Start on doorlike

PPKFS · Nov 9, 2023 · f6e856f · f6e856f
1 parent 47e4f17
commit f6e856f
Show file tree

Hide file tree

Showing 7 changed files with 36 additions and 28 deletions.
diff --git a/src/Yaifl/Activities/PrintingTheLocaleDescription.hs b/src/Yaifl/Activities/PrintingTheLocaleDescription.hs
@@ -171,10 +171,10 @@ alsoSee = Rule "You can also see" [] (\v ->
       isASupporter <- dom `isType` "supporter"
       isAnAnimal <- dom `isType` "animal"
 
-      let isInLoc = True -- TODO TODOmaybe False (dom `objectEquals`) plRoom
+      let isInLoc = maybe False (dom `objectEquals`) plRoom
       if
         --if the domain is the location: say "[We] " (A);
-        | isRoom dom && isInLoc ->
+        | isInLoc ->
           sayYCASResponse #youCanAlsoSeeA ()
         -- otherwise if the domain is a supporter or the domain is an animal:
         -- say "On [the domain] [we] " (B);

diff --git a/src/Yaifl/Model/Objects/RoomConnections.hs b/src/Yaifl/Model/Objects/RoomConnections.hs
@@ -193,12 +193,12 @@ isBelow = isDownOf
 addDoorToConnection ::
   NoMissingObjects wm es
   => WMHasProperty wm DoorSpecifics
-  => Thing wm
+  => DoorLike wm d
+  => d
   -> (Room wm, WMDirection wm)
   -> (Room wm, WMDirection wm)
   -> Eff es ()
 addDoorToConnection d (front, frontDir) (back, backDir) = do
-  -- this is probably best done as an asDoor thing TODO
   mbDs <- getDoorSpecificsMaybe d
   case mbDs of
     Nothing -> error $ "Tried to add a door, except it wasn't a door " <> show (getID d)

diff --git a/src/Yaifl/Model/Properties/Door.hs b/src/Yaifl/Model/Properties/Door.hs
@@ -3,8 +3,11 @@
 
 module Yaifl.Model.Properties.Door
   ( DoorSpecifics(..)
+  , DoorLike
   , blankDoor
   , getDoorSpecificsMaybe
+  , isOpen
+  , isClosed
   ) where
 
 
@@ -28,4 +31,23 @@ blankDoor :: Entity -> DoorSpecifics
 blankDoor e = Door e False Closed
 
 makeFieldLabelsNoPrefix ''DoorSpecifics
-makeSpecificsWithout [] ''DoorSpecifics
+makeSpecificsWithout [] ''DoorSpecifics
+
+isClosed ::
+  NoMissingRead wm es
+  => WMHasProperty wm Openable
+  => ObjectLike wm o
+  => o
+  -> Eff es Bool
+isClosed o = (Just Closed ==) <$> getOpenableMaybe o
+
+isOpen ::
+  NoMissingRead wm es
+  => WMHasProperty wm Openable
+  => ObjectLike wm o
+  => o
+  -> Eff es Bool
+isOpen o = (Just Open ==) <$> getOpenableMaybe o
+
+
+type DoorLike wm o = PropertyLike wm DoorSpecifics o
diff --git a/src/Yaifl/Model/Properties/Openable.hs b/src/Yaifl/Model/Properties/Openable.hs
@@ -4,8 +4,6 @@ module Yaifl.Model.Properties.Openable
   ( -- * Types
     Openable(..)
   , getOpenableMaybe
-  , isClosed
-  , isOpen
   ) where
 
 
@@ -21,20 +19,4 @@ import Yaifl.Model.Objects.Effects
 data Openable = Open | Closed
   deriving stock (Eq, Show, Read, Ord, Generic)
 
-makeSpecificsWithout [] ''Openable
-
-isClosed ::
-  NoMissingRead wm es
-  => WMHasProperty wm Openable
-  => ObjectLike wm o
-  => o
-  -> Eff es Bool
-isClosed o = (Just Closed ==) <$> getOpenableMaybe o
-
-isOpen ::
-  NoMissingRead wm es
-  => WMHasProperty wm Openable
-  => ObjectLike wm o
-  => o
-  -> Eff es Bool
-isOpen o = (Just Open ==) <$> getOpenableMaybe o
+makeSpecificsWithout [] ''Openable
diff --git a/src/Yaifl/Model/Properties/PropertyLike.hs b/src/Yaifl/Model/Properties/PropertyLike.hs
@@ -0,0 +1,4 @@
+module Yaifl.Model.Properties.PropertyLike
+  (
+
+  ) where
diff --git a/src/Yaifl/Model/Properties/Query.hs b/src/Yaifl/Model/Properties/Query.hs
@@ -92,8 +92,7 @@ class PropertyLike wm prop o where
   getAs :: (WMHasProperty wm prop, NoMissingObjects wm es) => o -> Eff es prop
 
 type EnclosingLike wm o = PropertyLike wm Enclosing o
-
-instance PropertyLike wm Enclosing Enclosing where
+instance PropertyLike wm a a where
   getAs = pure
 
 instance PropertyLike wm Enclosing (TaggedEntity EnclosingTag) where
@@ -108,4 +107,4 @@ instance PropertyLike wm Enclosing (TaggedEntity RoomTag) where
     getAs a
 
 instance PropertyLike wm Enclosing (Room wm) where
- getAs o = pure $ o ^. #objectData % #enclosing
+ getAs o = pure $ o ^. #objectData % #enclosing
diff --git a/test/Yaifl/Test/Chapter3/StarryVoid.hs b/test/Yaifl/Test/Chapter3/StarryVoid.hs
@@ -17,6 +17,7 @@ import Yaifl.Rules.RuleEffects
 import Yaifl.Text.AdaptiveNarrative
 import Yaifl.Text.DynamicText
 import Yaifl.Text.SayQQ
+import Yaifl.Model.Direction
 
 boothDesc :: WMHasProperty wm Openable => Room wm -> DynamicText wm
 boothDesc tcr = DynamicText $ Right ("description of magician's booth door", RuleLimitedEffect $ withThing $ \t -> do
@@ -35,5 +36,5 @@ starryVoid = do
   tsv <- addRoom "The Starry Void" ""
   tmb <- addDoor "The magician's booth" (Just $ boothDesc tcr) tcr tsv Nothing
   tcr `isInsideFrom` tsv
-  --addDoorToConnection tmb (Out, tcr) (In, tsv)
+  addDoorToConnection tmb (Out, tcr) (In, tsv)
   pass