diff options
Diffstat (limited to '')
-rw-r--r-- | lib/CheckDir.hs | 19 |
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 |