{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Servant.JuicyPixels where

import Codec.Picture
import Codec.Picture.Bitmap
import Codec.Picture.Gif
import Codec.Picture.HDR
import Codec.Picture.Jpg
import Codec.Picture.Metadata
import Codec.Picture.Png
import Codec.Picture.Saving
import Codec.Picture.Tga
import Codec.Picture.Tiff
import Codec.Picture.Types
import qualified Data.ByteString.Lazy as BL
import Data.Proxy
import GHC.TypeLits
import qualified Network.HTTP.Media as M
import Servant.API

data BMP

instance Accept BMP where
    contentType :: Proxy BMP -> MediaType
contentType Proxy BMP
_ = ByteString
"image" ByteString -> ByteString -> MediaType
M.// ByteString
"bmp"

instance MimeRender BMP DynamicImage where
    mimeRender :: Proxy BMP -> DynamicImage -> ByteString
mimeRender Proxy BMP
_ = DynamicImage -> ByteString
imageToBitmap

instance BmpEncodable pixel => MimeRender BMP (Image pixel, Metadatas) where
    mimeRender :: Proxy BMP -> (Image pixel, Metadatas) -> ByteString
mimeRender Proxy BMP
_ (Image pixel
img, Metadatas
metadata) = Metadatas -> Image pixel -> ByteString
forall pixel.
BmpEncodable pixel =>
Metadatas -> Image pixel -> ByteString
encodeBitmapWithMetadata Metadatas
metadata Image pixel
img

instance MimeUnrender BMP DynamicImage where
    mimeUnrender :: Proxy BMP -> ByteString -> Either String DynamicImage
mimeUnrender Proxy BMP
_ = ByteString -> Either String DynamicImage
decodeBitmap (ByteString -> Either String DynamicImage)
-> (ByteString -> ByteString)
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance MimeUnrender BMP (DynamicImage, Metadatas) where
    mimeUnrender :: Proxy BMP -> ByteString -> Either String (DynamicImage, Metadatas)
mimeUnrender Proxy BMP
_ = ByteString -> Either String (DynamicImage, Metadatas)
decodeBitmapWithMetadata (ByteString -> Either String (DynamicImage, Metadatas))
-> (ByteString -> ByteString)
-> ByteString
-> Either String (DynamicImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

data GIF

instance Accept GIF where
    contentType :: Proxy GIF -> MediaType
contentType Proxy GIF
_ = ByteString
"image" ByteString -> ByteString -> MediaType
M.// ByteString
"gif"

instance MimeRender GIF DynamicImage where
    mimeRender :: Proxy GIF -> DynamicImage -> ByteString
mimeRender Proxy GIF
_ = (String -> ByteString)
-> (ByteString -> ByteString)
-> Either String ByteString
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ByteString
forall a. HasCallStack => String -> a
error ByteString -> ByteString
forall a. a -> a
id (Either String ByteString -> ByteString)
-> (DynamicImage -> Either String ByteString)
-> DynamicImage
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> Either String ByteString
imageToGif

instance MimeUnrender GIF DynamicImage where
    mimeUnrender :: Proxy GIF -> ByteString -> Either String DynamicImage
mimeUnrender Proxy GIF
_ = ByteString -> Either String DynamicImage
decodeGif (ByteString -> Either String DynamicImage)
-> (ByteString -> ByteString)
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance MimeUnrender GIF (DynamicImage, Metadatas) where
    mimeUnrender :: Proxy GIF -> ByteString -> Either String (DynamicImage, Metadatas)
mimeUnrender Proxy GIF
_ = ByteString -> Either String (DynamicImage, Metadatas)
decodeGifWithMetadata (ByteString -> Either String (DynamicImage, Metadatas))
-> (ByteString -> ByteString)
-> ByteString
-> Either String (DynamicImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

data JPEG (quality :: Nat)

instance (KnownNat quality, quality <= 100) => Accept (JPEG quality) where
    contentType :: Proxy (JPEG quality) -> MediaType
contentType Proxy (JPEG quality)
_ = ByteString
"image" ByteString -> ByteString -> MediaType
M.// ByteString
"jpeg"

instance (KnownNat quality, quality <= 100) => MimeRender (JPEG quality) DynamicImage where
    mimeRender :: Proxy (JPEG quality) -> DynamicImage -> ByteString
mimeRender Proxy (JPEG quality)
_ DynamicImage
img =
      let quality :: Int
quality = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy quality -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy quality
forall k (t :: k). Proxy t
Proxy :: Proxy quality)
      in Int -> DynamicImage -> ByteString
imageToJpg Int
quality DynamicImage
img

instance (KnownNat quality, quality <= 100, ColorSpaceConvertible a PixelYCbCr8) => MimeRender (JPEG quality) (Image a) where
    mimeRender :: Proxy (JPEG quality) -> Image a -> ByteString
mimeRender Proxy (JPEG quality)
_ = Word8 -> Image PixelYCbCr8 -> ByteString
encodeJpegAtQuality Word8
quality (Image PixelYCbCr8 -> ByteString)
-> (Image a -> Image PixelYCbCr8) -> Image a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image a -> Image PixelYCbCr8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage
      where quality :: Word8
quality = Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Word8) -> Integer -> Word8
forall a b. (a -> b) -> a -> b
$ Proxy quality -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy quality
forall k (t :: k). Proxy t
Proxy :: Proxy quality)

