From 34488ce52bca4031a81c57b9b1ee79ce5c4858c6 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Tue, 14 Dec 2021 00:14:12 +0100
Subject: audioVolumne is of type float, not int

also, float properties exist, apparently
---
 lib/Properties.hs | 23 +++++++++++++++++++----
 lib/Tiled.hs      | 36 ++++++++++++++++++++++++------------
 2 files changed, 43 insertions(+), 16 deletions(-)

diff --git a/lib/Properties.hs b/lib/Properties.hs
index db4908e..592aac4 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -297,7 +297,7 @@ checkTileLayerProperty p@(Property name _value) = case name of
     "playAudioLoop" ->
       deprecatedUseInstead "audioLoop"
     "audioVolume" -> do
-      isBool p
+      isOrdInRange unwrapFloat 0 1 p
       requireProperty "playAudio"
     "openWebsite" -> do
       uselessEmptyLayer
@@ -502,6 +502,12 @@ unwrapInt (Property name value) f = case value of
   _ -> complain $ "type error: property " <> prettyprint name
                <> " should be of type int."
 
+unwrapFloat :: Property -> (Float -> LintWriter a) -> LintWriter a
+unwrapFloat (Property name value) f = case value of
+  FloatProp float -> f float
+  _ -> complain $ "type error: property " <> prettyprint name
+               <> " should be of type float."
+
 unwrapPath :: Text -> (RelPath -> LintWriter a) -> LintWriter a
 unwrapPath str f = case parsePath str of
   OkRelPath p@(Path up _ _) -> do
@@ -548,7 +554,16 @@ isString = flip unwrapString (const $ pure ())
 isBool :: Property -> LintWriter a
 isBool = flip unwrapBool (const $ pure ())
 
-isIntInRange :: Int -> Int -> Property -> LintWriter a
-isIntInRange l r p@(Property name _) = unwrapInt p $ \int ->
+isIntInRange :: Int -> Int -> Property -> LintWriter b
+isIntInRange = isOrdInRange @Int unwrapInt
+
+isOrdInRange :: (Ord a, Show a)
+  => (Property -> (a -> LintWriter b) -> LintWriter b)
+  -> a
+  -> a
+  -> Property
+  -> LintWriter b
+isOrdInRange unwrapa l r p@(Property name _) = unwrapa p $ \int ->
   if l < int && int < r then pure ()
-  else complain $ "Property " <> prettyprint name <> " should be between" <> showText l <> " and " <> showText r<>"."
+  else complain $ "Property " <> prettyprint name <> " should be between "
+               <> showText l <> " and " <> showText r<>"."
diff --git a/lib/Tiled.hs b/lib/Tiled.hs
index f1d7ec6..a092b67 100644
--- a/lib/Tiled.hs
+++ b/lib/Tiled.hs
@@ -62,7 +62,7 @@ data Property = Property Text PropertyValue
 -- | The value of a custom tiled property.
 -- It is strongly typed via a tag in the json representation,
 -- and needs a custom ToJSON and FromJSON instance because of that.
-data PropertyValue = StrProp Text | BoolProp Bool | IntProp Int
+data PropertyValue = StrProp Text | BoolProp Bool | IntProp Int | FloatProp Float
   deriving (Eq, Generic, Show)
 
 instance IsString PropertyValue where
@@ -81,22 +81,34 @@ instance FromJSON Property where
       A.String "int" -> do
         val <- o .: "value"
         pure $ Property name (IntProp val)
+      A.String "float" -> do
+        val <- o .: "value"
+        pure $ Property name (FloatProp val)
       ty -> fail $ "properties can only have types string, int, bool, but encountered type" <> show ty
   parseJSON invalid = typeMismatch "Property" invalid
 
 instance ToJSON Property where
   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
-                            ]
-    IntProp int -> object [ "type" .= A.String "int"
-                          , "name" .= name
-                          , "value" .= int]
+    StrProp str -> object
+      [ "type" .= A.String "string"
+      , "name" .= name
+      , "value" .= str
+      ]
+    BoolProp bool -> object
+      [ "type" .= A.String "bool"
+      , "name" .= name
+      , "value" .= bool
+      ]
+    IntProp int -> object
+      [ "type" .= A.String "int"
+      , "name" .= name
+      , "value" .= int
+      ]
+    FloatProp float -> object
+      [ "type" .= A.String "float"
+      , "name" .= name
+      , "value" .= float
+      ]
 
 data Point = Point { pointX :: Double
                    , pointY :: Double
-- 
cgit v1.2.3