Move some more things

yaifl/src/Yaifl.hs

@@ -18,7 +18,7 @@ module Yaifl (
 
   , module Yaifl.Core.Metadata
   , module Yaifl.Game.World
-  , module Yaifl.Model.WorldModel
+  , module Yaifl.Core.WorldModel
   ) where
 
 import Yaifl.Prelude hiding ( Reader, runReader )
@@ -43,7 +43,7 @@ import Yaifl.Model.Kinds.Container
 import Yaifl.Model.Kinds.Door
 import Yaifl.Core.Kinds.Enclosing
 import Yaifl.Model.Kinds.Openable
-import Yaifl.Model.WorldModel
+import Yaifl.Core.WorldModel
 import Yaifl.Model.Rules.RuleEffects
 import Yaifl.Game.WhenPlayBegins
 import Yaifl.Text.AdaptiveNarrative (blankAdaptiveNarrative)
@@ -56,7 +56,7 @@ import qualified Data.Map as DM
 import qualified Data.Text as T
 import Yaifl.Text.ListWriter
 import Yaifl.Game.Actions.OutOfWorld
-import Yaifl.Model.Actions.Args
+import Yaifl.Core.Actions.Args
 import Yaifl.Game.EffectHandlers
 import Yaifl.Text.DynamicText
 import Yaifl.Game.Actions.Collection
@@ -76,7 +76,7 @@ import Yaifl.Game.Actions.Taking
 import Yaifl.Model.Kinds.Device
 import Yaifl.Game.Activities.PrintingRoomDescriptionDetails
 import qualified Data.Set as S
-import Yaifl.Game.TurnSequence (turnSequenceRules, everyTurnRules)
+import Yaifl.Game.TurnSequence (turnSequenceRules, everyTurnRulesImpl)
 import Yaifl.Model.Rules.Run
 import System.Random.Stateful
 import Yaifl.Game.Actions.Entering (enteringAction)
@@ -86,6 +86,7 @@ import Yaifl.Game.Actions.GettingOff (gettingOffAction)
 import Yaifl.Game.Accessibility
 import Yaifl.Model.Kinds.Person
 import Yaifl.Core.Effects
+import Yaifl.Core.Actions.GoesWith
 
 type PlainWorldModel = 'WorldModel ObjectSpecifics Direction () () ActivityCollection ResponseCollection DynamicText
 
@@ -163,7 +164,7 @@ blankActions = WorldActions
   , whenPlayBegins = whenPlayBeginsRules
   , actionProcessing = actionProcessingRules
   , turnSequence = turnSequenceRules
-  , everyTurn = everyTurnRules
+  , everyTurnRules = everyTurnRulesImpl
   , accessibilityRules = accessibility
   }
 

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

