Skip to content
Snippets Groups Projects
Commit 7b76bada authored by stuebinm's avatar stuebinm
Browse files

correct recognision of entrypoints in sublayers

also, the recursive check layer function slowly approaches something
like readability!
parent 53f71bca
No related branches found
No related tags found
No related merge requests found
......@@ -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') }
......
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment