-- |

-- Module      : Hakyll.Images.Resize

-- Description : Hakyll compiler to resize images

-- Copyright   : (c) Laurent P René de Cotret, 2019

-- License     : BSD3

-- Maintainer  : laurent.decotret@outlook.com

-- Stability   : unstable

-- Portability : portable

--

-- This module defines two Hakyll compilers. The first one, 'resizeImageCompiler',

-- is used to resize images to specific dimensions. The aspect ratio might not be the same.

--

-- The other compiler, `scaleImageCompiler`, scales images to fit within a specified

-- box while preserving aspect ratio.

--

-- @

--     import Hakyll

--     import Hakyll.Images        ( loadImage

--                                 , resizeImageCompiler

--                                 , scaleImageCompiler

--                                 )

--

--     hakyll $ do

--

--         -- Resize all profile pictures with .png extensions to 64x48

--         match "profiles/**.png" $ do

--             route idRoute

--             compile $ loadImage

--                 >>= resizeImageCompiler 64 48

--

--         -- Scale images to fit within a 600x400 box

--         match "images/**" $ do

--             route idRoute

--             compile $ loadImage

--                 >>= scaleImageCompiler 600 400

--

--         (... omitted ...)

-- @

module Hakyll.Images.Resize
  ( Width,
    Height,
    resize,
    resizeImageCompiler,
    scale,
    scaleImageCompiler,
    ensureFit,
    ensureFitCompiler,
  )
where

import Codec.Picture (convertRGBA8, decodeImage)
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)

type Width = Int

type Height = Int

decodeImage' :: ByteString -> DynamicImage
decodeImage' :: ByteString -> DynamicImage
decodeImage' ByteString
im = case ByteString -> Either String DynamicImage
decodeImage ByteString
im of
  Left String
msg -> String -> DynamicImage
forall a. HasCallStack => String -> a
error String
msg
  Right DynamicImage
im' -> DynamicImage
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 :: Width -> Width -> DynamicImage -> DynamicImage
resize Width
w Width
h = Image PixelRGBA8 -> DynamicImage
ImageRGBA8 (Image PixelRGBA8 -> DynamicImage)
-> (DynamicImage -> Image PixelRGBA8)
-> DynamicImage
-> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Width -> Width -> Image PixelRGBA8 -> Image PixelRGBA8
forall a.
(Pixel a, Bounded (PixelBaseComponent a),
 Integral (PixelBaseComponent a)) =>
Width -> Width -> Image a -> Image a
scaleBilinear Width
w Width
h) (Image PixelRGBA8 -> Image PixelRGBA8)
-> (DynamicImage -> Image PixelRGBA8)
-> DynamicImage
-> Image PixelRGBA8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> Image PixelRGBA8
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.

--

-- In the process, an image is converted to RGBA8. Therefore, some information

-- loss may occur.

--

-- To scale images down only, take a look at 'ensureFit'.

scale :: Width -> Height -> DynamicImage -> DynamicImage
scale :: Width -> Width -> DynamicImage -> DynamicImage
scale Width
w Width
h = Width -> Width -> Bool -> DynamicImage -> DynamicImage
scale' Width
w Width
h Bool
True

-- | 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.

--

-- In the process, an image is converted to RGBA8. Therefore, some information

-- loss may occur.

scale' ::
  -- | Desired width.

  Width ->
  -- | Desired height.

  Height ->
  -- | Allow scaling up as well.

  Bool ->
  -- | Source image

  DynamicImage ->
  -- | Scaled image.

  DynamicImage
scale' :: Width -> Width -> Bool -> DynamicImage -> DynamicImage
scale' Width
w Width
h Bool
upAllowed DynamicImage
img = Width -> Width -> DynamicImage -> DynamicImage
resize Width
maxWidth Width
maxHeight DynamicImage
img
  where
    img' :: Image PixelRGBA8
img' = DynamicImage -> Image PixelRGBA8
convertRGBA8 DynamicImage
img -- Required to extract height and width

    (Width
imgWidth, Width
imgHeight) = (Image PixelRGBA8 -> Width
forall a. Image a -> Width
imageWidth Image PixelRGBA8
img', Image PixelRGBA8 -> Width
forall a. Image a -> Width
imageHeight Image PixelRGBA8
img')
    -- Find the smallest resizing that will accomodate both the width

    -- and height.

    -- If we don't allow scaling up, minimum scaling is 1

    resizing :: Ratio Width
resizing =
      if Bool
upAllowed
        then Ratio Width -> Ratio Width -> Ratio Width
forall a. Ord a => a -> a -> a
min (Width
w Width -> Width -> Ratio Width
forall a. Integral a => a -> a -> Ratio a
% Width
imgWidth) (Width
h Width -> Width -> Ratio Width
forall a. Integral a => a -> a -> Ratio a
% Width
imgHeight)
        else [Ratio Width] -> Ratio Width
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Width
w Width -> Width -> Ratio Width
forall a. Integral a => a -> a -> Ratio a
% Width
imgWidth, Width
h Width -> Width -> Ratio Width
forall a. Integral a => a -> a -> Ratio a
% Width
imgHeight, Ratio Width
1]
    maxWidth :: Width
