make tiled stricter (and organise some imports)

7 files changed, 50 insertions, 63 deletions

diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 93b6345..8ecbc8f 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,
                                          unreachableFrom)
 import           LintConfig             (LintConfig', configMaxLintLevel)
@@ -40,7 +41,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))
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 0b5b58a..6cd2893 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')
 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)
@@ -94,14 +93,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
@@ -203,7 +201,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 1ba5faa..c53ae48 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 (..))
-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 ccd2ef3..3212374 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)
 
 mkProxy :: a -> Proxy a
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