diff options
| -rw-r--r-- | lib/CheckMap.hs | 37 | ||||
| -rw-r--r-- | lib/LintWriter.hs | 2 |
2 files changed, 23 insertions, 16 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs index 04f3264..63b264a 100644 --- a/lib/CheckMap.hs +++ b/lib/CheckMap.hs @@ -61,6 +61,7 @@ instance ToJSON MapResult where [ "layer" .= CollectedLints (fmap getName <$> mapresultLayer res) , "tileset" .= CollectedLints (fmap getName <$> mapresultTileset res) , "general" .= mapresultGeneral res + , "offers" .= mapresultProvides res ] newtype CollectedLints = CollectedLints (Map Hint [Text]) @@ -143,22 +144,26 @@ checkLayerRec config depth layers = (runLintWriter config parent depth checkLayer,[]) -- this is a group layer. Fun! Just sublayers -> - let - -- before linting, append the group's top-level name to that of sublayers - results = take (length sublayers) - $ checkLayerRec config depth $ sublayers - <&> \l -> l { layerName = layerName parent <> "/" <> layerName l } - -- get the original sublayer names - names = fmap layerName sublayers - -- pass the adjusted sublayers on to linting the parent layer, - -- but restore the actual names of sublayers - result = runLintWriter config - (parent { layerLayers = Just - $ zipWith (\n l -> (resultToAdjusted l) { layerName = n }) - names results - } - ) depth checkLayer - in (result,results) + (parentResult, subresults) + where + -- Lintresults for sublayers with adjusted names + subresults :: [LintResult Layer] + subresults = + take (length sublayers) + . fmap (fmap (\l -> l { layerName = layerName parent <> "/" <> layerName l } )) + $ subresults' + + -- Lintresults for sublayers and subsublayers etc. + subresults' = + checkLayerRec config depth + $ sublayers + + -- lintresult for the parent layer + parentResult = runLintWriter config parentAdjusted depth (checkLayer) + + -- the parent layer with adjusted sublayers + parentAdjusted = + parent { layerLayers = Just (fmap resultToAdjusted subresults') } diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs index fa8207b..5a6fc7d 100644 --- a/lib/LintWriter.hs +++ b/lib/LintWriter.hs @@ -7,6 +7,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE DeriveFunctor #-} {-# OPTIONS_GHC -Wno-missing-signatures #-} -- | a monad that collects warnings, outputs, etc, @@ -67,6 +68,7 @@ type LintWriter' ctxt res = -- | it already collected. newtype LinterState ctxt = LinterState { fromLinterState :: ([Lint], ctxt)} + deriving Functor -- | The result of running a linter: an adjusted context, and a list of lints. -- | This is actually just a type synonym of LinterState, but kept seperately |