hakyll-images 1.2.2 → 1.3.0

raw patch · 15 files changed

+480/−188 lines, 15 filesdep +containersdep +vectordep ~hakyllbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, vector

Dependency ranges changed: hakyll

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• hakyll-images.cabal +19/−21
• library/Codec/Picture/Saving/WithMetadata.hs +164/−0
• library/Hakyll/Images.hs +0/−1
• library/Hakyll/Images/Common.hs +66/−10
• library/Hakyll/Images/CompressJpg.hs +24/−68
• library/Hakyll/Images/Internal.hs +16/−0
• library/Hakyll/Images/Resize.hs +18/−30
• tests/Hakyll/Images/Common/Tests.hs +1/−1
• tests/Hakyll/Images/CompressJpg/Tests.hs +30/−28
• tests/Hakyll/Images/Metadata/Tests.hs +1/−1
• tests/Hakyll/Images/Resize/Tests.hs +50/−27
• tests/Hakyll/Images/Tests/Utils.hs +79/−0
• tests/TestSuite.hs +4/−1
• tests/data/issue11-2.jpg binary

@@ -1,5 +1,13 @@ # Change log +## Release 1.3.0++* Fixed handling of EXIF orientation of metadata, which was previously thought to be fixed (#11).+  The EXIF orientation tag, if it exists, will now persist through all compilers provided+  by `hakyll-images`.+* Removed the `compressJpg` function, which was only used for testing. `compressJpgCompiler` is still here of course.+* Refactoring of the test suite, which led to internals being exposed in `Hakyll.Images.Internal`.+ ## Release 1.2.2  * Minor documentation improvements

@@ -1,9 +1,11 @@ cabal-version: 2.2  name:           hakyll-images-version:        1.2.2+version:        1.3.0 synopsis:       Hakyll utilities to work with images-description:    hakyll-images is an add-on to the hakyll package. It adds utilities to work with images, including JPEG compression.+description:    +  hakyll-images is an add-on to the hakyll package. It adds utilities to work with images, +  including resizing and JPEG compression. category:       Web homepage:       https://github.com/LaurentRDC/hakyll-images#readme bug-reports:    https://github.com/LaurentRDC/hakyll-images/issues@@ -12,7 +14,7 @@ license:        BSD-3-Clause license-file:   LICENSE.md build-type:     Simple-extra-source-files:+extra-doc-files:     CHANGELOG.md     LICENSE.md     README.md@@ -20,6 +22,7 @@     tests/data/piccolo.jpg     tests/data/donkey.gif     tests/data/issue11.jpeg+    tests/data/issue11-2.jpg  source-repository head   type: git@@ -29,23 +32,23 @@   exposed-modules:       Hakyll.Images       Hakyll.Images.CompressJpg+      Hakyll.Images.Internal       Hakyll.Images.Resize       Hakyll.Images.Metadata   other-modules:+      Codec.Picture.Saving.WithMetadata       Hakyll.Images.Common-      Paths_hakyll_images-  autogen-modules:-      Paths_hakyll_images   hs-source-dirs:       library   ghc-options: -Wall -Wcompat   build-depends:-      JuicyPixels       >= 3   && <4-    , JuicyPixels-extra >  0.3 && <1-    , base              >= 4.8 && <5-    , binary            >= 0.5 && <1-    , bytestring        >= 0.9 && <1-    , hakyll            >  4   && <5+      JuicyPixels       >= 3    && <4+    , JuicyPixels-extra >  0.3  && <1+    , base              >= 4.8  && <5+    , binary            >= 0.5  && <1+    , bytestring        >= 0.9  && <1+    , hakyll            >  4    && <5+    , vector            >= 0.12 && <0.14   default-language: Haskell2010  test-suite spec@@ -56,15 +59,8 @@       Hakyll.Images.CompressJpg.Tests       Hakyll.Images.Metadata.Tests       Hakyll.Images.Resize.Tests-      Hakyll.Images-      Hakyll.Images.Common-      Hakyll.Images.CompressJpg-      Hakyll.Images.Metadata-      Hakyll.Images.Resize-      Paths_hakyll_images-  hs-source-dirs:-      tests-      library+      Hakyll.Images.Tests.Utils+  hs-source-dirs: tests   ghc-options: -Wall -Wcompat   build-depends:       HUnit-approx      >= 1    && <2@@ -73,10 +69,12 @@     , base              >= 4.8  && <5     , binary            >= 0.5  && <1     , bytestring        >= 0.9  && <1+    , containers     , directory         >= 1    && <2     , filepath          >= 1    && <2     , hakyll            >= 4    && <5     , hakyll-images     , tasty             >= 0.11 && <2     , tasty-hunit       >= 0.9  && <1+    , vector            >=0.12   default-language: Haskell2010

