summaryrefslogtreecommitdiff
path: root/tiled/Data/Tiled
diff options
context:
space:
mode:
Diffstat (limited to 'tiled/Data/Tiled')
-rw-r--r--tiled/Data/Tiled/Abstract.hs66
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 #-}