config options: implement script-related options

3 files changed, 20 insertions, 2 deletions

diff --git a/lib/LintConfig.hs b/lib/LintConfig.hs
index 28559bd..5596005 100644
--- a/lib/LintConfig.hs
+++ b/lib/LintConfig.hs
@@ -38,6 +38,8 @@ data LintConfig f = LintConfig
   -- ^ Maximum warn level allowed before the lint fails
   , configDontCopyAssets :: HKD f Bool
   -- ^ Don't copy map assets (mostly useful for development)
+  , configAllowScripts   :: HKD f Bool
+  -- ^ Allow defining custom scripts in maps
   } deriving (Generic)
 
 type LintConfig' = LintConfig Identity
diff --git a/lib/Properties.hs b/lib/Properties.hs
index e6a3384..50fec53 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -15,7 +15,7 @@ import           Tiled2        (HasProperties (adjustProperties, getProperties),
 import           Util          (layerIsEmpty, prettyprint)
 
 import           Data.Maybe    (fromMaybe)
-import           LintConfig    (LintConfig (configAssemblyTag))
+import           LintConfig    (LintConfig (..))
 import           LintWriter    (LintWriter, adjust, askContext, askFileDepth,
                                 complain, dependsOn, forbid, lintConfig,
                                 offersEntrypoint, suggest, warn)
@@ -62,7 +62,18 @@ checkMap = do
 -- longer function same as checkLayerProperty.
 checkMapProperty :: Property -> LintWriter Tiledmap
 checkMapProperty (Property name _value) = case name of
-  "script" -> isForbidden
+  "script" -> do
+    -- this is kind of stupid, since if we also inject script this
+    -- will be overriden anyways, but it also doesn't really hurt I guess
+    -- TODO: perhaps include an explanation in the lint, or allow
+    -- exactly that one value?
+    lintConfig configAllowScripts >>= \case
+      False -> isForbidden
+      True  -> pure ()
+    lintConfig configScriptInject >>= \case
+      Nothing  -> pure ()
+      Just url -> setProperty "script" url
+
   _        -> complain $ "unknown map property " <> prettyprint name
   where
     -- | this property is forbidden and should not be used
diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs
index 873e22d..5b37f20 100644
--- a/lib/Tiled2.hs
+++ b/lib/Tiled2.hs
@@ -332,6 +332,11 @@ instance HasProperties Tileset where
   adjustProperties f tileset = tileset
     { tilesetProperties = f (getProperties tileset) }
 
+instance HasProperties Tiledmap where
+  getProperties = fromMaybe [] . tiledmapProperties
+  adjustProperties f tiledmap = tiledmap
+    { tiledmapProperties = f (getProperties tiledmap) }
+
 class HasName a where
   getName :: a -> Text
 instance HasName Layer where