support for properties that aren't strings

apparently i couldn't read or something?

1 files changed, 29 insertions, 13 deletions

diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs
index c751cdc..c3bf401 100644
--- a/lib/Tiled2.hs
+++ b/lib/Tiled2.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings          #-}
@@ -24,6 +25,7 @@ import           Data.Text                  (Text)
 import           Data.Vector                (Vector)
 import           GHC.Exts                   (fromList, toList)
 import           GHC.Generics               (Generic)
+import Data.Functor ((<&>))
 
 
 -- | A globally indexed identifier.
@@ -67,28 +69,42 @@ parseDefault :: FromJSON a => A.Object -> Text -> a -> Parser a
 parseDefault o s d = fromMaybe d <$> o .:? s
 
 
--- | workadventure custom property
+{-- | workadventure custom property
 data Property = Property { propertyName  :: Text
                          --, propertyType :: Text (unnecessary since always string)
                          , propertyValue :: Text
                          } deriving (Eq, Generic, Show)
+-}
+
+data PropertyValue = StrProp Text | BoolProp Bool
+  deriving (Eq, Generic, Show)
+data Property = Property Text PropertyValue
+  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 }
+    name <- o .: "name"
+    o .: "type" >>= \case
+      A.String "string" -> do
+        val <- o .: "value"
+        pure $ Property name (StrProp val)
+      A.String "bool" -> do
+        val <- o .: "value"
+        pure $ Property name (BoolProp val)
+      ty -> fail $ "properties can only have type string or bool, but encountered " <> show ty
   parseJSON invalid = typeMismatch "Property" invalid
 
 instance ToJSON Property where
-  toJSON prop = object [ "type" .= A.String "string"
-                       , "name" .= propertyName prop
-                       , "value" .= propertyName prop
-                       ]
+  toJSON (Property name val) = case val of
+    StrProp str -> object [ "type" .= A.String "string"
+                          , "name" .= name
+                          , "value" .= str
+                          ]
+    BoolProp bool -> object [ "type" .= A.String "bool"
+                            , "name" .= name
+                            , "value" .= bool
+                            ]
 
 data Object = Object { objectId         :: Int
                        -- ^ Incremental id - unique across all objects
@@ -196,7 +212,7 @@ instance FromJSON Layer where
                                  <*>  o .: "y"
                                  <*> (o .: "data"       <|> pure Nothing)
                                  <*> o .:? "objects"
-                                 <*> (o .: "properties" <|> pure mempty)
+                                 <*> (o .:? "properties" <&> fromMaybe [])
                                  <*>  o .: "opacity"
                                  <*> (o .: "draworder"  <|> pure "topdown")
   parseJSON invalid = typeMismatch "Layer" invalid