From 828f033e80773b38842cca6c30c3c08f320f6e1f Mon Sep 17 00:00:00 2001 From: pacien Date: Tue, 27 Dec 2022 22:55:30 +0100 Subject: compiler: handle dimension flip internally ImageMagick's `-auto-rotate` flag prevents the use of `-ping`, forcing the whole files to be loaded just to read the adjusted width and height. This makes the compiler handle the dimension flipping internally while using `-ping`, which should be way faster. --- compiler/src/FileProcessors.hs | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) (limited to 'compiler/src') diff --git a/compiler/src/FileProcessors.hs b/compiler/src/FileProcessors.hs index db5c9a1..78e7351 100644 --- a/compiler/src/FileProcessors.hs +++ b/compiler/src/FileProcessors.hs @@ -101,17 +101,34 @@ type FileDescriber a = getImageResolution :: FilePath -> IO Resolution getImageResolution fsPath = readProcess "magick" - ["identify", "-auto-orient", "-format", "%w %h", firstFrame] [] - >>= parseResolution . break (== ' ') + [ "identify" + , "-ping" + , "-format", "%[orientation] %w %h" + , firstFrame + ] [] + >>= parseOutput . words + where firstFrame :: FilePath firstFrame = fsPath ++ "[0]" + -- Flip the dimensions when necessary according to the metadata. + -- ImageMagick's `-auto-orient` flag does the same, but isn't compatible + -- with `-ping` and causes the whole image file to be loaded. + parseOutput :: [String] -> IO Resolution + parseOutput ["RightTop", w, h] = parseResolution (h, w) + parseOutput ["LeftBottom", w, h] = parseResolution (h, w) + parseOutput [_, w, h] = parseResolution (w, h) + parseOutput _ = throwIO failedRead + 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." + _ -> throwIO failedRead + + failedRead :: ProcessingException + failedRead = ProcessingException fsPath "Unable to read image resolution." resourceAt :: FileDescriber Resource resourceAt resPath fsPath = Resource resPath <$> getModificationTime fsPath -- cgit v1.2.3