aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Processors.hs
diff options
context:
space:
mode:
authorpacien2020-09-25 16:01:49 +0200
committerpacien2020-09-25 16:01:49 +0200
commite93f7b1eb84c083d67567115284c0002a3a7d5fc (patch)
tree8d373e8f7f571485e1330928f43b090ed004c525 /compiler/src/Processors.hs
parent8e3ac8fe44bebb38e1882ca7f06b8100078ad88d (diff)
parentfd542f75a1d94ee5f804d0925823276b97f38581 (diff)
downloadldgallery-e93f7b1eb84c083d67567115284c0002a3a7d5fc.tar.gz
Merge branch 'develop' for release v2.0v2.0
Diffstat (limited to 'compiler/src/Processors.hs')
-rw-r--r--compiler/src/Processors.hs203
1 files changed, 0 insertions, 203 deletions
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
deleted file mode 100644
index 02db325..0000000
--- a/compiler/src/Processors.hs
+++ /dev/null
@@ -1,203 +0,0 @@
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 Processors
20 ( Resolution(..)
21 , ItemFileProcessor, itemFileProcessor
22 , ThumbnailFileProcessor, thumbnailFileProcessor
23 , skipCached, withCached
24 ) where
25
26
27import Control.Exception (Exception, throwIO)
28import Control.Monad (when)
29import Data.Function ((&))
30import Data.Char (toLower)
31import Text.Read (readMaybe)
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
43import Files
44
45
46data ProcessingException = ProcessingException FilePath String deriving Show
47instance Exception ProcessingException
48
49
50-- TODO: handle video, music, text...
51data Format = PictureFormat | Unknown
52
53formatFromPath :: Path -> Format
54formatFromPath =
55 maybe Unknown fromExt
56 . fmap (map toLower)
57 . fmap takeExtension
58 . fileName
59 where
60 fromExt :: String -> Format
61 fromExt ext = case ext of
62 ".bmp" -> PictureFormat
63 ".jpg" -> PictureFormat
64 ".jpeg" -> PictureFormat
65 ".png" -> PictureFormat
66 ".tiff" -> PictureFormat
67 ".hdr" -> PictureFormat
68 ".gif" -> PictureFormat
69 _ -> Unknown
70
71
72type FileProcessor =
73 FileName -- ^ Input path
74 -> FileName -- ^ Output path
75 -> IO ()
76
77copyFileProcessor :: FileProcessor
78copyFileProcessor inputPath outputPath =
79 (putStrLn $ "Copying:\t" ++ outputPath)
80 >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
81
82resizePictureUpTo :: Resolution -> FileProcessor
83resizePictureUpTo maxResolution inputPath outputPath =
84 (putStrLn $ "Generating:\t" ++ outputPath)
85 >> ensureParentDir (flip resize) outputPath inputPath
86 where
87 maxSize :: Resolution -> String
88 maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">"
89
90 resize :: FileName -> FileName -> IO ()
91 resize input output = callProcess "magick"
92 [ input
93 , "-auto-orient"
94 , "-resize", maxSize maxResolution
95 , output ]
96
97
98type Cache = FileProcessor -> FileProcessor
99
100skipCached :: Cache
101skipCached processor inputPath outputPath =
102 removePathForcibly outputPath
103 >> processor inputPath outputPath
104
105withCached :: Cache
106withCached processor inputPath outputPath =
107 do
108 isDir <- doesDirectoryExist outputPath
109 when isDir $ removePathForcibly outputPath
110
111 fileExists <- doesFileExist outputPath
112 if fileExists then
113 do
114 needUpdate <- isOutdated True inputPath outputPath
115 if needUpdate then update else skip
116 else
117 update
118
119 where
120 update = processor inputPath outputPath
121 skip = putStrLn $ "Skipping:\t" ++ outputPath
122
123
124resourceAt :: FilePath -> Path -> IO Resource
125resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath
126
127getImageResolution :: FilePath -> IO Resolution
128getImageResolution fsPath =
129 readProcess "magick" ["identify", "-format", "%w %h", firstFrame] []
130 >>= parseResolution . break (== ' ')
131 where
132 firstFrame :: FilePath
133 firstFrame = fsPath ++ "[0]"
134
135 parseResolution :: (String, String) -> IO Resolution
136 parseResolution (widthString, heightString) =
137 case (readMaybe widthString, readMaybe heightString) of
138 (Just w, Just h) -> return $ Resolution w h
139 _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution."
140
141getPictureProps :: ItemDescriber
142getPictureProps fsPath resource =
143 getImageResolution fsPath
144 >>= return . Picture resource
145
146
147type ItemDescriber =
148 FilePath
149 -> Resource
150 -> IO GalleryItemProps
151
152
153type ItemFileProcessor =
154 FileName -- ^ Input base path
155 -> FileName -- ^ Output base path
156 -> FileName -- ^ Output class (subdir)
157 -> ItemProcessor
158
159itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
160itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
161 cached processor inPath outPath
162 >> resourceAt outPath relOutPath
163 >>= descriptor outPath
164 where
165 relOutPath = resClass /> inputRes
166 inPath = localPath $ inputBase /> inputRes
167 outPath = localPath $ outputBase /> relOutPath
168 (processor, descriptor) = processorFor (formatFromPath inputRes) maxResolution
169
170 processorFor :: Format -> Maybe Resolution -> (FileProcessor, ItemDescriber)
171 processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps)
172 processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps)
173 -- TODO: handle video reencoding and others?
174 processorFor Unknown _ = (copyFileProcessor, const $ return . Other)
175
176
177type ThumbnailFileProcessor =
178 FileName -- ^ Input base path
179 -> FileName -- ^ Output base path
180 -> FileName -- ^ Output class (subdir)
181 -> ThumbnailProcessor
182
183thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
184thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
185 cached <$> processorFor (formatFromPath inputRes)
186 & process
187 where
188 relOutPath = resClass /> inputRes
189 inPath = localPath $ inputBase /> inputRes
190 outPath = localPath $ outputBase /> relOutPath
191
192 process :: Maybe FileProcessor -> IO (Maybe Thumbnail)
193 process Nothing = return Nothing
194 process (Just proc) =
195 do
196 proc inPath outPath
197 resource <- resourceAt outPath relOutPath
198 resolution <- getImageResolution outPath
199 return $ Just $ Thumbnail resource resolution
200
201 processorFor :: Format -> Maybe FileProcessor
202 processorFor PictureFormat = Just $ resizePictureUpTo maxRes
203 processorFor _ = Nothing