{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
-- |
-- Module      : Hakyll.Images.Common
-- Description : Types and utilities for Hakyll.Images
-- Copyright   : (c) Laurent P René de Cotret, 2019 - present
-- 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.Either (fromRight)
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
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. 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 = forall a. Writable a => FilePath -> Item a -> IO ()
write FilePath
fp (Image -> ByteString
image 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) = forall t. Binary t => t -> Put
put ImageFormat
fmt forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put ByteString
content
  get :: Get Image
get = ImageFormat -> ByteString -> Image
Image forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler (Item ByteString)
getResourceLBS
  ImageFormat
fmt <- FilePath -> ImageFormat
fromExt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compiler FilePath
getUnderlyingExtension
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ImageFormat -> ByteString -> Image
Image ImageFormat
fmt 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' forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower 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' = forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"Unsupported format: " 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 forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict 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 forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict 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 forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict 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 forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict 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 forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> Either a b -> b
fromRight (forall a. HasCallStack => FilePath -> a
error FilePath
"Could not parse gif") forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> Either FilePath ByteString
imageToGif) DynamicImage
im