{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
-- | Main module for image import/export into various image formats.

--

-- To use the library without thinking about it, look after 'decodeImage' and

-- 'readImage'.

--

-- Generally, the @read*@ functions read the images from a file and try to decode

-- it, and the @decode*@ functions try to decode a bytestring.

--

-- For an easy image writing use the 'saveBmpImage', 'saveJpgImage' & 'savePngImage'

-- functions

module Codec.Picture (
                     -- * Generic functions

                       readImage
                     , readImageWithMetadata
                     , decodeImage
                     , decodeImageWithMetadata
                     , decodeImageWithPaletteAndMetadata
                     , pixelMap
                     , dynamicMap
                     , dynamicPixelMap
                     , generateImage
                     , generateFoldImage
                     , withImage
                     , palettedToTrueColor

                      -- * RGB helper functions

                     , convertRGB8
                     , convertRGB16
                     , convertRGBA8

                     -- * Lens compatibility

                     , Traversal
                     , imagePixels
                     , imageIPixels

                     -- * Generic image writing

                     , saveBmpImage
                     , saveJpgImage
                     , saveGifImage
                     , savePngImage
                     , saveTiffImage
                     , saveRadianceImage

                     -- * Specific image format functions

                     -- ** Bitmap handling

                     , BmpEncodable
                     , writeBitmap
                     , encodeBitmap
                     , readBitmap
                     , decodeBitmap
                     , encodeDynamicBitmap
                     , writeDynamicBitmap

                     -- ** Gif handling

                     , readGif
                     , readGifImages
                     , decodeGif
                     , decodeGifImages

                     , encodeGifImage
                     , writeGifImage
                     , encodeGifImageWithPalette
                     , writeGifImageWithPalette
                     , encodeColorReducedGifImage
                     , writeColorReducedGifImage 
                     , encodeGifImages
                     , writeGifImages

                     -- *** Gif animation

                     , GifDelay
                     , GifLooping( .. )
                     , encodeGifAnimation
                     , writeGifAnimation

                     -- ** Jpeg handling

                     , readJpeg
                     , decodeJpeg
                     , encodeJpeg
                     , encodeJpegAtQuality

                     -- ** Png handling

                     , PngSavable( .. )
                     , readPng
                     , decodePng
                     , writePng
                     , encodePalettedPng
                     , encodeDynamicPng
                     , writeDynamicPng

                     -- ** TGA handling

                     , readTGA
                     , decodeTga
                     , TgaSaveable
                     , encodeTga
                     , writeTga

                     -- ** Tiff handling

                     , readTiff
                     , TiffSaveable
                     , decodeTiff
                     , encodeTiff
                     , writeTiff

                     -- ** HDR (Radiance/RGBE) handling

                     , readHDR
                     , decodeHDR
                     , encodeHDR
                     , writeHDR

                     -- ** Color Quantization

                     , PaletteCreationMethod(..)
                     , PaletteOptions(..)
                     , palettize

                     -- * Image types and pixel types

                     -- ** Image

                     , Image( .. )
                     , DynamicImage( .. )
                     , Palette
                     -- ** Pixels

                     , Pixel( .. )
                     -- $graph

                     , Pixel8
                     , Pixel16
                     , Pixel32
                     , PixelF

                     , PixelYA8( .. )
                     , PixelYA16( .. )
                     , PixelRGB8( .. )
                     , PixelRGB16( .. )
                     , PixelRGBF( .. )
                     , PixelRGBA8( .. )
                     , PixelRGBA16( .. )
                     , PixelYCbCr8( .. )
                     , PixelCMYK8( .. )
                     , PixelCMYK16( .. )

                     -- * Foreign unsafe import

                     , imageFromUnsafePtr
                     ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative( (<$>) )
#endif

import Control.Arrow( first )
import Data.Bits( unsafeShiftR )
import Control.DeepSeq( NFData, deepseq )
import qualified Control.Exception as Exc ( catch, IOException )
import Codec.Picture.Metadata( Metadatas )
import Codec.Picture.Bitmap( BmpEncodable
                           , decodeBitmap
                           , decodeBitmapWithPaletteAndMetadata
                           , writeBitmap, encodeBitmap
                           , encodeDynamicBitmap, writeDynamicBitmap )
import Codec.Picture.Jpg( decodeJpeg
                        , decodeJpegWithMetadata
                        , encodeJpeg
                        , encodeJpegAtQuality )
import Codec.Picture.Png( PngSavable( .. )
                        , decodePng
                        , decodePngWithPaletteAndMetadata
                        , writePng
                        , encodeDynamicPng
                        , encodePalettedPng
                        , writeDynamicPng
                        )

import Codec.Picture.Gif( GifDelay
                        , GifLooping( .. )
                        , decodeGif
                        , decodeGifWithPaletteAndMetadata
                        , decodeGifImages
                        , encodeGifImage
                        , encodeGifImageWithPalette
                        , encodeGifImages

                        , writeGifImage
                        , writeGifImageWithPalette
                        , writeGifImages
                        )

import Codec.Picture.HDR( decodeHDR
                        , decodeHDRWithMetadata
                        , encodeHDR
                        , writeHDR
                        )
import Codec.Picture.Tiff( decodeTiff
                         , decodeTiffWithPaletteAndMetadata
                         , TiffSaveable
                         , encodeTiff
                         , writeTiff )
import Codec.Picture.Tga( TgaSaveable
                        , decodeTga
                        , decodeTgaWithPaletteAndMetadata
                        , encodeTga
                        , writeTga
                        )
import Codec.Picture.Saving
import Codec.Picture.Types
import Codec.Picture.ColorQuant
import Codec.Picture.VectorByteConversion( imageFromUnsafePtr )
-- import System.IO ( withFile, IOMode(ReadMode) )

#ifdef WITH_MMAP_BYTESTRING
import System.IO.MMap ( mmapFileByteString )
#endif

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Vector.Storable as VS

-- | Return the first Right thing, accumulating error

eitherLoad :: c -> [(String, c -> Either String b)] -> Either String b
eitherLoad :: c -> [(String, c -> Either String b)] -> Either String b
eitherLoad c
v = String -> [(String, c -> Either String b)] -> Either String b
inner String
""
    where inner :: String -> [(String, c -> Either String b)] -> Either String b
inner String
errAcc [] = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"Cannot load file\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errAcc
          inner String
errAcc ((String
hdr, c -> Either String b
f) : [(String, c -> Either String b)]
rest) = case c -> Either String b
f c
v of
                Left  String
err  -> String -> [(String, c -> Either String b)] -> Either String b
inner (String
errAcc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hdr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") [(String, c -> Either String b)]
rest
                Right b
rez  -> b -> Either String b
forall a b. b -> Either a b
Right b
rez

-- | Encode a full color image to a gif by applying a color quantization

-- algorithm on it.

encodeColorReducedGifImage :: Image PixelRGB8 -> Either String L.ByteString
encodeColorReducedGifImage :: Image PixelRGB8 -> Either String ByteString
encodeColorReducedGifImage Image PixelRGB8
img = Image Pixel8 -> Image PixelRGB8 -> Either String ByteString
encodeGifImageWithPalette Image Pixel8
indexed Image PixelRGB8
pal
  where (Image Pixel8
indexed, Image PixelRGB8
pal) = PaletteOptions
-> Image PixelRGB8 -> (Image Pixel8, Image PixelRGB8)
palettize PaletteOptions
defaultPaletteOptions Image PixelRGB8
img

-- | Write a full color image to a gif by applying a color quantization

-- algorithm on it.

writeColorReducedGifImage :: FilePath -> Image PixelRGB8 -> Either String (IO ())
writeColorReducedGifImage :: String -> Image PixelRGB8 -> Either String (IO ())
writeColorReducedGifImage String
path Image PixelRGB8
img =
    String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ())
-> Either String ByteString -> Either String (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image PixelRGB8 -> Either String ByteString
encodeColorReducedGifImage Image PixelRGB8
img


-- | Helper function to create a gif animation.

-- All the images of the animation are separated

-- by the same delay.

encodeGifAnimation :: GifDelay -> GifLooping
                   -> [Image PixelRGB8] -> Either String L.ByteString
encodeGifAnimation :: GifDelay
-> GifLooping -> [Image PixelRGB8] -> Either String ByteString
encodeGifAnimation GifDelay
delay GifLooping
looping [Image PixelRGB8]
lst =
    GifLooping
-> [(Image PixelRGB8, GifDelay, Image Pixel8)]
-> Either String ByteString
encodeGifImages GifLooping
looping
        [(Image PixelRGB8
pal, GifDelay
delay, Image Pixel8
img)
                | (Image Pixel8
img, Image PixelRGB8
pal) <- PaletteOptions
-> Image PixelRGB8 -> (Image Pixel8, Image PixelRGB8)
palettize PaletteOptions
defaultPaletteOptions (Image PixelRGB8 -> (Image Pixel8, Image PixelRGB8))
-> [Image PixelRGB8] -> [(Image Pixel8, Image PixelRGB8)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image PixelRGB8]
lst]

-- | Helper function to write a gif animation on disk.

-- See encodeGifAnimation

writeGifAnimation :: FilePath -> GifDelay -> GifLooping
                  -> [Image PixelRGB8] -> Either String (IO ())
writeGifAnimation :: String
-> GifDelay
-> GifLooping
-> [Image PixelRGB8]
-> Either String (IO ())
writeGifAnimation String
path GifDelay
delay GifLooping
looping [Image PixelRGB8]
img =
    String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ())
-> Either String ByteString -> Either String (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GifDelay
-> GifLooping -> [Image PixelRGB8] -> Either String ByteString
encodeGifAnimation GifDelay
delay GifLooping
looping [Image PixelRGB8]
img

withImageDecoder :: (NFData a)
                 => (B.ByteString -> Either String a) -> FilePath
                 -> IO (Either String a)
withImageDecoder :: (ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String a
decoder String
path = IO (Either String a)
-> (IOException -> IO (Either String a)) -> IO (Either String a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exc.catch IO (Either String a)
doit
                    (\IOException
e -> Either String a -> IO (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> (String -> Either String a) -> String -> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left (String -> IO (Either String a)) -> String -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show (IOException
e :: Exc.IOException))
    where doit :: IO (Either String a)
doit = Either String a -> Either String a
forall b. NFData b => b -> b
force (Either String a -> Either String a)
-> (ByteString -> Either String a) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
decoder (ByteString -> Either String a)
-> IO ByteString -> IO (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
get
#ifdef WITH_MMAP_BYTESTRING
          get = mmapFileByteString path Nothing
#else
          get :: IO ByteString
get = String -> IO ByteString
B.readFile String
path
#endif
          -- force appeared in deepseq 1.3, Haskell Platform

          -- provides 1.1

          force :: b -> b
force b
x = b
x b -> b -> b
forall a b. NFData a => a -> b -> b
`deepseq` b
x

-- | Load an image file without even thinking about it, it does everything

-- as 'decodeImage'

readImage :: FilePath -> IO (Either String DynamicImage)
readImage :: String -> IO (Either String DynamicImage)
readImage = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeImage

-- | Equivalent to 'readImage'  but also providing metadatas.

readImageWithMetadata :: FilePath -> IO (Either String (DynamicImage, Metadatas))
readImageWithMetadata :: String -> IO (Either String (DynamicImage, Metadatas))
readImageWithMetadata = (ByteString -> Either String (DynamicImage, Metadatas))
-> String -> IO (Either String (DynamicImage, Metadatas))
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata


-- | If you want to decode an image in a bytestring without even thinking

-- in term of format or whatever, this is the function to use. It will try

-- to decode in each known format and if one decoding succeeds, it will return

-- the decoded image in it's own colorspace.

decodeImage :: B.ByteString -> Either String DynamicImage
decodeImage :: ByteString -> Either String DynamicImage
decodeImage = ((DynamicImage, Metadatas) -> DynamicImage)
-> Either String (DynamicImage, Metadatas)
-> Either String DynamicImage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DynamicImage, Metadatas) -> DynamicImage
forall a b. (a, b) -> a
fst (Either String (DynamicImage, Metadatas)
 -> Either String DynamicImage)
-> (ByteString -> Either String (DynamicImage, Metadatas))
-> ByteString
-> Either String DynamicImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata 

class Decimable px1 px2 where
   decimateBitDepth :: Image px1 -> Image px2

decimateWord16 :: ( Pixel px1, Pixel px2
                  , PixelBaseComponent px1 ~ Pixel16
                  , PixelBaseComponent px2 ~ Pixel8
                  ) => Image px1 -> Image px2
decimateWord16 :: Image px1 -> Image px2
decimateWord16 (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
  GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (Pixel16 -> Pixel8) -> Vector Pixel16 -> Vector Pixel8
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (\Pixel16
v -> Pixel16 -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel16 -> Pixel8) -> Pixel16 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel16
v Pixel16 -> GifDelay -> Pixel16
forall a. Bits a => a -> GifDelay -> a
`unsafeShiftR` GifDelay
8) Vector Pixel16
Vector (PixelBaseComponent px1)
da

decimateWord3216 :: ( Pixel px1, Pixel px2
                  , PixelBaseComponent px1 ~ Pixel32
                  , PixelBaseComponent px2 ~ Pixel16
                  ) => Image px1 -> Image px2
decimateWord3216 :: Image px1 -> Image px2
decimateWord3216 (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
  GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (Pixel32 -> Pixel16) -> Vector Pixel32 -> Vector Pixel16
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (\Pixel32
v -> Pixel32 -> Pixel16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel32 -> Pixel16) -> Pixel32 -> Pixel16
forall a b. (a -> b) -> a -> b
$ Pixel32
v Pixel32 -> GifDelay -> Pixel32
forall a. Bits a => a -> GifDelay -> a
`unsafeShiftR` GifDelay
16) Vector Pixel32
Vector (PixelBaseComponent px1)
da
  
decimateWord32 :: ( Pixel px1, Pixel px2
                  , PixelBaseComponent px1 ~ Pixel32
                  , PixelBaseComponent px2 ~ Pixel8
                  ) => Image px1 -> Image px2
decimateWord32 :: Image px1 -> Image px2
decimateWord32 (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
  GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (Pixel32 -> Pixel8) -> Vector Pixel32 -> Vector Pixel8
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (\Pixel32
v -> Pixel32 -> Pixel8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Pixel32 -> Pixel8) -> Pixel32 -> Pixel8
forall a b. (a -> b) -> a -> b
$ Pixel32
v Pixel32 -> GifDelay -> Pixel32
forall a. Bits a => a -> GifDelay -> a
`unsafeShiftR` GifDelay
24) Vector Pixel32
Vector (PixelBaseComponent px1)
da

decimateFloat :: ( Pixel px1, Pixel px2
                 , PixelBaseComponent px1 ~ PixelF
                 , PixelBaseComponent px2 ~ Pixel8
                 ) => Image px1 -> Image px2
decimateFloat :: Image px1 -> Image px2
decimateFloat (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
  GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (PixelF -> Pixel8) -> Vector PixelF -> Vector Pixel8
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (PixelF -> Pixel8
forall a b. (RealFrac a, Integral b) => a -> b
floor (PixelF -> Pixel8) -> (PixelF -> PixelF) -> PixelF -> Pixel8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelF
255PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
*) (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
max PixelF
0 (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
min PixelF
1) Vector PixelF
Vector (PixelBaseComponent px1)
da

decimateFloat16 :: ( Pixel px1, Pixel px2
                 , PixelBaseComponent px1 ~ PixelF
                 , PixelBaseComponent px2 ~ Pixel16
                 ) => Image px1 -> Image px2
decimateFloat16 :: Image px1 -> Image px2
decimateFloat16 (Image GifDelay
w GifDelay
h Vector (PixelBaseComponent px1)
da) =
  GifDelay
-> GifDelay -> Vector (PixelBaseComponent px2) -> Image px2
forall a.
GifDelay -> GifDelay -> Vector (PixelBaseComponent a) -> Image a
Image GifDelay
w GifDelay
h (Vector (PixelBaseComponent px2) -> Image px2)
-> Vector (PixelBaseComponent px2) -> Image px2
forall a b. (a -> b) -> a -> b
$ (PixelF -> Pixel16) -> Vector PixelF -> Vector Pixel16
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
VS.map (PixelF -> Pixel16
forall a b. (RealFrac a, Integral b) => a -> b
floor (PixelF -> Pixel16) -> (PixelF -> PixelF) -> PixelF -> Pixel16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelF
65535PixelF -> PixelF -> PixelF
forall a. Num a => a -> a -> a
*) (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
max PixelF
0 (PixelF -> PixelF) -> (PixelF -> PixelF) -> PixelF -> PixelF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PixelF -> PixelF -> PixelF
forall a. Ord a => a -> a -> a
min PixelF
1) Vector PixelF
Vector (PixelBaseComponent px1)
da

instance Decimable Pixel16 Pixel8 where
   decimateBitDepth :: Image Pixel16 -> Image Pixel8
decimateBitDepth = Image Pixel16 -> Image Pixel8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
 PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16

instance Decimable Pixel32 Pixel16 where
   decimateBitDepth :: Image Pixel32 -> Image Pixel16
decimateBitDepth = Image Pixel32 -> Image Pixel16
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel32,
 PixelBaseComponent px2 ~ Pixel16) =>
Image px1 -> Image px2
decimateWord3216

instance Decimable Pixel32 Pixel8 where
   decimateBitDepth :: Image Pixel32 -> Image Pixel8
decimateBitDepth = Image Pixel32 -> Image Pixel8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel32,
 PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord32

instance Decimable PixelYA16 PixelYA8 where
   decimateBitDepth :: Image PixelYA16 -> Image PixelYA8
decimateBitDepth = Image PixelYA16 -> Image PixelYA8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
 PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16

instance Decimable PixelRGB16 PixelRGB8 where
   decimateBitDepth :: Image PixelRGB16 -> Image PixelRGB8
decimateBitDepth = Image PixelRGB16 -> Image PixelRGB8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
 PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16

instance Decimable PixelRGBA16 PixelRGBA8 where
   decimateBitDepth :: Image PixelRGBA16 -> Image PixelRGBA8
decimateBitDepth = Image PixelRGBA16 -> Image PixelRGBA8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
 PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16

instance Decimable PixelCMYK16 PixelCMYK8 where
   decimateBitDepth :: Image PixelCMYK16 -> Image PixelCMYK8
decimateBitDepth = Image PixelCMYK16 -> Image PixelCMYK8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ Pixel16,
 PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateWord16

instance Decimable PixelF Pixel8 where
   decimateBitDepth :: Image PixelF -> Image Pixel8
decimateBitDepth = Image PixelF -> Image Pixel8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
 PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateFloat

instance Decimable PixelF Pixel16 where
   decimateBitDepth :: Image PixelF -> Image Pixel16
decimateBitDepth = Image PixelF -> Image Pixel16
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
 PixelBaseComponent px2 ~ Pixel16) =>
Image px1 -> Image px2
decimateFloat16

instance Decimable PixelRGBF PixelRGB8 where
   decimateBitDepth :: Image PixelRGBF -> Image PixelRGB8
decimateBitDepth = Image PixelRGBF -> Image PixelRGB8
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
 PixelBaseComponent px2 ~ Pixel8) =>
Image px1 -> Image px2
decimateFloat

instance Decimable PixelRGBF PixelRGB16 where
   decimateBitDepth :: Image PixelRGBF -> Image PixelRGB16
decimateBitDepth = Image PixelRGBF -> Image PixelRGB16
forall px1 px2.
(Pixel px1, Pixel px2, PixelBaseComponent px1 ~ PixelF,
 PixelBaseComponent px2 ~ Pixel16) =>
Image px1 -> Image px2
decimateFloat16

-- | Convert by any means possible a dynamic image to an image

-- in RGBA. The process can lose precision while converting from

-- 16bits pixels or Floating point pixels.

convertRGBA8 :: DynamicImage -> Image PixelRGBA8
convertRGBA8 :: DynamicImage -> Image PixelRGBA8
convertRGBA8 DynamicImage
dynImage = case DynamicImage
dynImage of
  ImageY8     Image Pixel8
img -> Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel8
img
  ImageY16    Image Pixel16
img -> Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel16 -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel16
img :: Image Pixel8)
  ImageY32    Image Pixel32
img -> Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel32 -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel32
img :: Image Pixel8)
  ImageYF     Image PixelF
img -> Image Pixel8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelF -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelF
img :: Image Pixel8)
  ImageYA8    Image PixelYA8
img -> Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
img
  ImageYA16   Image PixelYA16
img -> Image PixelYA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYA16 -> Image PixelYA8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelYA16
img :: Image PixelYA8)
  ImageRGB8   Image PixelRGB8
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGB8
img
  ImageRGB16  Image PixelRGB16
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelRGB16 -> Image PixelRGB8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGB16
img :: Image PixelRGB8)
  ImageRGBF   Image PixelRGBF
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelRGBF -> Image PixelRGB8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBF
img :: Image PixelRGB8)
  ImageRGBA8  Image PixelRGBA8
