aboutsummaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/src/Caching.hs56
-rw-r--r--compiler/src/Compiler.hs7
-rw-r--r--compiler/src/FileProcessors.hs95
-rw-r--r--compiler/src/ItemProcessors.hs (renamed from compiler/src/Processors.hs)111
4 files changed, 164 insertions, 105 deletions
diff --git a/compiler/src/Caching.hs b/compiler/src/Caching.hs
new file mode 100644
index 0000000..b2b1ee1
--- /dev/null
+++ b/compiler/src/Caching.hs
@@ -0,0 +1,56 @@
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 Caching
20 ( Cache
21 , skipCache
22 , withCache
23 ) where
24
25
26import Control.Monad (when)
27import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist)
28
29import FileProcessors (FileProcessor)
30import Files
31
32
33type Cache = FileProcessor -> FileProcessor
34
35skipCache :: Cache
36skipCache processor inputPath outputPath =
37 removePathForcibly outputPath
38 >> processor inputPath outputPath
39
40withCache :: Cache
41withCache processor inputPath outputPath =
42 do
43 isDir <- doesDirectoryExist outputPath
44 when isDir $ removePathForcibly outputPath
45
46 fileExists <- doesFileExist outputPath
47 if fileExists then
48 do
49 needUpdate <- isOutdated True inputPath outputPath
50 if needUpdate then update else skip
51 else
52 update
53
54 where
55 update = processor inputPath outputPath
56 skip = putStrLn $ "Skipping:\t" ++ outputPath
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 5a7632d..92e6ed6 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -43,9 +43,8 @@ import Files
43 , nodeName 43 , nodeName
44 , filterDir 44 , filterDir
45 , ensureParentDir ) 45 , ensureParentDir )
46import Processors 46import ItemProcessors (itemFileProcessor, thumbnailFileProcessor)
47 ( itemFileProcessor, thumbnailFileProcessor 47import Caching (skipCache, withCache)
48 , skipCached, withCached )
49 48
50 49
51defaultGalleryConf :: String 50defaultGalleryConf :: String
@@ -127,7 +126,7 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
127 inputTree <- readInputTree sourceTree 126 inputTree <- readInputTree sourceTree
128 let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree 127 let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree
129 128
130 let cache = if rebuildAll then skipCached else withCached 129 let cache = if rebuildAll then skipCache else withCache
131 let itemProc = itemProcessor config cache 130 let itemProc = itemProcessor config cache
132 let thumbnailProc = thumbnailProcessor config cache 131 let thumbnailProc = thumbnailProcessor config cache
133 let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config) 132 let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
diff --git a/compiler/src/FileProcessors.hs b/compiler/src/FileProcessors.hs
new file mode 100644
index 0000000..8ea04d1
--- /dev/null
+++ b/compiler/src/FileProcessors.hs
@@ -0,0 +1,95 @@
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 FileProcessors
20 ( FileProcessor
21 , copyFileProcessor
22 , resizePictureUpTo
23 , resourceAt
24 , getImageResolution
25 , ItemDescriber
26 , getPictureProps
27 ) where
28
29
30import Control.Exception (Exception, throwIO)
31import System.Process (readProcess, callProcess)
32import Text.Read (readMaybe)
33
34import System.Directory (getModificationTime)
35import qualified System.Directory
36
37import Config (Resolution(..))
38import Resource (Resource(..), GalleryItemProps(..))
39import Files
40
41
42data ProcessingException = ProcessingException FilePath String deriving Show
43instance Exception ProcessingException
44
45type FileProcessor =
46 FileName -- ^ Input path
47 -> FileName -- ^ Output path
48 -> IO ()
49
50copyFileProcessor :: FileProcessor
51copyFileProcessor inputPath outputPath =
52 putStrLn ("Copying:\t" ++ outputPath)
53 >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
54
55resizePictureUpTo :: Resolution -> FileProcessor
56resizePictureUpTo maxResolution inputPath outputPath =
57 putStrLn ("Generating:\t" ++ outputPath)
58 >> ensureParentDir (flip resize) outputPath inputPath
59 where
60 maxSize :: Resolution -> String
61 maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">"
62
63 resize :: FileName -> FileName -> IO ()
64 resize input output = callProcess "magick"
65 [ input
66 , "-auto-orient"
67 , "-resize", maxSize maxResolution
68 , output ]
69
70
71resourceAt :: FilePath -> Path -> IO Resource
72resourceAt fsPath resPath = Resource resPath <$> getModificationTime fsPath
73
74getImageResolution :: FilePath -> IO Resolution
75getImageResolution fsPath =
76 readProcess "magick" ["identify", "-format", "%w %h", firstFrame] []
77 >>= parseResolution . break (== ' ')
78 where
79 firstFrame :: FilePath
80 firstFrame = fsPath ++ "[0]"
81
82 parseResolution :: (String, String) -> IO Resolution
83 parseResolution (widthString, heightString) =
84 case (readMaybe widthString, readMaybe heightString) of
85 (Just w, Just h) -> return $ Resolution w h
86 _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution."
87
88
89type ItemDescriber =
90 FilePath
91 -> Resource
92 -> IO GalleryItemProps
93
94getPictureProps :: ItemDescriber
95getPictureProps fsPath resource = Picture resource <$> getImageResolution fsPath
diff --git a/compiler/src/Processors.hs b/compiler/src/ItemProcessors.hs
index 73529ee..209bc2a 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/ItemProcessors.hs
@@ -16,37 +16,25 @@
16-- 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
17-- 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/>.
18 18
19module Processors 19module ItemProcessors
20 ( Resolution(..) 20 ( ItemProcessor
21 , ItemFileProcessor, itemFileProcessor 21 , itemFileProcessor
22 , ThumbnailFileProcessor, thumbnailFileProcessor 22 , ThumbnailProcessor
23 , skipCached, withCached 23 , thumbnailFileProcessor
24 ) where 24 ) where
25 25
26 26
27import Control.Exception (Exception, throwIO)
28import Control.Monad (when)
29import Data.Function ((&)) 27import Data.Function ((&))
30import Data.Char (toLower) 28import Data.Char (toLower)
31import Text.Read (readMaybe) 29import System.FilePath (takeExtension)
32
33import System.Directory hiding (copyFile)
34import qualified System.Directory
35import System.FilePath
36
37import System.Process (callProcess, readProcess)
38
39import Resource
40 ( ItemProcessor, ThumbnailProcessor
41 , GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) )
42 30
31import Config (Resolution(..))
32import Resource (ItemProcessor, ThumbnailProcessor, Thumbnail(..), GalleryItemProps(..))
33import Caching (Cache)
34import FileProcessors
43import Files 35import Files
44 36
45 37
46data ProcessingException = ProcessingException FilePath String deriving Show
47instance Exception ProcessingException
48
49
50data Format = 38data Format =
51 PictureFormat 39 PictureFormat
52 | PlainTextFormat 40 | PlainTextFormat
@@ -87,85 +75,6 @@ formatFromPath =