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/Compiler.hs | 96 ++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 96 insertions(+)
create mode 100644 compiler/src/Compiler.hs
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
new file mode 100644
index 0000000..9767394
--- /dev/null
+++ b/compiler/src/Compiler.hs
@@ -0,0 +1,96 @@
+-- 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 .
+
+{-# LANGUAGE
+ DuplicateRecordFields
+ , DeriveGeneric
+ , DeriveAnyClass
+#-}
+
+module Compiler
+ ( compileGallery
+ ) where
+
+
+import Control.Monad
+import Data.Function ((&))
+import Data.Ord (comparing)
+import Data.List (sortBy, length)
+import System.Directory (createDirectoryIfMissing, removePathForcibly)
+import System.FilePath (dropFileName, ())
+
+import Data.Aeson (ToJSON)
+import qualified Data.Aeson as JSON
+
+import Config
+import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir)
+import Input (decodeYamlFile, readInputTree)
+import Resource (ResourceTree, buildResourceTree, outputDiff)
+import Gallery (buildGalleryTree)
+import Processors
+
+
+itemsDir :: String
+itemsDir = "items"
+
+thumbnailsDir :: String
+thumbnailsDir = "thumbnails"
+
+
+compileGallery :: FilePath -> FilePath -> IO ()
+compileGallery inputDirPath outputDirPath =
+ do
+ config <- readConfig (inputDirPath "gallery.yaml")
+ inputDir <- readDirectory inputDirPath
+
+ let isGalleryFile = \n -> nodeName n == "gallery.yaml"
+ let galleryTree = filterDir (liftM2 (&&) (not . isGalleryFile) (not . isHidden)) inputDir
+
+ inputTree <- readInputTree galleryTree
+
+ let dirProc = dirFileProcessor inputDirPath outputDirPath itemsDir
+ let itemProc = itemFileProcessor Nothing skipCached inputDirPath outputDirPath itemsDir
+ let thumbnailProc = thumbnailFileProcessor (Resolution 150 50) skipCached inputDirPath outputDirPath thumbnailsDir
+ resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree
+
+ putStrLn "\nRESOURCE TREE"
+ putStrLn (show resourceTree)
+
+ --cleanup resourceTree outputDirPath
+
+ buildGalleryTree resourceTree
+ & ensureParentDir JSON.encodeFile (outputDirPath "index.json")
+
+ viewer config
+ & ensureParentDir JSON.encodeFile (outputDirPath "viewer.json")
+
+ where
+ -- TODO: delete all files, then only non-empty dirs
+ cleanup :: ResourceTree -> FileName -> IO ()
+ cleanup resourceTree outputDir =
+ readDirectory outputDir
+ >>= return . outputDiff resourceTree . root
+ >>= return . sortBy (flip $ comparing length) -- nested files before dirs
+ >>= return . map (localPath . (/>) outputDir)
+ >>= mapM_ remove
+
+ remove :: FileName -> IO ()
+ remove path =
+ do
+ putStrLn $ "Removing: " ++ path
+ removePathForcibly path
--
cgit v1.2.3
From 015d793b25a3f0d1ff275ed42ec211dd6a532ca0 Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 10:21:44 +0100
Subject: compiler: fix old resources cleanup
---
compiler/src/Compiler.hs | 13 +++++++++----
1 file changed, 9 insertions(+), 4 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 9767394..991de9c 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -71,16 +71,15 @@ compileGallery inputDirPath outputDirPath =
putStrLn "\nRESOURCE TREE"
putStrLn (show resourceTree)
- --cleanup resourceTree outputDirPath
+ cleanup resourceTree outputDirPath
buildGalleryTree resourceTree
- & ensureParentDir JSON.encodeFile (outputDirPath "index.json")
+ & writeJSON (outputDirPath "index.json")
viewer config
- & ensureParentDir JSON.encodeFile (outputDirPath "viewer.json")
+ & writeJSON (outputDirPath "viewer.json")
where
- -- TODO: delete all files, then only non-empty dirs
cleanup :: ResourceTree -> FileName -> IO ()
cleanup resourceTree outputDir =
readDirectory outputDir
@@ -94,3 +93,9 @@ compileGallery inputDirPath outputDirPath =
do
putStrLn $ "Removing: " ++ path
removePathForcibly path
+
+ writeJSON :: ToJSON a => FileName -> a -> IO ()
+ writeJSON outputPath object =
+ do
+ putStrLn $ "Generating: " ++ outputPath
+ ensureParentDir JSON.encodeFile outputPath object
--
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/Compiler.hs | 48 +++++++++++++-----------------------------------
1 file changed, 13 insertions(+), 35 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 991de9c..5c47521 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -29,10 +29,7 @@ module Compiler
import Control.Monad
import Data.Function ((&))
-import Data.Ord (comparing)
-import Data.List (sortBy, length)
-import System.Directory (createDirectoryIfMissing, removePathForcibly)
-import System.FilePath (dropFileName, ())
+import System.FilePath (())
import Data.Aeson (ToJSON)
import qualified Data.Aeson as JSON
@@ -40,25 +37,25 @@ import qualified Data.Aeson as JSON
import Config
import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir)
import Input (decodeYamlFile, readInputTree)
-import Resource (ResourceTree, buildResourceTree, outputDiff)
+import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
import Gallery (buildGalleryTree)
import Processors
-itemsDir :: String
-itemsDir = "items"
-
-thumbnailsDir :: String
-thumbnailsDir = "thumbnails"
+writeJSON :: ToJSON a => FileName -> a -> IO ()
+writeJSON outputPath object =
+ do
+ putStrLn $ "Generating:\t" ++ outputPath
+ ensureParentDir JSON.encodeFile outputPath object
compileGallery :: FilePath -> FilePath -> IO ()
compileGallery inputDirPath outputDirPath =
do
- config <- readConfig (inputDirPath "gallery.yaml")
+ config <- readConfig (inputDirPath galleryConf)
inputDir <- readDirectory inputDirPath
- let isGalleryFile = \n -> nodeName n == "gallery.yaml"
+ let isGalleryFile = \n -> nodeName n == galleryConf
let galleryTree = filterDir (liftM2 (&&) (not . isGalleryFile) (not . isHidden)) inputDir
inputTree <- readInputTree galleryTree
@@ -68,10 +65,7 @@ compileGallery inputDirPath outputDirPath =
let thumbnailProc = thumbnailFileProcessor (Resolution 150 50) skipCached inputDirPath outputDirPath thumbnailsDir
resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree
- putStrLn "\nRESOURCE TREE"
- putStrLn (show resourceTree)
-
- cleanup resourceTree outputDirPath
+ cleanupResourceDir resourceTree outputDirPath
buildGalleryTree resourceTree
& writeJSON (outputDirPath "index.json")
@@ -80,22 +74,6 @@ compileGallery inputDirPath outputDirPath =
& writeJSON (outputDirPath "viewer.json")
where
- cleanup :: ResourceTree -> FileName -> IO ()
- cleanup resourceTree outputDir =
- readDirectory outputDir
- >>= return . outputDiff resourceTree . root
- >>= return . sortBy (flip $ comparing length) -- nested files before dirs
- >>= return . map (localPath . (/>) outputDir)
- >>= mapM_ remove
-
- remove :: FileName -> IO ()
- remove path =
- do
- putStrLn $ "Removing: " ++ path
- removePathForcibly path
-
- writeJSON :: ToJSON a => FileName -> a -> IO ()
- writeJSON outputPath object =
- do
- putStrLn $ "Generating: " ++ outputPath
- ensureParentDir JSON.encodeFile outputPath object
+ galleryConf = "gallery.yaml"
+ itemsDir = "items"
+ thumbnailsDir = "thumbnails"
--
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/Compiler.hs | 35 ++++++++++++++++++++++++++++-------
1 file changed, 28 insertions(+), 7 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 5c47521..854fd03 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -35,7 +35,19 @@ import Data.Aeson (ToJSON)
import qualified Data.Aeson as JSON
import Config
-import Files (FileName, readDirectory, localPath, isHidden, nodeName, filterDir, flattenDir, root, (/>), ensureParentDir)
+import Files
+ ( FileName
+ , readDirectory
+ , localPath
+ , isHidden
+ , nodeName
+ , filterDir
+ , flattenDir
+ , root
+ , (/>)
+ , ensureParentDir
+ , isOutdated )
+
import Input (decodeYamlFile, readInputTree)
import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
import Gallery (buildGalleryTree)
@@ -52,7 +64,10 @@ writeJSON outputPath object =
compileGallery :: FilePath -> FilePath -> IO ()
compileGallery inputDirPath outputDirPath =
do
- config <- readConfig (inputDirPath galleryConf)
+ fullConfig <- readConfig inputGalleryConf
+ let config = compiler fullConfig
+
+ -- TODO: exclude output dir if it's under the input dir
inputDir <- readDirectory inputDirPath
let isGalleryFile = \n -> nodeName n == galleryConf
@@ -60,20 +75,26 @@ compileGallery inputDirPath outputDirPath =
inputTree <- readInputTree galleryTree
+ invalidateCache <- isOutdated inputGalleryConf outputIndex
+ let cache = if invalidateCache then skipCached else withCached
let dirProc = dirFileProcessor inputDirPath outputDirPath itemsDir
- let itemProc = itemFileProcessor Nothing skipCached inputDirPath outputDirPath itemsDir
- let thumbnailProc = thumbnailFileProcessor (Resolution 150 50) skipCached inputDirPath outputDirPath thumbnailsDir
+ let itemProc = itemFileProcessor (pictureMaxResolution config) cache inputDirPath outputDirPath itemsDir
+ let thumbnailProc = thumbnailFileProcessor (thumbnailResolution config) cache inputDirPath outputDirPath thumbnailsDir
resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree
cleanupResourceDir resourceTree outputDirPath
buildGalleryTree resourceTree
- & writeJSON (outputDirPath "index.json")
+ & writeJSON outputIndex
- viewer config
- & writeJSON (outputDirPath "viewer.json")
+ viewer fullConfig
+ & writeJSON outputViewerConf
where
galleryConf = "gallery.yaml"
itemsDir = "items"
thumbnailsDir = "thumbnails"
+
+ inputGalleryConf = inputDirPath galleryConf
+ outputIndex = outputDirPath "index.json"
+ outputViewerConf = outputDirPath "viewer.json"
--
cgit v1.2.3
From 1e57d76eadb2192be2b3d9343d4ddfeccc996bcb Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 13:38:47 +0100
Subject: compiler: exclude output dir from input
---
compiler/src/Compiler.hs | 59 ++++++++++++++++++++++++++++--------------------
1 file changed, 35 insertions(+), 24 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 854fd03..2584570 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -27,31 +27,33 @@ module Compiler
) where
-import Control.Monad
+import Control.Monad (liftM2)
import Data.Function ((&))
+import Data.List (any)
import System.FilePath (())
import Data.Aeson (ToJSON)
import qualified Data.Aeson as JSON
import Config
+import Input (decodeYamlFile, readInputTree)
+import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
+import Gallery (buildGalleryTree)
import Files
( FileName
+ , FSNode(..)
, readDirectory
- , localPath
, isHidden
, nodeName
, filterDir
- , flattenDir
- , root
- , (/>)
, ensureParentDir
, isOutdated )
-
-import Input (decodeYamlFile, readInputTree)
-import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
-import Gallery (buildGalleryTree)
import Processors
+ ( dirFileProcessor
+ , itemFileProcessor
+ , thumbnailFileProcessor
+ , skipCached
+ , withCached )
writeJSON :: ToJSON a => FileName -> a -> IO ()
@@ -61,26 +63,21 @@ writeJSON outputPath object =
ensureParentDir JSON.encodeFile outputPath object
-compileGallery :: FilePath -> FilePath -> IO ()
-compileGallery inputDirPath outputDirPath =
+compileGallery :: FilePath -> FilePath -> Bool -> IO ()
+compileGallery inputDirPath outputDirPath rebuildAll =
do
fullConfig <- readConfig inputGalleryConf
let config = compiler fullConfig
- -- TODO: exclude output dir if it's under the input dir
inputDir <- readDirectory inputDirPath
-
- let isGalleryFile = \n -> nodeName n == galleryConf
- let galleryTree = filterDir (liftM2 (&&) (not . isGalleryFile) (not . isHidden)) inputDir
-
- inputTree <- readInputTree galleryTree
+ let sourceTree = filterDir galleryDirFilter inputDir
+ inputTree <- readInputTree sourceTree
invalidateCache <- isOutdated inputGalleryConf outputIndex
- let cache = if invalidateCache then skipCached else withCached
- let dirProc = dirFileProcessor inputDirPath outputDirPath itemsDir
- let itemProc = itemFileProcessor (pictureMaxResolution config) cache inputDirPath outputDirPath itemsDir
- let thumbnailProc = thumbnailFileProcessor (thumbnailResolution config) cache inputDirPath outputDirPath thumbnailsDir
- resourceTree <- buildResourceTree dirProc itemProc thumbnailProc inputTree
+ let cache = if invalidateCache || rebuildAll then skipCached else withCached
+ let itemProc = itemProcessor (pictureMaxResolution config) cache
+ let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache
+ resourceTree <- buildResourceTree dirProcessor itemProc thumbnailProc inputTree
cleanupResourceDir resourceTree outputDirPath
@@ -92,9 +89,23 @@ compileGallery inputDirPath outputDirPath =
where
galleryConf = "gallery.yaml"
+ indexFile = "index.json"
+ viewerConfFile = "viewer.json"
itemsDir = "items"
thumbnailsDir = "thumbnails"
inputGalleryConf = inputDirPath galleryConf
- outputIndex = outputDirPath "index.json"
- outputViewerConf = outputDirPath "viewer.json"
+ outputIndex = outputDirPath indexFile
+ outputViewerConf = outputDirPath viewerConfFile
+
+ (&&&) = liftM2 (&&)
+ galleryDirFilter = (not . containsOutputGallery) &&& (not . isConfigFile) &&& (not . isHidden)
+ isConfigFile = (==) galleryConf . nodeName
+ containsOutputGallery (File _) = False
+ containsOutputGallery (Dir _ items) = any ((==) indexFile . nodeName) items
+
+ dirProcessor = dirFileProcessor inputDirPath outputDirPath itemsDir
+ itemProcessor maxRes cache =
+ itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir
+ thumbnailProcessor thumbRes cache =
+ thumbnailFileProcessor thumbRes cache inputDirPath outputDirPath thumbnailsDir
--
cgit v1.2.3
From 538996dc84b03eab1429ddd693334673b857c005 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 28 Dec 2019 19:04:54 +0100
Subject: compiler: parameterise gallery name
---
compiler/src/Compiler.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 2584570..dbe6cae 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -38,7 +38,7 @@ import qualified Data.Aeson as JSON
import Config
import Input (decodeYamlFile, readInputTree)
import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
-import Gallery (buildGalleryTree)
+import Gallery (buildGallery)
import Files
( FileName
, FSNode(..)
@@ -81,7 +81,7 @@ compileGallery inputDirPath outputDirPath rebuildAll =
cleanupResourceDir resourceTree outputDirPath
- buildGalleryTree resourceTree
+ buildGallery (galleryName config) resourceTree
& writeJSON outputIndex
viewer fullConfig
--
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/Compiler.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index dbe6cae..0a3e540 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -73,7 +73,7 @@ compileGallery inputDirPath outputDirPath rebuildAll =
let sourceTree = filterDir galleryDirFilter inputDir
inputTree <- readInputTree sourceTree
- invalidateCache <- isOutdated inputGalleryConf outputIndex
+ invalidateCache <- isOutdated False inputGalleryConf outputIndex
let cache = if invalidateCache || rebuildAll then skipCached else withCached
let itemProc = itemProcessor (pictureMaxResolution config) cache
let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache
--
cgit v1.2.3
From d0962ef2dea7e8a0c25ca8fdbc55fcbafeeb2f79 Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 30 Dec 2019 23:18:49 +0100
Subject: compiler: refactor resource transformation pipeline
---
compiler/src/Compiler.hs | 17 +++++++----------
1 file changed, 7 insertions(+), 10 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 0a3e540..048afc1 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -37,8 +37,7 @@ import qualified Data.Aeson as JSON
import Config
import Input (decodeYamlFile, readInputTree)
-import Resource (ResourceTree, buildResourceTree, cleanupResourceDir)
-import Gallery (buildGallery)
+import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir)
import Files
( FileName
, FSNode(..)
@@ -75,17 +74,15 @@ compileGallery inputDirPath outputDirPath rebuildAll =
invalidateCache <- isOutdated False inputGalleryConf outputIndex
let cache = if invalidateCache || rebuildAll then skipCached else withCached
+
let itemProc = itemProcessor (pictureMaxResolution config) cache
let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache
- resourceTree <- buildResourceTree dirProcessor itemProc thumbnailProc inputTree
-
- cleanupResourceDir resourceTree outputDirPath
-
- buildGallery (galleryName config) resourceTree
- & writeJSON outputIndex
+ let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc
+ resources <- galleryBuilder (galleryName config) inputTree
- viewer fullConfig
- & writeJSON outputViewerConf
+ galleryCleanupResourceDir resources outputDirPath
+ writeJSON outputIndex resources
+ writeJSON outputViewerConf $ viewer fullConfig
where
galleryConf = "gallery.yaml"
--
cgit v1.2.3
From 9d2b6cf4641cfff08ad556d3a7b24d4d63464eb5 Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 31 Dec 2019 00:16:29 +0100
Subject: compiler: populate the properties field in the index
GitHub: closes #8
---
compiler/src/Compiler.hs | 9 +++------
1 file changed, 3 insertions(+), 6 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 048afc1..f15192f 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -37,7 +37,7 @@ import qualified Data.Aeson as JSON
import Config
import Input (decodeYamlFile, readInputTree)
-import Resource (GalleryItem, buildGalleryTree, galleryCleanupResourceDir)
+import Resource (buildGalleryTree, galleryCleanupResourceDir)
import Files
( FileName
, FSNode(..)
@@ -48,11 +48,8 @@ import Files
, ensureParentDir
, isOutdated )
import Processors
- ( dirFileProcessor
- , itemFileProcessor
- , thumbnailFileProcessor
- , skipCached
- , withCached )
+ ( dirFileProcessor, itemFileProcessor, thumbnailFileProcessor
+ , skipCached, withCached )
writeJSON :: ToJSON a => FileName -> a -> IO ()
--
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/Compiler.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index f15192f..9572d50 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -74,7 +74,7 @@ compileGallery inputDirPath outputDirPath rebuildAll =
let itemProc = itemProcessor (pictureMaxResolution config) cache
let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache
- let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc
+ let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc (implicitDirectoryTag config)
resources <- galleryBuilder (galleryName config) inputTree
galleryCleanupResourceDir resources outputDirPath
--
cgit v1.2.3
From 6691b14cf4e867a9018f38c174fa98f1ada19f82 Mon Sep 17 00:00:00 2001
From: pacien
Date: Tue, 31 Dec 2019 08:38:15 +0100
Subject: compiler: add option to ignore files matching a regex
GitHub: closes #10
---
compiler/src/Compiler.hs | 47 ++++++++++++++++++++++++++++++++++-------------
1 file changed, 34 insertions(+), 13 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 9572d50..0132b1a 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -30,6 +30,8 @@ module Compiler
import Control.Monad (liftM2)
import Data.Function ((&))
import Data.List (any)
+import Data.Maybe (isJust)
+import Text.Regex (Regex, mkRegex, matchRegex)
import System.FilePath (())
import Data.Aeson (ToJSON)
@@ -52,6 +54,14 @@ import Processors
, skipCached, withCached )
+galleryConf = "gallery.yaml"
+indexFile = "index.json"
+viewerMainFile = "index.html"
+viewerConfFile = "viewer.json"
+itemsDir = "items"
+thumbnailsDir = "thumbnails"
+
+
writeJSON :: ToJSON a => FileName -> a -> IO ()
writeJSON outputPath object =
do
@@ -59,6 +69,28 @@ writeJSON outputPath object =
ensureParentDir JSON.encodeFile outputPath object
+galleryDirFilter :: Regex -> FSNode -> Bool
+galleryDirFilter excludeRegex =
+ (not . isHidden)
+ &&& (not . isConfigFile)
+ &&& (not . containsOutputGallery)
+ &&& (not . excludedName)
+
+ where
+ (&&&) = liftM2 (&&)
+ (|||) = liftM2 (||)
+
+ isConfigFile = (galleryConf ==) . nodeName
+
+ isGalleryIndex = (indexFile ==)
+ isViewerIndex = (viewerMainFile ==)
+ containsOutputGallery (File _) = False
+ containsOutputGallery (Dir _ items) =
+ any ((isGalleryIndex ||| isViewerIndex) . nodeName) items
+
+ excludedName = isJust . matchRegex excludeRegex . nodeName
+
+
compileGallery :: FilePath -> FilePath -> Bool -> IO ()
compileGallery inputDirPath outputDirPath rebuildAll =
do
@@ -66,7 +98,8 @@ compileGallery inputDirPath outputDirPath rebuildAll =
let config = compiler fullConfig
inputDir <- readDirectory inputDirPath
- let sourceTree = filterDir galleryDirFilter inputDir
+ let sourceFilter = galleryDirFilter (mkRegex $ ignoreFiles config)
+ let sourceTree = filterDir sourceFilter inputDir
inputTree <- readInputTree sourceTree
invalidateCache <- isOutdated False inputGalleryConf outputIndex
@@ -82,22 +115,10 @@ compileGallery inputDirPath outputDirPath rebuildAll =
writeJSON outputViewerConf $ viewer fullConfig
where
- galleryConf = "gallery.yaml"
- indexFile = "index.json"
- viewerConfFile = "viewer.json"
- itemsDir = "items"
- thumbnailsDir = "thumbnails"
-
inputGalleryConf = inputDirPath galleryConf
outputIndex = outputDirPath indexFile
outputViewerConf = outputDirPath viewerConfFile
- (&&&) = liftM2 (&&)
- galleryDirFilter = (not . containsOutputGallery) &&& (not . isConfigFile) &&& (not . isHidden)
- isConfigFile = (==) galleryConf . nodeName
- containsOutputGallery (File _) = False
- containsOutputGallery (Dir _ items) = any ((==) indexFile . nodeName) items
-
dirProcessor = dirFileProcessor inputDirPath outputDirPath itemsDir
itemProcessor maxRes cache =
itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir
--
cgit v1.2.3
From 1a0f4b17fc77c4b330c43185a15230e67116a3aa Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 10:43:30 +0100
Subject: compiler: rename max thumbnail size option
---
compiler/src/Compiler.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 0132b1a..4f2093b 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -106,7 +106,7 @@ compileGallery inputDirPath outputDirPath rebuildAll =
let cache = if invalidateCache || rebuildAll then skipCached else withCached
let itemProc = itemProcessor (pictureMaxResolution config) cache
- let thumbnailProc = thumbnailProcessor (thumbnailResolution config) cache
+ let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache
let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc (implicitDirectoryTag config)
resources <- galleryBuilder (galleryName config) inputTree
--
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/Compiler.hs | 21 +++++++++++----------
1 file changed, 11 insertions(+), 10 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 4f2093b..5d30a26 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.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
@@ -20,6 +20,7 @@
DuplicateRecordFields
, DeriveGeneric
, DeriveAnyClass
+ , NamedFieldPuns
#-}
module Compiler
@@ -30,7 +31,7 @@ module Compiler
import Control.Monad (liftM2)
import Data.Function ((&))
import Data.List (any)
-import Data.Maybe (isJust)
+import Data.Maybe (isJust, fromMaybe)
import Text.Regex (Regex, mkRegex, matchRegex)
import System.FilePath (())
@@ -80,15 +81,15 @@ galleryDirFilter excludeRegex =
(&&&) = liftM2 (&&)
(|||) = liftM2 (||)
- isConfigFile = (galleryConf ==) . nodeName
+ matchName :: (FileName -> Bool) -> FSNode -> Bool
+ matchName cond = maybe False cond . nodeName
- isGalleryIndex = (indexFile ==)
- isViewerIndex = (viewerMainFile ==)
- containsOutputGallery (File _) = False
- containsOutputGallery (Dir _ items) =
- any ((isGalleryIndex ||| isViewerIndex) . nodeName) items
-
- excludedName = isJust . matchRegex excludeRegex . nodeName
+ isConfigFile = matchName (== galleryConf)
+ isGalleryIndex = matchName (== indexFile)
+ isViewerIndex = matchName (== viewerMainFile)
+ containsOutputGallery File{} = False
+ containsOutputGallery Dir{items} = any (isGalleryIndex ||| isViewerIndex) items
+ excludedName = isJust . matchRegex excludeRegex . fromMaybe "" . nodeName
compileGallery :: FilePath -> FilePath -> Bool -> IO ()
--
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/Compiler.hs | 14 ++++++++++++--
1 file changed, 12 insertions(+), 2 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 5d30a26..f4b38d0 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -29,7 +29,6 @@ module Compiler
import Control.Monad (liftM2)
-import Data.Function ((&))
import Data.List (any)
import Data.Maybe (isJust, fromMaybe)
import Text.Regex (Regex, mkRegex, matchRegex)
@@ -39,7 +38,7 @@ import Data.Aeson (ToJSON)
import qualified Data.Aeson as JSON
import Config
-import Input (decodeYamlFile, readInputTree)
+import Input (readInputTree)
import Resource (buildGalleryTree, galleryCleanupResourceDir)
import Files
( FileName
@@ -55,11 +54,22 @@ import Processors
, skipCached, withCached )
+galleryConf :: String
galleryConf = "gallery.yaml"
+
+indexFile :: String
indexFile = "index.json"
+
+viewerMainFile :: String
viewerMainFile = "index.html"
+
+viewerConfFile :: String
viewerConfFile = "viewer.json"
+
+itemsDir :: String
itemsDir = "items"
+
+thumbnailsDir :: String
thumbnailsDir = "thumbnails"
--
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/Compiler.hs | 7 -------
1 file changed, 7 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index f4b38d0..b9f52e5 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -16,13 +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
- , DeriveAnyClass
- , NamedFieldPuns
-#-}
-
module Compiler
( compileGallery
) where
--
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/Compiler.hs | 5 ++---
1 file changed, 2 insertions(+), 3 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index b9f52e5..d0ec003 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -43,7 +43,7 @@ import Files
, ensureParentDir
, isOutdated )
import Processors
- ( dirFileProcessor, itemFileProcessor, thumbnailFileProcessor
+ ( itemFileProcessor, thumbnailFileProcessor
, skipCached, withCached )
@@ -111,7 +111,7 @@ compileGallery inputDirPath outputDirPath rebuildAll =
let itemProc = itemProcessor (pictureMaxResolution config) cache
let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache
- let galleryBuilder = buildGalleryTree dirProcessor itemProc thumbnailProc (implicitDirectoryTag config)
+ let galleryBuilder = buildGalleryTree itemProc thumbnailProc (implicitDirectoryTag config)
resources <- galleryBuilder (galleryName config) inputTree
galleryCleanupResourceDir resources outputDirPath
@@ -123,7 +123,6 @@ compileGallery inputDirPath outputDirPath rebuildAll =
outputIndex = outputDirPath indexFile
outputViewerConf = outputDirPath viewerConfFile
- dirProcessor = dirFileProcessor inputDirPath outputDirPath itemsDir
itemProcessor maxRes cache =
itemFileProcessor maxRes cache inputDirPath outputDirPath itemsDir
thumbnailProcessor thumbRes cache =
--
cgit v1.2.3
From 2ad60869c2e8d0846672ccb18b2de99c9cf33671 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 19:24:50 +0100
Subject: compiler: add option to add tags from n parent directories
GitHub: closes #15
---
compiler/src/Compiler.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index d0ec003..fc4e272 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -111,7 +111,7 @@ compileGallery inputDirPath outputDirPath rebuildAll =
let itemProc = itemProcessor (pictureMaxResolution config) cache
let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache
- let galleryBuilder = buildGalleryTree itemProc thumbnailProc (implicitDirectoryTag config)
+ let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
resources <- galleryBuilder (galleryName config) inputTree
galleryCleanupResourceDir resources outputDirPath
--
cgit v1.2.3
From 1e3a0e39cb6cdc86a6ba6b570c72c44931cf1c3b Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 5 Jan 2020 20:40:41 +0100
Subject: compiler: replace file filter with inclusino and exclusion glob lists
GitHub: closes #16
---
compiler/src/Compiler.hs | 29 +++++++++++++++++------------
1 file changed, 17 insertions(+), 12 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index fc4e272..b84dedf 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -23,9 +23,8 @@ module Compiler
import Control.Monad (liftM2)
import Data.List (any)
-import Data.Maybe (isJust, fromMaybe)
-import Text.Regex (Regex, mkRegex, matchRegex)
import System.FilePath (())
+import qualified System.FilePath.Glob as Glob
import Data.Aeson (ToJSON)
import qualified Data.Aeson as JSON
@@ -73,26 +72,30 @@ writeJSON outputPath object =
ensureParentDir JSON.encodeFile outputPath object
-galleryDirFilter :: Regex -> FSNode -> Bool
-galleryDirFilter excludeRegex =
+galleryDirFilter :: ([Glob.Pattern], [Glob.Pattern]) -> FSNode -> Bool
+galleryDirFilter (inclusionPatterns, exclusionPatterns) =
(not . isHidden)
+ &&& (matchName True $ anyPattern inclusionPatterns)
&&& (not . isConfigFile)
&&& (not . containsOutputGallery)
- &&& (not . excludedName)
+ &&& (not . (matchName False $ anyPattern exclusionPatterns))
where
(&&&) = liftM2 (&&)
(|||) = liftM2 (||)
- matchName :: (FileName -> Bool) -> FSNode -> Bool
- matchName cond = maybe False cond . nodeName
+ matchName :: Bool -> (FileName -> Bool) -> FSNode -> Bool
+ matchName matchDir _ Dir{} = matchDir
+ matchName _ cond file@File{} = maybe False cond $ nodeName file
- isConfigFile = matchName (== galleryConf)
- isGalleryIndex = matchName (== indexFile)
- isViewerIndex = matchName (== viewerMainFile)
+ anyPattern :: [Glob.Pattern] -> FileName -> Bool
+ anyPattern patterns filename = any (flip Glob.match filename) patterns
+
+ isConfigFile = matchName False (== galleryConf)
+ isGalleryIndex = matchName False (== indexFile)
+ isViewerIndex = matchName False (== viewerMainFile)
containsOutputGallery File{} = False
containsOutputGallery Dir{items} = any (isGalleryIndex ||| isViewerIndex) items
- excludedName = isJust . matchRegex excludeRegex . fromMaybe "" . nodeName
compileGallery :: FilePath -> FilePath -> Bool -> IO ()
@@ -102,7 +105,9 @@ compileGallery inputDirPath outputDirPath rebuildAll =
let config = compiler fullConfig
inputDir <- readDirectory inputDirPath
- let sourceFilter = galleryDirFilter (mkRegex $ ignoreFiles config)
+ let inclusionPatterns = map Glob.compile $ includeFiles config
+ let exclusionPatterns = map Glob.compile $ excludeFiles config
+ let sourceFilter = galleryDirFilter (inclusionPatterns, exclusionPatterns)
let sourceTree = filterDir sourceFilter inputDir
inputTree <- readInputTree sourceTree
--
cgit v1.2.3
From 5f57fd4f21f7ecd4038ca6e66a4b89622cbcc9fc Mon Sep 17 00:00:00 2001
From: pacien
Date: Mon, 6 Jan 2020 01:30:30 +0100
Subject: compiler: do not invalidate cache on gallery settings modification
---
compiler/src/Compiler.hs | 7 ++-----
1 file changed, 2 insertions(+), 5 deletions(-)
(limited to 'compiler/src/Compiler.hs')
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index b84dedf..a347433 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -39,8 +39,7 @@ import Files
, isHidden
, nodeName
, filterDir
- , ensureParentDir
- , isOutdated )
+ , ensureParentDir )
import Processors
( itemFileProcessor, thumbnailFileProcessor
, skipCached, withCached )
@@ -111,9 +110,7 @@ compileGallery inputDirPath outputDirPath rebuildAll =
let sourceTree = filterDir sourceFilter inputDir
inputTree <- readInputTree sourceTree
- invalidateCache <- isOutdated False inputGalleryConf outputIndex
- let cache = if invalidateCache || rebuildAll then skipCached else withCached
-
+ let cache = if rebuildAll then skipCached else withCached
let itemProc = itemProcessor (pictureMaxResolution config) cache
let thumbnailProc = thumbnailProcessor (thumbnailMaxResolution config) cache
let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
--
cgit v1.2.3