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.hs15
1 files changed, 8 insertions, 7 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index c769815..40149e1 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -30,6 +30,7 @@ module Files
30 30
31import Data.List (isPrefixOf, length, subsequences, sortOn) 31import Data.List (isPrefixOf, length, subsequences, sortOn)
32import Data.Function ((&)) 32import Data.Function ((&))
33import Data.Functor ((<&>))
33import Data.Text (pack) 34import Data.Text (pack)
34import Data.Aeson (ToJSON) 35import Data.Aeson (ToJSON)
35import qualified Data.Aeson as JSON 36import qualified Data.Aeson as JSON
@@ -53,7 +54,7 @@ type LocalPath = String
53type WebPath = String 54type WebPath = String
54 55
55-- | Reversed path component list 56-- | Reversed path component list
56data Path = Path [FileName] deriving Show 57newtype Path = Path [FileName] deriving Show
57 58
58instance ToJSON Path where 59instance ToJSON Path where
59 toJSON = JSON.String . pack . webPath 60 toJSON = JSON.String . pack . webPath
@@ -120,7 +121,7 @@ isHidden = hiddenName . nodeName
120-- | DFS with intermediate dirs first. 121-- | DFS with intermediate dirs first.
121flattenDir :: FSNode -> [FSNode] 122flattenDir :: FSNode -> [FSNode]
122flattenDir file@File{} = [file] 123flattenDir file@File{} = [file]
123flattenDir dir@Dir{items} = dir:(concatMap flattenDir items) 124flattenDir dir@Dir{items} = dir:concatMap flattenDir items
124 125
125-- | Filters a dir tree. The root is always returned. 126-- | Filters a dir tree. The root is always returned.
126filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode 127filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
@@ -133,7 +134,7 @@ filterDir cond (AnchoredFSNode anchor root) =
133 filter cond items & map filterNode & Dir path canonicalPath 134 filter cond items & map filterNode & Dir path canonicalPath
134 135
135readDirectory :: LocalPath -> IO AnchoredFSNode 136readDirectory :: LocalPath -> IO AnchoredFSNode
136readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root 137readDirectory root = AnchoredFSNode root <$> mkNode (Path [])
137 where 138 where
138 mkNode :: Path -> IO FSNode 139 mkNode :: Path -> IO FSNode
139 mkNode path = 140 mkNode path =
@@ -151,10 +152,10 @@ readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
151 152
152 mkDirNode :: Path -> FilePath -> IO FSNode 153 mkDirNode :: Path -> FilePath -> IO FSNode
153 mkDirNode path canonicalPath = 154 mkDirNode path canonicalPath =
154 (listDirectory $ localPath (root /> path)) 155 listDirectory (localPath (root /> path))
155 >>= mapM (mkNode . ((</) path)) 156 >>= mapM (mkNode . (path </))
156 >>= return . sortOn nodeName 157 <&> sortOn nodeName
157 >>= return . Dir path canonicalPath 158 <&> Dir path canonicalPath
158 159
159copyTo :: FilePath -> AnchoredFSNode -> IO () 160copyTo :: FilePath -> AnchoredFSNode -> IO ()
160copyTo target AnchoredFSNode{anchor, root} = copyNode root 161copyTo target AnchoredFSNode{anchor, root} = copyNode root