img -> Image PixelRGBA8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGBA8
img
  ImageRGBA16 Image PixelRGBA16
img -> Image PixelRGBA16 -> Image PixelRGBA8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBA16
img
  ImageYCbCr8 Image PixelYCbCr8
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img :: Image PixelRGB8)
  ImageCMYK8  Image PixelCMYK8
img -> Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img :: Image PixelRGB8)
  ImageCMYK16 Image PixelCMYK16
img ->
    Image PixelRGB8 -> Image PixelRGBA8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage (Image PixelCMYK16 -> Image PixelCMYK8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelCMYK16
img :: Image PixelCMYK8) :: Image PixelRGB8)

-- | Convert by any means possible a dynamic image to an image

-- in RGB. The process can lose precision while converting from

-- 16bits pixels or Floating point pixels. Any alpha layer will

-- be dropped

convertRGB8 :: DynamicImage -> Image PixelRGB8
convertRGB8 :: DynamicImage -> Image PixelRGB8
convertRGB8 DynamicImage
dynImage = case DynamicImage
dynImage of
  ImageY8     Image Pixel8
img -> Image Pixel8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel8
img
  ImageY16    Image Pixel16
img -> Image Pixel8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel16 -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel16
img :: Image Pixel8)
  ImageY32    Image Pixel32
