{-# 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 v = inner ""
    where inner errAcc [] = Left $ "Cannot load file\n" ++ errAcc
          inner errAcc ((hdr, f) : rest) = case f v of
                Left  err  -> inner (errAcc ++ hdr ++ " " ++ err ++ "\n") rest
                Right rez  -> Right 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 img = encodeGifImageWithPalette indexed pal
  where (indexed, pal) = palettize defaultPaletteOptions 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 path img =
    L.writeFile path <$> encodeColorReducedGifImage 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 delay looping lst =
    encodeGifImages looping
        [(pal, delay, img)
                | (img, pal) <- palettize defaultPaletteOptions <$> lst]

-- | Helper function to write a gif animation on disk.
-- See encodeGifAnimation
writeGifAnimation :: FilePath -> GifDelay -> GifLooping
                  -> [Image PixelRGB8] -> Either String (IO ())
writeGifAnimation path delay looping img =
    L.writeFile path <$> encodeGifAnimation delay looping img

withImageDecoder :: (NFData a)
                 => (B.ByteString -> Either String a) -> FilePath
                 -> IO (Either String a)
withImageDecoder decoder path = Exc.catch doit
                    (\e -> return . Left $ show (e :: Exc.IOException))
    where doit = force . decoder <$> get
#ifdef WITH_MMAP_BYTESTRING
          get = mmapFileByteString path Nothing
#else
          get = B.readFile path
#endif
          -- force appeared in deepseq 1.3, Haskell Platform
          -- provides 1.1
          force x = x `deepseq` x

-- | Load an image file without even thinking about it, it does everything
-- as 'decodeImage'
readImage :: FilePath -> IO (Either String DynamicImage)
readImage = withImageDecoder decodeImage

-- | Equivalent to 'readImage'  but also providing metadatas.
readImageWithMetadata :: FilePath -> IO (Either String (DynamicImage, Metadatas))
readImageWithMetadata = withImageDecoder 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 = fmap fst . 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 w h da) =
  Image w h $ VS.map (\v -> fromIntegral $ v `unsafeShiftR` 8) da

decimateWord3216 :: ( Pixel px1, Pixel px2
                  , PixelBaseComponent px1 ~ Pixel32
                  , PixelBaseComponent px2 ~ Pixel16
                  ) => Image px1 -> Image px2
decimateWord3216 (Image w h da) =
  Image w h $ VS.map (\v -> fromIntegral $ v `unsafeShiftR` 16) da

decimateWord32 :: ( Pixel px1, Pixel px2
                  , PixelBaseComponent px1 ~ Pixel32
                  , PixelBaseComponent px2 ~ Pixel8
                  ) => Image px1 -> Image px2
decimateWord32 (Image w h da) =
  Image w h $ VS.map (\v -> fromIntegral $ v `unsafeShiftR` 24) da

decimateFloat :: ( Pixel px1, Pixel px2
                 , PixelBaseComponent px1 ~ PixelF
                 , PixelBaseComponent px2 ~ Pixel8
                 ) => Image px1 -> Image px2
decimateFloat (Image w h da) =
  Image w h $ VS.map (floor . (255*) . max 0 . min 1) da

decimateFloat16 :: ( Pixel px1, Pixel px2
                 , PixelBaseComponent px1 ~ PixelF
                 , PixelBaseComponent px2 ~ Pixel16
                 ) => Image px1 -> Image px2
decimateFloat16 (Image w h da) =
  Image w h $ VS.map (floor . (65535*) . max 0 . min 1) da

instance Decimable Pixel16 Pixel8 where
   decimateBitDepth = decimateWord16

instance Decimable Pixel32 Pixel16 where
   decimateBitDepth = decimateWord3216

instance Decimable Pixel32 Pixel8 where
   decimateBitDepth = decimateWord32

instance Decimable PixelYA16 PixelYA8 where
   decimateBitDepth = decimateWord16

instance Decimable PixelRGB16 PixelRGB8 where
   decimateBitDepth = decimateWord16

instance Decimable PixelRGBA16 PixelRGBA8 where
   decimateBitDepth = decimateWord16

instance Decimable PixelCMYK16 PixelCMYK8 where
   decimateBitDepth = decimateWord16

instance Decimable PixelF Pixel8 where
   decimateBitDepth = decimateFloat

instance Decimable PixelF Pixel16 where
   decimateBitDepth = decimateFloat16

instance Decimable PixelRGBF PixelRGB8 where
   decimateBitDepth = decimateFloat

