diff options
Diffstat (limited to 'compiler/src/Files.hs')
-rw-r--r-- | compiler/src/Files.hs | 45 |
1 files changed, 33 insertions, 12 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index d1363a1..457f1da 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -23,7 +23,8 @@ | |||
23 | 23 | ||
24 | module Files | 24 | module Files |
25 | ( FileName, LocalPath, WebPath, Path | 25 | ( FileName, LocalPath, WebPath, Path |
26 | , (</>), (</), (/>), (<.>), localPath, webPath | 26 | , (</>), (</), (/>), (<.>), fileName, subPaths, pathLength |
27 | , localPath, webPath | ||
27 | , FSNode(..), AnchoredFSNode(..) | 28 | , FSNode(..), AnchoredFSNode(..) |
28 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory | 29 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory |
29 | , ensureParentDir, remove, isOutdated | 30 | , ensureParentDir, remove, isOutdated |
@@ -32,8 +33,12 @@ module Files | |||
32 | 33 | ||
33 | import Control.Monad (filterM, mapM) | 34 | import Control.Monad (filterM, mapM) |
34 | import Data.Bool (bool) | 35 | import Data.Bool (bool) |
35 | import Data.List (isPrefixOf, length, deleteBy) | 36 | import Data.List (isPrefixOf, length, deleteBy, subsequences) |
36 | import Data.Function ((&)) | 37 | import Data.Function ((&)) |
38 | import Data.Text (pack) | ||
39 | import Data.Aeson (ToJSON) | ||
40 | import qualified Data.Aeson as JSON | ||
41 | |||
37 | import System.Directory | 42 | import System.Directory |
38 | ( doesDirectoryExist | 43 | ( doesDirectoryExist |
39 | , doesPathExist | 44 | , doesPathExist |
@@ -51,25 +56,41 @@ type LocalPath = String | |||
51 | type WebPath = String | 56 | type WebPath = String |
52 | 57 | ||
53 | -- | Reversed path component list | 58 | -- | Reversed path component list |
54 | type Path = [FileName] | 59 | data Path = Path [FileName] deriving Show |
60 | |||
61 | instance ToJSON Path where | ||
62 | toJSON = JSON.String . pack . webPath | ||
63 | |||
64 | instance Eq Path where | ||
65 | (Path left) == (Path right) = left == right | ||
55 | 66 | ||
56 | (</>) :: Path -> Path -> Path | 67 | (</>) :: Path -> Path -> Path |
57 | l </> r = r ++ l | 68 | (Path l) </> (Path r) = Path (r ++ l) |
58 | 69 | ||
59 | (</) :: Path -> FileName -> Path | 70 | (</) :: Path -> FileName -> Path |
60 | path </ file = file:path | 71 | (Path path) </ file = Path (file:path) |
61 | 72 | ||
62 | (/>) :: FileName -> Path -> Path | 73 | (/>) :: FileName -> Path -> Path |
63 | file /> path = path ++ [file] | 74 | file /> (Path path) = Path (path ++ [file]) |
64 | 75 | ||
65 | (<.>) :: Path -> String -> Path | 76 | (<.>) :: Path -> String -> Path |
66 | (filename:pathto) <.> ext = System.FilePath.addExtension filename ext : pathto | 77 | (Path (filename:pathto)) <.> ext = |
78 | Path $ System.FilePath.addExtension filename ext : pathto | ||
79 | |||
80 | fileName :: Path -> FileName | ||
81 | fileName (Path (name:_)) = name | ||
82 | |||
83 | subPaths :: Path -> [Path] | ||
84 | subPaths (Path path) = map (Path . subsequences) path | ||
85 | |||
86 | pathLength :: Path -> Int | ||
87 | pathLength (Path path) = Data.List.length path | ||
67 | 88 | ||
68 | localPath :: Path -> LocalPath | 89 | localPath :: Path -> LocalPath |
69 | localPath = System.FilePath.joinPath . reverse | 90 | localPath (Path path) = System.FilePath.joinPath $ reverse path |
70 | 91 | ||
71 | webPath :: Path -> WebPath | 92 | webPath :: Path -> WebPath |
72 | webPath = System.FilePath.Posix.joinPath . reverse | 93 | webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path |
73 | 94 | ||
74 | 95 | ||
75 | data FSNode = File Path | Dir Path [FSNode] deriving Show | 96 | data FSNode = File Path | Dir Path [FSNode] deriving Show |
@@ -82,10 +103,10 @@ nodePath (File path) = path | |||
82 | nodePath (Dir path _) = path | 103 | nodePath (Dir path _) = path |
83 | 104 | ||
84 | nodeName :: FSNode -> FileName | 105 | nodeName :: FSNode -> FileName |
85 | nodeName = head . nodePath | 106 | nodeName = fileName . nodePath |
86 | 107 | ||
87 | isHidden :: FSNode -> Bool | 108 | isHidden :: FSNode -> Bool |
88 | isHidden node = "." `isPrefixOf` filename && length filename > 1 | 109 | isHidden node = "." `isPrefixOf` filename &&length filename > 1 |
89 | where filename = nodeName node | 110 | where filename = nodeName node |
90 | 111 | ||
91 | -- | DFS with intermediate dirs first. | 112 | -- | DFS with intermediate dirs first. |
@@ -104,7 +125,7 @@ filterDir cond (AnchoredFSNode anchor root) = | |||
104 | filter cond items & map filterNode & Dir path | 125 | filter cond items & map filterNode & Dir path |
105 | 126 | ||
106 | readDirectory :: LocalPath -> IO AnchoredFSNode | 127 | readDirectory :: LocalPath -> IO AnchoredFSNode |
107 | readDirectory root = mkNode [] >>= return . AnchoredFSNode root | 128 | readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root |
108 | where | 129 | where |
109 | mkNode :: Path -> IO FSNode | 130 | mkNode :: Path -> IO FSNode |
110 | mkNode path = | 131 | mkNode path = |