diff options
Diffstat (limited to 'users/glittershark/xanthous/src/Xanthous/Entities/Raws.hs')
-rw-r--r-- | users/glittershark/xanthous/src/Xanthous/Entities/Raws.hs | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/users/glittershark/xanthous/src/Xanthous/Entities/Raws.hs b/users/glittershark/xanthous/src/Xanthous/Entities/Raws.hs new file mode 100644 index 000000000000..d4cae7ccc299 --- /dev/null +++ b/users/glittershark/xanthous/src/Xanthous/Entities/Raws.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Raws + ( raws + , raw + , RawType(..) + , rawsWithType + , entityFromRaw + ) where +-------------------------------------------------------------------------------- +import Data.FileEmbed +import qualified Data.Yaml as Yaml +import Xanthous.Prelude +import System.FilePath.Posix +-------------------------------------------------------------------------------- +import Xanthous.Entities.RawTypes +import Xanthous.Game.State +import qualified Xanthous.Entities.Creature as Creature +import qualified Xanthous.Entities.Item as Item +import Xanthous.AI.Gormlak () +-------------------------------------------------------------------------------- +rawRaws :: [(FilePath, ByteString)] +rawRaws = $(embedDir "src/Xanthous/Entities/Raws") + +raws :: HashMap Text EntityRaw +raws + = mapFromList + . map (bimap + (pack . takeBaseName) + (either (error . Yaml.prettyPrintParseException) id + . Yaml.decodeEither')) + $ rawRaws + +raw :: Text -> Maybe EntityRaw +raw n = raws ^. at n + +class RawType (a :: Type) where + _RawType :: Prism' EntityRaw a + +instance RawType CreatureType where + _RawType = prism' Creature $ \case + Creature c -> Just c + _ -> Nothing + +instance RawType ItemType where + _RawType = prism' Item $ \case + Item i -> Just i + _ -> Nothing + +rawsWithType :: forall a. RawType a => HashMap Text a +rawsWithType = mapFromList . itoListOf (ifolded . _RawType) $ raws + +-------------------------------------------------------------------------------- + +entityFromRaw :: EntityRaw -> SomeEntity +entityFromRaw (Creature creatureType) + = SomeEntity $ Creature.newWithType creatureType +entityFromRaw (Item itemType) + = SomeEntity $ Item.newWithType itemType |