maxWidth = Ratio Width -> Width
forall a b. (RealFrac a, Integral b) => a -> b
round (Ratio Width
resizing Ratio Width -> Ratio Width -> Ratio Width
forall a. Num a => a -> a -> a
* Width -> Ratio Width
forall a b. (Integral a, Num b) => a -> b
fromIntegral Width
imgWidth)
    maxHeight :: Width
maxHeight = Ratio Width -> Width
forall a b. (RealFrac a, Integral b) => a -> b
round (Ratio Width
resizing Ratio Width -> Ratio Width -> Ratio Width
forall a. Num a => a -> a -> a
* Width -> Ratio Width
forall a b. (Integral a, Num b) => a -> b
fromIntegral Width
imgHeight)

-- | Scale an image down to a size that will fit in the specified width and height,

-- while preserving aspect ratio.

--

-- In the process, an image is converted to RGBA8. Therefore, some information

-- loss may occur.

--

-- To scale images up __or__ down, take a look at 'scale'.

ensureFit :: Width -> Height -> DynamicImage -> DynamicImage
ensureFit :: Width -> Width -> DynamicImage -> DynamicImage
ensureFit Width
w Width
h = Width -> Width -> Bool -> DynamicImage -> DynamicImage
scale' Width
w Width
h Bool
False

-- | Compiler that resizes images to a specific dimensions. Aspect ratio

-- may not be preserved.

--

-- @

-- match "*.png" $ do

--     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 :: Width -> Width -> Item Image -> Compiler (Item Image)
resizeImageCompiler Width
w Width
h Item Image
item =
  let fmt :: ImageFormat
fmt = (Image -> ImageFormat
format (Image -> ImageFormat)
-> (Item Image -> Image) -> Item Image -> ImageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item Image -> Image
forall a. Item a -> a
itemBody) Item Image
item
   in Item Image -> Compiler (Item Image)
forall (m :: * -> *) a. Monad m => a -> m a
return (Item Image -> Compiler (Item Image))
-> Item Image -> Compiler (Item Image)
forall a b. (a -> b) -> a -> b
$ (ImageFormat -> DynamicImage -> Image
encode ImageFormat
fmt (DynamicImage -> Image)
-> (Image -> DynamicImage) -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Width -> DynamicImage -> DynamicImage
resize Width
w Width
h (DynamicImage -> DynamicImage)
-> (Image -> DynamicImage) -> Image -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DynamicImage
decodeImage' (ByteString -> DynamicImage)
-> (Image -> ByteString) -> Image -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image -> ByteString
image) (Image -> Image) -> Item Image -> Item Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item Image
item

-- | 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

-- @

--

-- 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 :: Width -> Width -> Item Image -> Compiler (Item Image)
scaleImageCompiler Width
w Width
h Item Image
item =
  let fmt :: ImageFormat
fmt = (Image -> ImageFormat
format (Image -> ImageFormat)
-> (Item Image -> Image) -> Item Image -> ImageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item Image -> Image
forall a. Item a -> a
itemBody) Item Image
item
   in Item Image -> Compiler (Item Image)
forall (m :: * -> *) a. Monad m => a -> m a
return (Item Image -> Compiler (Item Image))
-> Item Image -> Compiler (Item Image)
forall a b. (a -> b) -> a -> b
$ (ImageFormat -> DynamicImage -> Image
encode ImageFormat
fmt (DynamicImage -> Image)
-> (Image -> DynamicImage) -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Width -> DynamicImage -> DynamicImage
scale Width
w Width
h (DynamicImage -> DynamicImage)
-> (Image -> DynamicImage) -> Image -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DynamicImage
decodeImage' (ByteString -> DynamicImage)
-> (Image -> ByteString) -> Image -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image -> ByteString
image) (Image -> Image) -> Item Image -> Item Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item Image
item

-- | 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

-- @

--

-- 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 :: Width -> Width -> Item Image -> Compiler (Item Image)
ensureFitCompiler Width
w Width
h Item Image
item =
  let fmt :: ImageFormat
fmt = (Image -> ImageFormat
format (Image -> ImageFormat)
-> (Item Image -> Image) -> Item Image -> ImageFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item Image -> Image
forall a. Item a -> a
itemBody) Item Image
item
   in Item Image -> Compiler (Item Image)
forall (m :: * -> *) a. Monad m => a -> m a
return (Item Image -> Compiler (Item Image))
-> Item Image -> Compiler (Item Image)
forall a b. (a -> b) -> a -> b
$ (ImageFormat -> DynamicImage -> Image
encode ImageFormat
fmt (DynamicImage -> Image)
-> (Image -> DynamicImage) -> Image -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Width -> DynamicImage -> DynamicImage
ensureFit Width
w Width
h (DynamicImage -> DynamicImage)
-> (Image -> DynamicImage) -> Image -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DynamicImage
decodeImage' (ByteString -> DynamicImage)
-> (Image -> ByteString) -> Image -> DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image -> ByteString
image) (Image -> Image) -> Item Image -> Item Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item Image
item