diff options
| -rw-r--r-- | lib/CheckDir.hs | 7 | ||||
| -rw-r--r-- | lib/CheckMap.hs | 6 | ||||
| -rw-r--r-- | lib/Dirgraph.hs | 2 | ||||
| -rw-r--r-- | lib/Properties.hs | 9 | ||||
| -rw-r--r-- | lib/Util.hs | 6 | ||||
| -rw-r--r-- | tiled/Data/Tiled/Abstract.hs | 6 |
6 files changed, 17 insertions, 19 deletions
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs index 49b3774..eaf9aee 100644 --- a/lib/CheckDir.hs +++ b/lib/CheckDir.hs @@ -27,6 +27,7 @@ import CheckMap (MapResult (..), Optional, import Control.Monad.Extra (mapMaybeM) import Data.Aeson (ToJSON, (.=)) import qualified Data.Aeson as A +import Data.List (partition) import qualified Data.Map as M import Data.Map.Strict (mapKeys, mapWithKey, (\\)) import Data.Text (isInfixOf) @@ -124,7 +125,7 @@ instance ToJSON (DirResult a) where . foldr aggregateSameResults [] . M.toList $ dirresultMaps res) - , "exitGraph" .= showDot (dirresultGraph res) + , "exitGraph" .= dirresultGraph res ] , "severity" .= maximumLintLevel res , "mapInfo" .= fmap (\tm -> A.object [ "badges" .= mapresultBadges tm ]) @@ -133,8 +134,8 @@ instance ToJSON (DirResult a) where where aggregateSameResults (path,res) acc = case partition (\(_,res') -> res == res') acc of - ([],_) -> ([T.pack path], res):acc - ((paths,_):_,acc') -> (T.pack path:paths, res) : acc' + ([],_) -> ([toText path], res):acc + ((paths,_):_,acc') -> (toText path:paths, res) : acc' instance ToJSON MissingAsset where toJSON (MissingAsset md) = A.object diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs index 8611f03..1d4c404 100644 --- a/lib/CheckMap.hs +++ b/lib/CheckMap.hs @@ -7,10 +7,10 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE RecordWildCards #-} -- | Module that contains the high-level checking functions module CheckMap (loadAndLintMap, MapResult(..), ResultKind(..), Optional,shrinkMapResult) where @@ -29,7 +29,7 @@ import Badges (Badge) import Data.Tiled (Layer (layerLayers, layerName), Tiledmap (tiledmapLayers, tiledmapTilesets), loadTiledmap) -import LintConfig (LintConfig', LintConfig (..)) +import LintConfig (LintConfig (..), LintConfig') import LintWriter (LintResult, invertLintResult, resultToAdjusted, resultToBadges, resultToDeps, resultToLints, resultToOffers, @@ -131,7 +131,7 @@ runLinter isMain config@LintConfig{..} tiledmap depth = MapResult linksLobby = \case MapLink link -> ("/@/"<>configEventSlug<>"/lobby") `T.isPrefixOf` link - || configAssemblyTag config == "lobby" + || configAssemblyTag == "lobby" _ -> False layerDeps = concatMap resultToDeps layer layer = checkLayerRec config depth (V.toList $ tiledmapLayers tiledmap) diff --git a/lib/Dirgraph.hs b/lib/Dirgraph.hs index fe9dc96..3fe1ce6 100644 --- a/lib/Dirgraph.hs +++ b/lib/Dirgraph.hs @@ -68,7 +68,7 @@ takeSubGraph i start graph graphToDot :: Graph FilePath -> Dot () graphToDot graph = do main <- D.node [("label","main.json")] - nodes' <- traverseMaybeWithKey + nodes' <- M.traverseMaybeWithKey (\name edges -> if name /= "main.json" then D.node [("label",name)] <&> (, edges) <&> Just else pure Nothing diff --git a/lib/Properties.hs b/lib/Properties.hs index b937534..f645392 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -20,11 +20,11 @@ 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 Data.Tiled.Abstract (HasData (..), HasName (..), + HasProperties (..), HasTypeName (..), + IsProperty (..), layerIsEmpty) import qualified Data.Vector as V -import Util (layerIsEmpty, mkProxy, naiveEscapeHTML, - prettyprint) +import Util (mkProxy, naiveEscapeHTML, prettyprint) import Badges (Badge (Badge), BadgeArea (BadgePoint, BadgeRect), @@ -424,7 +424,6 @@ checkTileThing removeExits p@(Property name _value) = case name of complain "All exit links must link to .json files." | otherwise -> dependsOn . LocalMap $ path else do - removeProperty "exitUrl" warn "exitUrls in Tilesets are not properly supported; if you want to add an \ \exit, please use a tile layer instead." "exitSceneUrl" -> diff --git a/lib/Util.hs b/lib/Util.hs index 4b5d092..93060aa 100644 --- a/lib/Util.hs +++ b/lib/Util.hs @@ -2,14 +2,12 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} --- | has (perhaps inevitably) morphed into a module that mostly --- concerns itself with wrangling haskell's string types module Util ( mkProxy , PrettyPrint(..) , printPretty , naiveEscapeHTML - , layerIsEmpty + , ellipsis ) where import Universum @@ -69,7 +67,7 @@ printPretty = putStr . toString . prettyprint -- | for long lists which shouldn't be printed out in their entirety ellipsis :: Int -> [Text] -> Text ellipsis i texts - | i < l = prettyprint (take i texts) <> " ... (and " <> showText (l-i) <> " more)" + | i < l = prettyprint (take i texts) <> " ... (and " <> show (l-i) <> " more)" | otherwise = prettyprint texts where l = length texts diff --git a/tiled/Data/Tiled/Abstract.hs b/tiled/Data/Tiled/Abstract.hs index 574a0ae..89c40b4 100644 --- a/tiled/Data/Tiled/Abstract.hs +++ b/tiled/Data/Tiled/Abstract.hs @@ -4,9 +4,9 @@ module Data.Tiled.Abstract where import Universum -import Data.Tiled (Layer (..), Object (..), Property (..), +import Data.Tiled (GlobalId, Layer (..), Object (..), Property (..), PropertyValue (..), Tile (..), Tiledmap (..), - Tileset (..), GlobalId) + Tileset (..), mkTiledId) import qualified Data.Vector as V class HasProperties a where @@ -65,7 +65,7 @@ instance HasName Tileset where instance HasName Property where getName (Property n _) = n instance HasName Tile where - getName tile = "[tile with global id " <> showText (tileId tile) <> "]" + getName tile = "[tile with global id " <> show (tileId tile) <> "]" class IsProperty a where |