From 6cfdefc3438100ea829b1c86e790a0f2d56ec503 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 4 Dec 2021 04:33:01 +0100
Subject: lots of code reorganising and some deduplication

it was kinda getting messy in places.

Also found some accidental isomorphisms between types, so these are now
only one type because the consequences were getting silly.
---
 lib/TiledAbstract.hs | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 55 insertions(+)
 create mode 100644 lib/TiledAbstract.hs

(limited to 'lib/TiledAbstract.hs')

diff --git a/lib/TiledAbstract.hs b/lib/TiledAbstract.hs
new file mode 100644
index 0000000..f7bbbb9
--- /dev/null
+++ b/lib/TiledAbstract.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module TiledAbstract where
+
+import           Data.Maybe (fromMaybe)
+import           Data.Proxy (Proxy)
+import           Data.Text  (Text)
+import           Tiled      (Layer (..), Property (..), PropertyValue (..),
+                             Tiledmap (..), Tileset (..))
+
+class HasProperties a where
+  getProperties :: a -> [Property]
+  adjustProperties :: ([Property] -> Maybe [Property]) -> a -> a
+
+instance HasProperties Layer where
+  getProperties = fromMaybe mempty . layerProperties
+  adjustProperties f layer = layer
+    { layerProperties = f (getProperties layer) }
+
+instance HasProperties Tileset where
+  getProperties = fromMaybe mempty . tilesetProperties
+  adjustProperties f tileset = tileset
+    { tilesetProperties = f (getProperties tileset) }
+
+instance HasProperties Tiledmap where
+  getProperties = fromMaybe mempty . 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