A bunch more tidying up - removing ObjectLike almost completely and a…

…dding placeholders for activities to implement

run_no

@@ -1 +1 @@
-285
+296

src/Yaifl.hs

@@ -79,17 +79,32 @@ type HasStandardProperties s = (
   , Pointed (WMObjSpecifics s)
   )
 
+-- | All the standard library activities.
+-- printing the banner text, constructing the status line, reading a command, deciding the scope
+-- clarifying the parser's scope, printing a paser error, asking which do you mean
+-- supplying a missing noun, second noun, implicitly taking, amusing a victorius player, printing obit
+-- handling final question, offering something and performing something (both dialogue)
 data ActivityCollection wm = ActivityCollection
-  { printingNameOfADarkRoom :: !(Activity wm () ())
-  , printingNameOfSomething :: !(Activity wm (AnyObject wm) Text)
-  , printingDescriptionOfADarkRoom :: !(Activity wm () ())
-  , choosingNotableLocaleObjects :: !(Activity wm (AnyObject wm) (LocalePriorities wm))
-  , printingLocaleParagraphAbout :: !(Activity wm (LocaleVariables wm, LocaleInfo wm) (LocaleVariables wm))
-  , printingTheLocaleDescription :: !(Activity wm (LocaleVariables wm) ())
-  , listingNondescriptItems :: !(Activity wm (AnyObject wm) ())
-  , listingContents :: !(Activity wm (ListWritingParameters wm) ())
+  { choosingNotableLocaleObjects :: Activity wm (AnyObject wm) (LocalePriorities wm)
   , groupingTogether :: Activity wm (AnyObject wm) ()
+  , listingContents :: Activity wm (ListWritingParameters wm) ()
+  , listingNondescriptItems :: Activity wm (AnyObject wm) ()
   , printingANumberOf :: Activity wm (Int, AnyObject wm) ()
+  , printingDescriptionOfADarkRoom :: Activity wm () ()
+  , printingLocaleParagraphAbout :: Activity wm (LocaleVariables wm, LocaleInfo wm) (LocaleVariables wm)
+  , printingNameOfSomething :: Activity wm (AnyObject wm) Text
+  , printingTheLocaleDescription :: Activity wm (LocaleVariables wm) ()
+  , printingNameOfADarkRoom :: Activity wm () ()
+  -- TODO https://ganelson.github.io/inform/standard_rules/S-act.html#SP15
+ {- , printingRoomDescriptionDetails :: Activity wm (Thing wm) ()
+  , printingInventoryDetails :: Activity wm (Thing wm) ()
+  , writingAParagraphAbout :: Activity wm (AnyObject wm) ()
+  , printingAnnouncementOfDarkness :: Activity wm () ()
+  , printingAnnouncementOfLight :: Activity wm () ()
+  , printingRefusalToActInTheDark :: Activity wm () ()
+  , decidingConcealedPossessions :: Activity wm () ()
+  , decidingWhetherAllIncludes :: Activity wm () ()
+-}
   } deriving stock (Generic)
 
 makeFieldLabelsNoPrefix ''ActivityCollection

src/Yaifl/Actions/ActionProcessing.hs

@@ -16,7 +16,7 @@ import Yaifl.Rules.Run
 
 
 actionProcessingRules :: ActionProcessing wm
-actionProcessingRules = ActionProcessing $ \aSpan Action{..} u -> withoutMissingObjects (runRulebook (Just aSpan) (Rulebook
+actionProcessingRules = ActionProcessing $ \aSpan Action{..} u -> failHorriblyIfMissing (runRulebook (Just aSpan) (Rulebook
   "action processing"
   (Just True)
   -- I have no idea how this works
@@ -49,4 +49,4 @@ actionProcessingRules = ActionProcessing $ \aSpan Action{..} u -> withoutMissing
           r <- runRulebookAndReturnVariables (Just aSpan) reportRules v
           return (first Just $ fromMaybe (v, Nothing) r))
   , notImplementedRule "clean actions rule"
-  ]) u) (handleMissingObject "" (Just False))
+  ]) u)

src/Yaifl/Actions/Collection.hs

@@ -10,7 +10,8 @@ import Yaifl.Actions.Going
 import Yaifl.Actions.Looking.Visibility
 import Solitude
 
