aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Files.hs
diff options
context:
space:
mode:
authorNotkea2020-01-10 22:31:47 +0100
committerGitHub2020-01-10 22:31:47 +0100
commit7042ffc06326fa8ffe70f5a59747709250166c16 (patch)
treedbfc7567bd106e03a47b499d2a07cecb6b8d6305 /compiler/src/Files.hs
parentc9264b0a0a7e1cb92ef7d9a391cee2c94376cff3 (diff)
parent27b51018525dbb7a6edb3073819d82245387ddd3 (diff)
downloadldgallery-7042ffc06326fa8ffe70f5a59747709250166c16.tar.gz
Merge pull request #34 from pacien/develop
first working prototype
Diffstat (limited to 'compiler/src/Files.hs')
-rw-r--r--compiler/src/Files.hs183
1 files changed, 183 insertions, 0 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
new file mode 100644
index 0000000..41fc5a8
--- /dev/null
+++ b/compiler/src/Files.hs
@@ -0,0 +1,183 @@
1-- ldgallery - A static generator which turns a collection of tagged
2-- pictures into a searchable web gallery.
3--
4-- Copyright (C) 2019-2020 Pacien TRAN-GIRARD
5--
6-- This program is free software: you can redistribute it and/or modify
7-- it under the terms of the GNU Affero General Public License as
8-- published by the Free Software Foundation, either version 3 of the
9-- License, or (at your option) any later version.
10--
11-- This program is distributed in the hope that it will be useful,
12-- but WITHOUT ANY WARRANTY; without even the implied warranty of
13-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14-- GNU Affero General Public License for more details.
15--
16-- You should have received a copy of the GNU Affero General Public License
17-- along with this program. If not, see <https://www.gnu.org/licenses/>.
18
19module Files
20 ( FileName, LocalPath, WebPath, Path(..)
21 , (</>), (</), (/>), (<.>)
22 , fileName, subPaths, pathLength
23 , localPath, webPath
24 , FSNode(..), AnchoredFSNode(..)
25 , nodeName, isHidden, flattenDir, filterDir
26 , readDirectory, copyTo
27 , ensureParentDir, remove, isOutdated
28 ) where
29
30
31import Control.Monad (mapM)
32import Data.Bool (bool)
33import Data.List (isPrefixOf, length, subsequences)
34import Data.Function ((&))
35import Data.Text (pack)
36import Data.Aeson (ToJSON)
37import qualified Data.Aeson as JSON
38
39import System.Directory
40 ( doesDirectoryExist
41 , doesPathExist
42 , getModificationTime
43 , listDirectory
44 , createDirectoryIfMissing
45 , removePathForcibly
46 , copyFile )
47
48import qualified System.FilePath
49import qualified System.FilePath.Posix
50
51
52type FileName = String
53type LocalPath = String
54type WebPath = String
55
56 -- | Reversed path component list
57data Path = Path [FileName] deriving Show
58
59instance ToJSON Path where
60 toJSON = JSON.String . pack . webPath
61
62instance Eq Path where
63 (Path left) == (Path right) = left == right
64
65(</>) :: Path -> Path -> Path
66(Path l) </> (Path r) = Path (r ++ l)
67
68(</) :: Path -> FileName -> Path
69(Path path) </ file = Path (file:path)
70
71(/>) :: FileName -> Path -> Path
72file /> (Path path) = Path (path ++ [file])
73
74(<.>) :: Path -> String -> Path
75(Path (filename:pathto)) <.> ext =
76 Path $ System.FilePath.addExtension filename ext : pathto
77(Path _) <.> ext = Path [ext]
78
79fileName :: Path -> Maybe FileName
80fileName (Path (name:_)) = Just name
81fileName _ = Nothing
82
83subPaths :: Path -> [Path]
84subPaths (Path path) = map Path $ subsequences path
85
86pathLength :: Path -> Int
87pathLength (Path path) = Data.List.length path
88
89localPath :: Path -> LocalPath
90localPath (Path path) = System.FilePath.joinPath $ reverse path
91
92webPath :: Path -> WebPath
93webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
94
95
96data FSNode =
97 File { path :: Path }
98 | Dir { path :: Path, items :: [FSNode] }
99 deriving Show
100
101data AnchoredFSNode = AnchoredFSNode
102 { anchor :: LocalPath
103 , root :: FSNode }
104 deriving Show
105
106nodeName :: FSNode -> Maybe FileName
107nodeName = fileName . path
108
109isHidden :: FSNode -> Bool
110isHidden = hiddenName . nodeName
111 where
112 hiddenName :: Maybe FileName -> Bool
113 hiddenName Nothing = False
114 hiddenName (Just filename) = "." `isPrefixOf` filename && length filename > 1
115
116-- | DFS with intermediate dirs first.
117flattenDir :: FSNode -> [FSNode]
118flattenDir file@(File _) = [file]
119flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items)
120
121-- | Filters a dir tree. The root is always returned.
122filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
123filterDir cond (AnchoredFSNode anchor root) =
124 AnchoredFSNode anchor (filterNode root)
125 where
126 filterNode :: FSNode -> FSNode
127 filterNode file@(File _) = file
128 filterNode (Dir path items) =
129 filter cond items & map filterNode & Dir path
130
131readDirectory :: LocalPath -> IO AnchoredFSNode
132readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
133 where
134 mkNode :: Path -> IO FSNode
135 mkNode path =
136 (doesDirectoryExist $ localPath (root /> path))
137 >>= bool (mkFileNode path) (mkDirNode path)
138
139 mkFileNode :: Path -> IO FSNode
140 mkFileNode path = return $ File path
141
142 mkDirNode :: Path -> IO FSNode
143 mkDirNode path =
144 (listDirectory $ localPath (root /> path))
145 >>= mapM (mkNode . ((</) path))
146 >>= return . Dir path
147
148copyTo :: FilePath -> AnchoredFSNode -> IO ()
149copyTo target AnchoredFSNode{anchor, root} = copyNode root
150 where
151 copyNode :: FSNode -> IO ()
152 copyNode (File path) =
153 copyFile (localPath $ anchor /> path) (localPath $ target /> path)
154
155 copyNode (Dir path items) =
156 createDirectoryIfMissing True (localPath $ target /> path)
157 >> mapM_ copyNode items
158
159ensureParentDir :: (FileName -> a -> IO b) -> FileName -> a -> IO b
160ensureParentDir writer filePath a =
161 createDirectoryIfMissing True parentDir
162 >> writer filePath a
163 where
164 parentDir = System.FilePath.dropFileName filePath
165
166remove :: FileName -> IO ()
167remove path =
168 do
169 putStrLn $ "Removing:\t" ++ path
170 removePathForcibly path
171
172isOutdated :: Bool -> FilePath -> FilePath -> IO Bool
173isOutdated onMissingTarget ref target =
174 do
175 refExists <- doesPathExist ref
176 targetExists <- doesPathExist target
177 if refExists && targetExists then
178 do
179 refTime <- getModificationTime ref
180 targetTime <- getModificationTime target
181 return (targetTime < refTime)
182 else
183 return onMissingTarget