summaryrefslogtreecommitdiff
path: root/lib/CheckDir.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/CheckDir.hs')
-rw-r--r--lib/CheckDir.hs76
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'