From 0b2f6fb420d213b4ee718b9ac79cc3f9fa7678d5 Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 25 Dec 2019 21:04:31 +0100
Subject: compiler: refactor transform stages
---
compiler/src/Files.hs | 104 ++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 104 insertions(+)
create mode 100644 compiler/src/Files.hs
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
new file mode 100644
index 0000000..7948842
--- /dev/null
+++ b/compiler/src/Files.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE DuplicateRecordFields, DeriveGeneric #-}
+
+-- ldgallery - A static generator which turns a collection of tagged
+-- pictures into a searchable web gallery.
+--
+-- Copyright (C) 2019 Pacien TRAN-GIRARD
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as
+-- published by the Free Software Foundation, either version 3 of the
+-- License, or (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program. If not, see .
+
+
+module Files
+ ( FileName, LocalPath, WebPath, Path
+ , (), (), localPath, webPath
+ , FSNode(..), AnchoredFSNode(..)
+ , nodePath, nodeName, isHidden, flatten, filterDir, readDirectory
+ ) where
+
+
+import Control.Monad (filterM, mapM)
+import Data.Bool (bool)
+import Data.List (isPrefixOf, length, deleteBy)
+import Data.Function ((&))
+import System.Directory (doesDirectoryExist, listDirectory)
+import qualified System.FilePath
+import qualified System.FilePath.Posix
+import Utils
+
+
+type FileName = String
+type LocalPath = String
+type WebPath = String
+
+ -- | Reversed path component list
+type Path = [FileName]
+
+() :: Path -> Path -> Path
+l r = r ++ l
+
+( FileName -> Path
+path ) :: FileName -> Path -> Path
+file /> path = path ++ [file]
+
+localPath :: Path -> LocalPath
+localPath = System.FilePath.joinPath . reverse
+
+webPath :: Path -> WebPath
+webPath = System.FilePath.Posix.joinPath . reverse
+
+
+data FSNode = File Path | Dir Path [FSNode] deriving Show
+data AnchoredFSNode = AnchoredFSNode
+ { anchor :: LocalPath
+ , root :: FSNode } deriving Show
+
+nodePath :: FSNode -> Path
+nodePath (File path) = path
+nodePath (Dir path _) = path
+
+nodeName :: FSNode -> FileName
+nodeName = head . nodePath
+
+isHidden :: FSNode -> Bool
+isHidden node = "." `isPrefixOf` filename && length filename > 1
+ where filename = nodeName node
+
+flatten :: FSNode -> [FSNode]
+flatten file@(File _) = [file]
+flatten dir@(Dir _ childs) = dir:(concatMap flatten childs)
+
+-- | Filters a dir tree. The root is always returned.
+filterDir :: (FSNode -> Bool) -> FSNode -> FSNode
+filterDir _ file@(File _) = file
+filterDir cond (Dir path childs) =
+ filter cond childs & map (filterDir cond) & Dir path
+
+readDirectory :: LocalPath -> IO AnchoredFSNode
+readDirectory root = mkNode [""] >>= return . AnchoredFSNode root
+ where
+ mkNode :: Path -> IO FSNode
+ mkNode path =
+ (doesDirectoryExist $ localPath (root /> path))
+ >>= bool (mkFileNode path) (mkDirNode path)
+
+ mkFileNode :: Path -> IO FSNode
+ mkFileNode path = return $ File path
+
+ mkDirNode :: Path -> IO FSNode
+ mkDirNode path =
+ (listDirectory $ localPath (root /> path))
+ >>= mapM (mkNode . ((>= return . Dir path
--
cgit v1.2.3
From 5b35285daa62fb9c10280fb43e340ba7b0746f5a Mon Sep 17 00:00:00 2001
From: pacien
Date: Wed, 25 Dec 2019 22:48:34 +0100
Subject: compiler: add gallery config file handling
---
compiler/src/Files.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 7948842..30e4b94 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -32,9 +32,9 @@ import Data.Bool (bool)
import Data.List (isPrefixOf, length, deleteBy)
import Data.Function ((&))
import System.Directory (doesDirectoryExist, listDirectory)
+
import qualified System.FilePath
import qualified System.FilePath.Posix
-import Utils
type FileName = String
--
cgit v1.2.3
From 2a6467272e18af4864745b9d0267f9fa3ed382dd Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 26 Dec 2019 01:13:42 +0100
Subject: compiler: implement output dir cleanup
---
compiler/src/Files.hs | 11 ++++++-----
1 file changed, 6 insertions(+), 5 deletions(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 30e4b94..77a8c5b 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -23,7 +23,7 @@ module Files
( FileName, LocalPath, WebPath, Path
, (), (), localPath, webPath
, FSNode(..), AnchoredFSNode(..)
- , nodePath, nodeName, isHidden, flatten, filterDir, readDirectory
+ , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
) where
@@ -76,9 +76,10 @@ isHidden :: FSNode -> Bool
isHidden node = "." `isPrefixOf` filename && length filename > 1
where filename = nodeName node
-flatten :: FSNode -> [FSNode]
-flatten file@(File _) = [file]
-flatten dir@(Dir _ childs) = dir:(concatMap flatten childs)
+-- | DFS with intermediate dirs first.
+flattenDir :: FSNode -> [FSNode]
+flattenDir file@(File _) = [file]
+flattenDir dir@(Dir _ childs) = dir:(concatMap flattenDir childs)
-- | Filters a dir tree. The root is always returned.
filterDir :: (FSNode -> Bool) -> FSNode -> FSNode
@@ -87,7 +88,7 @@ filterDir cond (Dir path childs) =
filter cond childs & map (filterDir cond) & Dir path
readDirectory :: LocalPath -> IO AnchoredFSNode
-readDirectory root = mkNode [""] >>= return . AnchoredFSNode root
+readDirectory root = mkNode [] >>= return . AnchoredFSNode root
where
mkNode :: Path -> IO FSNode
mkNode path =
--
cgit v1.2.3
From eb7a652b2244ffa4dd5ba2440b7879127e7c6078 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 10:08:19 +0100
Subject: compiler: implement resource processing
but break directory cleanup
---
compiler/src/Files.hs | 31 +++++++++++++++++++++++--------
1 file changed, 23 insertions(+), 8 deletions(-)
(limited to 'compiler/src/Files.hs')
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 @@
-{-# LANGUAGE DuplicateRecordFields, DeriveGeneric #-}
-
-- ldgallery - A static generator which turns a collection of tagged
-- pictures into a searchable web gallery.
--
@@ -18,12 +16,17 @@
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see .
+{-# LANGUAGE
+ DuplicateRecordFields
+ , DeriveGeneric
+#-}
module Files
( FileName, LocalPath, WebPath, Path
, (), (), localPath, webPath
, FSNode(..), AnchoredFSNode(..)
, nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
+ , ensureParentDir
) where
@@ -31,7 +34,7 @@ import Control.Monad (filterM, mapM)
import Data.Bool (bool)
import Data.List (isPrefixOf, length, deleteBy)
import Data.Function ((&))
-import System.Directory (doesDirectoryExist, listDirectory)
+import System.Directory (doesDirectoryExist, listDirectory, createDirectoryIfMissing)
import qualified System.FilePath
import qualified System.FilePath.Posix
@@ -79,13 +82,17 @@ isHidden node = "." `isPrefixOf` filename && length filename > 1
-- | DFS with intermediate dirs first.
flattenDir :: FSNode -> [FSNode]
flattenDir file@(File _) = [file]
-flattenDir dir@(Dir _ childs) = dir:(concatMap flattenDir childs)
+flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items)
-- | Filters a dir tree. The root is always returned.
-filterDir :: (FSNode -> Bool) -> FSNode -> FSNode
-filterDir _ file@(File _) = file
-filterDir cond (Dir path childs) =
- filter cond childs & map (filterDir cond) & Dir path
+filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
+filterDir cond (AnchoredFSNode anchor root) =
+ AnchoredFSNode anchor (filterNode root)
+ where
+ filterNode :: FSNode -> FSNode
+ filterNode file@(File _) = file
+ filterNode (Dir path items) =
+ filter cond items & map filterNode & Dir path
readDirectory :: LocalPath -> IO AnchoredFSNode
readDirectory root = mkNode [] >>= return . AnchoredFSNode root
@@ -103,3 +110,11 @@ readDirectory root = mkNode [] >>= return . AnchoredFSNode root
(listDirectory $ localPath (root /> path))
>>= mapM (mkNode . ((>= return . Dir path
+
+
+ensureParentDir :: (FileName -> a -> IO b) -> FileName -> a -> IO b
+ensureParentDir writer filePath a =
+ createDirectoryIfMissing True parentDir
+ >> writer filePath a
+ where
+ parentDir = System.FilePath.dropFileName filePath
--
cgit v1.2.3
From 6bc29b5db2c8de62e2d9f21c25fa8dcd1ec5a75b Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 10:32:35 +0100
Subject: compiler: extracting funcs
---
compiler/src/Files.hs | 14 ++++++++++++--
1 file changed, 12 insertions(+), 2 deletions(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 0392efe..23daf3a 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -26,7 +26,7 @@ module Files
, (), (), localPath, webPath
, FSNode(..), AnchoredFSNode(..)
, nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
- , ensureParentDir
+ , ensureParentDir, remove
) where
@@ -34,7 +34,11 @@ import Control.Monad (filterM, mapM)
import Data.Bool (bool)
import Data.List (isPrefixOf, length, deleteBy)
import Data.Function ((&))
-import System.Directory (doesDirectoryExist, listDirectory, createDirectoryIfMissing)
+import System.Directory
+ ( doesDirectoryExist
+ , listDirectory
+ , createDirectoryIfMissing
+ , removePathForcibly )
import qualified System.FilePath
import qualified System.FilePath.Posix
@@ -118,3 +122,9 @@ ensureParentDir writer filePath a =
>> writer filePath a
where
parentDir = System.FilePath.dropFileName filePath
+
+remove :: FileName -> IO ()
+remove path =
+ do
+ putStrLn $ "Removing:\t" ++ path
+ removePathForcibly path
--
cgit v1.2.3
From 63b06627f200f155f66ecdb6c5f41ab44808dd6b Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 12:38:01 +0100
Subject: compiler: add compiler config keys
---
compiler/src/Files.hs | 17 ++++++++++++++++-
1 file changed, 16 insertions(+), 1 deletion(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 23daf3a..fb46c33 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -26,7 +26,7 @@ module Files
, (), (), localPath, webPath
, FSNode(..), AnchoredFSNode(..)
, nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
- , ensureParentDir, remove
+ , ensureParentDir, remove, isOutdated
) where
@@ -36,6 +36,8 @@ import Data.List (isPrefixOf, length, deleteBy)
import Data.Function ((&))
import System.Directory
( doesDirectoryExist
+ , doesPathExist
+ , getModificationTime
, listDirectory
, createDirectoryIfMissing
, removePathForcibly )
@@ -128,3 +130,16 @@ remove path =
do
putStrLn $ "Removing:\t" ++ path
removePathForcibly path
+
+isOutdated :: FilePath -> FilePath -> IO Bool
+isOutdated ref target =
+ do
+ refExists <- doesPathExist ref
+ targetExists <- doesPathExist target
+ if refExists && targetExists then
+ do
+ refTime <- getModificationTime ref
+ targetTime <- getModificationTime target
+ return (targetTime < refTime)
+ else
+ return True
--
cgit v1.2.3
From 119d837edce4d4c109539b6722fab162ab29c0b0 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 29 Dec 2019 09:54:55 +0100
Subject: compiler: allow fast recovery from partial gallery compilation
---
compiler/src/Files.hs | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index fb46c33..079da61 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -131,8 +131,8 @@ remove path =
putStrLn $ "Removing:\t" ++ path
removePathForcibly path
-isOutdated :: FilePath -> FilePath -> IO Bool
-isOutdated ref target =
+isOutdated :: Bool -> FilePath -> FilePath -> IO Bool
+isOutdated onMissingTarget ref target =
do
refExists <- doesPathExist ref
targetExists <- doesPathExist target
@@ -142,4 +142,4 @@ isOutdated ref target =
targetTime <- getModificationTime target
return (targetTime < refTime)
else
- return True
+ return onMissingTarget
--
cgit v1.2.3
From 54ccbbb9ebde9cb42c5c425266b298668eb3df43 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 29 Dec 2019 14:21:13 +0100
Subject: compiler: do not require sidecar file
GitHub: closes #4
---
compiler/src/Files.hs | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 079da61..d1363a1 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -23,7 +23,7 @@
module Files
( FileName, LocalPath, WebPath, Path
- , (), (), localPath, webPath
+ , (), (), (<.>), localPath, webPath
, FSNode(..), AnchoredFSNode(..)
, nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
, ensureParentDir, remove, isOutdated
@@ -62,6 +62,9 @@ path ) :: FileName -> Path -> Path
file /> path = path ++ [file]
+(<.>) :: Path -> String -> Path
+(filename:pathto) <.> ext = System.FilePath.addExtension filename ext : pathto
+
localPath :: Path -> LocalPath
localPath = System.FilePath.joinPath . reverse
--
cgit v1.2.3
From 8a75458290002c765a0fa673912c162020de2bd1 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 30 Dec 2019 01:40:55 +0100
Subject: compiler: refactor path handling
---
compiler/src/Files.hs | 45 +++++++++++++++++++++++++++++++++------------
1 file changed, 33 insertions(+), 12 deletions(-)
(limited to 'compiler/src/Files.hs')
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 @@
module Files
( FileName, LocalPath, WebPath, Path
- , (), (), (<.>), localPath, webPath
+ , (), (), (<.>), fileName, subPaths, pathLength
+ , localPath, webPath
, FSNode(..), AnchoredFSNode(..)
, nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
, ensureParentDir, remove, isOutdated
@@ -32,8 +33,12 @@ module Files
import Control.Monad (filterM, mapM)
import Data.Bool (bool)
-import Data.List (isPrefixOf, length, deleteBy)
+import Data.List (isPrefixOf, length, deleteBy, subsequences)
import Data.Function ((&))
+import Data.Text (pack)
+import Data.Aeson (ToJSON)
+import qualified Data.Aeson as JSON
+
import System.Directory
( doesDirectoryExist
, doesPathExist
@@ -51,25 +56,41 @@ type LocalPath = String
type WebPath = String
-- | Reversed path component list
-type Path = [FileName]
+data Path = Path [FileName] deriving Show
+
+instance ToJSON Path where
+ toJSON = JSON.String . pack . webPath
+
+instance Eq Path where
+ (Path left) == (Path right) = left == right
() :: Path -> Path -> Path
-l r = r ++ l
+(Path l) (Path r) = Path (r ++ l)
( FileName -> Path
-path ) :: FileName -> Path -> Path
-file /> path = path ++ [file]
+file /> (Path path) = Path (path ++ [file])
(<.>) :: Path -> String -> Path
-(filename:pathto) <.> ext = System.FilePath.addExtension filename ext : pathto
+(Path (filename:pathto)) <.> ext =
+ Path $ System.FilePath.addExtension filename ext : pathto
+
+fileName :: Path -> FileName
+fileName (Path (name:_)) = name
+
+subPaths :: Path -> [Path]
+subPaths (Path path) = map (Path . subsequences) path
+
+pathLength :: Path -> Int
+pathLength (Path path) = Data.List.length path
localPath :: Path -> LocalPath
-localPath = System.FilePath.joinPath . reverse
+localPath (Path path) = System.FilePath.joinPath $ reverse path
webPath :: Path -> WebPath
-webPath = System.FilePath.Posix.joinPath . reverse
+webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
data FSNode = File Path | Dir Path [FSNode] deriving Show
@@ -82,10 +103,10 @@ nodePath (File path) = path
nodePath (Dir path _) = path
nodeName :: FSNode -> FileName
-nodeName = head . nodePath
+nodeName = fileName . nodePath
isHidden :: FSNode -> Bool
-isHidden node = "." `isPrefixOf` filename && length filename > 1
+isHidden node = "." `isPrefixOf` filename &&length filename > 1
where filename = nodeName node
-- | DFS with intermediate dirs first.
@@ -104,7 +125,7 @@ filterDir cond (AnchoredFSNode anchor root) =
filter cond items & map filterNode & Dir path
readDirectory :: LocalPath -> IO AnchoredFSNode
-readDirectory root = mkNode [] >>= return . AnchoredFSNode root
+readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
where
mkNode :: Path -> IO FSNode
mkNode path =
--
cgit v1.2.3
From 856d6ea290f6050e813e9cd5634b9e9960995671 Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 31 Dec 2019 00:40:35 +0100
Subject: compiler: fix subpath generation
---
compiler/src/Files.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 457f1da..ed082ba 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -81,7 +81,7 @@ fileName :: Path -> FileName
fileName (Path (name:_)) = name
subPaths :: Path -> [Path]
-subPaths (Path path) = map (Path . subsequences) path
+subPaths (Path path) = map Path $ subsequences path
pathLength :: Path -> Int
pathLength (Path path) = Data.List.length path
--
cgit v1.2.3
From 7ef9f09c0f3be1cd5e1f38c9abc845abc9ed3639 Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 31 Dec 2019 01:39:23 +0100
Subject: compiler: add option to add implicit directory tags
GitHub: closes #7
---
compiler/src/Files.hs | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index ed082ba..a6649c8 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -23,7 +23,8 @@
module Files
( FileName, LocalPath, WebPath, Path
- , (), (), (<.>), fileName, subPaths, pathLength
+ , (), (), (<.>)
+ , fileName, maybeFileName, subPaths, pathLength
, localPath, webPath
, FSNode(..), AnchoredFSNode(..)
, nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
@@ -80,6 +81,10 @@ file /> (Path path) = Path (path ++ [file])
fileName :: Path -> FileName
fileName (Path (name:_)) = name
+maybeFileName :: Path -> Maybe FileName
+maybeFileName (Path (name:_)) = Just name
+maybeFileName _ = Nothing
+
subPaths :: Path -> [Path]
subPaths (Path path) = map Path $ subsequences path
--
cgit v1.2.3
From 641ea85d4da795cb2c67d9777cb3db3dfede1d8b Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 31 Dec 2019 06:58:53 +0100
Subject: compiler: add option to include static web app in the output
GitHub: closes #6
---
compiler/src/Files.hs | 17 +++++++++++++++--
1 file changed, 15 insertions(+), 2 deletions(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index a6649c8..a658ded 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -19,6 +19,7 @@
{-# LANGUAGE
DuplicateRecordFields
, DeriveGeneric
+ , NamedFieldPuns
#-}
module Files
@@ -27,7 +28,8 @@ module Files
, fileName, maybeFileName, subPaths, pathLength
, localPath, webPath
, FSNode(..), AnchoredFSNode(..)
- , nodePath, nodeName, isHidden, flattenDir, filterDir, readDirectory
+ , nodePath, nodeName, isHidden, flattenDir, filterDir
+ , readDirectory, copyTo
, ensureParentDir, remove, isOutdated
) where
@@ -46,7 +48,8 @@ import System.Directory
, getModificationTime
, listDirectory
, createDirectoryIfMissing
- , removePathForcibly )
+ , removePathForcibly
+ , copyFile )
import qualified System.FilePath
import qualified System.FilePath.Posix
@@ -146,6 +149,16 @@ readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
>>= mapM (mkNode . ((>= return . Dir path
+copyTo :: FilePath -> AnchoredFSNode -> IO ()
+copyTo target AnchoredFSNode{anchor, root} = copyNode root
+ where
+ copyNode :: FSNode -> IO ()
+ copyNode (File path) =
+ copyFile (localPath $ anchor /> path) (localPath $ target /> path)
+
+ copyNode (Dir path items) =
+ createDirectoryIfMissing True (localPath $ target /> path)
+ >> mapM_ copyNode items
ensureParentDir :: (FileName -> a -> IO b) -> FileName -> a -> IO b
ensureParentDir writer filePath a =
--
cgit v1.2.3
From abdf82bbfde843a87bd00746f52dafdd28f3f60b Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 15:31:38 +0100
Subject: compiler: make absent file names more explicit
---
compiler/src/Files.hs | 39 ++++++++++++++++++++-------------------
1 file changed, 20 insertions(+), 19 deletions(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index a658ded..53f9c9e 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -1,7 +1,7 @@
-- ldgallery - A static generator which turns a collection of tagged
-- pictures into a searchable web gallery.
--
--- Copyright (C) 2019 Pacien TRAN-GIRARD
+-- Copyright (C) 2019-2020 Pacien TRAN-GIRARD
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as
@@ -25,10 +25,10 @@
module Files
( FileName, LocalPath, WebPath, Path
, (), (), (<.>)
- , fileName, maybeFileName, subPaths, pathLength
+ , fileName, subPaths, pathLength
, localPath, webPath
, FSNode(..), AnchoredFSNode(..)
- , nodePath, nodeName, isHidden, flattenDir, filterDir
+ , nodeName, isHidden, flattenDir, filterDir
, readDirectory, copyTo
, ensureParentDir, remove, isOutdated
) where
@@ -81,12 +81,9 @@ file /> (Path path) = Path (path ++ [file])
(Path (filename:pathto)) <.> ext =
Path $ System.FilePath.addExtension filename ext : pathto
-fileName :: Path -> FileName
-fileName (Path (name:_)) = name
-
-maybeFileName :: Path -> Maybe FileName
-maybeFileName (Path (name:_)) = Just name
-maybeFileName _ = Nothing
+fileName :: Path -> Maybe FileName
+fileName (Path (name:_)) = Just name
+fileName _ = Nothing
subPaths :: Path -> [Path]
subPaths (Path path) = map Path $ subsequences path
@@ -101,21 +98,25 @@ webPath :: Path -> WebPath
webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
-data FSNode = File Path | Dir Path [FSNode] deriving Show
+data FSNode =
+ File { path :: Path }
+ | Dir { path :: Path, items :: [FSNode] }
+ deriving Show
+
data AnchoredFSNode = AnchoredFSNode
{ anchor :: LocalPath
- , root :: FSNode } deriving Show
+ , root :: FSNode }
+ deriving Show
-nodePath :: FSNode -> Path
-nodePath (File path) = path
-nodePath (Dir path _) = path
-
-nodeName :: FSNode -> FileName
-nodeName = fileName . nodePath
+nodeName :: FSNode -> Maybe FileName
+nodeName = fileName . path
isHidden :: FSNode -> Bool
-isHidden node = "." `isPrefixOf` filename &&length filename > 1
- where filename = nodeName node
+isHidden = hiddenName . nodeName
+ where
+ hiddenName :: Maybe FileName -> Bool
+ hiddenName Nothing = False
+ hiddenName (Just filename) = "." `isPrefixOf` filename && length filename > 1
-- | DFS with intermediate dirs first.
flattenDir :: FSNode -> [FSNode]
--
cgit v1.2.3
From 9dd271504160b624284dbc438cdc867b6ca0d0e7 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 16:24:02 +0100
Subject: compiler: enable warnings and fix them
GitHub: fixes #9
---
compiler/src/Files.hs | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 53f9c9e..291a1c5 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -34,9 +34,9 @@ module Files
) where
-import Control.Monad (filterM, mapM)
+import Control.Monad (mapM)
import Data.Bool (bool)
-import Data.List (isPrefixOf, length, deleteBy, subsequences)
+import Data.List (isPrefixOf, length, subsequences)
import Data.Function ((&))
import Data.Text (pack)
import Data.Aeson (ToJSON)
@@ -80,6 +80,7 @@ file /> (Path path) = Path (path ++ [file])
(<.>) :: Path -> String -> Path
(Path (filename:pathto)) <.> ext =
Path $ System.FilePath.addExtension filename ext : pathto
+(Path _) <.> ext = Path [ext]
fileName :: Path -> Maybe FileName
fileName (Path (name:_)) = Just name
--
cgit v1.2.3
From ee222b40569b9f40c482dd9df518f6445c1c304d Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 16:42:09 +0100
Subject: compiler: enable language extensions on whole project
---
compiler/src/Files.hs | 6 ------
1 file changed, 6 deletions(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 291a1c5..51e97e6 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -16,12 +16,6 @@
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see .
-{-# LANGUAGE
- DuplicateRecordFields
- , DeriveGeneric
- , NamedFieldPuns
-#-}
-
module Files
( FileName, LocalPath, WebPath, Path
, (), (), (<.>)
--
cgit v1.2.3
From ab2f076c5bf546f8aca9910b2b61a1b5a67361bc Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 18:39:47 +0100
Subject: compiler: distinguish item and resource paths
GitHub: closes #13
---
compiler/src/Files.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'compiler/src/Files.hs')
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 51e97e6..41fc5a8 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -17,7 +17,7 @@
-- along with this program. If not, see .
module Files
- ( FileName, LocalPath, WebPath, Path
+ ( FileName, LocalPath, WebPath, Path(..)
, (), (), (<.>)
, fileName, subPaths, pathLength
, localPath, webPath
--
cgit v1.2.3