@@ -0,0 +1,164 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++-- | Helper functions to save dynamic images to other file format,+-- while preserving metadata when possible.+--+-- This module is modified from `Codec.Picture.Saving` from JuicyPixels+module Codec.Picture.Saving.WithMetadata+  ( imageToJpgWithMetadata,+    imageToPngWithMetadata,+    imageToBitmapWithMetadata,+  )+where++import Codec.Picture.Bitmap (encodeBitmapWithMetadata)+import Codec.Picture.Jpg (encodeDirectJpegAtQualityWithMetadata, encodeJpegAtQualityWithMetadata)+import Codec.Picture.Metadata (Metadatas)+import Codec.Picture.Png (PngSavable (encodePngWithMetadata))+import Codec.Picture.Types+  ( ColorConvertible (promoteImage),+    ColorSpaceConvertible (convertImage),+    DynamicImage (..),+    Image (..),+    Pixel (PixelBaseComponent),+    Pixel8,+    PixelF,+    PixelRGB16,+    PixelRGB8 (..),+    PixelRGBA8,+    PixelRGBF (..),+    dropAlphaLayer,+    pixelMap,+  )+import Data.Bits (unsafeShiftR)+import qualified Data.ByteString.Lazy as L+import qualified Data.Vector.Storable as V+import Data.Word (Word16, Word32, Word8)++componentToLDR :: Float -> Word8+componentToLDR = truncate . (255 *) . min 1.0 . max 0.0++toStandardDef :: Image PixelRGBF -> Image PixelRGB8+toStandardDef = pixelMap pixelConverter+  where+    pixelConverter (PixelRGBF rf gf bf) = PixelRGB8 r g b+      where+        r = componentToLDR rf+        g = componentToLDR gf+        b = componentToLDR bf++greyScaleToStandardDef :: Image PixelF -> Image Pixel8+greyScaleToStandardDef = pixelMap componentToLDR++from16to8 ::+  ( PixelBaseComponent source ~ Word16,+    PixelBaseComponent dest ~ Word8+  ) =>+  Image source ->+  Image dest+from16to8+  Image+    { imageWidth = w,+      imageHeight = h,+      imageData = arr+    } = Image w h transformed+    where+      transformed = V.map toWord8 arr+      toWord8 v = fromIntegral (v `unsafeShiftR` 8)++from32to8 ::+  ( PixelBaseComponent source ~ Word32,+    PixelBaseComponent dest ~ Word8+  ) =>+  Image source ->+  Image dest+from32to8+  Image+    { imageWidth = w,+      imageHeight = h,+      imageData = arr+    } = Image w h transformed+    where+      transformed = V.map toWord8 arr+      toWord8 v = fromIntegral (v `unsafeShiftR` 24)++from32to16 ::+  ( PixelBaseComponent source ~ Word32,+    PixelBaseComponent dest ~ Word16+  ) =>+  Image source ->+  Image dest+from32to16+  Image+    { imageWidth = w,+      imageHeight = h,+      imageData = arr+    } = Image w h transformed+    where+      transformed = V.map toWord16 arr+      toWord16 v = fromIntegral (v `unsafeShiftR` 16)++-- | This function will try to do anything to encode an image+-- as JPEG, make all color conversion and such. Equivalent+-- of 'decodeImage' for jpeg encoding+-- Save Y or YCbCr Jpeg only, all other colorspaces are converted.+-- To save a RGB or CMYK JPEG file, use the+-- 'Codec.Picture.Jpg.Internal.encodeDirectJpegAtQualityWithMetadata' function+imageToJpgWithMetadata :: Int -> Metadatas -> DynamicImage -> L.ByteString+imageToJpgWithMetadata quality meta dynImage =+  let encodeAtQuality = encodeJpegAtQualityWithMetadata (fromIntegral quality) meta+      encodeWithMeta = encodeDirectJpegAtQualityWithMetadata (fromIntegral quality) meta+   in case dynImage of+        ImageYCbCr8 img -> encodeAtQuality img+        ImageCMYK8 img -> imageToJpgWithMetadata quality meta . ImageRGB8 $ convertImage img+        ImageCMYK16 img -> imageToJpgWithMetadata quality meta . ImageRGB16 $ convertImage img+        ImageRGB8 img -> encodeAtQuality (convertImage img)+        ImageRGBF img -> imageToJpgWithMetadata quality meta . ImageRGB8 $ toStandardDef img+        ImageRGBA8 img -> encodeAtQuality (convertImage $ dropAlphaLayer img)+        ImageYF img -> imageToJpgWithMetadata quality meta . ImageY8 $ greyScaleToStandardDef img+        ImageY8 img -> encodeWithMeta img+        ImageYA8 img -> encodeWithMeta $ dropAlphaLayer img+        ImageY16 img -> imageToJpgWithMetadata quality meta . ImageY8 $ from16to8 img+        ImageYA16 img -> imageToJpgWithMetadata quality meta . ImageYA8 $ from16to8 img+        ImageY32 img -> imageToJpgWithMetadata quality meta . ImageY8 $ from32to8 img+        ImageRGB16 img -> imageToJpgWithMetadata quality meta . ImageRGB8 $ from16to8 img+        ImageRGBA16 img -> imageToJpgWithMetadata quality meta . ImageRGBA8 $ from16to8 img++-- | This function will try to do anything to encode an image+-- as PNG, make all color conversion and such. Equivalent+-- of 'decodeImage' for PNG encoding+imageToPngWithMetadata :: Metadatas -> DynamicImage -> L.ByteString+imageToPngWithMetadata meta (ImageYCbCr8 img) = encodePngWithMetadata meta (convertImage img :: Image PixelRGB8)+imageToPngWithMetadata meta (ImageCMYK8 img) = encodePngWithMetadata meta (convertImage img :: Image PixelRGB8)+imageToPngWithMetadata meta (ImageCMYK16 img) = encodePngWithMetadata meta (convertImage img :: Image PixelRGB16)+imageToPngWithMetadata meta (ImageRGB8 img) = encodePngWithMetadata meta img+imageToPngWithMetadata meta (ImageRGBF img) = encodePngWithMetadata meta $ toStandardDef img+imageToPngWithMetadata meta (ImageRGBA8 img) = encodePngWithMetadata meta img+imageToPngWithMetadata meta (ImageY8 img) = encodePngWithMetadata meta img+imageToPngWithMetadata meta (ImageYF img) = encodePngWithMetadata meta $ greyScaleToStandardDef img+imageToPngWithMetadata meta (ImageYA8 img) = encodePngWithMetadata meta img+imageToPngWithMetadata meta (ImageY16 img) = encodePngWithMetadata meta img+imageToPngWithMetadata meta (ImageY32 img) = imageToPngWithMetadata meta . ImageY16 $ from32to16 img+imageToPngWithMetadata meta (ImageYA16 img) = encodePngWithMetadata meta img+imageToPngWithMetadata meta (ImageRGB16 img) = encodePngWithMetadata meta img+imageToPngWithMetadata meta (ImageRGBA16 img) = encodePngWithMetadata meta img++-- | This function will try to do anything to encode an image+-- as bitmap, make all color conversion and such. Equivalent+-- of 'decodeImage' for Bitmap encoding+imageToBitmapWithMetadata :: Metadatas -> DynamicImage -> L.ByteString+imageToBitmapWithMetadata meta (ImageYCbCr8 img) = encodeBitmapWithMetadata meta (convertImage img :: Image PixelRGB8)+imageToBitmapWithMetadata meta (ImageCMYK8 img) = encodeBitmapWithMetadata meta (convertImage img :: Image PixelRGB8)+imageToBitmapWithMetadata meta (ImageCMYK16 img) = imageToBitmapWithMetadata meta . ImageRGB16 $ convertImage img+imageToBitmapWithMetadata meta (ImageRGBF img) = encodeBitmapWithMetadata meta $ toStandardDef img+imageToBitmapWithMetadata meta (ImageRGB8 img) = encodeBitmapWithMetadata meta img+imageToBitmapWithMetadata meta (ImageRGBA8 img) = encodeBitmapWithMetadata meta img+imageToBitmapWithMetadata meta (ImageY8 img) = encodeBitmapWithMetadata meta img+imageToBitmapWithMetadata meta (ImageYF img) = encodeBitmapWithMetadata meta $ greyScaleToStandardDef img+imageToBitmapWithMetadata meta (ImageYA8 img) = encodeBitmapWithMetadata meta (promoteImage img :: Image PixelRGBA8)+imageToBitmapWithMetadata meta (ImageY16 img) = imageToBitmapWithMetadata meta . ImageY8 $ from16to8 img+imageToBitmapWithMetadata meta (ImageY32 img) = imageToBitmapWithMetadata meta . ImageY8 $ from32to8 img+imageToBitmapWithMetadata meta (ImageYA16 img) = imageToBitmapWithMetadata meta . ImageYA8 $ from16to8 img+imageToBitmapWithMetadata meta (ImageRGB16 img) = imageToBitmapWithMetadata meta . ImageRGB8 $ from16to8 img+imageToBitmapWithMetadata meta (ImageRGBA16 img) = imageToBitmapWithMetadata meta . ImageRGBA8 $ from16to8 img

