1 files changed, 23 insertions, 5 deletions

diff --git a/compiler/src/FileProcessors.hs b/compiler/src/FileProcessors.hs
index 5c4e1c8..78e7351 100644
--- a/compiler/src/FileProcessors.hs
+++ b/compiler/src/FileProcessors.hs
@@ -1,7 +1,7 @@
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
--- Copyright (C) 2019-2020  Pacien TRAN-GIRARD
+-- Copyright (C) 2019-2022  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
@@ -79,7 +79,7 @@ copyFileProcessor inputPath outputPath =
 
 resizePictureUpTo :: Resolution -> FileTransformer
 resizePictureUpTo maxResolution inputPath outputPath =
-  putStrLn ("Generating:\t" ++ outputPath)
+  putStrLn ("Processing:\t" ++ outputPath)
   >> ensureParentDir (flip resize) outputPath inputPath
   where
     maxSize :: Resolution -> String
@@ -100,17 +100,35 @@ type FileDescriber a =
 
 getImageResolution :: FilePath -> IO Resolution
 getImageResolution fsPath =
-  readProcess "magick" ["identify", "-format", "%w %h", firstFrame] []
-  >>= parseResolution . break (== ' ')
+  readProcess "magick"
+    [ "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