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.hs55
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
31import Control.Monad (mapM) 31import Data.List (isPrefixOf, length, subsequences, sortOn)
32import Data.Bool (bool)
33import Data.List (isPrefixOf, length, subsequences)
34import Data.Function ((&)) 32import Data.Function ((&))
35import Data.Text (pack) 33import Data.Text (pack)
36import Data.Aeson (ToJSON) 34import Data.Aeson (ToJSON)
@@ -39,6 +37,7 @@ import qualified Data.Aeson as JSON
39import System.Directory 37import 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
53type LocalPath = String 52type LocalPath = String
54type WebPath = String 53type WebPath = String
55 54
56 -- | Reversed path component list 55-- | Reversed path component list
57data Path = Path [FileName] deriving Show 56data Path = Path [FileName] deriving Show
58 57
59instance ToJSON Path where 58instance ToJSON Path where
@@ -94,8 +93,13 @@ webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
94 93
95 94
96data FSNode = 95data 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
101data AnchoredFSNode = AnchoredFSNode 105data AnchoredFSNode = AnchoredFSNode
@@ -115,8 +119,8 @@ isHidden = hiddenName . nodeName
115 119
116-- | DFS with intermediate dirs first. 120-- | DFS with intermediate dirs first.
117flattenDir :: FSNode -> [FSNode] 121flattenDir :: FSNode -> [FSNode]
118flattenDir file@(File _) = [file] 122flattenDir file@File{} = [file]
119flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items) 123flattenDir 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.
122filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode 126filterDir :: (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
131readDirectory :: LocalPath -> IO AnchoredFSNode 135readDirectory :: LocalPath -> IO AnchoredFSNode
132readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root 136readDirectory 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
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