aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/src/FileProcessors.hs23
1 files changed, 20 insertions, 3 deletions
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 =
101getImageResolution :: FilePath -> IO Resolution 101getImageResolution :: FilePath -> IO Resolution
102getImageResolution fsPath = 102getImageResolution fsPath =
103 readProcess "magick" 103 readProcess "magick"
104 ["identify", "-auto-orient", "-format", "%w %h", firstFrame] [] 104 [ "identify"
105 >>= parseResolution . break (== ' ') 105 , "-ping"
106 , "-format", "%[orientation] %w %h"
107 , firstFrame
108 ] []
109 >>= parseOutput . words
110
106 where 111 where
107 firstFrame :: FilePath 112 firstFrame :: FilePath
108 firstFrame = fsPath ++ "[0]" 113 firstFrame = fsPath ++ "[0]"
109 114
115 -- Flip the dimensions when necessary according to the metadata.
116 -- ImageMagick's `-auto-orient` flag does the same, but isn't compatible
117 -- with `-ping` and causes the whole image file to be loaded.
118 parseOutput :: [String] -> IO Resolution
119 parseOutput ["RightTop", w, h] = parseResolution (h, w)
120 parseOutput ["LeftBottom", w, h] = parseResolution (h, w)
121 parseOutput [_, w, h] = parseResolution (w, h)
122 parseOutput _ = throwIO failedRead
123
110 parseResolution :: (String, String) -> IO Resolution 124 parseResolution :: (String, String) -> IO Resolution
111 parseResolution (widthString, heightString) = 125 parseResolution (widthString, heightString) =
112 case (readMaybe widthString, readMaybe heightString) of 126 case (readMaybe widthString, readMaybe heightString) of
113 (Just w, Just h) -> return $ Resolution w h 127 (Just w, Just h) -> return $ Resolution w h
114 _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution." 128 _ -> throwIO failedRead
129
130 failedRead :: ProcessingException
131 failedRead = ProcessingException fsPath "Unable to read image resolution."
115 132
116resourceAt :: FileDescriber Resource 133resourceAt :: FileDescriber Resource
117resourceAt resPath fsPath = Resource resPath <$> getModificationTime fsPath 134resourceAt resPath fsPath = Resource resPath <$> getModificationTime fsPath