img -> Image Pixel8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel32 -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel32
img :: Image Pixel8)
  ImageYF     Image PixelF
img -> Image Pixel8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelF -> Image Pixel8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelF
img :: Image Pixel8)
  ImageYA8    Image PixelYA8
img -> Image PixelYA8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
img
  ImageYA16   Image PixelYA16
img -> Image PixelYA8 -> Image PixelRGB8
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYA16 -> Image PixelYA8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelYA16
img :: Image PixelYA8)
  ImageRGB8   Image PixelRGB8
img -> Image PixelRGB8
img
  ImageRGB16  Image PixelRGB16
img -> Image PixelRGB16 -> Image PixelRGB8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGB16
img
  ImageRGBF   Image PixelRGBF
img -> Image PixelRGBF -> Image PixelRGB8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBF
img :: Image PixelRGB8
  ImageRGBA8  Image PixelRGBA8
img -> Image PixelRGBA8 -> Image PixelRGB8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelRGBA8
img
  ImageRGBA16 Image PixelRGBA16
img -> Image PixelRGBA8 -> Image PixelRGB8
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer (Image PixelRGBA16 -> Image PixelRGBA8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBA16
img :: Image PixelRGBA8)
  ImageYCbCr8 Image PixelYCbCr8
img -> Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img
  ImageCMYK8  Image PixelCMYK8
