{-# LANGUAGE GeneralisedNewtypeDeriving #-}
-- |

-- Module      : Hakyll.Images.CompressJpg

-- Description : Hakyll compiler to compress Jpeg images

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

-- 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,
  )
import Numeric.Natural (Natural)


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

-- @since 1.2.0

newtype JpgQuality = JpgQuality Natural
  deriving (Integer -> JpgQuality
JpgQuality -> JpgQuality
JpgQuality -> JpgQuality -> JpgQuality
(JpgQuality -> JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality)
-> (Integer -> JpgQuality)
-> Num JpgQuality
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> JpgQuality
$cfromInteger :: Integer -> JpgQuality
signum :: JpgQuality -> JpgQuality
$csignum :: JpgQuality -> JpgQuality
abs :: JpgQuality -> JpgQuality
$cabs :: JpgQuality -> JpgQuality
negate :: JpgQuality -> JpgQuality
$cnegate :: JpgQuality -> JpgQuality
* :: JpgQuality -> JpgQuality -> JpgQuality
$c* :: JpgQuality -> JpgQuality -> JpgQuality
- :: JpgQuality -> JpgQuality -> JpgQuality
$c- :: JpgQuality -> JpgQuality -> JpgQuality
+ :: JpgQuality -> JpgQuality -> JpgQuality
$c+ :: JpgQuality -> JpgQuality -> JpgQuality
Num, JpgQuality -> JpgQuality -> Bool
(JpgQuality -> JpgQuality -> Bool)
-> (JpgQuality -> JpgQuality -> Bool) -> Eq JpgQuality
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JpgQuality -> JpgQuality -> Bool
$c/= :: JpgQuality -> JpgQuality -> Bool
== :: JpgQuality -> JpgQuality -> Bool
$c== :: JpgQuality -> JpgQuality -> Bool
Eq, Int -> JpgQuality
JpgQuality -> Int
JpgQuality -> [JpgQuality]
JpgQuality -> JpgQuality
JpgQuality -> JpgQuality -> [JpgQuality]
JpgQuality -> JpgQuality -> JpgQuality -> [JpgQuality]
(JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality)
-> (Int -> JpgQuality)
-> (JpgQuality -> Int)
-> (JpgQuality -> [JpgQuality])
-> (JpgQuality -> JpgQuality -> [JpgQuality])
-> (JpgQuality -> JpgQuality -> [JpgQuality])
-> (JpgQuality -> JpgQuality -> JpgQuality -> [JpgQuality])
-> Enum JpgQuality
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JpgQuality -> JpgQuality -> JpgQuality -> [JpgQuality]
$cenumFromThenTo :: JpgQuality -> JpgQuality -> JpgQuality -> [JpgQuality]
enumFromTo :: JpgQuality -> JpgQuality -> [JpgQuality]
$cenumFromTo :: JpgQuality -> JpgQuality -> [JpgQuality]
enumFromThen :: JpgQuality -> JpgQuality -> [JpgQuality]
$cenumFromThen :: JpgQuality -> JpgQuality -> [JpgQuality]
enumFrom :: JpgQuality -> [JpgQuality]
$cenumFrom :: JpgQuality -> [JpgQuality]
fromEnum :: JpgQuality -> Int
$cfromEnum :: JpgQuality -> Int
toEnum :: Int -> JpgQuality
$ctoEnum :: Int -> JpgQuality
pred :: JpgQuality -> JpgQuality
$cpred :: JpgQuality -> JpgQuality
succ :: JpgQuality -> JpgQuality
$csucc :: JpgQuality -> JpgQuality
Enum, Eq JpgQuality
Eq JpgQuality
-> (JpgQuality -> JpgQuality -> Ordering)
-> (JpgQuality -> JpgQuality -> Bool)
-> (JpgQuality -> JpgQuality -> Bool)
-> (JpgQuality -> JpgQuality -> Bool)
-> (JpgQuality -> JpgQuality -> Bool)
-> (JpgQuality -> JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality -> JpgQuality)
-> Ord JpgQuality
JpgQuality -> JpgQuality -> Bool
JpgQuality -> JpgQuality -> Ordering
JpgQuality -> JpgQuality -> JpgQuality
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JpgQuality -> JpgQuality -> JpgQuality
$cmin :: JpgQuality -> JpgQuality -> JpgQuality
max :: JpgQuality -> JpgQuality -> JpgQuality
$cmax :: JpgQuality -> JpgQuality -> JpgQuality
>= :: JpgQuality -> JpgQuality -> Bool
$c>= :: JpgQuality -> JpgQuality -> Bool
> :: JpgQuality -> JpgQuality -> Bool
$c> :: JpgQuality -> JpgQuality -> Bool
<= :: JpgQuality -> JpgQuality -> Bool
$c<= :: JpgQuality -> JpgQuality -> Bool
< :: JpgQuality -> JpgQuality -> Bool
$c< :: JpgQuality -> JpgQuality -> Bool
compare :: JpgQuality -> JpgQuality -> Ordering
$ccompare :: JpgQuality -> JpgQuality -> Ordering
$cp1Ord :: Eq JpgQuality
Ord, Num JpgQuality
Ord JpgQuality
Num JpgQuality
-> Ord JpgQuality -> (JpgQuality -> Rational) -> Real JpgQuality
JpgQuality -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: JpgQuality -> Rational
$ctoRational :: JpgQuality -> Rational
$cp2Real :: Ord JpgQuality
$cp1Real :: Num JpgQuality
Real, Enum JpgQuality
Real JpgQuality
Real JpgQuality
-> Enum JpgQuality
-> (JpgQuality -> JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality -> JpgQuality)
-> (JpgQuality -> JpgQuality -> (JpgQuality, JpgQuality))
-> (JpgQuality -> JpgQuality -> (JpgQuality, JpgQuality))
-> (JpgQuality -> Integer)
-> Integral JpgQuality
JpgQuality -> Integer
JpgQuality -> JpgQuality -> (JpgQuality, JpgQuality)
JpgQuality -> JpgQuality -> JpgQuality
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: JpgQuality -> Integer
$ctoInteger :: JpgQuality -> Integer
divMod :: JpgQuality -> JpgQuality -> (JpgQuality, JpgQuality)
$cdivMod :: JpgQuality -> JpgQuality -> (JpgQuality, JpgQuality)
quotRem :: JpgQuality -> JpgQuality -> (JpgQuality, JpgQuality)
$cquotRem :: JpgQuality -> JpgQuality -> (JpgQuality, JpgQuality)
mod :: JpgQuality -> JpgQuality -> JpgQuality
$cmod :: JpgQuality -> JpgQuality -> JpgQuality
div :: JpgQuality -> JpgQuality -> JpgQuality
$cdiv :: JpgQuality -> JpgQuality -> JpgQuality
rem :: JpgQuality -> JpgQuality -> JpgQuality
$crem :: JpgQuality -> JpgQuality -> JpgQuality
quot :: JpgQuality -> JpgQuality -> JpgQuality
$cquot :: JpgQuality -> JpgQuality -> JpgQuality
$cp2Integral :: Enum JpgQuality
$cp1Integral :: Real JpgQuality
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 :: a -> JpgQuality
mkJpgQuality a
q | a
q a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0     = Natural -> JpgQuality
JpgQuality Natural
0
               | a
q a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
100   = Natural -> JpgQuality
JpgQuality Natural
100
               | Bool
otherwise = Natural -> JpgQuality
JpgQuality (a -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
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.

compressJpg :: Integral a => a -> Image -> Image
compressJpg :: a -> Image -> Image
compressJpg a
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 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]
"Loading the image failed."
      Right DynamicImage
dynImage -> ImageFormat -> ByteString -> Image
Image ImageFormat
Jpeg (ByteString -> Image) -> ByteString -> Image
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (Int -> DynamicImage -> ByteString
imageToJpg (JpgQuality -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral JpgQuality
quality) DynamicImage
dynImage)
  where quality :: JpgQuality
quality = a -> JpgQuality
forall a. Integral a => a -> JpgQuality
mkJpgQuality a
quality'

-- | Compiler that compresses a JPG image to a certain quality setting.

-- The quality should be between 0 (lowest quality) and 100 (best quality).

-- Values outside of this range will be normalized to the interval [0, 100].

-- An error is raised if the image cannot be decoded.

--

-- @

-- match "*.jpg" $ do

--     route idRoute

--     compile $ loadImage

--         >>= compressJpgCompiler 50

-- @

compressJpgCompiler :: Integral a => a -> Item Image -> Compiler (Item Image)
compressJpgCompiler :: a -> Item Image -> Compiler (Item Image)
compressJpgCompiler a
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 (a -> Image -> Image
forall a. Integral a => a -> Image -> Image
compressJpg a
quality)