separate tiled modules out into own package

1 files changed, 85 insertions, 0 deletions

diff --git a/tiled/Data/Tiled/Abstract.hs b/tiled/Data/Tiled/Abstract.hs
new file mode 100644
index 0000000..5a5b7c0
--- /dev/null
+++ b/tiled/Data/Tiled/Abstract.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.Tiled.Abstract where
+
+import           Universum
+
+import qualified Data.Vector as V
+import           Data.Tiled  (GlobalId, Layer (..), Object (..), Property (..),
+                              PropertyValue (..), Tile (..), Tiledmap (..),
+                              Tileset (..), mkTiledId)
+import           Util        (showText)
+
+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 HasData a where
+  getData :: a -> Maybe (Vector GlobalId)
+instance HasData Layer where
+  getData = layerData
+instance HasData Tile where
+  getData _ = Nothing
+
+
+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
+instance HasName Tile where
+  getName tile = "[tile with global id " <> showText (tileId tile) <> "]"
+
+
+class IsProperty a where
+  asProperty :: a -> PropertyValue
+instance IsProperty PropertyValue where
+  asProperty = id
+  {-# INLINE asProperty #-}
+instance IsProperty Text where
+  asProperty = StrProp
+  {-# INLINE asProperty #-}
+
+
+layerIsEmpty :: HasData a => a -> Bool
+layerIsEmpty layer = case getData layer of
+  Nothing -> True
+  Just d  -> all ((==) $ mkTiledId 0) d