img -> Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img
  ImageCMYK16 Image PixelCMYK16
img -> Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage (Image PixelCMYK16 -> Image PixelCMYK8
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelCMYK16
img :: Image PixelCMYK8)
  
-- | Convert by any means possible a dynamic image to an image

-- in RGB. The process can lose precision while converting from

-- 32bits pixels or Floating point pixels. Any alpha layer will

-- be dropped

convertRGB16 :: DynamicImage -> Image PixelRGB16
convertRGB16 :: DynamicImage -> Image PixelRGB16
convertRGB16 DynamicImage
dynImage = case DynamicImage
dynImage of
  ImageY8     Image Pixel8
img -> Image Pixel8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel8
img
  ImageY16    Image Pixel16
img -> Image Pixel16 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image Pixel16
img
  ImageY32    Image Pixel32
img -> Image Pixel16 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image Pixel32 -> Image Pixel16
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image Pixel32
img :: Image Pixel16)
  ImageYF     Image PixelF
img -> Image Pixel16 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelF -> Image Pixel16
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelF
img :: Image Pixel16)
  ImageYA8    Image PixelYA8
img -> Image PixelYA8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA8
img
  ImageYA16   Image PixelYA16
img -> Image PixelYA16 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelYA16
img
  ImageRGB8   Image PixelRGB8