instance (KnownNat quality, quality <= 100, ColorSpaceConvertible a PixelYCbCr8) => MimeRender (JPEG quality) (Image a, Metadatas) where
    mimeRender :: Proxy (JPEG quality) -> (Image a, Metadatas) -> ByteString
mimeRender Proxy (JPEG quality)
_ (Image a
img, Metadatas
metadata) = Word8 -> Metadatas -> Image PixelYCbCr8 -> ByteString
encodeJpegAtQualityWithMetadata Word8
quality Metadatas
metadata (Image PixelYCbCr8 -> ByteString)
-> Image PixelYCbCr8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Image a -> Image PixelYCbCr8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image a
img
      where
        quality :: Word8
quality = Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Word8) -> Integer -> Word8
forall a b. (a -> b) -> a -> b
$ Proxy quality -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy quality
forall k (t :: k). Proxy t
Proxy :: Proxy quality)

instance (KnownNat quality, quality <= 100) => MimeUnrender (JPEG quality) DynamicImage where
    mimeUnrender :: Proxy (JPEG quality) -> ByteString -> Either String DynamicImage
mimeUnrender Proxy (JPEG quality)
_ = ByteString -> Either String DynamicImage
decodeJpeg (ByteString -> Either String DynamicImage)
-> (ByteString -> ByteString)
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance (KnownNat quality, quality <= 100) => MimeUnrender (JPEG quality) (DynamicImage, Metadatas) where
    mimeUnrender :: Proxy (JPEG quality)
