content: {-# 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
                               , pngSignature
                               , iHDRSignature
                               , 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]
  
  