summaryrefslogtreecommitdiff
path: root/lib/CheckDir.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/CheckDir.hs')
-rw-r--r--lib/CheckDir.hs19
1 files changed, 10 insertions, 9 deletions
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index cd8f5ab..2a35c12 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -3,19 +3,17 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
-- | Module that contains high-level checking for an entire directory
-{-# LANGUAGE TupleSections #-}
module CheckDir (recursiveCheckDir) where
import CheckMap (MapResult (mapresultProvides),
loadAndLintMap, mapresultDepends)
import Control.Monad (void)
+import Control.Monad.Extra (mapMaybeM)
import Data.Aeson (ToJSON, (.=))
import qualified Data.Aeson as A
-import Data.Bifunctor (bimap)
-import Data.Foldable (fold)
-import Data.Functor ((<&>))
import Data.Map (Map)
import qualified Data.Map as M
import Data.Map.Strict (mapKeys, (\\))
@@ -30,6 +28,7 @@ import System.FilePath.Posix (takeDirectory)
import Types (Dep (LocalMap), Level)
import Util (PrettyPrint (prettyprint))
+
-- based on the startling observation that Data.Map has lower complexity
-- for difference than Data.Set, but the same complexity for fromList
type Set a = Map a ()
@@ -103,7 +102,7 @@ recursiveCheckDir prefix root = do
-- maps are referenced but do not actually exist.
missingDeps :: DirResult -> [MissingDep]
missingDeps res =
- let simple = used \\ M.union defined trivial
+ let simple = M.insert "main.json" [] used \\ M.union defined trivial
in M.foldMapWithKey (\f n -> [MissingDep f n]) simple
where
-- which maps are linked somewhere?
@@ -133,18 +132,20 @@ missingDeps res =
recursiveCheckDir' :: FilePath -> [FilePath] -> Set FilePath -> DirResult -> IO DirResult
recursiveCheckDir' prefix paths done acc = do
- -- lint all maps in paths
+ -- lint all maps in paths. The double fmap skips maps which cause IO errors
+ -- (in which case loadAndLintMap returns Nothing); appropriate warnings will
+ -- show up later during dependency checks
lints <-
- let lintPath p = loadAndLintMap (prefix </> p) depth <&> (p,)
+ let lintPath p = fmap (fmap (p,)) (loadAndLintMap (prefix </> p) depth)
where depth = length (splitPath p) - 1
- in mapM lintPath paths
+ in mapMaybeM lintPath paths
let mapdeps = concatMap
(\(m,res) ->
let ps = mapMaybe
(\case {LocalMap p -> Just p; _ -> Nothing})
- (mapresultDepends res)
+ (mapresultDepends $ res)
in map (FP.normalise . normalise (takeDirectory m)) ps
)
lints