aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Files.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Files.hs')
-rw-r--r--compiler/src/Files.hs31
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
22module Files 24module 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)
31import Data.Bool (bool) 34import Data.Bool (bool)
32import Data.List (isPrefixOf, length, deleteBy) 35import Data.List (isPrefixOf, length, deleteBy)
33import Data.Function ((&)) 36import Data.Function ((&))
34import System.Directory (doesDirectoryExist, listDirectory) 37import System.Directory (doesDirectoryExist, listDirectory, createDirectoryIfMissing)
35 38
36import qualified System.FilePath 39import qualified System.FilePath
37import qualified System.FilePath.Posix 40import 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.
80flattenDir :: FSNode -> [FSNode] 83flattenDir :: FSNode -> [FSNode]
81flattenDir file@(File _) = [file] 84flattenDir file@(File _) = [file]
82flattenDir dir@(Dir _ childs) = dir:(concatMap flattenDir childs) 85flattenDir 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.
85filterDir :: (FSNode -> Bool) -> FSNode -> FSNode 88filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
86filterDir _ file@(File _) = file 89filterDir cond (AnchoredFSNode anchor root) =
87filterDir 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
90readDirectory :: LocalPath -> IO AnchoredFSNode 97readDirectory :: LocalPath -> IO AnchoredFSNode
91readDirectory root = mkNode [] >>= return . AnchoredFSNode root 98readDirectory 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
115ensureParentDir :: (FileName -> a -> IO b) -> FileName -> a -> IO b
116ensureParentDir writer filePath a =
117 createDirectoryIfMissing True parentDir
118 >> writer filePath a
119 where
120 parentDir = System.FilePath.dropFileName filePath