    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeSynonymInstances #-}
    {-# LANGUAGE TypeFamilies #-}
    -- | Modules used for Bitmap file (.bmp) file loading and writing

    module Codec.Picture.Bitmap( -- * Functions

                                 writeBitmap
                               , encodeBitmap
                               , encodeBitmapWithMetadata
                               , decodeBitmap
                               , decodeBitmapWithMetadata
                               , decodeBitmapWithPaletteAndMetadata
                               , encodeDynamicBitmap
                               , encodeBitmapWithPaletteAndMetadata
                               , writeDynamicBitmap
                                 -- * Accepted format in output

                               , BmpEncodable( )
                               ) where

    #if !MIN_VERSION_base(4,8,0)
    import Data.Monoid( mempty )
    import Control.Applicative( (<$>) )
    #endif

    import Control.Arrow( first )
    import Control.Monad( replicateM, when, foldM_, forM_, void )
    import Control.Monad.ST ( ST, runST )
    import Data.Maybe( fromMaybe )
    import qualified Data.Vector.Storable as VS
    import qualified Data.Vector.Storable.Mutable as M
    import Data.Binary( Binary( .. ) )
    import Data.Binary.Put( Put
                          , runPut
                          , putInt32le
                          , putWord16le
                          , putWord32le
                          , putByteString
                          )

    import Data.Binary.Get( Get
                          , getWord8
                          , getWord16le
                          , getWord32le
                          , getInt32le
                          , getByteString
                          , bytesRead
                          , skip
                          , label
                          )

    import Data.Bits
    import Data.Int( Int32 )
    import Data.Word( Word32, Word16, Word8 )
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Internal as BI
    import qualified Data.ByteString.Lazy as L

    import Codec.Picture.InternalHelper
    import Codec.Picture.Types
    import Codec.Picture.VectorByteConversion
    import qualified Codec.Picture.Metadata as Met
    import Codec.Picture.Metadata ( Metadatas )

    data BmpHeader = BmpHeader
        { BmpHeader -> Word16
    magicIdentifier :: !Word16
        , BmpHeader -> Word32
    fileSize        :: !Word32 -- ^ in bytes

        , BmpHeader -> Word16
    reserved1       :: !Word16
        , BmpHeader -> Word16
    reserved2       :: !Word16
        , BmpHeader -> Word32
    dataOffset      :: !Word32
        }

    bitmapMagicIdentifier :: Word16
    bitmapMagicIdentifier :: Word16
    bitmapMagicIdentifier = Word16
    0x4D42

    instance Binary BmpHeader where
        put :: BmpHeader -> Put
    put BmpHeader
    hdr = do
            Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpHeader -> Word16
    magicIdentifier BmpHeader
    hdr
            Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpHeader -> Word32
    fileSize BmpHeader
    hdr
            Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpHeader -> Word16
    reserved1 BmpHeader
    hdr
            Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpHeader -> Word16
    reserved2 BmpHeader
    hdr
            Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpHeader -> Word32
    dataOffset BmpHeader
    hdr

        get :: Get BmpHeader
    get = do
            Word16
    ident <- Get Word16
    getWord16le
            Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word16
    ident Word16 -> Word16 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word16
    bitmapMagicIdentifier)
                 (String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Invalid Bitmap magic identifier")
            Word32
    fsize <- Get Word32
    getWord32le
            Word16
    r1 <- Get Word16
    getWord16le
            Word16
    r2 <- Get Word16
    getWord16le
            Word32
    offset <- Get Word32
    getWord32le
            BmpHeader -> Get BmpHeader
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return BmpHeader
                { magicIdentifier :: Word16
    magicIdentifier = Word16
    ident
                , fileSize :: Word32
    fileSize = Word32
    fsize
                , reserved1 :: Word16
    reserved1 = Word16
    r1
                , reserved2 :: Word16
    reserved2 = Word16
    r2
                , dataOffset :: Word32
    dataOffset = Word32
    offset
                }

    -- | The type of color space declared in a Windows BMP file.

    data ColorSpaceType = CalibratedRGB
                        | DeviceDependentRGB
                        | DeviceDependentCMYK
                        | SRGB
                        | WindowsColorSpace
                        | ProfileEmbedded
                        | ProfileLinked
                        | UnknownColorSpace Word32
                        deriving (ColorSpaceType -> ColorSpaceType -> Bool
    (ColorSpaceType -> ColorSpaceType -> Bool)
    -> (ColorSpaceType -> ColorSpaceType -> Bool) -> Eq ColorSpaceType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ColorSpaceType -> ColorSpaceType -> Bool
    == :: ColorSpaceType -> ColorSpaceType -> Bool
    $c/= :: ColorSpaceType -> ColorSpaceType -> Bool
    /= :: ColorSpaceType -> ColorSpaceType -> Bool
    Eq, Int -> ColorSpaceType -> ShowS
    [ColorSpaceType] -> ShowS
    ColorSpaceType -> String
    (Int -> ColorSpaceType -> ShowS)
    -> (ColorSpaceType -> String)
    -> ([ColorSpaceType] -> ShowS)
    -> Show ColorSpaceType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ColorSpaceType -> ShowS
    showsPrec :: Int -> ColorSpaceType -> ShowS
    $cshow :: ColorSpaceType -> String
    show :: ColorSpaceType -> String
    $cshowList :: [ColorSpaceType] -> ShowS
    showList :: [ColorSpaceType] -> ShowS
    Show)

    -- | BITMAPxHEADER with compatibility up to V5. This header was first introduced

    -- with Windows 2.0 as the BITMAPCOREHEADER, and was later extended in Windows

    -- 3.1, Windows 95 and Windows 98. The original BITMAPCOREHEADER includes all

    -- fields up to 'bitPerPixel'. The Windows 3.1 BITMAPINFOHEADER adds all the

    -- fields up to 'importantColors'.

    --

    -- Some Windows 3.1 bitmaps with 16 or 32 bits per pixel might also have three

    -- bitmasks following the BITMAPINFOHEADER. These bitmasks were later

    -- incorporated into the bitmap header structure in the unreleased

    -- BITMAPV2INFOHEADER. The (also unreleased) BITMAPV3INFOHEADER added another

    -- bitmask for an alpha channel.

    --

    -- The later Windows 95 and Windows 98 extensions to the BITMAPINFOHEADER extend

    -- the BITMAPV3INFOHEADER, adding support for color correction.

    --

    --  * BITMAPV4HEADER (Windows 95) may include a simple color profile in a

    --      proprietary format. The fields in this color profile (which includes gamma

    --      values) are not to be used unless the 'colorSpaceType' field is

    --      'CalibratedRGB'.

    --

    --  * BITMAPV5HEADER (Windows 98) adds support for an ICC color profile. The

    --      presence of an ICC color profile is indicated by setting the 'colorSpaceType'

    --      field to 'ProfileEmbedded' or 'ProfileLinked'. If it is 'ProfileLinked' then

    --      the profile data is actually a Windows-1252 encoded string containing the

    --      fully qualified path to an ICC color profile.

    data BmpV5Header = BmpV5Header
        { BmpV5Header -> Word32
    size              :: !Word32 -- Header size in bytes

        , BmpV5Header -> Int32
    width             :: !Int32
        , BmpV5Header -> Int32
    height            :: !Int32
        , BmpV5Header -> Word16
    planes            :: !Word16 -- Number of colour planes

        , BmpV5Header -> Word16
    bitPerPixel       :: !Word16
        , BmpV5Header -> Word32
    bitmapCompression :: !Word32
        , BmpV5Header -> Word32
    byteImageSize     :: !Word32
        , BmpV5Header -> Int32
    xResolution       :: !Int32  -- ^ Pixels per meter

        , BmpV5Header -> Int32
    yResolution       :: !Int32  -- ^ Pixels per meter

        , BmpV5Header -> Word32
    colorCount        :: !Word32 -- ^ Number of colors in the palette

        , BmpV5Header -> Word32
    importantColours  :: !Word32
        -- Fields added to the header in V2

        , BmpV5Header -> Word32
    redMask           :: !Word32 -- ^ Red bitfield mask, set to 0 if not used

        , BmpV5Header -> Word32
    greenMask         :: !Word32 -- ^ Green bitfield mask, set to 0 if not used

        , BmpV5Header -> Word32
    blueMask          :: !Word32 -- ^ Blue bitfield mask, set to 0 if not used

        -- Fields added to the header in V3

        , BmpV5Header -> Word32
    alphaMask         :: !Word32 -- ^ Alpha bitfield mask, set to 0 if not used

        -- Fields added to the header in V4

        , BmpV5Header -> ColorSpaceType
    colorSpaceType    :: !ColorSpaceType
        , BmpV5Header -> ByteString
    colorSpace        :: !B.ByteString -- ^ Windows color space, not decoded

        -- Fields added to the header in V5

        , BmpV5Header -> Word32
    iccIntent         :: !Word32
        , BmpV5Header -> Word32
    iccProfileData    :: !Word32
        , BmpV5Header -> Word32
    iccProfileSize    :: !Word32
        }
        deriving Int -> BmpV5Header -> ShowS
    [BmpV5Header] -> ShowS
    BmpV5Header -> String
    (Int -> BmpV5Header -> ShowS)
    -> (BmpV5Header -> String)
    -> ([BmpV5Header] -> ShowS)
    -> Show BmpV5Header
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> BmpV5Header -> ShowS
    showsPrec :: Int -> BmpV5Header -> ShowS
    $cshow :: BmpV5Header -> String
    show :: BmpV5Header -> String
    $cshowList :: [BmpV5Header] -> ShowS
    showList :: [BmpV5Header] -> ShowS
    Show

    -- | Size of the Windows BITMAPV4INFOHEADER color space information.

    sizeofColorProfile :: Int
    sizeofColorProfile :: Int
    sizeofColorProfile = Int
    48

    -- | Sizes of basic BMP headers.

    sizeofBmpHeader, sizeofBmpCoreHeader, sizeofBmpInfoHeader :: Word32
    sizeofBmpHeader :: Word32
    sizeofBmpHeader = Word32
    2 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    4 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    2 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    2 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    4
    sizeofBmpCoreHeader :: Word32
    sizeofBmpCoreHeader = Word32
    12
    sizeofBmpInfoHeader :: Word32
    sizeofBmpInfoHeader = Word32
    40

    -- | Sizes of extended BMP headers.

    sizeofBmpV2Header, sizeofBmpV3Header, sizeofBmpV4Header, sizeofBmpV5Header :: Word32
    sizeofBmpV2Header :: Word32
    sizeofBmpV2Header = Word32
    52
    sizeofBmpV3Header :: Word32
    sizeofBmpV3Header = Word32
    56
    sizeofBmpV4Header :: Word32
    sizeofBmpV4Header = Word32
    108
    sizeofBmpV5Header :: Word32
    sizeofBmpV5Header = Word32
    124

    instance Binary ColorSpaceType where
        put :: ColorSpaceType -> Put
    put ColorSpaceType
    CalibratedRGB         = Word32 -> Put
    putWord32le Word32
    0
        put ColorSpaceType
    DeviceDependentRGB    = Word32 -> Put
    putWord32le Word32
    1
        put ColorSpaceType
    DeviceDependentCMYK   = Word32 -> Put
    putWord32le Word32
    2
        put ColorSpaceType
    ProfileEmbedded       = Word32 -> Put
    putWord32le Word32
    0x4D424544
        put ColorSpaceType
    ProfileLinked         = Word32 -> Put
    putWord32le Word32
    0x4C494E4B
        put ColorSpaceType
    SRGB                  = Word32 -> Put
    putWord32le Word32
    0x73524742
        put ColorSpaceType
    WindowsColorSpace     = Word32 -> Put
    putWord32le Word32
    0x57696E20
        put (UnknownColorSpace Word32
    x) = Word32 -> Put
    putWord32le Word32
    x
        get :: Get ColorSpaceType
    get = do
          Word32
    w <- Get Word32
    getWord32le
          ColorSpaceType -> Get ColorSpaceType
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ColorSpaceType -> Get ColorSpaceType)
    -> ColorSpaceType -> Get ColorSpaceType
    forall a b. (a -> b) -> a -> b
    $ case Word32
    w of
            Word32
    0          -> ColorSpaceType
    CalibratedRGB
            Word32
    1          -> ColorSpaceType
    DeviceDependentRGB
            Word32
    2          -> ColorSpaceType
    DeviceDependentCMYK
            Word32
    0x4D424544 -> ColorSpaceType
    ProfileEmbedded
            Word32
    0x4C494E4B -> ColorSpaceType
    ProfileLinked
            Word32
    0x73524742 -> ColorSpaceType
    SRGB
            Word32
    0x57696E20 -> ColorSpaceType
    WindowsColorSpace
            Word32
    _          -> Word32 -> ColorSpaceType
    UnknownColorSpace Word32
    w

    instance Binary BmpV5Header where
        put :: BmpV5Header -> Put
    put BmpV5Header
    hdr = do
            Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    size BmpV5Header
    hdr

            if (BmpV5Header -> Word32
    size BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    sizeofBmpCoreHeader) then do
              Word16 -> Put
    putWord16le (Word16 -> Put) -> (Int32 -> Word16) -> Int32 -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int32 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Put) -> Int32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    width BmpV5Header
    hdr
              Word16 -> Put
    putWord16le (Word16 -> Put) -> (Int32 -> Word16) -> Int32 -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int32 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Put) -> Int32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    height BmpV5Header
    hdr
              Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word16
    planes BmpV5Header
    hdr
              Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word16
    bitPerPixel BmpV5Header
    hdr
            else do
              Int32 -> Put
    putInt32le (Int32 -> Put) -> Int32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    width BmpV5Header
    hdr
              Int32 -> Put
    putInt32le (Int32 -> Put) -> Int32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    height BmpV5Header
    hdr
              Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word16
    planes BmpV5Header
    hdr
              Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word16
    bitPerPixel BmpV5Header
    hdr

            Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (BmpV5Header -> Word32
    size BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32
    sizeofBmpCoreHeader) (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $ do
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    bitmapCompression BmpV5Header
    hdr
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    byteImageSize BmpV5Header
    hdr
              Int32 -> Put
    putInt32le (Int32 -> Put) -> Int32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    xResolution BmpV5Header
    hdr
              Int32 -> Put
    putInt32le (Int32 -> Put) -> Int32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    yResolution BmpV5Header
    hdr
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    colorCount BmpV5Header
    hdr
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    importantColours BmpV5Header
    hdr

            Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (BmpV5Header -> Word32
    size BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32
    sizeofBmpInfoHeader Bool -> Bool -> Bool
    || BmpV5Header -> Word32
    bitmapCompression BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    3) (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $ do
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    redMask BmpV5Header
    hdr
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    greenMask BmpV5Header
    hdr
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    blueMask BmpV5Header
    hdr

            Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (BmpV5Header -> Word32
    size BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32
    sizeofBmpV2Header) (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    alphaMask BmpV5Header
    hdr

            Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (BmpV5Header -> Word32
    size BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32
    sizeofBmpV3Header) (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $ do
              ColorSpaceType -> Put
    forall t. Binary t => t -> Put
    put (ColorSpaceType -> Put) -> ColorSpaceType -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> ColorSpaceType
    colorSpaceType BmpV5Header
    hdr
              ByteString -> Put
    putByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> ByteString
    colorSpace BmpV5Header
    hdr

            Bool -> Put -> Put
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (BmpV5Header -> Word32
    size BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32
    sizeofBmpV4Header) (Put -> Put) -> Put -> Put
    forall a b. (a -> b) -> a -> b
    $ do
              Word32 -> Put
    forall t. Binary t => t -> Put
    put (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    iccIntent BmpV5Header
    hdr
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    iccProfileData BmpV5Header
    hdr
              Word32 -> Put
    putWord32le (Word32 -> Put) -> Word32 -> Put
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    iccProfileSize BmpV5Header
    hdr
              Word32 -> Put
    putWord32le Word32
    0 -- reserved field

        get :: Get BmpV5Header
    get = do
          Word32
    readSize <- Get Word32
    getWord32le
          if Word32
    readSize Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    sizeofBmpCoreHeader
            then Word32 -> Get BmpV5Header
    getBitmapCoreHeader Word32
    readSize
            else Word32 -> Get BmpV5Header
    getBitmapInfoHeader Word32
    readSize

          where
            getBitmapCoreHeader :: Word32 -> Get BmpV5Header
    getBitmapCoreHeader Word32
    readSize = do
              Word16
    readWidth <- Get Word16
    getWord16le
              Word16
    readHeight <- Get Word16
    getWord16le
              Word16
    readPlanes <- Get Word16
    getWord16le
              Word16
    readBitPerPixel <- Get Word16
    getWord16le
              BmpV5Header -> Get BmpV5Header
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return BmpV5Header {
                  size :: Word32
    size = Word32
    readSize,
                  width :: Int32
    width = Word16 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    readWidth,
                  height :: Int32
    height = Word16 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    readHeight,
                  planes :: Word16
    planes = Word16
    readPlanes,
                  bitPerPixel :: Word16
    bitPerPixel = Word16
    readBitPerPixel,
                  bitmapCompression :: Word32
    bitmapCompression = Word32
    0,
                  byteImageSize :: Word32
    byteImageSize = Word32
    0,
                  xResolution :: Int32
    xResolution = Int32
    2835,
                  yResolution :: Int32
    yResolution = Int32
    2835,
                  colorCount :: Word32
    colorCount = Word32
    2 Word32 -> Word16 -> Word32
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Word16
    readBitPerPixel,
                  importantColours :: Word32
    importantColours = Word32
    0,
                  redMask :: Word32
    redMask = Word32
    0,
                  greenMask :: Word32
    greenMask = Word32
    0,
                  blueMask :: Word32
    blueMask = Word32
    0,
                  alphaMask :: Word32
    alphaMask = Word32
    0,
                  colorSpaceType :: ColorSpaceType
    colorSpaceType = ColorSpaceType
    DeviceDependentRGB,
                  colorSpace :: ByteString
    colorSpace = ByteString
    B.empty,
                  iccIntent :: Word32
    iccIntent = Word32
    0,
                  iccProfileData :: Word32
    iccProfileData = Word32
    0,
                  iccProfileSize :: Word32
    iccProfileSize = Word32
    0
              }

            getBitmapInfoHeader :: Word32 -> Get BmpV5Header
    getBitmapInfoHeader Word32
    readSize = do
              Int32
    readWidth <- Get Int32
    getInt32le
              Int32
    readHeight <- Get Int32
    getInt32le
              Word16
    readPlanes <- Get Word16
    getWord16le
              Word16
    readBitPerPixel <- Get Word16
    getWord16le
              Word32
    readBitmapCompression <- Get Word32
    getWord32le
              Word32
    readByteImageSize <- Get Word32
    getWord32le
              Int32
    readXResolution <- Get Int32
    getInt32le
              Int32
    readYResolution <- Get Int32
    getInt32le
              Word32
    readColorCount <- Get Word32
    getWord32le
              Word32
    readImportantColours <- Get Word32
    getWord32le

              (Word32
    readRedMask, Word32
    readGreenMask, Word32
    readBlueMask) <-
                if Word32
    readSize Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    sizeofBmpInfoHeader Bool -> Bool -> Bool
    && Word32
    readBitmapCompression Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word32
    3
                  then (Word32, Word32, Word32) -> Get (Word32, Word32, Word32)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32
    0, Word32
    0, Word32
    0)
                  else do
                    -- fields added to the header in V2, but sometimes present

                    -- immediately after a plain BITMAPINFOHEADER

                    Word32
    innerReadRedMask <- Get Word32
    getWord32le
                    Word32
    innerReadGreenMask <- Get Word32
    getWord32le
                    Word32
    innerReadBlueMask <- Get Word32
    getWord32le
                    (Word32, Word32, Word32) -> Get (Word32, Word32, Word32)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32
    innerReadRedMask, Word32
    innerReadGreenMask, Word32
    innerReadBlueMask)

              -- field added in V3 (undocumented)

              Word32
    readAlphaMask <- if Word32
    readSize Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word32
    sizeofBmpV3Header then Word32 -> Get Word32
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Word32
    0 else Get Word32
    getWord32le

              (ColorSpaceType
    readColorSpaceType, ByteString
    readColorSpace) <-
                if Word32
    readSize Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word32
    sizeofBmpV4Header
                  then (ColorSpaceType, ByteString) -> Get (ColorSpaceType, ByteString)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ColorSpaceType
    DeviceDependentRGB, ByteString
    B.empty)
                  else do
                    -- fields added in V4 (Windows 95)

                    ColorSpaceType
    csType <- Get ColorSpaceType
    forall t. Binary t => Get t
    get
                    ByteString
    cs <- Int -> Get ByteString
    getByteString Int
    sizeofColorProfile
                    (ColorSpaceType, ByteString) -> Get (ColorSpaceType, ByteString)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ColorSpaceType
    csType, ByteString
    cs)

              (Word32
    readIccIntent, Word32
    readIccProfileData, Word32
    readIccProfileSize) <-
                if Word32
    readSize Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word32
    sizeofBmpV5Header
                  then (Word32, Word32, Word32) -> Get (Word32, Word32, Word32)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32
    0, Word32
    0, Word32
    0)
                  else do
                    -- fields added in V5 (Windows 98)

                    Word32
    innerIccIntent <- Get Word32
    getWord32le
                    Word32
    innerIccProfileData <- Get Word32
    getWord32le
                    Word32
    innerIccProfileSize <- Get Word32
    getWord32le
                    Get Word32 -> Get ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void Get Word32
    getWord32le -- reserved field

                    (Word32, Word32, Word32) -> Get (Word32, Word32, Word32)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32
    innerIccIntent, Word32
    innerIccProfileData, Word32
    innerIccProfileSize)

              BmpV5Header -> Get BmpV5Header
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return BmpV5Header {
                  size :: Word32
    size = Word32
    readSize,
                  width :: Int32
    width = Int32
    readWidth,
                  height :: Int32
    height = Int32
    readHeight,
                  planes :: Word16
    planes = Word16
    readPlanes,
                  bitPerPixel :: Word16
    bitPerPixel = Word16
    readBitPerPixel,
                  bitmapCompression :: Word32
    bitmapCompression = Word32
    readBitmapCompression,
                  byteImageSize :: Word32
    byteImageSize = Word32
    readByteImageSize,
                  xResolution :: Int32
    xResolution = Int32
    readXResolution,
                  yResolution :: Int32
    yResolution = Int32
    readYResolution,
                  colorCount :: Word32
    colorCount = Word32
    readColorCount,
                  importantColours :: Word32
    importantColours = Word32
    readImportantColours,
                  redMask :: Word32
    redMask = Word32
    readRedMask,
                  greenMask :: Word32
    greenMask = Word32
    readGreenMask,
                  blueMask :: Word32
    blueMask = Word32
    readBlueMask,
                  alphaMask :: Word32
    alphaMask = Word32
    readAlphaMask,
                  colorSpaceType :: ColorSpaceType
    colorSpaceType = ColorSpaceType
    readColorSpaceType,
                  colorSpace :: ByteString
    colorSpace = ByteString
    readColorSpace,
                  iccIntent :: Word32
    iccIntent = Word32
    readIccIntent,
                  iccProfileData :: Word32
    iccProfileData = Word32
    readIccProfileData,
                  iccProfileSize :: Word32
    iccProfileSize = Word32
    readIccProfileSize
              }

    newtype BmpPalette = BmpPalette [(Word8, Word8, Word8, Word8)]

    putPalette :: BmpPalette -> Put
    putPalette :: BmpPalette -> Put
    putPalette (BmpPalette [(Word8, Word8, Word8, Word8)]
    p) = ((Word8, Word8, Word8, Word8) -> Put)
    -> [(Word8, Word8, Word8, Word8)] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\(Word8
    r, Word8
    g, Word8
    b, Word8
    a) -> Word8 -> Put
    forall t. Binary t => t -> Put
    put Word8
    r Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    forall t. Binary t => t -> Put
    put Word8
    g Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    forall t. Binary t => t -> Put
    put Word8
    b Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    forall t. Binary t => t -> Put
    put Word8
    a) [(Word8, Word8, Word8, Word8)]
    p

    putICCProfile :: Maybe B.ByteString -> Put
    putICCProfile :: Maybe ByteString -> Put
    putICCProfile Maybe ByteString
    Nothing = () -> Put
    forall a. a -> PutM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    putICCProfile (Just ByteString
    bytes) = ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    bytes

    -- | All the instance of this class can be written as a bitmap file

    -- using this library.

    class BmpEncodable pixel where
        bitsPerPixel   :: pixel -> Int
        bmpEncode      :: Image pixel -> Put
        hasAlpha       :: Image pixel -> Bool
        defaultPalette :: pixel -> BmpPalette
        defaultPalette pixel
    _ = [(Word8, Word8, Word8, Word8)] -> BmpPalette
    BmpPalette []

    stridePut :: M.STVector s Word8 -> Int -> Int -> ST s ()
    {-# INLINE stridePut #-}
    stridePut :: forall s. STVector s Word8 -> Int -> Int -> ST s ()
    stridePut STVector s Word8
    vec = Int -> Int -> ST s ()
    inner
     where inner :: Int -> Int -> ST s ()
    inner  Int
    _ Int
    0 = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
           inner Int
    ix Int
    n = do
               (STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    ix) Word8
    0
               Int -> Int -> ST s ()
    inner (Int
    ix Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

    instance BmpEncodable Pixel8 where
        hasAlpha :: Image Word8 -> Bool
    hasAlpha Image Word8
    _ = Bool
    False
        defaultPalette :: Word8 -> BmpPalette
    defaultPalette Word8
    _ = [(Word8, Word8, Word8, Word8)] -> BmpPalette
    BmpPalette [(Word8
    x,Word8
    x,Word8
    x, Word8
    255) | Word8
    x <- [Word8
    0 .. Word8
    255]]
        bitsPerPixel :: Word8 -> Int
    bitsPerPixel Word8
    _ = Int
    8
        bmpEncode :: Image Word8 -> Put
    bmpEncode (Image {imageWidth :: forall a. Image a -> Int
    imageWidth = Int
    w, imageHeight :: forall a. Image a -> Int
    imageHeight = Int
    h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
    imageData = Vector (PixelBaseComponent Word8)
    arr}) =
          [Int] -> (Int -> Put) -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2 .. Int
    0] ((Int -> Put) -> Put) -> (Int -> Put) -> Put
    forall a b. (a -> b) -> a -> b
    $ \Int
    l -> Vector Word8 -> Put
    putVector (Vector Word8 -> Put) -> Vector Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Vector Word8)) -> Vector Word8)
    -> (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a b. (a -> b) -> a -> b
    $ Int -> ST s (Vector Word8)
    forall s. Int -> ST s (Vector Word8)
    encodeLine Int
    l
            where stride :: Int
    stride = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    linePadding Int
    8 Int
    w
                  putVector :: Vector Word8 -> Put
    putVector Vector Word8
    vec = ByteString -> Put
    putByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ Vector Word8 -> Int -> Int -> ByteString
    blitVector Vector Word8
    vec Int
    0 Int
    lineWidth
                  lineWidth :: Int
    lineWidth = Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    stride

                  encodeLine :: forall s. Int -> ST s (VS.Vector Word8)
                  encodeLine :: forall s. Int -> ST s (Vector Word8)
    encodeLine Int
    line = do
                      STVector s Word8
    buff <- Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new Int
    lineWidth

                      let lineIdx :: Int
    lineIdx = Int
    line Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w
                          inner :: Int -> ST s ()
    inner Int
    col | Int
    col Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    w = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                          inner Int
    col = do
                              let v :: Word8
    v = Vector Word8
    Vector (PixelBaseComponent Word8)
    arr Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` (Int
    lineIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    col)
                              (STVector s Word8
    MVector (PrimState (ST s)) Word8
    buff MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    col) Word8
    v
                              Int -> ST s ()
    inner (Int
    col Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

                      Int -> ST s ()
    inner Int
    0

                      STVector s Word8 -> Int -> Int -> ST s ()
    forall s. STVector s Word8 -> Int -> Int -> ST s ()
    stridePut STVector s Word8
    buff Int
    w Int
    stride
                      MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    VS.unsafeFreeze STVector s Word8
    MVector (PrimState (ST s)) Word8
    buff

    instance BmpEncodable PixelRGBA8 where
        hasAlpha :: Image PixelRGBA8 -> Bool
    hasAlpha Image PixelRGBA8
    _ = Bool
    True
        bitsPerPixel :: PixelRGBA8 -> Int
    bitsPerPixel PixelRGBA8
    _ = Int
    32
        bmpEncode :: Image PixelRGBA8 -> Put
    bmpEncode (Image {imageWidth :: forall a. Image a -> Int
    imageWidth = Int
    w, imageHeight :: forall a. Image a -> Int
    imageHeight = Int
    h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
    imageData = Vector (PixelBaseComponent PixelRGBA8)
    arr}) =
          [Int] -> (Int -> Put) -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2 .. Int
    0] ((Int -> Put) -> Put) -> (Int -> Put) -> Put
    forall a b. (a -> b) -> a -> b
    $ \Int
    l -> Vector Word8 -> Put
    putVector (Vector Word8 -> Put) -> Vector Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Vector Word8)) -> Vector Word8)
    -> (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a b. (a -> b) -> a -> b
    $ Int -> ST s (Vector Word8)
    forall s. Int -> ST s (Vector Word8)
    putLine Int
    l
          where
            putVector :: Vector Word8 -> Put
    putVector Vector Word8
    vec = ByteString -> Put
    putByteString (ByteString -> Put) -> (Int -> ByteString) -> Int -> Put
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Word8 -> Int -> Int -> ByteString
    blitVector Vector Word8
    vec Int
    0 (Int -> Put) -> Int -> Put
    forall a b. (a -> b) -> a -> b
    $ Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4

            putLine :: forall s. Int -> ST s (VS.Vector Word8)
            putLine :: forall s. Int -> ST s (Vector Word8)
    putLine Int
    line = do
                MVector s Word8
    buff <- Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new (Int -> ST s (MVector (PrimState (ST s)) Word8))
    -> Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall a b. (a -> b) -> a -> b
    $ Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w
                let initialIndex :: Int
    initialIndex = Int
    line Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4
                    inner :: Int -> Int -> Int -> ST s ()
    inner Int
    col Int
    _ Int
    _ | Int
    col Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    w = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    inner Int
    col Int
    writeIdx Int
    readIdx = do
                        let r :: Word8
    r = Vector Word8
    Vector (PixelBaseComponent PixelRGBA8)
    arr Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` Int
    readIdx
                            g :: Word8
    g = Vector Word8
    Vector (PixelBaseComponent PixelRGBA8)
    arr Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                            b :: Word8
    b = Vector Word8
    Vector (PixelBaseComponent PixelRGBA8)
    arr Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)
                            a :: Word8
    a = Vector Word8
    Vector (PixelBaseComponent PixelRGBA8)
    arr Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)

                        (MVector s Word8
    MVector (PrimState (ST s)) Word8
    buff MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    writeIdx) Word8
    b
                        (MVector s Word8
    MVector (PrimState (ST s)) Word8
    buff MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) Word8
    g
                        (MVector s Word8
    MVector (PrimState (ST s)) Word8
    buff MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)) Word8
    r
                        (MVector s Word8
    MVector (PrimState (ST s)) Word8
    buff MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)) Word8
    a

                        Int -> Int -> Int -> ST s ()
    inner (Int
    col Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4) (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4)

                Int -> Int -> Int -> ST s ()
    inner Int
    0 Int
    0 Int
    initialIndex
                MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    VS.unsafeFreeze MVector s Word8
    MVector (PrimState (ST s)) Word8
    buff

    instance BmpEncodable PixelRGB8 where
        hasAlpha :: Image PixelRGB8 -> Bool
    hasAlpha Image PixelRGB8
    _ = Bool
    False
        bitsPerPixel :: PixelRGB8 -> Int
    bitsPerPixel PixelRGB8
    _ = Int
    24
        bmpEncode :: Image PixelRGB8 -> Put
    bmpEncode (Image {imageWidth :: forall a. Image a -> Int
    imageWidth = Int
    w, imageHeight :: forall a. Image a -> Int
    imageHeight = Int
    h, imageData :: forall a. Image a -> Vector (PixelBaseComponent a)
    imageData = Vector (PixelBaseComponent PixelRGB8)
    arr}) =
           [Int] -> (Int -> Put) -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    h Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2 .. Int
    0] ((Int -> Put) -> Put) -> (Int -> Put) -> Put
    forall a b. (a -> b) -> a -> b
    $ \Int
    l -> Vector Word8 -> Put
    putVector (Vector Word8 -> Put) -> Vector Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Vector Word8)) -> Vector Word8)
    -> (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a b. (a -> b) -> a -> b
    $ Int -> ST s (Vector Word8)
    forall s. Int -> ST s (Vector Word8)
    putLine Int
    l
            where
              stride :: Int
    stride = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int) -> (Int -> Int) -> Int -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int -> Int
    linePadding Int
    24 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    w

              putVector :: Vector Word8 -> Put
    putVector Vector Word8
    vec = ByteString -> Put
    putByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ Vector Word8 -> Int -> Int -> ByteString
    blitVector Vector Word8
    vec Int
    0 (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    stride)

              putLine :: forall s. Int -> ST s (VS.Vector Word8)
              putLine :: forall s. Int -> ST s (Vector Word8)
    putLine Int
    line = do
                  MVector s Word8
    buff <- Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new (Int -> ST s (MVector (PrimState (ST s)) Word8))
    -> Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall a b. (a -> b) -> a -> b
    $ Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    stride
                  let initialIndex :: Int
    initialIndex = Int
    line Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3
                      inner :: Int -> Int -> Int -> ST s ()
    inner Int
    col Int
    _ Int
    _ | Int
    col Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    w = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                      inner Int
    col Int
    writeIdx Int
    readIdx = do
                          let r :: Word8
    r = Vector Word8
    Vector (PixelBaseComponent PixelRGB8)
    arr Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` Int
    readIdx
                              g :: Word8
    g = Vector Word8
    Vector (PixelBaseComponent PixelRGB8)
    arr Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                              b :: Word8
    b = Vector Word8
    Vector (PixelBaseComponent PixelRGB8)
    arr Vector Word8 -> Int -> Word8
    forall a. Storable a => Vector a -> Int -> a
    `VS.unsafeIndex` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)

                          (MVector s Word8
    MVector (PrimState (ST s)) Word8
    buff MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    writeIdx) Word8
    b
                          (MVector s Word8
    MVector (PrimState (ST s)) Word8
    buff MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) Word8
    g
                          (MVector s Word8
    MVector (PrimState (ST s)) Word8
    buff MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)) Word8
    r

                          Int -> Int -> Int -> ST s ()
    inner (Int
    col Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3) (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)

                  Int -> Int -> Int -> ST s ()
    inner Int
    0 Int
    0 Int
    initialIndex
                  MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    VS.unsafeFreeze MVector s Word8
    MVector (PrimState (ST s)) Word8
    buff

    -- | Information required to extract data from a bitfield.

    data Bitfield t = Bitfield
        { forall t. Bitfield t -> t
    bfMask :: !t            -- ^ The original bitmask.

        , forall t. Bitfield t -> Int
    bfShift :: !Int         -- ^ The computed number of bits to shift right.

        , forall t. Bitfield t -> Float
    bfScale :: !Float       -- ^ The scale factor to fit the data into 8 bits.

        } deriving (Bitfield t -> Bitfield t -> Bool
    (Bitfield t -> Bitfield t -> Bool)
    -> (Bitfield t -> Bitfield t -> Bool) -> Eq (Bitfield t)
    forall t. Eq t => Bitfield t -> Bitfield t -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall t. Eq t => Bitfield t -> Bitfield t -> Bool
    == :: Bitfield t -> Bitfield t -> Bool
    $c/= :: forall t. Eq t => Bitfield t -> Bitfield t -> Bool
    /= :: Bitfield t -> Bitfield t -> Bool
    Eq, Int -> Bitfield t -> ShowS
    [Bitfield t] -> ShowS
    Bitfield t -> String
    (Int -> Bitfield t -> ShowS)
    -> (Bitfield t -> String)
    -> ([Bitfield t] -> ShowS)
    -> Show (Bitfield t)
    forall t. Show t => Int -> Bitfield t -> ShowS
    forall t. Show t => [Bitfield t] -> ShowS
    forall t. Show t => Bitfield t -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall t. Show t => Int -> Bitfield t -> ShowS
    showsPrec :: Int -> Bitfield t -> ShowS
    $cshow :: forall t. Show t => Bitfield t -> String
    show :: Bitfield t -> String
    $cshowList :: forall t. Show t => [Bitfield t] -> ShowS
    showList :: [Bitfield t] -> ShowS
    Show)

    -- | Four bitfields (red, green, blue, alpha)

    data Bitfields4 t = Bitfields4 !(Bitfield t)
                                   !(Bitfield t)
                                   !(Bitfield t)
                                   !(Bitfield t)
                                   deriving (Bitfields4 t -> Bitfields4 t -> Bool
    (Bitfields4 t -> Bitfields4 t -> Bool)
    -> (Bitfields4 t -> Bitfields4 t -> Bool) -> Eq (Bitfields4 t)
    forall t. Eq t => Bitfields4 t -> Bitfields4 t -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall t. Eq t => Bitfields4 t -> Bitfields4 t -> Bool
    == :: Bitfields4 t -> Bitfields4 t -> Bool
    $c/= :: forall t. Eq t => Bitfields4 t -> Bitfields4 t -> Bool
    /= :: Bitfields4 t -> Bitfields4 t -> Bool
    Eq, Int -> Bitfields4 t -> ShowS
    [Bitfields4 t] -> ShowS
    Bitfields4 t -> String
    (Int -> Bitfields4 t -> ShowS)
    -> (Bitfields4 t -> String)
    -> ([Bitfields4 t] -> ShowS)
    -> Show (Bitfields4 t)
    forall t. Show t => Int -> Bitfields4 t -> ShowS
    forall t. Show t => [Bitfields4 t] -> ShowS
    forall t. Show t => Bitfields4 t -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall t. Show t => Int -> Bitfields4 t -> ShowS
    showsPrec :: Int -> Bitfields4 t -> ShowS
    $cshow :: forall t. Show t => Bitfields4 t -> String
    show :: Bitfields4 t -> String
    $cshowList :: forall t. Show t => [Bitfields4 t] -> ShowS
    showList :: [Bitfields4 t] -> ShowS
    Show)

    -- | Default bitfields 32 bit bitmaps.

    defaultBitfieldsRGB32 :: Bitfields3 Word32
    defaultBitfieldsRGB32 :: Bitfields3 Word32
    defaultBitfieldsRGB32 = Bitfield Word32
    -> Bitfield Word32 -> Bitfield Word32 -> Bitfields3 Word32
    forall t. Bitfield t -> Bitfield t -> Bitfield t -> Bitfields3 t
    Bitfields3 (Word32 -> Bitfield Word32
    forall t. (FiniteBits t, Integral t) => t -> Bitfield t
    makeBitfield Word32
    0x00FF0000)
                                       (Word32 -> Bitfield Word32
    forall t. (FiniteBits t, Integral t) => t -> Bitfield t
    makeBitfield Word32
    0x0000FF00)
                                       (Word32 -> Bitfield Word32
    forall t. (FiniteBits t, Integral t) => t -> Bitfield t
    makeBitfield Word32
    0x000000FF)

    -- | Default bitfields for 16 bit bitmaps.

    defaultBitfieldsRGB16 :: Bitfields3 Word16
    defaultBitfieldsRGB16 :: Bitfields3 Word16
    defaultBitfieldsRGB16 = Bitfield Word16
    -> Bitfield Word16 -> Bitfield Word16 -> Bitfields3 Word16
    forall t. Bitfield t -> Bitfield t -> Bitfield t -> Bitfields3 t
    Bitfields3 (Word16 -> Bitfield Word16
    forall t. (FiniteBits t, Integral t) => t -> Bitfield t
    makeBitfield Word16
    0x7C00)
                                       (Word16 -> Bitfield Word16
    forall t. (FiniteBits t, Integral t) => t -> Bitfield t
    makeBitfield Word16
    0x03E0)
                                       (Word16 -> Bitfield Word16
    forall t. (FiniteBits t, Integral t) => t -> Bitfield t
    makeBitfield Word16
    0x001F)

    -- | Three bitfields (red, gree, blue).

    data Bitfields3 t = Bitfields3 !(Bitfield t)
                                   !(Bitfield t)
                                   !(Bitfield t)
                                   deriving (Bitfields3 t -> Bitfields3 t -> Bool
    (Bitfields3 t -> Bitfields3 t -> Bool)
    -> (Bitfields3 t -> Bitfields3 t -> Bool) -> Eq (Bitfields3 t)
    forall t. Eq t => Bitfields3 t -> Bitfields3 t -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall t. Eq t => Bitfields3 t -> Bitfields3 t -> Bool
    == :: Bitfields3 t -> Bitfields3 t -> Bool
    $c/= :: forall t. Eq t => Bitfields3 t -> Bitfields3 t -> Bool
    /= :: Bitfields3 t -> Bitfields3 t -> Bool
    Eq, Int -> Bitfields3 t -> ShowS
    [Bitfields3 t] -> ShowS
    Bitfields3 t -> String
    (Int -> Bitfields3 t -> ShowS)
    -> (Bitfields3 t -> String)
    -> ([Bitfields3 t] -> ShowS)
    -> Show (Bitfields3 t)
    forall t. Show t => Int -> Bitfields3 t -> ShowS
    forall t. Show t => [Bitfields3 t] -> ShowS
    forall t. Show t => Bitfields3 t -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall t. Show t => Int -> Bitfields3 t -> ShowS
    showsPrec :: Int -> Bitfields3 t -> ShowS
    $cshow :: forall t. Show t => Bitfields3 t -> String
    show :: Bitfields3 t -> String
    $cshowList :: forall t. Show t => [Bitfields3 t] -> ShowS
    showList :: [Bitfields3 t] -> ShowS
    Show)

    -- | Pixel formats used to encode RGBA image data.

    data RGBABmpFormat = RGBA32 !(Bitfields4 Word32)
                       | RGBA16 !(Bitfields4 Word16)
                       deriving (RGBABmpFormat -> RGBABmpFormat -> Bool
    (RGBABmpFormat -> RGBABmpFormat -> Bool)
    -> (RGBABmpFormat -> RGBABmpFormat -> Bool) -> Eq RGBABmpFormat
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: RGBABmpFormat -> RGBABmpFormat -> Bool
    == :: RGBABmpFormat -> RGBABmpFormat -> Bool
    $c/= :: RGBABmpFormat -> RGBABmpFormat -> Bool
    /= :: RGBABmpFormat -> RGBABmpFormat -> Bool
    Eq, Int -> RGBABmpFormat -> ShowS
    [RGBABmpFormat] -> ShowS
    RGBABmpFormat -> String
    (Int -> RGBABmpFormat -> ShowS)
    -> (RGBABmpFormat -> String)
    -> ([RGBABmpFormat] -> ShowS)
    -> Show RGBABmpFormat
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RGBABmpFormat -> ShowS
    showsPrec :: Int -> RGBABmpFormat -> ShowS
    $cshow :: RGBABmpFormat -> String
    show :: RGBABmpFormat -> String
    $cshowList :: [RGBABmpFormat] -> ShowS
    showList :: [RGBABmpFormat] -> ShowS
    Show)

    -- | Pixel formats used to encode RGB image data.

    data RGBBmpFormat = RGB32 !(Bitfields3 Word32)
                      | RGB24
                      | RGB16 !(Bitfields3 Word16)
                      deriving (RGBBmpFormat -> RGBBmpFormat -> Bool
    (RGBBmpFormat -> RGBBmpFormat -> Bool)
    -> (RGBBmpFormat -> RGBBmpFormat -> Bool) -> Eq RGBBmpFormat
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: RGBBmpFormat -> RGBBmpFormat -> Bool
    == :: RGBBmpFormat -> RGBBmpFormat -> Bool
    $c/= :: RGBBmpFormat -> RGBBmpFormat -> Bool
    /= :: RGBBmpFormat -> RGBBmpFormat -> Bool
    Eq, Int -> RGBBmpFormat -> ShowS
    [RGBBmpFormat] -> ShowS
    RGBBmpFormat -> String
    (Int -> RGBBmpFormat -> ShowS)
    -> (RGBBmpFormat -> String)
    -> ([RGBBmpFormat] -> ShowS)
    -> Show RGBBmpFormat
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RGBBmpFormat -> ShowS
    showsPrec :: Int -> RGBBmpFormat -> ShowS
    $cshow :: RGBBmpFormat -> String
    show :: RGBBmpFormat -> String
    $cshowList :: [RGBBmpFormat] -> ShowS
    showList :: [RGBBmpFormat] -> ShowS
    Show)

    -- | Pixel formats used to encode indexed or grayscale images.

    data IndexedBmpFormat = OneBPP | FourBPP | EightBPP deriving Int -> IndexedBmpFormat -> ShowS
    [IndexedBmpFormat] -> ShowS
    IndexedBmpFormat -> String
    (Int -> IndexedBmpFormat -> ShowS)
    -> (IndexedBmpFormat -> String)
    -> ([IndexedBmpFormat] -> ShowS)
    -> Show IndexedBmpFormat
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> IndexedBmpFormat -> ShowS
    showsPrec :: Int -> IndexedBmpFormat -> ShowS
    $cshow :: IndexedBmpFormat -> String
    show :: IndexedBmpFormat -> String
    $cshowList :: [IndexedBmpFormat] -> ShowS
    showList :: [IndexedBmpFormat] -> ShowS
    Show

    -- | Extract pixel data from a bitfield.

    extractBitfield :: (FiniteBits t, Integral t) => Bitfield t -> t -> Word8
    extractBitfield :: forall t. (FiniteBits t, Integral t) => Bitfield t -> t -> Word8
    extractBitfield Bitfield t
    bf t
    t = if Bitfield t -> Float
    forall t. Bitfield t -> Float
    bfScale Bitfield t
    bf Float -> Float -> Bool
    forall a. Eq a => a -> a -> Bool
    == Float
    1
                            then t -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral t
    field
                            else Float -> Word8
    forall b. Integral b => Float -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Float -> Word8) -> Float -> Word8
    forall a b. (a -> b) -> a -> b
    $ Bitfield t -> Float
    forall t. Bitfield t -> Float
    bfScale Bitfield t
    bf Float -> Float -> Float
    forall a. Num a => a -> a -> a
    * t -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral t
    field
      where field :: t
    field = (t
    t t -> t -> t
    forall a. Bits a => a -> a -> a
    .&. Bitfield t -> t
    forall t. Bitfield t -> t
    bfMask Bitfield t
    bf) t -> Int -> t
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Bitfield t -> Int
    forall t. Bitfield t -> Int
    bfShift Bitfield t
    bf

    -- | Convert a bit mask into a 'BitField'.

    makeBitfield :: (FiniteBits t, Integral t) => t -> Bitfield t
    makeBitfield :: forall t. (FiniteBits t, Integral t) => t -> Bitfield t
    makeBitfield t
    mask = t -> Int -> Float -> Bitfield t
    forall t. t -> Int -> Float -> Bitfield t
    Bitfield t
    mask Int
    shiftBits Float
    scale
      where
        shiftBits :: Int
    shiftBits = t -> Int
    forall b. FiniteBits b => b -> Int
    countTrailingZeros t
    mask
        scale :: Float
    scale = Float
    255 Float -> Float -> Float
    forall a. Fractional a => a -> a -> a
    / t -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (t
    mask t -> Int -> t
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    shiftBits)

    -- | Helper method to cast a 'B.ByteString' to a 'VS.Vector' of some type.

    castByteString :: VS.Storable a => B.ByteString -> VS.Vector a
    #if MIN_VERSION_bytestring(0,11,0)
    castByteString :: forall a. Storable a => ByteString -> Vector a
    castByteString (BI.BS ForeignPtr Word8
    fp Int
    len) = Vector Word8 -> Vector a
    forall a b. (Storable a, Storable b) => Vector a -> Vector b
    VS.unsafeCast (Vector Word8 -> Vector a) -> Vector Word8 -> Vector a
    forall a b. (a -> b) -> a -> b
    $ ForeignPtr Word8 -> Int -> Int -> Vector Word8
    forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
    VS.unsafeFromForeignPtr ForeignPtr Word8
    fp Int
    0 Int
    len
    #else
    castByteString (BI.PS fp offset len) = VS.unsafeCast $ VS.unsafeFromForeignPtr fp offset len
    #endif

    decodeImageRGBA8 :: RGBABmpFormat -> BmpV5Header -> B.ByteString -> Image PixelRGBA8
    decodeImageRGBA8 :: RGBABmpFormat -> BmpV5Header -> ByteString -> Image PixelRGBA8
    decodeImageRGBA8 RGBABmpFormat
    pixelFormat (BmpV5Header { width :: BmpV5Header -> Int32
    width = Int32
    w, height :: BmpV5Header -> Int32
    height = Int32
    h, bitPerPixel :: BmpV5Header -> Word16
    bitPerPixel = Word16
    bpp }) ByteString
    str = Int
    -> Int
    -> Vector (PixelBaseComponent PixelRGBA8)
    -> Image PixelRGBA8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    wi Int
    hi Vector Word8
    Vector (PixelBaseComponent PixelRGBA8)
    stArray where
      wi :: Int
    wi = Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    w
      hi :: Int
    hi = Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    h
      stArray :: Vector Word8
    stArray = (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Vector Word8)) -> Vector Word8)
    -> (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a b. (a -> b) -> a -> b
    $ do
          MVector s Word8
    arr <- Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new (Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int) -> Int32 -> Int
    forall a b. (a -> b) -> a -> b
    $ Int32
    w Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    * Int32 -> Int32
    forall a. Num a => a -> a
    abs Int32
    h Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    * Int32
    4)
          if Int32
    h Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int32
    0 then
            (Int -> Int -> ST s Int) -> Int -> [Int] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m ()
    foldM_ (MVector s Word8 -> Int -> Int -> ST s Int
    forall s. MVector s Word8 -> Int -> Int -> ST s Int
    readLine MVector s Word8
    arr) Int
    0 [Int
    0 .. Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
          else
            (Int -> Int -> ST s Int) -> Int -> [Int] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m ()
    foldM_ (MVector s Word8 -> Int -> Int -> ST s Int
    forall s. MVector s Word8 -> Int -> Int -> ST s Int
    readLine MVector s Word8
    arr) Int
    0 [Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2 .. Int
    0]
          MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    VS.unsafeFreeze MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr

      paddingWords :: Int
    paddingWords = (Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int -> Int -> Int
    linePadding Int
    intBPP Int
    wi) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    intBPP
      intBPP :: Int
    intBPP = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    bpp

      readLine :: forall s. M.MVector s Word8 -> Int -> Int -> ST s Int
      readLine :: forall s. MVector s Word8 -> Int -> Int -> ST s Int
    readLine MVector s Word8
    arr Int
    readIndex Int
    line = case RGBABmpFormat
    pixelFormat of
          RGBA32 Bitfields4 Word32
    bitfields -> Bitfields4 Word32 -> Vector Word32 -> Int -> Int -> ST s Int
    forall t.
    (FiniteBits t, Integral t, Storable t, Show t) =>
    Bitfields4 t -> Vector t -> Int -> Int -> ST s Int
    inner Bitfields4 Word32
    bitfields (ByteString -> Vector Word32
    forall a. Storable a => ByteString -> Vector a
    castByteString ByteString
    str) Int
    readIndex Int
    writeIndex
          RGBA16 Bitfields4 Word16
    bitfields -> Bitfields4 Word16 -> Vector Word16 -> Int -> Int -> ST s Int
    forall t.
    (FiniteBits t, Integral t, Storable t, Show t) =>
    Bitfields4 t -> Vector t -> Int -> Int -> ST s Int
    inner Bitfields4 Word16
    bitfields (ByteString -> Vector Word16
    forall a. Storable a => ByteString -> Vector a
    castByteString ByteString
    str) Int
    readIndex Int
    writeIndex
        where
          lastIndex :: Int
    lastIndex = Int
    wi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    line Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4
          writeIndex :: Int
    writeIndex = Int
    wi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    line) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4

          inner
            :: (FiniteBits t, Integral t, M.Storable t, Show t)
            => Bitfields4 t
            -> VS.Vector t
            -> Int
            -> Int
            -> ST s Int
          inner :: forall t.
    (FiniteBits t, Integral t, Storable t, Show t) =>
    Bitfields4 t -> Vector t -> Int -> Int -> ST s Int
    inner (Bitfields4 Bitfield t
    r Bitfield t
    g Bitfield t
    b Bitfield t
    a) Vector t
    inStr = Int -> Int -> ST s Int
    inner0
            where
              inner0 :: Int -> Int -> ST s Int
              inner0 :: Int -> Int -> ST s Int
    inner0 Int
    readIdx Int
    writeIdx | Int
    writeIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    lastIndex = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    paddingWords
              inner0 Int
    readIdx Int
    writeIdx = do
                let word :: t
    word = Vector t
    inStr Vector t -> Int -> t
    forall a. Storable a => Vector a -> Int -> a
    VS.! Int
    readIdx
                (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite`  Int
    writeIdx     ) (Bitfield t -> t -> Word8
    forall t. (FiniteBits t, Integral t) => Bitfield t -> t -> Word8
    extractBitfield Bitfield t
    r t
    word)
                (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) (Bitfield t -> t -> Word8
    forall t. (FiniteBits t, Integral t) => Bitfield t -> t -> Word8
    extractBitfield Bitfield t
    g t
    word)
                (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)) (Bitfield t -> t -> Word8
    forall t. (FiniteBits t, Integral t) => Bitfield t -> t -> Word8
    extractBitfield Bitfield t
    b t
    word)
                (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)) (Bitfield t -> t -> Word8
    forall t. (FiniteBits t, Integral t) => Bitfield t -> t -> Word8
    extractBitfield Bitfield t
    a t
    word)
                Int -> Int -> ST s Int
    inner0 (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4)

    decodeImageRGB8 :: RGBBmpFormat -> BmpV5Header -> B.ByteString -> Image PixelRGB8
    decodeImageRGB8 :: RGBBmpFormat -> BmpV5Header -> ByteString -> Image PixelRGB8
    decodeImageRGB8 RGBBmpFormat
    pixelFormat (BmpV5Header { width :: BmpV5Header -> Int32
    width = Int32
    w, height :: BmpV5Header -> Int32
    height = Int32
    h, bitPerPixel :: BmpV5Header -> Word16
    bitPerPixel = Word16
    bpp }) ByteString
    str = Int
    -> Int -> Vector (PixelBaseComponent PixelRGB8) -> Image PixelRGB8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    wi Int
    hi Vector Word8
    Vector (PixelBaseComponent PixelRGB8)
    stArray where
      wi :: Int
    wi = Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    w
      hi :: Int
    hi = Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    h
      stArray :: Vector Word8
    stArray = (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Vector Word8)) -> Vector Word8)
    -> (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a b. (a -> b) -> a -> b
    $ do
          MVector s Word8
    arr <- Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new (Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int) -> Int32 -> Int
    forall a b. (a -> b) -> a -> b
    $ Int32
    w Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    * Int32 -> Int32
    forall a. Num a => a -> a
    abs Int32
    h Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    * Int32
    3)
          if Int32
    h Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int32
    0 then
            (Int -> Int -> ST s Int) -> Int -> [Int] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m ()
    foldM_ (MVector s Word8 -> Int -> Int -> ST s Int
    forall s. MVector s Word8 -> Int -> Int -> ST s Int
    readLine MVector s Word8
    arr) Int
    0 [Int
    0 .. Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
          else
            (Int -> Int -> ST s Int) -> Int -> [Int] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m ()
    foldM_ (MVector s Word8 -> Int -> Int -> ST s Int
    forall s. MVector s Word8 -> Int -> Int -> ST s Int
    readLine MVector s Word8
    arr) Int
    0 [Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2 .. Int
    0]
          MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    VS.unsafeFreeze MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr

      paddingBytes :: Int
    paddingBytes = Int -> Int -> Int
    linePadding Int
    intBPP Int
    wi
      paddingWords :: Int
    paddingWords = (Int -> Int -> Int
    linePadding Int
    intBPP Int
    wi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    8) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    intBPP
      intBPP :: Int
    intBPP = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    bpp

      readLine :: forall s. M.MVector s Word8 -> Int -> Int -> ST s Int
      readLine :: forall s. MVector s Word8 -> Int -> Int -> ST s Int
    readLine MVector s Word8
    arr Int
    readIndex Int
    line = case RGBBmpFormat
    pixelFormat of
          RGB16 Bitfields3 Word16
    bitfields -> Bitfields3 Word16 -> Vector Word16 -> Int -> Int -> ST s Int
    forall t.
    (FiniteBits t, Integral t, Storable t, Show t) =>
    Bitfields3 t -> Vector t -> Int -> Int -> ST s Int
    innerBF Bitfields3 Word16
    bitfields (ByteString -> Vector Word16
    forall a. Storable a => ByteString -> Vector a
    castByteString ByteString
    str) Int
    readIndex Int
    writeIndex
          RGB32 Bitfields3 Word32
    bitfields -> Bitfields3 Word32 -> Vector Word32 -> Int -> Int -> ST s Int
    forall t.
    (FiniteBits t, Integral t, Storable t, Show t) =>
    Bitfields3 t -> Vector t -> Int -> Int -> ST s Int
    innerBF Bitfields3 Word32
    bitfields (ByteString -> Vector Word32
    forall a. Storable a => ByteString -> Vector a
    castByteString ByteString
    str) Int
    readIndex Int
    writeIndex
          RGBBmpFormat
    RGB24 -> Int -> Int -> ST s Int
    inner24 Int
    readIndex Int
    writeIndex
        where
          lastIndex :: Int
    lastIndex = Int
    wi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    line Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3
          writeIndex :: Int
    writeIndex = Int
    wi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    line) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3

          inner24 :: Int -> Int -> ST s Int
    inner24 Int
    readIdx Int
    writeIdx | Int
    writeIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    lastIndex = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    paddingBytes
          inner24 Int
    readIdx Int
    writeIdx = do
              (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite`  Int
    writeIdx     ) (ByteString
    str HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `B.index` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2))
              (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) (ByteString
    str HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `B.index` (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1))
              (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)) (ByteString
    str HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `B.index`  Int
    readIdx)
              Int -> Int -> ST s Int
    inner24 (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)

          innerBF
            :: (FiniteBits t, Integral t, M.Storable t, Show t)
            => Bitfields3 t
            -> VS.Vector t
            -> Int
            -> Int
            -> ST s Int
          innerBF :: forall t.
    (FiniteBits t, Integral t, Storable t, Show t) =>
    Bitfields3 t -> Vector t -> Int -> Int -> ST s Int
    innerBF (Bitfields3 Bitfield t
    r Bitfield t
    g Bitfield t
    b) Vector t
    inStr = Int -> Int -> ST s Int
    innerBF0
            where
              innerBF0 :: Int -> Int -> ST s Int
              innerBF0 :: Int -> Int -> ST s Int
    innerBF0 Int
    readIdx Int
    writeIdx | Int
    writeIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    lastIndex = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    paddingWords
              innerBF0 Int
    readIdx Int
    writeIdx = do
                let word :: t
    word = Vector t
    inStr Vector t -> Int -> t
    forall a. Storable a => Vector a -> Int -> a
    VS.! Int
    readIdx
                (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite`  Int
    writeIdx     ) (Bitfield t -> t -> Word8
    forall t. (FiniteBits t, Integral t) => Bitfield t -> t -> Word8
    extractBitfield Bitfield t
    r t
    word)
                (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) (Bitfield t -> t -> Word8
    forall t. (FiniteBits t, Integral t) => Bitfield t -> t -> Word8
    extractBitfield Bitfield t
    g t
    word)
                (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)) (Bitfield t -> t -> Word8
    forall t. (FiniteBits t, Integral t) => Bitfield t -> t -> Word8
    extractBitfield Bitfield t
    b t
    word)
                Int -> Int -> ST s Int
    innerBF0 (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)

    decodeImageY8 :: IndexedBmpFormat -> BmpV5Header -> B.ByteString -> Image Pixel8
    decodeImageY8 :: IndexedBmpFormat -> BmpV5Header -> ByteString -> Image Word8
    decodeImageY8 IndexedBmpFormat
    lowBPP (BmpV5Header { width :: BmpV5Header -> Int32
    width = Int32
    w, height :: BmpV5Header -> Int32
    height = Int32
    h, bitPerPixel :: BmpV5Header -> Word16
    bitPerPixel = Word16
    bpp }) ByteString
    str = Int -> Int -> Vector (PixelBaseComponent Word8) -> Image Word8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    wi Int
    hi Vector Word8
    Vector (PixelBaseComponent Word8)
    stArray where
      wi :: Int
    wi = Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    w
      hi :: Int
    hi = Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    h
      stArray :: Vector Word8
    stArray = (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Vector Word8)) -> Vector Word8)
    -> (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a b. (a -> b) -> a -> b
    $ do
          MVector s Word8
    arr <- Int -> ST s (MVector s Word8)
    Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new (Int -> ST s (MVector s Word8))
    -> (Int32 -> Int) -> Int32 -> ST s (MVector s Word8)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> ST s (MVector s Word8))
    -> Int32 -> ST s (MVector s Word8)
    forall a b. (a -> b) -> a -> b
    $ Int32
    w Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    * Int32 -> Int32
    forall a. Num a => a -> a
    abs Int32
    h
          if Int32
    h Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int32
    0 then
            (Int -> Int -> ST s Int) -> Int -> [Int] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m ()
    foldM_ (MVector s Word8 -> Int -> Int -> ST s Int
    forall s. MVector s Word8 -> Int -> Int -> ST s Int
    readLine MVector s Word8
    arr) Int
    0 [Int
    0 .. Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
          else
            (Int -> Int -> ST s Int) -> Int -> [Int] -> ST s ()
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m ()
    foldM_ (MVector s Word8 -> Int -> Int -> ST s Int
    forall s. MVector s Word8 -> Int -> Int -> ST s Int
    readLine MVector s Word8
    arr) Int
    0 [Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2 .. Int
    0]
          MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    VS.unsafeFreeze MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr

      padding :: Int
    padding = Int -> Int -> Int
    linePadding (Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    bpp) Int
    wi

      readLine :: forall s. M.MVector s Word8 -> Int -> Int -> ST s Int
      readLine :: forall s. MVector s Word8 -> Int -> Int -> ST s Int
    readLine MVector s Word8
    arr Int
    readIndex Int
    line = case IndexedBmpFormat
    lowBPP of
          IndexedBmpFormat
    OneBPP -> Int -> Int -> ST s Int
    inner1 Int
    readIndex Int
    writeIndex
          IndexedBmpFormat
    FourBPP -> Int -> Int -> ST s Int
    inner4 Int
    readIndex Int
    writeIndex
          IndexedBmpFormat
    EightBPP -> Int -> Int -> ST s Int
    inner8 Int
    readIndex Int
    writeIndex
        where
          lastIndex :: Int
    lastIndex = Int
    wi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    line Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
          writeIndex :: Int
    writeIndex = Int
    wi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    line)

          inner8 :: Int -> Int -> ST s Int
    inner8 Int
    readIdx Int
    writeIdx | Int
    writeIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    lastIndex = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    padding
          inner8 Int
    readIdx Int
    writeIdx = do
            (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    writeIdx) (ByteString
    str HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `B.index` Int
    readIdx)
            Int -> Int -> ST s Int
    inner8 (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

          inner4 :: Int -> Int -> ST s Int
    inner4 Int
    readIdx Int
    writeIdx | Int
    writeIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    lastIndex = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    padding
          inner4 Int
    readIdx Int
    writeIdx = do
            let byte :: Word8
    byte = ByteString
    str HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `B.index` Int
    readIdx
            if Int
    writeIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    lastIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1 then do
              (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    writeIdx) (Word8
    byte Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4)
              Int -> Int -> ST s Int
    inner4 (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
            else do
              (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    writeIdx) (Word8
    byte Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4)
              (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) (Word8
    byte Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x0F)
              Int -> Int -> ST s Int
    inner4 (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)

          inner1 :: Int -> Int -> ST s Int
    inner1 Int
    readIdx Int
    writeIdx | Int
    writeIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    lastIndex = Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    padding
          inner1 Int
    readIdx Int
    writeIdx = do
            let byte :: Word8
    byte = ByteString
    str HasCallStack => ByteString -> Int -> Word8
    ByteString -> Int -> Word8
    `B.index` Int
    readIdx
            let toWrite :: Int
    toWrite = (Int
    lastIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    writeIdx) Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    `min` Int
    8
            [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. (Int
    toWrite Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    i ->
              Bool -> ST s () -> ST s ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word8
    byte Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` (Int
    7 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i)) (ST s () -> ST s ()) -> ST s () -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    i)) Word8
    1
            Int -> Int -> ST s Int
    inner1 (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    toWrite)

    decodeImageY8RLE :: Bool -> BmpV5Header -> B.ByteString -> Image Pixel8
    decodeImageY8RLE :: Bool -> BmpV5Header -> ByteString -> Image Word8
    decodeImageY8RLE Bool
    is4bpp (BmpV5Header { width :: BmpV5Header -> Int32
    width = Int32
    w, height :: BmpV5Header -> Int32
    height = Int32
    h, byteImageSize :: BmpV5Header -> Word32
    byteImageSize = Word32
    sz }) ByteString
    str = Int -> Int -> Vector (PixelBaseComponent Word8) -> Image Word8
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    wi Int
    hi Vector Word8
    Vector (PixelBaseComponent Word8)
    stArray where
      wi :: Int
    wi = Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    w
      hi :: Int
    hi = Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    h
      xOffsetMax :: Int
    xOffsetMax = Int
    wi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

      stArray :: Vector Word8
    stArray = (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Vector Word8)) -> Vector Word8)
    -> (forall s. ST s (Vector Word8)) -> Vector Word8
    forall a b. (a -> b) -> a -> b
    $ do
        MVector s Word8
    arr <- Int -> ST s (MVector s Word8)
    Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new (Int -> ST s (MVector s Word8))
    -> (Int32 -> Int) -> Int32 -> ST s (MVector s Word8)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> ST s (MVector s Word8))
    -> Int32 -> ST s (MVector s Word8)
    forall a b. (a -> b) -> a -> b
    $ Int32
    w Int32 -> Int32 -> Int32
    forall a. Num a => a -> a -> a
    * Int32 -> Int32
    forall a. Num a => a -> a
    abs Int32
    h
        MVector s Word8 -> [Word8] -> (Int, Int) -> ST s ()
    forall s. MVector s Word8 -> [Word8] -> (Int, Int) -> ST s ()
    decodeRLE MVector s Word8
    arr (ByteString -> [Word8]
    B.unpack (Int -> ByteString -> ByteString
    B.take (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    sz) ByteString
    str)) ((Int
    hi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    wi, Int
    0)
        MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    VS.unsafeFreeze MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr

      decodeRLE :: forall s . M.MVector s Word8 -> [Word8] -> (Int, Int) -> ST s ()
      decodeRLE :: forall s. MVector s Word8 -> [Word8] -> (Int, Int) -> ST s ()
    decodeRLE MVector s Word8
    arr = [Word8] -> (Int, Int) -> ST s ()
    inner
        where
          inner :: [Word8] -> (Int, Int) -> ST s ()
          inner :: [Word8] -> (Int, Int) -> ST s ()
    inner [] (Int, Int)
    _ = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          inner (Word8
    0 : Word8
    0 : [Word8]
    rest) (Int
    yOffset, Int
    _) = [Word8] -> (Int, Int) -> ST s ()
    inner [Word8]
    rest (Int
    yOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    wi, Int
    0)
          inner (Word8
    0 : Word8
    1 : [Word8]
    _) (Int, Int)
    _ = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          inner (Word8
    0 : Word8
    2 : Word8
    hOffset : Word8
    vOffset : [Word8]
    rest) (Int
    yOffset, Int
    _) =
            [Word8] -> (Int, Int) -> ST s ()
    inner [Word8]
    rest (Int
    yOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    wi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    vOffset), Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    hOffset)
          inner (Word8
    0 : Word8
    n : [Word8]
    rest) (Int, Int)
    writePos =
            let isPadded :: Bool
    isPadded = if Bool
    is4bpp then (Word8
    n Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    3) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x3 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    2 else Word8 -> Bool
    forall a. Integral a => a -> Bool
    odd Word8
    n
            in Bool -> Int -> [Word8] -> (Int, Int) -> ST s ()
    copyN Bool
    isPadded (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    n) [Word8]
    rest (Int, Int)
    writePos
          inner (Word8
    n : Word8
    b : [Word8]
    rest) (Int, Int)
    writePos = Int -> Word8 -> [Word8] -> (Int, Int) -> ST s ()
    writeN (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    n) Word8
    b [Word8]
    rest (Int, Int)
    writePos
          inner [Word8]
    _ (Int, Int)
    _ = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

          -- | Write n copies of a byte to the output array.

          writeN :: Int -> Word8 -> [Word8] -> (Int, Int) -> ST s ()
          writeN :: Int -> Word8 -> [Word8] -> (Int, Int) -> ST s ()
    writeN Int
    0 Word8
    _ [Word8]
    rest (Int, Int)
    writePos = [Word8] -> (Int, Int) -> ST s ()
    inner [Word8]
    rest (Int, Int)
    writePos
          writeN Int
    n Word8
    b [Word8]
    rest (Int, Int)
    writePos =
            case (Bool
    is4bpp, Int
    n) of
              (Bool
    True, Int
    1) ->
                Word8 -> (Int, Int) -> ST s (Int, Int)
    writeByte (Word8
    b Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4) (Int, Int)
    writePos ST s (Int, Int) -> ((Int, Int) -> ST s ()) -> ST s ()
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> Word8 -> [Word8] -> (Int, Int) -> ST s ()
    writeN (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Word8
    b [Word8]
    rest
              (Bool
    True, Int
    _) ->
                Word8 -> (Int, Int) -> ST s (Int, Int)
    writeByte (Word8
    b Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4) (Int, Int)
    writePos
                  ST s (Int, Int)
    -> ((Int, Int) -> ST s (Int, Int)) -> ST s (Int, Int)
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Word8 -> (Int, Int) -> ST s (Int, Int)
    writeByte (Word8
    b Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x0F) ST s (Int, Int) -> ((Int, Int) -> ST s ()) -> ST s ()
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> Word8 -> [Word8] -> (Int, Int) -> ST s ()
    writeN (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) Word8
    b [Word8]
    rest
              (Bool
    False, Int
    _) ->
                Word8 -> (Int, Int) -> ST s (Int, Int)
    writeByte Word8
    b (Int, Int)
    writePos ST s (Int, Int) -> ((Int, Int) -> ST s ()) -> ST s ()
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> Word8 -> [Word8] -> (Int, Int) -> ST s ()
    writeN (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) Word8
    b [Word8]
    rest

          -- | Copy the next byte to the output array, possibly ignoring a padding byte at the end.

          copyN :: Bool -> Int -> [Word8] -> (Int, Int) -> ST s ()
          copyN :: Bool -> Int -> [Word8] -> (Int, Int) -> ST s ()
    copyN Bool
    _ Int
    _ [] (Int, Int)
    _ = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          copyN Bool
    False Int
    0 [Word8]
    rest (Int, Int)
    writePos = [Word8] -> (Int, Int) -> ST s ()
    inner [Word8]
    rest (Int, Int)
    writePos
          copyN Bool
    True Int
    0 (Word8
    _:[Word8]
    rest) (Int, Int)
    writePos = [Word8] -> (Int, Int) -> ST s ()
    inner [Word8]
    rest (Int, Int)
    writePos
          copyN Bool
    isPadded Int
    n (Word8
    b : [Word8]
    rest) (Int, Int)
    writePos =
            case (Bool
    is4bpp, Int
    n) of
              (Bool
    True, Int
    1) ->
                Word8 -> (Int, Int) -> ST s (Int, Int)
    writeByte (Word8
    b Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4) (Int, Int)
    writePos ST s (Int, Int) -> ((Int, Int) -> ST s ()) -> ST s ()
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Int -> [Word8] -> (Int, Int) -> ST s ()
    copyN Bool
    isPadded (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) [Word8]
    rest
              (Bool
    True, Int
    _) ->
                Word8 -> (Int, Int) -> ST s (Int, Int)
    writeByte (Word8
    b Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4) (Int, Int)
    writePos
                  ST s (Int, Int)
    -> ((Int, Int) -> ST s (Int, Int)) -> ST s (Int, Int)
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Word8 -> (Int, Int) -> ST s (Int, Int)
    writeByte (Word8
    b Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x0F) ST s (Int, Int) -> ((Int, Int) -> ST s ()) -> ST s ()
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Int -> [Word8] -> (Int, Int) -> ST s ()
    copyN Bool
    isPadded (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    2) [Word8]
    rest
              (Bool
    False, Int
    _) ->
                Word8 -> (Int, Int) -> ST s (Int, Int)
    writeByte Word8
    b (Int, Int)
    writePos ST s (Int, Int) -> ((Int, Int) -> ST s ()) -> ST s ()
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Bool -> Int -> [Word8] -> (Int, Int) -> ST s ()
    copyN Bool
    isPadded (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) [Word8]
    rest

          -- | Write the next byte to the output array.

          writeByte :: Word8 -> (Int, Int) -> ST s (Int, Int)
          writeByte :: Word8 -> (Int, Int) -> ST s (Int, Int)
    writeByte Word8
    byte (Int
    yOffset, Int
    xOffset) = do
            (MVector s Word8
    MVector (PrimState (ST s)) Word8
    arr MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    yOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    xOffset)) Word8
    byte
            (Int, Int) -> ST s (Int, Int)
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    yOffset, (Int
    xOffset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    `min` Int
    xOffsetMax)

    pixel4Get :: Get [Word8]
    pixel4Get :: Get [Word8]
    pixel4Get = do
        Word8
    b <- Get Word8
    getWord8
        Word8
    g <- Get Word8
    getWord8
        Word8
    r <- Get Word8
    getWord8
        Word8
    _ <- Get Word8
    getWord8
        [Word8] -> Get [Word8]
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Word8
    r, Word8
    g, Word8
    b]

    pixel3Get :: Get [Word8]
    pixel3Get :: Get [Word8]
    pixel3Get = do
        Word8
    b <- Get Word8
    getWord8
        Word8
    g <- Get Word8
    getWord8
        Word8
    r <- Get Word8
    getWord8
        [Word8] -> Get [Word8]
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Word8
    r, Word8
    g, Word8
    b]

    metadataOfHeader :: BmpV5Header -> Maybe B.ByteString -> Metadatas
    metadataOfHeader :: BmpV5Header -> Maybe ByteString -> Metadatas
    metadataOfHeader BmpV5Header
    hdr Maybe ByteString
    iccProfile =
        Metadatas
    cs Metadatas -> Metadatas -> Metadatas
    forall a. Monoid a => a -> a -> a
    `mappend` SourceFormat -> Int32 -> Int32 -> Word -> Word -> Metadatas
    forall nSize nDpi.
    (Integral nSize, Integral nDpi) =>
    SourceFormat -> nSize -> nSize -> nDpi -> nDpi -> Metadatas
    Met.simpleMetadata SourceFormat
    Met.SourceBitmap (BmpV5Header -> Int32
    width BmpV5Header
    hdr) (Int32 -> Int32
    forall a. Num a => a -> a
    abs (Int32 -> Int32) -> Int32 -> Int32
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    height BmpV5Header
    hdr) Word
    dpiX Word
    dpiY
      where
        dpiX :: Word
    dpiX = Word -> Word
    Met.dotsPerMeterToDotPerInch (Word -> Word) -> (Int32 -> Word) -> Int32 -> Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int32 -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Word) -> Int32 -> Word
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    xResolution BmpV5Header
    hdr
        dpiY :: Word
    dpiY = Word -> Word
    Met.dotsPerMeterToDotPerInch (Word -> Word) -> (Int32 -> Word) -> Int32 -> Word
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int32 -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Word) -> Int32 -> Word
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    yResolution BmpV5Header
    hdr
        cs :: Metadatas
    cs = case BmpV5Header -> ColorSpaceType
    colorSpaceType BmpV5Header
    hdr of
              ColorSpaceType
    CalibratedRGB -> Keys ColorSpace -> ColorSpace -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton
                Keys ColorSpace
    Met.ColorSpace (ByteString -> ColorSpace
    Met.WindowsBitmapColorSpace (ByteString -> ColorSpace) -> ByteString -> ColorSpace
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> ByteString
    colorSpace BmpV5Header
    hdr)
              ColorSpaceType
    SRGB -> Keys ColorSpace -> ColorSpace -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton Keys ColorSpace
    Met.ColorSpace ColorSpace
    Met.SRGB
              ColorSpaceType
    ProfileEmbedded -> case Maybe ByteString
    iccProfile of
                                  Maybe ByteString
    Nothing -> Metadatas
    Met.empty
                                  Just ByteString
    profile -> Keys ColorSpace -> ColorSpace -> Metadatas
    forall a. (Show a, NFData a) => Keys a -> a -> Metadatas
    Met.singleton Keys ColorSpace
    Met.ColorSpace
                                                    (ByteString -> ColorSpace
    Met.ICCProfile ByteString
    profile)
              ColorSpaceType
    _ -> Metadatas
    Met.empty

    -- | Try to decode a bitmap image.

    -- Right now this function can output the following image:

    --

    --   - 'ImageY8'

    --

    --   - 'ImageRGB8'

    --

    --   - 'ImageRGBA8'

    --

    decodeBitmap :: B.ByteString -> Either String DynamicImage
    decodeBitmap :: ByteString -> Either String DynamicImage
    decodeBitmap = ((DynamicImage, Metadatas) -> DynamicImage)
    -> Either String (DynamicImage, Metadatas)
    -> Either String DynamicImage
    forall a b. (a -> b) -> Either String a -> Either String b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (DynamicImage, Metadatas) -> DynamicImage
    forall a b. (a, b) -> a
    fst (Either String (DynamicImage, Metadatas)
     -> Either String DynamicImage)
    -> (ByteString -> Either String (DynamicImage, Metadatas))
    -> ByteString
    -> Either String DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either String (DynamicImage, Metadatas)
    decodeBitmapWithMetadata

    -- | Same as 'decodeBitmap' but also extracts metadata.

    decodeBitmapWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
    decodeBitmapWithMetadata :: ByteString -> Either String (DynamicImage, Metadatas)
    decodeBitmapWithMetadata ByteString
    byte =
      (PalettedImage -> DynamicImage)
    -> (PalettedImage, Metadatas) -> (DynamicImage, Metadatas)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first PalettedImage -> DynamicImage
    palettedToTrueColor ((PalettedImage, Metadatas) -> (DynamicImage, Metadatas))
    -> Either String (PalettedImage, Metadatas)
    -> Either String (DynamicImage, Metadatas)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> Either String (PalettedImage, Metadatas)
    decodeBitmapWithPaletteAndMetadata ByteString
    byte

    -- | Same as 'decodeBitmap' but also extracts metadata and provide separated palette.

    decodeBitmapWithPaletteAndMetadata :: B.ByteString -> Either String (PalettedImage, Metadatas)
    decodeBitmapWithPaletteAndMetadata :: ByteString -> Either String (PalettedImage, Metadatas)
    decodeBitmapWithPaletteAndMetadata ByteString
    str = (Get (PalettedImage, Metadatas)
     -> ByteString -> Either String (PalettedImage, Metadatas))
    -> ByteString
    -> Get (PalettedImage, Metadatas)
    -> Either String (PalettedImage, Metadatas)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Get (PalettedImage, Metadatas)
    -> ByteString -> Either String (PalettedImage, Metadatas)
    forall a. Get a -> ByteString -> Either String a
    runGetStrict ByteString
    str (Get (PalettedImage, Metadatas)
     -> Either String (PalettedImage, Metadatas))
    -> Get (PalettedImage, Metadatas)
    -> Either String (PalettedImage, Metadatas)
    forall a b. (a -> b) -> a -> b
    $ do
      BmpHeader
    fileHeader <- Get BmpHeader
    forall t. Binary t => Get t
    get :: Get BmpHeader
      BmpV5Header
    bmpHeader  <- Get BmpV5Header
    forall t. Binary t => Get t
    get :: Get BmpV5Header

      Int64
    readed <- Get Int64
    bytesRead
      Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int64
    readed Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (BmpHeader -> Word32
    dataOffset BmpHeader
    fileHeader))
           (String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Invalid bmp image, data in header")

      Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (BmpV5Header -> Int32
    width BmpV5Header
    bmpHeader Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int32
    0)
           (String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Get ()) -> String -> Get ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid bmp width, " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int32 -> String
    forall a. Show a => a -> String
    show (BmpV5Header -> Int32
    width BmpV5Header
    bmpHeader))

      Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (BmpV5Header -> Int32
    height BmpV5Header
    bmpHeader Int32 -> Int32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int32
    0)
           (String -> Get ()
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Get ()) -> String -> Get ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid bmp height (0) ")

      BmpHeader -> BmpV5Header -> Get (PalettedImage, Metadatas)
    decodeBitmapWithHeaders BmpHeader
    fileHeader BmpV5Header
    bmpHeader

    -- | Decode the rest of a bitmap, after the headers have been decoded.

    decodeBitmapWithHeaders :: BmpHeader -> BmpV5Header -> Get (PalettedImage, Metadatas)
    decodeBitmapWithHeaders :: BmpHeader -> BmpV5Header -> Get (PalettedImage, Metadatas)
    decodeBitmapWithHeaders BmpHeader
    fileHdr BmpV5Header
    hdr = do
        PalettedImage
    img <- Get PalettedImage
    bitmapData
        Maybe ByteString
    profile <- Get (Maybe ByteString)
    getICCProfile
        (PalettedImage, Metadatas) -> Get (PalettedImage, Metadatas)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((PalettedImage, Metadatas) -> Get (PalettedImage, Metadatas))
    -> (PalettedImage, Metadatas) -> Get (PalettedImage, Metadatas)
    forall a b. (a -> b) -> a -> b
    $ Maybe ByteString -> PalettedImage -> (PalettedImage, Metadatas)
    addMetadata Maybe ByteString
    profile PalettedImage
    img

      where
        bpp :: Int
    bpp = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word16
    bitPerPixel BmpV5Header
    hdr :: Int
        paletteColorCount :: Int
    paletteColorCount
          | BmpV5Header -> Word32
    colorCount BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    0 = Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int
    bpp
          | Bool
    otherwise = Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Word32 -> Int
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    colorCount BmpV5Header
    hdr

        addMetadata :: Maybe ByteString -> PalettedImage -> (PalettedImage, Metadatas)
    addMetadata Maybe ByteString
    profile PalettedImage
    i = (PalettedImage
    i, BmpV5Header -> Maybe ByteString -> Metadatas
    metadataOfHeader BmpV5Header
    hdr Maybe ByteString
    profile)

        getData :: Get ByteString
    getData = do
          Int64
    readed <- Get Int64
    bytesRead
          String -> Get () -> Get ()
    forall a. String -> Get a -> Get a
    label String
    "Start of pixel data" (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
            Int -> Get ()
    skip (Int -> Get ()) -> (Word32 -> Int) -> Word32 -> Get ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Get ()) -> Word32 -> Get ()
    forall a b. (a -> b) -> a -> b
    $ BmpHeader -> Word32
    dataOffset BmpHeader
    fileHdr Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Int64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    readed
          let pixelBytes :: Int
    pixelBytes = if BmpV5Header -> Word32
    bitmapCompression BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    1 Bool -> Bool -> Bool
    || BmpV5Header -> Word32
    bitmapCompression BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    2
                              then Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Word32 -> Int
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    byteImageSize BmpV5Header
    hdr
                              else Int -> Int -> Int -> Int
    sizeofPixelData Int
    bpp (Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int) -> Int32 -> Int
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    width BmpV5Header
    hdr)
                                                       (Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int) -> Int32 -> Int
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Int32
    height BmpV5Header
    hdr)
          String -> Get ByteString -> Get ByteString
    forall a. String -> Get a -> Get a
    label String
    "Pixel data" (Get ByteString -> Get ByteString)
    -> Get ByteString -> Get ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> Get ByteString
    getByteString Int
    pixelBytes

        getICCProfile :: Get (Maybe ByteString)
    getICCProfile =
          if BmpV5Header -> Word32
    size BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word32
    sizeofBmpV5Header
              Bool -> Bool -> Bool
    && BmpV5Header -> ColorSpaceType
    colorSpaceType BmpV5Header
    hdr ColorSpaceType -> ColorSpaceType -> Bool
    forall a. Eq a => a -> a -> Bool
    == ColorSpaceType
    ProfileLinked
              Bool -> Bool -> Bool
    && BmpV5Header -> Word32
    iccProfileData BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32
    0
              Bool -> Bool -> Bool
    && BmpV5Header -> Word32
    iccProfileSize BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word32
    0
          then do
            Int64
    readSoFar <- Get Int64
    bytesRead
            String -> Get () -> Get ()
    forall a. String -> Get a -> Get a
    label String
    "Start of embedded ICC color profile" (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
              Int -> Get ()
    skip (Int -> Get ()) -> Int -> Get ()
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (BmpV5Header -> Word32
    iccProfileData BmpV5Header
    hdr) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    readSoFar
            ByteString
    profile <- String -> Get ByteString -> Get ByteString
    forall a. String -> Get a -> Get a
    label String
    "Embedded ICC color profile" (Get ByteString -> Get ByteString)
    -> Get ByteString -> Get ByteString
    forall a b. (a -> b) -> a -> b
    $
                          Int -> Get ByteString
    getByteString (Int -> Get ByteString)
    -> (Word32 -> Int) -> Word32 -> Get ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Get ByteString) -> Word32 -> Get ByteString
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    iccProfileSize BmpV5Header
    hdr
            Maybe ByteString -> Get (Maybe ByteString)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    profile)
          else Maybe ByteString -> Get (Maybe ByteString)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing

        bitmapData :: Get PalettedImage
    bitmapData = case (BmpV5Header -> Word16
    bitPerPixel BmpV5Header
    hdr, BmpV5Header -> Word16
    planes BmpV5Header
    hdr, BmpV5Header -> Word32
    bitmapCompression BmpV5Header
    hdr) of
          (Word16
    32, Word16
    1, Word32
    0) -> do
            ByteString
    rest <- Get ByteString
    getData
            PalettedImage -> Get PalettedImage
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PalettedImage -> Get PalettedImage)
    -> (Image PixelRGB8 -> PalettedImage)
    -> Image PixelRGB8
    -> Get PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynamicImage -> PalettedImage
    TrueColorImage (DynamicImage -> PalettedImage)
    -> (Image PixelRGB8 -> DynamicImage)
    -> Image PixelRGB8
    -> PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGB8 -> DynamicImage
    ImageRGB8 (Image PixelRGB8 -> Get PalettedImage)
    -> Image PixelRGB8 -> Get PalettedImage
    forall a b. (a -> b) -> a -> b
    $
              RGBBmpFormat -> BmpV5Header -> ByteString -> Image PixelRGB8
    decodeImageRGB8 (Bitfields3 Word32 -> RGBBmpFormat
    RGB32 Bitfields3 Word32
    defaultBitfieldsRGB32) BmpV5Header
    hdr ByteString
    rest
            -- (2, 1, 0, 3) means BGRA pixel order

          (Word16
    32, Word16
    1, Word32
    3) -> do
            Bitfield Word32
    r <- Word32 -> Get (Bitfield Word32)
    forall t (m :: * -> *).
    (FiniteBits t, Integral t, Num t, MonadFail m) =>
    t -> m (Bitfield t)
    getBitfield (Word32 -> Get (Bitfield Word32))
    -> Word32 -> Get (Bitfield Word32)
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    redMask BmpV5Header
    hdr
            Bitfield Word32
    g <- Word32 -> Get (Bitfield Word32)
    forall t (m :: * -> *).
    (FiniteBits t, Integral t, Num t, MonadFail m) =>
    t -> m (Bitfield t)
    getBitfield (Word32 -> Get (Bitfield Word32))
    -> Word32 -> Get (Bitfield Word32)
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    greenMask BmpV5Header
    hdr
            Bitfield Word32
    b <- Word32 -> Get (Bitfield Word32)
    forall t (m :: * -> *).
    (FiniteBits t, Integral t, Num t, MonadFail m) =>
    t -> m (Bitfield t)
    getBitfield (Word32 -> Get (Bitfield Word32))
    -> Word32 -> Get (Bitfield Word32)
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    blueMask BmpV5Header
    hdr
            ByteString
    rest     <- Get ByteString
    getData
            if BmpV5Header -> Word32
    alphaMask BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    0
              then PalettedImage -> Get PalettedImage
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PalettedImage -> Get PalettedImage)
    -> (Image PixelRGB8 -> PalettedImage)
    -> Image PixelRGB8
    -> Get PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynamicImage -> PalettedImage
    TrueColorImage (DynamicImage -> PalettedImage)
    -> (Image PixelRGB8 -> DynamicImage)
    -> Image PixelRGB8
    -> PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGB8 -> DynamicImage
    ImageRGB8 (Image PixelRGB8 -> Get PalettedImage)
    -> Image PixelRGB8 -> Get PalettedImage
    forall a b. (a -> b) -> a -> b
    $
                RGBBmpFormat -> BmpV5Header -> ByteString -> Image PixelRGB8
    decodeImageRGB8 (Bitfields3 Word32 -> RGBBmpFormat
    RGB32 (Bitfields3 Word32 -> RGBBmpFormat)
    -> Bitfields3 Word32 -> RGBBmpFormat
    forall a b. (a -> b) -> a -> b
    $ Bitfield Word32
    -> Bitfield Word32 -> Bitfield Word32 -> Bitfields3 Word32
    forall t. Bitfield t -> Bitfield t -> Bitfield t -> Bitfields3 t
    Bitfields3 Bitfield Word32
    r Bitfield Word32
    g Bitfield Word32
    b) BmpV5Header
    hdr ByteString
    rest
              else do
                Bitfield Word32
    a <- Word32 -> Get (Bitfield Word32)
    forall t (m :: * -> *).
    (FiniteBits t, Integral t, Num t, MonadFail m) =>
    t -> m (Bitfield t)
    getBitfield (Word32 -> Get (Bitfield Word32))
    -> Word32 -> Get (Bitfield Word32)
    forall a b. (a -> b) -> a -> b
    $ BmpV5Header -> Word32
    alphaMask BmpV5Header
    hdr
                PalettedImage -> Get PalettedImage
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PalettedImage -> Get PalettedImage)
    -> (Image PixelRGBA8 -> PalettedImage)
    -> Image PixelRGBA8
    -> Get PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynamicImage -> PalettedImage
    TrueColorImage (DynamicImage -> PalettedImage)
    -> (Image PixelRGBA8 -> DynamicImage)
    -> Image PixelRGBA8
    -> PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGBA8 -> DynamicImage
    ImageRGBA8 (Image PixelRGBA8 -> Get PalettedImage)
    -> Image PixelRGBA8 -> Get PalettedImage
    forall a b. (a -> b) -> a -> b
    $
                  RGBABmpFormat -> BmpV5Header -> ByteString -> Image PixelRGBA8
    decodeImageRGBA8 (Bitfields4 Word32 -> RGBABmpFormat
    RGBA32 (Bitfields4 Word32 -> RGBABmpFormat)
    -> Bitfields4 Word32 -> RGBABmpFormat
    forall a b. (a -> b) -> a -> b
    $ Bitfield Word32
    -> Bitfield Word32
    -> Bitfield Word32
    -> Bitfield Word32
    -> Bitfields4 Word32
    forall t.
    Bitfield t
    -> Bitfield t -> Bitfield t -> Bitfield t -> Bitfields4 t
    Bitfields4 Bitfield Word32
    r Bitfield Word32
    g Bitfield Word32
    b Bitfield Word32
    a) BmpV5Header
    hdr ByteString
    rest
          (Word16
    24, Word16
    1, Word32
    0) -> do
            ByteString
    rest <- Get ByteString
    getData
            PalettedImage -> Get PalettedImage
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PalettedImage -> Get PalettedImage)
    -> (Image PixelRGB8 -> PalettedImage)
    -> Image PixelRGB8
    -> Get PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynamicImage -> PalettedImage
    TrueColorImage (DynamicImage -> PalettedImage)
    -> (Image PixelRGB8 -> DynamicImage)
    -> Image PixelRGB8
    -> PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGB8 -> DynamicImage
    ImageRGB8 (Image PixelRGB8 -> Get PalettedImage)
    -> Image PixelRGB8 -> Get PalettedImage
    forall a b. (a -> b) -> a -> b
    $
              RGBBmpFormat -> BmpV5Header -> ByteString -> Image PixelRGB8
    decodeImageRGB8 RGBBmpFormat
    RGB24 BmpV5Header
    hdr ByteString
    rest
          (Word16
    16, Word16
    1, Word32
    0) -> do
            ByteString
    rest <- Get ByteString
    getData
            PalettedImage -> Get PalettedImage
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PalettedImage -> Get PalettedImage)
    -> (Image PixelRGB8 -> PalettedImage)
    -> Image PixelRGB8
    -> Get PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynamicImage -> PalettedImage
    TrueColorImage (DynamicImage -> PalettedImage)
    -> (Image PixelRGB8 -> DynamicImage)
    -> Image PixelRGB8
    -> PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGB8 -> DynamicImage
    ImageRGB8 (Image PixelRGB8 -> Get PalettedImage)
    -> Image PixelRGB8 -> Get PalettedImage
    forall a b. (a -> b) -> a -> b
    $
              RGBBmpFormat -> BmpV5Header -> ByteString -> Image PixelRGB8
    decodeImageRGB8 (Bitfields3 Word16 -> RGBBmpFormat
    RGB16 Bitfields3 Word16
    defaultBitfieldsRGB16) BmpV5Header
    hdr ByteString
    rest
          (Word16
    16, Word16
    1, Word32
    3) -> do
            Bitfield Word16
    r <- Word16 -> Get (Bitfield Word16)
    forall t (m :: * -> *).
    (FiniteBits t, Integral t, Num t, MonadFail m) =>
    t -> m (Bitfield t)
    getBitfield (Word16 -> Get (Bitfield Word16))
    -> (Word32 -> Word16) -> Word32 -> Get (Bitfield Word16)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Get (Bitfield Word16))
    -> Word32 -> Get (Bitfield Word16)
    forall a b. (a -> b) -> a -> b
    $ Word32
    0xFFFF Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. BmpV5Header -> Word32
    redMask BmpV5Header
    hdr
            Bitfield Word16
    g <- Word16 -> Get (Bitfield Word16)
    forall t (m :: * -> *).
    (FiniteBits t, Integral t, Num t, MonadFail m) =>
    t -> m (Bitfield t)
    getBitfield (Word16 -> Get (Bitfield Word16))
    -> (Word32 -> Word16) -> Word32 -> Get (Bitfield Word16)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Get (Bitfield Word16))
    -> Word32 -> Get (Bitfield Word16)
    forall a b. (a -> b) -> a -> b
    $ Word32
    0xFFFF Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. BmpV5Header -> Word32
    greenMask BmpV5Header
    hdr
            Bitfield Word16
    b <- Word16 -> Get (Bitfield Word16)
    forall t (m :: * -> *).
    (FiniteBits t, Integral t, Num t, MonadFail m) =>
    t -> m (Bitfield t)
    getBitfield (Word16 -> Get (Bitfield Word16))
    -> (Word32 -> Word16) -> Word32 -> Get (Bitfield Word16)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Get (Bitfield Word16))
    -> Word32 -> Get (Bitfield Word16)
    forall a b. (a -> b) -> a -> b
    $ Word32
    0xFFFF Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. BmpV5Header -> Word32
    blueMask BmpV5Header
    hdr
            ByteString
    rest     <- Get ByteString
    getData
            if BmpV5Header -> Word32
    alphaMask BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    0
              then PalettedImage -> Get PalettedImage
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PalettedImage -> Get PalettedImage)
    -> (Image PixelRGB8 -> PalettedImage)
    -> Image PixelRGB8
    -> Get PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynamicImage -> PalettedImage
    TrueColorImage (DynamicImage -> PalettedImage)
    -> (Image PixelRGB8 -> DynamicImage)
    -> Image PixelRGB8
    -> PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGB8 -> DynamicImage
    ImageRGB8 (Image PixelRGB8 -> Get PalettedImage)
    -> Image PixelRGB8 -> Get PalettedImage
    forall a b. (a -> b) -> a -> b
    $
                RGBBmpFormat -> BmpV5Header -> ByteString -> Image PixelRGB8
    decodeImageRGB8 (Bitfields3 Word16 -> RGBBmpFormat
    RGB16 (Bitfields3 Word16 -> RGBBmpFormat)
    -> Bitfields3 Word16 -> RGBBmpFormat
    forall a b. (a -> b) -> a -> b
    $ Bitfield Word16
    -> Bitfield Word16 -> Bitfield Word16 -> Bitfields3 Word16
    forall t. Bitfield t -> Bitfield t -> Bitfield t -> Bitfields3 t
    Bitfields3 Bitfield Word16
    r Bitfield Word16
    g Bitfield Word16
    b) BmpV5Header
    hdr ByteString
    rest
              else do
                Bitfield Word16
    a <- Word16 -> Get (Bitfield Word16)
    forall t (m :: * -> *).
    (FiniteBits t, Integral t, Num t, MonadFail m) =>
    t -> m (Bitfield t)
    getBitfield (Word16 -> Get (Bitfield Word16))
    -> (Word32 -> Word16) -> Word32 -> Get (Bitfield Word16)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Get (Bitfield Word16))
    -> Word32 -> Get (Bitfield Word16)
    forall a b. (a -> b) -> a -> b
    $ Word32
    0xFFFF Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    .&. BmpV5Header -> Word32
    alphaMask BmpV5Header
    hdr
                PalettedImage -> Get PalettedImage
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PalettedImage -> Get PalettedImage)
    -> (Image PixelRGBA8 -> PalettedImage)
    -> Image PixelRGBA8
    -> Get PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynamicImage -> PalettedImage
    TrueColorImage (DynamicImage -> PalettedImage)
    -> (Image PixelRGBA8 -> DynamicImage)
    -> Image PixelRGBA8
    -> PalettedImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGBA8 -> DynamicImage
    ImageRGBA8 (Image PixelRGBA8 -> Get PalettedImage)
    -> Image PixelRGBA8 -> Get PalettedImage
    forall a b. (a -> b) -> a -> b
    $
                  RGBABmpFormat -> BmpV5Header -> ByteString -> Image PixelRGBA8
    decodeImageRGBA8 (Bitfields4 Word16 -> RGBABmpFormat
    RGBA16 (Bitfields4 Word16 -> RGBABmpFormat)
    -> Bitfields4 Word16 -> RGBABmpFormat
    forall a b. (a -> b) -> a -> b
    $ Bitfield Word16
    -> Bitfield Word16
    -> Bitfield Word16
    -> Bitfield Word16
    -> Bitfields4 Word16
    forall t.
    Bitfield t
    -> Bitfield t -> Bitfield t -> Bitfield t -> Bitfields4 t
    Bitfields4 Bitfield Word16
    r Bitfield Word16
    g Bitfield Word16
    b Bitfield Word16
    a) BmpV5Header
    hdr ByteString
    rest
          ( Word16
    _, Word16
    1, Word32
    compression) -> do
            [[Word8]]
    table <- if BmpV5Header -> Word32
    size BmpV5Header
    hdr Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word32
    sizeofBmpCoreHeader
                        then Int -> Get [Word8] -> Get [[Word8]]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    paletteColorCount Get [Word8]
    pixel3Get
                        else Int -> Get [Word8] -> Get [[Word8]]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    paletteColorCount Get [Word8]
    pixel4Get
            ByteString
    rest <- Get ByteString
    getData
            let palette :: Palette' PixelRGB8
    palette = Palette'
                  { _paletteSize :: Int
    _paletteSize = Int
    paletteColorCount
                  , _paletteData :: Vector (PixelBaseComponent PixelRGB8)
    _paletteData = Int
    -> [PixelBaseComponent PixelRGB8]
    -> Vector (PixelBaseComponent PixelRGB8)
    forall a. Storable a => Int -> [a] -> Vector a
    VS.fromListN (Int
    paletteColorCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3) ([PixelBaseComponent PixelRGB8]
     -> Vector (PixelBaseComponent PixelRGB8))
    -> [PixelBaseComponent PixelRGB8]
    -> Vector (PixelBaseComponent PixelRGB8)
    forall a b. (a -> b) -> a -> b
    $ [[Word8]] -> [Word8]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Word8]]
    table
                  }
            Image Word8
    image <-
              case (Int
    bpp, Word32
    compression) of
                (Int
    8, Word32
    0) -> Image Word8 -> Get (Image Word8)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Image Word8 -> Get (Image Word8))
    -> Image Word8 -> Get (Image Word8)
    forall a b. (a -> b) -> a -> b
    $ IndexedBmpFormat -> BmpV5Header -> ByteString -> Image Word8
    decodeImageY8 IndexedBmpFormat
    EightBPP BmpV5Header
    hdr ByteString
    rest
                (Int
    4, Word32
    0) -> Image Word8 -> Get (Image Word8)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Image Word8 -> Get (Image Word8))
    -> Image Word8 -> Get (Image Word8)
    forall a b. (a -> b) -> a -> b
    $ IndexedBmpFormat -> BmpV5Header -> ByteString -> Image Word8
    decodeImageY8 IndexedBmpFormat
    FourBPP BmpV5Header
    hdr ByteString
    rest
                (Int
    1, Word32
    0) -> Image Word8 -> Get (Image Word8)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Image Word8 -> Get (Image Word8))
    -> Image Word8 -> Get (Image Word8)
    forall a b. (a -> b) -> a -> b
    $ IndexedBmpFormat -> BmpV5Header -> ByteString -> Image Word8
    decodeImageY8 IndexedBmpFormat
    OneBPP BmpV5Header
    hdr ByteString
    rest
                (Int
    8, Word32
    1) -> Image Word8 -> Get (Image Word8)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Image Word8 -> Get (Image Word8))
    -> Image Word8 -> Get (Image Word8)
    forall a b. (a -> b) -> a -> b
    $ Bool -> BmpV5Header -> ByteString -> Image Word8
    decodeImageY8RLE Bool
    False BmpV5Header
    hdr ByteString
    rest
                (Int
    4, Word32
    2) -> Image Word8 -> Get (Image Word8)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Image Word8 -> Get (Image Word8))
    -> Image Word8 -> Get (Image Word8)
    forall a b. (a -> b) -> a -> b
    $ Bool -> BmpV5Header -> ByteString -> Image Word8
    decodeImageY8RLE Bool
    True BmpV5Header
    hdr ByteString
    rest
                (Int
    a, Word32
    b) -> String -> Get (Image Word8)
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Get (Image Word8)) -> String -> Get (Image Word8)
    forall a b. (a -> b) -> a -> b
    $ String
    "Can't handle BMP file " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Int, Int, Word32) -> String
    forall a. Show a => a -> String
    show (Int
    a, Int
    1 :: Int, Word32
    b)

            PalettedImage -> Get PalettedImage
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PalettedImage -> Get PalettedImage)
    -> PalettedImage -> Get PalettedImage
    forall a b. (a -> b) -> a -> b
    $ Image Word8 -> Palette' PixelRGB8 -> PalettedImage
    PalettedRGB8 Image Word8
    image Palette' PixelRGB8
    palette

          (Word16, Word16, Word32)
    a          -> String -> Get PalettedImage
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Get PalettedImage) -> String -> Get PalettedImage
    forall a b. (a -> b) -> a -> b
    $ String
    "Can't handle BMP file " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (Word16, Word16, Word32) -> String
    forall a. Show a => a -> String
    show (Word16, Word16, Word32)
    a

    -- | Decode a bitfield. Will fail if the bitfield is empty.

    #if MIN_VERSION_base(4,13,0)
    getBitfield :: (FiniteBits t, Integral t, Num t, MonadFail m) => t -> m (Bitfield t)
    #else
    getBitfield :: (FiniteBits t, Integral t, Num t, Monad m) => t -> m (Bitfield t)
    #endif
    getBitfield :: forall t (m :: * -> *).
    (FiniteBits t, Integral t, Num t, MonadFail m) =>
    t -> m (Bitfield t)
    getBitfield t
    0 = String -> m (Bitfield t)
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m (Bitfield t)) -> String -> m (Bitfield t)
    forall a b. (a -> b) -> a -> b
    $
      String
    "Codec.Picture.Bitmap.getBitfield: bitfield cannot be 0"
    getBitfield t
    w = Bitfield t -> m (Bitfield t)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (t -> Bitfield t
    forall t. (FiniteBits t, Integral t) => t -> Bitfield t
    makeBitfield t
    w)

    -- | Compute the size of the pixel data

    sizeofPixelData :: Int -> Int -> Int -> Int
    sizeofPixelData :: Int -> Int -> Int -> Int
    sizeofPixelData Int
    bpp Int
    lineWidth Int
    nLines = ((Int
    bpp Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * (Int -> Int
    forall a. Num a => a -> a
    abs Int
    lineWidth) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    31) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    32) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int -> Int
    forall a. Num a => a -> a
    abs Int
    nLines

    -- | Write an image in a file use the bitmap format.

    writeBitmap :: (BmpEncodable pixel)
                => FilePath -> Image pixel -> IO ()
    writeBitmap :: forall pixel. BmpEncodable pixel => String -> Image pixel -> IO ()
    writeBitmap String
    filename Image pixel
    img = String -> ByteString -> IO ()
    L.writeFile String
    filename (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Image pixel -> ByteString
    forall pixel. BmpEncodable pixel => Image pixel -> ByteString
    encodeBitmap Image pixel
    img

    linePadding :: Int -> Int -> Int
    linePadding :: Int -> Int -> Int
    linePadding Int
    bpp Int
    imgWidth = (Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    bytesPerLine Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    4)) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    4
      where bytesPerLine :: Int
    bytesPerLine = (Int
    bpp Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    imgWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    7) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    8

    -- | Encode an image into a bytestring in .bmp format ready to be written

    -- on disk.

    encodeBitmap :: forall pixel. (BmpEncodable pixel) => Image pixel -> L.ByteString
    encodeBitmap :: forall pixel. BmpEncodable pixel => Image pixel -> ByteString
    encodeBitmap = BmpPalette -> Image pixel -> ByteString
    forall pixel.
    BmpEncodable pixel =>
    BmpPalette -> Image pixel -> ByteString
    encodeBitmapWithPalette (pixel -> BmpPalette
    forall pixel. BmpEncodable pixel => pixel -> BmpPalette
    defaultPalette (pixel
    forall a. HasCallStack => a
    undefined :: pixel))

    -- | Equivalent to 'encodeBitmap' but also store

    -- the following metadatas:

    --

    --  * 'Codec.Picture.Metadata.DpiX'

    --  * 'Codec.Picture.Metadata.DpiY'

    --

    encodeBitmapWithMetadata :: forall pixel. BmpEncodable pixel
                             => Metadatas -> Image pixel -> L.ByteString
    encodeBitmapWithMetadata :: forall pixel.
    BmpEncodable pixel =>
    Metadatas -> Image pixel -> ByteString
    encodeBitmapWithMetadata Metadatas
    metas =
      Metadatas -> BmpPalette -> Image pixel -> ByteString
    forall pixel.
    BmpEncodable pixel =>
    Metadatas -> BmpPalette -> Image pixel -> ByteString
    encodeBitmapWithPaletteAndMetadata Metadatas
    metas (pixel -> BmpPalette
    forall pixel. BmpEncodable pixel => pixel -> BmpPalette
    defaultPalette (pixel
    forall a. HasCallStack => a
    undefined :: pixel))

    -- | Write a dynamic image in a .bmp image file if possible.

    -- The same restriction as 'encodeDynamicBitmap' apply.

    writeDynamicBitmap :: FilePath -> DynamicImage -> IO (Either String Bool)
    writeDynamicBitmap :: String -> DynamicImage -> IO (Either String Bool)
    writeDynamicBitmap String
    path DynamicImage
    img = case DynamicImage -> Either String ByteString
    encodeDynamicBitmap DynamicImage
    img of
            Left String
    err -> Either String Bool -> IO (Either String Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String Bool -> IO (Either String Bool))
    -> Either String Bool -> IO (Either String Bool)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String Bool
    forall a b. a -> Either a b
    Left String
    err
            Right ByteString
    b  -> String -> ByteString -> IO ()
    L.writeFile String
    path ByteString
    b IO () -> IO (Either String Bool) -> IO (Either String Bool)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Either String Bool -> IO (Either String Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Either String Bool
    forall a b. b -> Either a b
    Right Bool
    True)

    -- | Encode a dynamic image in BMP if possible, supported images are:

    --

    --   - 'ImageY8'

    --

    --   - 'ImageRGB8'

    --

    --   - 'ImageRGBA8'

    --

    encodeDynamicBitmap :: DynamicImage -> Either String L.ByteString
    encodeDynamicBitmap :: DynamicImage -> Either String ByteString
    encodeDynamicBitmap (ImageRGB8 Image PixelRGB8
    img) = ByteString -> Either String ByteString
    forall a b. b -> Either a b
    Right (ByteString -> Either String ByteString)
    -> ByteString -> Either String ByteString
    forall a b. (a -> b) -> a -> b
    $ Image PixelRGB8 -> ByteString
    forall pixel. BmpEncodable pixel => Image pixel -> ByteString
    encodeBitmap Image PixelRGB8
    img
    encodeDynamicBitmap (ImageRGBA8 Image PixelRGBA8
    img) = ByteString -> Either String ByteString
    forall a b. b -> Either a b
    Right (ByteString -> Either String ByteString)
    -> ByteString -> Either String ByteString
    forall a b. (a -> b) -> a -> b
    $ Image PixelRGBA8 -> ByteString
    forall pixel. BmpEncodable pixel => Image pixel -> ByteString
    encodeBitmap Image PixelRGBA8
    img
    encodeDynamicBitmap (ImageY8 Image Word8
    img) = ByteString -> Either String ByteString
    forall a b. b -> Either a b
    Right (ByteString -> Either String ByteString)
    -> ByteString -> Either String ByteString
    forall a b. (a -> b) -> a -> b
    $ Image Word8 -> ByteString
    forall pixel. BmpEncodable pixel => Image pixel -> ByteString
    encodeBitmap Image Word8
    img
    encodeDynamicBitmap DynamicImage
    _ = String -> Either String ByteString
    forall a b. a -> Either a b
    Left String
    "Unsupported image format for bitmap export"

    extractDpiOfMetadata :: Metadatas -> (Word32, Word32)
    extractDpiOfMetadata :: Metadatas -> (Word32, Word32)
    extractDpiOfMetadata Metadatas
    metas = (Keys Word -> Word32
    fetch Keys Word
    Met.DpiX, Keys Word -> Word32
    fetch Keys Word
    Met.DpiY) where
      fetch :: Keys Word -> Word32
    fetch Keys Word
    k = Word32 -> (Word -> Word32) -> Maybe Word -> Word32
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Word32
    0 (Word -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word -> Word32) -> (Word -> Word) -> Word -> Word32
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word -> Word
    Met.dotPerInchToDotsPerMeter) (Maybe Word -> Word32) -> Maybe Word -> Word32
    forall a b. (a -> b) -> a -> b
    $ Keys Word -> Metadatas -> Maybe Word
    forall a. Keys a -> Metadatas -> Maybe a
    Met.lookup Keys Word
    k Metadatas
    metas

    -- | Convert an image to a bytestring ready to be serialized.

    encodeBitmapWithPalette :: forall pixel. (BmpEncodable pixel)
                            => BmpPalette -> Image pixel -> L.ByteString
    encodeBitmapWithPalette :: forall pixel.
    BmpEncodable pixel =>
    BmpPalette -> Image pixel -> ByteString
    encodeBitmapWithPalette = Metadatas -> BmpPalette -> Image pixel -> ByteString
    forall pixel.
    BmpEncodable pixel =>
    Metadatas -> BmpPalette -> Image pixel -> ByteString
    encodeBitmapWithPaletteAndMetadata Metadatas
    forall a. Monoid a => a
    mempty

    -- | Equivalent to 'encodeBitmapWithPalette' but also store

    -- the following metadatas:

    --

    --  * 'Codec.Picture.Metadata.DpiX'

    --  * 'Codec.Picture.Metadata.DpiY'

    --

    encodeBitmapWithPaletteAndMetadata :: forall pixel. (BmpEncodable pixel)
                                       => Metadatas -> BmpPalette -> Image pixel
                                       -> L.ByteString
    encodeBitmapWithPaletteAndMetadata :: forall pixel.
    BmpEncodable pixel =>
    Metadatas -> BmpPalette -> Image pixel -> ByteString
    encodeBitmapWithPaletteAndMetadata Metadatas
    metas pal :: BmpPalette
    pal@(BmpPalette [(Word8, Word8, Word8, Word8)]
    palette) Image pixel
    img =
      Put -> ByteString
    runPut (Put -> ByteString) -> Put -> ByteString
    forall a b. (a -> b) -> a -> b
    $ BmpHeader -> Put
    forall t. Binary t => t -> Put
    put BmpHeader
    hdr Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> BmpV5Header -> Put
    forall t. Binary t => t -> Put
    put BmpV5Header
    info Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> BmpPalette -> Put
    putPalette BmpPalette
    pal Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Image pixel -> Put
    forall pixel. BmpEncodable pixel => Image pixel -> Put
    bmpEncode Image pixel
    img
                       Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe ByteString -> Put
    putICCProfile Maybe ByteString
    colorProfileData

        where imgWidth :: Int
    imgWidth = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Image pixel -> Int
    forall a. Image a -> Int
    imageWidth Image pixel
    img
              imgHeight :: Int
    imgHeight = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Image pixel -> Int
    forall a. Image a -> Int
    imageHeight Image pixel
    img
              (Word32
    dpiX, Word32
    dpiY) = Metadatas -> (Word32, Word32)
    extractDpiOfMetadata Metadatas
    metas
              cs :: Maybe ColorSpace
    cs = Keys ColorSpace -> Metadatas -> Maybe ColorSpace
    forall a. Keys a -> Metadatas -> Maybe a
    Met.lookup Keys ColorSpace
    Met.ColorSpace Metadatas
    metas
              colorType :: ColorSpaceType
    colorType = case Maybe ColorSpace
    cs of
                            Just ColorSpace
    Met.SRGB -> ColorSpaceType
    SRGB
                            Just (Met.WindowsBitmapColorSpace ByteString
    _) -> ColorSpaceType
    CalibratedRGB
                            Just (Met.ICCProfile ByteString
    _) -> ColorSpaceType
    ProfileEmbedded
                            Maybe ColorSpace
    Nothing -> ColorSpaceType
    DeviceDependentRGB

              colorSpaceInfo :: ByteString
    colorSpaceInfo = case Maybe ColorSpace
    cs of
                                Just (Met.WindowsBitmapColorSpace ByteString
    bytes) -> ByteString
    bytes
                                Maybe ColorSpace
    _ -> [Word8] -> ByteString
    B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> Word8 -> [Word8]
    forall a. Int -> a -> [a]
    replicate Int
    sizeofColorProfile Word8
    0

              colorProfileData :: Maybe ByteString
    colorProfileData = case Maybe ColorSpace
    cs of
                                  Just (Met.ICCProfile ByteString
    bytes) -> ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    bytes
                                  Maybe ColorSpace
    _ -> Maybe ByteString
    forall a. Maybe a
    Nothing

              headerSize :: Word32
    headerSize | ColorSpaceType
    colorType ColorSpaceType -> ColorSpaceType -> Bool
    forall a. Eq a => a -> a -> Bool
    == ColorSpaceType
    ProfileEmbedded                = Word32
    sizeofBmpV5Header
                         | ColorSpaceType
    colorType ColorSpaceType -> ColorSpaceType -> Bool
    forall a. Eq a => a -> a -> Bool
    == ColorSpaceType
    CalibratedRGB Bool -> Bool -> Bool
    || Image pixel -> Bool
    forall pixel. BmpEncodable pixel => Image pixel -> Bool
    hasAlpha Image pixel
    img  = Word32
    sizeofBmpV4Header
                         | Bool
    otherwise                                   = Word32
    sizeofBmpInfoHeader

              paletteSize :: Word32
    paletteSize = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ [(Word8, Word8, Word8, Word8)] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [(Word8, Word8, Word8, Word8)]
    palette
              bpp :: Int
    bpp = pixel -> Int
    forall pixel. BmpEncodable pixel => pixel -> Int
    bitsPerPixel (pixel
    forall a. HasCallStack => a
    undefined :: pixel)

              profileSize :: Word32
    profileSize = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int -> (ByteString -> Int) -> Maybe ByteString -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 ByteString -> Int
    B.length Maybe ByteString
    colorProfileData
              imagePixelSize :: Word32
    imagePixelSize = Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int -> Int
    sizeofPixelData Int
    bpp Int
    imgWidth Int
    imgHeight
              offsetToData :: Word32
    offsetToData = Word32
    sizeofBmpHeader Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    headerSize Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    4 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    paletteSize
              offsetToICCProfile :: Maybe Word32
    offsetToICCProfile = Word32
    offsetToData Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    imagePixelSize Word32 -> Maybe ByteString -> Maybe Word32
    forall a b. a -> Maybe b -> Maybe a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Maybe ByteString
    colorProfileData
              sizeOfFile :: Word32
    sizeOfFile = Word32
    sizeofBmpHeader Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    headerSize Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    4 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    paletteSize
                            Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    imagePixelSize Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    profileSize

              hdr :: BmpHeader
    hdr = BmpHeader {
                  magicIdentifier :: Word16
    magicIdentifier = Word16
    bitmapMagicIdentifier,
                  fileSize :: Word32
    fileSize = Word32
    sizeOfFile,
                  reserved1 :: Word16
    reserved1 = Word16
    0,
                  reserved2 :: Word16
    reserved2 = Word16
    0,
                  dataOffset :: Word32
    dataOffset = Word32
    offsetToData
              }

              info :: BmpV5Header
    info = BmpV5Header {
                  size :: Word32
    size = Word32
    headerSize,
                  width :: Int32
    width = Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    imgWidth,
                  height :: Int32
    height = Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    imgHeight,
                  planes :: Word16
    planes = Word16
    1,
                  bitPerPixel :: Word16
    bitPerPixel = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    bpp,
                  bitmapCompression :: Word32
    bitmapCompression = if Image pixel -> Bool
    forall pixel. BmpEncodable pixel => Image pixel -> Bool
    hasAlpha Image pixel
    img then Word32
    3 else Word32
    0,
                  byteImageSize :: Word32
    byteImageSize = Word32
    imagePixelSize,
                  xResolution :: Int32
    xResolution = Word32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    dpiX,
                  yResolution :: Int32
    yResolution = Word32 -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    dpiY,
                  colorCount :: Word32
    colorCount = Word32
    paletteSize,
                  importantColours :: Word32
    importantColours = Word32
    0,
                  redMask :: Word32
    redMask   = if Image pixel -> Bool
    forall pixel. BmpEncodable pixel => Image pixel -> Bool
    hasAlpha Image pixel
    img then Word32
    0x00FF0000 else Word32
    0,
                  greenMask :: Word32
    greenMask = if Image pixel -> Bool
    forall pixel. BmpEncodable pixel => Image pixel -> Bool
    hasAlpha Image pixel
    img then Word32
    0x0000FF00 else Word32
    0,
                  blueMask :: Word32
    blueMask  = if Image pixel -> Bool
    forall pixel. BmpEncodable pixel => Image pixel -> Bool
    hasAlpha Image pixel
    img then Word32
    0x000000FF else Word32
    0,
                  alphaMask :: Word32
    alphaMask = if Image pixel -> Bool
    forall pixel. BmpEncodable pixel => Image pixel -> Bool
    hasAlpha Image pixel
    img then Word32
    0xFF000000 else Word32
    0,
                  colorSpaceType :: ColorSpaceType
    colorSpaceType = ColorSpaceType
    colorType,
                  colorSpace :: ByteString
    colorSpace = ByteString
    colorSpaceInfo,
                  iccIntent :: Word32
    iccIntent = Word32
    0,
                  iccProfileData :: Word32
    iccProfileData = Word32 -> Maybe Word32 -> Word32
    forall a. a -> Maybe a -> a
    fromMaybe Word32
    0 Maybe Word32
    offsetToICCProfile,
                  iccProfileSize :: Word32
    iccProfileSize = Word32
    profileSize
              }

    {-# ANN module "HLint: ignore Reduce duplication" #-}