From 204d3f4a393cc1be5d0872e6fd53d014ede191a5 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 13 Dec 2021 23:50:09 +0100
Subject: complain if map links that don't go to .json files

---
 lib/Paths.hs      |  6 ++++++
 lib/Properties.hs | 20 ++++++++++++++------
 2 files changed, 20 insertions(+), 6 deletions(-)

(limited to 'lib')

diff --git a/lib/Paths.hs b/lib/Paths.hs
index b849cf6..83c065f 100644
--- a/lib/Paths.hs
+++ b/lib/Paths.hs
@@ -68,3 +68,9 @@ isOldStyle (Path _ text frag) = path =~ ("{<.+>*}" :: Text)
   where path = case frag of
           Just f -> text <> f
           _ -> text
+
+getExtension :: RelPath -> Text
+getExtension (Path _ text frag) = case length splitted of
+  0 -> ""
+  _ -> last splitted
+  where splitted = T.splitOn "." text
diff --git a/lib/Properties.hs b/lib/Properties.hs
index c278351..c106b9f 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -11,7 +11,7 @@ module Properties (checkMap, checkTileset, checkLayer) where
 
 
 import           Control.Monad (forM_, unless, when)
-import           Data.Text     (Text, isPrefixOf, intercalate)
+import           Data.Text     (Text, intercalate, isPrefixOf)
 import qualified Data.Vector   as V
 import           Tiled         (Layer (..), Object (..), Property (..),
                                 PropertyValue (..), Tile (..), Tiledmap (..),
@@ -35,7 +35,8 @@ import           LintConfig    (LintConfig (..))
 import           LintWriter    (LintWriter, adjust, askContext, askFileDepth,
                                 complain, dependsOn, forbid, lintConfig,
                                 offersBadge, offersEntrypoint, suggest, warn)
-import           Paths         (PathResult (..), RelPath (..), parsePath, isOldStyle)
+import           Paths         (PathResult (..), RelPath (..), getExtension,
+                                isOldStyle, parsePath)
 import           Types         (Dep (Link, Local, LocalMap, MapLink))
 import           Uris          (SubstError (..), applySubst)
 
@@ -323,10 +324,17 @@ checkTileLayerProperty p@(Property name _value) = case name of
       forbidEmptyLayer
       unwrapURI (Proxy @"map") p
         (dependsOn . MapLink)
-        (\path -> do
-            if isOldStyle path
-              then complain "Old-Style inter-repository links (using {<placeholder>}) cannot be used at rC3 2021; please use world:// instead (cf. howto.rc3.world)."
-              else dependsOn . LocalMap $ path)
+        $ \path ->
+          let ext = getExtension path in
+          if | isOldStyle path ->
+               complain "Old-Style inter-repository links (using {<placeholder>}) \
+                        \cannot be used at rC3 2021; please use world:// instead \
+                        \(cf. howto.rc3.world)."
+             | ext == "tmx" ->
+                 complain "Cannot use .tmx map format; use Tiled's json export instead."
+             | ext /= "json" ->
+                 complain "All exit links must link to .json files."
+             | otherwise -> dependsOn . LocalMap $ path
     "exitSceneUrl" ->
       deprecatedUseInstead "exitUrl"
     "exitInstance" ->
-- 
cgit v1.2.3