diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Caching.hs | 56 | ||||
-rw-r--r-- | compiler/src/Compiler.hs | 7 | ||||
-rw-r--r-- | compiler/src/FileProcessors.hs | 95 | ||||
-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 | |||
19 | module Caching | ||
20 | ( Cache | ||
21 | , skipCache | ||
22 | , withCache | ||
23 | ) where | ||
24 | |||
25 | |||
26 | import Control.Monad (when) | ||
27 | import System.Directory (removePathForcibly, doesDirectoryExist, doesFileExist) | ||
28 | |||
29 | import FileProcessors (FileProcessor) | ||
30 | import Files | ||
31 | |||
32 | |||
33 | type Cache = FileProcessor -> FileProcessor | ||
34 | |||
35 | skipCache :: Cache | ||
36 | skipCache processor inputPath outputPath = | ||
37 | removePathForcibly outputPath | ||
38 | >> processor inputPath outputPath | ||
39 | |||
40 | withCache :: Cache | ||
41 | withCache 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 ) |
46 | import Processors | 46 | import ItemProcessors (itemFileProcessor, thumbnailFileProcessor) |
47 | ( itemFileProcessor, thumbnailFileProcessor | 47 | import Caching (skipCache, withCache) |
48 | , skipCached, withCached ) | ||
49 | 48 | ||
50 | 49 | ||
51 | defaultGalleryConf :: String | 50 | defaultGalleryConf :: 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 | |||
19 | module FileProcessors | ||
20 | ( FileProcessor | ||
21 | , copyFileProcessor | ||
22 | , resizePictureUpTo | ||
23 | , resourceAt | ||
24 | , getImageResolution | ||
25 | , ItemDescriber | ||
26 | , getPictureProps | ||
27 | ) where | ||
28 | |||
29 | |||
30 | import Control.Exception (Exception, throwIO) | ||
31 | import System.Process (readProcess, callProcess) | ||
32 | import Text.Read (readMaybe) | ||
33 | |||
34 | import System.Directory (getModificationTime) | ||
35 | import qualified System.Directory | ||
36 | |||
37 | import Config (Resolution(..)) | ||
38 | import Resource (Resource(..), GalleryItemProps(..)) | ||
39 | import Files | ||
40 | |||
41 | |||
42 | data ProcessingException = ProcessingException FilePath String deriving Show | ||
43 | instance Exception ProcessingException | ||
44 | |||
45 | type FileProcessor = | ||
46 | FileName -- ^ Input path | ||
47 | -> FileName -- ^ Output path | ||
48 | -> IO () | ||
49 | |||
50 | copyFileProcessor :: FileProcessor | ||
51 | copyFileProcessor inputPath outputPath = | ||
52 | putStrLn ("Copying:\t" ++ outputPath) | ||
53 | >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath | ||
54 | |||
55 | resizePictureUpTo :: Resolution -> FileProcessor | ||
56 | resizePictureUpTo 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 | |||
71 | resourceAt :: FilePath -> Path -> IO Resource | ||
72 | resourceAt fsPath resPath = Resource resPath <$> getModificationTime fsPath | ||
73 | |||
74 | getImageResolution :: FilePath -> IO Resolution | ||
75 | getImageResolution 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 | |||
89 | type ItemDescriber = | ||
90 | FilePath | ||
91 | -> Resource | ||
92 | -> IO GalleryItemProps | ||
93 | |||
94 | getPictureProps :: ItemDescriber | ||
95 | getPictureProps 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 | ||
19 | module Processors | 19 | module 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 | ||
27 | import Control.Exception (Exception, throwIO) | ||
28 | import Control.Monad (when) | ||
29 | import Data.Function ((&)) | 27 | import Data.Function ((&)) |
30 | import Data.Char (toLower) | 28 | import Data.Char (toLower) |
31 | import Text.Read (readMaybe) | 29 | import System.FilePath (takeExtension) |
32 | |||
33 | import System.Directory hiding (copyFile) | ||
34 | import qualified System.Directory | ||
35 | import System.FilePath | ||
36 | |||
37 | import System.Process (callProcess, readProcess) | ||
38 | |||
39 | import Resource | ||
40 | ( ItemProcessor, ThumbnailProcessor | ||
41 | , GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) ) | ||
42 | 30 | ||
31 | import Config (Resolution(..)) | ||
32 | import Resource (ItemProcessor, ThumbnailProcessor, Thumbnail(..), GalleryItemProps(..)) | ||
33 | import Caching (Cache) | ||
34 | import FileProcessors | ||
43 | import Files | 35 | import Files |
44 | 36 | ||
45 | 37 | ||
46 | data ProcessingException = ProcessingException FilePath String deriving Show | ||
47 | instance Exception ProcessingException | ||
48 | |||
49 | |||
50 | data Format = | 38 | data Format = |
51 | PictureFormat | 39 | PictureFormat |
52 | | PlainTextFormat | 40 | | PlainTextFormat |
@@ -87,85 +75,6 @@ formatFromPath = | |||
87 | _ -> Unknown | 75 | _ -> Unknown |
88 | 76 | ||
89 |