instance Decimable PixelRGBF PixelRGB16 where
   decimateBitDepth = 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 dynImage = case dynImage of
  ImageY8     img -> promoteImage img
  ImageY16    img -> promoteImage (decimateBitDepth img :: Image Pixel8)
  ImageY32    img -> promoteImage (decimateBitDepth img :: Image Pixel8)
  ImageYF     img -> promoteImage (decimateBitDepth img :: Image Pixel8)
  ImageYA8    img -> promoteImage img
  ImageYA16   img -> promoteImage (decimateBitDepth img :: Image PixelYA8)
  ImageRGB8   img -> promoteImage img
  ImageRGB16  img -> promoteImage (decimateBitDepth img :: Image PixelRGB8)
  ImageRGBF   img -> promoteImage (decimateBitDepth img :: Image PixelRGB8)
  ImageRGBA8  img -> promoteImage img
  ImageRGBA16 img -> decimateBitDepth img
  ImageYCbCr8 img -> promoteImage (convertImage img :: Image PixelRGB8)
  ImageCMYK8  img -> promoteImage (convertImage img :: Image PixelRGB8)
  ImageCMYK16 img ->
    promoteImage (convertImage (decimateBitDepth 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 dynImage = case dynImage of
  ImageY8     img -> promoteImage img
  ImageY16    img -> promoteImage (decimateBitDepth img :: Image Pixel8)
  ImageY32    img -> promoteImage (decimateBitDepth img :: Image Pixel8)
  ImageYF     img -> promoteImage (decimateBitDepth img :: Image Pixel8)
  ImageYA8    img -> promoteImage img
  ImageYA16   img -> promoteImage (decimateBitDepth img :: Image PixelYA8)
  ImageRGB8   img -> img
  ImageRGB16  img -> decimateBitDepth img
  ImageRGBF   img -> decimateBitDepth img :: Image PixelRGB8
  ImageRGBA8  img -> dropAlphaLayer img
  ImageRGBA16 img -> dropAlphaLayer (decimateBitDepth img :: Image PixelRGBA8)
  ImageYCbCr8 img -> convertImage img
  ImageCMYK8  img -> convertImage img
  ImageCMYK16 img -> convertImage (decimateBitDepth 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 dynImage = case dynImage of
  ImageY8     img -> promoteImage img
  ImageY16    img -> promoteImage img
  ImageY32    img -> promoteImage (decimateBitDepth img :: Image Pixel16)
  ImageYF     img -> promoteImage (decimateBitDepth img :: Image Pixel16)
  ImageYA8    img -> promoteImage img
  ImageYA16   img -> promoteImage img
  ImageRGB8   img -> promoteImage img
  ImageRGB16  img -> img
  ImageRGBF   img -> decimateBitDepth img :: Image PixelRGB16
  ImageRGBA8  img -> dropAlphaLayer (promoteImage img :: Image PixelRGBA16)
  ImageRGBA16 img -> dropAlphaLayer img
  ImageYCbCr8 img -> promoteImage (convertImage img :: Image PixelRGB8)
  ImageCMYK8  img -> promoteImage (convertImage img :: Image PixelRGB8)
  ImageCMYK16 img -> convertImage 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 str = eitherLoad str
    [ ("Jpeg", fmap (first TrueColorImage) . decodeJpegWithMetadata)
    , ("PNG", decodePngWithPaletteAndMetadata)
    , ("Bitmap", decodeBitmapWithPaletteAndMetadata)
    , ("GIF", decodeGifWithPaletteAndMetadata)
    , ("HDR", fmap (first TrueColorImage) . decodeHDRWithMetadata)
    , ("Tiff", decodeTiffWithPaletteAndMetadata)
    , ("TGA", decodeTgaWithPaletteAndMetadata)
    ]

-- | Equivalent to 'decodeImage', but also provide potential metadatas
-- present in the given file.
decodeImageWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
decodeImageWithMetadata =
    fmap (first palettedToTrueColor) . decodeImageWithPaletteAndMetadata

-- | Helper function trying to load a png file from a file on disk.
readPng :: FilePath -> IO (Either String DynamicImage)
readPng = withImageDecoder decodePng

-- | Helper function trying to load a gif file from a file on disk.
readGif :: FilePath -> IO (Either String DynamicImage)
readGif = withImageDecoder decodeGif

-- | Helper function trying to load tiff file from a file on disk.
readTiff :: FilePath -> IO (Either String DynamicImage)
readTiff = withImageDecoder decodeTiff

-- | Helper function trying to load all the images of an animated
-- gif file.
readGifImages :: FilePath -> IO (Either String [DynamicImage])
readGifImages = withImageDecoder 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 = withImageDecoder decodeJpeg

-- | Try to load a .bmp file. The colorspace would be RGB, RGBA or Y.
readBitmap :: FilePath -> IO (Either String DynamicImage)
readBitmap = withImageDecoder decodeBitmap

-- | Try to load a .pic file. The colorspace can only be
-- RGB with floating point precision.
readHDR :: FilePath -> IO (Either String DynamicImage)
readHDR = withImageDecoder decodeHDR

-- | Try to load a .tga file from disk.
readTGA :: FilePath -> IO (Either String DynamicImage)
readTGA = withImageDecoder decodeTga

-- | Save an image to a '.jpg' file, will do everything it can to save an image.
saveJpgImage :: Int -> FilePath -> DynamicImage -> IO ()
saveJpgImage quality path img = L.writeFile path $ imageToJpg quality img

-- | Save an image to a '.gif' file, will do everything it can to save it.
saveGifImage :: FilePath -> DynamicImage -> Either String (IO ())
saveGifImage path img = L.writeFile path <$> imageToGif img

-- | Save an image to a '.tiff' file, will do everything it can to save an image.
saveTiffImage :: FilePath -> DynamicImage -> IO ()
saveTiffImage path img = L.writeFile path $ imageToTiff img

-- | Save an image to a '.hdr' file, will do everything it can to save an image.
saveRadianceImage :: FilePath -> DynamicImage -> IO ()
saveRadianceImage path = L.writeFile path . 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 path img = L.writeFile path $ imageToPng img

-- | Save an image to a '.bmp' file, will do everything it can to save an image.
saveBmpImage :: FilePath -> DynamicImage -> IO ()
saveBmpImage path img = L.writeFile path $ imageToBitmap img