diff options
Diffstat (limited to 'compiler/src/Files.hs')
-rw-r--r-- | compiler/src/Files.hs | 49 |
1 files changed, 30 insertions, 19 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 41fc5a8..8ea943f 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -29,7 +29,6 @@ module Files | |||
29 | 29 | ||
30 | 30 | ||
31 | import Control.Monad (mapM) | 31 | import Control.Monad (mapM) |
32 | import Data.Bool (bool) | ||
33 | import Data.List (isPrefixOf, length, subsequences) | 32 | import Data.List (isPrefixOf, length, subsequences) |
34 | import Data.Function ((&)) | 33 | import Data.Function ((&)) |
35 | import Data.Text (pack) | 34 | import Data.Text (pack) |
@@ -39,6 +38,7 @@ import qualified Data.Aeson as JSON | |||
39 | import System.Directory | 38 | import System.Directory |
40 | ( doesDirectoryExist | 39 | ( doesDirectoryExist |
41 | , doesPathExist | 40 | , doesPathExist |
41 | , canonicalizePath | ||
42 | , getModificationTime | 42 | , getModificationTime |
43 | , listDirectory | 43 | , listDirectory |
44 | , createDirectoryIfMissing | 44 | , createDirectoryIfMissing |
@@ -94,8 +94,13 @@ webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path | |||
94 | 94 | ||
95 | 95 | ||
96 | data FSNode = | 96 | data FSNode = |
97 | File { path :: Path } | 97 | File |
98 | | Dir { path :: Path, items :: [FSNode] } | 98 | { path :: Path |
99 | , canonicalPath :: FilePath } | ||
100 | | Dir | ||
101 | { path :: Path | ||
102 | , canonicalPath :: FilePath | ||
103 | , items :: [FSNode] } | ||
99 | deriving Show | 104 | deriving Show |
100 | 105 | ||
101 | data AnchoredFSNode = AnchoredFSNode | 106 | data AnchoredFSNode = AnchoredFSNode |
@@ -115,8 +120,8 @@ isHidden = hiddenName . nodeName | |||
115 | 120 | ||
116 | -- | DFS with intermediate dirs first. | 121 | -- | DFS with intermediate dirs first. |
117 | flattenDir :: FSNode -> [FSNode] | 122 | flattenDir :: FSNode -> [FSNode] |
118 | flattenDir file@(File _) = [file] | 123 | flattenDir file@File{} = [file] |
119 | flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items) | 124 | flattenDir dir@Dir{items} = dir:(concatMap flattenDir items) |
120 | 125 | ||
121 | -- | Filters a dir tree. The root is always returned. | 126 | -- | Filters a dir tree. The root is always returned. |
122 | filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode | 127 | filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode |
@@ -124,35 +129,41 @@ filterDir cond (AnchoredFSNode anchor root) = | |||
124 | AnchoredFSNode anchor (filterNode root) | 129 | AnchoredFSNode anchor (filterNode root) |
125 | where | 130 | where |
126 | filterNode :: FSNode -> FSNode | 131 | filterNode :: FSNode -> FSNode |
127 | filterNode file@(File _) = file | 132 | filterNode file@File{} = file |
128 | filterNode (Dir path items) = | 133 | filterNode Dir{path, canonicalPath, items} = |
129 | filter cond items & map filterNode & Dir path | 134 | filter cond items & map filterNode & Dir path canonicalPath |
130 | 135 | ||
131 | readDirectory :: LocalPath -> IO AnchoredFSNode | 136 | readDirectory :: LocalPath -> IO AnchoredFSNode |
132 | readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root | 137 | readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root |
133 | where | 138 | where |
134 | mkNode :: Path -> IO FSNode | 139 | mkNode :: Path -> IO FSNode |
135 | mkNode path = | 140 | mkNode path = |
136 | (doesDirectoryExist $ localPath (root /> path)) | 141 | do |
137 | >>= bool (mkFileNode path) (mkDirNode path) | 142 | let relPath = localPath (root /> path) |
138 | 143 | canonicalPath <- canonicalizePath relPath | |
139 | mkFileNode :: Path -> IO FSNode | 144 | isDir <- doesDirectoryExist relPath |
140 | mkFileNode path = return $ File path | 145 | if isDir then |
141 | 146 | mkDirNode path canonicalPath | |
142 | mkDirNode :: Path -> IO FSNode | 147 | else |
143 | mkDirNode path = | 148 | mkFileNode path canonicalPath |
149 | |||
150 | mkFileNode :: Path -> FilePath -> IO FSNode | ||
151 | mkFileNode path canonicalPath = return $ File path canonicalPath | ||
152 | |||
153 | mkDirNode :: Path -> FilePath -> IO FSNode | ||
154 | mkDirNode path canonicalPath = | ||
144 | (listDirectory $ localPath (root /> path)) | 155 | (listDirectory $ localPath (root /> path)) |
145 | >>= mapM (mkNode . ((</) path)) | 156 | >>= mapM (mkNode . ((</) path)) |
146 | >>= return . Dir path | 157 | >>= return . Dir path canonicalPath |
147 | 158 | ||
148 | copyTo :: FilePath -> AnchoredFSNode -> IO () | 159 | copyTo :: FilePath -> AnchoredFSNode -> IO () |
149 | copyTo target AnchoredFSNode{anchor, root} = copyNode root | 160 | copyTo target AnchoredFSNode{anchor, root} = copyNode root |
150 | where | 161 | where |
151 | copyNode :: FSNode -> IO () | 162 | copyNode :: FSNode -> IO () |
152 | copyNode (File path) = | 163 | copyNode File{path} = |
153 | copyFile (localPath $ anchor /> path) (localPath $ target /> path) | 164 | copyFile (localPath $ anchor /> path) (localPath $ target /> path) |
154 | 165 | ||
155 | copyNode (Dir path items) = | 166 | copyNode Dir{path, items} = |
156 | createDirectoryIfMissing True (localPath $ target /> path) | 167 | createDirectoryIfMissing True (localPath $ target /> path) |
157 | >> mapM_ copyNode items | 168 | >> mapM_ copyNode items |
158 | 169 | ||