From 04d5cb917f4288c26a308dfda4ba788d77fda8fd Mon Sep 17 00:00:00 2001 From: pacien Date: Wed, 13 May 2020 00:18:16 +0200 Subject: compiler: add plain text file format support through simple copy --- compiler/src/Processors.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 02db325..ca8a74c 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -47,8 +47,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show instance Exception ProcessingException --- TODO: handle video, music, text... -data Format = PictureFormat | Unknown +-- TODO: handle video, music, markdown, pdf... +data Format = PictureFormat | PlainTextFormat | Unknown formatFromPath :: Path -> Format formatFromPath = @@ -66,6 +66,8 @@ formatFromPath = ".tiff" -> PictureFormat ".hdr" -> PictureFormat ".gif" -> PictureFormat + ".txt" -> PlainTextFormat + ".md" -> PlainTextFormat -- TODO: handle markdown separately _ -> Unknown @@ -170,6 +172,7 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = processorFor :: Format -> Maybe Resolution -> (FileProcessor, ItemDescriber) processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps) processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps) + processorFor PlainTextFormat _ = (copyFileProcessor, const $ return . PlainText) -- TODO: handle video reencoding and others? processorFor Unknown _ = (copyFileProcessor, const $ return . Other) -- cgit v1.2.3 From e9e46a3b3392ab435f7414729592b2b5af4071b6 Mon Sep 17 00:00:00 2001 From: pacien Date: Mon, 18 May 2020 20:05:14 +0200 Subject: compiler: add pdf resource type --- compiler/src/Processors.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index ca8a74c..2988f83 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -47,8 +47,8 @@ data ProcessingException = ProcessingException FilePath String deriving Show instance Exception ProcessingException --- TODO: handle video, music, markdown, pdf... -data Format = PictureFormat | PlainTextFormat | Unknown +-- TODO: handle video, music, markdown... +data Format = PictureFormat | PlainTextFormat | PortableDocumentFormat | Unknown formatFromPath :: Path -> Format formatFromPath = @@ -68,6 +68,7 @@ formatFromPath = ".gif" -> PictureFormat ".txt" -> PlainTextFormat ".md" -> PlainTextFormat -- TODO: handle markdown separately + ".pdf" -> PortableDocumentFormat _ -> Unknown @@ -173,6 +174,7 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps) processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps) processorFor PlainTextFormat _ = (copyFileProcessor, const $ return . PlainText) + processorFor PortableDocumentFormat _ = (copyFileProcessor, const $ return . PDF) -- TODO: handle video reencoding and others? processorFor Unknown _ = (copyFileProcessor, const $ return . Other) -- cgit v1.2.3 From 516ee7c5599f2c90a636fd9301806bef67830046 Mon Sep 17 00:00:00 2001 From: pacien Date: Tue, 19 May 2020 21:06:16 +0200 Subject: compiler: add audio and video extensions --- compiler/src/Processors.hs | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 2988f83..0efbf6d 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -47,8 +47,13 @@ data ProcessingException = ProcessingException FilePath String deriving Show instance Exception ProcessingException --- TODO: handle video, music, markdown... -data Format = PictureFormat | PlainTextFormat | PortableDocumentFormat | Unknown +data Format = + PictureFormat + | PlainTextFormat + | PortableDocumentFormat + | VideoFormat + | AudioFormat + | Unknown formatFromPath :: Path -> Format formatFromPath = @@ -69,6 +74,19 @@ formatFromPath = ".txt" -> PlainTextFormat ".md" -> PlainTextFormat -- TODO: handle markdown separately ".pdf" -> PortableDocumentFormat + ".wav" -> AudioFormat + ".oga" -> AudioFormat + ".ogg" -> AudioFormat + ".spx" -> AudioFormat + ".opus" -> AudioFormat + ".flac" -> AudioFormat + ".m4a" -> AudioFormat + ".mp3" -> AudioFormat + ".ogv" -> VideoFormat + ".ogx" -> VideoFormat + ".webm" -> VideoFormat + ".mkv" -> VideoFormat + ".mp4" -> VideoFormat _ -> Unknown @@ -175,6 +193,8 @@ itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps) processorFor PlainTextFormat _ = (copyFileProcessor, const $ return . PlainText) processorFor PortableDocumentFormat _ = (copyFileProcessor, const $ return . PDF) + processorFor VideoFormat _ = (copyFileProcessor, const $ return . Video) + processorFor AudioFormat _ = (copyFileProcessor, const $ return . Audio) -- TODO: handle video reencoding and others? processorFor Unknown _ = (copyFileProcessor, const $ return . Other) -- cgit v1.2.3 From 00c6216259d8a7b131307953ba5000d2b5dc564b Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 13 Jun 2020 00:06:18 +0200 Subject: compiler: trivial code simplifications Following HLint's advice. --- compiler/src/Processors.hs | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 0efbf6d..73529ee 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -57,10 +57,7 @@ data Format = formatFromPath :: Path -> Format formatFromPath = - maybe Unknown fromExt - . fmap (map toLower) - . fmap takeExtension - . fileName + maybe Unknown ((fromExt . map toLower) . takeExtension) . fileName where fromExt :: String -> Format fromExt ext = case ext of @@ -97,12 +94,12 @@ type FileProcessor = copyFileProcessor :: FileProcessor copyFileProcessor inputPath outputPath = - (putStrLn $ "Copying:\t" ++ outputPath) + putStrLn ("Copying:\t" ++ outputPath) >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath resizePictureUpTo :: Resolution -> FileProcessor resizePictureUpTo maxResolution inputPath outputPath = - (putStrLn $ "Generating:\t" ++ outputPath) + putStrLn ("Generating:\t" ++ outputPath) >> ensureParentDir (flip resize) outputPath inputPath where maxSize :: Resolution -> String @@ -143,7 +140,7 @@ withCached processor inputPath outputPath = resourceAt :: FilePath -> Path -> IO Resource -resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath +resourceAt fsPath resPath = Resource resPath <$> getModificationTime fsPath getImageResolution :: FilePath -> IO Resolution getImageResolution fsPath = @@ -160,9 +157,7 @@ getImageResolution fsPath = _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." getPictureProps :: ItemDescriber -getPictureProps fsPath resource = - getImageResolution fsPath - >>= return . Picture resource +getPictureProps fsPath resource = Picture resource <$> getImageResolution fsPath type ItemDescriber = -- cgit v1.2.3 From 8905383e2d17e2adb4097e1ce2e7f90ab9ceb5f5 Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 13 Jun 2020 10:58:00 +0200 Subject: compiler: split ItemProcessors, FileProcessors and Caching --- compiler/src/Processors.hs | 223 --------------------------------------------- 1 file changed, 223 deletions(-) delete mode 100644 compiler/src/Processors.hs (limited to 'compiler/src/Processors.hs') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs deleted file mode 100644 index 73529ee..0000000 --- a/compiler/src/Processors.hs +++ /dev/null @@ -1,223 +0,0 @@ --- ldgallery - A static generator which turns a collection of tagged --- pictures into a searchable web gallery. --- --- 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 --- 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 . - -module Processors - ( Resolution(..) - , ItemFileProcessor, itemFileProcessor - , ThumbnailFileProcessor, thumbnailFileProcessor - , skipCached, withCached - ) where - - -import Control.Exception (Exception, throwIO) -import Control.Monad (when) -import Data.Function ((&)) -import Data.Char (toLower) -import Text.Read (readMaybe) - -import System.Directory hiding (copyFile) -import qualified System.Directory -import System.FilePath - -import System.Process (callProcess, readProcess) - -import Resource - ( ItemProcessor, ThumbnailProcessor - , GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) ) - -import Files - - -data ProcessingException = ProcessingException FilePath String deriving Show -instance Exception ProcessingException - - -data Format = - PictureFormat - | PlainTextFormat - | PortableDocumentFormat - | VideoFormat - | AudioFormat - | Unknown - -formatFromPath :: Path -> Format -formatFromPath = - maybe Unknown ((fromExt . map toLower) . takeExtension) . fileName - where - fromExt :: String -> Format - fromExt ext = case ext of - ".bmp" -> PictureFormat - ".jpg" -> PictureFormat - ".jpeg" -> PictureFormat - ".png" -> PictureFormat - ".tiff" -> PictureFormat - ".hdr" -> PictureFormat - ".gif" -> PictureFormat - ".txt" -> PlainTextFormat - ".md" -> PlainTextFormat -- TODO: handle markdown separately - ".pdf" -> PortableDocumentFormat - ".wav" -> AudioFormat - ".oga" -> AudioFormat - ".ogg" -> AudioFormat - ".spx" -> AudioFormat - ".opus" -> AudioFormat - ".flac" -> AudioFormat - ".m4a" -> AudioFormat - ".mp3" -> AudioFormat - ".ogv" -> VideoFormat - ".ogx" -> VideoFormat - ".webm" -> VideoFormat - ".mkv" -> VideoFormat - ".mp4" -> VideoFormat - _ -> Unknown - - -type FileProcessor = - FileName -- ^ Input path - -> FileName -- ^ Output path - -> IO () - -copyFileProcessor :: FileProcessor -copyFileProcessor inputPath outputPath = - putStrLn ("Copying:\t" ++ outputPath) - >> ensureParentDir (flip System.Directory.copyFile) outputPath inputPath - -resizePictureUpTo :: Resolution -> FileProcessor -resizePictureUpTo maxResolution inputPath outputPath = - putStrLn ("Generating:\t" ++ outputPath) - >> ensureParentDir (flip resize) outputPath inputPath - where - maxSize :: Resolution -> String - maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" - - resize :: FileName -> FileName -> IO () - resize input output = callProcess "magick" - [ input - , "-auto-orient" - , "-resize", maxSize maxResolution - , output ] - - -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 - when isDir $ removePathForcibly outputPath - - fileExists <- doesFileExist outputPath - if fileExists then - do - needUpdate <- isOutdated True inputPath outputPath - if needUpdate then update else skip - else - update - - where - update = processor inputPath outputPath - skip = putStrLn $ "Skipping:\t" ++ outputPath - - -resourceAt :: FilePath -> Path -> IO Resource -resourceAt fsPath resPath = Resource resPath <$> getModificationTime fsPath - -getImageResolution :: FilePath -> IO Resolution -getImageResolution fsPath = - readProcess "magick" ["identify", "-format", "%w %h", firstFrame] [] - >>= parseResolution . break (== ' ') - where - firstFrame :: FilePath - firstFrame = fsPath ++ "[0]" - - parseResolution :: (String, String) -> IO Resolution - parseResolution (widthString, heightString) = - case (readMaybe widthString, readMaybe heightString) of - (Just w, Just h) -> return $ Resolution w h - _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." - -getPictureProps :: ItemDescriber -getPictureProps fsPath resource = Picture resource <$> getImageResolution fsPath - - -type ItemDescriber = - FilePath - -> Resource - -> IO GalleryItemProps - - -type ItemFileProcessor = - FileName -- ^ Input base path - -> FileName -- ^ Output base path - -> FileName -- ^ Output class (subdir) - -> ItemProcessor - -itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor -itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = - cached processor inPath outPath - >> resourceAt outPath relOutPath - >>= descriptor outPath - where - relOutPath = resClass /> inputRes - inPath = localPath $ inputBase /> inputRes - outPath = localPath $ outputBase /> relOutPath - (processor, descriptor) = processorFor (formatFromPath inputRes) maxResolution - - processorFor :: Format -> Maybe Resolution -> (FileProcessor, ItemDescriber) - processorFor PictureFormat (Just maxRes) = (resizePictureUpTo maxRes, getPictureProps) - processorFor PictureFormat Nothing = (copyFileProcessor, getPictureProps) - processorFor PlainTextFormat _ = (copyFileProcessor, const $ return . PlainText) - processorFor PortableDocumentFormat _ = (copyFileProcessor, const $ return . PDF) - processorFor VideoFormat _ = (copyFileProcessor, const $ return . Video) - processorFor AudioFormat _ = (copyFileProcessor, const $ return . Audio) - -- TODO: handle video reencoding and others? - processorFor Unknown _ = (copyFileProcessor, const $ return . Other) - - -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 <$> processorFor (formatFromPath inputRes) - & process - where - relOutPath = resClass /> inputRes - inPath = localPath $ inputBase /> inputRes - outPath = localPath $ outputBase /> relOutPath - - process :: Maybe FileProcessor -> IO (Maybe Thumbnail) - process Nothing = return Nothing - process (Just proc) = - do - proc inPath outPath - resource <- resourceAt outPath relOutPath - resolution <- getImageResolution outPath - return $ Just $ Thumbnail resource resolution - - processorFor :: Format -> Maybe FileProcessor - processorFor PictureFormat = Just $ resizePictureUpTo maxRes - processorFor _ = Nothing -- cgit v1.2.3