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