From b1cdddcca9b627e8ba1f2870aa5e62043f7b04b3 Mon Sep 17 00:00:00 2001 From: pacien Date: Fri, 31 Jan 2020 18:15:41 +0100 Subject: compiler: auto orient processed images Let ImageMagick re-orient images based on EXIF metadata. Some web browsers still don't support that correctly. GitHub: closes #67 --- compiler/src/Processors.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'compiler/src') diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index f2ade63..df7e632 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -86,7 +86,11 @@ resizePictureUpTo maxResolution inputPath outputPath = maxSize Resolution{width, height} = show width ++ "x" ++ show height ++ ">" resize :: FileName -> FileName -> IO () - resize input output = callProcess "magick" [input, "-resize", maxSize maxResolution, output] + resize input output = callProcess "magick" + [ input + , "-auto-orient" + , "-resize", maxSize maxResolution + , output ] type Cache = FileProcessor -> FileProcessor -- cgit v1.2.3 From 9b947996588c02867541ee394aa84fd3839d5f47 Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 1 Feb 2020 00:00:23 +0100 Subject: compiler: optimise dir diff for output cleanup n log n by sorting instead of silly n^2 GitHub: closes #70 --- compiler/src/Resource.hs | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) (limited to 'compiler/src') diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index c0ef317..599509e 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -24,8 +24,8 @@ module Resource import Control.Concurrent.ParallelIO.Global (parallel) -import Data.List ((\\), sortBy) -import Data.Ord (comparing) +import Data.List (sortOn) +import Data.List.Ordered (minusBy) import Data.Char (toLower) import Data.Maybe (mapMaybe, fromMaybe, maybeToList) import Data.Function ((&)) @@ -202,11 +202,26 @@ galleryOutputDiff resources ref = thumbnailPaths :: [GalleryItem] -> [Path] thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail) + (\\) :: [Path] -> [Path] -> [Path] + a \\ b = minusOn orderedForm (sortOn orderedForm a) (sortOn orderedForm b) + where + orderedForm :: Path -> WebPath + orderedForm = webPath + + minusOn :: Ord b => (a -> b) -> [a] -> [a] -> [a] + minusOn f l r = map snd $ minusBy comparingFst (packRef f l) (packRef f r) + + packRef :: (a -> b) -> [a] -> [(b, a)] + packRef f = map (\x -> let y = f x in y `seq` (y, x)) + + comparingFst :: Ord b => (b, a) -> (b, a) -> Ordering + comparingFst (l, _) (r, _) = compare l r + galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () galleryCleanupResourceDir resourceTree outputDir = readDirectory outputDir >>= return . galleryOutputDiff resourceTree . root - >>= return . sortBy (flip $ comparing pathLength) -- nested files before dirs + >>= return . sortOn ((0 -) . pathLength) -- nested files before their parent dirs >>= return . map (localPath . (/>) outputDir) >>= mapM_ remove -- cgit v1.2.3