From 5d8cbd7c9975ca1fb95fb332f7e27357cc18e982 Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Sun, 6 Mar 2022 16:28:05 +0100
Subject: [PATCH] make tiled stricter (and organise some imports)
---
lib/CheckDir.hs | 2 +-
lib/CheckMap.hs | 17 +++++--------
lib/LayerData.hs | 2 +-
lib/LintWriter.hs | 10 ++++----
lib/Properties.hs | 62 ++++++++++++++++++++++-----------------------
lib/Util.hs | 2 +-
tiled/Data/Tiled.hs | 18 +++----------
7 files changed, 50 insertions(+), 63 deletions(-)
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 300cf00..c7fbc5a 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -31,6 +31,7 @@ import qualified Data.Map as M
import Data.Map.Strict (mapKeys, mapWithKey, (\\))
import Data.Text (isInfixOf)
import qualified Data.Text as T
+import Data.Tiled (Tiledmap)
import Dirgraph (graphToDot, invertGraph, resultToGraph,
takeSubGraph, unreachableFrom)
import GHC.Generics (Generic)
@@ -41,7 +42,6 @@ import System.FilePath (splitPath, (</>))
import qualified System.FilePath as FP
import System.FilePath.Posix (takeDirectory)
import Text.Dot (showDot)
-import Data.Tiled (Tiledmap)
import Types (Dep (Local, LocalMap), Hint (Hint),
Level (..), hintLevel)
import Util (PrettyPrint (prettyprint), ellipsis)
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 9dc3a4c..9e3027c 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -25,6 +25,9 @@ import qualified Data.Vector as V
import Badges (Badge)
+import Data.Tiled (Layer (layerLayers, layerName),
+ Tiledmap (tiledmapLayers, tiledmapTilesets),
+ loadTiledmap)
import LintConfig (LintConfig (configAssemblyTag), LintConfig')
import LintWriter (LintResult, invertLintResult,
resultToAdjusted, resultToBadges,
@@ -32,10 +35,6 @@ import LintWriter (LintResult, invertLintResult,
runLintWriter)
import Properties (checkLayer, checkMap, checkTileset)
import System.FilePath (takeFileName)
-import Data.Tiled (Layer (layerLayers, layerName),
- LoadResult (..),
- Tiledmap (tiledmapLayers, tiledmapTilesets),
- loadTiledmap)
import Types (Dep (MapLink),
Hint (Hint, hintLevel, hintMsg), Level (..),
lintsToHints)
@@ -102,14 +101,13 @@ shrinkMapResult !res = res { mapresultAdjusted = () }
-- Lints the map at `path`, and limits local links to at most `depth`
-- layers upwards in the file hierarchy
loadAndLintMap :: LintConfig' -> FilePath -> Int -> IO (Maybe (MapResult Full))
-loadAndLintMap config path depth = loadTiledmap path <&> (\case
- DecodeErr err -> Just (MapResult mempty mempty mempty mempty Nothing mempty
+loadAndLintMap config path depth = loadTiledmap path <&> \case
+ Left err -> Just (MapResult mempty mempty mempty mempty Nothing mempty
[ Hint Fatal . toText $
path <> ": Fatal: " <> err
])
- IOErr _ -> Nothing
- Loaded waMap ->
- Just (runLinter (takeFileName path == "main.json") config waMap depth))
+ Right waMap ->
+ Just (runLinter (takeFileName path == "main.json") config waMap depth)
-- | lint a loaded map
runLinter :: Bool -> LintConfig' -> Tiledmap -> Int -> MapResult Full
@@ -212,7 +210,6 @@ instance PrettyPrint (Level, MapResult a) where
prettyLints getter = fmap
(\(h, cs) -> prettyprint h
<> "\n (in "
- -- foldl :: ((length of current line, acc) -> next ctxt -> list) -> ...
<> snd (foldl (\(l,a) c -> case l of
0 -> (T.length c, c)
_ | l < 70 -> (l+2+T.length c, a <> ", " <> c)
diff --git a/lib/LayerData.hs b/lib/LayerData.hs
index 46d6449..82efbfc 100644
--- a/lib/LayerData.hs
+++ b/lib/LayerData.hs
@@ -6,9 +6,9 @@ import Universum hiding (maximum, uncons)
import Control.Monad.Zip (mzipWith)
import Data.Set (insert)
+import Data.Tiled (GlobalId (unGlobalId), Layer (..))
import Data.Vector (maximum, uncons)
import qualified Text.Show as TS
-import Data.Tiled (GlobalId (unGlobalId), Layer (..))
import Util (PrettyPrint (..))
-- | A collision between two layers of the given names.
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index b55b16e..bf2eb3e 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -45,12 +45,12 @@ module LintWriter
import Universum
-import Badges (Badge)
-import Data.Map (fromListWith)
-import LintConfig (LintConfig')
+import Badges (Badge)
+import Data.Map (fromListWith)
import Data.Tiled.Abstract (HasName (getName))
-import Types (Dep, Hint, Level (..), Lint (..), hint,
- lintsToHints)
+import LintConfig (LintConfig')
+import Types (Dep, Hint, Level (..), Lint (..), hint,
+ lintsToHints)
-- | A monad modelling the main linter features
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 846430b..3100b3a 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -13,37 +13,37 @@
-- | Contains checks for custom ties of the map json
module Properties (checkMap, checkTileset, checkLayer) where
-import Universum hiding (intercalate, isPrefixOf)
-
-import Data.Text (intercalate, isInfixOf, isPrefixOf)
-import qualified Data.Text as T
-import qualified Data.Vector as V
-import Data.Tiled (Layer (..), Object (..), Property (..),
- PropertyValue (..), Tile (..),
- Tiledmap (..), Tileset (..))
-import Data.Tiled.Abstract (HasName (..), HasProperties (..),
- HasTypeName (..), IsProperty (..), HasData (..))
-import Util (layerIsEmpty, mkProxy, naiveEscapeHTML,
- prettyprint)
-
-import Badges (Badge (Badge),
- BadgeArea (BadgePoint, BadgeRect),
- BadgeToken, parseToken)
-import Data.List ((\\))
-import qualified Data.Set as S
-import Data.Text.Metrics (damerauLevenshtein)
-import GHC.TypeLits (KnownSymbol)
-import LayerData (Collision, layerOverlaps)
-import LintConfig (LintConfig (..))
-import LintWriter (LintWriter, adjust, askContext,
- askFileDepth, complain, dependsOn, forbid,
- lintConfig, offersBadge, offersEntrypoint,
- suggest, warn, zoom)
-import Paths (PathResult (..), RelPath (..), getExtension,
- isOldStyle, parsePath)
-import Types (Dep (Link, Local, LocalMap, MapLink))
-import Uris (SubstError (..), applySubsts, extractDomain,
- parseUri)
+import Universum hiding (intercalate, isPrefixOf)
+
+import Data.Text (intercalate, isInfixOf, isPrefixOf)
+import qualified Data.Text as T
+import Data.Tiled (Layer (..), Object (..), Property (..),
+ PropertyValue (..), Tile (..),
+ Tiledmap (..), Tileset (..))
+import Data.Tiled.Abstract (HasName (..), HasProperties (..),
+ HasTypeName (..), IsProperty (..))
+import qualified Data.Vector as V
+import Util (layerIsEmpty, mkProxy, naiveEscapeHTML,
+ prettyprint)
+
+import Badges (Badge (Badge),
+ BadgeArea (BadgePoint, BadgeRect),
+ BadgeToken, parseToken)
+import Data.List ((\\))
+import qualified Data.Set as S
+import Data.Text.Metrics (damerauLevenshtein)
+import GHC.TypeLits (KnownSymbol)
+import LayerData (Collision, layerOverlaps)
+import LintConfig (LintConfig (..))
+import LintWriter (LintWriter, adjust, askContext,
+ askFileDepth, complain, dependsOn, forbid,
+ lintConfig, offersBadge, offersEntrypoint,
+ suggest, warn, zoom)
+import Paths (PathResult (..), RelPath (..),
+ getExtension, isOldStyle, parsePath)
+import Types (Dep (Link, Local, LocalMap, MapLink))
+import Uris (SubstError (..), applySubsts,
+ extractDomain, parseUri)
diff --git a/lib/Util.hs b/lib/Util.hs
index d5e9e98..4b5d092 100644
--- a/lib/Util.hs
+++ b/lib/Util.hs
@@ -17,7 +17,7 @@ import Universum
import Data.Aeson as Aeson
import qualified Data.Set as S
import qualified Data.Text as T
-import Data.Tiled (Layer (layerData), PropertyValue (..),
+import Data.Tiled (Layer (layerData), PropertyValue (..),
Tileset (tilesetName), layerName, mkTiledId)
-- | helper function to create proxies
diff --git a/tiled/Data/Tiled.hs b/tiled/Data/Tiled.hs
index 046a080..8a8036e 100644
--- a/tiled/Data/Tiled.hs
+++ b/tiled/Data/Tiled.hs
@@ -19,12 +19,9 @@ module Data.Tiled where
import Universum
--- TODO: what ever are these aeson imports
import Data.Aeson hiding (Object)
import qualified Data.Aeson as A
import Data.Aeson.Types (typeMismatch)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as LB
import Data.Char (toLower)
@@ -382,15 +379,8 @@ instance FromJSON Tiledmap where
instance ToJSON Tiledmap where
toJSON = genericToJSON (aesonOptions 8)
-data LoadResult = Loaded Tiledmap | IOErr String | DecodeErr String
- deriving Show
-
-- | Load a Tiled map from the given 'FilePath'.
-loadTiledmap :: FilePath -> IO LoadResult
-loadTiledmap path = do
- res <- try (BS.readFile path)
- pure $ case res of
- Right file -> case eitherDecode . LB.fromStrict $ file of
- Left err -> DecodeErr err
- Right tiledmap -> Loaded tiledmap
- Left (err :: SomeException) -> IOErr $ show err
+loadTiledmap :: FilePath -> IO (Either String Tiledmap)
+loadTiledmap path = eitherDecodeFileStrict' path <&> \case
+ Left err -> Left err
+ Right tiledmap -> Right tiledmap
--
GitLab