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/Processors.hs | 221 +++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 221 insertions(+)
create mode 100644 compiler/src/Processors.hs
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
new file mode 100644
index 0000000..a296215
--- /dev/null
+++ b/compiler/src/Processors.hs
@@ -0,0 +1,221 @@
+-- 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
+ , FlexibleContexts
+#-}
+
+module Processors
+ ( Resolution(..)
+ , DirFileProcessor, dirFileProcessor
+ , ItemFileProcessor, itemFileProcessor
+ , ThumbnailFileProcessor, thumbnailFileProcessor
+ , skipCached, withCached
+ ) where
+
+
+import Control.Exception (throwIO)
+import Data.Function ((&))
+import Data.Ratio ((%))
+
+import System.Directory hiding (copyFile)
+import qualified System.Directory
+import System.FilePath
+
+import Codec.Picture
+import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented)
+
+import Resource
+import Files
+
+
+data Format =
+ Bmp | Jpg | Png | Tiff | Hdr -- static images
+ | Gif -- TODO: might be animated
+ | Other
+
+formatFromExt :: String -> Format
+formatFromExt ".bmp" = Bmp
+formatFromExt ".jpg" = Jpg
+formatFromExt ".jpeg" = Jpg
+formatFromExt ".png" = Png
+formatFromExt ".tiff" = Tiff
+formatFromExt ".hdr" = Hdr
+formatFromExt ".gif" = Gif
+formatFromExt _ = Other
+
+data Resolution = Resolution
+ { width :: Int
+ , height :: Int } deriving Show
+
+type FileProcessor =
+ FileName -- ^ Input path
+ -> FileName -- ^ Output path
+ -> IO ()
+
+copyFileProcessor :: FileProcessor
+copyFileProcessor inputPath outputPath =
+ (putStrLn $ "Copying: " ++ outputPath)
+ >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
+
+eitherIOToIO :: Either String (IO a) -> IO a
+eitherIOToIO (Left err) = throwIO $ userError err
+eitherIOToIO (Right res) = res
+
+eitherResToIO :: Either String a -> IO a
+eitherResToIO (Left err) = throwIO $ userError err
+eitherResToIO (Right res) = return res
+
+resizeStaticImageUpTo :: Format -> Resolution -> FileProcessor
+resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage
+-- TODO: parameterise export quality for jpg
+resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80)
+resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage
+resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage
+resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage
+resizeStaticImageUpTo Gif = resizeStaticGeneric readGif ((.) eitherIOToIO . saveGifImage)
+
+
+type StaticImageReader = FilePath -> IO (Either String DynamicImage)
+type StaticImageWriter = FilePath -> DynamicImage -> IO ()
+
+resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> FileProcessor
+resizeStaticGeneric reader writer maxRes inputPath outputPath =
+ (putStrLn $ "Generating: " ++ outputPath)
+ >> reader inputPath
+ >>= eitherResToIO
+ >>= return . (fitDynamicImage maxRes)
+ >>= ensureParentDir writer outputPath
+
+fitDynamicImage :: Resolution -> DynamicImage -> DynamicImage
+fitDynamicImage (Resolution boxWidth boxHeight) image =
+ convertRGBA8 image
+ & scaleBilinear targetWidth targetHeight
+ & ImageRGBA8
+ where
+ picWidth = dynamicMap imageWidth image
+ picHeight = dynamicMap imageHeight image
+ resizeRatio = min (boxWidth % picWidth) (boxHeight % picHeight)
+ targetWidth = floor $ resizeRatio * (picWidth % 1)
+ targetHeight = floor $ resizeRatio * (picHeight % 1)
+
+
+type Cache = FileProcessor -> FileProcessor
+
+skipCached :: Cache
+skipCached processor inputPath outputPath =
+ removePathForcibly outputPath
+ >> processor inputPath outputPath
+
+withCached :: Cache
+withCached processor inputPath outputPath =
+ do
+ isDir <- doesDirectoryExist outputPath
+ if isDir then removePathForcibly outputPath else noop
+
+ fileExists <- doesFileExist outputPath
+ if fileExists then
+ do
+ needUpdate <- isOutdated inputPath outputPath
+ if needUpdate then update else skip
+ else
+ update
+
+ where
+ noop = return ()
+ update = processor inputPath outputPath
+ skip = putStrLn $ "Skipping: " ++ outputPath
+
+ isOutdated :: FilePath -> FilePath -> IO Bool
+ isOutdated ref target =
+ do
+ refTime <- getModificationTime ref
+ targetTime <- getModificationTime target
+ return (targetTime < refTime)
+
+
+type DirFileProcessor =
+ FileName -- ^ Input base path
+ -> FileName -- ^ Output base path
+ -> FileName -- ^ Output class (subdir)
+ -> DirProcessor
+
+dirFileProcessor :: DirFileProcessor
+dirFileProcessor _ _ = (.) return . (/>)
+
+
+type ItemFileProcessor =
+ FileName -- ^ Input base path
+ -> FileName -- ^ Output base path
+ -> FileName -- ^ Output class (subdir)
+ -> ItemProcessor
+
+itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
+itemFileProcessor maxRes cached inputBase outputBase resClass inputRes =
+ cached (processor maxRes (extOf inputRes)) inPath outPath
+ >> return relOutPath
+ where
+ extOf = formatFromExt . takeExtension . head
+ relOutPath = resClass /> inputRes
+ inPath = localPath $ inputBase /> inputRes
+ outPath = localPath $ outputBase /> relOutPath
+
+ processor :: Maybe Resolution -> Format -> FileProcessor
+ processor Nothing _ = copyFileProcessor
+ processor (Just maxRes) Bmp = resizeStaticImageUpTo Bmp maxRes
+ processor (Just maxRes) Jpg = resizeStaticImageUpTo Jpg maxRes
+ processor (Just maxRes) Png = resizeStaticImageUpTo Png maxRes
+ processor (Just maxRes) Tiff = resizeStaticImageUpTo Tiff maxRes
+ processor (Just maxRes) Hdr = resizeStaticImageUpTo Hdr maxRes
+ processor _ Gif = copyFileProcessor -- TODO: handle animated gif resizing
+ processor _ Other = copyFileProcessor -- TODO: handle video reencoding and others?
+
+
+type ThumbnailFileProcessor =
+ FileName -- ^ Input base path
+ -> FileName -- ^ Output base path
+ -> FileName -- ^ Output class (subdir)
+ -> ThumbnailProcessor
+
+thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
+thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
+ cached <$> processor (extOf inputRes)
+ & process
+ where
+ extOf = formatFromExt . takeExtension . head
+ relOutPath = resClass /> inputRes
+ inPath = localPath $ inputBase /> inputRes
+ outPath = localPath $ outputBase /> relOutPath
+
+ process :: Maybe FileProcessor -> IO (Maybe Path)
+ process Nothing = return Nothing
+ process (Just processor) =
+ processor inPath outPath
+ >> return (Just relOutPath)
+
+ processor :: Format -> Maybe FileProcessor
+ processor Bmp = Just $ resizeStaticImageUpTo Bmp maxRes
+ processor Jpg = Just $ resizeStaticImageUpTo Jpg maxRes
+ processor Png = Just $ resizeStaticImageUpTo Png maxRes
+ processor Tiff = Just $ resizeStaticImageUpTo Tiff maxRes
+ processor Hdr = Just $ resizeStaticImageUpTo Hdr maxRes
+ processor Gif = Just $ resizeStaticImageUpTo Gif maxRes -- static thumbnail from first frame
+ processor _ = Nothing
--
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/Processors.hs | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index a296215..aaa178f 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -73,7 +73,7 @@ type FileProcessor =
copyFileProcessor :: FileProcessor
copyFileProcessor inputPath outputPath =
- (putStrLn $ "Copying: " ++ outputPath)
+ (putStrLn $ "Copying:\t" ++ outputPath)
>> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
eitherIOToIO :: Either String (IO a) -> IO a
@@ -99,7 +99,7 @@ type StaticImageWriter = FilePath -> DynamicImage -> IO ()
resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> FileProcessor
resizeStaticGeneric reader writer maxRes inputPath outputPath =
- (putStrLn $ "Generating: " ++ outputPath)
+ (putStrLn $ "Generating:\t" ++ outputPath)
>> reader inputPath
>>= eitherResToIO
>>= return . (fitDynamicImage maxRes)
@@ -142,7 +142,7 @@ withCached processor inputPath outputPath =
where
noop = return ()
update = processor inputPath outputPath
- skip = putStrLn $ "Skipping: " ++ outputPath
+ skip = putStrLn $ "Skipping:\t" ++ outputPath
isOutdated :: FilePath -> FilePath -> IO Bool
isOutdated ref target =
--
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/Processors.hs | 12 ++++--------
1 file changed, 4 insertions(+), 8 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index aaa178f..c097db7 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -36,6 +36,9 @@ import Control.Exception (throwIO)
import Data.Function ((&))
import Data.Ratio ((%))
+import GHC.Generics (Generic)
+import Data.Aeson (FromJSON)
+
import System.Directory hiding (copyFile)
import qualified System.Directory
import System.FilePath
@@ -64,7 +67,7 @@ formatFromExt _ = Other
data Resolution = Resolution
{ width :: Int
- , height :: Int } deriving Show
+ , height :: Int } deriving (Show, Generic, FromJSON)
type FileProcessor =
FileName -- ^ Input path
@@ -144,13 +147,6 @@ withCached processor inputPath outputPath =
update = processor inputPath outputPath
skip = putStrLn $ "Skipping:\t" ++ outputPath
- isOutdated :: FilePath -> FilePath -> IO Bool
- isOutdated ref target =
- do
- refTime <- getModificationTime ref
- targetTime <- getModificationTime target
- return (targetTime < refTime)
-
type DirFileProcessor =
FileName -- ^ Input base path
--
cgit v1.2.3
From e324f3b776e24a441e2b436da95629f0eadaed3f Mon Sep 17 00:00:00 2001
From: pacien
Date: Fri, 27 Dec 2019 15:40:50 +0100
Subject: compiler: make extension case insensitive
---
compiler/src/Processors.hs | 19 +++++++++++--------
1 file changed, 11 insertions(+), 8 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index c097db7..7bf1e36 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -35,6 +35,7 @@ module Processors
import Control.Exception (throwIO)
import Data.Function ((&))
import Data.Ratio ((%))
+import Data.Char (toLower)
import GHC.Generics (Generic)
import Data.Aeson (FromJSON)
@@ -56,14 +57,16 @@ data Format =
| Other
formatFromExt :: String -> Format
-formatFromExt ".bmp" = Bmp
-formatFromExt ".jpg" = Jpg
-formatFromExt ".jpeg" = Jpg
-formatFromExt ".png" = Png
-formatFromExt ".tiff" = Tiff
-formatFromExt ".hdr" = Hdr
-formatFromExt ".gif" = Gif
-formatFromExt _ = Other
+formatFromExt = aux . (map toLower)
+ where
+ aux ".bmp" = Bmp
+ aux ".jpg" = Jpg
+ aux ".jpeg" = Jpg
+ aux ".png" = Png
+ aux ".tiff" = Tiff
+ aux ".hdr" = Hdr
+ aux ".gif" = Gif
+ aux _ = Other
data Resolution = Resolution
{ width :: Int
--
cgit v1.2.3
From 1872dbe68d4a68f43990f8a93e3ff4716eecf525 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 29 Dec 2019 09:31:38 +0100
Subject: compiler: make processing error message mention the problematic file
---
compiler/src/Processors.hs | 22 +++++++++++-----------
1 file changed, 11 insertions(+), 11 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 7bf1e36..67f8619 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -32,7 +32,7 @@ module Processors
) where
-import Control.Exception (throwIO)
+import Control.Exception (Exception, throwIO)
import Data.Function ((&))
import Data.Ratio ((%))
import Data.Char (toLower)
@@ -51,6 +51,9 @@ import Resource
import Files
+data ProcessingException = ProcessingException FilePath String deriving Show
+instance Exception ProcessingException
+
data Format =
Bmp | Jpg | Png | Tiff | Hdr -- static images
| Gif -- TODO: might be animated
@@ -82,14 +85,6 @@ copyFileProcessor inputPath outputPath =
(putStrLn $ "Copying:\t" ++ outputPath)
>> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
-eitherIOToIO :: Either String (IO a) -> IO a
-eitherIOToIO (Left err) = throwIO $ userError err
-eitherIOToIO (Right res) = res
-
-eitherResToIO :: Either String a -> IO a
-eitherResToIO (Left err) = throwIO $ userError err
-eitherResToIO (Right res) = return res
-
resizeStaticImageUpTo :: Format -> Resolution -> FileProcessor
resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage
-- TODO: parameterise export quality for jpg
@@ -97,7 +92,12 @@ resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80)
resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage
resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage
resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage
-resizeStaticImageUpTo Gif = resizeStaticGeneric readGif ((.) eitherIOToIO . saveGifImage)
+resizeStaticImageUpTo Gif = resizeStaticGeneric readGif writeGifImage
+ where
+ writeGifImage :: StaticImageWriter
+ writeGifImage outputPath image =
+ saveGifImage outputPath image
+ & either (throwIO . ProcessingException outputPath) id
type StaticImageReader = FilePath -> IO (Either String DynamicImage)
@@ -107,7 +107,7 @@ resizeStaticGeneric :: StaticImageReader -> StaticImageWriter -> Resolution -> F
resizeStaticGeneric reader writer maxRes inputPath outputPath =
(putStrLn $ "Generating:\t" ++ outputPath)
>> reader inputPath
- >>= eitherResToIO
+ >>= either (throwIO . ProcessingException inputPath) return
>>= return . (fitDynamicImage maxRes)
>>= ensureParentDir writer outputPath
--
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/Processors.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 67f8619..7362822 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -140,7 +140,7 @@ withCached processor inputPath outputPath =
fileExists <- doesFileExist outputPath
if fileExists then
do
- needUpdate <- isOutdated inputPath outputPath
+ needUpdate <- isOutdated True inputPath outputPath
if needUpdate then update else skip
else
update
--
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/Processors.hs | 10 ++++------
1 file changed, 4 insertions(+), 6 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 7362822..ded3cc5 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -59,8 +59,8 @@ data Format =
| Gif -- TODO: might be animated
| Other
-formatFromExt :: String -> Format
-formatFromExt = aux . (map toLower)
+formatFromPath :: Path -> Format
+formatFromPath = aux . (map toLower) . fileName
where
aux ".bmp" = Bmp
aux ".jpg" = Jpg
@@ -169,10 +169,9 @@ type ItemFileProcessor =
itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
itemFileProcessor maxRes cached inputBase outputBase resClass inputRes =
- cached (processor maxRes (extOf inputRes)) inPath outPath
+ cached (processor maxRes (formatFromPath inputRes)) inPath outPath
>> return relOutPath
where
- extOf = formatFromExt . takeExtension . head
relOutPath = resClass /> inputRes
inPath = localPath $ inputBase /> inputRes
outPath = localPath $ outputBase /> relOutPath
@@ -196,10 +195,9 @@ type ThumbnailFileProcessor =
thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
- cached <$> processor (extOf inputRes)
+ cached <$> processor (formatFromPath inputRes)
& process
where
- extOf = formatFromExt . takeExtension . head
relOutPath = resClass /> inputRes
inPath = localPath $ inputBase /> inputRes
outPath = localPath $ outputBase /> relOutPath
--
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/Processors.hs | 8 +-------
1 file changed, 1 insertion(+), 7 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index ded3cc5..df05c24 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -37,9 +37,6 @@ import Data.Function ((&))
import Data.Ratio ((%))
import Data.Char (toLower)
-import GHC.Generics (Generic)
-import Data.Aeson (FromJSON)
-
import System.Directory hiding (copyFile)
import qualified System.Directory
import System.FilePath
@@ -60,7 +57,7 @@ data Format =
| Other
formatFromPath :: Path -> Format
-formatFromPath = aux . (map toLower) . fileName
+formatFromPath = aux . (map toLower) . takeExtension . fileName
where
aux ".bmp" = Bmp
aux ".jpg" = Jpg
@@ -71,9 +68,6 @@ formatFromPath = aux . (map toLower) . fileName
aux ".gif" = Gif
aux _ = Other
-data Resolution = Resolution
- { width :: Int
- , height :: Int } deriving (Show, Generic, FromJSON)
type FileProcessor =
FileName -- ^ Input path
--
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/Processors.hs | 32 ++++++++++++++++++--------------
1 file changed, 18 insertions(+), 14 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index df05c24..dab9aaa 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -45,6 +45,9 @@ import Codec.Picture
import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented)
import Resource
+ ( DirProcessor, ItemProcessor, ThumbnailProcessor
+ , GalleryItemProps(..), Resolution(..) )
+
import Files
@@ -54,7 +57,7 @@ instance Exception ProcessingException
data Format =
Bmp | Jpg | Png | Tiff | Hdr -- static images
| Gif -- TODO: might be animated
- | Other
+ | Unknown
formatFromPath :: Path -> Format
formatFromPath = aux . (map toLower) . takeExtension . fileName
@@ -66,7 +69,7 @@ formatFromPath = aux . (map toLower) . takeExtension . fileName
aux ".tiff" = Tiff
aux ".hdr" = Hdr
aux ".gif" = Gif
- aux _ = Other
+ aux _ = Unknown
type FileProcessor =
@@ -163,22 +166,23 @@ type ItemFileProcessor =
itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
itemFileProcessor maxRes cached inputBase outputBase resClass inputRes =
- cached (processor maxRes (formatFromPath inputRes)) inPath outPath
- >> return relOutPath
+ cached processor inPath outPath
+ >> return (relOutPath, props)
where
relOutPath = resClass /> inputRes
inPath = localPath $ inputBase /> inputRes
outPath = localPath $ outputBase /> relOutPath
-
- processor :: Maybe Resolution -> Format -> FileProcessor
- processor Nothing _ = copyFileProcessor
- processor (Just maxRes) Bmp = resizeStaticImageUpTo Bmp maxRes
- processor (Just maxRes) Jpg = resizeStaticImageUpTo Jpg maxRes
- processor (Just maxRes) Png = resizeStaticImageUpTo Png maxRes
- processor (Just maxRes) Tiff = resizeStaticImageUpTo Tiff maxRes
- processor (Just maxRes) Hdr = resizeStaticImageUpTo Hdr maxRes
- processor _ Gif = copyFileProcessor -- TODO: handle animated gif resizing
- processor _ Other = copyFileProcessor -- TODO: handle video reencoding and others?
+ (processor, props) = formatProcessor maxRes $ formatFromPath inputRes
+
+ formatProcessor :: Maybe Resolution -> Format -> (FileProcessor, GalleryItemProps)
+ formatProcessor Nothing _ = (copyFileProcessor, Other)
+ formatProcessor (Just maxRes) Bmp = (resizeStaticImageUpTo Bmp maxRes, Picture)
+ formatProcessor (Just maxRes) Jpg = (resizeStaticImageUpTo Jpg maxRes, Picture)
+ formatProcessor (Just maxRes) Png = (resizeStaticImageUpTo Png maxRes, Picture)
+ formatProcessor (Just maxRes) Tiff = (resizeStaticImageUpTo Tiff maxRes, Picture)
+ formatProcessor (Just maxRes) Hdr = (resizeStaticImageUpTo Hdr maxRes, Picture)
+ formatProcessor _ Gif = (copyFileProcessor, Other) -- TODO: handle animated gif resizing
+ formatProcessor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
type ThumbnailFileProcessor =
--
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/Processors.hs | 21 +++++++++++----------
1 file changed, 11 insertions(+), 10 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index dab9aaa..2525af4 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.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
@@ -60,16 +60,17 @@ data Format =
| Unknown
formatFromPath :: Path -> Format
-formatFromPath = aux . (map toLower) . takeExtension . fileName
+formatFromPath = maybe Unknown fromExt . fmap (map toLower) . fmap takeExtension . fileName
where
- aux ".bmp" = Bmp
- aux ".jpg" = Jpg
- aux ".jpeg" = Jpg
- aux ".png" = Png
- aux ".tiff" = Tiff
- aux ".hdr" = Hdr
- aux ".gif" = Gif
- aux _ = Unknown
+ fromExt :: String -> Format
+ fromExt ".bmp" = Bmp
+ fromExt ".jpg" = Jpg
+ fromExt ".jpeg" = Jpg
+ fromExt ".png" = Png
+ fromExt ".tiff" = Tiff
+ fromExt ".hdr" = Hdr
+ fromExt ".gif" = Gif
+ fromExt _ = Unknown
type FileProcessor =
--
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/Processors.hs | 17 +++++++++--------
1 file changed, 9 insertions(+), 8 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 2525af4..6ee8c78 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -32,7 +32,7 @@ module Processors
) where
-import Control.Exception (Exception, throwIO)
+import Control.Exception (Exception, PatternMatchFail(..), throw, throwIO)
import Data.Function ((&))
import Data.Ratio ((%))
import Data.Char (toLower)
@@ -90,12 +90,13 @@ resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80)
resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage
resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage
resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage
-resizeStaticImageUpTo Gif = resizeStaticGeneric readGif writeGifImage
+resizeStaticImageUpTo Gif = resizeStaticGeneric readGif saveGifImage'
where
- writeGifImage :: StaticImageWriter
- writeGifImage outputPath image =
+ saveGifImage' :: StaticImageWriter
+ saveGifImage' outputPath image =
saveGifImage outputPath image
& either (throwIO . ProcessingException outputPath) id
+resizeStaticImageUpTo _ = throw $ PatternMatchFail "Unhandled format"
type StaticImageReader = FilePath -> IO (Either String DynamicImage)
@@ -166,14 +167,14 @@ type ItemFileProcessor =
-> ItemProcessor
itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
-itemFileProcessor maxRes cached inputBase outputBase resClass inputRes =
+itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
cached processor inPath outPath
>> return (relOutPath, props)
where
relOutPath = resClass /> inputRes
inPath = localPath $ inputBase /> inputRes
outPath = localPath $ outputBase /> relOutPath
- (processor, props) = formatProcessor maxRes $ formatFromPath inputRes
+ (processor, props) = formatProcessor maxResolution $ formatFromPath inputRes
formatProcessor :: Maybe Resolution -> Format -> (FileProcessor, GalleryItemProps)
formatProcessor Nothing _ = (copyFileProcessor, Other)
@@ -203,8 +204,8 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
process :: Maybe FileProcessor -> IO (Maybe Path)
process Nothing = return Nothing
- process (Just processor) =
- processor inPath outPath
+ process (Just proc) =
+ proc inPath outPath
>> return (Just relOutPath)
processor :: Format -> Maybe FileProcessor
--
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/Processors.hs | 7 -------
1 file changed, 7 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index 6ee8c78..e10dc21 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.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
- , FlexibleContexts
-#-}
-
module Processors
( Resolution(..)
, DirFileProcessor, dirFileProcessor
--
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/Processors.hs | 84 ++++++++++++++++++++--------------------------
1 file changed, 37 insertions(+), 47 deletions(-)
(limited to 'compiler/src/Processors.hs')
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index e10dc21..159a425 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -18,14 +18,13 @@
module Processors
( Resolution(..)
- , DirFileProcessor, dirFileProcessor
, ItemFileProcessor, itemFileProcessor
, ThumbnailFileProcessor, thumbnailFileProcessor
, skipCached, withCached
) where
-import Control.Exception (Exception, PatternMatchFail(..), throw, throwIO)
+import Control.Exception (Exception, throwIO)
import Data.Function ((&))
import Data.Ratio ((%))
import Data.Char (toLower)
@@ -38,7 +37,7 @@ import Codec.Picture
import Codec.Picture.Extra -- TODO: compare DCT and bilinear (and Lanczos, but it's not implemented)
import Resource
- ( DirProcessor, ItemProcessor, ThumbnailProcessor
+ ( ItemProcessor, ThumbnailProcessor
, GalleryItemProps(..), Resolution(..) )
import Files
@@ -47,22 +46,27 @@ import Files
data ProcessingException = ProcessingException FilePath String deriving Show
instance Exception ProcessingException
-data Format =
- Bmp | Jpg | Png | Tiff | Hdr -- static images
- | Gif -- TODO: might be animated
- | Unknown
+
+data PictureFileFormat = Bmp | Jpg | Png | Tiff | Hdr | Gif
+
+-- TODO: handle video, music, text...
+data Format = PictureFormat PictureFileFormat | Unknown
formatFromPath :: Path -> Format
-formatFromPath = maybe Unknown fromExt . fmap (map toLower) . fmap takeExtension . fileName
+formatFromPath =
+ maybe Unknown fromExt
+ . fmap (map toLower)
+ . fmap takeExtension
+ . fileName
where
fromExt :: String -> Format
- fromExt ".bmp" = Bmp
- fromExt ".jpg" = Jpg
- fromExt ".jpeg" = Jpg
- fromExt ".png" = Png
- fromExt ".tiff" = Tiff
- fromExt ".hdr" = Hdr
- fromExt ".gif" = Gif
+ fromExt ".bmp" = PictureFormat Bmp
+ fromExt ".jpg" = PictureFormat Jpg
+ fromExt ".jpeg" = PictureFormat Jpg
+ fromExt ".png" = PictureFormat Png
+ fromExt ".tiff" = PictureFormat Tiff
+ fromExt ".hdr" = PictureFormat Hdr
+ fromExt ".gif" = PictureFormat Gif
fromExt _ = Unknown
@@ -76,7 +80,7 @@ copyFileProcessor inputPath outputPath =
(putStrLn $ "Copying:\t" ++ outputPath)
>> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath
-resizeStaticImageUpTo :: Format -> Resolution -> FileProcessor
+resizeStaticImageUpTo :: PictureFileFormat -> Resolution -> FileProcessor
resizeStaticImageUpTo Bmp = resizeStaticGeneric readBitmap saveBmpImage
-- TODO: parameterise export quality for jpg
resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80)
@@ -89,7 +93,6 @@ resizeStaticImageUpTo Gif = resizeStaticGeneric readGif saveGifImage'
saveGifImage' outputPath image =
saveGifImage outputPath image
& either (throwIO . ProcessingException outputPath) id
-resizeStaticImageUpTo _ = throw $ PatternMatchFail "Unhandled format"
type StaticImageReader = FilePath -> IO (Either String DynamicImage)
@@ -143,16 +146,6 @@ withCached processor inputPath outputPath =
skip = putStrLn $ "Skipping:\t" ++ outputPath
-type DirFileProcessor =
- FileName -- ^ Input base path
- -> FileName -- ^ Output base path
- -> FileName -- ^ Output class (subdir)
- -> DirProcessor
-
-dirFileProcessor :: DirFileProcessor
-dirFileProcessor _ _ = (.) return . (/>)
-
-
type ItemFileProcessor =
FileName -- ^ Input base path
-> FileName -- ^ Output base path
@@ -162,22 +155,22 @@ type ItemFileProcessor =
itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor
itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes =
cached processor inPath outPath
- >> return (relOutPath, props)
+ >> return (props relOutPath)
where
relOutPath = resClass /> inputRes
inPath = localPath $ inputBase /> inputRes
outPath = localPath $ outputBase /> relOutPath
- (processor, props) = formatProcessor maxResolution $ formatFromPath inputRes
+ (processor, props) = processorFor maxResolution $ formatFromPath inputRes
- formatProcessor :: Maybe Resolution -> Format -> (FileProcessor, GalleryItemProps)
- formatProcessor Nothing _ = (copyFileProcessor, Other)
- formatProcessor (Just maxRes) Bmp = (resizeStaticImageUpTo Bmp maxRes, Picture)
- formatProcessor (Just maxRes) Jpg = (resizeStaticImageUpTo Jpg maxRes, Picture)
- formatProcessor (Just maxRes) Png = (resizeStaticImageUpTo Png maxRes, Picture)
- formatProcessor (Just maxRes) Tiff = (resizeStaticImageUpTo Tiff maxRes, Picture)
- formatProcessor (Just maxRes) Hdr = (resizeStaticImageUpTo Hdr maxRes, Picture)
- formatProcessor _ Gif = (copyFileProcessor, Other) -- TODO: handle animated gif resizing
- formatProcessor _ Unknown = (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
+ processorFor :: Maybe Resolution -> Format -> (FileProcessor, Path -> GalleryItemProps)
+ processorFor Nothing _ =
+ (copyFileProcessor, Other)
+ processorFor _ (PictureFormat Gif) =
+ (copyFileProcessor, Picture) -- TODO: handle animated gif resizing
+ processorFor (Just maxRes) (PictureFormat picFormat) =
+ (resizeStaticImageUpTo picFormat maxRes, Picture)
+ processorFor _ Unknown =
+ (copyFileProcessor, Other) -- TODO: handle video reencoding and others?
type ThumbnailFileProcessor =
@@ -188,7 +181,7 @@ type ThumbnailFileProcessor =
thumbnailFileProcessor :: Resolution -> Cache -> ThumbnailFileProcessor
thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
- cached <$> processor (formatFromPath inputRes)
+ cached <$> processorFor (formatFromPath inputRes)
& process
where
relOutPath = resClass /> inputRes
@@ -201,11 +194,8 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
proc inPath outPath
>> return (Just relOutPath)
- processor :: Format -> Maybe FileProcessor
- processor Bmp = Just $ resizeStaticImageUpTo Bmp maxRes
- processor Jpg = Just $ resizeStaticImageUpTo Jpg maxRes
- processor Png = Just $ resizeStaticImageUpTo Png maxRes
- processor Tiff = Just $ resizeStaticImageUpTo Tiff maxRes
- processor Hdr = Just $ resizeStaticImageUpTo Hdr maxRes
- processor Gif = Just $ resizeStaticImageUpTo Gif maxRes -- static thumbnail from first frame
- processor _ = Nothing
+ processorFor :: Format -> Maybe FileProcessor
+ processorFor (PictureFormat picFormat) =
+ Just $ resizeStaticImageUpTo picFormat maxRes
+ processorFor _ =
+ Nothing
--
cgit v1.2.3