d1ca526ff9dbd662f04f69e70d12defe2db0f0c0
[barrelfish] / hake / TreeDB.hs
1 module TreeDB(
2     DirList,
3     dlEmpty, dlByExt, dlAdd, dlAddByExt,
4
5     TreeDB,
6     tdbEmpty, tdbByDir, tdbAdd, tdbAddDir,
7     tdbBuild,
8
9     tdbByDirExt
10     )
11 where
12
13 import qualified Data.ByteString.Char8 as C
14 import Data.Trie(Trie)
15 import qualified Data.Trie as T
16 import Data.Typeable
17
18 import System.FilePath
19
20 --
21 -- The files in a directory, partitioned by extension.
22 --
23 type DirList = [(String, [String])]
24
25 dlEmpty :: DirList
26 dlEmpty = []
27
28 -- Linear search for files by extension, in a single directory.
29 dlByExt :: String -> DirList -> [String]
30 dlByExt _ [] = []
31 dlByExt ext ((ext', names) : dirlist)
32     | ext == ext' = names
33     | otherwise = dlByExt ext dirlist
34
35 -- Insert a file, given its extension.  Again linear.
36 dlAdd :: FilePath -> DirList -> DirList
37 dlAdd file dirList =
38     dlAddByExt (takeExtension file) (dropExtension file) dirList
39
40 dlAddByExt ::  String -> String -> DirList -> DirList
41 dlAddByExt ext name [] = [(ext, [name])]
42 dlAddByExt ext name ((ext', names):dirlist)
43     | ext == ext' = (ext', name:names):dirlist
44     | otherwise = (ext', names):(dlAddByExt ext name dirlist)
45
46 --
47 -- A map from directory to contents, excluding subdirectories.
48 --
49 type TreeDB = Trie DirList
50
51 deriving instance Typeable1 Trie
52
53 tdbEmpty :: TreeDB
54 tdbEmpty  = T.empty
55
56 -- Get directory contents by directory path
57 tdbByDir :: FilePath -> TreeDB -> Maybe DirList
58 tdbByDir path treeDB = T.lookup (C.pack path) treeDB
59
60 -- Add a file
61 tdbAdd :: FilePath -> TreeDB -> TreeDB
62 tdbAdd path treeDB
63     | T.member dirS treeDB =
64         T.adjust (\dirList -> dlAdd file dirList) dirS treeDB
65     | otherwise =
66         T.insert dirS (dlAdd file dlEmpty) treeDB
67     where
68         dir = takeDirectory path
69         file = takeFileName path
70         dirS = C.pack dir
71
72 -- Add a directory, complete with (relative) contents
73 tdbAddDir :: FilePath -> [FilePath] -> TreeDB -> TreeDB
74 tdbAddDir dir files treeDB
75     | T.member dirS treeDB =
76         T.adjust (\dirList -> foldr dlAdd dirList files) dirS treeDB
77     | otherwise =
78         T.insert dirS (foldr dlAdd dlEmpty files) treeDB
79     where
80         dirS = C.pack dir
81
82 tdbBuild :: [FilePath] -> TreeDB
83 tdbBuild files = foldr tdbAdd tdbEmpty files
84
85 --
86 -- Combined queries
87 --
88
89 -- Find files by directory and extension
90 tdbByDirExt :: FilePath -> String -> TreeDB -> Maybe [FilePath]
91 tdbByDirExt path ext treeDB = do
92     dirList <- tdbByDir path treeDB
93     let basenames = dlByExt ext dirList
94     return [ path </> base <.> ext | base <- basenames ]