-> ByteString -> Either String (DynamicImage, Metadatas)
mimeUnrender Proxy (JPEG quality)
_ = ByteString -> Either String (DynamicImage, Metadatas)
decodeJpegWithMetadata (ByteString -> Either String (DynamicImage, Metadatas))
-> (ByteString -> ByteString)
-> ByteString
-> Either String (DynamicImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

data PNG

instance Accept PNG where
    contentType :: Proxy PNG -> MediaType
contentType Proxy PNG
_ = ByteString
"image" ByteString -> ByteString -> MediaType
M.// ByteString
"png"

instance MimeRender PNG DynamicImage where
    mimeRender :: Proxy PNG -> DynamicImage -> ByteString
mimeRender Proxy PNG
_ = DynamicImage -> ByteString
imageToPng

instance PngSavable a => MimeRender PNG (Image a) where
    mimeRender :: Proxy PNG -> Image a -> ByteString
mimeRender Proxy PNG
_ = Image a -> ByteString
forall a. PngSavable a => Image a -> ByteString
encodePng

instance PngSavable a => MimeRender PNG (Image a, Metadatas) where
    mimeRender :: Proxy PNG -> (Image a, Metadatas) -> ByteString
mimeRender Proxy PNG
_ (Image a
img, Metadatas
metadata) = Metadatas -> Image a -> ByteString
forall a. PngSavable a => Metadatas -> Image a -> ByteString
encodePngWithMetadata Metadatas
metadata Image a
img

instance MimeUnrender PNG DynamicImage where
    mimeUnrender :: Proxy PNG -> ByteString -> Either String DynamicImage
mimeUnrender Proxy PNG
_ = ByteString -> Either String DynamicImage
decodePng (ByteString -> Either String DynamicImage)
-> (ByteString -> ByteString)
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance MimeUnrender PNG (DynamicImage, Metadatas) where
    mimeUnrender :: Proxy PNG -> ByteString -> Either String (DynamicImage, Metadatas)
mimeUnrender Proxy PNG
_ = ByteString -> Either String (DynamicImage, Metadatas)
decodePngWithMetadata (ByteString -> Either String (DynamicImage, Metadatas))
-> (ByteString -> ByteString)
-> ByteString
-> Either String (DynamicImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

data TIFF

instance Accept TIFF where
    contentType :: Proxy TIFF -> MediaType
contentType Proxy TIFF
_ = ByteString
"image" ByteString -> ByteString -> MediaType
M.// ByteString
"tiff"

instance MimeRender TIFF DynamicImage where
    mimeRender :: Proxy TIFF -> DynamicImage -> ByteString
mimeRender Proxy TIFF
_ = DynamicImage -> ByteString
imageToTiff

instance TiffSaveable a => MimeRender TIFF (Image a) where
    mimeRender :: Proxy TIFF -> Image a -> ByteString
mimeRender Proxy TIFF
_ = Image a -> ByteString
forall px. TiffSaveable px => Image px -> ByteString
encodeTiff

instance MimeUnrender TIFF DynamicImage where
    mimeUnrender :: Proxy TIFF -> ByteString -> Either String DynamicImage
mimeUnrender Proxy TIFF
_ = ByteString -> Either String DynamicImage
decodeTiff (ByteString -> Either String DynamicImage)
-> (ByteString -> ByteString)
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance MimeUnrender TIFF (DynamicImage, Metadatas) where
    mimeUnrender :: Proxy TIFF -> ByteString -> Either String (DynamicImage, Metadatas)
mimeUnrender Proxy TIFF
_ = ByteString -> Either String (DynamicImage, Metadatas)
decodeTiffWithMetadata (ByteString -> Either String (DynamicImage, Metadatas))
-> (ByteString -> ByteString)
-> ByteString
-> Either String (DynamicImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

data RADIANCE

instance Accept RADIANCE where
    contentType :: Proxy RADIANCE -> MediaType
contentType Proxy RADIANCE
_ = ByteString
"image" ByteString -> ByteString -> MediaType
M.// ByteString
"vnd.radiance"

instance MimeRender RADIANCE DynamicImage where
    mimeRender :: Proxy RADIANCE -> DynamicImage -> ByteString
mimeRender Proxy RADIANCE
_ = DynamicImage -> ByteString
imageToRadiance

instance a ~ PixelRGBF => MimeRender RADIANCE (Image a) where
    mimeRender :: Proxy RADIANCE -> Image a -> ByteString
mimeRender Proxy RADIANCE
_ = Image a -> ByteString
Image PixelRGBF -> ByteString
encodeHDR

instance MimeUnrender RADIANCE DynamicImage where
    mimeUnrender :: Proxy RADIANCE -> ByteString -> Either String DynamicImage
mimeUnrender Proxy RADIANCE
_ = ByteString -> Either String DynamicImage
decodeHDR (ByteString -> Either String DynamicImage)
-> (ByteString -> ByteString)
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance MimeUnrender RADIANCE (DynamicImage, Metadatas) where
    mimeUnrender :: Proxy RADIANCE
-> ByteString -> Either String (DynamicImage, Metadatas)
mimeUnrender Proxy RADIANCE
_ = ByteString -> Either String (DynamicImage, Metadatas)
decodeHDRWithMetadata (ByteString -> Either String (DynamicImage, Metadatas))
-> (ByteString -> ByteString)
-> ByteString
-> Either String (DynamicImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

data TGA

instance Accept TGA where
    contentType :: Proxy TGA -> MediaType
contentType Proxy TGA
_ = ByteString
"image" ByteString -> ByteString -> MediaType
M.// ByteString
"x-targa"

instance MimeRender TGA DynamicImage where
    mimeRender :: Proxy TGA -> DynamicImage -> ByteString
mimeRender Proxy TGA
_ = DynamicImage -> ByteString
imageToTga

instance TgaSaveable a => MimeRender TGA (Image a) where
    mimeRender :: Proxy TGA -> Image a -> ByteString
mimeRender Proxy TGA
_ = Image a -> ByteString
forall px. TgaSaveable px => Image px -> ByteString
encodeTga

instance MimeUnrender TGA DynamicImage where
    mimeUnrender :: Proxy TGA -> ByteString -> Either String DynamicImage
mimeUnrender Proxy TGA
_ = ByteString -> Either String DynamicImage
decodeTga (ByteString -> Either String DynamicImage)
-> (ByteString -> ByteString)
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict

instance MimeUnrender TGA (DynamicImage, Metadatas) where
    mimeUnrender :: Proxy TGA -> ByteString -> Either String (DynamicImage, Metadatas)
mimeUnrender Proxy TGA
_ = ByteString -> Either String (DynamicImage, Metadatas)
decodeTgaWithMetadata (ByteString -> Either String (DynamicImage, Metadatas))
-> (ByteString -> ByteString)
-> ByteString
-> Either String (DynamicImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict