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

module Servant.JuicyPixels where

import Servant.API
import GHC.TypeLits
import qualified Network.HTTP.Media as M
import Codec.Picture
import Codec.Picture.Saving
import Codec.Picture.Types
import Data.Proxy
import qualified Data.ByteString.Lazy as BL


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 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


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


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) => 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


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 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


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


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

#if MIN_VERSION_JuicyPixels(3,2,6)
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
#endif