{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- |

-- Module      : Hakyll.Images.Common

-- Description : Types and utilities for Hakyll.Images

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

-- License     : BSD3

-- Maintainer  : laurent.decotret@outlook.com

-- Stability   : unstable

-- Portability : portable

module Hakyll.Images.Common
  ( Image (..),
    ImageFormat (..),
    loadImage,
    encode,
  )
where

import Codec.Picture.Saving
import Codec.Picture.Types (DynamicImage)
import Data.Binary (Binary (..))
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (toStrict)
import Data.Char (toLower)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Hakyll.Core.Compiler (Compiler, getResourceLBS, getUnderlyingExtension)
import Hakyll.Core.Item (Item (..))
import Hakyll.Core.Writable (Writable (..))
import Prelude hiding (readFile)

-- Supported (i.e. encodable) image formats

data ImageFormat
  = Jpeg
  | Png
  | Bitmap
  | Tiff
  | Gif
  deriving (ImageFormat -> ImageFormat -> Bool
(ImageFormat -> ImageFormat -> Bool)
-> (ImageFormat -> ImageFormat -> Bool) -> Eq ImageFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImageFormat -> ImageFormat -> Bool
$c/= :: ImageFormat -> ImageFormat -> Bool
== :: ImageFormat -> ImageFormat -> Bool
$c== :: ImageFormat -> ImageFormat -> Bool
Eq, (forall x. ImageFormat -> Rep ImageFormat x)
-> (forall x. Rep ImageFormat x -> ImageFormat)
-> Generic ImageFormat
forall x. Rep ImageFormat x -> ImageFormat
forall x. ImageFormat -> Rep ImageFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImageFormat x -> ImageFormat
$cfrom :: forall x. ImageFormat -> Rep ImageFormat x
Generic)

-- Automatic derivation of Binary instances requires Generic

instance Binary ImageFormat

data Image = Image
  { Image -> ImageFormat
format :: ImageFormat,
    Image -> ByteString
image :: ByteString
  }
  deriving (Typeable)

-- When writing to disk, we ignore the image format.

-- Trusting users to route correctly.

instance Writable Image where
  -- Write the bytestring content

  write :: FilePath -> Item Image -> IO ()
write FilePath
fp Item Image
item = FilePath -> Item ByteString -> IO ()
forall a. Writable a => FilePath -> Item a -> IO ()
write FilePath
fp (Image -> ByteString
image (Image -> ByteString) -> Item Image -> Item ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item Image
item)

-- Binary instance looks similar to the binary instance for a Hakyll Item

instance Binary Image where
  put :: Image -> Put
put (Image ImageFormat
fmt ByteString
content) = ImageFormat -> Put
forall t. Binary t => t -> Put
put ImageFormat
fmt Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Put
forall t. Binary t => t -> Put
put ByteString
content
  get :: Get Image
get = ImageFormat -> ByteString -> Image
Image (ImageFormat -> ByteString -> Image)
-> Get ImageFormat -> Get (ByteString -> Image)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ImageFormat
forall t. Binary t => Get t
get Get (ByteString -> Image) -> Get ByteString -> Get Image
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ByteString
forall t. Binary t => Get t
get

-- | Load an image from a file.

-- This function can be combined with other compilers.

--

-- @

-- match "*.jpg" $ do

--     route idRoute

--     compile $ loadImage

--         >>= compressJpgCompiler 50

-- @

loadImage :: Compiler (Item Image)
loadImage :: Compiler (Item Image)
loadImage = do
  Item ByteString
content <- (ByteString -> ByteString) -> Item ByteString -> Item ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
toStrict (Item ByteString -> Item ByteString)
-> Compiler (Item ByteString) -> Compiler (Item ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler (Item ByteString)
getResourceLBS
  ImageFormat
fmt <- FilePath -> ImageFormat
fromExt (FilePath -> ImageFormat)
-> Compiler FilePath -> Compiler ImageFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler FilePath
getUnderlyingExtension
  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 -> ByteString -> Image
Image ImageFormat
fmt) (ByteString -> Image) -> Item ByteString -> Item Image
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item ByteString
content

-- | Translation between file extensions and image formats.

-- It is important to keep track of image formats because Hakyll

-- compilers provides raw bytestrings and filenames.

--

-- This function is case-insensitive

fromExt :: String -> ImageFormat
fromExt :: FilePath -> ImageFormat
fromExt FilePath
ext = FilePath -> ImageFormat
fromExt' (FilePath -> ImageFormat) -> FilePath -> ImageFormat
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower (Char -> Char) -> FilePath -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
ext
  where
    fromExt' :: FilePath -> ImageFormat
fromExt' FilePath
".jpeg" = ImageFormat
Jpeg
    fromExt' FilePath
".jpg" = ImageFormat
Jpeg
    fromExt' FilePath
".png" = ImageFormat
Png
    fromExt' FilePath
".bmp" = ImageFormat
Bitmap
    fromExt' FilePath
".tif" = ImageFormat
Tiff
    fromExt' FilePath
".tiff" = ImageFormat
Tiff
    fromExt' FilePath
".gif" = ImageFormat
Gif
    fromExt' FilePath
ext' = FilePath -> ImageFormat
forall a. HasCallStack => FilePath -> a
error (FilePath -> ImageFormat) -> FilePath -> ImageFormat
forall a b. (a -> b) -> a -> b
$ FilePath
"Unsupported format: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
ext'

-- Encode images based on file extension

encode :: ImageFormat -> DynamicImage -> Image
encode :: ImageFormat -> DynamicImage -> Image
encode ImageFormat
Jpeg DynamicImage
im = ImageFormat -> ByteString -> Image
Image ImageFormat
Jpeg (ByteString -> Image) -> ByteString -> Image
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (DynamicImage -> ByteString) -> DynamicImage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DynamicImage -> ByteString
imageToJpg Int
100) DynamicImage
im
encode ImageFormat
Png DynamicImage
im = ImageFormat -> ByteString -> Image
Image ImageFormat
Png (ByteString -> Image) -> ByteString -> Image
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (DynamicImage -> ByteString) -> DynamicImage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> ByteString
imageToPng) DynamicImage
im
encode ImageFormat
Bitmap DynamicImage
im = ImageFormat -> ByteString -> Image
Image ImageFormat
Bitmap (ByteString -> Image) -> ByteString -> Image
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (DynamicImage -> ByteString) -> DynamicImage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> ByteString
imageToBitmap) DynamicImage
im
encode ImageFormat
Tiff DynamicImage
im = ImageFormat -> ByteString -> Image
Image ImageFormat
Tiff (ByteString -> Image) -> ByteString -> Image
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (DynamicImage -> ByteString) -> DynamicImage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> ByteString
imageToTiff) DynamicImage
im
encode ImageFormat
Gif DynamicImage
im = ImageFormat -> ByteString -> Image
Image ImageFormat
Gif (ByteString -> Image) -> ByteString -> Image
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (DynamicImage -> ByteString) -> DynamicImage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> ByteString)
-> (ByteString -> ByteString)
-> Either FilePath ByteString
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> FilePath -> ByteString
forall a b. a -> b -> a
const (ByteString -> FilePath -> ByteString)
-> ByteString -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
error FilePath
"Could not parse gif") ByteString -> ByteString
forall a. a -> a
id (Either FilePath ByteString -> ByteString)
-> (DynamicImage -> Either FilePath ByteString)
-> DynamicImage
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> Either FilePath ByteString
imageToGif) DynamicImage
im