From 727f2cbc5feb3cdd30df3c78f39ba4a58e6c4832 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 20 Sep 2021 20:41:31 +0200
Subject: simple parsing of local dependency paths

---
 lib/Properties.hs | 27 ++++++++++++++++-----------
 1 file changed, 16 insertions(+), 11 deletions(-)

(limited to 'lib/Properties.hs')

diff --git a/lib/Properties.hs b/lib/Properties.hs
index c2f5c81..320f132 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -14,10 +14,10 @@ import           Util          (layerIsEmpty, prettyprint)
 
 import           LintWriter    (LintWriter, complain, dependsOn, forbid, info,
                                 suggest, warn)
+import           Paths
 import           Types         (Dep (Link, Local, LocalMap, MapLink))
 
 
-
 -- | Checks an entire map for "general" lints.
 --
 -- Note that it does /not/ call checkMapProperty; this is handled
@@ -70,7 +70,7 @@ checkMapProperty map (Property name value) = case name of
 checkTileset :: Tileset -> LintWriter ()
 checkTileset tileset = do
   -- TODO: can tilesets be non-local dependencies?
-  dependsOn $ Local (tilesetImage tileset)
+  unwrapPath (tilesetImage tileset) (dependsOn . Local)
 
   -- reject tilesets unsuitable for workadventure
   unless (tilesetTilewidth tileset == 32 && tilesetTileheight tileset == 32)
@@ -104,9 +104,9 @@ checkLayerProperty layer p@(Property name value) = case name of
     "jitsiRoomAdminTag" -> isForbidden
     "playAudio" -> do
       uselessEmptyLayer
-      unwrapLink p $ \link -> dependsOn $ if "https://" `isPrefixOf` link
-        then Link link
-        else Local link
+      unwrapLink p $ \link -> if "https://" `isPrefixOf` link
+        then dependsOn $ Link link
+        else unwrapPath link (dependsOn . Local)
     "audioLoop" -> do
       isBool p
       requireProp "playAudio"
@@ -116,9 +116,9 @@ checkLayerProperty layer p@(Property name value) = case name of
     "openWebsite" -> do
       uselessEmptyLayer
       suggestProp $ Property "openWebsiteTrigger" (StrProp "onaction")
-      unwrapLink p $ \link -> dependsOn $ if "https://" `isPrefixOf` link
-        then Link link
-        else Local link
+      unwrapLink p $ \link -> if "https://" `isPrefixOf` link
+        then dependsOn $ Link link
+        else unwrapPath link (dependsOn . Local)
     "openWebsiteTrigger" -> do
       isString p
       unless (hasProperty "openWebsiteTriggerMessage")
@@ -137,9 +137,9 @@ checkLayerProperty layer p@(Property name value) = case name of
     "allowApi" -> isForbidden
     "exitUrl" -> do
       forbidEmptyLayer
-      unwrapLink p $ \link -> dependsOn $ if "https://" `isPrefixOf` link
-        then MapLink link
-        else LocalMap link
+      unwrapLink p $ \link -> if "https://" `isPrefixOf` link
+        then dependsOn $ MapLink link
+        else unwrapPath link (dependsOn . LocalMap)
     "startLayer" -> do
       forbidEmptyLayer
       unwrapBool p $ \case
@@ -206,6 +206,11 @@ unwrapBool (Property name value) f = case value of
   BoolProp b -> f b
   _ -> complain $ "type mismatch in property " <> name <> "; should be of type bool"
 
+unwrapPath :: Text -> (RelPath -> LintWriter ()) -> LintWriter ()
+unwrapPath str f = case parsePath str of
+  Just path -> f path
+  Nothing   -> complain $ "path \"" <> str <> "\" is invalid"
+
 -- | just asserts that this is a string
 isString :: Property -> LintWriter ()
 isString = flip unwrapString (const $ pure ())
-- 
cgit v1.2.3