img -> Image PixelRGB8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGB8
img
  ImageRGB16  Image PixelRGB16
img -> Image PixelRGB16
img
  ImageRGBF   Image PixelRGBF
img -> Image PixelRGBF -> Image PixelRGB16
forall px1 px2. Decimable px1 px2 => Image px1 -> Image px2
decimateBitDepth Image PixelRGBF
img :: Image PixelRGB16
  ImageRGBA8  Image PixelRGBA8
img -> Image PixelRGBA16 -> Image PixelRGB16
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer (Image PixelRGBA8 -> Image PixelRGBA16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage Image PixelRGBA8
img :: Image PixelRGBA16)
  ImageRGBA16 Image PixelRGBA16
img -> Image PixelRGBA16 -> Image PixelRGB16
forall a b. TransparentPixel a b => Image a -> Image b
dropAlphaLayer Image PixelRGBA16
img
  ImageYCbCr8 Image PixelYCbCr8
img -> Image PixelRGB8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelYCbCr8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelYCbCr8
img :: Image PixelRGB8)
  ImageCMYK8  Image PixelCMYK8
img -> Image PixelRGB8 -> Image PixelRGB16
forall a b. ColorConvertible a b => Image a -> Image b
promoteImage (Image PixelCMYK8 -> Image PixelRGB8
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK8
img :: Image PixelRGB8)
  ImageCMYK16 Image PixelCMYK16
