From 8a201e8658c9365d301a7cda9077ddf005b014c9 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 28 Feb 2022 00:39:54 +0100
Subject: separate tiled modules out into own package

---
 tiled/Data/Tiled/Abstract.hs | 66 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 66 insertions(+)
 create mode 100644 tiled/Data/Tiled/Abstract.hs

(limited to 'tiled/Data/Tiled')

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 #-}
-- 
cgit v1.2.3