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.hs36
1 files changed, 23 insertions, 13 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index c769815..023546b 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -20,7 +20,7 @@ module Files
20 ( FileName, LocalPath, WebPath, Path(..) 20 ( FileName, LocalPath, WebPath, Path(..)
21 , (</>), (</), (/>), (<.>) 21 , (</>), (</), (/>), (<.>)
22 , fileName, subPaths, pathLength 22 , fileName, subPaths, pathLength
23 , localPath, webPath 23 , localPath, webPath, fromWebPath
24 , FSNode(..), AnchoredFSNode(..) 24 , FSNode(..), AnchoredFSNode(..)
25 , nodeName, isHidden, flattenDir, filterDir 25 , nodeName, isHidden, flattenDir, filterDir
26 , readDirectory, copyTo 26 , readDirectory, copyTo
@@ -28,10 +28,11 @@ module Files
28 ) where 28 ) where
29 29
30 30
31import Data.List (isPrefixOf, length, subsequences, sortOn) 31import Data.List (isPrefixOf, length, sortOn)
32import Data.Function ((&)) 32import Data.Function ((&))
33import Data.Text (pack) 33import Data.Functor ((<&>))
34import Data.Aeson (ToJSON) 34import Data.Text (pack, unpack)
35import Data.Aeson (ToJSON, FromJSON)
35import qualified Data.Aeson as JSON 36import qualified Data.Aeson as JSON
36 37
37import System.Directory 38import System.Directory
@@ -53,13 +54,16 @@ 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
60 61
62instance FromJSON Path where
63 parseJSON = JSON.withText "Path" (return . fromWebPath . unpack)
64
61instance Eq Path where 65instance Eq Path where
62 (Path left) == (Path right) = left == right 66 left == right = webPath left == webPath right
63 67
64(</>) :: Path -> Path -> Path 68(</>) :: Path -> Path -> Path
65(Path l) </> (Path r) = Path (r ++ l) 69(Path l) </> (Path r) = Path (r ++ l)
@@ -80,7 +84,10 @@ fileName (Path (name:_)) = Just name
80fileName _ = Nothing 84fileName _ = Nothing
81 85
82subPaths :: Path -> [Path] 86subPaths :: Path -> [Path]
83subPaths (Path path) = map Path $ subsequences path 87subPaths (Path path) = map Path $ subpaths path
88 where
89 subpaths [] = []
90 subpaths full@(_:r) = full : subpaths r
84 91
85pathLength :: Path -> Int 92pathLength :: Path -> Int
86pathLength (Path path) = Data.List.length path 93pathLength (Path path) = Data.List.length path
@@ -91,6 +98,9 @@ localPath (Path path) = System.FilePath.joinPath $ reverse path
91webPath :: Path -> WebPath 98webPath :: Path -> WebPath
92webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path 99webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
93 100
101fromWebPath :: WebPath -> Path
102fromWebPath = Path . reverse . System.FilePath.Posix.splitDirectories
103
94 104
95data FSNode = 105data FSNode =
96 File 106 File
@@ -120,7 +130,7 @@ isHidden = hiddenName . nodeName
120-- | DFS with intermediate dirs first. 130-- | DFS with intermediate dirs first.
121flattenDir :: FSNode -> [FSNode] 131flattenDir :: FSNode -> [FSNode]
122flattenDir file@File{} = [file] 132flattenDir file@File{} = [file]
123flattenDir dir@Dir{items} = dir:(concatMap flattenDir items) 133flattenDir dir@Dir{items} = dir:concatMap flattenDir items
124 134
125-- | Filters a dir tree. The root is always returned. 135-- | Filters a dir tree. The root is always returned.
126filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode 136filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
@@ -133,7 +143,7 @@ filterDir cond (AnchoredFSNode anchor root) =
133 filter cond items & map filterNode & Dir path canonicalPath 143 filter cond items & map filterNode & Dir path canonicalPath
134 144
135readDirectory :: LocalPath -> IO AnchoredFSNode 145readDirectory :: LocalPath -> IO AnchoredFSNode
136readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root 146readDirectory root = AnchoredFSNode root <$> mkNode (Path [])
137 where 147 where
138 mkNode :: Path -> IO FSNode 148 mkNode :: Path -> IO FSNode
139 mkNode path = 149 mkNode path =
@@ -151,10 +161,10 @@ readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
151 161
152 mkDirNode :: Path -> FilePath -> IO FSNode 162 mkDirNode :: Path -> FilePath -> IO FSNode
153 mkDirNode path canonicalPath = 163 mkDirNode path canonicalPath =
154 (listDirectory $ localPath (root /> path)) 164 listDirectory (localPath (root /> path))
155 >>= mapM (mkNode . ((</) path)) 165 >>= mapM (mkNode . (path </))
156 >>= return . sortOn nodeName 166 <&> sortOn nodeName
157 >>= return . Dir path canonicalPath 167 <&> Dir path canonicalPath
158 168
159copyTo :: FilePath -> AnchoredFSNode -> IO () 169copyTo :: FilePath -> AnchoredFSNode -> IO ()
160copyTo target AnchoredFSNode{anchor, root} = copyNode root 170copyTo target AnchoredFSNode{anchor, root} = copyNode root