diff --git a/src/Yaifl/Activities/PrintingTheLocaleDescription.hs b/src/Yaifl/Activities/PrintingTheLocaleDescription.hs index a9ab199..5eedd5e 100644 --- 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 index 41fa7d7..4775f23 100644 --- 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 index 0e09683..9a3d1ac 100644 --- 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 \ No newline at end of file +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 index cee5015..53b5d1e 100644 --- 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 \ No newline at end of file +makeSpecificsWithout [] ''Openable \ No newline at end of file diff --git a/src/Yaifl/Model/Properties/PropertyLike.hs b/src/Yaifl/Model/Properties/PropertyLike.hs new file mode 100644 index 0000000..3d75dd3 --- /dev/null +++ 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 index 980dda3..96e26c3 100644 --- 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 \ No newline at end of file + getAs o = pure $ o ^. #objectData % #enclosing diff --git a/test/Yaifl/Test/Chapter3/StarryVoid.hs b/test/Yaifl/Test/Chapter3/StarryVoid.hs index f8082cc..0288550 100644 --- 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 \ No newline at end of file