    {-# LANGUAGE CPP #-}
    -- | Low level png module, you should import 'Codec.Picture.Png.Internal' instead.
    module Codec.Picture.Png.Internal.Type( PngIHdr( .. )
                                 , PngFilter( .. )
                                 , PngInterlaceMethod( .. )
                                 , PngPalette
                                 , PngImageType( .. )
                                 , PngPhysicalDimension( .. )
                                 , PngGamma( .. )
                                 , PngUnit( .. )
                                 , APngAnimationControl( .. )
                                 , APngFrameDisposal( .. )
                                 , APngBlendOp( .. )
                                 , APngFrameControl( .. )
                                 , parsePalette
                                 , pngComputeCrc
                                 , pLTESignature
                                 , iDATSignature
                                 , iENDSignature
                                 , tRNSSignature
                                 , tEXtSignature
                                 , zTXtSignature
                                 , gammaSignature
                                 , pHYsSignature
                                 , animationControlSignature
                                 -- * Low level types
                                 , ChunkSignature
                                 , PngRawImage( .. )
                                 , PngChunk( .. )
                                 , PngRawChunk( .. )
                                 , PngLowLevel( .. )
                                 , chunksWithSig
                                 , mkRawChunk
                                 ) where

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

    import Control.Monad( when, replicateM )
    import Data.Bits( xor, (.&.), unsafeShiftR )
    import Data.Binary( Binary(..), Get, get )
    import Data.Binary.Get( getWord8
                          , getWord32be
                          , getLazyByteString
                          )
    import Data.Binary.Put( runPut
                          , putWord8
                          , putWord32be
                          , putLazyByteString
                          )
    import Data.Vector.Unboxed( Vector, fromListN, (!) )
    import qualified Data.Vector.Storable as V
    import Data.List( foldl' )
    import Data.Word( Word32, Word16, Word8 )
    import qualified Data.ByteString.Lazy as L
    import qualified Data.ByteString.Lazy.Char8 as LS

    import Codec.Picture.Types
    import Codec.Picture.InternalHelper

    --------------------------------------------------
    ----            Types
    --------------------------------------------------

    -- | Value used to identify a png chunk, must be 4 bytes long.
    type ChunkSignature = L.ByteString

    -- | Generic header used in PNG images.
    data PngIHdr = PngIHdr
        { width             :: !Word32       -- ^ Image width in number of pixel
        , height            :: !Word32       -- ^ Image height in number of pixel
        , bitDepth          :: !Word8        -- ^ Number of bit per sample
        , colourType        :: !PngImageType -- ^ Kind of png image (greyscale, true color, indexed...)
        , compressionMethod :: !Word8        -- ^ Compression method used
        , filterMethod      :: !Word8        -- ^ Must be 0
        , interlaceMethod   :: !PngInterlaceMethod   -- ^ If the image is interlaced (for progressive rendering)
        }
        deriving Show

    data PngUnit
        = PngUnitUnknown -- ^ 0 value
        | PngUnitMeter   -- ^ 1 value

    instance Binary PngUnit where
      get = do
        v <- getWord8
        pure $ case v of
          0 -> PngUnitUnknown
          1 -> PngUnitMeter
          _ -> PngUnitUnknown

      put v = case v of
        PngUnitUnknown -> putWord8 0
        PngUnitMeter -> putWord8 1

    data PngPhysicalDimension = PngPhysicalDimension
        { pngDpiX     :: !Word32
        , pngDpiY     :: !Word32
        , pngUnit     :: !PngUnit
        }

    instance Binary PngPhysicalDimension where
      get = PngPhysicalDimension <$> getWord32be <*> getWord32be <*> get
      put (PngPhysicalDimension dpx dpy unit) =
        putWord32be dpx >> putWord32be dpy >> put unit

    newtype PngGamma = PngGamma { getPngGamma :: Double }

    instance Binary PngGamma where
      get = PngGamma . (/ 100000) . fromIntegral <$> getWord32be
      put = putWord32be . ceiling . (100000 *) . getPngGamma

    data APngAnimationControl = APngAnimationControl
        { animationFrameCount :: !Word32
        , animationPlayCount  :: !Word32
        }
        deriving Show

    -- | Encoded in a Word8
    data APngFrameDisposal
          -- | No disposal is done on this frame before rendering the
          -- next; the contents of the output buffer are left as is.
          -- Has Value 0
        = APngDisposeNone
          -- | The frame's region of the output buffer is to be cleared
          -- to fully transparent black before rendering the next frame.
          -- Has Value 1
        | APngDisposeBackground
          -- | the frame's region of the output buffer is to be reverted
          -- to the previous contents before rendering the next frame.
          -- Has Value 2
        | APngDisposePrevious
        deriving Show

    -- | Encoded in a Word8
    data APngBlendOp
          -- | Overwrite output buffer. has value '0'
        = APngBlendSource
          -- | Alpha blend to the output buffer. Has value '1'
        | APngBlendOver
        deriving Show

    data APngFrameControl = APngFrameControl
        { frameSequenceNum      :: !Word32 -- ^ Starting from 0
        , frameWidth            :: !Word32 -- ^ Width of the following frame
        , frameHeight           :: !Word32 -- ^ Height of the following frame
        , frameLeft             :: !Word32 -- X position where to render the frame.
        , frameTop              :: !Word32 -- Y position where to render the frame.
        , frameDelayNumerator   :: !Word16
        , frameDelayDenuminator :: !Word16
        , frameDisposal         :: !APngFrameDisposal
        , frameBlending         :: !APngBlendOp
        }
        deriving Show

    -- | What kind of information is encoded in the IDAT section
    -- of the PngFile
    data PngImageType =
          PngGreyscale
        | PngTrueColour
        | PngIndexedColor
        | PngGreyscaleWithAlpha
        | PngTrueColourWithAlpha
        deriving Show

    -- | Raw parsed image which need to be decoded.
    data PngRawImage = PngRawImage
        { header       :: PngIHdr
        , chunks       :: [PngRawChunk]
        }

    -- | Palette with indices beginning at 0 to elemcount - 1
    type PngPalette = Palette' PixelRGB8

    -- | Parse a palette from a png chunk.
    parsePalette :: PngRawChunk -> Either String PngPalette
    parsePalette plte
     | chunkLength plte `mod` 3 /= 0 = Left "Invalid palette size"
     | otherwise = Palette' pixelCount . V.fromListN (3 * pixelCount) <$> pixels
        where pixelUnpacker = replicateM (fromIntegral pixelCount * 3) get
              pixelCount = fromIntegral $ chunkLength plte `div` 3
              pixels = runGet pixelUnpacker (chunkData plte)

    -- | Data structure during real png loading/parsing
    data PngRawChunk = PngRawChunk
        { chunkLength :: Word32
        , chunkType   :: ChunkSignature
        , chunkCRC    :: Word32
        , chunkData   :: L.ByteString
        }

    mkRawChunk :: ChunkSignature -> L.ByteString -> PngRawChunk
    mkRawChunk sig binaryData = PngRawChunk
      { chunkLength = fromIntegral $ L.length binaryData
      , chunkType   = sig
      , chunkCRC    = pngComputeCrc [sig, binaryData]
      , chunkData   = binaryData
      }

    -- | PNG chunk representing some extra information found in the parsed file.
    data PngChunk = PngChunk
        { pngChunkData        :: L.ByteString  -- ^ The raw data inside the chunk
        , pngChunkSignature   :: ChunkSignature -- ^ The name of the chunk.
        }

    -- | Low level access to PNG information
    data PngLowLevel a = PngLowLevel
        { pngImage  :: Image a      -- ^ The real uncompressed image
        , pngChunks :: [PngChunk]   -- ^ List of raw chunk where some user data might be present.
        }

    -- | The pixels value should be :
    -- +---+---+
    -- | c | b |
    -- +---+---+
    -- | a | x |
    -- +---+---+
    -- x being the current filtered pixel
    data PngFilter =
        -- | Filt(x) = Orig(x), Recon(x) = Filt(x)
          FilterNone
        -- | Filt(x) = Orig(x) - Orig(a),     Recon(x) = Filt(x) + Recon(a)
        | FilterSub
        -- | Filt(x) = Orig(x) - Orig(b),     Recon(x) = Filt(x) + Recon(b)
        | FilterUp
        -- | Filt(x) = Orig(x) - floor((Orig(a) + Orig(b)) / 2),
        -- Recon(x) = Filt(x) + floor((Recon(a) + Recon(b)) / 2)
        | FilterAverage
        -- | Filt(x) = Orig(x) - PaethPredictor(Orig(a), Orig(b), Orig(c)),
        -- Recon(x) = Filt(x) + PaethPredictor(Recon(a), Recon(b), Recon(c))
        | FilterPaeth
        deriving (Enum, Show)

    -- | Different known interlace methods for PNG image
    data PngInterlaceMethod =
          -- | No interlacing, basic data ordering, line by line
          -- from left to right.
          PngNoInterlace

          -- | Use the Adam7 ordering, see `adam7Reordering`
        | PngInterlaceAdam7
        deriving (Enum, Show)

    --------------------------------------------------
    ----            Instances
    --------------------------------------------------
    instance Binary PngFilter where
        put = putWord8 . toEnum . fromEnum
        get = getWord8 >>= \w -> case w of
            0 -> return FilterNone
            1 -> return FilterSub
            2 -> return FilterUp
            3 -> return FilterAverage
            4 -> return FilterPaeth
            _ -> fail "Invalid scanline filter"

    instance Binary PngRawImage where
        put img = do
            putLazyByteString pngSignature
            put $ header img
            mapM_ put $ chunks img

        get = parseRawPngImage

    instance Binary PngRawChunk where
        put chunk = do
            putWord32be $ chunkLength chunk
            putLazyByteString $ chunkType chunk
            when (chunkLength chunk /= 0)
                 (putLazyByteString $ chunkData chunk)
            putWord32be $ chunkCRC chunk

        get = do
            size <- getWord32be
            chunkSig <- getLazyByteString (fromIntegral $ L.length iHDRSignature)
            imgData <- if size == 0
                then return L.empty
                else getLazyByteString (fromIntegral size)
            crc <- getWord32be

            let computedCrc = pngComputeCrc [chunkSig, imgData]
            when (computedCrc `xor` crc /= 0)
                 (fail $ "Invalid CRC : " ++ show computedCrc ++ ", "
                                          ++ show crc)
            return PngRawChunk {
                chunkLength = size,
                chunkData = imgData,
                chunkCRC = crc,
                chunkType = chunkSig
            }

    instance Binary PngIHdr where
        put hdr = do
            putWord32be 13
            let inner = runPut $ do
                    putLazyByteString iHDRSignature
                    putWord32be $ width hdr
                    putWord32be $ height hdr
                    putWord8    $ bitDepth hdr
                    put $ colourType hdr
                    put $ compressionMethod hdr
                    put $ filterMethod hdr
                    put $ interlaceMethod hdr
                crc = pngComputeCrc [inner]
            putLazyByteString inner
            putWord32be crc

        get = do
            _size <- getWord32be
            ihdrSig <- getLazyByteString (L.length iHDRSignature)
            when (ihdrSig /= iHDRSignature)
                 (fail "Invalid PNG file, wrong ihdr")
            w <- getWord32be
            h <- getWord32be
            depth <- get
            colorType <- get
            compression <- get
            filtermethod <- get
            interlace <- get
            _crc <- getWord32be
            return PngIHdr {
                width = w,
                height = h,
                bitDepth = depth,
                colourType = colorType,
                compressionMethod = compression,
                filterMethod = filtermethod,
                interlaceMethod = interlace
            }

    -- | Parse method for a png chunk, without decompression.
    parseChunks :: Get [PngRawChunk]
    parseChunks = do
        chunk <- get

        if chunkType chunk == iENDSignature
           then return [chunk]
           else (chunk:) <$> parseChunks

    instance Binary PngInterlaceMethod where
        get = getWord8 >>= \w -> case w of
            0 -> return PngNoInterlace
            1 -> return PngInterlaceAdam7
            _ -> fail "Invalid interlace method"

        put PngNoInterlace    = putWord8 0
        put PngInterlaceAdam7 = putWord8 1

    -- | Implementation of the get method for the PngRawImage,
    -- unpack raw data, without decompressing it.
    parseRawPngImage :: Get PngRawImage
    parseRawPngImage = do
        sig <- getLazyByteString (L.length pngSignature)
        when (sig /= pngSignature)
             (fail "Invalid PNG file, signature broken")

        ihdr <- get

        chunkList <- parseChunks
        return PngRawImage { header = ihdr, chunks = chunkList }

    --------------------------------------------------
    ----            functions
    --------------------------------------------------

    -- | Signature signalling that the following data will be a png image
    -- in the png bit stream
    pngSignature :: ChunkSignature
    pngSignature = L.pack [137, 80, 78, 71, 13, 10, 26, 10]

    -- | Helper function to help pack signatures.
    signature :: String -> ChunkSignature
    signature = LS.pack

    -- | Signature for the header chunk of png (must be the first)
    iHDRSignature :: ChunkSignature
    iHDRSignature = signature "IHDR"

    -- | Signature for a palette chunk in the pgn file. Must
    -- occure before iDAT.
    pLTESignature :: ChunkSignature
    pLTESignature = signature "PLTE"

    -- | Signature for a data chuck (with image parts in it)
    iDATSignature :: ChunkSignature
    iDATSignature = signature "IDAT"

    -- | Signature for the last chunk of a png image, telling
    -- the end.
    iENDSignature :: ChunkSignature
    iENDSignature = signature "IEND"

    tRNSSignature :: ChunkSignature
    tRNSSignature = signature "tRNS"

    gammaSignature :: ChunkSignature
    gammaSignature = signature "gAMA"

    pHYsSignature :: ChunkSignature
    pHYsSignature = signature "pHYs"

    tEXtSignature :: ChunkSignature
    tEXtSignature = signature "tEXt"

    zTXtSignature :: ChunkSignature
    zTXtSignature = signature "zTXt"

    animationControlSignature :: ChunkSignature
    animationControlSignature = signature "acTL"

    instance Binary PngImageType where
        put PngGreyscale = putWord8 0
        put PngTrueColour = putWord8 2
        put PngIndexedColor = putWord8 3
        put PngGreyscaleWithAlpha = putWord8 4
        put PngTrueColourWithAlpha = putWord8 6

        get = get >>= imageTypeOfCode

    imageTypeOfCode :: Word8 -> Get PngImageType
    imageTypeOfCode 0 = return PngGreyscale
    imageTypeOfCode 2 = return PngTrueColour
    imageTypeOfCode 3 = return PngIndexedColor
    imageTypeOfCode 4 = return PngGreyscaleWithAlpha
    imageTypeOfCode 6 = return PngTrueColourWithAlpha
    imageTypeOfCode _ = fail "Invalid png color code"

    -- | From the Annex D of the png specification.
    pngCrcTable :: Vector Word32
    pngCrcTable = fromListN 256 [ foldl' updateCrcConstant c [zero .. 7] | c <- [0 .. 255] ]
        where zero = 0 :: Int -- To avoid defaulting to Integer
              updateCrcConstant c _ | c .&. 1 /= 0 = magicConstant `xor` (c `unsafeShiftR` 1)
                                    | otherwise = c `unsafeShiftR` 1
              magicConstant = 0xedb88320 :: Word32

    -- | Compute the CRC of a raw buffer, as described in annex D of the PNG
    -- specification.
    pngComputeCrc :: [L.ByteString] -> Word32
    pngComputeCrc = (0xFFFFFFFF `xor`) . L.foldl' updateCrc 0xFFFFFFFF . L.concat
        where updateCrc crc val =
                  let u32Val = fromIntegral val
                      lutVal = pngCrcTable ! (fromIntegral ((crc `xor` u32Val) .&. 0xFF))
                  in lutVal `xor` (crc `unsafeShiftR` 8)

    chunksWithSig :: PngRawImage -> ChunkSignature -> [LS.ByteString]
    chunksWithSig rawImg sig =
      [chunkData chunk | chunk <- chunks rawImg, chunkType chunk == sig]