aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Files.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Files.hs')
-rw-r--r--compiler/src/Files.hs49
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
31import Control.Monad (mapM) 31import Control.Monad (mapM)
32import Data.Bool (bool)
33import Data.List (isPrefixOf, length, subsequences) 32import Data.List (isPrefixOf, length, subsequences)
34import Data.Function ((&)) 33import Data.Function ((&))
35import Data.Text (pack) 34import Data.Text (pack)
@@ -39,6 +38,7 @@ import qualified Data.Aeson as JSON
39import System.Directory 38import 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
96data FSNode = 96data 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
101data AnchoredFSNode = AnchoredFSNode 106data AnchoredFSNode = AnchoredFSNode
@@ -115,8 +120,8 @@ isHidden = hiddenName . nodeName
115 120
116-- | DFS with intermediate dirs first. 121-- | DFS with intermediate dirs first.
117flattenDir :: FSNode -> [FSNode] 122flattenDir :: FSNode -> [FSNode]
118flattenDir file@(File _) = [file] 123flattenDir file@File{} = [file]
119flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items) 124flattenDir 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.
122filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode 127filterDir :: (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
131readDirectory :: LocalPath -> IO AnchoredFSNode 136readDirectory :: LocalPath -> IO AnchoredFSNode
132readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root 137readDirectory 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
148copyTo :: FilePath -> AnchoredFSNode -> IO () 159copyTo :: FilePath -> AnchoredFSNode -> IO ()
149copyTo target AnchoredFSNode{anchor, root} = copyNode root 160copyTo 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