diff options
Diffstat (limited to 'compiler/src/Files.hs')
-rw-r--r-- | compiler/src/Files.hs | 36 |
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 | ||
31 | import Data.List (isPrefixOf, length, subsequences, sortOn) | 31 | import Data.List (isPrefixOf, length, sortOn) |
32 | import Data.Function ((&)) | 32 | import Data.Function ((&)) |
33 | import Data.Text (pack) | 33 | import Data.Functor ((<&>)) |
34 | import Data.Aeson (ToJSON) | 34 | import Data.Text (pack, unpack) |
35 | import Data.Aeson (ToJSON, FromJSON) | ||
35 | import qualified Data.Aeson as JSON | 36 | import qualified Data.Aeson as JSON |
36 | 37 | ||
37 | import System.Directory | 38 | import System.Directory |
@@ -53,13 +54,16 @@ type LocalPath = String | |||
53 | type WebPath = String | 54 | type WebPath = String |
54 | 55 | ||
55 | -- | Reversed path component list | 56 | -- | Reversed path component list |
56 | data Path = Path [FileName] deriving Show | 57 | newtype Path = Path [FileName] deriving Show |
57 | 58 | ||
58 | instance ToJSON Path where | 59 | instance ToJSON Path where |
59 | toJSON = JSON.String . pack . webPath | 60 | toJSON = JSON.String . pack . webPath |
60 | 61 | ||
62 | instance FromJSON Path where | ||
63 | parseJSON = JSON.withText "Path" (return . fromWebPath . unpack) | ||
64 | |||
61 | instance Eq Path where | 65 | instance 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 | |||
80 | fileName _ = Nothing | 84 | fileName _ = Nothing |
81 | 85 | ||
82 | subPaths :: Path -> [Path] | 86 | subPaths :: Path -> [Path] |
83 | subPaths (Path path) = map Path $ subsequences path | 87 | subPaths (Path path) = map Path $ subpaths path |
88 | where | ||
89 | subpaths [] = [] | ||
90 | subpaths full@(_:r) = full : subpaths r | ||
84 | 91 | ||
85 | pathLength :: Path -> Int | 92 | pathLength :: Path -> Int |
86 | pathLength (Path path) = Data.List.length path | 93 | pathLength (Path path) = Data.List.length path |
@@ -91,6 +98,9 @@ localPath (Path path) = System.FilePath.joinPath $ reverse path | |||
91 | webPath :: Path -> WebPath | 98 | webPath :: Path -> WebPath |
92 | webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path | 99 | webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path |
93 | 100 | ||
101 | fromWebPath :: WebPath -> Path | ||
102 | fromWebPath = Path . reverse . System.FilePath.Posix.splitDirectories | ||
103 | |||
94 | 104 | ||
95 | data FSNode = | 105 | data FSNode = |
96 | File | 106 | File |
@@ -120,7 +130,7 @@ isHidden = hiddenName . nodeName | |||
120 | -- | DFS with intermediate dirs first. | 130 | -- | DFS with intermediate dirs first. |
121 | flattenDir :: FSNode -> [FSNode] | 131 | flattenDir :: FSNode -> [FSNode] |
122 | flattenDir file@File{} = [file] | 132 | flattenDir file@File{} = [file] |
123 | flattenDir dir@Dir{items} = dir:(concatMap flattenDir items) | 133 | flattenDir 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. |
126 | filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode | 136 | filterDir :: (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 | ||
135 | readDirectory :: LocalPath -> IO AnchoredFSNode | 145 | readDirectory :: LocalPath -> IO AnchoredFSNode |
136 | readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root | 146 | readDirectory 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 | ||
159 | copyTo :: FilePath -> AnchoredFSNode -> IO () | 169 | copyTo :: FilePath -> AnchoredFSNode -> IO () |
160 | copyTo target AnchoredFSNode{anchor, root} = copyNode root | 170 | copyTo target AnchoredFSNode{anchor, root} = copyNode root |