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 +++++++++++++++++++----
 1 file changed, 19 insertions(+), 4 deletions(-)

(limited to 'lib/Properties.hs')

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<>"."
-- 
cgit v1.2.3