1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Contains checks for custom properties of the map json
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 Util (quote, showAeson)
import LintWriter (Hint, LintWriter, Level(..), hint,
assertWarn, complain, forbid, info,
suggest, unwrapWarn, warn)
-- | 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
--
-- given a property, check if it is valid. It gets a reference
-- to its own layer since sometimes the presense of one property
-- implies the presence or absense of another.
--
-- 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
"jitsiRoom" -> do
propEqual prop "type" "string"
urlValue <- lift $ getAttr prop "value"
info $ "found jitsi room: " <> showAeson urlValue
suggestPropertyValue "jitsiTrigger" "onaction"
"jitsiTrigger" ->
requireProperty "jitsiRoom"
"jitsiUrl" -> isForbidden
"jitsiConfig" -> isForbidden
"jitsiClientConfig" -> isForbidden
"jitsiRoomAdminTag" -> isForbidden
"playAudio" -> do
-- TODO: check for url validity?
propEqual prop "type" "string"
"audioLoop" ->
requireProperty "playAudio"
"audioVolume" ->
requireProperty "playAudio"
"openWebsite" ->
suggestPropertyValue "openWebsiteTrigger" "onaction"
"openWebsiteTrigger" ->
requireProperty "openWebsite"
"openWebsitePolicy" ->
requireProperty "openWebsite"
"exitUrl" -> pure ()
"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 " <> quote ty
where
-- | require some property in this layer
requireProperty name = unless (hasProperty name layer)
$ complain $ "property "<>quote name<>" requires property "<>quote ty
-- | This property is forbidden and should not be used
isForbidden = forbid $ "property " <> quote ty <> " should not be used"
-- TODO: check if the property has the correct value
suggestPropertyValue name value = unless (hasProperty name layer)
$ suggest $ "set property " <> quote name <> " to " <> quote value
-- | does this layer have the given property?
hasProperty :: Text -> Layer -> Bool
hasProperty name = any
(\prop -> prop !? "name" == Just (Aeson.String 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 "<>showAeson value'
<>", should be "<>showAeson value)
$ value' == value
|
