-- |

-- Module      : Hakyll.Images.CompressJpg

-- Description : Hakyll compiler to compress Jpeg images

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

-- License     : BSD3

-- Maintainer  : laurent.decotret@outlook.com

-- Stability   : unstable

-- Portability : portable

--

-- This module defines a Hakyll compiler, 'compressJpgCompiler', which can be used to

-- re-encode Jpeg images at a lower quality during website compilation. Original images are

-- left unchanged, but compressed images can be up to 10x smaller.

--

-- The @compressJpgCompiler@ is expected to be used like this:

--

-- @

--     import Hakyll

--     import Hakyll.Images        ( loadImage

--                                 , compressJpgCompiler

--                                 )

--

--     hakyll $ do

--

--         -- Compress all source Jpegs to a Jpeg quality of 50

--         match "images/**.jpg" $ do

--             route idRoute

--             compile $ loadImage

--                 >>= compressJpgCompiler 50

--

--         (... omitted ...)

-- @

module Hakyll.Images.CompressJpg
  ( JpgQuality,
    compressJpgCompiler,
    compressJpg,
  )
where

import Codec.Picture.Jpg (decodeJpeg)
import Codec.Picture.Saving (imageToJpg)
import Data.ByteString.Lazy (toStrict)
import Hakyll.Core.Compiler (Compiler)
import Hakyll.Core.Item (Item (..))
import Hakyll.Images.Common
  ( Image (..),
    ImageFormat (..),
    format,
    image,
  )

-- | Jpeg encoding quality, from 0 (lower quality) to 100 (best quality).

type JpgQuality = Int

-- | 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, or if the

-- encoding quality is out-of-bounds

compressJpg :: JpgQuality -> Image -> Image
compressJpg :: JpgQuality -> Image -> Image
compressJpg JpgQuality
quality Image
src =
  if (Image -> ImageFormat
format Image
src) ImageFormat -> ImageFormat -> Bool
forall a. Eq a => a -> a -> Bool
/= ImageFormat
Jpeg
    then [Char] -> Image
forall a. HasCallStack => [Char] -> a
error ([Char] -> Image) -> [Char] -> Image
forall a b. (a -> b) -> a -> b
$ [Char]
"Image is not a JPEG."
    else case ByteString -> Either [Char] DynamicImage
decodeJpeg (ByteString -> Either [Char] DynamicImage)
-> ByteString -> Either [Char] DynamicImage
forall a b. (a -> b) -> a -> b
$ Image -> ByteString
image Image
src of
      Left [Char]
_ -> [Char] -> Image
forall a. HasCallStack => [Char] -> a
error ([Char] -> Image) -> [Char] -> Image
forall a b. (a -> b) -> a -> b
$ [Char]
"Loading the image failed."
      Right DynamicImage
dynImage ->
        if (JpgQuality
quality JpgQuality -> JpgQuality -> Bool
forall a. Ord a => a -> a -> Bool
< JpgQuality
0 Bool -> Bool -> Bool
|| JpgQuality
quality JpgQuality -> JpgQuality -> Bool
forall a. Ord a => a -> a -> Bool
> JpgQuality
100)
          then [Char] -> Image
forall a. HasCallStack => [Char] -> a
error ([Char] -> Image) -> [Char] -> Image
forall a b. (a -> b) -> a -> b
$ [Char]
"JPEG encoding quality should be between 0 and 100."
          else ImageFormat -> ByteString -> Image
Image ImageFormat
Jpeg (ByteString -> Image) -> ByteString -> Image
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ JpgQuality -> DynamicImage -> ByteString
imageToJpg JpgQuality
quality DynamicImage
dynImage)

-- | Compiler that compresses a JPG image 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.

--

-- @

-- match "*.jpg" $ do

--     route idRoute

--     compile $ loadImage

--         >>= compressJpgCompiler 50

-- @

compressJpgCompiler :: JpgQuality -> Item Image -> Compiler (Item Image)
compressJpgCompiler :: JpgQuality -> Item Image -> Compiler (Item Image)
compressJpgCompiler JpgQuality
quality = Item Image -> Compiler (Item Image)
forall (m :: * -> *) a. Monad m => a -> m a
return (Item Image -> Compiler (Item Image))
-> (Item Image -> Item Image)
-> Item Image
-> Compiler (Item Image)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Image -> Image) -> Item Image -> Item Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (JpgQuality -> Image -> Image
compressJpg JpgQuality
quality)