From 5d8cbd7c9975ca1fb95fb332f7e27357cc18e982 Mon Sep 17 00:00:00 2001 From: stuebinm Date: Sun, 6 Mar 2022 16:28:05 +0100 Subject: 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 -- cgit v1.2.3