separate tiled modules out into own package

1 files changed, 66 insertions, 0 deletions

diff --git a/tiled/Data/Tiled/Abstract.hs b/tiled/Data/Tiled/Abstract.hs
new file mode 100644
index 0000000..4b2e15d
--- /dev/null
+++ b/tiled/Data/Tiled/Abstract.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.Tiled.Abstract where
+
+import           Universum
+
+import qualified Data.Vector as V
+import           Data.Tiled       (Layer (..), Object (..), Property (..),
+                              PropertyValue (..), Tile (..), Tiledmap (..),
+                              Tileset (..))
+
+class HasProperties a where
+  getProperties :: a -> [Property]
+  adjustProperties :: ([Property] -> Maybe [Property]) -> a -> a
+
+instance HasProperties Layer where
+  getProperties = maybeToMonoid . layerProperties
+  adjustProperties f layer = layer
+    { layerProperties = f (getProperties layer) }
+
+instance HasProperties Tileset where
+  getProperties = maybeToMonoid . tilesetProperties
+  adjustProperties f tileset = tileset
+    { tilesetProperties = f (getProperties tileset) }
+
+instance HasProperties Tile where
+  getProperties = V.toList . maybeToMonoid . tileProperties
+  adjustProperties f tile = tile
+    { tileProperties = (fmap V.fromList . f) (getProperties tile) }
+
+instance HasProperties Object where
+  getProperties = V.toList . maybeToMonoid . objectProperties
+  adjustProperties f obj = obj
+    { objectProperties = (fmap V.fromList . f) (getProperties obj) }
+
+instance HasProperties Tiledmap where
+  getProperties = maybeToMonoid . tiledmapProperties
+  adjustProperties f tiledmap = tiledmap
+    { tiledmapProperties = f (getProperties tiledmap) }
+
+class HasTypeName a where
+  typeName :: Proxy a -> Text
+instance HasTypeName Layer where
+  typeName _ = "layer"
+instance HasTypeName Tileset where
+  typeName _ = "tileset"
+instance HasTypeName Property where
+  typeName _ = "property"
+
+class HasName a where
+  getName :: a -> Text
+instance HasName Layer where
+  getName = layerName
+instance HasName Tileset where
+  getName = tilesetName
+instance HasName Property where
+  getName (Property n _) = n
+
+class IsProperty a where
+  asProperty :: a -> PropertyValue
+instance IsProperty PropertyValue where
+  asProperty = id
+  {-# INLINE asProperty #-}
+instance IsProperty Text where
+  asProperty = StrProp
+  {-# INLINE asProperty #-}