time to rename every module for some reason

yaifl-city/src/Main.hs

@@ -7,7 +7,7 @@ import Yaifl.Model.Rules.RuleEffects
 import Yaifl.Text.ResponseCollection
 import Breadcrumbs
 import Yaifl.Model.Input
-import Yaifl.Model.Effects
+import Yaifl.Core.Effects
 import Yaifl.Text.Print
 import Yaifl.Model.Rules.Run
 import Yaifl.Text.SayQQ

yaifl-city/src/Yaifl/Gen/City/Apartment.hs

@@ -10,7 +10,7 @@ import Control.Placeholder
 import Yaifl.Model.WorldModel
 import Yaifl.Model.Kinds.Region
 import Yaifl.Game.Create
-import Yaifl.Model.Entity
+import Yaifl.Core.Entity
 import Yaifl.Model.Rules
 import Yaifl.Gen.City.Building
 

yaifl-city/src/Yaifl/Gen/City/ApartmentTower.hs

@@ -13,13 +13,13 @@ import Yaifl.Game.Create.RoomConnection
 import Yaifl.Gen.City.Building
 import Yaifl.Text.DynamicText
 import Yaifl.Model.Kinds
-import Yaifl.Model.Entity
+import Yaifl.Core.Entity
 import Yaifl.Model.Rules
 import System.Random.Stateful
 import Yaifl.Text.AdaptiveNarrative
 import Yaifl.Model.Query
 import Yaifl.Model.Kinds.Door
-import Yaifl.Model.Tag
+import Yaifl.Core.Tag
 import Data.Text (toLower)
 import Yaifl.Game.Create
 import Yaifl
@@ -43,7 +43,7 @@ addStaircases = do
               do
                 let d = fromMaybe (error "not a door") $ getDoorMaybe t
                 pLoc <- getPlayer >>= getLocation
-                getConnectionViaDoor (tag d t) pLoc & \case
+                getConnectionViaDoor (tagEntity d t) pLoc & \case
                   Nothing -> sayTell (display t)
                   Just (r, conn) -> sayTell $ " (leading " <> toLower (show $ view #direction conn) <> ")"
       return (Just r)

yaifl-city/src/Yaifl/Gen/City/Building.hs

@@ -6,16 +6,16 @@ module Yaifl.Gen.City.Building
 ) where
 
 import Yaifl.Prelude
-import Yaifl.Model.Entity
+import Yaifl.Core.Entity
 import Yaifl.Model.Kinds.Region
 import Yaifl.Model.WorldModel
 import Yaifl.Model.Kinds
-import Yaifl.Model.Effects
+import Yaifl.Core.Effects
 import Yaifl.Model.Rules.RuleEffects
-import Yaifl.Model.HasProperty
+import Yaifl.Core.HasProperty
 import Yaifl.Game.Create
 import Yaifl.Model.MultiLocated
-import Yaifl.Model.Kinds.Enclosing
+import Yaifl.Core.Kinds.Enclosing
 import Yaifl.Model.Kinds.Door
 import Yaifl.Text.Say (WithPrintingNameOfSomething)
 import Yaifl.Game.Activities.ListingContents (WithListingContents)

yaifl/src/Yaifl.hs

@@ -16,7 +16,7 @@ module Yaifl (
   , runTurnsFromBuffer
   , runTurn
 
-  , module Yaifl.Model.Metadata
+  , module Yaifl.Core.Metadata
   , module Yaifl.Game.World
   , module Yaifl.Model.WorldModel
   ) where
@@ -35,14 +35,14 @@ import Yaifl.Game.Activities.ChoosingNotableLocaleObjects
 import Yaifl.Game.Activities.ListingContents
 import Yaifl.Game.Activities.PrintingLocaleParagraphAbout
 import Yaifl.Game.Activities.PrintingTheLocaleDescription
-import Yaifl.Model.Metadata
+import Yaifl.Core.Metadata
 import Yaifl.Model.Kinds.Direction
