3 dlEmpty, dlByExt, dlByExts, dlAdd, dlAddByExt,
6 tdbEmpty, tdbByDir, tdbAdd, tdbAddDir,
9 tdbByDirExt, tdbByDirExts
13 import qualified Data.ByteString.Char8 as C
15 import Data.Trie(Trie)
16 import qualified Data.Trie as T
19 import System.FilePath
22 -- The files in a directory, partitioned by extension.
24 type DirList = [(String, [String])]
29 -- Linear search for files by extension, in a single directory.
30 dlByExt :: String -> DirList -> [String]
32 dlByExt ext ((ext', names) : dirlist)
33 | ext' == ext = [n <.> ext' | n <- names]
34 | otherwise = dlByExt ext dirlist
36 -- Search for multiple extensions at once. 'exts' must be sorted, with no
38 dlByExts :: [String] -> DirList -> [String]
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
50 -- Insert a file, given its extension. Again linear.
51 dlAdd :: FilePath -> DirList -> DirList
53 dlAddByExt (takeExtension file) (dropExtension file) dirList
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)
65 -- A map from directory to contents, excluding subdirectories.
67 type TreeDB = Trie DirList
69 deriving instance Typeable1 Trie
74 -- Get directory contents by directory path
75 tdbByDir :: FilePath -> TreeDB -> Maybe DirList
76 tdbByDir path treeDB = T.lookup (C.pack path) treeDB
79 tdbAdd :: FilePath -> TreeDB -> TreeDB
81 | T.member dirS treeDB =
82 T.adjust (\dirList -> dlAdd file dirList) dirS treeDB
84 T.insert dirS (dlAdd file dlEmpty) treeDB
86 dir = takeDirectory path
87 file = takeFileName path
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
96 T.insert dirS (foldr dlAdd dlEmpty files) treeDB
100 tdbBuild :: [FilePath] -> TreeDB
101 tdbBuild files = foldr tdbAdd tdbEmpty files
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 ]
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 ]