From 80cc9d0f70e98ff9b8aa78c86891d4a9bb4759d5 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 19 Mar 2022 20:20:20 +0100
Subject: unbreak a very, very long rebase
---
lib/CheckDir.hs | 7 ++++---
lib/CheckMap.hs | 6 +++---
lib/Dirgraph.hs | 2 +-
lib/Properties.hs | 9 ++++-----
lib/Util.hs | 6 ++----
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
--
cgit v1.2.3