    -- | Reading and writing uncompressed BMP files.
    --
    --   Supports uncompressed 24bit RGB and 32bit RGBA
    --      WindowsV3, WindowsV4 and WindowsV5 formats.
    --
    --   We don't support the plain OS/2 BitmapCoreHeader
    --       and BitmapCoreHeader2 image headers, but I haven't yet seen one of
    --       these in the wild.
    --
    -- To write a file do something like:
    --
    --  > do let rgba   = Data.ByteString.pack [some list of Word8s]
    --  >    let bmp    = packRGBA32ToBMP width height rgba
    --  >    writeBMP fileName bmp
    --
    -- To read a file do something like:
    --
    --  > do Right bmp  <- readBMP fileName
    --  >    let rgba   =  unpackBMPToRGBA32 bmp
    --  >    let (width, height) = bmpDimensions bmp
    --  >    ...
    --
    -- Release Notes:
    --
    --  >  * bmp 1.2.5
    --  >    Add support for writing uncompressed 32-bit files.
    --  >
    --  >  * bmp 1.2.4
    --  >    Update to use binary 0.6.
    --  >
    --  >  * bmp 1.2.3
    --  >    Add pure parseBMP / renderBMP API.
    --  >
    --  >  * bmp 1.2.2
    --  >    Allow the physical image buffer to be larger than the image
    --  >     size stated in the header, to accept output of foolish Win7 codec.
    --
    module Codec.BMP
            ( -- * Data Structures
              BMP             (..)
            , FileHeader      (..)
            , BitmapInfo      (..)
            , BitmapInfoV3    (..)
            , BitmapInfoV4    (..)
            , BitmapInfoV5    (..)
            , Compression     (..)
            , CIEXYZ          (..)
            , Error           (..)

              -- * Reading
            , readBMP,  hGetBMP, parseBMP

              -- * Writing
            , writeBMP, hPutBMP, renderBMP

              -- * Pack and Unpack
            , packRGBA32ToBMP
            , packRGBA32ToBMP32
            , packRGBA32ToBMP24
            , unpackBMPToRGBA32
            , bmpDimensions)
    where
    import Codec.BMP.Base
    import Codec.BMP.Error
    import Codec.BMP.Unpack
    import Codec.BMP.Pack
    import Codec.BMP.FileHeader
    import Codec.BMP.BitmapInfo
    import Codec.BMP.BitmapInfoV3
    import Codec.BMP.BitmapInfoV4
    import Codec.BMP.BitmapInfoV5
    import System.IO
    import Data.ByteString.Lazy     as BSL
    import Data.Binary
    import Data.Binary.Get

    -- Reading --------------------------------------------------------------------
    -- | Read a BMP from a file.
    --      The file is checked for problems and unsupported features when read.
    --      If there is anything wrong this gives an `Error` instead.
    readBMP :: FilePath -> IO (Either Error BMP)
    readBMP :: FilePath -> IO (Either Error BMP)
    readBMP FilePath
    fileName
     = do   h       <- FilePath -> IOMode -> IO Handle
    openBinaryFile FilePath
    fileName IOMode
    ReadMode
            hGetBMP h

    -- | Get a BMP image from a file handle.
    hGetBMP :: Handle -> IO (Either Error BMP)
    hGetBMP :: Handle -> IO (Either Error BMP)
    hGetBMP Handle
    h
     = do   -- lazily load the whole file
            buf     <- Handle -> IO ByteString
    BSL.hGetContents Handle
    h
            return $ parseBMP buf

    -- | Parse a BMP image from a lazy `ByteString`
    parseBMP :: BSL.ByteString -> Either Error BMP
    parseBMP :: ByteString -> Either Error BMP
    parseBMP ByteString
    buf
     = let  -- split off the file header
            (ByteString
    bufFileHeader, ByteString
    bufRest)
                   = Int64 -> ByteString -> (ByteString, ByteString)
    BSL.splitAt (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    sizeOfFileHeader) ByteString
    buf

       in   if (Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    BSL.length ByteString
    bufFileHeader) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    sizeOfFileHeader
             then   Error -> Either Error BMP
    forall a b. a -> Either a b
    Left Error
    ErrorFileHeaderTruncated
             else   ByteString -> FileHeader -> Either Error BMP
    parseBMP2 ByteString
    bufRest (ByteString -> FileHeader
    forall a. Binary a => ByteString -> a
    decode ByteString
    bufFileHeader)

    parseBMP2 :: ByteString -> FileHeader -> Either Error BMP
    parseBMP2 ByteString
    buf FileHeader
    fileHeader
     -- Check the magic before doing anything else.
     | FileHeader -> Word16
    fileHeaderType FileHeader
    fileHeader Word16 -> Word16 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word16
    bmpMagic
     = Error -> Either Error BMP
    forall a b. a -> Either a b
    Left (Error -> Either Error BMP) -> Error -> Either Error BMP
    forall a b. (a -> b) -> a -> b
    $ Word16 -> Error
    ErrorBadMagic (FileHeader -> Word16
    fileHeaderType FileHeader
    fileHeader)

     | Bool
    otherwise
     = let  -- Next comes the image header.
            -- The first word tells us how long it is.
            sizeHeader :: Word32
    sizeHeader      = Get Word32 -> ByteString -> Word32
    forall a. Get a -> ByteString -> a
    runGet Get Word32
    getWord32le ByteString
    buf

            -- Split off the image header
            bufImageHeader :: ByteString
    bufImageHeader  = Int64 -> ByteString -> ByteString
    BSL.take (Word32 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    sizeHeader) ByteString
    buf
            bufRest :: ByteString
    bufRest         = Int64 -> ByteString -> ByteString
    BSL.drop (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (FileHeader -> Word32
    fileHeaderOffset FileHeader
    fileHeader) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    sizeOfFileHeader)) ByteString
    buf

            -- How much non-header data is present in the file.
            -- For uncompressed data without a colour table, the remaining data
            -- should be the image, but there may also be padding bytes on the
            -- end.
            physicalBufferSize :: Word32
    physicalBufferSize
                    = (Int64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Word32) -> Int64 -> Word32
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    BSL.length ByteString
    bufRest) :: Word32

       in if (Int64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Word32) -> Int64 -> Word32
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    BSL.length ByteString
    bufImageHeader) Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word32
    sizeHeader
             then   Error -> Either Error BMP
    forall a b. a -> Either a b
    Left Error
    ErrorImageHeaderTruncated
             else   FileHeader
    -> ByteString -> ByteString -> Word32 -> Either Error BMP
    parseBMP3 FileHeader
    fileHeader ByteString
    bufImageHeader ByteString
    bufRest Word32
    physicalBufferSize

    parseBMP3 :: FileHeader
    -> ByteString -> ByteString -> Word32 -> Either Error BMP
    parseBMP3 FileHeader
    fileHeader ByteString
    bufImageHeader ByteString
    bufRest Word32
    physicalBufferSize
            | ByteString -> Int64
    BSL.length ByteString
    bufImageHeader Int64 -> Int64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int64
    40
            = let info :: BitmapInfoV3
    info      = ByteString -> BitmapInfoV3
    forall a. Binary a => ByteString -> a
    decode ByteString
    bufImageHeader
              in  case BitmapInfoV3 -> Word32 -> Maybe Error
    checkBitmapInfoV3 BitmapInfoV3
    info Word32
    physicalBufferSize of
                     Just Error
    err       -> Error -> Either Error BMP
    forall a b. a -> Either a b
    Left Error
    err
                     Maybe Error
    Nothing
                      |  Just Int
    imageSize      <- BitmapInfoV3 -> Maybe Int
    imageSizeFromBitmapInfoV3 BitmapInfoV3
    info
                      -> FileHeader -> BitmapInfo -> ByteString -> Int -> Either Error BMP
    parseBMP4 FileHeader
    fileHeader (BitmapInfoV3 -> BitmapInfo
    InfoV3 BitmapInfoV3
    info) ByteString
    bufRest Int
    imageSize

                      |  Bool
    otherwise
                      -> Error -> Either Error BMP
    forall a b. a -> Either a b
    Left (Error -> Either Error BMP) -> Error -> Either Error BMP
    forall a b. (a -> b) -> a -> b
    $ Error
    ErrorInternalErrorPleaseReport

            | ByteString -> Int64
    BSL.length ByteString
    bufImageHeader Int64 -> Int64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int64
    108
            = let info :: BitmapInfoV4
    info      = ByteString -> BitmapInfoV4
    forall a. Binary a => ByteString -> a
    decode ByteString
    bufImageHeader
              in  case BitmapInfoV4 -> Word32 -> Maybe Error
    checkBitmapInfoV4 BitmapInfoV4
    info Word32
    physicalBufferSize of
                     Just Error
    err       -> Error -> Either Error BMP
    forall a b. a -> Either a b
    Left Error
    err
                     Maybe Error
    Nothing
                      | Just Int
    imageSize      <- BitmapInfoV4 -> Maybe Int
    imageSizeFromBitmapInfoV4 BitmapInfoV4
    info
                      -> FileHeader -> BitmapInfo -> ByteString -> Int -> Either Error BMP
    parseBMP4 FileHeader
    fileHeader (BitmapInfoV4 -> BitmapInfo
    InfoV4 BitmapInfoV4
    info) ByteString
    bufRest Int
    imageSize

                      | Bool
    otherwise
                      -> Error -> Either Error BMP
    forall a b. a -> Either a b
    Left (Error -> Either Error BMP) -> Error -> Either Error BMP
    forall a b. (a -> b) -> a -> b
    $ Error
    ErrorInternalErrorPleaseReport

            | ByteString -> Int64
    BSL.length ByteString
    bufImageHeader Int64 -> Int64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int64
    124
            = let info :: BitmapInfoV5
    info      = ByteString -> BitmapInfoV5
    forall a. Binary a => ByteString -> a
    decode ByteString
    bufImageHeader
              in  case BitmapInfoV5 -> Word32 -> Maybe Error
    checkBitmapInfoV5 BitmapInfoV5
    info Word32
    physicalBufferSize of
                     Just Error
    err       -> Error -> Either Error BMP
    forall a b. a -> Either a b
    Left Error
    err
                     Maybe Error
    Nothing
                      | Just Int
    imageSize      <- BitmapInfoV5 -> Maybe Int
    imageSizeFromBitmapInfoV5 BitmapInfoV5
    info
                      -> FileHeader -> BitmapInfo -> ByteString -> Int -> Either Error BMP
    parseBMP4 FileHeader
    fileHeader (BitmapInfoV5 -> BitmapInfo
    InfoV5 BitmapInfoV5
    info) ByteString
    bufRest Int
    imageSize

                      | Bool
    otherwise
                      -> Error -> Either Error BMP
    forall a b. a -> Either a b
    Left (Error -> Either Error BMP) -> Error -> Either Error BMP
    forall a b. (a -> b) -> a -> b
    $ Error
    ErrorInternalErrorPleaseReport

            | Bool
    otherwise
            = Error -> Either Error BMP
    forall a b. a -> Either a b
    Left (Error -> Either Error BMP) -> Error -> Either Error BMP
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Error
    ErrorUnhandledBitmapHeaderSize
                   (Word32 -> Error) -> Word32 -> Error
    forall a b. (a -> b) -> a -> b
    $ Int64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Word32) -> Int64 -> Word32
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    BSL.length ByteString
    bufImageHeader

    parseBMP4 :: FileHeader -> BitmapInfo -> ByteString -> Int -> Either Error BMP
    parseBMP4 FileHeader
    fileHeader BitmapInfo
    imageHeader ByteString
    bufImage (Int
    sizeImage :: Int)
     = let  bufLen :: Int
    bufLen  = Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    BSL.length ByteString
    bufImage
       in   if Int
    bufLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    sizeImage
             then Error -> Either Error BMP
    forall a b. a -> Either a b
    Left (Error -> Either Error BMP) -> Error -> Either Error BMP
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Error
    ErrorImageDataTruncated Int
    sizeImage Int
    bufLen
             else BMP -> Either Error BMP
    forall a b. b -> Either a b
    Right (BMP -> Either Error BMP) -> BMP -> Either Error BMP
    forall a b. (a -> b) -> a -> b
    $ BMP
                    { bmpFileHeader :: FileHeader
    bmpFileHeader         = FileHeader
    fileHeader
                    , bmpBitmapInfo :: BitmapInfo
    bmpBitmapInfo         = BitmapInfo
    imageHeader
                    , bmpRawImageData :: ByteString
    bmpRawImageData       = ByteString -> ByteString
    BSL.toStrict ByteString
    bufImage }

    -- Writing --------------------------------------------------------------------
    -- | Wrapper for `hPutBMP`
    writeBMP :: FilePath -> BMP -> IO ()
    writeBMP :: FilePath -> BMP -> IO ()
    writeBMP FilePath
    fileName BMP
    bmp
     = do   h       <- FilePath -> IOMode -> IO Handle
    openBinaryFile FilePath
    fileName IOMode
    WriteMode
            hPutBMP h bmp
            hFlush h
            hClose h

    -- | Put a BMP image to a file handle.
    hPutBMP :: Handle -> BMP -> IO ()
    hPutBMP :: Handle -> BMP -> IO ()
    hPutBMP Handle
    h BMP
    bmp
            = Handle -> ByteString -> IO ()
    BSL.hPut Handle
    h (BMP -> ByteString
    renderBMP BMP
    bmp)

    -- | Render a BMP image to a lazy `ByteString`.
    renderBMP :: BMP -> BSL.ByteString
    renderBMP :: BMP -> ByteString
    renderBMP BMP
    bmp
            = ByteString -> ByteString -> ByteString
    BSL.append    (FileHeader -> ByteString
    forall a. Binary a => a -> ByteString
    encode (FileHeader -> ByteString) -> FileHeader -> ByteString
    forall a b. (a -> b) -> a -> b
    $ BMP -> FileHeader
    bmpFileHeader BMP
    bmp)
            (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString -> ByteString
    BSL.append    (BitmapInfo -> ByteString
    forall a. Binary a => a -> ByteString
    encode (BitmapInfo -> ByteString) -> BitmapInfo -> ByteString
    forall a b. (a -> b) -> a -> b
    $ BMP -> BitmapInfo
    bmpBitmapInfo BMP
    bmp)
            (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    BSL.fromStrict (BMP -> ByteString
    bmpRawImageData BMP
    bmp)

    -- | Get the width and height of an image.
    --      It's better to use this function than to access the headers directly.
    bmpDimensions :: BMP -> (Int, Int)
    bmpDimensions :: BMP -> (Int, Int)
    bmpDimensions BMP
    bmp
     = let  info :: BitmapInfoV3
    info    = BitmapInfo -> BitmapInfoV3
    getBitmapInfoV3 (BitmapInfo -> BitmapInfoV3) -> BitmapInfo -> BitmapInfoV3
    forall a b. (a -> b) -> a -> b
    $ BMP -> BitmapInfo
    bmpBitmapInfo BMP
    bmp
       in   ( Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Word32 -> Int
    forall a b. (a -> b) -> a -> b
    $ BitmapInfoV3 -> Word32
    dib3Width BitmapInfoV3
    info
            , Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Word32 -> Int
    forall a b. (a -> b) -> a -> b
    $ BitmapInfoV3 -> Word32
    dib3Height BitmapInfoV3
    info)