diff options
author | stuebinm | 2021-12-04 04:33:01 +0100 |
---|---|---|
committer | stuebinm | 2021-12-04 04:34:11 +0100 |
commit | 6cfdefc3438100ea829b1c86e790a0f2d56ec503 (patch) | |
tree | 04a190c2ddddcfa317bb5fda326f8e6fcaaa7eff /lib/TiledAbstract.hs | |
parent | c61f8b2ac2ecf5ff96401e1a913d41a6d5a4a343 (diff) |
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.
Diffstat (limited to '')
-rw-r--r-- | lib/TiledAbstract.hs | 55 |
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 #-} |