-import Yaifl.Model.Entity
+import Yaifl.Core.Entity
 import Yaifl.Game.ObjectSpecifics
 import Yaifl.Model.Kinds.Container
 import Yaifl.Model.Kinds.Door
-import Yaifl.Model.Kinds.Enclosing
-import Yaifl.Model.HasProperty
+import Yaifl.Core.Kinds.Enclosing
+import Yaifl.Core.HasProperty
 import Yaifl.Model.Kinds.Openable
 import Yaifl.Model.WorldModel
 import Yaifl.Model.Rules.RuleEffects
@@ -64,12 +64,12 @@ import Yaifl.Game.Actions.Collection
 import Breadcrumbs
 import Yaifl.Model.Query (failHorriblyIfMissing)
 import Yaifl.Game.Actions.Examining
-import Yaifl.Model.Store
+import Yaifl.Core.Store
 import Yaifl.Game.Actions.Closing
 import Yaifl.Game.Actions.Opening
-import Yaifl.Model.Kinds.AnyObject
-import Yaifl.Model.Kinds.Thing
-import Yaifl.Model.Kinds.Room
+import Yaifl.Core.Kinds.AnyObject
+import Yaifl.Core.Kinds.Thing
+import Yaifl.Core.Kinds.Room
 import Yaifl.Model.ObjectKind
 import qualified Data.Map as M
 import Yaifl.Model.Input (waitForInput)

yaifl/src/Yaifl/Model/Effects.hs → yaifl/src/Yaifl/Core/Effects.hs

@@ -1,5 +1,5 @@
 {-|
-Module      : Yaifl.Model.Effects
+Module      : Yaifl.Core.Effects
 Copyright   : (c) Avery 2023-2024
 License     : MIT
 Maintainer  : [email protected]
@@ -8,7 +8,7 @@ Effects for getting, setting, modifying, traversing over the `Object` collection
 type synonyms for bundling common constraints together.
 -}
 
