diff options
Diffstat (limited to 'compiler/src/Files.hs')
-rw-r--r-- | compiler/src/Files.hs | 55 |
1 files changed, 33 insertions, 22 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 41fc5a8..c769815 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -28,9 +28,7 @@ module Files | |||
28 | ) where | 28 | ) where |
29 | 29 | ||
30 | 30 | ||
31 | import Control.Monad (mapM) | 31 | import Data.List (isPrefixOf, length, subsequences, sortOn) |
32 | import Data.Bool (bool) | ||
33 | import Data.List (isPrefixOf, length, subsequences) | ||
34 | import Data.Function ((&)) | 32 | import Data.Function ((&)) |
35 | import Data.Text (pack) | 33 | import Data.Text (pack) |
36 | import Data.Aeson (ToJSON) | 34 | import Data.Aeson (ToJSON) |
@@ -39,6 +37,7 @@ import qualified Data.Aeson as JSON | |||
39 | import System.Directory | 37 | import System.Directory |
40 | ( doesDirectoryExist | 38 | ( doesDirectoryExist |
41 | , doesPathExist | 39 | , doesPathExist |
40 | , canonicalizePath | ||
42 | , getModificationTime | 41 | , getModificationTime |
43 | , listDirectory | 42 | , listDirectory |
44 | , createDirectoryIfMissing | 43 | , createDirectoryIfMissing |
@@ -53,7 +52,7 @@ type FileName = String | |||
53 | type LocalPath = String | 52 | type LocalPath = String |
54 | type WebPath = String | 53 | type WebPath = String |
55 | 54 | ||
56 | -- | Reversed path component list | 55 | -- | Reversed path component list |
57 | data Path = Path [FileName] deriving Show | 56 | data Path = Path [FileName] deriving Show |
58 | 57 | ||
59 | instance ToJSON Path where | 58 | instance ToJSON Path where |
@@ -94,8 +93,13 @@ webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path | |||
94 | 93 | ||
95 | 94 | ||
96 | data FSNode = | 95 | data FSNode = |
97 | File { path :: Path } | 96 | File |
98 | | Dir { path :: Path, items :: [FSNode] } | 97 | { path :: Path |
98 | , canonicalPath :: FilePath } | ||
99 | | Dir | ||
100 | { path :: Path | ||
101 | , canonicalPath :: FilePath | ||
102 | , items :: [FSNode] } | ||
99 | deriving Show | 103 | deriving Show |
100 | 104 | ||
101 | data AnchoredFSNode = AnchoredFSNode | 105 | data AnchoredFSNode = AnchoredFSNode |
@@ -115,8 +119,8 @@ isHidden = hiddenName . nodeName | |||
115 | 119 | ||
116 | -- | DFS with intermediate dirs first. | 120 | -- | DFS with intermediate dirs first. |
117 | flattenDir :: FSNode -> [FSNode] | 121 | flattenDir :: FSNode -> [FSNode] |
118 | flattenDir file@(File _) = [file] | 122 | flattenDir file@File{} = [file] |
119 | flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items) | 123 | flattenDir dir@Dir{items} = dir:(concatMap flattenDir items) |
120 | 124 | ||
121 | -- | Filters a dir tree. The root is always returned. | 125 | -- | Filters a dir tree. The root is always returned. |
122 | filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode | 126 | filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode |
@@ -124,35 +128,42 @@ filterDir cond (AnchoredFSNode anchor root) = | |||
124 | AnchoredFSNode anchor (filterNode root) | 128 | AnchoredFSNode anchor (filterNode root) |
125 | where | 129 | where |
126 | filterNode :: FSNode -> FSNode | 130 | filterNode :: FSNode -> FSNode |
127 | filterNode file@(File _) = file | 131 | filterNode file@File{} = file |
128 | filterNode (Dir path items) = | 132 | filterNode Dir{path, canonicalPath, items} = |
129 | filter cond items & map filterNode & Dir path | 133 | filter cond items & map filterNode & Dir path canonicalPath |
130 | 134 | ||
131 | readDirectory :: LocalPath -> IO AnchoredFSNode | 135 | readDirectory :: LocalPath -> IO AnchoredFSNode |
132 | readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root | 136 | readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root |
133 | where | 137 | where |
134 | mkNode :: Path -> IO FSNode | 138 | mkNode :: Path -> IO FSNode |
135 | mkNode path = | 139 | mkNode path = |
136 | (doesDirectoryExist $ localPath (root /> path)) | 140 | do |
137 | >>= bool (mkFileNode path) (mkDirNode path) | 141 | let relPath = localPath (root /> path) |
138 | 142 | canonicalPath <- canonicalizePath relPath | |
139 | mkFileNode :: Path -> IO FSNode | 143 | isDir <- doesDirectoryExist relPath |
140 | mkFileNode path = return $ File path | 144 | if isDir then |
141 | 145 | mkDirNode path canonicalPath | |
142 | mkDirNode :: Path -> IO FSNode | 146 | else |
143 | mkDirNode path = | 147 | mkFileNode path canonicalPath |
148 | |||
149 | mkFileNode :: Path -> FilePath -> IO FSNode | ||
150 | mkFileNode path canonicalPath = return $ File path canonicalPath | ||
151 | |||
152 | mkDirNode :: Path -> FilePath -> IO FSNode | ||
153 | mkDirNode path canonicalPath = | ||
144 | (listDirectory $ localPath (root /> path)) | 154 | (listDirectory $ localPath (root /> path)) |
145 | >>= mapM (mkNode . ((</) path)) | 155 | >>= mapM (mkNode . ((</) path)) |
146 | >>= return . Dir path | 156 | >>= return . sortOn nodeName |
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 | ||