From 4b11859d046b470a87d73edc8447ed73a3f7a6da Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Wed, 24 Nov 2021 17:10:47 -0500
Subject: feat(gs/xanthous): Allow generating creatures with items

Add an `equippedItems` field to the CreatureType raw, which provides a
chance for generating that creature with an item equipped, which goes
into a new `inventory` field on the creature entity itself. Currently
the creature doesn't actually *use* this equipped item, but it's a step.

This commit also adds a broken-dagger equipped 90% of the time to the
"husk" creature.

Change-Id: I6416c0678ba7bc1b002c5ce6119f7dc97dd86437
---
 .../test/Xanthous/Entities/RawTypesSpec.hs         | 39 ++++++++++++++++------
 .../xanthous/test/Xanthous/Entities/RawsSpec.hs    | 14 ++++++++
 2 files changed, 42 insertions(+), 11 deletions(-)

(limited to 'users/grfn/xanthous/test/Xanthous/Entities')

diff --git a/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs
index f5feb8a506db..e23f7faba3a6 100644
--- a/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs
+++ b/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs
@@ -1,8 +1,11 @@
+{-# LANGUAGE RecordWildCards #-}
 --------------------------------------------------------------------------------
 module Xanthous.Entities.RawTypesSpec (main, test) where
 --------------------------------------------------------------------------------
 import           Test.Prelude
 --------------------------------------------------------------------------------
+import           Data.Interval (Extended(..), (<=..<=))
+--------------------------------------------------------------------------------
 import           Xanthous.Entities.RawTypes
 --------------------------------------------------------------------------------
 
@@ -12,17 +15,31 @@ main = defaultMain test
 test :: TestTree
 test = testGroup "Xanthous.Entities.RawTypesSpec"
   [ testGroup "CreatureGenerateParams"
-    [ testBatch $ monoid @CreatureGenerateParams mempty
-    , testGroup "canGenerate"
-      [ testProperty "no bounds" $ \level ->
-          let gps = CreatureGenerateParams Nothing Nothing
-          in canGenerate level gps
-      , testProperty "min bound" $ \level minB ->
-          let gps = CreatureGenerateParams (Just minB) Nothing
-          in canGenerate level gps === (level >= minB)
-      , testProperty "max bound" $ \level maxB ->
-          let gps = CreatureGenerateParams Nothing (Just maxB)
-          in canGenerate level gps === (level <= maxB)
+    [ testGroup "Ord laws"
+      [ testProperty "comparability" $ \(a :: CreatureGenerateParams) b ->
+          a <= b || b <= a
+      , testProperty "transitivity" $ \(a :: CreatureGenerateParams) b c ->
+          a <= b && b <= c ==> a <= c
+      , testProperty "reflexivity" $ \(a :: CreatureGenerateParams) ->
+          a <= a
+      , testProperty "antisymmetry" $ \(a :: CreatureGenerateParams) b ->
+          (a <= b && b <= a) == (a == b)
       ]
+    , testGroup "canGenerate" $
+      let makeParams minB maxB =
+            let _levelRange = maybe NegInf Finite minB <=..<= maybe PosInf Finite maxB
+                _equippedItem = Nothing
+            in CreatureGenerateParams {..}
+      in
+        [ testProperty "no bounds" $ \level ->
+            let gps = makeParams Nothing Nothing
+            in canGenerate level gps
+        , testProperty "min bound" $ \level minB ->
+            let gps = makeParams (Just minB) Nothing
+            in canGenerate level gps === (level >= minB)
+        , testProperty "max bound" $ \level maxB ->
+            let gps = makeParams Nothing (Just maxB)
+            in canGenerate level gps === (level <= maxB)
+        ]
     ]
   ]
diff --git a/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs
index 2e6f35457fc7..b6c80be51be7 100644
--- a/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs
+++ b/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs
@@ -4,6 +4,8 @@ module Xanthous.Entities.RawsSpec (main, test) where
 
 import Test.Prelude
 import Xanthous.Entities.Raws
+import Xanthous.Entities.RawTypes
+       (_Creature, entityName, generateParams, HasEquippedItem (equippedItem))
 
 main :: IO ()
 main = defaultMain test
@@ -12,5 +14,17 @@ test :: TestTree
 test = testGroup "Xanthous.Entities.Raws"
   [ testGroup "raws"
     [ testCase "are all valid" $ raws `deepseq` pure ()
+    , testCase "all CreatureEquippedItems reference existent entity names" $
+      let notFound
+            = raws
+              ^.. folded
+              . _Creature
+              . generateParams
+              . _Just
+              . equippedItem
+              . _Just
+              . entityName
+              . filtered (isNothing . raw)
+      in null notFound @? ("Some entities weren't found: " <> show notFound)
     ]
   ]
-- 
cgit 1.4.1