From 7770ed05484a8a7aae4d5d680a069a0886a145dd Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Fri, 20 Sep 2019 12:03:30 -0400
Subject: Add the beginnings of a prompt system

Add the beginnings of a generic prompt system, with exclusive support
atm for string prompts, and test it out by asking the character for
their name at startup
---
 test/Xanthous/Data/EntityMapSpec.hs | 5 ++++-
 test/Xanthous/GameSpec.hs           | 3 +++
 2 files changed, 7 insertions(+), 1 deletion(-)

(limited to 'test/Xanthous')

diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs
index 00bf1500466a..2e9714a44eb7 100644
--- a/test/Xanthous/Data/EntityMapSpec.hs
+++ b/test/Xanthous/Data/EntityMapSpec.hs
@@ -15,7 +15,10 @@ test = localOption (QuickCheckTests 20)
   $ testGroup "Xanthous.Data.EntityMap"
   [ testBatch $ monoid @(EntityMap Int) mempty
   , testGroup "Deduplicate"
-    [ testBatch $ monoid @(Deduplicate Int) mempty
+    [ testGroup "Semigroup laws"
+      [ testProperty "associative" $ \(a :: Deduplicate (EntityMap Int)) b c ->
+          a <> (b <> c) === (a <> b) <> c
+      ]
     ]
   , testGroup "Eq laws"
     [ testProperty "reflexivity" $ \(em :: EntityMap Int) ->
diff --git a/test/Xanthous/GameSpec.hs b/test/Xanthous/GameSpec.hs
index dbd1677f7e79..32faae03d7a9 100644
--- a/test/Xanthous/GameSpec.hs
+++ b/test/Xanthous/GameSpec.hs
@@ -27,4 +27,7 @@ test = testGroup "Xanthous.Game"
   , testGroup "characterPosition"
     [ testProperty "lens laws" $ isLens characterPosition
     ]
+  , testGroup "character"
+    [ testProperty "lens laws" $ isLens character
+    ]
   ]
-- 
cgit 1.4.1