summaryrefslogtreecommitdiff
path: root/lib/Properties.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r--lib/Properties.hs68
1 files changed, 15 insertions, 53 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs
index f4dff3d..f48d62e 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -6,25 +6,14 @@ module Properties (checkProperty) where
import Control.Monad (unless)
-import Control.Monad.Trans.Class (lift)
-import Data.Aeson as Aeson (Value (String))
-import Data.Map (Map, (!?))
import Data.Text (Text)
-import Tiled2 (Layer (layerProperties))
+import Tiled2 (Layer (layerProperties), Property, propertyName, propertyValue)
import Util (prettyprint)
-import LintWriter (Hint, LintWriter, Level(..), hint,
- assertWarn, complain, forbid, info,
- suggest, unwrapWarn, warn)
+import LintWriter (LintWriter, complain, forbid, info,
+ suggest, warn, Dep(..), require)
--- | values may be anything, and are not typechecked (for now),
--- since they may contain arbitrary json – our only guarantee
--- is that they are named, and therefore a map.
-type Properties = Map Text Aeson.Value
-
-
-
--- | /technically/ the main function here
+-- | the point of this module
--
-- given a property, check if it is valid. It gets a reference
-- to its own layer since sometimes the presense of one property
@@ -33,28 +22,13 @@ type Properties = Map Text Aeson.Value
-- The tests in here are meant to comply with the informal spec
-- at https://workadventu.re/map-building
--
--- In practice, the actual specification of what is allowed is
--- handled in checkProperty', since apparently all possible layerProperties
--- are strings anyways, so this just extracts that string and then
--- calls that.
-checkProperty :: Layer -> Properties -> LintWriter ()
-checkProperty layer prop = do
- tyObj <- lift $ getAttr prop "name"
- ty <- lift $ case tyObj of
- Aeson.String str -> Right str
- _ -> Left (hint Suggestion "wtf")
- checkProperty' layer prop ty
-
--- | The /real/ main thing.
---
-- I've attempted to build the LintWriter monad in a way
-- that should make this readable even to non-Haskellers
-checkProperty' :: Layer -> Properties -> Text -> LintWriter ()
-checkProperty' layer prop ty = case ty of
+-- TODO: also pass the value of this property directly
+checkProperty :: Layer -> Property -> LintWriter ()
+checkProperty layer prop = case propName of
"jitsiRoom" -> do
- propEqual prop "type" "string"
- urlValue <- lift $ getAttr prop "value"
- info $ "found jitsi room: " <> prettyprint urlValue
+ info $ "found jitsi room: " <> prettyprint (propertyValue prop)
suggestPropertyValue "jitsiTrigger" "onaction"
"jitsiTrigger" ->
requireProperty "jitsiRoom"
@@ -64,12 +38,12 @@ checkProperty' layer prop ty = case ty of
"jitsiRoomAdminTag" -> isForbidden
"playAudio" -> do
-- TODO: check for url validity?
- propEqual prop "type" "string"
+ pure ()
"audioLoop" ->
requireProperty "playAudio"
"audioVolume" ->
requireProperty "playAudio"
- "openWebsite" ->
+ "openWebsite" -> do
suggestPropertyValue "openWebsiteTrigger" "onaction"
"openWebsiteTrigger" ->
requireProperty "openWebsite"
@@ -79,13 +53,14 @@ checkProperty' layer prop ty = case ty of
"startLayer" -> 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 ty
+ _ -> warn $ "unknown property type " <> prettyprint propName
where
+ propName = propertyName prop
-- | require some property in this layer
requireProperty name = unless (hasProperty name layer)
- $ complain $ "property "<>prettyprint name<>" requires property "<>prettyprint ty
+ $ complain $ "property "<>prettyprint name<>" requires property "<>prettyprint propName
-- | This property is forbidden and should not be used
- isForbidden = forbid $ "property " <> prettyprint ty <> " should not be used"
+ isForbidden = forbid $ "property " <> prettyprint propName <> " should not be used"
-- TODO: check if the property has the correct value
suggestPropertyValue :: Text -> Text -> LintWriter ()
suggestPropertyValue name value = unless (hasProperty name layer)
@@ -97,18 +72,5 @@ checkProperty' layer prop ty = case ty of
-- | does this layer have the given property?
hasProperty :: Text -> Layer -> Bool
hasProperty name = any
- (\prop -> prop !? "name" == Just (Aeson.String name))
+ (\prop -> propertyName prop == name)
. layerProperties
-
--- | get an attribute from a map
-getAttr :: Properties -> Text -> Either Hint Aeson.Value
-getAttr props name = unwrapWarn msg $ props !? name
- where msg = "field " <> name <> "does not exist"
-
--- | lint goal: the property with the given name has given value
-propEqual :: Properties -> Text -> Aeson.Value -> LintWriter ()
-propEqual props name value = do
- value' <- lift $ getAttr props name
- assertWarn ("field "<>name<>" has unexpected value "<>prettyprint value'
- <>", should be "<>prettyprint value)
- $ value' == value