@@ -58,7 +58,6 @@     module Hakyll.Images.Metadata,     -- Jpg compression     JpgQuality,-    compressJpg,     compressJpgCompiler,     -- Image scaling     Width,

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}+ -- | -- Module      : Hakyll.Images.Common -- Description : Types and utilities for Hakyll.Images@@ -11,14 +12,28 @@ -- Portability : portable module Hakyll.Images.Common   ( Image (..),+    withImageContent,+    ImageContent,+    decodeContent,+    WithMetadata (..),     ImageFormat (..),     loadImage,     encode,   ) where +import Codec.Picture (decodeImageWithMetadata)+import Codec.Picture.Metadata (Metadatas)+import qualified Codec.Picture.Metadata as Meta+import qualified Codec.Picture.Metadata.Exif as Meta import Codec.Picture.Saving+import Codec.Picture.Saving.WithMetadata+  ( imageToBitmapWithMetadata,+    imageToJpgWithMetadata,+    imageToPngWithMetadata,+  ) import Codec.Picture.Types (DynamicImage)+import Data.Bifunctor (second) import Data.Binary (Binary (..)) import Data.ByteString (ByteString) import Data.ByteString.Lazy (toStrict)@@ -44,11 +59,39 @@ instance Binary ImageFormat  data Image = Image-  { format :: ImageFormat,-    image :: ByteString+  { format :: !ImageFormat,+    image :: !ByteString   }   deriving (Typeable) +-- Implementation note+-- We need to keep the content of an image as a bytestring, as+-- much as possible, because Hakyll's Items must be serializable.++data WithMetadata a+  = MkWithMetadata+  { getData :: !a,+    getMetadata :: !Metadatas+  }++type ImageContent = WithMetadata DynamicImage++decodeContent :: ByteString -> WithMetadata DynamicImage+decodeContent im = case decodeImageWithMetadata im of+  Left msg -> error msg+  Right content -> uncurry MkWithMetadata (second pruneMetadatas content)+    where+      -- \| Prune metadata to only keep tags which are absolutely necessary+      -- (of which there are very few).+      pruneMetadatas :: Metadatas -> Metadatas+      pruneMetadatas meta =+        foldMap (\(k, v) -> Meta.singleton (Meta.Exif k) v) $+          filter (\(k, _) -> k == Meta.TagOrientation) $+            Meta.extractExifMetas meta++instance Functor WithMetadata where+  fmap f (MkWithMetadata a m) = (MkWithMetadata (f a) m)+ -- When writing to disk, we ignore the image format. -- Trusting users to route correctly. instance Writable Image where@@ -65,8 +108,8 @@ -- -- @ -- match "*.jpg" $ do---     route idRoute---     compile $ loadImage >>= compressJpgCompiler 50+--    route idRoute+--    compile $ loadImage >>= compressJpgCompiler 50 -- @ loadImage :: Compiler (Item Image) loadImage = do@@ -92,9 +135,22 @@     fromExt' ext' = error $ "Unsupported format: " <> ext'  -- Encode images based on file extension-encode :: ImageFormat -> DynamicImage -> Image-encode Jpeg im = Image Jpeg $ (toStrict . imageToJpg 100) im-encode Png im = Image Png $ (toStrict . imageToPng) im-encode Bitmap im = Image Bitmap $ (toStrict . imageToBitmap) im-encode Tiff im = Image Tiff $ (toStrict . imageToTiff) im-encode Gif im = Image Gif $ (toStrict . fromRight (error "Could not parse gif") . imageToGif) im+--+-- Unfortunately, the upstream library `JuicyPixels` does not have support+-- for encoding metadata of some image formats, including `Tiff` and `Gif`.+encode :: ImageFormat -> ImageContent -> Image+encode Jpeg (MkWithMetadata im meta) = Image Jpeg $ (toStrict . imageToJpgWithMetadata 100 meta) im+encode Png (MkWithMetadata im meta) = Image Png $ (toStrict . imageToPngWithMetadata meta) im+encode Bitmap (MkWithMetadata im meta) = Image Bitmap $ (toStrict . imageToBitmapWithMetadata meta) im+encode Tiff (MkWithMetadata im _) = Image Tiff $ (toStrict . imageToTiff) im+encode Gif (MkWithMetadata im _) = Image Gif $ (toStrict . fromRight (error "Could not parse gif") . imageToGif) im++-- | Map over the content of an `Image`, decoded into an `ImageContent`.+withImageContent ::+  (ImageContent -> ImageContent) ->+  -- | Encoder function+  (ImageFormat -> ImageContent -> Image) ->+  (Image -> Image)+withImageContent f encoder (Image fmt bts) =+  let content = decodeContent bts+   in encoder fmt $ f content

@@ -1,6 +1,7 @@ {-# LANGUAGE GeneralisedNewtypeDeriving #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+ -- | -- Module      : Hakyll.Images.CompressJpg -- Description : Hakyll compiler to compress Jpeg images@@ -35,90 +36,37 @@ module Hakyll.Images.CompressJpg   ( JpgQuality,     compressJpgCompiler,-    compressJpg,   ) where -import Codec.Picture.Types (DynamicImage(..), dropTransparency, pixelMap)-import qualified Codec.Picture.Types as Picture-import Codec.Picture.Metadata (Metadatas, SourceFormat(SourceJpeg), basicMetadata) -import qualified Codec.Picture.Metadata as Meta-import Codec.Picture.Metadata.Exif (ExifTag(TagOrientation))-import Codec.Picture.Jpg (JpgEncodable, decodeJpegWithMetadata, encodeDirectJpegAtQualityWithMetadata)+import Codec.Picture.Saving.WithMetadata (imageToJpgWithMetadata) import Data.ByteString.Lazy (toStrict)-import Data.ByteString (ByteString)  import Hakyll.Core.Compiler (Compiler) import Hakyll.Core.Item (Item (..)) import Hakyll.Images.Common   ( Image (..),+    ImageContent,     ImageFormat (..),-    format,-    image,+    WithMetadata (..),+    withImageContent,   ) import Numeric.Natural (Natural) - -- | Jpeg encoding quality, from 0 (lower quality) to 100 (best quality). -- @since 1.2.0 newtype JpgQuality = JpgQuality Natural   deriving (Num, Eq, Enum, Ord, Real, Integral) - -- | @JpgQuality@ smart constructor. Ensures that @JpgQuality@ is always -- in the interval [0, 100]. Numbers outside this range will result in either -- a quality of 0 or 100. -- -- @since 1.2.0-mkJpgQuality :: Integral a => a -> JpgQuality-mkJpgQuality q | q < 0     = JpgQuality 0-               | q > 100   = JpgQuality 100-               | otherwise = JpgQuality (fromIntegral q)----- | Compress a JPG bytestring to a certain quality setting.--- The quality should be between 0 (lowest quality) and 100 (best quality).--- An error is raised if the image cannot be decoded.------ In the rare case where the JPEG data contains transparency information, it will be dropped.-compressJpg :: Integral a => a -> Image -> Image-compressJpg quality' src =-  if format src /= Jpeg-    then error "Image is not a JPEG."-    -- It is important to preserve some metadata, such as orientation (issue #11).-    else case decodeJpegWithMetadata $ image src of-      Left msg -> error $ "Loading the image failed for the following reason: " <> msg-      Right (dynImage, meta) -> -         Image Jpeg $ case dynImage of -          (ImageY8 img)     -> (encodeJpeg quality meta img)-          (ImageCMYK8 img)  -> (encodeJpeg quality meta img)-          (ImageRGB8 img)   -> (encodeJpeg quality meta img)-          (ImageYCbCr8 img) -> (encodeJpeg quality meta img)-          -- Out of the 5 possible image types that can be returned by `decodeJpegWithMetadata`, only 1-          -- has transparency. This is also the only image type which cannot be re-encoded directly;-          -- we need to remove transparency.-          (ImageYA8 img)    -> (encodeJpeg quality meta (pixelMap dropTransparency img))-          _ -> error "Loading the image failed because the color space is unknown." -  where -    quality = mkJpgQuality quality'----- | Encode a JPEG image at a particular quality, preserving some metadata.-encodeJpeg :: (Integral q, JpgEncodable px) -           => q -           -> Metadatas -           -> Picture.Image px -           -> ByteString-encodeJpeg qual meta img@Picture.Image{..} -  = toStrict $ encodeDirectJpegAtQualityWithMetadata (fromIntegral qual) newmeta img-  where-    -- We want to preserve Exif orientation metadata, which is important for presentation (see #11)-    -- However, other metadata tags are notoriously finicky and can leads to corrupted-    -- files. -    exifOrientationMeta = foldMap (\(k, v) -> Meta.singleton (Meta.Exif k) v) -                        $ filter (\(k, _) -> k == TagOrientation) -                        $ Meta.extractExifMetas meta-    newmeta = exifOrientationMeta <> basicMetadata SourceJpeg imageWidth imageHeight-+mkJpgQuality :: (Integral a) => a -> JpgQuality+mkJpgQuality q+  | q < 0 = JpgQuality 0+  | q > 100 = JpgQuality 100+  | otherwise = JpgQuality (fromIntegral q)  -- | Compiler that compresses a JPG image to a certain quality setting. -- The quality should be between 0 (lowest quality) and 100 (best quality).@@ -127,8 +75,16 @@ -- -- @ -- match "*.jpg" $ do---     route idRoute---     compile $ loadImage >>= compressJpgCompiler 50+--    route idRoute+--    compile $ loadImage >>= compressJpgCompiler 50 -- @-compressJpgCompiler :: Integral a => a -> Item Image -> Compiler (Item Image)-compressJpgCompiler quality = return . fmap (compressJpg quality)+compressJpgCompiler :: (Integral a) => a -> Item Image -> Compiler (Item Image)+compressJpgCompiler quality =+  return . fmap (withImageContent id encoder) -- JPG compression isn't a transformation of the image, but rather a re-encoding+  where+    validatedQuality :: Int+    validatedQuality = fromIntegral $ mkJpgQuality quality++    encoder :: ImageFormat -> ImageContent -> Image+    encoder _ (MkWithMetadata d md) =+      Image Jpeg (toStrict $ imageToJpgWithMetadata validatedQuality md d)

@@ -0,0 +1,16 @@+-- |+-- Module      : Hakyll.Images.Internal+-- Description : Hakyll utilities for image files+-- Copyright   : (c) Laurent P René de Cotret, 2019 - present+-- License     : BSD3+-- Maintainer  : laurent.decotret@outlook.com+-- Stability   : unstable+-- Portability : portable+--+-- Internal re-exports used for tests.+module Hakyll.Images.Internal+  ( module Hakyll.Images.Common,+  )+where++import Hakyll.Images.Common

@@ -46,31 +46,25 @@   ) where -import Codec.Picture (convertRGBA8, decodeImage)+import Codec.Picture (convertRGBA8) import Codec.Picture.Extra (scaleBilinear) import Codec.Picture.Types (DynamicImage (..), imageHeight, imageWidth)-import Data.ByteString (ByteString) import Data.Ratio ((%)) import Hakyll.Core.Compiler (Compiler) import Hakyll.Core.Item (Item (..))-import Hakyll.Images.Common (Image (..), encode)+import Hakyll.Images.Common (Image (..), ImageContent, WithMetadata (..), encode, withImageContent)  type Width = Int  type Height = Int -decodeImage' :: ByteString -> DynamicImage-decodeImage' im = case decodeImage im of-  Left msg -> error msg-  Right im' -> im'- -- | Resize an image to specified width and height using the bilinear transform. -- The aspect ratio may not be respected. -- -- In the process, an image is converted to RGBA8. Therefore, some information -- loss may occur.-resize :: Width -> Height -> DynamicImage -> DynamicImage-resize w h = ImageRGBA8 . scaleBilinear w h . convertRGBA8+resize :: Width -> Height -> ImageContent -> ImageContent+resize w h = fmap (ImageRGBA8 . scaleBilinear w h . convertRGBA8)  -- | Scale an image to a size that will fit in the specified width and height, -- while preserving aspect ratio. Images might be scaled up as well.@@ -79,7 +73,7 @@ -- loss may occur. -- -- To scale images down only, take a look at 'ensureFit'.-scale :: Width -> Height -> DynamicImage -> DynamicImage+scale :: Width -> Height -> ImageContent -> ImageContent scale w h = scale' w h True  -- | Scale an image to a size that will fit in the specified width and height,@@ -95,10 +89,10 @@   -- | Allow scaling up as well.   Bool ->   -- | Source image-  DynamicImage ->+  ImageContent ->   -- | Scaled image.-  DynamicImage-scale' w h upAllowed img = resize maxWidth maxHeight img+  ImageContent+scale' w h upAllowed content@(MkWithMetadata img _) = resize maxWidth maxHeight content   where     img' = convertRGBA8 img -- Required to extract height and width     (imgWidth, imgHeight) = (imageWidth img', imageHeight img')@@ -119,7 +113,7 @@ -- loss may occur. -- -- To scale images up __or__ down, take a look at 'scale'.-ensureFit :: Width -> Height -> DynamicImage -> DynamicImage+ensureFit :: Width -> Height -> ImageContent -> ImageContent ensureFit w h = scale' w h False  -- | Compiler that resizes images to a specific dimensions. Aspect ratio@@ -127,45 +121,39 @@ -- -- @ -- match "*.png" $ do---     route idRoute---     compile $ loadImage >>= resizeImageCompiler 48 64+--    route idRoute+--    compile $ loadImage >>= resizeImageCompiler 48 64 -- @ -- -- Note that in the resizing process, images will be converted to RGBA8. -- To preserve aspect ratio, take a look at 'scaleImageCompiler'. resizeImageCompiler :: Width -> Height -> Item Image -> Compiler (Item Image)-resizeImageCompiler w h item =-  let fmt = (format . itemBody) item-   in return $ encode fmt . resize w h . decodeImage' . image <$> item+resizeImageCompiler w h = return . fmap (withImageContent (resize w h) encode)  -- | Compiler that rescales images to fit within dimensions. Aspect ratio -- will be preserved. Images might be scaled up as well. -- -- @ -- match "*.tiff" $ do---     route idRoute---     compile $ loadImage >>= scaleImageCompiler 48 64+--    route idRoute+--    compile $ loadImage >>= scaleImageCompiler 48 64 -- @ -- -- Note that in the resizing process, images will be converted to RGBA8. -- To ensure images are only scaled __down__, take a look at 'ensureFitCompiler'. scaleImageCompiler :: Width -> Height -> Item Image -> Compiler (Item Image)-scaleImageCompiler w h item =-  let fmt = (format . itemBody) item-   in return $ encode fmt . scale w h . decodeImage' . image <$> item+scaleImageCompiler w h = return . fmap (withImageContent (scale w h) encode)  -- | Compiler that ensures images will fit within dimensions. Images might -- be scaled down, but never up.  Aspect ratio will be preserved. -- -- @ -- match "*.tiff" $ do---     route idRoute---     compile $ loadImage >>= ensureFitCompiler 48 64+--    route idRoute+--    compile $ loadImage >>= ensureFitCompiler 48 64 -- @ -- -- Note that in the resizing process, images will be converted to RGBA8. -- To allow the possibility of scaling up, take a look at 'scaleImageCompiler'. ensureFitCompiler :: Width -> Height -> Item Image -> Compiler (Item Image)-ensureFitCompiler w h item =-  let fmt = (format . itemBody) item-   in return $ encode fmt . ensureFit w h . decodeImage' . image <$> item+ensureFitCompiler w h = return . fmap (withImageContent (ensureFit w h) encode)

@@ -14,7 +14,7 @@ import qualified Hakyll.Core.Logger as L import Hakyll.Core.Rules.Internal (RuleSet) import Hakyll.Core.Runtime-import Hakyll.Images+import Hakyll.Images ( loadImage, compressJpgCompiler ) import System.Directory (doesFileExist) import System.Exit      (ExitCode) import System.FilePath ((</>))

@@ -1,18 +1,17 @@---------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+ module Hakyll.Images.CompressJpg.Tests   ( tests,   ) where ---------------------------------------------------------------------------------------------------------------------------------------------------------------------import Codec.Picture (dynamicMap, imageWidth, imageHeight, imageHeight)+import Codec.Picture (dynamicMap, imageHeight, imageWidth) import Codec.Picture.Jpg (decodeJpeg) import qualified Data.ByteString as B-import Hakyll.Images.Common ( Image(Image, image), ImageFormat(Jpeg) )-import Hakyll.Images.CompressJpg ( compressJpg )+import Hakyll (Identifier, Item (..))+import Hakyll.Images.Internal (Image (Image, image), ImageFormat (Jpeg), loadImage)+import Hakyll.Images.CompressJpg (compressJpgCompiler)+import Hakyll.Images.Tests.Utils (testCompilerDone) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, testCase) import Text.Printf (printf)@@ -30,55 +29,58 @@ fromAssertions name =   zipWith testCase [printf "[%2d] %s" n name | n <- [1 :: Int ..]] +compressJpg :: (Integral a) => a -> Identifier -> IO Image+compressJpg quality idt = testCompilerDone idt $ do+  Item _ compressed <- loadImage >>= compressJpgCompiler quality+  return $ compressed+ -- Test that the standard Image compressed to quality 25/100 is smaller -- than the initial image testCompressionFromImage :: Assertion testCompressionFromImage = do   im <- testJpg   let initialSize = (B.length . image) im-      finalSize = (B.length . image . compressJpg (25::Int)) im+  finalSize <- do+    testCompilerDone "piccolo.jpg" $ do+      Item _ compressed <- loadImage >>= compressJpgCompiler (25 :: Int)+      return $ (B.length . image) compressed    assertBool "Image was not compressed" (initialSize > finalSize)  -- Test that specifying a JPG encoding below 0 will not fail testJpgEncodingOutOfLowerBound :: Assertion testJpgEncodingOutOfLowerBound = do-  im <- testJpg-  -  let compressedSize = (B.length . image . compressJpg (-10 :: Int)) im-      expectedSize = (B.length . image . compressJpg (0 :: Int)) im+  compressedSize <- B.length . image <$> compressJpg (-10 :: Int) "piccolo.jpg"+  expectedSize <- B.length . image <$> compressJpg (0 :: Int) "piccolo.jpg"    assertBool "Out-of-bounds JpgQuality was not handled properly" (expectedSize == compressedSize)  -- Test that specifying a JPG encoding above 100 will fail testJpgEncodingOutOfUpperBound :: Assertion testJpgEncodingOutOfUpperBound = do-  im <- testJpg-  -  let compressedSize = (B.length . image . compressJpg (150 :: Int)) im-      expectedSize = (B.length . image . compressJpg (100 :: Int)) im+  compressedSize <- B.length . image <$> compressJpg (150 :: Int) "piccolo.jpg"+  expectedSize <- B.length . image <$> compressJpg (100 :: Int) "piccolo.jpg"    assertBool "Out-of-bounds JpgQuality was not handled properly" (expectedSize == compressedSize)  -- Test that issue #11 is fixed testJpgInadvertentRotation :: TestTree testJpgInadvertentRotation = testCase "Compressing a JPEG does not rotate it (issue #11)" $ do-  im <- Image Jpeg <$> B.readFile "tests/data/issue11.jpeg"+  im <- B.readFile "tests/data/issue11.jpeg" -  let initial    = either error id $ decodeJpeg (image im)-      compressed = either error id $ decodeJpeg $ image $ compressJpg (50::Int) im+  let initial = either error id $ decodeJpeg im+  compressed <- either error id <$> (compressJpg (50 :: Int) "issue11.jpeg" >>= pure . decodeJpeg . image)    assertEqual mempty (dynamicMap imageWidth initial) (dynamicMap imageWidth compressed)   assertEqual mempty (dynamicMap imageHeight initial) (dynamicMap imageHeight compressed) --------------------------------------------------------------------------------- tests :: TestTree tests =   testGroup "Hakyll.Images.CompressJpg.Tests" $-    [testJpgInadvertentRotation] <>-      fromAssertions-          "compressJpg"-          [ testCompressionFromImage,-            testJpgEncodingOutOfLowerBound,-            testJpgEncodingOutOfUpperBound-          ]+    [testJpgInadvertentRotation]+      <> fromAssertions+        "compressJpg"+        [ testCompressionFromImage,+          testJpgEncodingOutOfLowerBound,+          testJpgEncodingOutOfUpperBound+        ]

