Header.hs

{-|
Module : Codec.Picture.Png.Streaming.Header
Copyright : (c) Bradley Hardy 2016
License: LGPL3
Maintainer: bradleyhardy@live.com
Stability: experimental
Portability: non-portable

-}

{-# LANGUAGE RecordWildCards #-}
module Codec.Picture.Png.Streaming.Header
       ( HeaderData(..)
       , takeHeaderData
       , tryDecodeHeader
       )
       where

import           Codec.Picture.Png.Streaming.Core
import           Codec.Picture.Png.Streaming.Info
import           Codec.Picture.Png.Streaming.Util

import           Control.Monad (unless)
import           Control.Monad.Catch              (MonadThrow (..))

import qualified Data.ByteString                  as B
import qualified Data.Serialize                   as C
import           Data.Word                        (Word32)

import           Data.ByteString.Streaming        (ByteString)
import qualified Data.ByteString.Streaming        as Q
import           Streaming                        (Stream)
import qualified Streaming                        as S
import           Streaming.Prelude                (Of (..))

-- | Represents the header data of a PNG file in raw binary format.
data HeaderData =
  HeaderData
  { hdWidth             :: Word32
  , hdHeight            :: Word32
  , hdBitDepth          :: BitDepth
  , hdColourType        :: ColourType
  , hdCompressionMethod :: CompressionMethod
  , hdFilterMethod      :: FilterMethod
  , hdInterlaceMethod   :: InterlaceMethod
  }
  deriving (Show)

-- | Take the header data from the front of a stream and return the remainder.
-- Throws an 'UnexpectedChunk' exception if the first chunk isn't of type
-- "IHDR", or 'UnexpectedEOF' if the stream is empty.
takeHeaderData :: (MonadThrow m) => Stream (PNGChunk m) m r -> m (Of HeaderData (Stream (PNGChunk m) m r))
takeHeaderData input =
  do maybeChunk <- S.inspect input
     case maybeChunk of
       Left _ -> throwM UnexpectedEOF
       Right PNGChunk{..} ->
         do unless (chunkType == ctIHDR) (throwM (UnexpectedChunk chunkType))
            tryDecodeHeader chunkData

deserializeHeaderData :: B.ByteString -> Either String HeaderData
deserializeHeaderData = C.runGet $
  do hdWidth             <- C.getWord32be
     hdHeight            <- C.getWord32be
     hdBitDepth          <- C.getWord8
     hdColourType        <- C.getWord8
     hdCompressionMethod <- C.getWord8
     hdFilterMethod      <- C.getWord8
     hdInterlaceMethod   <- C.getWord8
     return HeaderData{..}

-- serializeHeaderData :: HeaderData -> B.ByteString
-- serializeHeaderData HeaderData{..} = C.runPut $
--   do C.putWord32be hdWidth
--      C.putWord32be hdHeight
--      C.putWord8 hdBitDepth
--      C.putWord8 hdColourType
--      C.putWord8 hdCompressionMethod
--      C.putWord8 hdFilterMethod
--      C.putWord8 hdInterlaceMethod

-- | Try to decode a PNG header from a ByteString, failing if it is of the wrong
-- length.
tryDecodeHeader
  :: MonadThrow m => ByteString m r -> m (Of HeaderData r)
tryDecodeHeader input =
  do (bytes :> rest) <- Q.toStrict $ Q.splitAt (fromIntegral ihdrLength) input
     res <- expectNull (BadChunkSize ctIHDR) rest
     parsed <- either (throwM . UnknownError) return (deserializeHeaderData bytes)
     return (parsed :> res)