diff options
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/App/Common.hs')
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/App/Common.hs | 67 |
1 files changed, 0 insertions, 67 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/App/Common.hs b/users/grfn/xanthous/src/Xanthous/App/Common.hs deleted file mode 100644 index 69ba6f0e0596..000000000000 --- a/users/grfn/xanthous/src/Xanthous/App/Common.hs +++ /dev/null @@ -1,67 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.App.Common - ( describeEntities - , describeEntitiesAt - , entitiesAtPositionWithType - - -- * Re-exports - , MonadState - , MonadRandom - , EntityMap - , module Xanthous.Game.Lenses - , module Xanthous.Monad - ) where --------------------------------------------------------------------------------- -import Xanthous.Prelude --------------------------------------------------------------------------------- -import Data.Aeson (object) -import qualified Data.Aeson as A -import Control.Monad.State (MonadState) -import Control.Monad.Random (MonadRandom) --------------------------------------------------------------------------------- -import Xanthous.Data (Position, positioned) -import Xanthous.Data.EntityMap (EntityMap) -import qualified Xanthous.Data.EntityMap as EntityMap -import Xanthous.Game -import Xanthous.Game.Lenses -import Xanthous.Game.State -import Xanthous.Monad -import Xanthous.Entities.Character (Character) -import Xanthous.Util.Inflection (toSentence) --------------------------------------------------------------------------------- - -entitiesAtPositionWithType - :: forall a. (Entity a, Typeable a) - => Position - -> EntityMap SomeEntity - -> [(EntityMap.EntityID, a)] -entitiesAtPositionWithType pos em = - let someEnts = EntityMap.atPositionWithIDs pos em - in flip foldMap someEnts $ \(eid, view positioned -> se) -> - case downcastEntity @a se of - Just e -> [(eid, e)] - Nothing -> [] - -describeEntitiesAt :: (MonadState GameState m, MonadRandom m) => Position -> m () -describeEntitiesAt pos = - use ( entities - . EntityMap.atPosition pos - . to (filter (not . entityIs @Character)) - ) >>= \case - Empty -> pure () - ents -> describeEntities ents - -describeEntities - :: ( Entity entity - , MonadRandom m - , MonadState GameState m - , MonoFoldable (f Text) - , Functor f - , Element (f Text) ~ Text - ) - => f entity - -> m () -describeEntities ents = - let descriptions = description <$> ents - in say ["entities", "description"] - $ object ["entityDescriptions" A..= toSentence descriptions] |