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

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) = 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 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 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
_ = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id 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 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 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 = forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage
      where quality :: Word8
quality = forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (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 forall a b. (a -> b) -> a -> b
$ forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image a
img
      where
        quality :: Word8
quality = forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (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 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 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
_ = 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) = 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 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 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
_ = 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 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 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 PixelRGBF -> ByteString
encodeHDR

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