Keep directory lists sorted
[barrelfish] / hake / TreeDB.hs
1 module TreeDB(
2     DirList,
3     dlEmpty, dlByExt, dlByExts, dlAdd, dlAddByExt,
4
5     TreeDB,
6     tdbEmpty, tdbByDir, tdbAdd, tdbAddDir,
7     tdbBuild,
8
9     tdbByDirExt, tdbByDirExts
10     )
11 where
12
13 import qualified Data.ByteString.Char8 as C
14 import Data.List
15 import Data.Trie(Trie)
16 import qualified Data.Trie as T
17 import Data.Typeable
18
19 import System.FilePath
20
21 --
22 -- The files in a directory, partitioned by extension.
23 --
24 type DirList = [(String, [String])]
25
26 dlEmpty :: DirList
27 dlEmpty = []
28
29 -- Linear search for files by extension, in a single directory.
30 dlByExt :: String -> DirList -> [String]
31 dlByExt _ [] = []
32 dlByExt ext ((ext', names) : dirlist)
33     | ext' == ext = [n <.> ext' | n <- names]
34     | otherwise = dlByExt ext dirlist
35
36 -- Search for multiple extensions at once.  'exts' must be sorted, with no
37 -- duplicates.
38 dlByExts :: [String] -> DirList -> [String]
39 dlByExts _ [] = []
40 dlByExts [] _ = []
41 dlByExts (ext:exts) ((ext', names):dirlist) =
42     case compare ext ext' of
43         -- 'ext' isn't in the list.
44         LT -> dlByExts exts ((ext', names):dirlist)
45         -- 'ext' is right here.
46         EQ -> [n <.> ext' | n <- names] ++ dlByExts exts dirlist
47         -- 'ext' may be in the remainder.  Nothing else can match here.
48         GT -> dlByExts (ext:exts) dirlist
49
50 -- Insert a file, given its extension.  Again linear.
51 dlAdd :: FilePath -> DirList -> DirList
52 dlAdd file dirList =
53     dlAddByExt (takeExtension file) (dropExtension file) dirList
54
55 -- Keeps the list sorted by extension
56 dlAddByExt ::  String -> String -> DirList -> DirList
57 dlAddByExt ext name [] = [(ext, [name])]
58 dlAddByExt ext name ((ext', names):dirlist) =
59     case compare ext ext' of
60         LT -> (ext, [name]):(ext', names):dirlist
61         EQ -> (ext', name:names):dirlist
62         GT -> (ext', names):(dlAddByExt ext name dirlist)
63
64 --
65 -- A map from directory to contents, excluding subdirectories.
66 --
67 type TreeDB = Trie DirList
68
69 deriving instance Typeable1 Trie
70
71 tdbEmpty :: TreeDB
72 tdbEmpty  = T.empty
73
74 -- Get directory contents by directory path
75 tdbByDir :: FilePath -> TreeDB -> Maybe DirList
76 tdbByDir path treeDB = T.lookup (C.pack path) treeDB
77
78 -- Add a file
79 tdbAdd :: FilePath -> TreeDB -> TreeDB
80 tdbAdd path treeDB
81     | T.member dirS treeDB =
82         T.adjust (\dirList -> dlAdd file dirList) dirS treeDB
83     | otherwise =
84         T.insert dirS (dlAdd file dlEmpty) treeDB
85     where
86         dir = takeDirectory path
87         file = takeFileName path
88         dirS = C.pack dir
89
90 -- Add a directory, complete with (relative) contents
91 tdbAddDir :: FilePath -> [FilePath] -> TreeDB -> TreeDB
92 tdbAddDir dir files treeDB
93     | T.member dirS treeDB =
94         T.adjust (\dirList -> foldr dlAdd dirList files) dirS treeDB
95     | otherwise =
96         T.insert dirS (foldr dlAdd dlEmpty files) treeDB
97     where
98         dirS = C.pack dir
99
100 tdbBuild :: [FilePath] -> TreeDB
101 tdbBuild files = foldr tdbAdd tdbEmpty files
102
103 --
104 -- Combined queries
105 --
106
107 -- Find files by directory and extension
108 tdbByDirExt :: FilePath -> String -> TreeDB -> Maybe [FilePath]
109 tdbByDirExt path ext treeDB = do
110     dirList <- tdbByDir path treeDB
111     let filenames = dlByExt ext dirList
112     return [ path </> file | file <- filenames ]
113
114 -- Look for multiple extensions.  'exts' need not be sorted.
115 tdbByDirExts :: FilePath -> [String] -> TreeDB -> Maybe [FilePath]
116 tdbByDirExts path exts treeDB = do
117     dirList <- tdbByDir path treeDB
118     let filenames = dlByExts (sort exts) dirList
119     return [ path </> file | file <- filenames ]