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 _ = "image" M.// "bmp"
instance MimeRender BMP DynamicImage where
mimeRender _ = imageToBitmap
instance MimeUnrender BMP DynamicImage where
mimeUnrender _ = decodeBitmap . BL.toStrict
data GIF
instance Accept GIF where
contentType _ = "image" M.// "gif"
instance MimeRender GIF DynamicImage where
mimeRender _ = either error id . imageToGif
instance MimeUnrender GIF DynamicImage where
mimeUnrender _ = decodeGif . BL.toStrict
data JPEG (quality :: Nat)
instance (KnownNat quality, quality <= 100) => Accept (JPEG quality) where
contentType _ = "image" M.// "jpeg"
instance (KnownNat quality, quality <= 100) => MimeRender (JPEG quality) DynamicImage where
mimeRender _ img =
let quality = fromInteger $ natVal (Proxy :: Proxy quality)
in imageToJpg quality img
instance (KnownNat quality, quality <= 100, ColorSpaceConvertible a PixelYCbCr8) => MimeRender (JPEG quality) (Image a) where
mimeRender _ = encodeJpegAtQuality quality . convertImage
where quality = fromInteger $ natVal (Proxy :: Proxy quality)
instance (KnownNat quality, quality <= 100) => MimeUnrender (JPEG quality) DynamicImage where
mimeUnrender _ = decodeJpeg . BL.toStrict
data PNG
instance Accept PNG where
contentType _ = "image" M.// "png"
instance MimeRender PNG DynamicImage where
mimeRender _ = imageToPng
instance PngSavable a => MimeRender PNG (Image a) where
mimeRender _ = encodePng
instance MimeUnrender PNG DynamicImage where
mimeUnrender _ = decodePng . BL.toStrict
data TIFF
instance Accept TIFF where
contentType _ = "image" M.// "tiff"
instance MimeRender TIFF DynamicImage where
mimeRender _ = imageToTiff
instance TiffSaveable a => MimeRender TIFF (Image a) where
mimeRender _ = encodeTiff
instance MimeUnrender TIFF DynamicImage where
mimeUnrender _ = decodeTiff . BL.toStrict
data RADIANCE
instance Accept RADIANCE where
contentType _ = "image" M.// "vnd.radiance"
instance MimeRender RADIANCE DynamicImage where
mimeRender _ = imageToRadiance
instance a ~ PixelRGBF => MimeRender RADIANCE (Image a) where
mimeRender _ = encodeHDR
instance MimeUnrender RADIANCE DynamicImage where
mimeUnrender _ = decodeHDR . BL.toStrict
#if MIN_VERSION_JuicyPixels(3,2,6)
data TGA
instance Accept TGA where
contentType _ = "image" M.// "x-targa"
instance MimeRender TGA DynamicImage where
mimeRender _ = imageToTga
instance TgaSaveable a => MimeRender TGA (Image a) where
mimeRender _ = encodeTga
instance MimeUnrender TGA DynamicImage where
mimeUnrender _ = decodeTga . BL.toStrict
#endif