diff options
author | stuebinm | 2021-12-14 00:14:12 +0100 |
---|---|---|
committer | stuebinm | 2021-12-14 00:14:12 +0100 |
commit | 34488ce52bca4031a81c57b9b1ee79ce5c4858c6 (patch) | |
tree | 105a3489131f5d260af6f0f81891d89e86f906f1 /lib/Properties.hs | |
parent | eeb78b3f0a634d58258873e57194ba41af3d3711 (diff) |
audioVolumne is of type float, not int
also, float properties exist, apparently
Diffstat (limited to '')
-rw-r--r-- | lib/Properties.hs | 23 |
1 files changed, 19 insertions, 4 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<>"." |