diff options
author | pacien | 2019-12-27 10:08:19 +0100 |
---|---|---|
committer | pacien | 2019-12-27 10:08:19 +0100 |
commit | eb7a652b2244ffa4dd5ba2440b7879127e7c6078 (patch) | |
tree | 71ab010b20a0f8d9f4a99179b68a7a12c081531d /compiler/src/Files.hs | |
parent | aead07929e6ed13375b86539b1679a88993c9cf5 (diff) | |
download | ldgallery-eb7a652b2244ffa4dd5ba2440b7879127e7c6078.tar.gz |
compiler: implement resource processing
but break directory cleanup
Diffstat (limited to 'compiler/src/Files.hs')
-rw-r--r-- | compiler/src/Files.hs | 31 |
1 files changed, 23 insertions, 8 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 77a8c5b..0392efe 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs | |||
@@ -1,5 +1,3 @@ | |||
1 | {-# LANGUAGE DuplicateRecordFields, DeriveGeneric #-} | ||
2 | |||
3 | -- ldgallery - A static generator which turns a collection of tagged | 1 | -- ldgallery - A static generator which turns a collection of tagged |
4 | -- pictures into a searchable web gallery. | 2 | -- pictures into a searchable web gallery. |
5 | -- | 3 | -- |
@@ -18,12 +16,17 @@ | |||
18 | -- You should have received a copy of the GNU Affero General Public License | 16 | -- You should have received a copy of the GNU Affero General Public License |
19 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. | 17 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. |
20 | 18 | ||
19 | {-# LANGUAGE | ||
20 | DuplicateRecordFields | ||
21 | , DeriveGeneric | ||
22 | #-} | ||
21 | 23 | ||
22 | module Files | 24 | module Files |
23 | ( FileName, LocalPath, WebPath, Path | 25 | ( FileName, LocalPath, WebPath, Path |
24 | , (</>), (</), (/>), localPath, webPath | 26 | , (</>), (</), (/>), localPath, webPath |
25 | , FSNode(..), AnchoredFSNode(..) | 27 | , FSNode(..), AnchoredFSNode(..) |
26 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory | 28 | , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory |
29 | , ensureParentDir | ||
27 | ) where | 30 | ) where |
28 | 31 | ||
29 | 32 | ||
@@ -31,7 +34,7 @@ import Control.Monad (filterM, mapM) | |||
31 | import Data.Bool (bool) | 34 | import Data.Bool (bool) |
32 | import Data.List (isPrefixOf, length, deleteBy) | 35 | import Data.List (isPrefixOf, length, deleteBy) |
33 | import Data.Function ((&)) | 36 | import Data.Function ((&)) |
34 | import System.Directory (doesDirectoryExist, listDirectory) | 37 | import System.Directory (doesDirectoryExist, listDirectory, createDirectoryIfMissing) |
35 | 38 | ||
36 | import qualified System.FilePath | 39 | import qualified System.FilePath |
37 | import qualified System.FilePath.Posix | 40 | import qualified System.FilePath.Posix |
@@ -79,13 +82,17 @@ isHidden node = "." `isPrefixOf` filename && length filename > 1 | |||
79 | -- | DFS with intermediate dirs first. | 82 | -- | DFS with intermediate dirs first. |
80 | flattenDir :: FSNode -> [FSNode] | 83 | flattenDir :: FSNode -> [FSNode] |
81 | flattenDir file@(File _) = [file] | 84 | flattenDir file@(File _) = [file] |
82 | flattenDir dir@(Dir _ childs) = dir:(concatMap flattenDir childs) | 85 | flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items) |
83 | 86 | ||
84 | -- | Filters a dir tree. The root is always returned. | 87 | -- | Filters a dir tree. The root is always returned. |
85 | filterDir :: (FSNode -> Bool) -> FSNode -> FSNode | 88 | filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode |
86 | filterDir _ file@(File _) = file | 89 | filterDir cond (AnchoredFSNode anchor root) = |
87 | filterDir cond (Dir path childs) = | 90 | AnchoredFSNode anchor (filterNode root) |
88 | filter cond childs & map (filterDir cond) & Dir path | 91 | where |
92 | filterNode :: FSNode -> FSNode | ||
93 | filterNode file@(File _) = file | ||
94 | filterNode (Dir path items) = | ||
95 | filter cond items & map filterNode & Dir path | ||
89 | 96 | ||
90 | readDirectory :: LocalPath -> IO AnchoredFSNode | 97 | readDirectory :: LocalPath -> IO AnchoredFSNode |
91 | readDirectory root = mkNode [] >>= return . AnchoredFSNode root | 98 | readDirectory root = mkNode [] >>= return . AnchoredFSNode root |
@@ -103,3 +110,11 @@ readDirectory root = mkNode [] >>= return . AnchoredFSNode root | |||
103 | (listDirectory $ localPath (root /> path)) | 110 | (listDirectory $ localPath (root /> path)) |
104 | >>= mapM (mkNode . ((</) path)) | 111 | >>= mapM (mkNode . ((</) path)) |
105 | >>= return . Dir path | 112 | >>= return . Dir path |
113 | |||
114 | |||
115 | ensureParentDir :: (FileName -> a -> IO b) -> FileName -> a -> IO b | ||
116 | ensureParentDir writer filePath a = | ||
117 | createDirectoryIfMissing True parentDir | ||
118 | >> writer filePath a | ||
119 | where | ||
120 | parentDir = System.FilePath.dropFileName filePath | ||