From 70d37dcb8b381ba1b0b0d1f97d2fe99522f387a6 Mon Sep 17 00:00:00 2001 From: stuebinm Date: Sun, 19 Sep 2021 22:39:01 +0200 Subject: support for properties that aren't strings apparently i couldn't read or something? --- lib/Properties.hs | 88 ++++++++++++++++++++++++++++++++----------------------- 1 file changed, 52 insertions(+), 36 deletions(-) (limited to 'lib/Properties.hs') diff --git a/lib/Properties.hs b/lib/Properties.hs index ebd34bb..fe00857 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -5,15 +5,16 @@ module Properties (checkProperty) where -import Control.Monad (unless) +import Control.Monad (unless, when) import Data.Text (Text, isPrefixOf) -import Tiled2 (Layer (layerProperties), Property, propertyName, - propertyValue) +import Tiled2 (Layer (layerProperties), Property(..), PropertyValue(..)) import Util (prettyprint) import LintWriter (LintWriter, complain, dependsOn, forbid, info, suggest, warn) import Types + + -- | the point of this module -- -- given a property, check if it is valid. It gets a reference @@ -27,60 +28,75 @@ import Types -- that should make this readable even to non-Haskellers -- TODO: also pass the value of this property directly checkProperty :: Layer -> Property -> LintWriter () -checkProperty layer prop = case propName of - "jitsiRoom" -> do - info $ "found jitsi room: " <> prettyprint (propertyValue prop) +checkProperty layer (Property name value) = case name of + "jitsiRoom" -> strProp $ do + info $ "found jitsi room: " <> prettyprint value suggestPropertyValue "jitsiTrigger" "onaction" - "jitsiTrigger" -> + "jitsiTrigger" -> strProp $ do + unless (hasProperty "jitsiTriggerMessage" layer) + $ suggest "set \"jitsiTriggerMessage\" to a custom message to overwrite the default \"press SPACE to enter in jitsi meet room\"" requireProperty "jitsiRoom" + "jitsiTriggerMessage" -> strProp + $ requireProperty "jitsiTrigger" "jitsiUrl" -> isForbidden "jitsiConfig" -> isForbidden "jitsiClientConfig" -> isForbidden "jitsiRoomAdminTag" -> isForbidden - "playAudio" -> - forbidHTTPAndThen $ dependsOn $ if "https://" `isPrefixOf` propValue - then Link propValue - else Local propValue + "playAudio" -> linkProp $ \link -> dependsOn $ if "https://" `isPrefixOf` link + then Link link + else Local link "audioLoop" -> - requireProperty "playAudio" + boolProp $ requireProperty "playAudio" "audioVolume" -> - requireProperty "playAudio" + boolProp $ requireProperty "playAudio" "openWebsite" -> do suggestPropertyValue "openWebsiteTrigger" "onaction" - if "http://" `isPrefixOf` propValue - then complain "cannot load content over http into map, please use https or include your assets locally" - else dependsOn $ - if "https://" `isPrefixOf` propValue - then Link propValue - else Local propValue - "openWebsiteTrigger" -> + linkProp $ \link -> dependsOn $ if "https://" `isPrefixOf` link + then Link link + else Local link + "openWebsiteTrigger" -> strProp $ do + unless (hasProperty "openWebsiteTriggerMessage" layer) + $ suggest "set \"openWebsiteTriggerMessage\" to a custom message to overwrite the generic \"press SPACE to open Website\"" requireProperty "openWebsite" + "openWebsiteTriggerMessage" -> + strProp $ requireProperty "openWebsiteTrigger" "openWebsitePolicy" -> - requireProperty "openWebsite" - "exitUrl" -> - forbidHTTPAndThen $ dependsOn $ if "https://" `isPrefixOf` propValue - then MapLink propValue - else LocalMap propValue - "startLayer" -> pure () + strProp $ requireProperty "openWebsite" + "openTab" -> + strProp $ requireProperty "openWebsite" + "url" -> isForbidden + "allowApi" -> isForbidden + "exitUrl" -> linkProp $ \link -> dependsOn $ if "https://" `isPrefixOf` link + then MapLink link + else LocalMap link + "startLayer" -> + isForbidden + "silent" -> boolProp $ pure () -- could also make this a "hard error" (i.e. Left), but then it -- stops checking other properties as checkLayer short-circuits. - _ -> warn $ "unknown property type " <> prettyprint propName + _ -> warn $ "unknown property type " <> prettyprint name where - propName = propertyName prop - propValue = propertyValue prop + strProp :: LintWriter () -> LintWriter () + strProp andthen = case value of + StrProp _ -> andthen + _ -> complain $ "type mismatch in property " <> name <> "; should be of type string" + linkProp f = case value of + StrProp str -> if "http://" `isPrefixOf` str + then complain "cannot access content via http; either use https or include it locally instead." + else f str + _ -> complain $ "type mismatch in property " <> name <> "; should be of typ string" + boolProp f = case value of + BoolProp _ -> f + _ -> complain $ "type mismatch in property " <> name <> "; should be of type bool" -- | require some property in this layer requireProperty name = unless (hasProperty name layer) - $ complain $ "property "<>prettyprint name<>" requires property "<>prettyprint propName + $ complain $ "property "<>prettyprint name<>" requires property "<>prettyprint name -- | This property is forbidden and should not be used - isForbidden = forbid $ "property " <> prettyprint propName <> " should not be used" + isForbidden = forbid $ "property " <> prettyprint name <> " should not be used" -- TODO: check if the property has the correct value suggestPropertyValue :: Text -> Text -> LintWriter () suggestPropertyValue name value = unless (hasProperty name layer) $ suggest $ "set property " <> prettyprint name <> " to " <> prettyprint value - forbidHTTPAndThen :: LintWriter () -> LintWriter () - forbidHTTPAndThen andthen = if "http://" `isPrefixOf` propValue - then complain "cannot access content via http; either use https or include it locally instead." - else andthen @@ -88,5 +104,5 @@ checkProperty layer prop = case propName of -- | does this layer have the given property? hasProperty :: Text -> Layer -> Bool hasProperty name = any - (\prop -> propertyName prop == name) + (\(Property name' _) -> name' == name) . layerProperties -- cgit v1.2.3