Need to fix up the listwriter for the missing parameterised (in which…

… is) descriptions

run_no

@@ -0,0 +1 @@
+2

yaifl/run_no

@@ -1 +1 @@
-548
+555

yaifl/src/Yaifl.hs

@@ -23,9 +23,6 @@ module Yaifl (
 
 import Yaifl.Prelude hiding ( Reader, runReader )
 
-
-import Effectful.Optics ( (?=), use )
-
 import Yaifl.Model.Action
 import Yaifl.Game.ActionProcessing
 import Yaifl.Game.Actions.Going
@@ -41,7 +38,6 @@ import Yaifl.Game.Activities.PrintingTheLocaleDescription
 import Yaifl.Model.Metadata
 import Yaifl.Model.Kinds.Direction
 import Yaifl.Model.Entity
-import Yaifl.Model.Kinds.Object
 import Yaifl.Game.ObjectSpecifics
 import Yaifl.Game.Create.Object
 import Yaifl.Model.Kinds.Container

yaifl/src/Yaifl/Game/ActionProcessing.hs

@@ -12,6 +12,7 @@ import Yaifl.Model.Query
 import Yaifl.Model.Rules.Rulebook
 import Yaifl.Model.Rules.Run
 import Effectful.Reader.Static
+import Breadcrumbs
 
 
 actionProcessingRules :: forall wm. ActionProcessing wm
@@ -27,13 +28,15 @@ actionProcessingRules = ActionProcessing $ \aSpan a@((Action{..}) :: Action wm r
   [ Rule "before stage rule"
       []
         ( \v -> do
+          ignoreSpanIfEmptyRulebook beforeRules
           r <- runRulebookAndReturnVariables (Just aSpan) False beforeRules v
           return (first Just $ fromMaybe (v, Nothing) r))
   , notImplementedRule "carrying requirements rule"
   , notImplementedRule "basic visibility rule"
   , Rule "instead stage rule"
       []
         ( \v -> do
+          ignoreSpanIfEmptyRulebook insteadRules
           r <- runRulebookAndReturnVariables (Just aSpan) False insteadRules v
           return (first Just $ fromMaybe (v, Nothing) r))
   , notImplementedRule "requested actions require persuasion rule"
@@ -42,23 +45,29 @@ actionProcessingRules = ActionProcessing $ \aSpan a@((Action{..}) :: Action wm r
   , Rule "check stage rule"
       []
         ( \v -> do
+          ignoreSpanIfEmptyRulebook checkRules
           r <- runRulebookAndReturnVariables (Just aSpan) False checkRules v
           return (first Just $ fromMaybe (v, Nothing) r))
   , Rule "carry out stage rule"
       []
         ( \v -> do
+          ignoreSpanIfEmptyRulebook carryOutRules
           r <- runRulebookAndReturnVariables (Just aSpan) False carryOutRules v
           return (first Just $ fromMaybe (v, Nothing) r))
   , Rule "after stage rule"
       []
         ( \v -> do
+          ignoreSpanIfEmptyRulebook afterRules
           r <- runRulebookAndReturnVariables (Just aSpan) False afterRules v
           return (first Just $ fromMaybe (v, Nothing) r))
   , notImplementedRule "investigate player awareness after rule"
   , Rule "report stage rule"
       []
         ( \v -> do
+          ignoreSpanIfEmptyRulebook reportRules
           r <- runRulebookAndReturnVariables (Just aSpan) False reportRules v
           return (first Just $ fromMaybe (v, Nothing) r))
   , notImplementedRule "clean actions rule"
   ]) u)
+  where
+    ignoreSpanIfEmptyRulebook r = if null (rules r) then ignoreSpan else pass

yaifl/src/Yaifl/Game/Actions/Looking/Visibility.hs

@@ -6,7 +6,6 @@ import Yaifl.Prelude
 
 import Breadcrumbs ( addAnnotation )
 import Yaifl.Model.Activity (WithPrintingNameOfADarkRoom, WithPrintingDescriptionOfADarkRoom)
-import Data.Text.Display
 import Yaifl.Game.Activities.PrintingTheLocaleDescription
 import Yaifl.Model.Kinds.Object
 import Yaifl.Model.Effects
@@ -30,6 +29,7 @@ type HasLookingProperties wm =
   ( WMWithProperty wm Enclosing
   , WMWithProperty wm Enterable
   , WMWithProperty wm Container
+  , WMWithProperty wm Supporter
   , Display (WMText wm)
   , IsString (WMText wm)
   , WithPrintingNameOfADarkRoom wm

yaifl/src/Yaifl/Game/Activities/ListingContents.hs

@@ -11,6 +11,7 @@ import Yaifl.Text.ListWriter
 import Effectful.Writer.Static.Local (execWriter)
 import Yaifl.Text.Say
 import Yaifl.Text.Print
+import Breadcrumbs (addAnnotation)
 
 type WithListingContents wm = (
   WithListWriting wm
@@ -28,5 +29,6 @@ listingContentsImpl = makeActivity "Listing contents of something" [makeRule "st
           -- to avoid the infinite loop, this doesn't start the activity again
           , asListingActivity = False
           }
+    addAnnotation $ "listing contents of " <> display (contents objs)
     execWriter (writeListOfThings objectsWithContents) >>= say >> runOnParagraph
     pure Nothing )]

yaifl/src/Yaifl/Game/Activities/PrintingLocaleParagraphAbout.hs

@@ -13,13 +13,19 @@ import Yaifl.Game.Actions.Looking.Locale
 import Yaifl.Model.Entity
 import Yaifl.Model.HasProperty
 import Yaifl.Model.Kinds.Enclosing
+import Yaifl.Model.Kinds.Supporter
 import Yaifl.Text.SayQQ
 import Yaifl.Model.Rules.RuleEffects
 import Yaifl.Text.Say
 import Yaifl.Text.AdaptiveNarrative
 import Yaifl.Text.Responses
 import Yaifl.Model.Kinds.AnyObject
 import Yaifl.Model.Metadata
+import Yaifl.Model.Actions.Args
+import qualified Data.EnumSet as ES
+import Yaifl.Text.ListWriter
+import Yaifl.Game.Activities.ListingContents (WithListingContents)
+import Breadcrumbs (addAnnotation)
 
 setLocalePriority ::
   AnyObject s
@@ -114,15 +120,52 @@ useInitialAppearance = Rule "use initial appearance in room descriptions rule" [
         [saying|{ia}|]
         -- say "[paragraph break]";
         [saying|#{paragraphBreak}|]
+        -- increase the locale paragraph count by 1;
+        -- now the item is mentioned;
+        mentionItemAndIncreaseParagraphCount e v li
+  )
+
+useInitialAppearanceOnSupporters :: LocaleParagraphAboutRule wm
+useInitialAppearanceOnSupporters = notImplementedRule "initial appearance on supporters rule"
+
+describeOnScenery :: LocaleParagraphAboutRule wm
+describeOnScenery = notImplementedRule "describe what's on scenery supporters in room descriptions rule"
 
+describeOnMentionedSupporters ::
+  WithListingContents wm
+  => WMWithProperty wm Supporter
+  => LocaleParagraphAboutRule wm
+describeOnMentionedSupporters = Rule "describe what's on mentioned supporters in room descriptions rule" []
+  (\(v, li@(LocaleInfo _ e isMentioned)) ->
+    forThing e $ \thing -> do
+      enc <- view (#objectData % #containedBy) <$> getPlayer
+      -- if the item is mentioned and the item is not undescribed and the item is
+      -- not scenery and the item does not enclose the player:
+      ruleGuard
+        (isMentioned && (thing ^. #objectData % #described == Described)
+        && not (thing ^.  #objectData % #isScenery) && not (enc `objectEquals` e)) $ do
+        -- set pronouns from the item;
+        regarding (Just thing)
+        let objSupports = getSupporterMaybe thing
+        case objSupports of
+          -- if a locale-supportable thing is on the item:
+          Just sup
+            | (not . ES.null) (sup ^. #enclosing % #contents) -> do
+            -- say "On [the item] " (A);
+            [saying|On {the thing} |]
+            void $ doActivity #listingContents (withContents [toAny thing])
+            [saying|.#{paragraphBreak}|]
+          Just _sup -> do
+            addAnnotation "It was a supporter but it did not support anything"
+
+          _ -> addAnnotation "It was not a supporter"
+        -- this stuff is all marked for listing/mentioned boilerplate so we don't need it
         {-
-        TODO:
-        -- if a locale-supportable thing is on the item:
         repeat with possibility running through things on the item:
                   now the possibility is marked for listing;
                   if the possibility is mentioned:
                       now the possibility is not marked for listing;
-              say "On [the item] " (A);
+
               list the contents of the item, as a sentence, including contents,
                   giving brief inventory information, tersely, not listing
                   concealed items, prefacing with is/are, listing marked items only;
@@ -133,15 +176,6 @@ useInitialAppearance = Rule "use initial appearance in room descriptions rule" [
         mentionItemAndIncreaseParagraphCount e v li
   )
 
-useInitialAppearanceOnSupporters :: LocaleParagraphAboutRule wm
-useInitialAppearanceOnSupporters = notImplementedRule "initial appearance on supporters rule"
-
-describeOnScenery :: LocaleParagraphAboutRule wm
-describeOnScenery = notImplementedRule "describe what's on scenery supporters in room descriptions rule"
-
-describeOnMentionedSupporters :: LocaleParagraphAboutRule wm
-describeOnMentionedSupporters = notImplementedRule "describe what's on mentioned supporters in room descriptions rule"
-
 setPronounsFromItems :: LocaleParagraphAboutRule wm
 setPronounsFromItems = notImplementedRule "set pronouns from items in room descriptions rule"
 

yaifl/src/Yaifl/Game/Activities/PrintingTheLocaleDescription.hs

@@ -98,6 +98,8 @@ interestingLocale = Rule "Interesting locale paragraphs" [] (\v ->
     -- the printing a locale paragraph activity will instead modify
     -- the locale variables and pass those through
     newP <- foldlM (\v' li -> do
+        o <- getObject (localeObject li)
+        addAnnotation $ "printing locale paragraph about " <> (display (view #name o))
         r <- doActivity #printingLocaleParagraphAbout (v', li)
         return $ fromMaybe v' r) v sorted
     addTag "interesting things after printingLocaleParagraphAbout" (length (unStore $ localePriorities newP))

yaifl/src/Yaifl/Game/ObjectSpecifics.hs

@@ -8,6 +8,7 @@ module Yaifl.Game.ObjectSpecifics
   , addDevice
   , addPerson
   , addContainer
+  , addSupporter
   ) where
 
 import Yaifl.Prelude
@@ -24,7 +25,7 @@ import Yaifl.Game.Create.RoomConnection
 import Yaifl.Model.Kinds.Thing
 import Yaifl.Model.Kinds.Container
 import Yaifl.Model.Kinds.Door
-import Yaifl.Model.Kinds.Enclosing ( Enclosing )
+import Yaifl.Model.Kinds.Enclosing ( Enclosing (..), blankEnclosing )
 import Yaifl.Model.HasProperty ( MayHaveProperty(..), WMWithProperty )
 import Yaifl.Model.MultiLocated
 import Yaifl.Model.Kinds.Openable
@@ -35,6 +36,7 @@ import Yaifl.Model.Tag
 import Yaifl.Model.Kinds.Device
 import Yaifl.Model.Kinds.Person
 import Yaifl.Model.Rules (RuleEffects)
+import Yaifl.Model.Kinds.Supporter
 
 data ObjectSpecifics =
   NoSpecifics
@@ -44,6 +46,7 @@ data ObjectSpecifics =
   | DoorSpecifics Door
   | DeviceSpecifics Device
   | PersonSpecifics Person
+  | SupporterSpecifics Supporter
   deriving stock (Eq, Show, Read)
 
 makePrisms ''ObjectSpecifics
@@ -58,7 +61,10 @@ instance WMHasObjSpecifics ('WorldModel ObjectSpecifics a b c ac r se) where
   inj _ = id
 
 instance MayHaveProperty ObjectSpecifics Enclosing where
-  propertyAT = _EnclosingSpecifics `thenATraverse` (_ContainerSpecifics % #enclosing) `thenATraverse` (_PersonSpecifics % #carrying)
+  propertyAT = _EnclosingSpecifics
+    `thenATraverse` (_ContainerSpecifics % #enclosing)
+    `thenATraverse` (_SupporterSpecifics % #enclosing)
+    `thenATraverse` (_PersonSpecifics % #carrying)
 
 instance MayHaveProperty ObjectSpecifics MultiLocated where
   propertyAT = _DoorSpecifics % #multiLocated --`thenATraverse` (_ContainerSpecifics % containerEnclosing)
@@ -83,6 +89,9 @@ instance MayHaveProperty ObjectSpecifics Device where
 instance MayHaveProperty ObjectSpecifics Person where
   propertyAT = castOptic _PersonSpecifics
 
+instance MayHaveProperty ObjectSpecifics Supporter where
+  propertyAT = castOptic _SupporterSpecifics
+
 localST ::
   State st :> es
   => (st -> st)
@@ -189,7 +198,7 @@ addContainer n ia d
         ! paramF #location l
         ! done
     pure $ tag @Container @ContainerTag cs c
-{-}
+
 addSupporter ::
   forall wm es.
   WMHasObjSpecifics wm
@@ -200,17 +209,19 @@ addSupporter ::
   -> "description" :? WMText wm
   -> "carryingCapacity" :? Int
   -> "location" :? EnclosingEntity
+  -> "enterable" :? Enterable
   -> Eff es SupporterEntity
 addSupporter n ia d
-  (argF #carryingCapacity -> cc) (argF #location -> l) = do
-    let cs = makeContainer cc op e o od
+  (argF #carryingCapacity -> cc) (argF #location -> l) (argF #enterable -> e) = do
+    let enc = (blankEnclosing { capacity = cc <|> Just 100 })
+        sup = Supporter enc (fromMaybe NotEnterable e)
     c <- addThing @wm n ia d
-        ! #specifics (inj (Proxy @wm) $ ContainerSpecifics cs)
+        ! #specifics (inj (Proxy @wm) $ SupporterSpecifics sup)
         ! #type (ObjectKind "container")
         ! paramF #location l
         ! done
-    pure $ tag @Supporter @SupporterTag cs c
--}
+    pure $ tag @_ @SupporterTag sup c
+
 addPerson ::
   forall wm es.
   WMHasObjSpecifics wm

yaifl/src/Yaifl/Game/Parser.hs

@@ -149,8 +149,8 @@ parseNouns _ wordsToMatch command = runErrorNoCallStack $ failHorriblyIfMissing
         [] -> error "impossible"
         (matchWord:args) -> do
           let v = fromMaybe (error "impossible") $ lookup matchWord wordsToMatch
-          arg <- parseArgumentType @wm v (unwords args)
-          either throwError (pure . (matchWord,)) arg) matchedWords
+          arg' <- parseArgumentType @wm v (unwords args)
+          either throwError (pure . (matchWord,)) arg') matchedWords
       either throwError pure cmdArgs >>= \c -> pure (c, matchWords)
 
 addPostPromptSpacing ::

yaifl/src/Yaifl/Model/Actions/Args.hs

@@ -24,11 +24,9 @@ module Yaifl.Model.Actions.Args
 
 import Yaifl.Prelude hiding (show)
 
-import Effectful.Optics
 import Yaifl.Model.ObjectLike
 import Yaifl.Model.Kinds.Object
 import Yaifl.Model.WorldModel
-import Data.Text.Display
 import Yaifl.Model.Effects
 import GHC.Show
 import qualified Data.Set as S

yaifl/src/Yaifl/Model/Activity.hs

@@ -18,8 +18,6 @@ module Yaifl.Model.Activity
 import Yaifl.Prelude hiding ( Reader, runReader )
 
 import Breadcrumbs ( withSpan )
-import Data.Text.Display
-import Effectful.Optics ( use )
 import GHC.TypeLits
 import Yaifl.Model.Actions.Args ( Refreshable )
 import Yaifl.Model.Rules.Rulebook

yaifl/src/Yaifl/Model/Effects.hs

@@ -37,12 +37,10 @@ module Yaifl.Model.Effects
 import Yaifl.Prelude
 
 import Breadcrumbs
-import Data.Text.Display
 import Effectful.Error.Static
 import Effectful.TH
 
 import Yaifl.Model.Metadata
-import Yaifl.Model.Kinds.Object
 import Yaifl.Model.Entity
 import Yaifl.Model.WorldModel
 import Yaifl.Model.Kinds.Region

yaifl/src/Yaifl/Model/Entity.hs

@@ -25,7 +25,6 @@ module Yaifl.Model.Entity
   ) where
 
 import Yaifl.Prelude
-import Data.Text.Display ( Display(..) )
 
 -- | An object ID.
 newtype Entity = Entity

yaifl/src/Yaifl/Model/Input.hs

@@ -7,7 +7,6 @@ module Yaifl.Model.Input
 
 import Yaifl.Prelude
 import Yaifl.Model.Metadata
-import Effectful.Optics
 import Effectful.Dispatch.Dynamic (interpret)
 import Effectful.TH ( makeEffect )
 

yaifl/src/Yaifl/Model/Kinds/AnyObject.hs

@@ -26,8 +26,8 @@ newtype AnyObject wm = AnyObject (RawAnyObject wm)
 instance HasField x (RawAnyObject wm) a => HasField x (AnyObject wm) a where
   getField (AnyObject o) = getField @x o
 
-instance Display (AnyObject wm) where
-  displayBuilder = const "object"
+instance Display (WMText wm) => Display (AnyObject wm) where
+  displayBuilder o = displayBuilder (o ^. #name)
 
 instance HasID (AnyObject wm) where
   getID (AnyObject a) = objectId a

yaifl/src/Yaifl/Model/Kinds/Room.hs

@@ -11,6 +11,8 @@ module Yaifl.Model.Kinds.Room
   , Room(..)
   , tagRoom
   , voidID
+  , isNotVisited
+  ,
 
   ) where
 
@@ -117,4 +119,9 @@ instance (TaggedAs (Room wm) EnclosingTag) where
   toTag = coerceTag . tagRoom
 
 instance IsObject (Room wm) where
-  isThing = const False
+  isThing = const False
+
+isNotVisited ::
+  RoomData wm
+  -> Bool
+isNotVisited = (/= Visited) . isVisited