-
+-- | The standard actions before they are existentially wrapped. This is so we can modify them during
+-- world construction as we lose the type information later and cannot modify a `WrappedAction`.
 data ActionCollection wm = ActionCollection
   { going :: Action wm (GoingActionVariables wm)
   , looking :: Action wm (LookingActionVariables wm)

src/Yaifl/Actions/Going.hs

@@ -124,9 +124,8 @@ goingActionSet (UnverifiedArgs Args{..}) = do
     NoParameter -> do
       mbThrough <- getMatchingThing "through"
       -- TODO: this should be a door or complain
-      --mbDoor <- join <$> traverse getDoorSpecificsMaybe mbThrough
-      --pure $ backSide <$> mbDoor
-      error "aaaaa door"
+      let mbDoor = join $ traverse getDoorSpecificsMaybe mbThrough
+      pure $ backSide <$> mbDoor
     ConstantParameter t -> error $ "got a " <> t
   mbRoomGoneTo <- join <$> traverse getRoomMaybe target
   addAnnotation $ "target was " <> show target
@@ -240,4 +239,4 @@ toTheRoom ::
   => r
   -> Precondition wm (Args wm (GoingActionVariables wm))
 toTheRoom r = Precondition $ \v -> do
-  pure $ getID (roomGoneTo $ variables $ v) == getID r
+  pure $ getID (roomGoneTo $ variables v) == getID r

src/Yaifl/Actions/Looking.hs

@@ -12,37 +12,39 @@ import Solitude
 import Breadcrumbs ( addTag )
 import Data.Text.Display ( display )
 import Effectful.Optics ( use )
+
 import Yaifl.Actions.Action
+import Yaifl.Actions.Looking.Locale
+import Yaifl.Actions.Looking.Visibility
 import Yaifl.Activities.Activity
-import Yaifl.Text.AdaptiveNarrative
-import Yaifl.Model.Entity ( emptyStore, HasID(..) )
+import Yaifl.Activities.PrintingTheLocaleDescription ( WithPrintingTheLocaleDescription )
 import Yaifl.Metadata
-import Yaifl.Model.Object( Object(..), AnyObject, Thing )
+import Yaifl.Model.Entity ( emptyStore, HasID(..) )
+import Yaifl.Model.Object( Object(..), AnyObject, Thing, objectEquals )
+import Yaifl.Model.Objects.Effects
 import Yaifl.Model.Objects.Query
-import Yaifl.Model.Objects.RoomData (IsVisited(..))
+import Yaifl.Model.Objects.RoomData ( IsVisited(..) )
 import Yaifl.Model.Objects.ThingData ( ThingData(..) )
-import Yaifl.Text.Print ( Print, setStyle, printLn )
-import Yaifl.Text.Responses
-import Yaifl.Rules.Rule
-import Yaifl.Rules.RuleEffects
-import Yaifl.Rules.Rulebook
-import Yaifl.Text.SayQQ
-import Yaifl.Actions.Looking.Locale
 import Yaifl.Model.Properties.Animal
 import Yaifl.Model.Properties.Supporter ( isSupporter )
+import Yaifl.Rules.Args
+import Yaifl.Rules.Rule
+import Yaifl.Rules.RuleEffects
+import Yaifl.Text.AdaptiveNarrative
+import Yaifl.Text.Print ( Print, setStyle, printLn )
+import Yaifl.Text.Responses
 import Yaifl.Text.Say
-import Yaifl.Actions.Looking.Visibility
+import Yaifl.Text.SayQQ
 import qualified Prettyprinter.Render.Terminal as PPTTY
-import Yaifl.Activities.PrintingTheLocaleDescription ( WithPrintingTheLocaleDescription )
-import Yaifl.Rules.Args
-import Yaifl.Model.Objects.Effects
 
+-- STATUS: all done, except report other people looking
+-- some of the locale printing needs more work
 roomDescriptionResponsesImpl :: WithPrintingNameOfSomething wm => RoomDescriptionResponses wm
 roomDescriptionResponsesImpl = RDR
-  { roomDescriptionHeadingA = roomDescriptionHeadingAImpl
-  , roomDescriptionHeadingB = roomDescriptionHeadingBImpl
-  , roomDescriptionHeadingC = roomDescriptionHeadingCImpl
-  , roomDescriptionBodyA = roomDescriptionBodyAImpl
+  { roomDescriptionHeadingA = Response $ const [sayingTell|Darkness|]
+  , roomDescriptionHeadingB = Response $ \intermediateLevel -> [sayingTell|(on {the intermediateLevel})|]
+  , roomDescriptionHeadingC = Response $ \intermediateLevel -> [sayingTell|(in {the intermediateLevel})|]
+  , roomDescriptionBodyA = Response $ const [sayingTell|#{It} #{are} pitch dark, and #{we} #{can't see} a thing.|]
   }
 
 lookingAction ::
@@ -69,18 +71,16 @@ lookingActionSet ::
   => NoMissingObjects wm es
   => UnverifiedArgs wm
   -> Eff es (ArgumentParseResult (LookingActionVariables wm))
-lookingActionSet ua@(UnverifiedArgs Args{..}) = withoutMissingObjects (do
+lookingActionSet ua@(UnverifiedArgs Args{..}) = do
   -- loc may be a thing (a container) or a room (the more likely case)
   loc <- getObject (source ^. #objectData % #containedBy)
   vl <- getVisibilityLevels loc
   lightLevels <- recalculateLightOfParent source
-  let ac = getActionParameter ua
-  acName <- case ac of
+  acName <- case getActionParameter ua of
     NoParameter -> pure "looking"
     ConstantParameter acName -> pure acName
     _other -> error "impossible"
-  return $ Right $ LookingActionVariables loc (take lightLevels vl) acName)
-    (handleMissingObject "Failed to set the variables for looking" $ Left "Failed to set the variables for looking")
+  return $ Right $ LookingActionVariables loc (take lightLevels vl) acName
 
 carryOutLookingRules ::
   WithPrintingNameOfADarkRoom wm
@@ -90,13 +90,12 @@ carryOutLookingRules ::
   => ActionRulebook wm (LookingActionVariables wm)
 carryOutLookingRules = makeActionRulebook "carry out looking" [
   makeRule "room description heading rule" forPlayer'
-    (\rb -> do
+    (\a@Args{variables=(LookingActionVariables _ lvls _)} -> do
       -- say bold type;
       setStyle (Just PPTTY.bold)
-      let (LookingActionVariables _ lvls _) = variables rb
-          mbVisCeil = viaNonEmpty last lvls
+      let mbVisCeil = viaNonEmpty last lvls
       whenJust mbVisCeil $ addTag "visibility ceiling" . display
-      loc <- getActorLocation rb
+      loc <- getActorLocation a
       case mbVisCeil of
         -- if the visibility level count is 0:
         Nothing -> do
@@ -120,6 +119,7 @@ carryOutLookingRules = makeActionRulebook "carry out looking" [
             addTag @Text "Ceiling is not the location" ""
             --  say "[The visibility ceiling]";
             [saying|{The visCeil}|]
+      let
       -- repeat with intermediate level count running from 2 to the visibility level count:
       mapM_ foreachVisibilityHolder (drop 1 lvls)
       -- say line break;
@@ -129,16 +129,15 @@ carryOutLookingRules = makeActionRulebook "carry out looking" [
       return Nothing),
 
   makeRule "room description body rule" forPlayer'
-    (\rb -> do
-      let (LookingActionVariables _ lvls ac) = variables rb
-          mbVisCeil = viaNonEmpty last lvls
+    (\a@Args{variables=(LookingActionVariables _ lvls ac)} -> do
+      let mbVisCeil = viaNonEmpty last lvls
       roomDesc <- use @Metadata #roomDescriptions
       dw <- use @Metadata #darknessWitnessed
       addTag "darkness witnessed" dw
       addTag "room descriptions" roomDesc
       let abbrev = roomDesc == AbbreviatedRoomDescriptions
           someAbbrev = roomDesc == SometimesAbbreviatedRoomDescriptions
-      loc <- getActorLocation rb
+      loc <- getActorLocation a
       case mbVisCeil of
         -- if the visibility level count is 0:
         Nothing ->
@@ -158,16 +157,13 @@ carryOutLookingRules = makeActionRulebook "carry out looking" [
             void $ endActivity #printingDescriptionOfADarkRoom
         Just visCeil ->
           -- otherwise if the visibility ceiling is the location:
-          if getID visCeil == getID loc
-          then
+          when (visCeil `objectEquals` loc) $ do
             -- if set to abbreviated room descriptions, continue the action;
             -- if set to sometimes abbreviated room descriptions and abbreviated form allowed
             -- is true and the location is visited, continue the action;
             unless (abbrev || (someAbbrev && ac /= "looking" && loc ^. #objectData % #isVisited == Visited)) $
               -- print the location's description;
               sayLn $ loc ^. #description
-          else
-            pass
       return Nothing),
   -- because I've ignored all the junk about marked for listing or w/e, and we can do nice clean loops
   -- 19 lines down to 2. lol.
@@ -179,9 +175,8 @@ carryOutLookingRules = makeActionRulebook "carry out looking" [
       return Nothing),
 
   makeRule "check new arrival rule" forPlayer'
-    (\rb -> do
-      let (LookingActionVariables _ lvls _) = variables rb
-          mbVisCeil = viaNonEmpty last lvls
+    (\a@Args{variables=(LookingActionVariables _ lvls _)} -> do
+      let mbVisCeil = viaNonEmpty last lvls
       case mbVisCeil of
         -- if in darkness:
         Nothing ->
@@ -190,7 +185,7 @@ carryOutLookingRules = makeActionRulebook "carry out looking" [
         Just _ -> do
           -- if the location is a room, now the location is visited;
           -- except...a location is always a room.
-          loc <- getActorLocation rb
+          loc <- getActorLocation a
           modifyRoom loc (#objectData % #isVisited .~ Visited)  >> rulePass
       )
   ]
@@ -216,22 +211,6 @@ foreachVisibilityHolder e = do
     -- say " (in [the intermediate level])" (C);    
     (sayResponse (#roomDescriptions % #roomDescriptionHeadingC) e)
 
-roomDescriptionHeadingAImpl :: Response wm ()
-roomDescriptionHeadingAImpl = Response $ const [sayingTell|Darkness|]
-
-roomDescriptionHeadingBImpl ::
-  WithPrintingNameOfSomething wm
-  => Response wm (AnyObject wm)
-roomDescriptionHeadingBImpl = Response $ \intermediateLevel -> [sayingTell|(on {the intermediateLevel})|]
-
-roomDescriptionHeadingCImpl ::
-  WithPrintingNameOfSomething wm
-  => Response wm (AnyObject wm)
-roomDescriptionHeadingCImpl = Response $ \intermediateLevel -> [sayingTell|(in {the intermediateLevel})|]
-
-roomDescriptionBodyAImpl :: Response wm ()
-roomDescriptionBodyAImpl = Response $ const [saying|#{It} #{are} pitch dark, and #{we} #{can't see} a thing.|]
-
 otherPeopleLookingAImpl ::
   WithPrintingNameOfSomething wm
   => Response wm (Thing wm)

src/Yaifl/Activities/Activity.hs

@@ -22,7 +22,7 @@ import Breadcrumbs ( withSpan )
 import Data.Text.Display
 import Effectful.Optics ( use )
 import GHC.TypeLits
-import Yaifl.Model.Objects.Query ( withoutMissingObjects, handleMissingObject, failHorriblyIfMissing )
+import Yaifl.Model.Objects.Query ( failHorriblyIfMissing )
 import Yaifl.Rules.Args ( Refreshable )
 import Yaifl.Rules.Rule
 import Yaifl.Rules.RuleEffects
@@ -76,14 +76,13 @@ beginActivity ::
 beginActivity acL c = do
   ac <- use @(ActivityCollector wm) (#activityCollection % acL)
   withSpan "begin activity" (ac ^. #name) $ \aSpan ->
-    withoutMissingObjects
+    failHorriblyIfMissing
       (do
         modify @(ActivityCollector wm) (#activityCollection % acL % #currentVariables ?~ c)
         -- run the before rules only.
         r <- runRulebookAndReturnVariables (Just aSpan) (beforeRules ac) c
         whenJust r $ \r' -> modify @(ActivityCollector wm) (#activityCollection % acL % #currentVariables ?~ fst r')
         pure $ maybe c fst r)
-      (handleMissingObject "beginning an activity" c)
 
 whenHandling' ::
   RuleEffects wm es
@@ -153,10 +152,10 @@ doActivity ::
   -> Eff es (Maybe r)
 doActivity acL c = do
   ac <- use @(ActivityCollector wm) (#activityCollection % acL)
-  withSpan "activity" (ac ^. #name) $ \aSpan -> withoutMissingObjects (do
+  withSpan "activity" (ac ^. #name) $ \aSpan -> failHorriblyIfMissing (do
     modify @(ActivityCollector wm) (#activityCollection % acL % #currentVariables ?~ c)
     x <- runRulebookAndReturnVariables (Just aSpan) (beforeRules ac) c
     mr <- runRulebookAndReturnVariables (Just aSpan) (carryOutRules ac) (maybe c fst x)
     _ <- runRulebookAndReturnVariables (Just aSpan) (afterRules ac) (maybe c fst mr)
     modify @(ActivityCollector wm) (#activityCollection % acL % #currentVariables .~ Nothing)
-    return $ snd =<< mr) (handleMissingObject "running an activity" Nothing)
+    return $ snd =<< mr)

src/Yaifl/Model/Objects/Move.hs

@@ -29,7 +29,7 @@ move ::
   => Thing wm
   -> l
   -> Eff es Bool
-move objectToMove oLoc = withoutMissingObjects moveBlock moveHandler
+move objectToMove oLoc = failHorriblyIfMissing moveBlock
   where
     moveBlock = withSpan' "move" ""$ do
       objectToMove' <- refreshThing objectToMove
@@ -48,7 +48,6 @@ move objectToMove oLoc = withoutMissingObjects moveBlock moveHandler
       setEnclosing oLoc' newLocation
       --at this point we know it's a success
       return True
-    moveHandler = handleMissingObject ("Failed to move " <> display (getID objectToMove) <> " to " <> display (getID oLoc)) False
 
 moveObjects :: EnclosingEntity -> Thing wm -> Enclosing -> Enclosing -> (Thing wm, Enclosing, Enclosing)
 moveObjects newId t oldLoc newLocEncl = let (newLoc', t') = nowContains newId newLocEncl t in (t', oldLoc `noLongerContains` t, newLoc')

src/Yaifl/Model/Objects/Query.hs

@@ -2,9 +2,7 @@ module Yaifl.Model.Objects.Query
   ( -- * Types
   ObjectLike(..)
   -- * Missing Objects
-  , withoutMissingObjects
   , failHorriblyIfMissing
-  , handleMissingObject
 
   -- * Get
   , getThingMaybe
@@ -50,15 +48,6 @@ withoutMissingObjects f def = do
     Left err' -> def (snd err')
     Right x -> return x
 
-handleMissingObject ::
-  WithMetadata es
-  => Text
-  -> a
-  -> MissingObject
-  -> Eff es a
-handleMissingObject msg def (MissingObject t o) =
-  noteError (const def) $ "When " <> show msg <> " the object with ID " <> show o <> " could not be found because " <> show t
-
 failHorriblyIfMissing ::
   HasCallStack
   => Breadcrumbs :> es

src/Yaifl/Model/Objects/RoomConnections.hs

@@ -187,7 +187,8 @@ modifyAndVerifyConnection ::
   -> Room wm
   -> (Connection -> Connection)
   -> Eff es ()
-modifyAndVerifyConnection fromRoom fromDir dest f = do
+modifyAndVerifyConnection fromRoom' fromDir dest f = do
+  fromRoom <- refreshRoom fromRoom'
   if connectionInDirection Nothing fromRoom fromDir == Just (tagRoom dest)
   then modifyRoom @wm fromRoom (connectionLens fromDir % _Just %~ f)
   else noteError (const ()) ("Tried to add a connection to the room " <> display fromRoom <> " but it had no connection in direction "

src/Yaifl/Model/Properties/Container.hs

@@ -30,7 +30,6 @@ import Yaifl.Model.Properties.Query ( defaultPropertySetter, defaultPropertyGett
 import Yaifl.Model.Properties.TH ( makeSpecificsWithout )
 import Yaifl.Model.Properties.Openable ( Openable(..) )
 import Yaifl.Model.Objects.Effects
-import Yaifl.Model.Objects.ObjectLike
 import Yaifl.Model.Object
 
 -- | If the container is see-through.

src/Yaifl/Model/Properties/Query.hs

@@ -95,7 +95,6 @@ class HasProperty w o v where
 instance MayHaveProperty o v => HasProperty w o v where
   propertyL _ = lens (fromMaybe (error "property witness was violated") . preview propertyAT) (flip (set propertyAT))
 
-
 class Taggable o EnclosingTag => EnclosingObject o where
   enclosingL :: Lens' o Enclosing
 

test/testcases/Chapter3/Slightly Wrong

@@ -1,6 +1,6 @@
----------------------
------ Verbosity -----
----------------------
+--------------------------
+----- Slightly Wrong -----
+--------------------------
 
 Slightly Wrong Chamber