img -> Image PixelCMYK16 -> Image PixelRGB16
forall a b. ColorSpaceConvertible a b => Image a -> Image b
convertImage Image PixelCMYK16
img

-- | Equivalent to 'decodeImage', but also provide potential metadatas

-- present in the given file and the palettes if the format provides them.

decodeImageWithPaletteAndMetadata :: B.ByteString -> Either String (PalettedImage, Metadatas)
decodeImageWithPaletteAndMetadata :: ByteString -> Either String (PalettedImage, Metadatas)
decodeImageWithPaletteAndMetadata ByteString
str = ByteString
-> [(String,
     ByteString -> Either String (PalettedImage, Metadatas))]
-> Either String (PalettedImage, Metadatas)
forall c b.
c -> [(String, c -> Either String b)] -> Either String b
eitherLoad ByteString
str
    [ (String
"Jpeg", ((DynamicImage, Metadatas) -> (PalettedImage, Metadatas))
-> Either String (DynamicImage, Metadatas)
-> Either String (PalettedImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DynamicImage -> PalettedImage)
-> (DynamicImage, Metadatas) -> (PalettedImage, Metadatas)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first DynamicImage -> PalettedImage
TrueColorImage) (Either String (DynamicImage, Metadatas)
 -> Either String (PalettedImage, Metadatas))
-> (ByteString -> Either String (DynamicImage, Metadatas))
-> ByteString
-> Either String (PalettedImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (DynamicImage, Metadatas)
decodeJpegWithMetadata)
    , (String
"PNG", ByteString -> Either String (PalettedImage, Metadatas)
decodePngWithPaletteAndMetadata)
    , (String
"Bitmap", ByteString -> Either String (PalettedImage, Metadatas)
decodeBitmapWithPaletteAndMetadata)
    , (String
"GIF", ByteString -> Either String (PalettedImage, Metadatas)
decodeGifWithPaletteAndMetadata)
    , (String
"HDR", ((DynamicImage, Metadatas) -> (PalettedImage, Metadatas))
-> Either String (DynamicImage, Metadatas)
-> Either String (PalettedImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DynamicImage -> PalettedImage)
-> (DynamicImage, Metadatas) -> (PalettedImage, Metadatas)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first DynamicImage -> PalettedImage
TrueColorImage) (Either String (DynamicImage, Metadatas)
 -> Either String (PalettedImage, Metadatas))
-> (ByteString -> Either String (DynamicImage, Metadatas))
-> ByteString
-> Either String (PalettedImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (DynamicImage, Metadatas)
decodeHDRWithMetadata)
    , (String
"Tiff", ByteString -> Either String (PalettedImage, Metadatas)
decodeTiffWithPaletteAndMetadata)
    , (String
"TGA", ByteString -> Either String (PalettedImage, Metadatas)
decodeTgaWithPaletteAndMetadata)
    ]

