{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Hakyll.Images.Common ( Image(..)
, ImageFormat(..)
, loadImage
, encode
) where
import Prelude hiding (readFile)
import Codec.Picture.Types (DynamicImage)
import Codec.Picture.Saving
import Data.Binary (Binary(..))
import Data.ByteString.Lazy (toStrict)
import Data.ByteString (ByteString)
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(..))
data ImageFormat
= Jpeg
| Png
| Bitmap
| Tiff
deriving (Eq, Generic)
instance Binary ImageFormat
data Image = Image { format :: ImageFormat
, image :: ByteString
}
deriving (Typeable)
instance Writable Image where
write fp item = write fp (image <$> item)
instance Binary Image where
put (Image fmt content) = put fmt >> put content
get = Image <$> get <*> get
loadImage :: Compiler (Item Image)
loadImage = do
content <- fmap toStrict <$> getResourceLBS
fmt <- fromExt <$> getUnderlyingExtension
return $ (Image fmt) <$> content
fromExt :: String -> ImageFormat
fromExt ext = fromExt' $ toLower <$> ext
where
fromExt' ".jpeg" = Jpeg
fromExt' ".jpg" = Jpeg
fromExt' ".png" = Png
fromExt' ".bmp" = Bitmap
fromExt' ".tif" = Tiff
fromExt' ".tiff" = Tiff
fromExt' ext' = error $ "Unsupported format: " <> ext'
encode :: ImageFormat -> DynamicImage -> Image
encode Jpeg im = Image Jpeg $ (toStrict . imageToJpg 100) im
encode Png im = Image Png $ (toStrict . imageToPng) im
encode Bitmap im = Image Bitmap $ (toStrict . imageToBitmap) im
encode Tiff im = Image Tiff $ (toStrict . imageToTiff) im