-module Yaifl.Model.Effects
+module Yaifl.Core.Effects
   ( -- * Effects
   ObjectLookup(..)
   , lookupThing
@@ -39,12 +39,12 @@ import Breadcrumbs
 import Effectful.Error.Static
 import Effectful.TH
 
-import Yaifl.Model.Metadata
-import Yaifl.Model.Entity
+import Yaifl.Core.Metadata
+import Yaifl.Core.Entity
 import Yaifl.Model.WorldModel
 import Yaifl.Model.Kinds.Region
-import Yaifl.Model.Kinds.Thing
-import Yaifl.Model.Kinds.Room
+import Yaifl.Core.Kinds.Thing
+import Yaifl.Core.Kinds.Room
 
 -- | Effect for reading objects from the world.
 data ObjectLookup (wm :: WorldModel) :: Effect where
@@ -89,7 +89,6 @@ type NoMissingObjects wm es = (WithMetadata es, Error MissingObject :> es, Objec
 -- | Type synonym for reading objects with a way to handle missing IDs.
 type NoMissingRead wm es = (Error MissingObject :> es, ObjectLookup wm :> es, WithMetadata es)
 
-
 withoutMissingObjects ::
   HasCallStack
   => (HasCallStack => Eff (Error MissingObject ': es) a) -- ^ the block

yaifl/src/Yaifl/Model/Entity.hs → yaifl/src/Yaifl/Core/Entity.hs

@@ -1,19 +1,22 @@
 {-|
-Module      : Yaifl.Model.Entity
+Module      : Yaifl.Core.Entity
 Copyright   : (c) Avery 2022-2023
 License     : MIT
 Maintainer  : [email protected]
 
 Object IDs.
 -}
 
-module Yaifl.Model.Entity
+module Yaifl.Core.Entity
   ( -- * Entities
     Entity(..)
   , HasID(..)
   , TaggedEntity(unTag)
   , unsafeTagEntity
   -- ** Tags
+  -- These are here because these ones are foundational enough that they need to be
+  -- forward-declared (things and rooms are foundational, enclosing is required for rooms,
+  -- doors are required for room connections, person is needed for the current player in metadata)
   , ThingTag
   , ThingEntity
   , RoomTag

yaifl/src/Yaifl/Model/HasProperty.hs → yaifl/src/Yaifl/Core/HasProperty.hs

@@ -1,20 +1,18 @@
 {-|
-Module      : Yaifl.Model.HasProperty
-Copyright   : (c) Avery 2023
+Module      : Yaifl.Core.HasProperty
+Copyright   : (c) Avery 2023-2024
 License     : MIT
 Maintainer  : [email protected]
 
 Optics for accessing a property from the sum type of object specifics.
 -}
 
-module Yaifl.Model.HasProperty (
+module Yaifl.Core.HasProperty (
   -- * Has
     MayHaveProperty(..)
-  , WMWithProperty
   ) where
 
 import Yaifl.Prelude
-import Yaifl.Model.WorldModel ( WMObjSpecifics )
 
 -- | An `AffineTraversal` is an optic that focuses on 0-1 objects; it's a `Prism` without
 -- the condition that you can build it back up again..which works great for the possibility
@@ -36,7 +34,4 @@ instance MayHaveProperty a v => MayHaveProperty (Maybe a) v where
       Just y -> Right y)
     (\case
       Nothing -> const Nothing
-      Just a -> \v -> Just $ a & propertyAT .~ v)
-
--- | A helper to define that a world model @wm@ has a Property.
-type WMWithProperty wm v = MayHaveProperty (WMObjSpecifics wm) v
+      Just a -> \v -> Just $ a & propertyAT .~ v)

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

@@ -1,22 +1,23 @@
-module Yaifl.Model.Kinds.AnyObject
+module Yaifl.Core.Kinds.AnyObject
   ( IsObject(..)
   , CanBeAny(..)
   , AnyObject(..)
   , _Room
   , _Thing
   , TaggedAnyEnclosing
   , EnclosingThing
+  , asThingOrRoom
   ) where
 
 import Yaifl.Prelude
 
 import GHC.Records
-import Yaifl.Model.Entity
-import Yaifl.Model.Kinds.Object
-import Yaifl.Model.Kinds.Room
-import Yaifl.Model.Kinds.Thing
+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.Model.Tag
 
 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
@@ -61,4 +62,22 @@ instance CanBeAny wm (AnyObject wm) where
 instance IsObject (AnyObject wm) where
   isThing = isJust . fromAny @wm @(Thing wm)
 
-type TaggedAnyEnclosing wm = TaggedObject (AnyObject wm) EnclosingTag
+type TaggedAnyEnclosing wm = TaggedObject (AnyObject wm) EnclosingTag
+
+unwrapAny ::
+  AnyObject wm
+  -> Either (TaggedEntity ThingTag) (TaggedEntity RoomTag)
+unwrapAny a = case (preview _Thing a, preview _Room a) of
+    (Just x, _) -> Left (tagEntity x (a ^. #objectId))
+    (_, Just x) -> Right (tagEntity x (a ^. #objectId))
+    _ -> error "impossible"
+
+asThingOrRoom ::
+  (Thing wm -> a)
+  -> (Room wm -> a)
+  -> AnyObject wm
+  -> a
+asThingOrRoom tf rf a = case (preview _Thing a, preview _Room a) of
+    (Just x, _) -> tf x
+    (_, Just x) -> rf x
+    _ -> error "impossible"

yaifl/src/Yaifl/Model/Kinds/Enclosing.hs → yaifl/src/Yaifl/Core/Kinds/Enclosing.hs

@@ -1,13 +1,13 @@
 {-|
-Module      : Yaifl.Model.Kinds.Enclosing
+Module      : Yaifl.Core.Kinds.Enclosing
 Copyright   : (c) Avery 2023
 License     : MIT
 Maintainer  : [email protected]
 
 A property component for things that can contain other things (rooms, supporters, containers, etc).
 -}
 
-module Yaifl.Model.Kinds.Enclosing (
+module Yaifl.Core.Kinds.Enclosing (
   -- * Enclosing
     Enclosing(..)
   , blankEnclosing
@@ -16,8 +16,8 @@ module Yaifl.Model.Kinds.Enclosing (
 import Yaifl.Prelude
 
 import Data.EnumSet ( EnumSet, empty )
-import Yaifl.Model.Entity
-import Yaifl.Model.Tag
+import Yaifl.Core.Entity
+import Yaifl.Core.Tag
 
 -- | A component that contains other objects.
 data Enclosing = Enclosing

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

@@ -1,13 +1,13 @@
 {-|
-Module      : Yaifl.Model.Kinds.Object
+Module      : Yaifl.Core.Kinds.Object
 Copyright   : (c) Avery 2023-2024
 License     : MIT
 Maintainer  : [email protected]
 
 A game object (a thing or a room).
 -}
 
-module Yaifl.Model.Kinds.Object (
+module Yaifl.Core.Kinds.Object (
   -- * Pointed sets
   Pointed(..)
   -- * Objects
@@ -25,7 +25,7 @@ module Yaifl.Model.Kinds.Object (
   ) where
 
 import Yaifl.Prelude
-import Yaifl.Model.Entity
+import Yaifl.Core.Entity
 import Yaifl.Model.WorldModel (WMText)
 
 -- | If the object has a pluralised name.
@@ -40,7 +40,7 @@ data NameProperness = Improper | Proper
 data NamePrivacy = PrivatelyNamed | PubliclyNamed
   deriving stock (Show, Eq, Ord, Bounded, Enum, Generic, Read)
 
--- | See also `Yaifl.Model.Metadata.typeDAG`. An object type is just a string that has some relations to other types.
+-- | See also `Yaifl.Core.Metadata.typeDAG`. An object type is just a string that has some relations to other types.
 -- there is no data or polymorphism connected to a type, so it's very possible to call something a supporter without
 -- having some supporter properties.
 newtype ObjectKind = ObjectKind

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

@@ -1,4 +1,4 @@
-module Yaifl.Model.Kinds.Room
+module Yaifl.Core.Kinds.Room
   ( ConnectionExplicitness(..)
   , Connection(..)
   , MapConnections(..)
@@ -9,20 +9,21 @@ module Yaifl.Model.Kinds.Room
   , IsVisited(..)
   , blankRoomData
   , Room(..)
-  , tagRoom
+  , tagRoomEntity
   , voidID
   , isNotVisited
   , roomIsLighted
+  , isVoid
 
   ) where
 
 import Yaifl.Prelude
 
 import GHC.Records
-import Yaifl.Model.Entity
-import Yaifl.Model.Kinds.Enclosing
-import Yaifl.Model.Kinds.Object
-import Yaifl.Model.Tag
+import Yaifl.Core.Entity
+import Yaifl.Core.Kinds.Enclosing
+import Yaifl.Core.Kinds.Object
+import Yaifl.Core.Tag
 import Yaifl.Model.WorldModel
 import qualified Data.Map.Strict as Map
 
@@ -114,10 +115,10 @@ instance Taggable (Room wm) EnclosingTag
 instance Taggable (Room wm) RoomTag
 
 -- | Tag a room entity.
-tagRoom ::
+tagRoomEntity ::
   Room wm
   -> TaggedEntity RoomTag
-tagRoom r = tagEntity r (r ^. #objectId)
+tagRoomEntity r = tagEntity r (r ^. #objectId)
 
 instance IsObject (Room wm) where
   isThing = const False
@@ -130,4 +131,10 @@ isNotVisited = (/= Visited) . isVisited
 roomIsLighted ::
   Room wm
   -> Bool
-roomIsLighted = (== Lighted) . view (#objectData % #darkness)
+roomIsLighted = (== Lighted) . view (#objectData % #darkness)
+
+isVoid ::
+  HasID a
+  => a
+  -> Bool
+isVoid = (unTag voidID ==) . getID