-- | Equivalent to 'decodeImage', but also provide potential metadatas

-- present in the given file.

decodeImageWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata :: ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata =
    ((PalettedImage, Metadatas) -> (DynamicImage, Metadatas))
-> Either String (PalettedImage, Metadatas)
-> Either String (DynamicImage, Metadatas)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PalettedImage -> DynamicImage)
-> (PalettedImage, Metadatas) -> (DynamicImage, Metadatas)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first PalettedImage -> DynamicImage
palettedToTrueColor) (Either String (PalettedImage, Metadatas)
 -> Either String (DynamicImage, Metadatas))
-> (ByteString -> Either String (PalettedImage, Metadatas))
-> ByteString
-> Either String (DynamicImage, Metadatas)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (PalettedImage, Metadatas)
decodeImageWithPaletteAndMetadata

-- | Helper function trying to load a png file from a file on disk.

readPng :: FilePath -> IO (Either String DynamicImage)
readPng :: String -> IO (Either String DynamicImage)
readPng = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodePng

-- | Helper function trying to load a gif file from a file on disk.

readGif :: FilePath -> IO (Either String DynamicImage)
readGif :: String -> IO (Either String DynamicImage)
readGif = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeGif

-- | Helper function trying to load tiff file from a file on disk.

readTiff :: FilePath -> IO (Either String DynamicImage)
readTiff :: String -> IO (Either String DynamicImage)
readTiff = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeTiff

