handle exif data

Handler/Commons.hs

@@ -29,11 +29,14 @@ import System.Directory
 import Text.Markdown
 import Codec.Picture as P
 import Codec.Picture.Metadata as PM hiding (insert, delete)
+import Codec.Picture.Metadata.Exif as PM
 import Codec.Picture.ScaleDCT
+import Codec.Picture.Extra
 import Codec.ImageType
 import Graphics.Svg
 import Graphics.Rasterific.Svg
 import Graphics.Text.TrueType
+import Graphics.HsExif
 
 import Debug.Trace
 
@@ -241,7 +244,6 @@ generateThumbs path uId aId mime = do
   orig <- case mime of
     "image/svg+xml" -> do
       svg <- liftIO $ loadSvgFile path
-      liftIO $ traceIO "------------------> SVG loaded!"
       let (swidth, sheight) = documentSize 100 (fromJust svg)
           scale =
             let
@@ -257,15 +259,40 @@ generateThumbs path uId aId mime = do
             in
               Just (nwidth, nheight)
       (img, _) <- liftIO $ renderSvgDocument emptyFontCache scale 100 $ fromJust svg
-      liftIO $ traceIO "------------------> SVG rendered!"
       return img
     _ -> do
       eimg <- liftIO $ readImage path
       case eimg of
         Left err ->
           error err
-        Right img -> -- This branch contains "classical" image formats like bmp or png
+        Right img -> do
-          return $ convertRGBA8 img
+          meta <- liftIO $ parseFileExif path
+          -- error $ show meta
+          case meta of
+            Left _ ->
+              return $ convertRGBA8 img
+            Right metamap ->
+              case getOrientation metamap of
+                Just Mirror ->
+                  return $ flipHorizontally $ convertRGBA8 img
+                Just (Rotation rot) ->
+                  case rot of
+                    HundredAndEighty ->
+                      return $ rotate180 $ convertRGBA8 img
+                    MinusNinety ->
+                      return $ rotateRight90 $ convertRGBA8 img
+                    Ninety ->
+                      return $ rotateLeft90 $ convertRGBA8 img
+                Just (MirrorRotation rot) ->
+                  case rot of
+                    HundredAndEighty ->
+                      return $ flipVertically $ convertRGBA8 img
+                    MinusNinety ->
+                      return $ flipHorizontally $ rotateRight90 $ convertRGBA8 img
+                    Ninety ->
+                      return $ rotate180 $ convertRGBA8 img
+                _ ->
+                  return $ convertRGBA8 img
   let thumbName = FP.takeBaseName path ++ "_thumb.png"
       prevName = FP.takeBaseName path ++ "_preview.png"
       pathPrefix = "static" FP.</> "data" FP.</> T.unpack (extractKey uId) FP.</> T.unpack (extractKey aId)
@@ -281,12 +308,8 @@ generateThumbs path uId aId mime = do
       pWidth = ceiling (fromIntegral oWidth * pScale)
       tPix = scaleBilinearAlpha tWidth tHeight orig
       pPix = scaleBilinearAlpha pWidth pHeight orig
-  liftIO $ traceIO $ show oWidth
-  liftIO $ traceIO "------------------> Image scaled!"
   liftIO $ savePngImage tPath $ ImageRGBA8 tPix
-  liftIO $ traceIO "------------------> Saved thumbnail!"
   liftIO $ savePngImage pPath $ ImageRGBA8 pPix
-  liftIO $ traceIO "------------------> Saved preview!"
   return $ ThumbsMeta
     { metaThumbPath    = tPath
     , metaPreviewPath  = pPath

eidolon.cabal

@@ -1,5 +1,5 @@
 name:                eidolon
-version:             0.1.10.0
+version:             0.1.11.0
 synopsis:            Image gallery in Yesod
 homepage:            https://eidolon.nek0.eu
 license:             AGPL-3
@@ -128,7 +128,9 @@ library
                  , http-types
                  , image-type
                  , JuicyPixels                   >= 3.2.8
+                 , JuicyPixels-extra
                  , JuicyPixels-scale-dct
+                 , hsexif
                  , classy-prelude-yesod          >= 1.0
                  -- svg stuff
                  , rasterific-svg                >= 0.3.2.1