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.

1 files changed, 55 insertions, 0 deletions

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 #-}