-- | Helper function trying to load all the images of an animated

-- gif file.

readGifImages :: FilePath -> IO (Either String [DynamicImage])
readGifImages :: String -> IO (Either String [DynamicImage])
readGifImages = (ByteString -> Either String [DynamicImage])
-> String -> IO (Either String [DynamicImage])
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String [DynamicImage]
decodeGifImages

-- | Try to load a jpeg file and decompress. The colorspace is still

-- YCbCr if you want to perform computation on the luma part. You can

-- convert it to RGB using 'colorSpaceConversion'.

readJpeg :: FilePath -> IO (Either String DynamicImage)
readJpeg :: String -> IO (Either String DynamicImage)
readJpeg = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeJpeg

-- | Try to load a .bmp file. The colorspace would be RGB, RGBA or Y.

readBitmap :: FilePath -> IO (Either String DynamicImage)
readBitmap :: String -> IO (Either String DynamicImage)
readBitmap = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeBitmap

-- | Try to load a .pic file. The colorspace can only be

-- RGB with floating point precision.

readHDR :: FilePath -> IO (Either String DynamicImage)
readHDR :: String -> IO (Either String DynamicImage)
readHDR = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeHDR

-- | Try to load a .tga file from disk.

readTGA :: FilePath -> IO (Either String DynamicImage)
readTGA :: String -> IO (Either String DynamicImage)
readTGA = (ByteString -> Either String DynamicImage)
-> String -> IO (Either String DynamicImage)
forall a.
NFData a =>
(ByteString -> Either String a) -> String -> IO (Either String a)
withImageDecoder ByteString -> Either String DynamicImage
decodeTga

-- | Save an image to a '.jpg' file, will do everything it can to save an image.

saveJpgImage :: Int -> FilePath -> DynamicImage -> IO ()
saveJpgImage :: GifDelay -> String -> DynamicImage -> IO ()
saveJpgImage GifDelay
quality String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ GifDelay -> DynamicImage -> ByteString
imageToJpg GifDelay
quality DynamicImage
img

-- | Save an image to a '.gif' file, will do everything it can to save it.

saveGifImage :: FilePath -> DynamicImage -> Either String (IO ())
saveGifImage :: String -> DynamicImage -> Either String (IO ())
saveGifImage String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ())
-> Either String ByteString -> Either String (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DynamicImage -> Either String ByteString
imageToGif DynamicImage
img

-- | Save an image to a '.tiff' file, will do everything it can to save an image.

saveTiffImage :: FilePath -> DynamicImage -> IO ()
saveTiffImage :: String -> DynamicImage -> IO ()
saveTiffImage String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicImage -> ByteString
imageToTiff DynamicImage
img

-- | Save an image to a '.hdr' file, will do everything it can to save an image.

saveRadianceImage :: FilePath -> DynamicImage -> IO ()
saveRadianceImage :: String -> DynamicImage -> IO ()
saveRadianceImage String
path = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ())
-> (DynamicImage -> ByteString) -> DynamicImage -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicImage -> ByteString
imageToRadiance

-- | Save an image to a '.png' file, will do everything it can to save an image.

-- For example, a simple transcoder to png

--

-- > transcodeToPng :: FilePath -> FilePath -> IO ()

-- > transcodeToPng pathIn pathOut = do

-- >    eitherImg <- readImage pathIn

-- >    case eitherImg of

-- >        Left _ -> return ()

-- >        Right img -> savePngImage pathOut img

--

savePngImage :: FilePath -> DynamicImage -> IO ()
savePngImage :: String -> DynamicImage -> IO ()
savePngImage String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicImage -> ByteString
imageToPng DynamicImage
img

-- | Save an image to a '.bmp' file, will do everything it can to save an image.

saveBmpImage :: FilePath -> DynamicImage -> IO ()
saveBmpImage :: String -> DynamicImage -> IO ()
saveBmpImage String
path DynamicImage
img = String -> ByteString -> IO ()
L.writeFile String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ DynamicImage -> ByteString
imageToBitmap DynamicImage
img