summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstuebinm2021-12-23 22:14:34 +0100
committerstuebinm2021-12-23 23:25:01 +0100
commit7b76badabaaef215618ae67a84c4ff33c4b8b450 (patch)
tree23c7c03e88b347ea46285f0e329a5a58bd4d9e06
parent53f71bca68a069e919821ecfde447cc97cc193b5 (diff)
correct recognision of entrypoints in sublayers
also, the recursive check layer function slowly approaches something like readability!
-rw-r--r--lib/CheckMap.hs37
-rw-r--r--lib/LintWriter.hs2
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