{-# LANGUAGE TypeFamilies, PolymorphicComponents, TupleSections, FlexibleContexts, ScopedTypeVariables #-}

module Data.Bitmap.Class
    ( Bitmap(..)
    , convertBitmap

    -- * Polymorphic type wrappers
    , CompleteEncoder(..)
    , CompleteDecoder(..)
    , ImageEncoder(..)
    , ImageDecoder(..)
    , GenericBitmapSerializer(..)

    -- * Bitmap serialization
    , updateIdentifiableElements
    , defaultCompleteEncoders
    , encodeCBF_BMPIUZ64
    , encodeCBF_BMPIU64
    , encodeCBF_BMPIU
    , encodeCBF_BMPIUU
    , defaultCompleteDecoders
    , tryCBF_BMPIUZ64
    , tryCBF_BMPIU64
    , tryCBF_BMPIU
    , tryCBF_BMPIUU
    , defaultImageEncoders
    , encodeIBF_IDRGB24Z64
    , encodeIBF_IDBGR24R2RZ64
    , encodeIBF_IDBGR24HZH
    , encodeIBF_IDRGB32Z64
    , encodeIBF_BGR24H
    , encodeIBF_BGR24A4VR
    , encodeIBF_BGRU32VR
    , encodeIBF_BGRU32
    , encodeIBF_RGB24A4VR
    , encodeIBF_RGB24A4
    , encodeIBF_RGB32
    , encodeIBF_RGB32Z64
    , defaultImageDecoders
    , tryIBF_IDRGB24Z64
    , tryIBF_IDBGR24R2RZ64
    , tryIBF_IDBGR24HZH
    , tryIBF_IDRGB32Z64
    , tryIBF_BGR24H
    , tryIBF_BGR24A4VR
    , tryIBF_BGRU32VR
    , tryIBF_BGRU32
    , tryIBF_RGB24A4VR
    , tryIBF_RGB24A4
    , tryIBF_RGB32
    , tryIBF_RGB32Z64
    , encodeComplete
    , decodeComplete
    , encodeImage
    , decodeImage
    , encodeCompleteFmt
    , decodeCompleteFmt
    , encodeImageFmt
    , decodeImageFmt
    , decodeImageDimensions
    , decodeImageDimensionsFmt

    -- * Utility functions
    , dimensionsFit
    , bitmapWidth
    , bitmapHeight
    ) where

import Codec.Compression.Zlib
import Codec.String.Base16
import Codec.String.Base64
import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.Record
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.Bitmap.Pixel
import Data.Bitmap.Types
import Data.Bitmap.Util
import qualified Data.ByteString as B  -- For zlib
import Data.Maybe
import qualified Data.String.Class as S
import Data.Tagged
import Text.Printf

-- | Bitmap class
--
-- Pixels are indexed by (row, column), where (0, 0) represents the
-- upper-left-most corner of the bitmap.  Instances of this class
-- are not required to support empty bitmaps.
--
-- The encoding and decoding lists contain functions that can encode
-- and decode or return a string containing information about why
-- it could not be decoded in that format.  The order is important:
-- When a function tries multiple or any decoder, it will use or return
-- the one(s) closest to the head of the list.  There are lists
-- of generic functions that are defined by default.  Normally, if an
-- implementation of a bitmap type overrides the default instance,
-- it will only need to replace one or a few decoders, not touching
-- the rest of the default decoders or the order of the decoders;
-- thus the function 'updateIdentifiableElements' is defined and exported.
--
-- Instances *must* support every serialization format.
class (Integral (BIndexType bmp), Pixel (BPixelType bmp)) => Bitmap bmp where
    type BIndexType bmp  -- @ Integral type for each coordinate in an index
    type BPixelType bmp  -- @ Pixel type of structure

    depth                   :: bmp -> Depth
        -- ^ The color depth of the bitmap in bits

    dimensions              :: bmp -> Dimensions (BIndexType bmp)
        -- ^ Return the width and height of the bitmap in pixels

    getPixel                :: bmp -> Coordinates (BIndexType bmp) -> BPixelType bmp
        -- ^ Get a pixel; indexing starts at 0
        --
        -- Implementations can assume that the coordinates are within the
        -- bounds of the bitmap.  Thus callers of this function should always
        -- ensure that the coordinates are within the bounds of the bitmap.

    constructPixels         :: (Coordinates (BIndexType bmp) -> BPixelType bmp) -> Dimensions (BIndexType bmp) -> bmp
        -- ^ Construct a bitmap with a function that returns a pixel for each coordinate with the given dimensions
        --
        -- The function should return the same type of pixel for each coordinate.
        --
        -- Implementations are not required to call the function in any particular order, and are not even
        -- required to guarantee that the function will be called for each pixel, which might be true for
        -- a bitmap that is evaluated lazily as needed.

    convertInternalFormat   :: bmp -> bmp -> bmp
        -- ^ Construct a new bitmap from the bitmap passed as the second argument but storing it in the bitmap of the meta-bitmap passed as the first argument
        --
        -- The purpose of this function is efficiency.  Some bitmap types have multiple possible internal representations of bitmaps.
        -- For these bitmap types, it is often more efficient when performing operations on multiple bitmaps for them be stored in the
        -- same format.  Instances might even always convert the bitmaps if their formats differ.
        --
        -- Implementations are not required to define this function
        -- to store the second bitmap in another format, or even in the same
        -- format as the first bitmap; this is only used for efficiency.  They
        -- should, however, return a bitmap that represents the same bitmap as
        -- what the main bitmap (passed as the second argument) represents.
        -- The default behaviour of this function is to return the main bitmap
        -- (passed second) verbatim.
        --
        -- As an example application of this function, consider a program that
        -- regularly captures the screen and searches for any of several
        -- bitmaps which are read from the filesystem.  The programmer
        -- chooses the type that is most efficient for the format that
        -- the screen capture is in, and uses it as the main type.
        -- As the screen is expected to change, it would be inefficient
        -- to convert each capture into another internal format each time,
        -- especially since screen dumps can be very large.  The bitmaps, however,
        -- are generally static (and much smaller), so they could be converted
        -- once using this function, 'convertInternalFormat', to the format that
        -- screen captures are represented in, and reused.  If the formats would
        -- otherwise differ, this is much more efficient than converting the format
        -- of every sub-bitmap every time a search or operation is needed.
        --
        -- NB: again, the format of the first argument is used along with
        -- the image of the second argument to return (possibly) a bitmap
        -- with the image of the second argument and with the format of the
        -- first argument.

    completeEncoders :: [(CompleteBitmapFormat, CompleteEncoder bmp)]
        -- ^ Bitmap encoders; default definition is based on 'defaultCompleteEncoders'
        --
        -- As the head of the list might be best suited for writing to files
        -- or generating text strings but not both, it is suggested that this
        -- function is used only when it does not matter whether the result
        -- is writable to a file or is generally "human readable".
    completeDecoders :: [(CompleteBitmapFormat, CompleteDecoder bmp)]
        -- ^ Bitmap decodes; extra bytes after the end should be ignored by them; default definition is based on 'defaultCompleteDecoders'
    imageEncoders    :: [(ImageBitmapFormat,    ImageEncoder    bmp)]
        -- ^ Bitmap encoders; the meta-information is lost; default definition is based on 'defaultImageEncoders'
    imageDecoders    :: [(ImageBitmapFormat,    ImageDecoder    bmp)]
        -- ^ Decode the bitmap; the meta-information from the given bitmap is used (see 'ImageDecoder'); default definition is based on 'defaultImageDecoders'

    convertInternalFormat = const

    completeEncoders = map (second unwrapGenericBitmapSerializer) defaultCompleteEncoders
    completeDecoders = map (second unwrapGenericBitmapSerializer) defaultCompleteDecoders
    imageEncoders    = map (second unwrapGenericBitmapSerializer) defaultImageEncoders
    imageDecoders    = map (second unwrapGenericBitmapSerializer) defaultImageDecoders

-- | Convert one bitmap type to another
convertBitmap :: (Bitmap a, Bitmap b) => a -> b
convertBitmap b = constructPixels (\(row, column) -> fromPixel $ getPixel b (fromIntegral row, fromIntegral column)) (let (width, height) = dimensions b in (fromIntegral width, fromIntegral height))

newtype CompleteEncoder bmp = CompleteEncoder {unwrapCompleteEncoder :: (S.StringCells s) => bmp -> s}
newtype CompleteDecoder bmp = CompleteDecoder {unwrapCompleteDecoder :: (S.StringCells s) => s -> Either String bmp}
newtype ImageEncoder    bmp = ImageEncoder    {unwrapImageEncoder    :: (S.StringCells s) => bmp -> s}
newtype ImageDecoder    bmp = ImageDecoder    {unwrapImageDecoder    :: (S.StringCells s) => bmp -> s -> Either String bmp}

newtype GenericBitmapSerializer s = GenericBitmapSerializer {unwrapGenericBitmapSerializer :: (Bitmap bmp) => s bmp}

-- | Update identifiable elements
--
-- 'updateIdentifiableElements' @orig new@ returns @orig@ with each matching
-- pair updated; extraneous replacements in @new@ are ignored.
updateIdentifiableElements :: (Eq k) => [(k, v)] -> [(k, v)] -> [(k, v)]
updateIdentifiableElements orig new = map (\(k, v) -> (k, maybe v id $ lookup k new)) orig

defaultCompleteEncoders :: [(CompleteBitmapFormat, GenericBitmapSerializer CompleteEncoder)]
defaultCompleteEncoders = 
    [ (CBF_BMPIUZ64, GenericBitmapSerializer $ CompleteEncoder $ encodeCBF_BMPIUZ64)
    , (CBF_BMPIU64,  GenericBitmapSerializer $ CompleteEncoder $ encodeCBF_BMPIU64)
    , (CBF_BMPIU,    GenericBitmapSerializer $ CompleteEncoder $ encodeCBF_BMPIU)
    , (CBF_BMPIUU,   GenericBitmapSerializer $ CompleteEncoder $ encodeCBF_BMPIUU)
    ]

encodeCBF_BMPIU :: (S.StringCells s, Bitmap bmp) => bmp -> s
encodeCBF_BMPIU b =
    let (width, height) = dimensions b
        header = S.fromLazyByteString . runPut $ do
            -- Magic sequence
            putWord8 (0x42 :: Word8)
            putWord8 (0x4D :: Word8)

            -- File size
            putWord32le (fromIntegral $ 3 * width * height + padding * height + 0x0E + 40  :: Word32)

            -- Reserved
            putWord16le 0x0000
            putWord16le 0x0000

            -- Offset
            putWord32le (0x0E + 40 :: Word32)

            -- Bitmap information header; BITMAPINFOHEADER
            -- header size
            putWord32le (40 :: Word32)
            -- width
            putWord32le (fromIntegral width  :: Word32)
            -- height
            putWord32le (fromIntegral height  :: Word32)
            -- number of color planes
            putWord16le (1 :: Word16)
            -- bits per pixel / depth
            putWord16le (24 :: Word16)
            -- compression
            putWord32le (0 :: Word32)  -- no compression
            -- image size
            putWord32le (fromIntegral $ 3 * width * height + padding * height  :: Word32)
            -- horizontal resolution; pixel per meter
            putWord32le (3000 :: Word32)
            -- vertical resolution; pixel per meter
            putWord32le (3000 :: Word32)
            -- number of colors
            putWord32le (0 :: Word32)
            -- number of important colors
            putWord32le (0 :: Word32)
        image   = encodeImageFmt IBF_BGR24A4VR b
        padding = case 4 - ((3 * width) `mod` 4) of
                      4 -> 0
                      n -> n
    in  header `S.append` image

encodeCBF_BMPIUU :: (S.StringCells s, Bitmap bmp) => bmp -> s
encodeCBF_BMPIUU b =
    let (width, height) = dimensions b
        header = S.fromLazyByteString . runPut $ do
            -- Magic sequence
            putWord8 (0x42 :: Word8)
            putWord8 (0x4D :: Word8)

            -- File size
            putWord32le (fromIntegral $ 4 * width * height + 0x0E + 40  :: Word32)

            -- Reserved
            putWord16le 0x0000
            putWord16le 0x0000

            -- Offset
            putWord32le (0x0E + 40 :: Word32)

            -- Bitmap information header; BITMAPINFOHEADER
            -- header size
            putWord32le (40 :: Word32)
            -- width
            putWord32le (fromIntegral width  :: Word32)
            -- height
            putWord32le (fromIntegral height  :: Word32)
            -- number of color planes
            putWord16le (1 :: Word16)
            -- bits per pixel / depth
            putWord16le (32 :: Word16)
            -- compression
            putWord32le (0 :: Word32)  -- no compression
            -- image size
            putWord32le (fromIntegral $ 4 * width * height  :: Word32)
            -- horizontal resolution; pixel per meter
            putWord32le (3000 :: Word32)
            -- vertical resolution; pixel per meter
            putWord32le (3000 :: Word32)
            -- number of colors
            putWord32le (0 :: Word32)
            -- number of important colors
            putWord32le (0 :: Word32)
        image   = encodeImageFmt IBF_BGRU32VR b
    in  header `S.append` image

encodeCBF_BMPIU64 :: (S.StringCells s, Bitmap bmp) => bmp -> s
encodeCBF_BMPIU64 = encode64 . encodeCompleteFmt CBF_BMPIU

encodeCBF_BMPIUZ64 :: (S.StringCells s, Bitmap bmp) => bmp -> s
encodeCBF_BMPIUZ64 = encode64 . S.fromStringCells . compress . encodeCompleteFmt CBF_BMPIU

defaultCompleteDecoders :: [(CompleteBitmapFormat, GenericBitmapSerializer CompleteDecoder)]
defaultCompleteDecoders =
    [ (CBF_BMPIUZ64, GenericBitmapSerializer $ CompleteDecoder $ tryCBF_BMPIUZ64)
    , (CBF_BMPIU64,  GenericBitmapSerializer $ CompleteDecoder $ tryCBF_BMPIU64)
    , (CBF_BMPIU,    GenericBitmapSerializer $ CompleteDecoder $ tryCBF_BMPIU)
    , (CBF_BMPIUU,   GenericBitmapSerializer $ CompleteDecoder $ tryCBF_BMPIUU)
    ]

tryCBF_BMPIU :: (S.StringCells s, Bitmap bmp) => s -> Either String bmp
tryCBF_BMPIU s = do
    let getImgInfo = do
            m0 <- getWord8
            m1 <- getWord8

            when (m0 /= 0x42 || m1 /= 0x4D) $ do
                fail "magic sequence is not that of BMP format"

            -- skip filesize 4, reserved 2, reserved, 2
            skip 8

            offset <- getWord32le

            -- get offset to image data
            let offset' = offset - 0x0E - 40

            when (offset' < 0) $ do
                fail $ printf "rewinding to image data at offset %d not supported" offset

            -- read DIB header
            headerSize <- getWord32le
            when (headerSize /= 40) $ do
                fail $ printf "header with size '%d' which is other than 40 is not supported" headerSize

            width  <- getWord32le
            height <- getWord32le
            numColorPlanes <- getWord16le
            when (numColorPlanes /= 1) $ do
                fail $ printf "numColorPlanes with value '%d' which is other than 1 is not supported" numColorPlanes
            bitsPerPixel <- getWord16le
            when (bitsPerPixel /= 24) $ do
                fail $ printf "bitsPerPixel with value '%d' which is other than 24 is not supported" bitsPerPixel
            compression <- getWord32le
            when (compression /= 0) $ do
                fail $ printf "compression with value '%d' which is other than 0 is not supported; needs to be uncompressed RGB" compression
            imageSize <- getWord32le
            let shouldBeImageSize = (3 * width + padding) * height
                padding = case (3 * width) `mod` 4 of
                              0 -> 0
                              n -> 4 - n
            when (imageSize /= shouldBeImageSize) $ do
                fail $ printf "imageSize was read to be '%d', but it should be '%d' since the dimensions of the bitmap are (%d, %d)" imageSize shouldBeImageSize width height
            -- skip horRes 4, verRes 4, usedColors 4, importantColors 4
            skip 16

            -- skip to image data
            when (offset' > 0) $ do
                skip $ fromIntegral offset'

            -- get image data
            imgData <- getLazyByteString (fromIntegral imageSize)

            return (width, height, imgData)

    (width, height, imgData) <- tablespoon . flip runGet (S.toLazyByteString s) $ getImgInfo
    let metaBitmap = constructPixels (const leastIntensity) (fromIntegral width, fromIntegral height)
    decodeImageFmt IBF_BGR24A4VR metaBitmap $ imgData

tryCBF_BMPIUU :: (S.StringCells s, Bitmap bmp) => s -> Either String bmp
tryCBF_BMPIUU s = do
    let getImgInfo = do
            m0 <- getWord8
            m1 <- getWord8

            when (m0 /= 0x42 || m1 /= 0x4D) $ do
                fail "magic sequence is not that of BMP format"

            -- skip filesize 4, reserved 2, reserved, 2
            skip 8

            offset <- getWord32le

            -- get offset to image data
            let offset' = offset - 0x0E - 40

            when (offset' < 0) $ do
                fail $ printf "rewinding to image data at offset %d not supported" offset

            -- read DIB header
            headerSize <- getWord32le
            when (headerSize /= 40) $ do
                fail $ printf "header with size '%d' which is other than 40 is not supported" headerSize

            width  <- getWord32le
            height <- getWord32le
            numColorPlanes <- getWord16le
            when (numColorPlanes /= 1) $ do
                fail $ printf "numColorPlanes with value '%d' which is other than 1 is not supported" numColorPlanes
            bitsPerPixel <- getWord16le
            when (bitsPerPixel /= 32) $ do
                fail $ printf "bitsPerPixel with value '%d' which is other than 32 is not supported" bitsPerPixel
            compression <- getWord32le
            when (compression /= 0) $ do
                fail $ printf "compression with value '%d' which is other than 0 is not supported; needs to be uncompressed RGB" compression
            imageSize <- getWord32le
            let shouldBeImageSize = 4 * width * height
            when (imageSize /= shouldBeImageSize) $ do
                fail $ printf "imageSize was read to be '%d', but it should be '%d' since the dimensions of the bitmap are (%d, %d)" imageSize shouldBeImageSize width height
            -- skip horRes 4, verRes 4, usedColors 4, importantColors 4
            skip 16

            -- skip to image data
            when (offset' > 0) $ do
                skip $ fromIntegral offset'

            -- get image data
            imgData <- getLazyByteString (fromIntegral imageSize)

            return (width, height, imgData)

    (width, height, imgData) <- tablespoon . flip runGet (S.toLazyByteString s) $ getImgInfo
    let metaBitmap = constructPixels (const leastIntensity) (fromIntegral width, fromIntegral height)
    decodeImageFmt IBF_BGRU32VR metaBitmap $ imgData

tryCBF_BMPIU64 :: (S.StringCells s, Bitmap bmp) => s -> Either String bmp
tryCBF_BMPIU64 s = decodeCompleteFmt CBF_BMPIU =<< (maybe (Left "Data.Bitmap.Class.tryCBF_BMPIU64: not a valid sequence of characters representing a base-64 encoded string") Right $ decode64 s)

tryCBF_BMPIUZ64 :: (S.StringCells s, Bitmap bmp) => s -> Either String bmp
tryCBF_BMPIUZ64 s = decodeCompleteFmt CBF_BMPIU =<< tablespoon . decompress . S.toStringCells =<< (maybe (Left "Data.Bitmap.Class.tryCBF_BMPIUZ64: not a valid sequence of characters representing a base-64 encoded string") Right $ decode64 s)

defaultImageEncoders :: [(ImageBitmapFormat, GenericBitmapSerializer ImageEncoder)]
defaultImageEncoders =
    [ (IBF_IDRGB32Z64,    GenericBitmapSerializer $ ImageEncoder $ encodeIBF_IDRGB32Z64)
    , (IBF_IDRGB24Z64,    GenericBitmapSerializer $ ImageEncoder $ encodeIBF_IDRGB24Z64)
    , (IBF_IDBGR24R2RZ64, GenericBitmapSerializer $ ImageEncoder $ encodeIBF_IDBGR24R2RZ64)
    , (IBF_IDBGR24HZH,    GenericBitmapSerializer $ ImageEncoder $ encodeIBF_IDBGR24HZH)
    , (IBF_BGR24H,        GenericBitmapSerializer $ ImageEncoder $ encodeIBF_BGR24H)
    , (IBF_BGR24A4VR,     GenericBitmapSerializer $ ImageEncoder $ encodeIBF_BGR24A4VR)
    , (IBF_BGRU32VR,      GenericBitmapSerializer $ ImageEncoder $ encodeIBF_BGRU32VR)
    , (IBF_BGRU32,        GenericBitmapSerializer $ ImageEncoder $ encodeIBF_BGRU32)
    , (IBF_RGB24A4VR,     GenericBitmapSerializer $ ImageEncoder $ encodeIBF_RGB24A4VR)
    , (IBF_RGB24A4,       GenericBitmapSerializer $ ImageEncoder $ encodeIBF_RGB24A4)
    , (IBF_RGB32,         GenericBitmapSerializer $ ImageEncoder $ encodeIBF_RGB32)
    , (IBF_RGB32Z64,      GenericBitmapSerializer $ ImageEncoder $ encodeIBF_RGB32Z64)
    ]

encodeIBF_IDRGB24Z64 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_IDRGB24Z64 b = ((untag' . S.toMainChar $ 'm') `S.cons`) . encode64 . S.fromStringCells . compress
    $ S.unfoldrN (fromIntegral $ 3 * width * height) getComponent (0, 0, 0 :: Int)
    where getComponent (row, column, orgb)
              | orgb   > 2         =
                  getComponent (row, succ column, 0)
              | column > maxColumn =
                  getComponent (succ row, 0, 0)
              | row    > maxRow    =
                  Nothing
              | otherwise =
                  let pixel = pixelf (row, column)
                      componentGetter =
                          case orgb of
                              0 -> untagBS . S.toMainChar . (red   <:)
                              1 -> untagBS . S.toMainChar . (green <:)
                              2 -> untagBS . S.toMainChar . (blue  <:)
                              _ -> undefined
                  in  Just (componentGetter pixel, (row, column, succ orgb))
          pixelf = (b `getPixel`)
          (width_, height_) = dimensions b
          (width, height) = (fromIntegral width_, fromIntegral height_)
          maxRow    = abs . pred $ height
          maxColumn = abs . pred $ width
          untag' = untag :: Tagged s a -> a
          untagBS = untag :: Tagged B.ByteString a -> a

encodeIBF_IDBGR24R2RZ64 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_IDBGR24R2RZ64 b = ((untag' . S.toMainChar $ 'b') `S.cons`) . encode64 . S.fromStringCells . compress
    $ S.unfoldrN (fromIntegral $ 3 * width * height) getComponent (0, 0, 0 :: Int)
    where getComponent (row, column, orgb)
              | orgb   > 2         =
                  getComponent (row, succ column, 0)
              | column > maxColumn =
                  getComponent (succ row, 0, 0)
              | row    > maxRow    =
                  Nothing
              | otherwise =
                  let pixel = pixelf (row, column)
                      componentGetter =
                          case orgb of
                              2 -> untagBS . S.toMainChar . (red   <:)
                              1 -> untagBS . S.toMainChar . (green <:)
                              0 -> untagBS . S.toMainChar . (blue  <:)
                              _ -> undefined
                  in  Just (componentGetter pixel, (row, column, succ orgb))
          pixelf = (b `getPixel`)
          (width_, height_) = dimensions b
          (width, height) = (fromIntegral width_, fromIntegral height_)
          maxRow    = abs . pred $ height
          maxColumn = abs . pred $ width
          untag' = untag :: Tagged s a -> a
          untagBS = untag :: Tagged B.ByteString a -> a

encodeIBF_IDBGR24HZH :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_IDBGR24HZH = ((untag' . S.toMainChar $ 'z') `S.cons`) . encodeHex . S.fromStringCells . compress . encodeImageFmt IBF_BGR24H
    where untag' = untag :: Tagged s a -> a

encodeIBF_IDRGB32Z64 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_IDRGB32Z64 = ((untag' . S.toMainChar $ 'l') `S.cons`) . encodeImageFmt IBF_RGB32Z64
    where untag' = untag :: Tagged s a -> a

encodeIBF_BGR24H :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_BGR24H b =
    encodeHex $ S.unfoldrN (fromIntegral $ 4 * width * height) getComponent (0, 0, 0 :: Int)
    where getComponent (row, column, orgb)
              | orgb   > 2         =
                  getComponent (row, succ column, 0)
              | column > maxColumn =
                  getComponent (succ row, 0, 0)
              | row    > maxRow    =
                  Nothing
              | otherwise =
                  let pixel = pixelf (row, column)
                      componentGetter =
                          case orgb of
                              2 -> untag' . S.toMainChar . (red   <:)
                              1 -> untag' . S.toMainChar . (green <:)
                              0 -> untag' . S.toMainChar . (blue  <:)
                              _ -> undefined
                  in  Just (componentGetter pixel, (row, column, succ orgb))
          pixelf = (b `getPixel`)
          (width_, height_) = dimensions b
          (width, height) = (fromIntegral width_, fromIntegral height_)
          maxRow    = abs . pred $ height
          maxColumn = abs . pred $ width
          untag' = untag :: Tagged s a -> a

encodeIBF_RGB24A4 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_RGB24A4 b =
    S.unfoldrN (fromIntegral $ (3 * width + paddingSize) * height) getComponent (0, 0, 0 :: Int, 0)
    where getComponent (row, column, orgb, paddingLeft)
              | paddingLeft > 0    =
                  Just (padCell, (row, column, orgb, pred paddingLeft))
              | orgb   > 2         =
                  getComponent (row, succ column, 0, 0)
              | column > maxColumn =
                  getComponent (succ row, 0, 0, paddingSize)
              | row    > maxRow    =
                  Nothing
              | otherwise =
                  let pixel = pixelf (row, column)
                      componentGetter =
                          case orgb of
                              0 -> untag' . S.toMainChar . (red   <:)
                              1 -> untag' . S.toMainChar . (green <:)
                              2 -> untag' . S.toMainChar . (blue  <:)
                              _ -> undefined
                  in  Just (componentGetter pixel, (row, column, succ orgb, 0))
          pixelf = (b `getPixel`)
          (width_, height_) = dimensions b
          (width, height) = (fromIntegral width_, fromIntegral height_)
          maxRow      = abs . pred $ height
          maxColumn   = abs . pred $ width
          paddingSize = case 4 - ((3 * width) `mod` 4) of
                            4 -> 0
                            n -> n
          padCell     = untag' . S.toMainChar $ padByte
          untag' = untag :: Tagged s a -> a

encodeIBF_BGR24A4VR :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_BGR24A4VR b =
    S.unfoldrN (fromIntegral $ (3 * width + paddingSize) * height) getComponent (0, 0, 0 :: Int, 0)
    where getComponent (row, column, orgb, paddingLeft)
              | paddingLeft > 0    =
                  Just (padCell, (row, column, orgb, pred paddingLeft))
              | orgb   > 2         =
                  getComponent (row, succ column, 0, 0)
              | column > maxColumn =
                  getComponent (succ row, 0, 0, paddingSize)
              | row    > maxRow    =
                  Nothing
              | otherwise =
                  let pixel = pixelf (maxRow - row, column)
                      componentGetter =
                          case orgb of
                              2 -> untag' . S.toMainChar . (red   <:)
                              1 -> untag' . S.toMainChar . (green <:)
                              0 -> untag' . S.toMainChar . (blue  <:)
                              _ -> undefined
                  in  Just (componentGetter pixel, (row, column, succ orgb, 0))
          pixelf = (b `getPixel`)
          (width_, height_) = dimensions b
          (width, height) = (fromIntegral width_, fromIntegral height_)
          maxRow      = abs . pred $ height
          maxColumn   = abs . pred $ width
          paddingSize = case 4 - ((3 * width) `mod` 4) of
                            4 -> 0
                            n -> n
          padCell     = untag' . S.toMainChar $ padByte
          untag' = untag :: Tagged s a -> a

encodeIBF_BGRU32VR :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_BGRU32VR b =
    S.unfoldrN (fromIntegral $ 4 * width * height) getComponent (0, 0, 0 :: Int)
    where getComponent (row, column, orgb)
              | orgb   > 3         =
                  getComponent (row, succ column, 0)
              | column > maxColumn =
                  getComponent (succ row, 0, 0)
              | row    > maxRow    =
                  Nothing
              | otherwise =
                  let pixel = pixelf (maxRow - row, column)
                      componentGetter =
                          case orgb of
                              3 -> const padCell
                              2 -> untag' . S.toMainChar . (red   <:)
                              1 -> untag' . S.toMainChar . (green <:)
                              0 -> untag' . S.toMainChar . (blue  <:)
                              _ -> undefined
                  in  Just (componentGetter pixel, (row, column, succ orgb))
          pixelf = (b `getPixel`)
          (width_, height_) = dimensions b
          (width, height) = (fromIntegral width_, fromIntegral height_)
          maxRow    = abs . pred $ height
          maxColumn = abs . pred $ width
          padCell   = untag' . S.toMainChar $ padByte
          untag' = untag :: Tagged s a -> a

encodeIBF_BGRU32 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_BGRU32 b =
    S.unfoldrN (fromIntegral $ 4 * width * height) getComponent (0, 0, 0 :: Int)
    where getComponent (row, column, orgb)
              | orgb   > 3         =
                  getComponent (row, succ column, 0)
              | column > maxColumn =
                  getComponent (succ row, 0, 0)
              | row    > maxRow    =
                  Nothing
              | otherwise =
                  let pixel = pixelf (row, column)
                      componentGetter =
                          case orgb of
                              3 -> const padCell
                              2 -> untag' . S.toMainChar . (red   <:)
                              1 -> untag' . S.toMainChar . (green <:)
                              0 -> untag' . S.toMainChar . (blue  <:)
                              _ -> undefined
                  in  Just (componentGetter pixel, (row, column, succ orgb))
          pixelf = (b `getPixel`)
          (width_, height_) = dimensions b
          (width, height) = (fromIntegral width_, fromIntegral height_)
          maxRow    = abs . pred $ height
          maxColumn = abs . pred $ width
          padCell   = untag' . S.toMainChar $ padByte
          untag' = untag :: Tagged s a -> a

encodeIBF_RGB24A4VR :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_RGB24A4VR b =
    S.unfoldrN (fromIntegral $ (3 * width + paddingSize) * height) getComponent (0, 0, 0 :: Int, 0)
    where getComponent (row, column, orgb, paddingLeft)
              | paddingLeft > 0    =
                  Just (padCell, (row, column, orgb, pred paddingLeft))
              | orgb   > 2         =
                  getComponent (row, succ column, 0, 0)
              | column > maxColumn =
                  getComponent (succ row, 0, 0, paddingSize)
              | row    > maxRow    =
                  Nothing
              | otherwise =
                  let pixel = pixelf (maxRow - row, column)
                      componentGetter =
                          case orgb of
                              0 -> untag' . S.toMainChar . (red   <:)
                              1 -> untag' . S.toMainChar . (green <:)
                              2 -> untag' . S.toMainChar . (blue  <:)
                              _ -> undefined
                  in  Just (componentGetter pixel, (row, column, succ orgb, 0))
          pixelf = (b `getPixel`)
          (width_, height_) = dimensions b
          (width, height) = (fromIntegral width_, fromIntegral height_)
          maxRow      = abs . pred $ height
          maxColumn   = abs . pred $ width
          paddingSize = case 4 - ((3 * width) `mod` 4) of
                            4 -> 0
                            n -> n
          padCell     = untag' . S.toMainChar $ padByte
          untag' = untag :: Tagged s a -> a

encodeIBF_RGB32 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_RGB32 b =
    S.unfoldrN (fromIntegral $ 4 * width * height) getComponent (0, 0, 0 :: Int)
    where getComponent (row, column, orgb)
              | orgb   > 3         =
                  getComponent (row, succ column, 0)
              | column > maxColumn =
                  getComponent (succ row, 0, 0)
              | row    > maxRow    =
                  Nothing
              | otherwise =
                  let pixel = pixelf (row, column)
                      componentGetter =
                          case orgb of
                              0 -> const padCell
                              1 -> untag' . S.toMainChar . (red   <:)
                              2 -> untag' . S.toMainChar . (green <:)
                              3 -> untag' . S.toMainChar . (blue  <:)
                              _ -> undefined
                  in  Just (componentGetter pixel, (row, column, succ orgb))
          pixelf = (b `getPixel`)
          (width_, height_) = dimensions b
          (width, height) = (fromIntegral width_, fromIntegral height_)
          maxRow    = abs . pred $ height
          maxColumn = abs . pred $ width
          padCell   = untag' . S.toMainChar $ padByte
          untag' = untag :: Tagged s a -> a

encodeIBF_RGB32Z64 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s
encodeIBF_RGB32Z64 = encode64 . S.fromStringCells . compress . encodeImageFmt IBF_RGB32

defaultImageDecoders :: [(ImageBitmapFormat, GenericBitmapSerializer ImageDecoder)]
defaultImageDecoders =
    [ (IBF_IDRGB32Z64,    GenericBitmapSerializer $ ImageDecoder $ tryIBF_IDRGB32Z64)
    , (IBF_IDRGB24Z64,    GenericBitmapSerializer $ ImageDecoder $ tryIBF_IDRGB24Z64)
    , (IBF_IDBGR24R2RZ64, GenericBitmapSerializer $ ImageDecoder $ tryIBF_IDBGR24R2RZ64)
    , (IBF_IDBGR24HZH,    GenericBitmapSerializer $ ImageDecoder $ tryIBF_IDBGR24HZH)
    , (IBF_BGR24H,        GenericBitmapSerializer $ ImageDecoder $ tryIBF_BGR24H)
    , (IBF_BGR24A4VR,     GenericBitmapSerializer $ ImageDecoder $ tryIBF_BGR24A4VR)
    , (IBF_BGRU32VR,      GenericBitmapSerializer $ ImageDecoder $ tryIBF_BGRU32VR)
    , (IBF_BGRU32,        GenericBitmapSerializer $ ImageDecoder $ tryIBF_BGRU32)
    , (IBF_RGB24A4VR,     GenericBitmapSerializer $ ImageDecoder $ tryIBF_RGB24A4VR)
    , (IBF_RGB24A4,       GenericBitmapSerializer $ ImageDecoder $ tryIBF_RGB24A4)
    , (IBF_RGB32,         GenericBitmapSerializer $ ImageDecoder $ tryIBF_RGB32)
    , (IBF_RGB32Z64,      GenericBitmapSerializer $ ImageDecoder $ tryIBF_RGB32Z64)
    ]

tryIBF_IDRGB24Z64 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_IDRGB24Z64 metaBitmap s_
    | (Just ('m', s')) <- (first S.toChar) <$> S.safeUncons s_
        = tryIBF_IDRGB24Z64' =<< tablespoon . decompress . S.toStringCells =<< (maybe (Left "Data.Bitmap.Class.tryIBF_IDRGB24Z64: not a valid sequence of characters representing a base-64 encoded string") Right $ decode64 s')
    | otherwise
        = Left "Data.Bitmap.Class.tryIBF_IDRGB24Z64: string does not begin with identifying 'b' character"
    where tryIBF_IDRGB24Z64' :: (S.StringCells s2) => s2 -> Either String bmp
          tryIBF_IDRGB24Z64' s
              | S.length s < minLength = Left $ printf "Data.Bitmap.Class.tryIBF_IDRGB24Z64: string is too small to contain the pixels of a bitmap with the dimensions of the passed bitmap, which are (%d, %d); the string is %d bytes long, but needs to be at least %d bytes long" (fromIntegral width  :: Integer) (fromIntegral height  :: Integer) (S.length s) minLength
              | otherwise              = Right $
                  constructPixels pixelf dms
              where (width, height) = dimensions metaBitmap
                    dms     = (fromIntegral width, fromIntegral height)
                    bytesPerPixel = 3
                    bytesPerRow   = bytesPerPixel * width
                    minLength     = fromIntegral $ bytesPerRow * height
                    pixelf (row, column) = let offset = fromIntegral $ bytesPerRow * (fromIntegral row) + bytesPerPixel * (fromIntegral column)
                                           in  (red   =: (S.toWord8 $ s `S.index` (offset + 0)))
                                             . (green =: (S.toWord8 $ s `S.index` (offset + 1)))
                                             . (blue  =: (S.toWord8 $ s `S.index` (offset + 2)))
                                             $ leastIntensity

tryIBF_IDBGR24R2RZ64 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_IDBGR24R2RZ64 metaBitmap s_
    | (Just ('b', s')) <- (first S.toChar) <$> S.safeUncons s_
        = tryIBF_IDBGR24R2RZ64' =<< tablespoon . decompress . S.toStringCells =<< (maybe (Left "Data.Bitmap.Class.tryIBF_IDBGR24R2RZ64: not a valid sequence of characters representing a base-64 encoded string") Right $ decode64 s')
    | otherwise
        = Left "Data.Bitmap.Class.tryIBF_IDBGR24R2RZ64: string does not begin with identifying 'b' character"
    where tryIBF_IDBGR24R2RZ64' :: (S.StringCells s2) => s2 -> Either String bmp
          tryIBF_IDBGR24R2RZ64' s
              | S.length s < minLength = Left $ printf "Data.Bitmap.Class.tryIBF_IDBGR24R2RZ64: string is too small to contain the pixels of a bitmap with the dimensions of the passed bitmap, which are (%d, %d); the string is %d bytes long, but needs to be at least %d bytes long" (fromIntegral width  :: Integer) (fromIntegral height  :: Integer) (S.length s) minLength
              | otherwise              = Right $
                  constructPixels pixelf dms
              where (width, height) = dimensions metaBitmap
                    dms             = (fromIntegral width, fromIntegral height)
                    maxRow          = abs . pred $ height
                    maxColumn       = abs . pred $ width
                    bytesPerPixel   = 3
                    bytesPerRow     = bytesPerPixel * width
                    minLength       = fromIntegral $ bytesPerRow * height
                    pixelf (row, column)
                        | (row, column) == (maxRow, maxColumn)
                            = (red   =: (S.toWord8 $ s `S.index` 1))
                            . (green =: (S.toWord8 $ s `S.index` 0))
                            . (blue  =: (S.toWord8 . S.last $ s))
                            $ leastIntensity
                        | otherwise
                            = let offset = fromIntegral $ bytesPerRow * (fromIntegral row) + bytesPerPixel * (fromIntegral column) + 2
                              in  (red   =: (S.toWord8 $ s `S.index` (offset + 2)))
                                . (green =: (S.toWord8 $ s `S.index` (offset + 1)))
                                . (blue  =: (S.toWord8 $ s `S.index` (offset + 0)))
                                $ leastIntensity

tryIBF_IDBGR24HZH :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_IDBGR24HZH metaBitmap s_
    | (Just ('z', s')) <- (first S.toChar) <$> S.safeUncons s_
        = decodeImageFmt IBF_BGR24H metaBitmap =<< tablespoon . decompress . S.toStringCells =<< (maybe (Left "Data.Bitmap.Class.tryIBF_IDBGR24HZH: not a valid sequence of characters representing a base-16 encoded string") Right $ decodeHex s')
    | otherwise
        = Left "Data.Bitmap.Class.tryIBF_IDBGR24HZH: string does not begin with identifying 'z' character"

tryIBF_IDRGB32Z64 :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_IDRGB32Z64 metaBitmap s_
    | (Just ('l', s')) <- (first S.toChar) <$> S.safeUncons s_
        = decodeImageFmt IBF_RGB32Z64 metaBitmap s'
    | otherwise
        = Left "Data.Bitmap.Class.tryIBF_IDRGB32Z64: string does not begin with identifying 'l' character"

tryIBF_BGR24H :: forall s bmp. (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_BGR24H metaBitmap s_
    | S.length s_ < minLength = Left $ printf "Data.Bitmap.Class.tryIBF_BGR24H: string is too small to contain the pixels of a bitmap with the dimensions of the passed bitmap, which are (%d, %d); the string is %d bytes long, but needs to be at least %d bytes long" (fromIntegral width  :: Integer) (fromIntegral height  :: Integer) (S.length s_) minLength
    | otherwise               = tryIBF_BGR24H' =<< (maybe (Left "Data.Bitmap.Class.tryIBF_BGR24H: not a valid sequence of characters representing a base-16 encoded string") Right $ decodeHex s_)
    where tryIBF_BGR24H' :: (S.StringCells s2) => s2 -> Either String bmp
          tryIBF_BGR24H' s
              | S.length s < minLengthDecoded = Left $ printf "Data.Bitmap.Class.tryIBF_BGR24H: the size of the encoded string, %d, is correct because it is at least %d, but after it was hex decoded, its size was incorrect; it was %d and it should have been at least %d; most likely there is a non-hex character too early in the string" (S.length s_) minLength (S.length s) minLengthDecoded
              | otherwise                     = Right $ constructPixels pixelf dms
              where pixelf (row, column) = let offset = fromIntegral $ bytesPerRow * (fromIntegral row) + bytesPerPixel * (fromIntegral column)
                                           in  (red   =: (S.toWord8 $ s `S.index` (offset + 2)))
                                             . (green =: (S.toWord8 $ s `S.index` (offset + 1)))
                                             . (blue  =: (S.toWord8 $ s `S.index` (offset + 0)))
                                             $ leastIntensity
          dms              = (fromIntegral width, fromIntegral height)
          (width, height)  = dimensions metaBitmap
          bytesPerPixel    = 3
          bytesPerRow      = bytesPerPixel * width
          minLength        = fromIntegral $ 2 * 3 * width * height
          minLengthDecoded = fromIntegral $ bytesPerRow * height

tryIBF_RGB24A4 :: (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_RGB24A4 metaBitmap s
    | S.length s < minLength = Left $ printf "Data.Bitmap.Class.tryIBF_RGB24A4: string is too small to contain the pixels of a bitmap with the dimensions of the passed bitmap, which are (%d, %d); the string is %d bytes long, but needs to be at least %d bytes long" (fromIntegral width  :: Integer) (fromIntegral height  :: Integer) (S.length s) minLength
    | otherwise              = Right $
        constructPixels pixelf dms
    where (width, height) = dimensions metaBitmap
          dms     = (fromIntegral width, fromIntegral height)
          padding = case 4 - ((3 * width) `mod` 4) of
                        4 -> 0
                        n -> n
          bytesPerPixel = 3
          bytesPerRow   = bytesPerPixel * width + padding
          minLength     = fromIntegral $ bytesPerRow * height
          pixelf (row, column) = let offset = fromIntegral $ bytesPerRow * (fromIntegral row) + bytesPerPixel * (fromIntegral column)
                                 in  (red   =: (S.toWord8 $ s `S.index` (offset + 0)))
                                   . (green =: (S.toWord8 $ s `S.index` (offset + 1)))
                                   . (blue  =: (S.toWord8 $ s `S.index` (offset + 2)))
                                   $ leastIntensity

tryIBF_BGR24A4VR :: (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_BGR24A4VR metaBitmap s
    | S.length s < minLength = Left $ printf "Data.Bitmap.Class.tryIBF_BGR24A4VR: string is too small to contain the pixels of a bitmap with the dimensions of the passed bitmap, which are (%d, %d); the string is %d bytes long, but needs to be at least %d bytes long" (fromIntegral width  :: Integer) (fromIntegral height  :: Integer) (S.length s) minLength
    | otherwise              = Right $
        constructPixels pixelf dms
    where (width, height) = dimensions metaBitmap
          dms     = (fromIntegral width, fromIntegral height)
          padding = case 4 - ((3 * width) `mod` 4) of
                        4 -> 0
                        n -> n
          bytesPerPixel = 3
          bytesPerRow   = bytesPerPixel * width + padding
          minLength     = fromIntegral $ bytesPerRow * height
          maxRow        = abs . pred $ height
          pixelf (row, column) = let offset = fromIntegral $ bytesPerRow * (fromIntegral $ maxRow - row) + bytesPerPixel * (fromIntegral column)
                                 in  (red   =: (S.toWord8 $ s `S.index` (offset + 2)))
                                   . (green =: (S.toWord8 $ s `S.index` (offset + 1)))
                                   . (blue  =: (S.toWord8 $ s `S.index` (offset + 0)))
                                   $ leastIntensity

tryIBF_BGRU32VR :: (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_BGRU32VR metaBitmap s
    | S.length s < minLength = Left $ printf "Data.Bitmap.Class.tryIBF_BGRU32VR: string is too small to contain the pixels of a bitmap with the dimensions of the passed bitmap, which are (%d, %d); the string is %d bytes long, but needs to be at least %d bytes long" (fromIntegral width  :: Integer) (fromIntegral height  :: Integer) (S.length s) minLength
    | otherwise              = Right $
        constructPixels pixelf dms
    where (width, height) = dimensions metaBitmap
          dms     = (fromIntegral width, fromIntegral height)
          bytesPerPixel = 4
          bytesPerRow   = bytesPerPixel * width
          minLength     = fromIntegral $ bytesPerRow * height
          maxRow        = abs . pred $ height
          pixelf (row, column) = let offset = fromIntegral $ bytesPerRow * (fromIntegral $ maxRow - row) + bytesPerPixel * (fromIntegral column)
                                 in  (red   =: (S.toWord8 $ s `S.index` (offset + 2)))
                                   . (green =: (S.toWord8 $ s `S.index` (offset + 1)))
                                   . (blue  =: (S.toWord8 $ s `S.index` (offset + 0)))
                                   $ leastIntensity

tryIBF_BGRU32 :: (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_BGRU32 metaBitmap s
    | S.length s < minLength = Left $ printf "Data.Bitmap.Class.tryIBF_BGRU32: string is too small to contain the pixels of a bitmap with the dimensions of the passed bitmap, which are (%d, %d); the string is %d bytes long, but needs to be at least %d bytes long" (fromIntegral width  :: Integer) (fromIntegral height  :: Integer) (S.length s) minLength
    | otherwise              = Right $
        constructPixels pixelf dms
    where (width, height) = dimensions metaBitmap
          dms     = (fromIntegral width, fromIntegral height)
          bytesPerPixel = 4
          bytesPerRow   = bytesPerPixel * width
          minLength     = fromIntegral $ bytesPerRow * height
          pixelf (row, column) = let offset = fromIntegral $ bytesPerRow * (fromIntegral row) + bytesPerPixel * (fromIntegral column)
                                 in  (red   =: (S.toWord8 $ s `S.index` (offset + 2)))
                                   . (green =: (S.toWord8 $ s `S.index` (offset + 1)))
                                   . (blue  =: (S.toWord8 $ s `S.index` (offset + 0)))
                                   $ leastIntensity

tryIBF_RGB24A4VR :: (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_RGB24A4VR metaBitmap s
    | S.length s < minLength = Left $ printf "Data.Bitmap.Class.tryIBF_RGB24A4VR: string is too small to contain the pixels of a bitmap with the dimensions of the passed bitmap, which are (%d, %d); the string is %d bytes long, but needs to be at least %d bytes long" (fromIntegral width  :: Integer) (fromIntegral height  :: Integer) (S.length s) minLength
    | otherwise              = Right $
        constructPixels pixelf dms
    where (width, height) = dimensions metaBitmap
          dms     = (fromIntegral width, fromIntegral height)
          padding = case 4 - ((3 * width) `mod` 4) of
                        4 -> 0
                        n -> n
          bytesPerPixel = 3
          bytesPerRow   = bytesPerPixel * width + padding
          minLength     = fromIntegral $ bytesPerRow * height
          maxRow        = abs . pred $ height
          pixelf (row, column) = let offset = fromIntegral $ bytesPerRow * (fromIntegral $ maxRow - row) + bytesPerPixel * (fromIntegral column)
                                 in  (red   =: (S.toWord8 $ s `S.index` (offset + 0)))
                                   . (green =: (S.toWord8 $ s `S.index` (offset + 1)))
                                   . (blue  =: (S.toWord8 $ s `S.index` (offset + 2)))
                                   $ leastIntensity

tryIBF_RGB32 :: (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_RGB32 metaBitmap s
    | S.length s < minLength = Left $ printf "Data.Bitmap.Class.tryIBF_RGB32: string is too small to contain the pixels of a bitmap with the dimensions of the passed bitmap, which are (%d, %d); the string is %d bytes long, but needs to be at least %d bytes long" (fromIntegral width  :: Integer) (fromIntegral height  :: Integer) (S.length s) minLength
    | otherwise              = Right $
        constructPixels pixelf dms
    where (width, height) = dimensions metaBitmap
          dms     = (fromIntegral width, fromIntegral height)
          bytesPerPixel = 4
          bytesPerRow   = bytesPerPixel * width
          minLength     = fromIntegral $ bytesPerRow * height
          pixelf (row, column) = let offset = fromIntegral $ bytesPerRow * (fromIntegral row) + bytesPerPixel * (fromIntegral column)
                                 in  (red   =: (S.toWord8 $ s `S.index` (offset + 1)))
                                   . (green =: (S.toWord8 $ s `S.index` (offset + 2)))
                                   . (blue  =: (S.toWord8 $ s `S.index` (offset + 3)))
                                   $ leastIntensity

tryIBF_RGB32Z64 :: (S.StringCells s, Bitmap bmp) => bmp -> s -> Either String bmp
tryIBF_RGB32Z64 metaBitmap s = decodeImageFmt IBF_RGB32 metaBitmap =<< tablespoon . decompress . S.toStringCells =<< (maybe (Left "Data.Bitmap.Class.tryIBF_RGB32Z64: not a valid sequence of characters representing a base-64 encoded string") Right $ decode64 s)

-- | Encode a bitmap
--
-- An implementation can choose the most efficient or appropriate
-- format by placing its encoder first in its list of encoders.
encodeComplete :: (S.StringCells s, Bitmap bmp) => bmp -> s
encodeComplete
    | null encoders = error $ printf "encodeComplete: implementation defines no encoders"
    | otherwise     = unwrapCompleteEncoder . snd . head $ encoders
    where encoders = completeEncoders

-- | Decode a bitmap
--
-- The result of first decoder of the implementation that succeeds
-- will be returned.  If none succeed, 'Nothing' is returned.
decodeComplete :: (S.StringCells s, Bitmap bmp) => s -> Maybe (CompleteBitmapFormat, bmp)
decodeComplete s = listToMaybe . catMaybes . map (\(fmt, decoder) -> either (const Nothing) (Just . (fmt, )) $ unwrapCompleteDecoder decoder s) $ completeDecoders

-- | Encode the pixels of a bitmap
--
-- An implementation can choose the most efficient or appropriate
-- format by placing its encoder first in its list of encoders.
encodeImage :: (S.StringCells s, Bitmap bmp) => bmp -> s
encodeImage
    | null encoders = error $ printf "encodeImage: implementation defines no encoders"
    | otherwise     = unwrapImageEncoder . snd . head $ encoders
    where encoders = imageEncoders

-- | Decode the pixels of a bitmap
--
-- The result of first decoder of the implementation that succeeds
-- will be returned.  If none succeed, 'Nothing' is returned.
decodeImage :: (S.StringCells s, Bitmap bmp) => bmp -> s -> Maybe (ImageBitmapFormat, bmp)
decodeImage bmp s = listToMaybe . catMaybes . map (\(fmt, decoder) -> either (const Nothing) (Just . (fmt, )) $ unwrapImageDecoder decoder bmp s) $ imageDecoders

serializeFmt :: (Eq a, Show a) => [(a, b)] -> String -> (a -> b)
serializeFmt serializers noHandlerErrorFmtStr = \fmt -> case lookup fmt serializers of
    (Just f)  -> f
    (Nothing) -> error $
        printf
            noHandlerErrorFmtStr
            (show fmt)

-- | Encode a bitmap in a particular format
encodeCompleteFmt :: (S.StringCells s, Bitmap bmp) => CompleteBitmapFormat -> bmp -> s
encodeCompleteFmt = unwrapCompleteEncoder . serializeFmt completeEncoders
    "encodeCompleteFmt: Bitmap instance did not define handler for encoding format '%s'; does it use 'updateIdentifiableElements' with 'defaultCompleteEncoders' properly?"

-- | Decode a bitmap in a particular format
decodeCompleteFmt :: (S.StringCells s, Bitmap bmp) => CompleteBitmapFormat -> s -> Either String bmp
decodeCompleteFmt = unwrapCompleteDecoder . serializeFmt completeDecoders
    "decodeCompleteFmt: Bitmap instance did not define handler for decoding '%s'; does it use 'updateIdentifiableElements' with 'defaultCompleteDecoders' properly?"

-- | Encode the pixels of a bitmap in a particular format
encodeImageFmt :: (S.StringCells s, Bitmap bmp) => ImageBitmapFormat -> bmp -> s
encodeImageFmt    = unwrapImageEncoder . serializeFmt imageEncoders
    "encodeImageFmt: Bitmap instance did not define handler for encoding format '%s'; does it use 'updateIdentifiableElements' with 'defaultImageEncoders' properly?"

-- | Decode the pixels of a bitmap in a particular format
decodeImageFmt :: (S.StringCells s, Bitmap bmp) => ImageBitmapFormat -> bmp -> s -> Either String bmp
decodeImageFmt    = unwrapImageDecoder . serializeFmt imageDecoders
    "decodeImageFmt: Bitmap instance did not define handler for decoding format '%s'; does it use 'updateIdentifiableElements' with 'defaultImageDecoders' properly?"

-- | Decode an image with the given dimensions
--
-- This is only guaranteed to work on implementations and formats that only
-- need dimensions in addition to the raw pixel data.  This is convenient
-- because most often the dimensions are all that is needed.
--
-- Currently, this function works by constructing a bitmap with the given dimensions
-- and with each pixel set to the least intensity.  Thus it is significantly more efficient
-- if this is used with a bitmap that doesn't strictly evaluate the entire pixel data when the structure
-- is first constructed (not necessarily when any pixel is accessed) (currently
-- none of the bitmap types exported in this library are so strict), as the
-- bitmap will not need to be fully evaluated; only the dimensions will be used.
decodeImageDimensions :: (S.StringCells s, Bitmap bmp) => Dimensions (BIndexType bmp) -> s -> Maybe (ImageBitmapFormat, bmp)
decodeImageDimensions dms = decodeImage (constructPixels (const leastIntensity) dms)

-- | Decode an image with the given dimensions as 'decodeImageDimensions' does it, but in a specific format
decodeImageDimensionsFmt :: (S.StringCells s, Bitmap bmp) => ImageBitmapFormat -> Dimensions (BIndexType bmp) -> s -> Either String bmp
decodeImageDimensionsFmt fmt dms = decodeImageFmt fmt (constructPixels (const leastIntensity) dms)

-- | Determine whether the seconds dimensions passed can fit within the first dimensions passed
--
-- If the width or height of the second dimensions exceeds those of first
-- dimensions, 'False' is returned.
dimensionsFit :: (Integral a) => Dimensions a -> Dimensions a -> Bool
dimensionsFit (widthSuper, heightSuper) (widthSub, heightSub)
    | widthSub  > widthSuper  = False
    | heightSub > heightSuper = False
    | otherwise               = True

-- | Returns the width of a bitmap
bitmapWidth :: (Bitmap bmp) => bmp -> BIndexType bmp
bitmapWidth bmp = let (width, _) = dimensions bmp in width

-- | Returns the height of a bitmap
bitmapHeight :: (Bitmap bmp) => bmp -> BIndexType bmp
bitmapHeight bmp = let (_, height) = dimensions bmp in height