@@ -12,7 +12,7 @@ import qualified Data.ByteString as B import Data.Maybe (fromMaybe) import Hakyll.Images-import Hakyll.Images.Common+import Hakyll.Images.Internal import qualified Hakyll.Images.Metadata as M import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, testCase)

@@ -1,36 +1,34 @@---------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+ module Hakyll.Images.Resize.Tests   ( tests,   ) where -------------------------------------------------------------------------------------------------------------------------------------------------------------------- import Codec.Picture+  ( convertRGBA8,+    decodeJpeg,+    dynamicMap,+    imageHeight,+    imageWidth,+  ) import qualified Data.ByteString as B import Data.Ratio ((%))+import Hakyll (Item (Item)) import Hakyll.Images+import Hakyll.Images.Internal (Image (Image), ImageContent, WithMetadata (..), decodeContent)+import Hakyll.Images.Tests.Utils import Test.HUnit.Approx (assertApproxEqual) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, testCase) import Text.Printf (printf)  -- Original test image "piccolo.jpg" has shape 1170 x 647px-testJpg :: IO DynamicImage-testJpg = do-  img <- decodeJpeg <$> B.readFile "tests/data/piccolo.jpg"-  case img of-    Left _ -> error "Could not decode test picture piccolo.jpg"-    Right im -> return im+testJpg :: IO ImageContent+testJpg = decodeContent <$> B.readFile "tests/data/piccolo.jpg" -testGif :: IO DynamicImage-testGif = do-  img <- decodeGif <$> B.readFile "tests/data/donkey.gif"-  case img of-    Left _ -> error "Could not decode test picture donkey.gif"-    Right im -> return im+testGif :: IO ImageContent+testGif = decodeContent <$> B.readFile "tests/data/donkey.gif"  fromAssertions ::   -- | Name@@ -47,7 +45,7 @@ testResizeJpg = do   image <- testJpg   let scaledImage = resize 48 64 image-      converted = convertRGBA8 scaledImage+      MkWithMetadata converted _ = fmap convertRGBA8 scaledImage       (width, height) =         ( imageWidth converted,           imageHeight converted@@ -60,7 +58,7 @@ testResizeGif = do   image <- testGif   let scaledImage = resize 48 64 image-      converted = convertRGBA8 scaledImage+      MkWithMetadata converted _ = fmap convertRGBA8 scaledImage       (width, height) =         ( imageWidth converted,           imageHeight converted@@ -73,7 +71,7 @@ testScale = do   image <- testJpg   let scaledImage = scale 600 400 image-      converted = convertRGBA8 scaledImage+      MkWithMetadata converted _ = fmap convertRGBA8 scaledImage       (width, height) =         ( imageWidth converted,           imageHeight converted@@ -86,9 +84,9 @@ testEnsureFit :: Assertion testEnsureFit = do   image <- testJpg-  let (originalWidth, originalHeight) = (imageWidth . convertRGBA8 $ image, imageHeight . convertRGBA8 $ image)+  let (originalWidth, originalHeight) = (imageWidth . convertRGBA8 . getData $ image, imageHeight . convertRGBA8 . getData $ image)       scaledImage = ensureFit 2000 2000 image-      converted = convertRGBA8 scaledImage+      MkWithMetadata converted _ = fmap convertRGBA8 scaledImage       (width, height) =         ( imageWidth converted,           imageHeight converted@@ -101,13 +99,36 @@ testScalePreservesAspectRatio = do   image <- testJpg -  let initialAspectRatio = imageWidth (convertRGBA8 image) % imageHeight (convertRGBA8 image)+  let initialAspectRatio = imageWidth (convertRGBA8 $ getData image) % imageHeight (convertRGBA8 $ getData image)       scaledImage = scale 600 400 image-      finalAspectRatio = imageWidth (convertRGBA8 scaledImage) % imageHeight (convertRGBA8 scaledImage)+      finalAspectRatio = imageWidth (convertRGBA8 $ getData scaledImage) % imageHeight (convertRGBA8 $ getData scaledImage)    assertApproxEqual "Aspect ratio was not preserved" 0.02 initialAspectRatio finalAspectRatio ---------------------------------------------------------------------------------+-- Test that issue #11 is fixed+testJpgInadvertentRotation :: TestTree+testJpgInadvertentRotation = testCase "resizing a JPEG does not rotate it (issue #11)" $ do+  Item _ (Image _ raw) <-+    testCompilerDone "issue11-2.jpg" $ loadImage++  let original = either error id $ decodeJpeg raw+      initialWidth = dynamicMap imageWidth original+      initialHeight = dynamicMap imageHeight original++  Item _ (Image _ bts) <-+    testCompilerDone "issue11-2.jpg" $ loadImage >>= ensureFitCompiler 400 400++  let resized = either error id $ decodeJpeg bts+      measuredWidth = dynamicMap imageWidth resized+      measuredHeight = dynamicMap imageHeight resized++  -- The image *appears* to be w=300, h=400,+  -- but an exif tag that rotates it means that we expect+  -- the height to be smaller than the width+  assertBool mempty (initialHeight < initialWidth)+  -- The same must hold for the resized image+  assertBool mempty (measuredHeight < measuredWidth)+ tests :: TestTree tests =   testGroup "Hakyll.Images.Resize.Tests" $@@ -119,8 +140,10 @@           ],         fromAssertions           "ensureFit"-          [testEnsureFit],+          [ testEnsureFit+          ],         fromAssertions           "resize"-          [testResizeJpg, testResizeGif]+          [testResizeJpg, testResizeGif],+        [testJpgInadvertentRotation]       ]

@@ -0,0 +1,79 @@+-- | Test utilities+module Hakyll.Images.Tests.Utils+  ( testCompiler,+    testCompilerDone,+    testConfiguration,+    cleanTestEnv,+  )+where++import Data.List (intercalate)+import qualified Data.Set as S+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Configuration+import Hakyll.Core.Identifier+import qualified Hakyll.Core.Logger as Logger+import Hakyll.Core.Provider+import qualified Hakyll.Core.Store as Store+import Hakyll.Core.Util.File++testCompiler ::+  Identifier ->+  Compiler a ->+  IO (CompilerResult a)+testCompiler underlying compiler = do+  store <- Store.new True $ storeDirectory testConfiguration+  provider <-+    newProvider store (const $ return False) $+      providerDirectory testConfiguration+  logger <- Logger.new Logger.Error+  let read' =+        CompilerRead+          { compilerConfig = testConfiguration,+            compilerUnderlying = underlying,+            compilerProvider = provider,+            compilerUniverse = S.empty,+            compilerRoutes = mempty,+            compilerStore = store,+            compilerLogger = logger+          }++  result <- runCompiler compiler read'+  Logger.flush logger+  return result++testCompilerDone :: Identifier -> Compiler a -> IO a+testCompilerDone underlying compiler = do+  result <- testCompiler underlying compiler+  case result of+    CompilerDone x _ -> return x+    CompilerError e ->+      fail $+        "Hakyll.Images.Tests.Utils.testCompilerDone: compiler "+          ++ show underlying+          ++ " threw: "+          ++ intercalate "; " (compilerErrorMessages e)+    CompilerRequire i _ ->+      fail $+        "Hakyll.Images.Tests.Utils.testCompilerDone: compiler "+          ++ show underlying+          ++ " requires: "+          ++ show i+    CompilerSnapshot _ _ ->+      fail+        "Hakyll.Images.Tests.Utils.testCompilerDone: unexpected CompilerSnapshot"++testConfiguration :: Configuration+testConfiguration =+  defaultConfiguration+    { destinationDirectory = "_testsite",+      storeDirectory = "_teststore",+      tmpDirectory = "_testtmp",+      providerDirectory = "tests/data"+    }++cleanTestEnv :: IO ()+cleanTestEnv = do+  removeDirectory $ destinationDirectory testConfiguration+  removeDirectory $ storeDirectory testConfiguration+  removeDirectory $ tmpDirectory testConfiguration

@@ -12,11 +12,12 @@ import qualified Hakyll.Images.CompressJpg.Tests import qualified Hakyll.Images.Metadata.Tests import qualified Hakyll.Images.Resize.Tests+import qualified Hakyll.Images.Tests.Utils import Test.Tasty (defaultMain, testGroup)  -------------------------------------------------------------------------------- main :: IO ()-main =+main = do   defaultMain $     testGroup       "Hakyll"@@ -25,3 +26,5 @@         Hakyll.Images.Resize.Tests.tests,         Hakyll.Images.Metadata.Tests.tests       ]++  Hakyll.Images.Tests.Utils.cleanTestEnv

binary file changed (absent → 1025881 bytes)