From 77d1f4ce4eb3ba40d884cc4ed7fa693e16538c8d Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 18 Sep 2021 01:34:36 +0200
Subject: type check properties

/finally/ figured out that all properties just look like {name, value,
type} so now that's abstracted away and Properties.hs doesn't look like
javascript anymore
---
 lib/Tiled2.hs | 26 +++++++++++++++++++++++++-
 1 file changed, 25 insertions(+), 1 deletion(-)

(limited to 'lib/Tiled2.hs')

diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs
index bc752a5..20886bd 100644
--- a/lib/Tiled2.hs
+++ b/lib/Tiled2.hs
@@ -8,6 +8,7 @@
 -- cover some of the types and records that are available in the format. For
 -- those you should read the TMX documentation at
 -- http://doc.mapeditor.org/en/latest/reference/tmx-map-format/
+{-# LANGUAGE NamedFieldPuns #-}
 module Tiled2 where
 
 import           Control.Applicative        ((<|>))
@@ -66,6 +67,29 @@ parseDefault :: FromJSON a => A.Object -> Text -> a -> Parser a
 parseDefault o s d = fromMaybe d <$> o .:? s
 
 
+-- | workadventure custom property
+data Property = Property { propertyName :: Text
+                         --, propertyType :: Text (unnecessary since always string)
+                         , propertyValue :: Text
+                         } deriving (Eq, Generic, Show)
+
+instance FromJSON Property where
+  parseJSON (A.Object o) = do
+    propertyType <- o .: "type"
+    if propertyType /= A.String "string"
+      then typeMismatch "type" "string"
+      else do
+        propertyName <- o .: "name"
+        propertyValue <- o .: "value"
+        pure $ Property { propertyName, propertyValue }
+  parseJSON invalid = typeMismatch "Property" invalid
+
+instance ToJSON Property where
+  toJSON prop = object [ "type" .= A.String "string"
+                       , "name" .= propertyName prop
+                       , "value" .= propertyName prop
+                       ]
+
 data Object = Object { objectId         :: Int
                        -- ^ Incremental id - unique across all objects
                      , objectWidth      :: Double
@@ -154,7 +178,7 @@ data Layer = Layer { layerWidth      :: Double
                      -- ^ Array of GIDs. tilelayer only.
                    , layerObjects    :: Maybe (Vector Object)
                      -- ^ Array of Objects. objectgroup only.
-                   , layerProperties :: [Map Text Value]
+                   , layerProperties :: [Property]
                      -- ^ string key-value pairs.
                    , layerOpacity    :: Float
                      -- ^ Value between 0 and 1
-- 
cgit v1.2.3