Add 'users/glittershark/xanthous/' from commit '53b56744f4335c038724a1bcffc27a7eb8cf6a6d' r/978

git-subtree-dir: users/glittershark/xanthous
git-subtree-mainline: 91f53f02d8479303910abfd3f3690d3ef27e6c4b
git-subtree-split: 53b56744f4335c038724a1bcffc27a7eb8cf6a6d

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