summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstuebinm2021-12-13 23:50:09 +0100
committerstuebinm2021-12-13 23:56:02 +0100
commit204d3f4a393cc1be5d0872e6fd53d014ede191a5 (patch)
treed459123dbbf00c8eda59cdcfe3c360fb1f68750e
parentea6ef98353669ece25c6366bfdbc5bb921a44b7a (diff)
complain if map links that don't go to .json files
-rw-r--r--lib/Paths.hs6
-rw-r--r--lib/Properties.hs20
2 files changed, 20 insertions, 6 deletions
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" ->