aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Files.hs
diff options
context:
space:
mode:
authorpacien2019-12-30 01:40:55 +0100
committerpacien2019-12-30 01:40:55 +0100
commit8a75458290002c765a0fa673912c162020de2bd1 (patch)
treedd8a6302b6bf786821b1d92f16af10375b9b16a7 /compiler/src/Files.hs
parentab84d0503e39f0a3acb6f8f5e6706a377aaeaf33 (diff)
downloadldgallery-8a75458290002c765a0fa673912c162020de2bd1.tar.gz
compiler: refactor path handling
Diffstat (limited to 'compiler/src/Files.hs')
-rw-r--r--compiler/src/Files.hs45
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
24module Files 24module 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
33import Control.Monad (filterM, mapM) 34import Control.Monad (filterM, mapM)
34import Data.Bool (bool) 35import Data.Bool (bool)
35import Data.List (isPrefixOf, length, deleteBy) 36import Data.List (isPrefixOf, length, deleteBy, subsequences)
36import Data.Function ((&)) 37import Data.Function ((&))
38import Data.Text (pack)
39import Data.Aeson (ToJSON)
40import qualified Data.Aeson as JSON
41
37import System.Directory 42import System.Directory
38 ( doesDirectoryExist 43 ( doesDirectoryExist
39 , doesPathExist 44 , doesPathExist
@@ -51,25 +56,41 @@ type LocalPath = String
51type WebPath = String 56type WebPath = String
52 57
53 -- | Reversed path component list 58 -- | Reversed path component list
54type Path = [FileName] 59data Path = Path [FileName] deriving Show
60
61instance ToJSON Path where
62 toJSON = JSON.String . pack . webPath
63
64instance Eq Path where
65 (Path left) == (Path right) = left == right
55 66
56(</>) :: Path -> Path -> Path 67(</>) :: Path -> Path -> Path
57l </> r = r ++ l 68(Path l) </> (Path r) = Path (r ++ l)
58 69
59(</) :: Path -> FileName -> Path 70(</) :: Path -> FileName -> Path
60path </ file = file:path 71(Path path) </ file = Path (file:path)
61 72
62(/>) :: FileName -> Path -> Path 73(/>) :: FileName -> Path -> Path
63file /> path = path ++ [file] 74file /> (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
80fileName :: Path -> FileName
81fileName (Path (name:_)) = name
82
83subPaths :: Path -> [Path]
84subPaths (Path path) = map (Path . subsequences) path
85
86pathLength :: Path -> Int
87pathLength (Path path) = Data.List.length path
67 88
68localPath :: Path -> LocalPath 89localPath :: Path -> LocalPath
69localPath = System.FilePath.joinPath . reverse 90localPath (Path path) = System.FilePath.joinPath $ reverse path
70 91
71webPath :: Path -> WebPath 92webPath :: Path -> WebPath
72webPath = System.FilePath.Posix.joinPath . reverse 93webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
73 94
74 95
75data FSNode = File Path | Dir Path [FSNode] deriving Show 96data FSNode = File Path | Dir Path [FSNode] deriving Show
@@ -82,10 +103,10 @@ nodePath (File path) = path
82nodePath (Dir path _) = path 103nodePath (Dir path _) = path
83 104
84nodeName :: FSNode -> FileName 105nodeName :: FSNode -> FileName
85nodeName = head . nodePath 106nodeName = fileName . nodePath
86 107
87isHidden :: FSNode -> Bool 108isHidden :: FSNode -> Bool
88isHidden node = "." `isPrefixOf` filename && length filename > 1 109isHidden 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
106readDirectory :: LocalPath -> IO AnchoredFSNode 127readDirectory :: LocalPath -> IO AnchoredFSNode
107readDirectory root = mkNode [] >>= return . AnchoredFSNode root 128readDirectory 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 =