diff options
Diffstat (limited to 'lib/CheckDir.hs')
-rw-r--r-- | lib/CheckDir.hs | 76 |
1 files changed, 76 insertions, 0 deletions
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs new file mode 100644 index 0000000..1ca71eb --- /dev/null +++ b/lib/CheckDir.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Module that contains high-level checking for an entire directory +module CheckDir (recursiveCheckDir) where + +import CheckMap (MapResult, loadAndLintMap, mapresultDepends) +import Data.Aeson (ToJSON) +import Data.Map (Map) +import qualified Data.Map as M +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics (Generic) +import Paths (normalise) +import Types (Dep (LocalMap)) +import Util (PrettyPrint (prettyprint)) + + +data DirResult = DirResult + { dirresultMaps :: [MapResult] + , dirresultDeps :: [Text] + } deriving (Generic, ToJSON) + + +instance PrettyPrint DirResult where + prettyprint res = "Here's a result:" <> T.concat (map prettyprint $ dirresultMaps res) + +-- 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 () + + +instance Semigroup DirResult where + a <> b = DirResult + { dirresultMaps = dirresultMaps a <> dirresultMaps b + , dirresultDeps = dirresultDeps a <> dirresultDeps b + } + +instance Monoid DirResult where + mempty = DirResult + { dirresultMaps = [] + , dirresultDeps = [] + } + + +-- TODO: options? +recursiveCheckDir :: FilePath -> IO DirResult +recursiveCheckDir root = recursiveCheckDir' [root] mempty mempty + + +recursiveCheckDir' :: [FilePath] -> Set FilePath -> DirResult -> IO DirResult +recursiveCheckDir' paths done acc = do + putStrLn $ "linting " <> show paths + -- lint all maps in paths + lints <- mapM loadAndLintMap paths + -- get new deps + let deps = concatMap mapresultDepends lints + -- filter deps for map dependencies + let mapdeps = + map (\(LocalMap path) -> normalise path) + . filter (\case { LocalMap _ -> True; _ -> False }) + $ deps + -- build a Map FilePath () containing all map dependencies + let mapmapdeps = M.fromList $ zip mapdeps (repeat ()) + -- take difference of that with what's already done (O(m+n)) + let unknowns = map fst . M.toList $ M.difference mapmapdeps done + let known = M.union done . M.fromList . zip paths $ repeat () + + let acc' = acc <> DirResult + { dirresultMaps = lints + , dirresultDeps = [] } + case unknowns of + [] -> pure acc' + _ -> recursiveCheckDir' unknowns known acc' |