From 71b628c604556bc2d829f12980db99c9a526ec84 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sat, 30 Nov 2019 19:55:43 -0500
Subject: Add messages on the ground

Add support for a "GroundMessage" entity type, support for a Read
command to read them, and randomly place an initial, tone-setting
tutorial message on the ground near the character at the beginning of
the game.
---
 src/Xanthous/Util.hs | 29 ++++++++++++++++++++++++-----
 1 file changed, 24 insertions(+), 5 deletions(-)

(limited to 'src/Xanthous/Util.hs')

diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs
index 3a7c10ace18e..814f9371150f 100644
--- a/src/Xanthous/Util.hs
+++ b/src/Xanthous/Util.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE AllowAmbiguousTypes   #-}
 {-# LANGUAGE QuantifiedConstraints #-}
-
+--------------------------------------------------------------------------------
 module Xanthous.Util
   ( EqEqProp(..)
   , EqProp(..)
@@ -25,13 +25,18 @@ module Xanthous.Util
     -- ** Bag sequence algorithms
   , takeWhileInclusive
   , smallestNotIn
-  ) where
 
+    -- * Type-level programming utils
+  , KnownBool(..)
+  ) where
+--------------------------------------------------------------------------------
 import Xanthous.Prelude hiding (foldr)
-
+--------------------------------------------------------------------------------
 import Test.QuickCheck.Checkers
 import Data.Foldable (foldr)
 import Data.Monoid
+import Data.Proxy
+--------------------------------------------------------------------------------
 
 newtype EqEqProp a = EqEqProp a
   deriving newtype Eq
@@ -204,3 +209,17 @@ smallestNotIn xs = case uniq $ sort xs of
     | x > minBound -> minBound
     | otherwise
     -> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..]
+
+--------------------------------------------------------------------------------
+
+-- | This class gives a boolean associated with a type-level bool, a'la
+-- 'KnownSymbol', 'KnownNat' etc.
+class KnownBool (bool :: Bool) where
+  boolVal' :: forall proxy. proxy bool -> Bool
+  boolVal' _ = boolVal @bool
+
+  boolVal :: Bool
+  boolVal = boolVal' $ Proxy @bool
+
+instance KnownBool 'True where boolVal = True
+instance KnownBool 'False where boolVal = False
-- 
cgit 1.4.1