@@ -0,0 +1,99 @@
+module Yaifl.Core.Actions.Args
+  ( Args(..)
+  , ArgsHaveMainObject(..)
+  , ArgsMightHaveMainObject(..)
+  , Refreshable(..)
+  , ActionOptions(..)
+  , UnverifiedArgs(..)
+  , getActorLocation
+  , silentAction
+  , unlessSilent
+  , normalAction
+  ) where
+
+import Yaifl.Prelude hiding (show)
+
+import Yaifl.Core.Kinds.Object
+import Yaifl.Core.Effects
+import Yaifl.Core.Kinds.Thing
+import Yaifl.Core.Kinds.Room
+import Yaifl.Core.Refreshable
+import Yaifl.Core.Query.Enclosing
+import Yaifl.Core.Actions.GoesWith
+
+data ActionOptions wm = ActionOptions
+  { silently :: Bool
+  , hidePrompt :: Bool
+  } deriving stock (Eq, Ord, Generic)
+
+-- | Arguments for an action, activity, or rulebook.
+data Args wm v = Args
+  { source :: Thing wm
+  , variables :: v
+  , actionOptions :: ActionOptions wm
+  , timestamp :: Timestamp
+  } deriving stock (Eq, Ord, Generic)
+
+instance Display (Args wm v) where
+  displayBuilder = const "args"
+
+instance {-# OVERLAPPING #-} Refreshable wm v => Refreshable wm (Args wm v) where
+  refresh av = do
+    v <- refresh (variables av)
+    o <- refresh $ source av
+    return $ av { source = o, variables = v }
+
+-- | Before 'Args' are parsed, the variable is just a command string
+-- the action has to parse them, ideally into some intermediary mix of `ArgSubject`.
+newtype UnverifiedArgs wm (goesWith :: ActionParameterType) = UnverifiedArgs
+  { unArgs :: Args wm (ActionParameter wm goesWith, [(Text, NamedActionParameter wm)])
+  } deriving newtype (Generic)
+
+makeFieldLabelsNoPrefix ''Args
+makeFieldLabelsNoPrefix ''UnverifiedArgs
+
+instance Functor (Args wm) where
+  fmap f = #variables %~ f
+
+silentAction :: ActionOptions wm
+silentAction = ActionOptions True True
+
+normalAction :: ActionOptions wm
+normalAction = ActionOptions False False
+
+unlessSilent ::
+  Applicative m
+  => Args wm v
+  -> m ()
+  -> m ()
+unlessSilent args = unless (silently . actionOptions $ args)
+class ArgsHaveMainObject argVars obj | argVars -> obj where
+  argsMainObject :: Lens' argVars obj
+
+class ArgsMightHaveMainObject argVars obj | argVars -> obj where
+  argsMainObjectMaybe :: AffineTraversal' argVars obj
+
+instance ArgsHaveMainObject a a where
+  argsMainObject = castOptic $ iso id id
+
+instance (ArgsHaveMainObject vars o) => ArgsHaveMainObject (Args wm vars) o where
+  argsMainObject = #variables % argsMainObject
+
+instance (ArgsHaveMainObject vars o) => ArgsMightHaveMainObject (Args wm vars) o where
+  argsMainObjectMaybe = #variables % argsMainObjectMaybe
+
+instance {-# OVERLAPS #-} (ArgsHaveMainObject vars o) => ArgsMightHaveMainObject vars o where
+  argsMainObjectMaybe = castOptic argsMainObject
+
+-- alas, this throws issues with type families in instances
+-- instance ArgsHaveMainObject (UnverifiedArgs wm goesWith) (ActionParameter wm goesWith)
+getNoun ::
+  UnverifiedArgs wm goesWith
+  -> ActionParameter wm goesWith
+getNoun = fst . variables . unArgs
+
+getActorLocation ::
+  NoMissingObjects wm es
+  => Args wm v
+  -> Eff es (Room wm)
+getActorLocation args = getLocation $ source args

yaifl/src/Yaifl/Model/Actions/Args.hs → yaifl/src/Yaifl/Core/Actions/GoesWith.hs

@@ -1,43 +1,19 @@
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 
-module Yaifl.Model.Actions.Args
-  ( Args(..)
-  , ArgsHaveMainObject(..)
-  , ArgsMightHaveMainObject(..)
-  , Refreshable(..)
+module Yaifl.Core.Actions.GoesWith
+  ( ActionParameterType(..)
   , ActionParameter
   , NamedActionParameter(..)
-  , ActionOptions(..)
-  , UnverifiedArgs(..)
-  , ActionParameterType(..)
   , GoesWith(..)
-  --, withPlayerSource
-  , getPlayer
-  , getPlayer'
-  , getActorLocation
-  , silentAction
-  , unlessSilent
-  , normalAction
-  --, blankArgs
-  --, playerArgs
-  --, getActionParameter
-  --, getNoun
   ) where
 
 import Yaifl.Prelude hiding (show)
 
-import Yaifl.Core.Kinds.Object
-import Yaifl.Model.WorldModel
-import Yaifl.Core.Effects
+import Yaifl.Core.WorldModel
 import GHC.Show
 import qualified Data.Set as S
 import Yaifl.Core.Kinds.Thing
 import Yaifl.Core.Kinds.AnyObject
-import Yaifl.Core.Kinds.Room
-import Yaifl.Model.Query
-import Yaifl.Model.Kinds.Person
-import Yaifl.Core.Refreshable
-import Yaifl.Core.Query.Enclosing
 
 data ActionParameterType =
   TakesNoParameter
@@ -124,81 +100,4 @@ instance GoesWith 'TakesConstantParameter where
 
 instance (GoesWith a, GoesWith b) => GoesWith ('TakesOneOf a b) where
   goesWithA _ = TakesOneOf (goesWithA (Proxy @a)) (goesWithA (Proxy @b))
-  tryParseArguments _ s = (Left <$> tryParseArguments (Proxy @a) s) <|> (Right <$> tryParseArguments (Proxy @b) s)
-
-data ActionOptions wm = ActionOptions
-  { silently :: Bool
-  , hidePrompt :: Bool
-  } deriving stock (Eq, Ord, Generic)
-
-silentAction :: ActionOptions wm
-silentAction = ActionOptions True True
-
-normalAction :: ActionOptions wm
-normalAction = ActionOptions False False
-
-unlessSilent ::
-  Applicative m
-  => Args wm v
-  -> m ()
-  -> m ()
-unlessSilent args = unless (silently . actionOptions $ args)
-
--- | Arguments for an action, activity, or rulebook.
-data Args wm v = Args
-  { source :: Thing wm
-  , variables :: v
-  , actionOptions :: ActionOptions wm
-  , timestamp :: Timestamp
-  } deriving stock (Eq, Ord, Generic)
-
-instance Display (Args wm v) where
-  displayBuilder = const "args"
-
-instance {-# OVERLAPPING #-} Refreshable wm v => Refreshable wm (Args wm v) where
-  refresh av = do
-    v <- refresh (variables av)
-    o <- refresh $ source av
-    return $ av { source = o, variables = v }
-
--- | Before 'Args' are parsed, the variable is just a command string
--- the action has to parse them, ideally into some intermediary mix of `ArgSubject`.
-newtype UnverifiedArgs wm (goesWith :: ActionParameterType) = UnverifiedArgs
-  { unArgs :: Args wm (ActionParameter wm goesWith, [(Text, NamedActionParameter wm)])
-  } deriving newtype (Generic)
-
-makeFieldLabelsNoPrefix ''Args
-
-class ArgsHaveMainObject argVars obj | argVars -> obj where
-  argsMainObject :: Lens' argVars obj
-
-class ArgsMightHaveMainObject argVars obj | argVars -> obj where
-  argsMainObjectMaybe :: AffineTraversal' argVars obj
-
-instance ArgsHaveMainObject a a where
-  argsMainObject = castOptic $ iso id id
-
-instance (ArgsHaveMainObject vars o) => ArgsHaveMainObject (Args wm vars) o where
-  argsMainObject = #variables % argsMainObject
-
-instance (ArgsHaveMainObject vars o) => ArgsMightHaveMainObject (Args wm vars) o where
-  argsMainObjectMaybe = #variables % argsMainObjectMaybe
-
-instance {-# OVERLAPS #-} (ArgsHaveMainObject vars o) => ArgsMightHaveMainObject vars o where
-  argsMainObjectMaybe = castOptic argsMainObject
-
--- alas, this throws issues with type families in instances
--- instance ArgsHaveMainObject (UnverifiedArgs wm goesWith) (ActionParameter wm goesWith)
-getNoun ::
-  UnverifiedArgs wm goesWith
-  -> ActionParameter wm goesWith
-getNoun = fst . variables . unArgs
-
-getActorLocation ::
-  NoMissingObjects wm es
-  => Args wm v
-  -> Eff es (Room wm)
-getActorLocation args = getLocation $ source args
-
-instance Functor (Args wm) where
-  fmap f = #variables %~ f
+  tryParseArguments _ s = (Left <$> tryParseArguments (Proxy @a) s) <|> (Right <$> tryParseArguments (Proxy @b) s)

yaifl/src/Yaifl/Core/Effects.hs

@@ -39,12 +39,12 @@ import Breadcrumbs
 import Effectful.Error.Static
 import Effectful.TH
 
-import Yaifl.Core.Metadata
 import Yaifl.Core.Entity
-import Yaifl.Model.WorldModel
-import Yaifl.Model.Kinds.Region
-import Yaifl.Core.Kinds.Thing
 import Yaifl.Core.Kinds.Room
+import Yaifl.Core.Kinds.Thing
+import Yaifl.Core.Metadata
+import Yaifl.Core.WorldModel
+import Yaifl.Model.Kinds.Region
 
 -- | Effect for reading objects from the world.
 data ObjectLookup (wm :: WorldModel) :: Effect where

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

@@ -12,13 +12,14 @@ module Yaifl.Core.Kinds.AnyObject
 
 import Yaifl.Prelude
 
+
 import GHC.Records
 import Yaifl.Core.Entity
 import Yaifl.Core.Kinds.Object
-import Yaifl.Core.Tag
 import Yaifl.Core.Kinds.Room
 import Yaifl.Core.Kinds.Thing
-import Yaifl.Model.WorldModel
+import Yaifl.Core.Tag
+import Yaifl.Core.WorldModel
 
 type RawAnyObject wm = Object wm (Either (ThingData wm) (RoomData wm)) (WMObjSpecifics wm)
 -- | Either a room or a thing. The `Either` is over the object data so it's easier to

yaifl/src/Yaifl/Core/Kinds/Object.hs

@@ -26,7 +26,7 @@ module Yaifl.Core.Kinds.Object (
 
 import Yaifl.Prelude
 import Yaifl.Core.Entity
-import Yaifl.Model.WorldModel (WMText)
+import Yaifl.Core.WorldModel (WMText)
 
 -- | If the object has a pluralised name.
 data NamePlurality = SingularNamed | PluralNamed

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

@@ -24,7 +24,7 @@ import Yaifl.Core.Entity
 import Yaifl.Core.Kinds.Enclosing
 import Yaifl.Core.Kinds.Object
 import Yaifl.Core.Tag
-import Yaifl.Model.WorldModel
+import Yaifl.Core.WorldModel
 import qualified Data.Map.Strict as Map
 
 -- | Whether a connection was made by the user or simply assumed (we can override assumed connections but

yaifl/src/Yaifl/Core/Kinds/Thing.hs

@@ -20,12 +20,13 @@ module Yaifl.Core.Kinds.Thing
   ) where
 
 import Yaifl.Prelude
+
+import GHC.Records
 import Yaifl.Core.Entity
-import Yaifl.Core.Tag
-import Yaifl.Core.Kinds.Room
-import Yaifl.Model.WorldModel
 import Yaifl.Core.Kinds.Object
-import GHC.Records
+import Yaifl.Core.Kinds.Room
+import Yaifl.Core.Tag
+import Yaifl.Core.WorldModel
 
 -- | If a thing provides light outwards; A lamp is lit, but a closed box with a light inside is not.
 data ThingLit = Lit | NotLit

yaifl/src/Yaifl/Core/Metadata.hs

@@ -42,9 +42,11 @@ module Yaifl.Core.Metadata (
   , randomR
   ) where
 
-import Breadcrumbs
-import Data.Text.Display
+
 import Yaifl.Prelude
+
+import Breadcrumbs
+
 import Yaifl.Core.Entity
 import Yaifl.Core.Kinds.Object
 import Yaifl.Model.ObjectKind

yaifl/src/Yaifl/Core/Query/Enclosing.hs

@@ -19,19 +19,20 @@ import Yaifl.Prelude
 
 import Data.List.NonEmpty as NE (cons)
 
-import Yaifl.Core.Kinds.Object
+
 import Yaifl.Core.Effects
 import Yaifl.Core.Entity
-import Yaifl.Core.ObjectLike
-import Yaifl.Core.Kinds.Thing
-import Yaifl.Core.Kinds.Room
 import Yaifl.Core.Kinds.AnyObject
+import Yaifl.Core.Kinds.Enclosing
+import Yaifl.Core.Kinds.Object
+import Yaifl.Core.Kinds.Room
+import Yaifl.Core.Kinds.Thing
+import Yaifl.Core.ObjectLike
+import Yaifl.Core.Query.Property
 import Yaifl.Core.Tag
-
+import Yaifl.Core.WorldModel
+import Yaifl.Core.Query.Object
 import qualified Data.EnumSet as ES
-import Yaifl.Core.Kinds.Enclosing
-import Yaifl.Model.WorldModel
-import Yaifl.Model.Query
 
 data IncludeScenery = IncludeScenery | ExcludeScenery
 data IncludeDoors = IncludeDoors | ExcludeDoors