blob: 1ca71eb9697af85454d9e655755044a1625e9ffe (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
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'
|
