    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE CPP #-}
    -- | Module implementing GIF decoding.

    module Codec.Picture.Gif ( -- * Reading

                               decodeGif
                             , decodeGifWithMetadata
                             , decodeGifWithPaletteAndMetadata
                             , decodeGifImages
                             , getDelaysGifImages

                               -- * Writing

                             , GifDelay
                             , GifDisposalMethod( .. )
                             , GifEncode( .. )
                             , GifFrame( .. )
                             , GifLooping( .. )
                             , encodeGifImage
                             , encodeGifImageWithPalette
                             , encodeGifImages
                             , encodeComplexGifImage

                             , writeGifImage
                             , writeGifImageWithPalette
                             , writeGifImages
                             , writeComplexGifImage
                             , greyPalette
                             ) where

    #if !MIN_VERSION_base(4,8,0)
    import Control.Applicative( pure, (<*>), (<$>) )
    #endif

    import Control.Arrow( first )
    import Control.Monad( replicateM, replicateM_, unless, when )
    import Control.Monad.ST( runST )
    import Control.Monad.Trans.Class( lift )

    import Data.Bits( (.&.), (.|.)
                    , unsafeShiftR
                    , unsafeShiftL
                    , testBit, setBit )
    import Data.Word( Word8, Word16 )

    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as BC
    import qualified Data.ByteString.Lazy as L
    import qualified Data.Vector.Storable as V
    import qualified Data.Vector.Storable.Mutable as M

    import Data.Binary( Binary(..), encode )
    import Data.Binary.Get( Get
                          , getWord8
                          , getWord16le
                          , getByteString
                          , bytesRead
                          , skip
                          )

    import Data.Binary.Put( Put
                          , putWord8
                          , putWord16le
                          , putByteString
                          )

    import Codec.Picture.InternalHelper
    import Codec.Picture.Types
    import Codec.Picture.Metadata( Metadatas
                                 , SourceFormat( SourceGif )
                                 , basicMetadata )
    import Codec.Picture.Gif.Internal.LZW
    import Codec.Picture.Gif.Internal.LZWEncoding
    import Codec.Picture.BitWriter

    -- | Delay to wait before showing the next Gif image.

    -- The delay is expressed in 100th of seconds.

    type GifDelay = Int

    -- | Help to control the behaviour of GIF animation looping.

    data GifLooping =
          -- | The animation will stop once the end is reached

          LoopingNever
          -- | The animation will restart once the end is reached

        | LoopingForever
          -- | The animation will repeat n times before stoping

        | LoopingRepeat Word16

    -- | GIF image definition for encoding

    data GifEncode = GifEncode
      { -- | Screen width

        GifEncode -> Int
    geWidth      :: Int
      , -- | Screen height

        GifEncode -> Int
    geHeight     :: Int
      , -- | Global palette, optional

        GifEncode -> Maybe Palette
    gePalette    :: Maybe Palette
      , -- | Background color index, optional. If given, a global palette is also required

        GifEncode -> Maybe Int
    geBackground :: Maybe Int
      , -- | Looping behaviour

        GifEncode -> GifLooping
    geLooping    :: GifLooping
      , -- | Image frames

        GifEncode -> [GifFrame]
    geFrames     :: [GifFrame]
      }

    -- | An individual image frame in a GIF image

    data GifFrame = GifFrame
      { -- | Image X offset in GIF canvas

        GifFrame -> Int
    gfXOffset     :: Int
      , -- | Image Y offset in GIF canvas

        GifFrame -> Int
    gfYOffset     :: Int
      , -- | Image local palette, optional if a global palette is given

        GifFrame -> Maybe Palette
    gfPalette     :: Maybe Palette
      , -- | Transparent color index, optional

        GifFrame -> Maybe Int
    gfTransparent :: Maybe Int
      , -- | Frame transition delay, in 1/100ths of a second

        GifFrame -> Int
    gfDelay       :: GifDelay
      , -- | Frame disposal method

        GifFrame -> GifDisposalMethod
    gfDisposal    :: GifDisposalMethod
      , -- | Image pixels

        GifFrame -> Image Word8
    gfPixels      :: Image Pixel8
      }

    {-
       <GIF Data Stream> ::=     Header <Logical Screen> <Data>* Trailer

       <Logical Screen> ::=      Logical Screen Descriptor [Global Color Table]

       <Data> ::=                <Graphic Block>  |
                                 <Special-Purpose Block>

       <Graphic Block> ::=       [Graphic Control Extension] <Graphic-Rendering Block>

       <Graphic-Rendering Block> ::=  <Table-Based Image>  |
                                      Plain Text Extension

       <Table-Based Image> ::=   Image Descriptor [Local Color Table] Image Data

       <Special-Purpose Block> ::=    Application Extension  |
                                      Comment Extension
     -}

    --------------------------------------------------

    ----            GifVersion

    --------------------------------------------------

    data GifVersion = GIF87a | GIF89a

    gif87aSignature, gif89aSignature :: B.ByteString
    gif87aSignature :: ByteString
    gif87aSignature = [Word8] -> ByteString
    B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Char -> Word8) -> String -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    forall a. Enum a => a -> Int
    fromEnum) String
    "GIF87a"
    gif89aSignature :: ByteString
    gif89aSignature = [Word8] -> ByteString
    B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Char -> Word8) -> String -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    forall a. Enum a => a -> Int
    fromEnum) String
    "GIF89a"

    instance Binary GifVersion where
        put :: GifVersion -> Put
    put GifVersion
    GIF87a = ByteString -> Put
    putByteString ByteString
    gif87aSignature
        put GifVersion
    GIF89a = ByteString -> Put
    putByteString ByteString
    gif89aSignature

        get :: Get GifVersion
    get = do
            ByteString
    sig <- Int -> Get ByteString
    getByteString (ByteString -> Int
    B.length ByteString
    gif87aSignature)
            case (ByteString
    sig ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    gif87aSignature, ByteString
    sig ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    gif89aSignature) of
                (Bool
    True, Bool
    _)  -> GifVersion -> Get GifVersion
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GifVersion
    GIF87a
                (Bool
    _ , Bool
    True) -> GifVersion -> Get GifVersion
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GifVersion
    GIF89a
                (Bool, Bool)
    _          -> String -> Get GifVersion
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> Get GifVersion) -> String -> Get GifVersion
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid Gif signature : " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Int -> Char
    forall a. Enum a => Int -> a
    toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a. Enum a => a -> Int
    fromEnum (Word8 -> Char) -> [Word8] -> String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> [Word8]
    B.unpack ByteString
    sig)

    --------------------------------------------------

    ----         LogicalScreenDescriptor

    --------------------------------------------------

    -- | Section 18 of spec-gif89a

    data LogicalScreenDescriptor = LogicalScreenDescriptor
      { -- | Stored on 16 bits

        LogicalScreenDescriptor -> Word16
    screenWidth           :: !Word16
        -- | Stored on 16 bits

      , LogicalScreenDescriptor -> Word16
    screenHeight          :: !Word16
        -- | Stored on 8 bits

      , LogicalScreenDescriptor -> Word8
    backgroundIndex       :: !Word8

      -- | Stored on 1 bit

      , LogicalScreenDescriptor -> Bool
    hasGlobalMap          :: !Bool
      -- | Stored on 3 bits

      , LogicalScreenDescriptor -> Word8
    colorResolution       :: !Word8
      -- | Stored on 1 bit

      , LogicalScreenDescriptor -> Bool
    isColorTableSorted    :: !Bool
      -- | Stored on 3 bits

      , LogicalScreenDescriptor -> Word8
    colorTableSize        :: !Word8
      }

    instance Binary LogicalScreenDescriptor where
        put :: LogicalScreenDescriptor -> Put
    put LogicalScreenDescriptor
    v = do
          Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ LogicalScreenDescriptor -> Word16
    screenWidth LogicalScreenDescriptor
    v
          Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ LogicalScreenDescriptor -> Word16
    screenHeight LogicalScreenDescriptor
    v
          let globalMapField :: Word8
    globalMapField
                | LogicalScreenDescriptor -> Bool
    hasGlobalMap LogicalScreenDescriptor
    v = Word8
    0x80
                | Bool
    otherwise = Word8
    0

              colorTableSortedField :: Word8
    colorTableSortedField
                | LogicalScreenDescriptor -> Bool
    isColorTableSorted LogicalScreenDescriptor
    v = Word8
    0x08
                | Bool
    otherwise = Word8
    0

              tableSizeField :: Word8
    tableSizeField = (LogicalScreenDescriptor -> Word8
    colorTableSize LogicalScreenDescriptor
    v Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    1) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    7

              colorResolutionField :: Word8
    colorResolutionField =
                ((LogicalScreenDescriptor -> Word8
    colorResolution LogicalScreenDescriptor
    v Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    1) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    7) Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    4

              packedField :: Word8
    packedField = Word8
    globalMapField
                         Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    colorTableSortedField
                         Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    tableSizeField
                         Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    colorResolutionField

          Word8 -> Put
    putWord8 Word8
    packedField
          Word8 -> Put
    putWord8 Word8
    0 -- aspect ratio

          Word8 -> Put
    putWord8 (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ LogicalScreenDescriptor -> Word8
    backgroundIndex LogicalScreenDescriptor
    v

        get :: Get LogicalScreenDescriptor
    get = do
            Word16
    w <- Get Word16
    getWord16le
            Word16
    h <- Get Word16
    getWord16le
            Word8
    packedField  <- Get Word8
    getWord8
            Word8
    backgroundColorIndex  <- Get Word8
    getWord8
            Word8
    _aspectRatio  <- Get Word8
    getWord8
            LogicalScreenDescriptor -> Get LogicalScreenDescriptor
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return LogicalScreenDescriptor
                { screenWidth :: Word16
    screenWidth           = Word16
    w
                , screenHeight :: Word16
    screenHeight          = Word16
    h
                , hasGlobalMap :: Bool
    hasGlobalMap          = Word8
    packedField Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    7
                , colorResolution :: Word8
    colorResolution       = (Word8
    packedField Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    4) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x7 Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    1
                , isColorTableSorted :: Bool
    isColorTableSorted    = Word8
    packedField Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    3
                , colorTableSize :: Word8
    colorTableSize        = (Word8
    packedField Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x7) Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    1
                , backgroundIndex :: Word8
    backgroundIndex       = Word8
    backgroundColorIndex
                }

    --------------------------------------------------

    ----            ImageDescriptor

    --------------------------------------------------

    -- | Section 20 of spec-gif89a

    data ImageDescriptor = ImageDescriptor
      { ImageDescriptor -> Word16
    gDescPixelsFromLeft         :: !Word16
      , ImageDescriptor -> Word16
    gDescPixelsFromTop          :: !Word16
      , ImageDescriptor -> Word16
    gDescImageWidth             :: !Word16
      , ImageDescriptor -> Word16
    gDescImageHeight            :: !Word16
      , ImageDescriptor -> Bool
    gDescHasLocalMap            :: !Bool
      , ImageDescriptor -> Bool
    gDescIsInterlaced           :: !Bool
      , ImageDescriptor -> Bool
    gDescIsImgDescriptorSorted  :: !Bool
      , ImageDescriptor -> Word8
    gDescLocalColorTableSize    :: !Word8
      }

    imageSeparator, extensionIntroducer, gifTrailer :: Word8
    imageSeparator :: Word8
    imageSeparator      = Word8
    0x2C
    extensionIntroducer :: Word8
    extensionIntroducer = Word8
    0x21
    gifTrailer :: Word8
    gifTrailer          = Word8
    0x3B

    graphicControlLabel, commentLabel, plainTextLabel, applicationLabel :: Word8
    plainTextLabel :: Word8
    plainTextLabel = Word8
    0x01
    graphicControlLabel :: Word8
    graphicControlLabel = Word8
    0xF9
    commentLabel :: Word8
    commentLabel = Word8
    0xFE
    applicationLabel :: Word8
    applicationLabel    = Word8
    0xFF

    parseDataBlocks :: Get B.ByteString
    parseDataBlocks :: Get ByteString
    parseDataBlocks = [ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString) -> Get [ByteString] -> Get ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Get Word8
    getWord8 Get Word8 -> (Word8 -> Get [ByteString]) -> Get [ByteString]
    forall a b. Get a -> (a -> Get b) -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Word8 -> Get [ByteString]
    aux)
     where aux :: Word8 -> Get [ByteString]
    aux    Word8
    0 = [ByteString] -> Get [ByteString]
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
           aux Word8
    size = (:) (ByteString -> [ByteString] -> [ByteString])
    -> Get ByteString -> Get ([ByteString] -> [ByteString])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get ByteString
    getByteString (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    size) Get ([ByteString] -> [ByteString])
    -> Get [ByteString] -> Get [ByteString]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Get Word8
    getWord8 Get Word8 -> (Word8 -> Get [ByteString]) -> Get [ByteString]
    forall a b. Get a -> (a -> Get b) -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Word8 -> Get [ByteString]
    aux)

    putDataBlocks :: B.ByteString -> Put
    putDataBlocks :: ByteString -> Put
    putDataBlocks ByteString
    wholeString = ByteString -> Put
    putSlices ByteString
    wholeString 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
    putWord8 Word8
    0
      where putSlices :: ByteString -> Put
    putSlices ByteString
    str | ByteString -> Int
    B.length ByteString
    str Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = () -> Put
    forall a. a -> PutM a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                          | ByteString -> Int
    B.length ByteString
    str Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0xFF =
                let (ByteString
    before, ByteString
    after) = Int -> ByteString -> (ByteString, ByteString)
    B.splitAt Int
    0xFF ByteString
    str in
                Word8 -> Put
    putWord8 Word8
    0xFF Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> Put
    putByteString ByteString
    before Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> Put
    putSlices ByteString
    after
            putSlices ByteString
    str =
                Word8 -> Put
    putWord8 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    str) Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ByteString -> Put
    putByteString ByteString
    str

    data GifDisposalMethod
        = DisposalAny
        | DisposalDoNot
        | DisposalRestoreBackground
        | DisposalRestorePrevious
        | DisposalUnknown Word8

    disposalMethodOfCode :: Word8 -> GifDisposalMethod
    disposalMethodOfCode :: Word8 -> GifDisposalMethod
    disposalMethodOfCode Word8
    v = case Word8
    v of
        Word8
    0 -> GifDisposalMethod
    DisposalAny
        Word8
    1 -> GifDisposalMethod
    DisposalDoNot
        Word8
    2 -> GifDisposalMethod
    DisposalRestoreBackground
        Word8
    3 -> GifDisposalMethod
    DisposalRestorePrevious
        Word8
    n -> Word8 -> GifDisposalMethod
    DisposalUnknown Word8
    n

    codeOfDisposalMethod :: GifDisposalMethod -> Word8
    codeOfDisposalMethod :: GifDisposalMethod -> Word8
    codeOfDisposalMethod GifDisposalMethod
    v = case GifDisposalMethod
    v of
        GifDisposalMethod
    DisposalAny -> Word8
    0
        GifDisposalMethod
    DisposalDoNot -> Word8
    1
        GifDisposalMethod
    DisposalRestoreBackground -> Word8
    2
        GifDisposalMethod
    DisposalRestorePrevious -> Word8
    3
        DisposalUnknown Word8
    n -> Word8
    n

    data GraphicControlExtension = GraphicControlExtension
        { GraphicControlExtension -> GifDisposalMethod
    gceDisposalMethod        :: !GifDisposalMethod -- ^ Stored on 3 bits

        , GraphicControlExtension -> Bool
    gceUserInputFlag         :: !Bool
        , GraphicControlExtension -> Bool
    gceTransparentFlag       :: !Bool
        , GraphicControlExtension -> Word16
    gceDelay                 :: !Word16
        , GraphicControlExtension -> Word8
    gceTransparentColorIndex :: !Word8
        }

    instance Binary GraphicControlExtension where
        put :: GraphicControlExtension -> Put
    put GraphicControlExtension
    v = do
            Word8 -> Put
    putWord8 Word8
    extensionIntroducer
            Word8 -> Put
    putWord8 Word8
    graphicControlLabel
            Word8 -> Put
    putWord8 Word8
    0x4  -- size

            let disposalCode :: Word8
    disposalCode = GifDisposalMethod -> Word8
    codeOfDisposalMethod (GifDisposalMethod -> Word8) -> GifDisposalMethod -> Word8
    forall a b. (a -> b) -> a -> b
    $ GraphicControlExtension -> GifDisposalMethod
    gceDisposalMethod GraphicControlExtension
    v
                disposalField :: Word8
    disposalField =
                    (Word8
    disposalCode Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x7) Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    2

                userInputField :: Word8
    userInputField
                    | GraphicControlExtension -> Bool
    gceUserInputFlag GraphicControlExtension
    v = Word8
    0 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    1
                    | Bool
    otherwise = Word8
    0

                transparentField :: Word8
    transparentField
                    | GraphicControlExtension -> Bool
    gceTransparentFlag GraphicControlExtension
    v = Word8
    0 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    0
                    | Bool
    otherwise = Word8
    0

                packedFields :: Word8
    packedFields =  Word8
    disposalField
                            Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    userInputField
                            Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    transparentField

            Word8 -> Put
    putWord8 Word8
    packedFields
            Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ GraphicControlExtension -> Word16
    gceDelay GraphicControlExtension
    v
            Word8 -> Put
    putWord8 (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ GraphicControlExtension -> Word8
    gceTransparentColorIndex GraphicControlExtension
    v
            Word8 -> Put
    putWord8 Word8
    0 -- blockTerminator

        get :: Get GraphicControlExtension
    get = do
            -- due to missing lookahead

            {-_extensionLabel  <- getWord8-}
            Word8
    _size            <- Get Word8
    getWord8
            Word8
    packedFields     <- Get Word8
    getWord8
            Word16
    delay            <- Get Word16
    getWord16le
            Word8
    idx              <- Get Word8
    getWord8
            Word8
    _blockTerminator <- Get Word8
    getWord8
            GraphicControlExtension -> Get GraphicControlExtension
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return GraphicControlExtension
                { gceDisposalMethod :: GifDisposalMethod
    gceDisposalMethod        =
                    Word8 -> GifDisposalMethod
    disposalMethodOfCode (Word8 -> GifDisposalMethod) -> Word8 -> GifDisposalMethod
    forall a b. (a -> b) -> a -> b
    $
                        (Word8
    packedFields Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    2) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x07
                , gceUserInputFlag :: Bool
    gceUserInputFlag         = Word8
    packedFields Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    1
                , gceTransparentFlag :: Bool
    gceTransparentFlag       = Word8
    packedFields Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    0
                , gceDelay :: Word16
    gceDelay                 = Word16
    delay
                , gceTransparentColorIndex :: Word8
    gceTransparentColorIndex = Word8
    idx
                }

    data GifImage = GifImage
        { GifImage -> ImageDescriptor
    imgDescriptor   :: !ImageDescriptor
        , GifImage -> Maybe Palette
    imgLocalPalette :: !(Maybe Palette)
        , GifImage -> Word8
    imgLzwRootSize  :: !Word8
        , GifImage -> ByteString
    imgData         :: B.ByteString
        }

    instance Binary GifImage where
        put :: GifImage -> Put
    put GifImage
    img = do
            let descriptor :: ImageDescriptor
    descriptor = GifImage -> ImageDescriptor
    imgDescriptor GifImage
    img
            ImageDescriptor -> Put
    forall t. Binary t => t -> Put
    put ImageDescriptor
    descriptor
            case ( GifImage -> Maybe Palette
    imgLocalPalette GifImage
    img
                 , ImageDescriptor -> Bool
    gDescHasLocalMap (ImageDescriptor -> Bool) -> ImageDescriptor -> Bool
    forall a b. (a -> b) -> a -> b
    $ GifImage -> ImageDescriptor
    imgDescriptor GifImage
    img) of
              (Maybe Palette
    Nothing, Bool
    _) -> () -> Put
    forall a. a -> PutM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              (Just Palette
    _, Bool
    False) -> () -> Put
    forall a. a -> PutM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              (Just Palette
    p, Bool
    True) ->
                  Int -> Palette -> Put
    putPalette (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word8
    gDescLocalColorTableSize ImageDescriptor
    descriptor) Palette
    p
            Word8 -> Put
    putWord8 (Word8 -> Put) -> Word8 -> Put
    forall a b. (a -> b) -> a -> b
    $ GifImage -> Word8
    imgLzwRootSize GifImage
    img
            ByteString -> Put
    putDataBlocks (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ GifImage -> ByteString
    imgData GifImage
    img

        get :: Get GifImage
    get = do
            ImageDescriptor
    desc <- Get ImageDescriptor
    forall t. Binary t => Get t
    get
            let hasLocalColorTable :: Bool
    hasLocalColorTable = ImageDescriptor -> Bool
    gDescHasLocalMap ImageDescriptor
    desc
            Maybe Palette
    palette <- if Bool
    hasLocalColorTable
               then Palette -> Maybe Palette
    forall a. a -> Maybe a
    Just (Palette -> Maybe Palette) -> Get Palette -> Get (Maybe Palette)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Word8 -> Get Palette
    getPalette (ImageDescriptor -> Word8
    gDescLocalColorTableSize ImageDescriptor
    desc)
               else Maybe Palette -> Get (Maybe Palette)
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Palette
    forall a. Maybe a
    Nothing

            ImageDescriptor -> Maybe Palette -> Word8 -> ByteString -> GifImage
    GifImage ImageDescriptor
    desc Maybe Palette
    palette (Word8 -> ByteString -> GifImage)
    -> Get Word8 -> Get (ByteString -> GifImage)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word8
    getWord8 Get (ByteString -> GifImage) -> Get ByteString -> Get GifImage
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get ByteString
    parseDataBlocks

    data Block = BlockImage GifImage
               | BlockGraphicControl GraphicControlExtension

    skipSubDataBlocks :: Get ()
    skipSubDataBlocks :: Get ()
    skipSubDataBlocks = do
      Int
    s <- Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word8
    getWord8
      Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Int
    s Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
        Int -> Get ()
    skip Int
    s Get () -> Get () -> Get ()
    forall a b. Get a -> Get b -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Get ()
    skipSubDataBlocks

    parseGifBlocks :: Get [Block]
    parseGifBlocks :: Get [Block]
    parseGifBlocks = Get Word8
    getWord8 Get Word8 -> (Word8 -> Get [Block]) -> Get [Block]
    forall a b. Get a -> (a -> Get b) -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Word8 -> Get [Block]
    blockParse
      where
        blockParse :: Word8 -> Get [Block]
    blockParse Word8
    v
          | Word8
    v Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    gifTrailer = [Block] -> Get [Block]
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
          | Word8
    v Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    imageSeparator = (:) (Block -> [Block] -> [Block])
    -> Get Block -> Get ([Block] -> [Block])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (GifImage -> Block
    BlockImage (GifImage -> Block) -> Get GifImage -> Get Block
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get GifImage
    forall t. Binary t => Get t
    get) Get ([Block] -> [Block]) -> Get [Block] -> Get [Block]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [Block]
    parseGifBlocks
          | Word8
    v Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    extensionIntroducer = Get Word8
    getWord8 Get Word8 -> (Word8 -> Get [Block]) -> Get [Block]
    forall a b. Get a -> (a -> Get b) -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Word8 -> Get [Block]
    extensionParse

        blockParse Word8
    v = do
          Int64
    readPosition <- Get Int64
    bytesRead
          String -> Get [Block]
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "Unrecognized gif block " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> String
    forall a. Show a => a -> String
    show Word8
    v String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " @" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int64 -> String
    forall a. Show a => a -> String
    show Int64
    readPosition)

        extensionParse :: Word8 -> Get [Block]
    extensionParse Word8
    code
         | Word8
    code Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    graphicControlLabel =
            (:) (Block -> [Block] -> [Block])
    -> Get Block -> Get ([Block] -> [Block])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (GraphicControlExtension -> Block
    BlockGraphicControl (GraphicControlExtension -> Block)
    -> Get GraphicControlExtension -> Get Block
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get GraphicControlExtension
    forall t. Binary t => Get t
    get) Get ([Block] -> [Block]) -> Get [Block] -> Get [Block]
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [Block]
    parseGifBlocks
         | Word8
    code Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    commentLabel = Get ()
    skipSubDataBlocks Get () -> Get [Block] -> Get [Block]
    forall a b. Get a -> Get b -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Get [Block]
    parseGifBlocks
         | Word8
    code Word8 -> [Word8] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Word8
    plainTextLabel, Word8
    applicationLabel] =
            Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word8
    getWord8 Get Int -> (Int -> Get ()) -> Get ()
    forall a b. Get a -> (a -> Get b) -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> Get ()
    skip Get () -> Get () -> Get ()
    forall a b. Get a -> Get b -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Get ()
    skipSubDataBlocks Get () -> Get [Block] -> Get [Block]
    forall a b. Get a -> Get b -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Get [Block]
    parseGifBlocks
         | Bool
    otherwise = Get ByteString
    parseDataBlocks Get ByteString -> Get [Block] -> Get [Block]
    forall a b. Get a -> Get b -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Get [Block]
    parseGifBlocks

    instance Binary ImageDescriptor where
        put :: ImageDescriptor -> Put
    put ImageDescriptor
    v = do
            Word8 -> Put
    putWord8 Word8
    imageSeparator
            Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescPixelsFromLeft ImageDescriptor
    v
            Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescPixelsFromTop ImageDescriptor
    v
            Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescImageWidth ImageDescriptor
    v
            Word16 -> Put
    putWord16le (Word16 -> Put) -> Word16 -> Put
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescImageHeight ImageDescriptor
    v
            let localMapField :: Word8
    localMapField
                    | ImageDescriptor -> Bool
    gDescHasLocalMap ImageDescriptor
    v = Word8
    0 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    7
                    | Bool
    otherwise = Word8
    0

                isInterlacedField :: Word8
    isInterlacedField
                    | ImageDescriptor -> Bool
    gDescIsInterlaced ImageDescriptor
    v = Word8
    0 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    6
                    | Bool
    otherwise = Word8
    0

                isImageDescriptorSorted :: Word8
    isImageDescriptorSorted
                    | ImageDescriptor -> Bool
    gDescIsImgDescriptorSorted ImageDescriptor
    v = Word8
    0 Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    `setBit` Int
    5
                    | Bool
    otherwise = Word8
    0

                localSize :: Word8
    localSize = ImageDescriptor -> Word8
    gDescLocalColorTableSize ImageDescriptor
    v
                tableSizeField :: Word8
    tableSizeField
                    | Word8
    localSize Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word8
    0 = (Word8
    localSize Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    1) Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x7
                    | Bool
    otherwise = Word8
    0

                packedFields :: Word8
    packedFields = Word8
    localMapField
                            Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    isInterlacedField
                            Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    isImageDescriptorSorted
                            Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .|. Word8
    tableSizeField
            Word8 -> Put
    putWord8 Word8
    packedFields

        get :: Get ImageDescriptor
    get = do
            -- due to missing lookahead

            {-_imageSeparator <- getWord8-}
            Word16
    imgLeftPos <- Get Word16
    getWord16le
            Word16
    imgTopPos  <- Get Word16
    getWord16le
            Word16
    imgWidth   <- Get Word16
    getWord16le
            Word16
    imgHeight  <- Get Word16
    getWord16le
            Word8
    packedFields <- Get Word8
    getWord8
            ImageDescriptor -> Get ImageDescriptor
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ImageDescriptor
                { gDescPixelsFromLeft :: Word16
    gDescPixelsFromLeft = Word16
    imgLeftPos
                , gDescPixelsFromTop :: Word16
    gDescPixelsFromTop  = Word16
    imgTopPos
                , gDescImageWidth :: Word16
    gDescImageWidth     = Word16
    imgWidth
                , gDescImageHeight :: Word16
    gDescImageHeight    = Word16
    imgHeight
                , gDescHasLocalMap :: Bool
    gDescHasLocalMap    = Word8
    packedFields Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    7
                , gDescIsInterlaced :: Bool
    gDescIsInterlaced     = Word8
    packedFields Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    6
                , gDescIsImgDescriptorSorted :: Bool
    gDescIsImgDescriptorSorted = Word8
    packedFields Word8 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    5
                , gDescLocalColorTableSize :: Word8
    gDescLocalColorTableSize = (Word8
    packedFields Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x7) Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    1
                }

    --------------------------------------------------

    ----            Palette

    --------------------------------------------------

    getPalette :: Word8 -> Get Palette
    getPalette :: Word8 -> Get Palette
    getPalette Word8
    bitDepth =
        Int -> Int -> Vector (PixelBaseComponent PixelRGB8) -> Palette
    forall a. Int -> Int -> Vector (PixelBaseComponent a) -> Image a
    Image Int
    size Int
    1 (Vector Word8 -> Palette)
    -> ([Word8] -> Vector Word8) -> [Word8] -> Palette
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> Vector Word8
    forall a. Storable a => [a] -> Vector a
    V.fromList ([Word8] -> Palette) -> Get [Word8] -> Get Palette
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Get Word8 -> Get [Word8]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM (Int
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3) Get Word8
    forall t. Binary t => Get t
    get
      where size :: Int
    size = Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    bitDepth :: Int)

    putPalette :: Int -> Palette -> Put
    putPalette :: Int -> Palette -> Put
    putPalette Int
    size Palette
    pal = do
        (Word8 -> Put) -> Vector Word8 -> Put
    forall (m :: * -> *) a b.
    (Monad m, Storable a) =>
    (a -> m b) -> Vector a -> m ()
    V.mapM_ Word8 -> Put
    putWord8 (Palette -> Vector (PixelBaseComponent PixelRGB8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData Palette
    pal)
        Int -> Put -> Put
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
    replicateM_ Int
    missingColorComponent (Word8 -> Put
    putWord8 Word8
    0)
      where elemCount :: Int
    elemCount = Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int
    size
            missingColorComponent :: Int
    missingColorComponent = (Int
    elemCount Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Palette -> Int
    forall a. Image a -> Int
    imageWidth Palette
    pal) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    3

    --------------------------------------------------

    ----            GifImage

    --------------------------------------------------

    data GifHeader = GifHeader
      { GifHeader -> GifVersion
    gifVersion          :: GifVersion
      , GifHeader -> LogicalScreenDescriptor
    gifScreenDescriptor :: LogicalScreenDescriptor
      , GifHeader -> Maybe Palette
    gifGlobalMap        :: Maybe Palette
      }

    instance Binary GifHeader where
        put :: GifHeader -> Put
    put GifHeader
    v = do
          GifVersion -> Put
    forall t. Binary t => t -> Put
    put (GifVersion -> Put) -> GifVersion -> Put
    forall a b. (a -> b) -> a -> b
    $ GifHeader -> GifVersion
    gifVersion GifHeader
    v
          let descr :: LogicalScreenDescriptor
    descr = GifHeader -> LogicalScreenDescriptor
    gifScreenDescriptor GifHeader
    v
          LogicalScreenDescriptor -> Put
    forall t. Binary t => t -> Put
    put LogicalScreenDescriptor
    descr
          case GifHeader -> Maybe Palette
    gifGlobalMap GifHeader
    v of
            Just Palette
    palette -> Int -> Palette -> Put
    putPalette (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ LogicalScreenDescriptor -> Word8
    colorTableSize LogicalScreenDescriptor
    descr) Palette
    palette
            Maybe Palette
    Nothing      -> () -> Put
    forall a. a -> PutM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        get :: Get GifHeader
    get = do
            GifVersion
    version    <- Get GifVersion
    forall t. Binary t => Get t
    get
            LogicalScreenDescriptor
    screenDesc <- Get LogicalScreenDescriptor
    forall t. Binary t => Get t
    get

            Maybe Palette
    palette <-
              if LogicalScreenDescriptor -> Bool
    hasGlobalMap LogicalScreenDescriptor
    screenDesc then
                Palette -> Maybe Palette
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Palette -> Maybe Palette) -> Get Palette -> Get (Maybe Palette)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Word8 -> Get Palette
    getPalette (LogicalScreenDescriptor -> Word8
    colorTableSize LogicalScreenDescriptor
    screenDesc)
              else
                Maybe Palette -> Get (Maybe Palette)
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Palette
    forall a. Maybe a
    Nothing

            GifHeader -> Get GifHeader
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return GifHeader
                { gifVersion :: GifVersion
    gifVersion = GifVersion
    version
                , gifScreenDescriptor :: LogicalScreenDescriptor
    gifScreenDescriptor = LogicalScreenDescriptor
    screenDesc
                , gifGlobalMap :: Maybe Palette
    gifGlobalMap = Maybe Palette
    palette
                }

    data GifFile = GifFile
        { GifFile -> GifHeader
    gifHeader      :: !GifHeader
        , GifFile -> [(Maybe GraphicControlExtension, GifImage)]
    gifImages      :: [(Maybe GraphicControlExtension, GifImage)]
        , GifFile -> GifLooping
    gifLoopingBehaviour :: GifLooping
        }

    putLooping :: GifLooping -> Put
    putLooping :: GifLooping -> Put
    putLooping GifLooping
    LoopingNever = () -> Put
    forall a. a -> PutM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    putLooping GifLooping
    LoopingForever = GifLooping -> Put
    putLooping (GifLooping -> Put) -> GifLooping -> Put
    forall a b. (a -> b) -> a -> b
    $ Word16 -> GifLooping
    LoopingRepeat Word16
    0
    putLooping (LoopingRepeat Word16
    count) = do
        Word8 -> Put
    putWord8 Word8
    extensionIntroducer
        Word8 -> Put
    putWord8 Word8
    applicationLabel
        Word8 -> Put
    putWord8 Word8
    11 -- the size

        ByteString -> Put
    putByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    BC.pack String
    "NETSCAPE2.0"
        Word8 -> Put
    putWord8 Word8
    3 -- size of sub block

        Word8 -> Put
    putWord8 Word8
    1
        Word16 -> Put
    putWord16le Word16
    count
        Word8 -> Put
    putWord8 Word8
    0

    associateDescr :: [Block] -> [(Maybe GraphicControlExtension, GifImage)]
    associateDescr :: [Block] -> [(Maybe GraphicControlExtension, GifImage)]
    associateDescr [] = []
    associateDescr [BlockGraphicControl GraphicControlExtension
    _] = []
    associateDescr (BlockGraphicControl GraphicControlExtension
    _ : rest :: [Block]
    rest@(BlockGraphicControl GraphicControlExtension
    _ : [Block]
    _)) =
        [Block] -> [(Maybe GraphicControlExtension, GifImage)]
    associateDescr [Block]
    rest
    associateDescr (BlockImage GifImage
    img:[Block]
    xs) = (Maybe GraphicControlExtension
    forall a. Maybe a
    Nothing, GifImage
    img) (Maybe GraphicControlExtension, GifImage)
    -> [(Maybe GraphicControlExtension, GifImage)]
    -> [(Maybe GraphicControlExtension, GifImage)]
    forall a. a -> [a] -> [a]
    : [Block] -> [(Maybe GraphicControlExtension, GifImage)]
    associateDescr [Block]
    xs
    associateDescr (BlockGraphicControl GraphicControlExtension
    ctrl : BlockImage GifImage
    img : [Block]
    xs) =
        (GraphicControlExtension -> Maybe GraphicControlExtension
    forall a. a -> Maybe a
    Just GraphicControlExtension
    ctrl, GifImage
    img) (Maybe GraphicControlExtension, GifImage)
    -> [(Maybe GraphicControlExtension, GifImage)]
    -> [(Maybe GraphicControlExtension, GifImage)]
    forall a. a -> [a] -> [a]
    : [Block] -> [(Maybe GraphicControlExtension, GifImage)]
    associateDescr [Block]
    xs

    instance Binary GifFile where
        put :: GifFile -> Put
    put GifFile
    v = do
            GifHeader -> Put
    forall t. Binary t => t -> Put
    put (GifHeader -> Put) -> GifHeader -> Put
    forall a b. (a -> b) -> a -> b
    $ GifFile -> GifHeader
    gifHeader GifFile
    v
            let putter :: (Maybe t, t) -> Put
    putter (Maybe t
    Nothing, t
    i) = t -> Put
    forall t. Binary t => t -> Put
    put t
    i
                putter (Just t
    a, t
    i) = t -> Put
    forall t. Binary t => t -> Put
    put t
    a Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> t -> Put
    forall t. Binary t => t -> Put
    put t
    i
            GifLooping -> Put
    putLooping (GifLooping -> Put) -> GifLooping -> Put
    forall a b. (a -> b) -> a -> b
    $ GifFile -> GifLooping
    gifLoopingBehaviour GifFile
    v
            ((Maybe GraphicControlExtension, GifImage) -> Put)
    -> [(Maybe GraphicControlExtension, GifImage)] -> Put
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Maybe GraphicControlExtension, GifImage) -> Put
    forall {t} {t}. (Binary t, Binary t) => (Maybe t, t) -> Put
    putter ([(Maybe GraphicControlExtension, GifImage)] -> Put)
    -> [(Maybe GraphicControlExtension, GifImage)] -> Put
    forall a b. (a -> b) -> a -> b
    $ GifFile -> [(Maybe GraphicControlExtension, GifImage)]
    gifImages GifFile
    v
            Word8 -> Put
    forall t. Binary t => t -> Put
    put Word8
    gifTrailer

        get :: Get GifFile
    get = do
            GifHeader
    hdr <- Get GifHeader
    forall t. Binary t => Get t
    get
            [Block]
    blocks <- Get [Block]
    parseGifBlocks
            GifFile -> Get GifFile
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return GifFile { gifHeader :: GifHeader
    gifHeader = GifHeader
    hdr
                           , gifImages :: [(Maybe GraphicControlExtension, GifImage)]
    gifImages = [Block] -> [(Maybe GraphicControlExtension, GifImage)]
    associateDescr [Block]
    blocks
                           , gifLoopingBehaviour :: GifLooping
    gifLoopingBehaviour = GifLooping
    LoopingNever
                           }

    substituteColors :: Palette -> Image Pixel8 -> Image PixelRGB8
    substituteColors :: Palette -> Image Word8 -> Palette
    substituteColors Palette
    palette = (Word8 -> PixelRGB8) -> Image Word8 -> Palette
    forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
    pixelMap Word8 -> PixelRGB8
    swaper
      where swaper :: Word8 -> PixelRGB8
    swaper Word8
    n = Palette -> Int -> Int -> PixelRGB8
    forall a. Pixel a => Image a -> Int -> Int -> a
    pixelAt Palette
    palette (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    n) Int
    0

    substituteColorsWithTransparency :: Int -> Image PixelRGBA8 -> Image Pixel8 -> Image PixelRGBA8
    substituteColorsWithTransparency :: Int -> Image PixelRGBA8 -> Image Word8 -> Image PixelRGBA8
    substituteColorsWithTransparency Int
    transparent Image PixelRGBA8
    palette = (Word8 -> PixelRGBA8) -> Image Word8 -> Image PixelRGBA8
    forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
    pixelMap Word8 -> PixelRGBA8
    swaper where
      swaper :: Word8 -> PixelRGBA8
    swaper Word8
    n | Int
    ix Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    transparent = Word8 -> Word8 -> Word8 -> Word8 -> PixelRGBA8
    PixelRGBA8 Word8
    0 Word8
    0 Word8
    0 Word8
    0
               | Bool
    otherwise = PixelRGBA8 -> PixelRGBA8
    forall a b. ColorConvertible a b => a -> b
    promotePixel (PixelRGBA8 -> PixelRGBA8) -> PixelRGBA8 -> PixelRGBA8
    forall a b. (a -> b) -> a -> b
    $ Image PixelRGBA8 -> Int -> Int -> PixelRGBA8
    forall a. Pixel a => Image a -> Int -> Int -> a
    pixelAt Image PixelRGBA8
    palette Int
    ix Int
    0
        where ix :: Int
    ix = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    n

    decodeImage :: GifImage -> Image Pixel8
    decodeImage :: GifImage -> Image Word8
    decodeImage GifImage
    img = (forall s. ST s (Image Word8)) -> Image Word8
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Image Word8)) -> Image Word8)
    -> (forall s. ST s (Image Word8)) -> Image Word8
    forall a b. (a -> b) -> a -> b
    $ BoolReader s (Image Word8) -> ST s (Image Word8)
    forall s a. BoolReader s a -> ST s a
    runBoolReader (BoolReader s (Image Word8) -> ST s (Image Word8))
    -> BoolReader s (Image Word8) -> ST s (Image Word8)
    forall a b. (a -> b) -> a -> b
    $ do
        STVector s Word8
    outputVector <- ST s (STVector s Word8)
    -> StateT BoolState (ST s) (STVector s Word8)
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s (STVector s Word8)
     -> StateT BoolState (ST s) (STVector s Word8))
    -> (Int -> ST s (STVector s Word8))
    -> Int
    -> StateT BoolState (ST s) (STVector s Word8)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ST s (STVector 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 -> StateT BoolState (ST s) (STVector s Word8))
    -> Int -> StateT BoolState (ST s) (STVector s Word8)
    forall a b. (a -> b) -> a -> b
    $ Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    height
        ByteString -> Int -> Int -> STVector s Word8 -> BoolReader s ()
    forall s.
    ByteString -> Int -> Int -> STVector s Word8 -> BoolReader s ()
    decodeLzw (GifImage -> ByteString
    imgData GifImage
    img) Int
    12 Int
    lzwRoot STVector s Word8
    outputVector
        Vector Word8
    frozenData <- ST s (Vector Word8) -> StateT BoolState (ST s) (Vector Word8)
    forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s (Vector Word8) -> StateT BoolState (ST s) (Vector Word8))
    -> ST s (Vector Word8) -> StateT BoolState (ST s) (Vector Word8)
    forall a b. (a -> b) -> a -> b
    $ MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
    forall a (m :: * -> *).
    (Storable a, PrimMonad m) =>
    MVector (PrimState m) a -> m (Vector a)
    V.unsafeFreeze STVector s Word8
    MVector (PrimState (ST s)) Word8
    outputVector
        Image Word8 -> BoolReader s (Image Word8)
    forall a. a -> StateT BoolState (ST s) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Image Word8 -> BoolReader s (Image Word8))
    -> (Image Word8 -> Image Word8)
    -> Image Word8
    -> BoolReader s (Image Word8)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image Word8 -> Image Word8
    deinterlaceGif (Image Word8 -> BoolReader s (Image Word8))
    -> Image Word8 -> BoolReader s (Image Word8)
    forall a b. (a -> b) -> a -> b
    $ Image
          { imageWidth :: Int
    imageWidth = Int
    width
          , imageHeight :: Int
    imageHeight = Int
    height
          , imageData :: Vector (PixelBaseComponent Word8)
    imageData = Vector Word8
    Vector (PixelBaseComponent Word8)
    frozenData
          }
      where lzwRoot :: Int
    lzwRoot = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ GifImage -> Word8
    imgLzwRootSize GifImage
    img
            width :: Int
    width = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescImageWidth ImageDescriptor
    descriptor
            height :: Int
    height = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescImageHeight ImageDescriptor
    descriptor
            isInterlaced :: Bool
    isInterlaced = ImageDescriptor -> Bool
    gDescIsInterlaced ImageDescriptor
    descriptor
            descriptor :: ImageDescriptor
    descriptor = GifImage -> ImageDescriptor
    imgDescriptor GifImage
    img

            deinterlaceGif :: Image Word8 -> Image Word8
    deinterlaceGif | Bool -> Bool
    not Bool
    isInterlaced = Image Word8 -> Image Word8
    forall a. a -> a
    id
                           | Bool
    otherwise = Image Word8 -> Image Word8
    deinterlaceGifImage

    deinterlaceGifImage :: Image Pixel8 -> Image Pixel8
    deinterlaceGifImage :: Image Word8 -> Image Word8
    deinterlaceGifImage img :: Image Word8
    img@(Image { imageWidth :: forall a. Image a -> Int
    imageWidth = Int
    w, imageHeight :: forall a. Image a -> Int
    imageHeight = Int
    h }) = (Int -> Int -> Word8) -> Int -> Int -> Image Word8
    forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
    generateImage Int -> Int -> Word8
    generator Int
    w Int
    h
       where lineIndices :: Vector Int
    lineIndices = Int -> Vector Int
    gifInterlacingIndices Int
    h
             generator :: Int -> Int -> Word8
    generator Int
    x Int
    y = Image Word8 -> Int -> Int -> Word8
    forall a. Pixel a => Image a -> Int -> Int -> a
    pixelAt Image Word8
    img Int
    x Int
    y'
                where y' :: Int
    y' = Vector Int
    lineIndices Vector Int -> Int -> Int
    forall a. Storable a => Vector a -> Int -> a
    V.! Int
    y

    gifInterlacingIndices :: Int -> V.Vector Int
    gifInterlacingIndices :: Int -> Vector Int
    gifInterlacingIndices Int
    height = (Int -> Int -> Int) -> Vector Int -> [(Int, Int)] -> Vector Int
    forall a b.
    Storable a =>
    (a -> b -> a) -> Vector a -> [(Int, b)] -> Vector a
    V.accum (\Int
    _ Int
    v -> Int
    v) (Int -> Int -> Vector Int
    forall a. Storable a => Int -> a -> Vector a
    V.replicate Int
    height Int
    0) [(Int, Int)]
    indices
        where indices :: [(Int, Int)]
    indices = ([Int] -> [Int] -> [(Int, Int)]) -> [Int] -> [Int] -> [(Int, Int)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [Int] -> [Int] -> [(Int, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] ([Int] -> [(Int, Int)]) -> [Int] -> [(Int, Int)]
    forall a b. (a -> b) -> a -> b
    $
                    [[Int]] -> [Int]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [Int
    0,     Int
    8 .. Int
    height Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
                           , [Int
    4, Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    8 .. Int
    height Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
                           , [Int
    2, Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4 .. Int
    height Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
                           , [Int
    1, Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2 .. Int
    height Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1]
                           ]

    paletteOf :: (ColorConvertible PixelRGB8 px)
              => Image px -> GifImage -> Image px
    paletteOf :: forall px.
    ColorConvertible PixelRGB8 px =>
    Image px -> GifImage -> Image px
    paletteOf Image px
    global GifImage { imgLocalPalette :: GifImage -> Maybe Palette
    imgLocalPalette = Maybe Palette
    Nothing } = Image px
    global
    paletteOf      Image px
    _ GifImage { imgLocalPalette :: GifImage -> Maybe Palette
    imgLocalPalette = Just Palette
    p  } = Palette -> Image px
    forall a b. ColorConvertible a b => Image a -> Image b
    promoteImage Palette
    p

    getFrameDelays :: GifFile -> [GifDelay]
    getFrameDelays :: GifFile -> [Int]
    getFrameDelays GifFile { gifImages :: GifFile -> [(Maybe GraphicControlExtension, GifImage)]
    gifImages = [] } = []
    getFrameDelays GifFile { gifImages :: GifFile -> [(Maybe GraphicControlExtension, GifImage)]
    gifImages = [(Maybe GraphicControlExtension, GifImage)]
    imgs } = ((Maybe GraphicControlExtension, GifImage) -> Int)
    -> [(Maybe GraphicControlExtension, GifImage)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe GraphicControlExtension, GifImage) -> Int
    forall {a} {b}. Num a => (Maybe GraphicControlExtension, b) -> a
    extractDelay [(Maybe GraphicControlExtension, GifImage)]
    imgs
        where extractDelay :: (Maybe GraphicControlExtension, b) -> a
    extractDelay (Maybe GraphicControlExtension
    ext, b
    _) =
                case Maybe GraphicControlExtension
    ext of
                    Maybe GraphicControlExtension
    Nothing -> a
    0
                    Just GraphicControlExtension
    e -> Word16 -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> a) -> Word16 -> a
    forall a b. (a -> b) -> a -> b
    $ GraphicControlExtension -> Word16
    gceDelay GraphicControlExtension
    e

    transparentColorOf :: Maybe GraphicControlExtension -> Int
    transparentColorOf :: Maybe GraphicControlExtension -> Int
    transparentColorOf Maybe GraphicControlExtension
    Nothing = Int
    300
    transparentColorOf (Just GraphicControlExtension
    ext)
      | GraphicControlExtension -> Bool
    gceTransparentFlag GraphicControlExtension
    ext = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ GraphicControlExtension -> Word8
    gceTransparentColorIndex GraphicControlExtension
    ext
      | Bool
    otherwise = Int
    300

    hasTransparency :: Maybe GraphicControlExtension -> Bool
    hasTransparency :: Maybe GraphicControlExtension -> Bool
    hasTransparency Maybe GraphicControlExtension
    Nothing = Bool
    False
    hasTransparency (Just GraphicControlExtension
    control) = GraphicControlExtension -> Bool
    gceTransparentFlag GraphicControlExtension
    control

    decodeAllGifImages :: GifFile -> [PalettedImage]
    decodeAllGifImages :: GifFile -> [PalettedImage]
    decodeAllGifImages GifFile { gifImages :: GifFile -> [(Maybe GraphicControlExtension, GifImage)]
    gifImages = [] } = []
    decodeAllGifImages GifFile { gifHeader :: GifFile -> GifHeader
    gifHeader = GifHeader { gifGlobalMap :: GifHeader -> Maybe Palette
    gifGlobalMap = Maybe Palette
    palette
                                                       , gifScreenDescriptor :: GifHeader -> LogicalScreenDescriptor
    gifScreenDescriptor = LogicalScreenDescriptor
    wholeDescriptor }
                               , gifImages :: GifFile -> [(Maybe GraphicControlExtension, GifImage)]
    gifImages = (Maybe GraphicControlExtension
    firstControl, GifImage
    firstImage) : [(Maybe GraphicControlExtension, GifImage)]
    rest }
      | Bool -> Bool
    not (Maybe GraphicControlExtension -> Bool
    hasTransparency Maybe GraphicControlExtension
    firstControl) =
          let backImage :: Palette
    backImage =
                  (Int -> Int -> PixelRGB8) -> Int -> Int -> Palette
    forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
    generateImage (\Int
    _ Int
    _ -> PixelRGB8
    backgroundColor) Int
    globalWidth Int
    globalHeight
              thisPalette :: Palette
    thisPalette = Palette -> GifImage -> Palette
    forall px.
    ColorConvertible PixelRGB8 px =>
    Image px -> GifImage -> Image px
    paletteOf Palette
    globalPalette GifImage
    firstImage
              baseImage :: Image Word8
    baseImage = GifImage -> Image Word8
    decodeImage GifImage
    firstImage
              initState :: (Palette, Maybe GraphicControlExtension, Palette)
    initState =
                (Palette
    thisPalette, Maybe GraphicControlExtension
    firstControl, Palette -> Image Word8 -> Palette
    substituteColors Palette
    thisPalette Image Word8
    baseImage)
              scanner :: (Palette, Maybe GraphicControlExtension, Palette)
    -> (Maybe GraphicControlExtension, GifImage)
    -> (Palette, Maybe GraphicControlExtension, Palette)
    scanner = (Int, Int)
    -> Palette
    -> Palette
    -> (Palette, Maybe GraphicControlExtension, Palette)
    -> (Maybe GraphicControlExtension, GifImage)
    -> (Palette, Maybe GraphicControlExtension, Palette)
    forall px.
    ColorConvertible PixelRGB8 px =>
    (Int, Int)
    -> Image px
    -> Image px
    -> (Image px, Maybe GraphicControlExtension, Image px)
    -> (Maybe GraphicControlExtension, GifImage)
    -> (Image px, Maybe GraphicControlExtension, Image px)
    gifAnimationApplyer (Int
    globalWidth, Int
    globalHeight) Palette
    thisPalette Palette
    backImage
              palette' :: Palette' PixelRGB8
    palette' = Palette'
                { _paletteSize :: Int
    _paletteSize = Palette -> Int
    forall a. Image a -> Int
    imageWidth Palette
    thisPalette
                , _paletteData :: Vector (PixelBaseComponent PixelRGB8)
    _paletteData = Palette -> Vector (PixelBaseComponent PixelRGB8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData Palette
    thisPalette
                }
          in
          Image Word8 -> Palette' PixelRGB8 -> PalettedImage
    PalettedRGB8 Image Word8
    baseImage Palette' PixelRGB8
    palette' PalettedImage -> [PalettedImage] -> [PalettedImage]
    forall a. a -> [a] -> [a]
    :
            [DynamicImage -> PalettedImage
    TrueColorImage (DynamicImage -> PalettedImage) -> DynamicImage -> PalettedImage
    forall a b. (a -> b) -> a -> b
    $ Palette -> DynamicImage
    ImageRGB8 Palette
    img | (Palette
    _, Maybe GraphicControlExtension
    _, Palette
    img) <- [(Palette, Maybe GraphicControlExtension, Palette)]
    -> [(Palette, Maybe GraphicControlExtension, Palette)]
    forall a. HasCallStack => [a] -> [a]
    tail ([(Palette, Maybe GraphicControlExtension, Palette)]
     -> [(Palette, Maybe GraphicControlExtension, Palette)])
    -> [(Palette, Maybe GraphicControlExtension, Palette)]
    -> [(Palette, Maybe GraphicControlExtension, Palette)]
    forall a b. (a -> b) -> a -> b
    $ ((Palette, Maybe GraphicControlExtension, Palette)
     -> (Maybe GraphicControlExtension, GifImage)
     -> (Palette, Maybe GraphicControlExtension, Palette))
    -> (Palette, Maybe GraphicControlExtension, Palette)
    -> [(Maybe GraphicControlExtension, GifImage)]
    -> [(Palette, Maybe GraphicControlExtension, Palette)]
    forall b a. (b -> a -> b) -> b -> [a] -> [b]
    scanl (Palette, Maybe GraphicControlExtension, Palette)
    -> (Maybe GraphicControlExtension, GifImage)
    -> (Palette, Maybe GraphicControlExtension, Palette)
    scanner (Palette, Maybe GraphicControlExtension, Palette)
    initState [(Maybe GraphicControlExtension, GifImage)]
    rest]

      | Bool
    otherwise =
          let backImage :: Image PixelRGBA8
              backImage :: Image PixelRGBA8
    backImage =
                (Int -> Int -> PixelRGBA8) -> Int -> Int -> Image PixelRGBA8
    forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
    generateImage (\Int
    _ Int
    _ -> PixelRGBA8
    transparentBackground) Int
    globalWidth Int
    globalHeight

              thisPalette :: Image PixelRGBA8
              thisPalette :: Image PixelRGBA8
    thisPalette = Image PixelRGBA8 -> GifImage -> Image PixelRGBA8
    forall px.
    ColorConvertible PixelRGB8 px =>
    Image px -> GifImage -> Image px
    paletteOf (Palette -> Image PixelRGBA8
    forall a b. ColorConvertible a b => Image a -> Image b
    promoteImage Palette
    globalPalette) GifImage
    firstImage

              transparentCode :: Int
    transparentCode = Maybe GraphicControlExtension -> Int
    transparentColorOf Maybe GraphicControlExtension
    firstControl
              decoded :: Image PixelRGBA8
    decoded =
                Int -> Image PixelRGBA8 -> Image Word8 -> Image PixelRGBA8
    substituteColorsWithTransparency Int
    transparentCode Image PixelRGBA8
    thisPalette (Image Word8 -> Image PixelRGBA8)
    -> Image Word8 -> Image PixelRGBA8
    forall a b. (a -> b) -> a -> b
    $
                    GifImage -> Image Word8
    decodeImage GifImage
    firstImage

              initState :: (Image PixelRGBA8, Maybe GraphicControlExtension, Image PixelRGBA8)
    initState = (Image PixelRGBA8
    thisPalette, Maybe GraphicControlExtension
    firstControl, Image PixelRGBA8
    decoded)
              scanner :: (Image PixelRGBA8, Maybe GraphicControlExtension, Image PixelRGBA8)
    -> (Maybe GraphicControlExtension, GifImage)
    -> (Image PixelRGBA8, Maybe GraphicControlExtension,
        Image PixelRGBA8)
    scanner =
                (Int, Int)
    -> Image PixelRGBA8
    -> Image PixelRGBA8
    -> (Image PixelRGBA8, Maybe GraphicControlExtension,
        Image PixelRGBA8)
    -> (Maybe GraphicControlExtension, GifImage)
    -> (Image PixelRGBA8, Maybe GraphicControlExtension,
        Image PixelRGBA8)
    forall px.
    ColorConvertible PixelRGB8 px =>
    (Int, Int)
    -> Image px
    -> Image px
    -> (Image px, Maybe GraphicControlExtension, Image px)
    -> (Maybe GraphicControlExtension, GifImage)
    -> (Image px, Maybe GraphicControlExtension, Image px)
    gifAnimationApplyer (Int
    globalWidth, Int
    globalHeight) Image PixelRGBA8
    thisPalette Image PixelRGBA8
    backImage in
          [DynamicImage -> PalettedImage
    TrueColorImage (DynamicImage -> PalettedImage) -> DynamicImage -> PalettedImage
    forall a b. (a -> b) -> a -> b
    $ Image PixelRGBA8 -> DynamicImage
    ImageRGBA8 Image PixelRGBA8
    img | (Image PixelRGBA8
    _, Maybe GraphicControlExtension
    _, Image PixelRGBA8
    img) <- ((Image PixelRGBA8, Maybe GraphicControlExtension,
      Image PixelRGBA8)
     -> (Maybe GraphicControlExtension, GifImage)
     -> (Image PixelRGBA8, Maybe GraphicControlExtension,
         Image PixelRGBA8))
    -> (Image PixelRGBA8, Maybe GraphicControlExtension,
        Image PixelRGBA8)
    -> [(Maybe GraphicControlExtension, GifImage)]
    -> [(Image PixelRGBA8, Maybe GraphicControlExtension,
         Image PixelRGBA8)]
    forall b a. (b -> a -> b) -> b -> [a] -> [b]
    scanl (Image PixelRGBA8, Maybe GraphicControlExtension, Image PixelRGBA8)
    -> (Maybe GraphicControlExtension, GifImage)
    -> (Image PixelRGBA8, Maybe GraphicControlExtension,
        Image PixelRGBA8)
    scanner (Image PixelRGBA8, Maybe GraphicControlExtension, Image PixelRGBA8)
    initState [(Maybe GraphicControlExtension, GifImage)]
    rest]

        where
          globalWidth :: Int
    globalWidth = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ LogicalScreenDescriptor -> Word16
    screenWidth LogicalScreenDescriptor
    wholeDescriptor
          globalHeight :: Int
    globalHeight = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ LogicalScreenDescriptor -> Word16
    screenHeight LogicalScreenDescriptor
    wholeDescriptor
          globalPalette :: Palette
    globalPalette = Palette -> (Palette -> Palette) -> Maybe Palette -> Palette
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Palette
    greyPalette Palette -> Palette
    forall a. a -> a
    id Maybe Palette
    palette

          transparentBackground :: PixelRGBA8
    transparentBackground = Word8 -> Word8 -> Word8 -> Word8 -> PixelRGBA8
    PixelRGBA8 Word8
    r Word8
    g Word8
    b Word8
    0
              where PixelRGB8 Word8
    r Word8
    g Word8
    b = PixelRGB8
    backgroundColor

          backgroundColor :: PixelRGB8
    backgroundColor
            | LogicalScreenDescriptor -> Bool
    hasGlobalMap LogicalScreenDescriptor
    wholeDescriptor =
                Palette -> Int -> Int -> PixelRGB8
    forall a. Pixel a => Image a -> Int -> Int -> a
    pixelAt Palette
    globalPalette (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ LogicalScreenDescriptor -> Word8
    backgroundIndex LogicalScreenDescriptor
    wholeDescriptor) Int
    0
            | Bool
    otherwise = Word8 -> Word8 -> Word8 -> PixelRGB8
    PixelRGB8 Word8
    0 Word8
    0 Word8
    0

    gifAnimationApplyer :: forall px.  (ColorConvertible PixelRGB8 px)
                        => (Int, Int) -> Image px -> Image px
                        -> (Image px, Maybe GraphicControlExtension, Image px)
                        -> (Maybe GraphicControlExtension, GifImage)
                        -> (Image px, Maybe GraphicControlExtension, Image px)
    gifAnimationApplyer :: forall px.
    ColorConvertible PixelRGB8 px =>
    (Int, Int)
    -> Image px
    -> Image px
    -> (Image px, Maybe GraphicControlExtension, Image px)
    -> (Maybe GraphicControlExtension, GifImage)
    -> (Image px, Maybe GraphicControlExtension, Image px)
    gifAnimationApplyer (Int
    globalWidth, Int
    globalHeight) Image px
    globalPalette Image px
    backgroundImage
              (Image px
    _, Maybe GraphicControlExtension
    prevControl, Image px
    img1)
              (Maybe GraphicControlExtension
    controlExt, img2 :: GifImage
    img2@(GifImage { imgDescriptor :: GifImage -> ImageDescriptor
    imgDescriptor = ImageDescriptor
    descriptor })) =
                (Image px
    thisPalette, Maybe GraphicControlExtension
    controlExt, Image px
    thisImage)
      where
        thisPalette :: Image px
        thisPalette :: Image px
    thisPalette = Image px -> GifImage -> Image px
    forall px.
    ColorConvertible PixelRGB8 px =>
    Image px -> GifImage -> Image px
    paletteOf Image px
    globalPalette GifImage
    img2

        thisImage :: Image px
    thisImage = (Int -> Int -> px) -> Int -> Int -> Image px
    forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
    generateImage Int -> Int -> px
    pixeler Int
    globalWidth Int
    globalHeight
        localWidth :: Int
    localWidth = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescImageWidth ImageDescriptor
    descriptor
        localHeight :: Int
    localHeight = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescImageHeight ImageDescriptor
    descriptor

        left :: Int
    left = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescPixelsFromLeft ImageDescriptor
    descriptor
        top :: Int
    top = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> Word16 -> Int
    forall a b. (a -> b) -> a -> b
    $ ImageDescriptor -> Word16
    gDescPixelsFromTop ImageDescriptor
    descriptor

        isPixelInLocalImage :: Int -> Int -> Bool
    isPixelInLocalImage Int
    x Int
    y =
            Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    left Bool -> Bool -> Bool
    && Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    left Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    localWidth Bool -> Bool -> Bool
    && Int
    y Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    top Bool -> Bool -> Bool
    && Int
    y Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    top Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    localHeight

        decoded :: Image Pixel8
        decoded :: Image Word8
    decoded = GifImage -> Image Word8
    decodeImage GifImage
    img2

        transparent :: Int
        transparent :: Int
    transparent = case Maybe GraphicControlExtension
    controlExt of
            Maybe GraphicControlExtension
    Nothing  -> Int
    300
            Just GraphicControlExtension
    ext -> if GraphicControlExtension -> Bool
    gceTransparentFlag GraphicControlExtension
    ext
                then Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ GraphicControlExtension -> Word8
    gceTransparentColorIndex GraphicControlExtension
    ext
                else Int
    300

        oldImage :: Image px
    oldImage = case GraphicControlExtension -> GifDisposalMethod
    gceDisposalMethod (GraphicControlExtension -> GifDisposalMethod)
    -> Maybe GraphicControlExtension -> Maybe GifDisposalMethod
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe GraphicControlExtension
    prevControl of
            Maybe GifDisposalMethod
    Nothing -> Image px
    img1
            Just GifDisposalMethod
    DisposalAny -> Image px
    img1
            Just GifDisposalMethod
    DisposalDoNot -> Image px
    img1
            Just GifDisposalMethod
    DisposalRestoreBackground -> Image px
    backgroundImage
            Just GifDisposalMethod
    DisposalRestorePrevious -> Image px
    img1
            Just (DisposalUnknown Word8
    _) -> Image px
    img1

        pixeler :: Int -> Int -> px
    pixeler Int
    x Int
    y
          | Int -> Int -> Bool
    isPixelInLocalImage Int
    x Int
    y Bool -> Bool -> Bool
    && Int
    code Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    transparent = px
    val where
              code :: Int
    code = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ Image Word8 -> Int -> Int -> Word8
    forall a. Pixel a => Image a -> Int -> Int -> a
    pixelAt Image Word8
    decoded (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    left) (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    top)
              val :: px
    val = Image px -> Int -> Int -> px
    forall a. Pixel a => Image a -> Int -> Int -> a
    pixelAt Image px
    thisPalette (Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    code) Int
    0
        pixeler Int
    x Int
    y = Image px -> Int -> Int -> px
    forall a. Pixel a => Image a -> Int -> Int -> a
    pixelAt Image px
    oldImage Int
    x Int
    y

    decodeFirstGifImage :: GifFile -> Either String (PalettedImage, Metadatas)
    decodeFirstGifImage :: GifFile -> Either String (PalettedImage, Metadatas)
    decodeFirstGifImage img :: GifFile
    img@GifFile { gifImages :: GifFile -> [(Maybe GraphicControlExtension, GifImage)]
    gifImages = ((Maybe GraphicControlExtension, GifImage)
    firstImage:[(Maybe GraphicControlExtension, GifImage)]
    _) } =
        case GifFile -> [PalettedImage]
    decodeAllGifImages GifFile
    img { gifImages = [firstImage] } of
          [] -> String -> Either String (PalettedImage, Metadatas)
    forall a b. a -> Either a b
    Left String
    "No image after decoding"
          (PalettedImage
    i:[PalettedImage]
    _) -> (PalettedImage, Metadatas)
    -> Either String (PalettedImage, Metadatas)
    forall a b. b -> Either a b
    Right (PalettedImage
    i, SourceFormat -> Word16 -> Word16 -> Metadatas
    forall nSize.
    Integral nSize =>
    SourceFormat -> nSize -> nSize -> Metadatas
    basicMetadata SourceFormat
    SourceGif (LogicalScreenDescriptor -> Word16
    screenWidth LogicalScreenDescriptor
    hdr) (LogicalScreenDescriptor -> Word16
    screenHeight LogicalScreenDescriptor
    hdr))
      where hdr :: LogicalScreenDescriptor
    hdr = GifHeader -> LogicalScreenDescriptor
    gifScreenDescriptor (GifHeader -> LogicalScreenDescriptor)
    -> GifHeader -> LogicalScreenDescriptor
    forall a b. (a -> b) -> a -> b
    $ GifFile -> GifHeader
    gifHeader GifFile
    img
    decodeFirstGifImage GifFile
    _ = String -> Either String (PalettedImage, Metadatas)
    forall a b. a -> Either a b
    Left String
    "No image in gif file"

    -- | Transform a raw gif image to an image, without modifying the pixels. This

    -- function can output the following images:

    --

    --  * 'ImageRGB8'

    --

    --  * 'ImageRGBA8'

    --

    decodeGif :: B.ByteString -> Either String DynamicImage
    decodeGif :: ByteString -> Either String DynamicImage
    decodeGif ByteString
    img = ByteString -> Either String GifFile
    forall a. Binary a => ByteString -> Either String a
    decode ByteString
    img Either String GifFile
    -> (GifFile -> Either String DynamicImage)
    -> Either String DynamicImage
    forall a b.
    Either String a -> (a -> Either String b) -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (((PalettedImage, Metadatas) -> DynamicImage)
    -> Either String (PalettedImage, 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 (PalettedImage -> DynamicImage
    palettedToTrueColor (PalettedImage -> DynamicImage)
    -> ((PalettedImage, Metadatas) -> PalettedImage)
    -> (PalettedImage, Metadatas)
    -> DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PalettedImage, Metadatas) -> PalettedImage
    forall a b. (a, b) -> a
    fst) (Either String (PalettedImage, Metadatas)
     -> Either String DynamicImage)
    -> (GifFile -> Either String (PalettedImage, Metadatas))
    -> GifFile
    -> Either String DynamicImage
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GifFile -> Either String (PalettedImage, Metadatas)
    decodeFirstGifImage)

    -- | Transform a raw gif image to an image, without modifying the pixels.  This

    -- function can output the following images:

    --

    --  * 'ImageRGB8'

    --

    --  * 'ImageRGBA8'

    --

    -- Metadatas include Width & Height information.

    --

    decodeGifWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
    decodeGifWithMetadata :: ByteString -> Either String (DynamicImage, Metadatas)
    decodeGifWithMetadata ByteString
    img = (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)
    decodeGifWithPaletteAndMetadata ByteString
    img

    -- | Return the gif image with metadata and palette.

    -- The palette is only returned for the first image of an

    -- animation and has no transparency.

    decodeGifWithPaletteAndMetadata :: B.ByteString -> Either String (PalettedImage, Metadatas)
    decodeGifWithPaletteAndMetadata :: ByteString -> Either String (PalettedImage, Metadatas)
    decodeGifWithPaletteAndMetadata ByteString
    img = ByteString -> Either String GifFile
    forall a. Binary a => ByteString -> Either String a
    decode ByteString
    img Either String GifFile
    -> (GifFile -> Either String (PalettedImage, Metadatas))
    -> Either String (PalettedImage, Metadatas)
    forall a b.
    Either String a -> (a -> Either String b) -> Either String b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= GifFile -> Either String (PalettedImage, Metadatas)
    decodeFirstGifImage

    -- | Transform a raw gif to a list of images, representing

    -- all the images of an animation.

    decodeGifImages :: B.ByteString -> Either String [DynamicImage]
    decodeGifImages :: ByteString -> Either String [DynamicImage]
    decodeGifImages ByteString
    img = (PalettedImage -> DynamicImage)
    -> [PalettedImage] -> [DynamicImage]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PalettedImage -> DynamicImage
    palettedToTrueColor ([PalettedImage] -> [DynamicImage])
    -> (GifFile -> [PalettedImage]) -> GifFile -> [DynamicImage]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GifFile -> [PalettedImage]
    decodeAllGifImages (GifFile -> [DynamicImage])
    -> Either String GifFile -> Either String [DynamicImage]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> Either String GifFile
    forall a. Binary a => ByteString -> Either String a
    decode ByteString
    img

    -- | Extract a list of frame delays from a raw gif.

    getDelaysGifImages :: B.ByteString -> Either String [GifDelay]
    getDelaysGifImages :: ByteString -> Either String [Int]
    getDelaysGifImages ByteString
    img = GifFile -> [Int]
    getFrameDelays (GifFile -> [Int]) -> Either String GifFile -> Either String [Int]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ByteString -> Either String GifFile
    forall a. Binary a => ByteString -> Either String a
    decode ByteString
    img

    -- | Default palette to produce greyscale images.

    greyPalette :: Palette
    greyPalette :: Palette
    greyPalette = (Int -> Int -> PixelRGB8) -> Int -> Int -> Palette
    forall px. Pixel px => (Int -> Int -> px) -> Int -> Int -> Image px
    generateImage Int -> Int -> PixelRGB8
    forall {a} {p}. Integral a => a -> p -> PixelRGB8
    toGrey Int
    256 Int
    1
      where toGrey :: a -> p -> PixelRGB8
    toGrey a
    x p
    _ = Word8 -> Word8 -> Word8 -> PixelRGB8
    PixelRGB8 Word8
    ix Word8
    ix Word8
    ix
               where ix :: Word8
    ix = a -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    x

    checkImageSizes :: GifEncode -> Either String ()
    checkImageSizes :: GifEncode -> Either String ()
    checkImageSizes GifEncode { geWidth :: GifEncode -> Int
    geWidth = Int
    width, geHeight :: GifEncode -> Int
    geHeight = Int
    height, geFrames :: GifEncode -> [GifFrame]
    geFrames = [GifFrame]
    frames }
      | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> Bool
    forall {a}. (Ord a, Num a) => a -> Bool
    isInBounds Int
    width Bool -> Bool -> Bool
    && Int -> Bool
    forall {a}. (Ord a, Num a) => a -> Bool
    isInBounds Int
    height = String -> Either String ()
    forall a b. a -> Either a b
    Left String
    "Invalid screen bounds"
      | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(GifFrame, Int)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(GifFrame, Int)]
    outOfBounds = String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ String
    "GIF frames with invalid bounds: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Int] -> String
    forall a. Show a => a -> String
    show (((GifFrame, Int) -> Int) -> [(GifFrame, Int)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (GifFrame, Int) -> Int
    forall a b. (a, b) -> b
    snd [(GifFrame, Int)]
    outOfBounds)
      | Bool
    otherwise = () -> Either String ()
    forall a b. b -> Either a b
    Right ()
      where isInBounds :: a -> Bool
    isInBounds a
    dim = a
    dim a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    0 Bool -> Bool -> Bool
    && a
    dim a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    0xffff
            outOfBounds :: [(GifFrame, Int)]
    outOfBounds = ((GifFrame, Int) -> Bool) -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((GifFrame, Int) -> Bool) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GifFrame -> Bool
    isFrameInBounds (GifFrame -> Bool)
    -> ((GifFrame, Int) -> GifFrame) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GifFrame, Int) -> GifFrame
    forall a b. (a, b) -> a
    fst) ([(GifFrame, Int)] -> [(GifFrame, Int)])
    -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a b. (a -> b) -> a -> b
    $ [GifFrame] -> [Int] -> [(GifFrame, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [GifFrame]
    frames [Int
    0 :: Int ..]
            isFrameInBounds :: GifFrame -> Bool
    isFrameInBounds GifFrame { gfPixels :: GifFrame -> Image Word8
    gfPixels = Image Word8
    img } = Int -> Bool
    forall {a}. (Ord a, Num a) => a -> Bool
    isInBounds (Image Word8 -> Int
    forall a. Image a -> Int
    imageWidth Image Word8
    img) Bool -> Bool -> Bool
    && Int -> Bool
    forall {a}. (Ord a, Num a) => a -> Bool
    isInBounds (Image Word8 -> Int
    forall a. Image a -> Int
    imageHeight Image Word8
    img)

    checkImagesInBounds :: GifEncode -> Either String ()
    checkImagesInBounds :: GifEncode -> Either String ()
    checkImagesInBounds GifEncode { geWidth :: GifEncode -> Int
    geWidth = Int
    width, geHeight :: GifEncode -> Int
    geHeight = Int
    height, geFrames :: GifEncode -> [GifFrame]
    geFrames = [GifFrame]
    frames } =
      if [(GifFrame, Int)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(GifFrame, Int)]
    outOfBounds
      then () -> Either String ()
    forall a b. b -> Either a b
    Right ()
      else String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ String
    "GIF frames out of screen bounds: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Int] -> String
    forall a. Show a => a -> String
    show (((GifFrame, Int) -> Int) -> [(GifFrame, Int)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (GifFrame, Int) -> Int
    forall a b. (a, b) -> b
    snd [(GifFrame, Int)]
    outOfBounds)
      where outOfBounds :: [(GifFrame, Int)]
    outOfBounds = ((GifFrame, Int) -> Bool) -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((GifFrame, Int) -> Bool) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GifFrame -> Bool
    isInBounds (GifFrame -> Bool)
    -> ((GifFrame, Int) -> GifFrame) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GifFrame, Int) -> GifFrame
    forall a b. (a, b) -> a
    fst) ([(GifFrame, Int)] -> [(GifFrame, Int)])
    -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a b. (a -> b) -> a -> b
    $ [GifFrame] -> [Int] -> [(GifFrame, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [GifFrame]
    frames [Int
    0 :: Int ..]
            isInBounds :: GifFrame -> Bool
    isInBounds GifFrame { gfXOffset :: GifFrame -> Int
    gfXOffset = Int
    xOff, gfYOffset :: GifFrame -> Int
    gfYOffset = Int
    yOff, gfPixels :: GifFrame -> Image Word8
    gfPixels = Image Word8
    img } =
              Int
    xOff Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    yOff Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    &&
              Int
    xOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Image Word8 -> Int
    forall a. Image a -> Int
    imageWidth Image Word8
    img Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    width Bool -> Bool -> Bool
    && Int
    yOff Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Image Word8 -> Int
    forall a. Image a -> Int
    imageHeight Image Word8
    img Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    height

    checkPaletteValidity :: GifEncode -> Either String ()
    checkPaletteValidity :: GifEncode -> Either String ()
    checkPaletteValidity GifEncode
    spec
      | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe Palette -> Bool
    forall {a}. Maybe (Image a) -> Bool
    isPaletteValid (Maybe Palette -> Bool) -> Maybe Palette -> Bool
    forall a b. (a -> b) -> a -> b
    $ GifEncode -> Maybe Palette
    gePalette GifEncode
    spec = String -> Either String ()
    forall a b. a -> Either a b
    Left String
    "Invalid global palette size"
      | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(GifFrame, Int)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(GifFrame, Int)]
    invalidPalettes = String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Invalid palette size in GIF frames: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Int] -> String
    forall a. Show a => a -> String
    show (((GifFrame, Int) -> Int) -> [(GifFrame, Int)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (GifFrame, Int) -> Int
    forall a b. (a, b) -> b
    snd [(GifFrame, Int)]
    invalidPalettes)
      | Bool
    otherwise = () -> Either String ()
    forall a b. b -> Either a b
    Right ()
      where invalidPalettes :: [(GifFrame, Int)]
    invalidPalettes = ((GifFrame, Int) -> Bool) -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((GifFrame, Int) -> Bool) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Palette -> Bool
    forall {a}. Maybe (Image a) -> Bool
    isPaletteValid (Maybe Palette -> Bool)
    -> ((GifFrame, Int) -> Maybe Palette) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GifFrame -> Maybe Palette
    gfPalette (GifFrame -> Maybe Palette)
    -> ((GifFrame, Int) -> GifFrame)
    -> (GifFrame, Int)
    -> Maybe Palette
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GifFrame, Int) -> GifFrame
    forall a b. (a, b) -> a
    fst) ([(GifFrame, Int)] -> [(GifFrame, Int)])
    -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a b. (a -> b) -> a -> b
    $ [GifFrame] -> [Int] -> [(GifFrame, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (GifEncode -> [GifFrame]
    geFrames GifEncode
    spec) [Int
    0 :: Int ..]
            isPaletteValid :: Maybe (Image a) -> Bool
    isPaletteValid Maybe (Image a)
    Nothing  = Bool
    True
            isPaletteValid (Just Image a
    p) = let w :: Int
    w = Image a -> Int
    forall a. Image a -> Int
    imageWidth Image a
    p
                                          h :: Int
    h = Image a -> Int
    forall a. Image a -> Int
    imageHeight Image a
    p
                                      in Int
    h Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 Bool -> Bool -> Bool
    && Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 Bool -> Bool -> Bool
    && Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    256

    checkIndexAbsentFromPalette :: GifEncode -> Either String ()
    checkIndexAbsentFromPalette :: GifEncode -> Either String ()
    checkIndexAbsentFromPalette GifEncode { gePalette :: GifEncode -> Maybe Palette
    gePalette = Maybe Palette
    global, geFrames :: GifEncode -> [GifFrame]
    geFrames = [GifFrame]
    frames } =
      if [(GifFrame, Int)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(GifFrame, Int)]
    missingPalette
      then () -> Either String ()
    forall a b. b -> Either a b
    Right ()
      else String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ String
    "GIF image frames with color indexes missing from palette: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Int] -> String
    forall a. Show a => a -> String
    show (((GifFrame, Int) -> Int) -> [(GifFrame, Int)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (GifFrame, Int) -> Int
    forall a b. (a, b) -> b
    snd [(GifFrame, Int)]
    missingPalette)
      where missingPalette :: [(GifFrame, Int)]
    missingPalette = ((GifFrame, Int) -> Bool) -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((GifFrame, Int) -> Bool) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GifFrame -> Bool
    checkFrame (GifFrame -> Bool)
    -> ((GifFrame, Int) -> GifFrame) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GifFrame, Int) -> GifFrame
    forall a b. (a, b) -> a
    fst) ([(GifFrame, Int)] -> [(GifFrame, Int)])
    -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a b. (a -> b) -> a -> b
    $ [GifFrame] -> [Int] -> [(GifFrame, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [GifFrame]
    frames [Int
    0 :: Int ..]
            checkFrame :: GifFrame -> Bool
    checkFrame GifFrame
    frame = (Word8 -> Bool) -> Vector Word8 -> Bool
    forall a. Storable a => (a -> Bool) -> Vector a -> Bool
    V.all (Maybe Palette -> Maybe Palette -> Int -> Bool
    checkIndexInPalette Maybe Palette
    global (GifFrame -> Maybe Palette
    gfPalette GifFrame
    frame) (Int -> Bool) -> (Word8 -> Int) -> Word8 -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) (Vector Word8 -> Bool) -> Vector Word8 -> Bool
    forall a b. (a -> b) -> a -> b
    $
                               Image Word8 -> Vector (PixelBaseComponent Word8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData (Image Word8 -> Vector (PixelBaseComponent Word8))
    -> Image Word8 -> Vector (PixelBaseComponent Word8)
    forall a b. (a -> b) -> a -> b
    $ GifFrame -> Image Word8
    gfPixels GifFrame
    frame

    checkBackground :: GifEncode -> Either String ()
    checkBackground :: GifEncode -> Either String ()
    checkBackground GifEncode { geBackground :: GifEncode -> Maybe Int
    geBackground = Maybe Int
    Nothing } = () -> Either String ()
    forall a b. b -> Either a b
    Right ()
    checkBackground GifEncode { gePalette :: GifEncode -> Maybe Palette
    gePalette = Maybe Palette
    global, geBackground :: GifEncode -> Maybe Int
    geBackground = Just Int
    background } =
      if Maybe Palette -> Maybe Palette -> Int -> Bool
    checkIndexInPalette Maybe Palette
    global Maybe Palette
    forall a. Maybe a
    Nothing Int
    background
      then () -> Either String ()
    forall a b. b -> Either a b
    Right ()
      else String -> Either String ()
    forall a b. a -> Either a b
    Left String
    "GIF background index absent from global palette"

    checkTransparencies :: GifEncode -> Either String ()
    checkTransparencies :: GifEncode -> Either String ()
    checkTransparencies GifEncode { gePalette :: GifEncode -> Maybe Palette
    gePalette = Maybe Palette
    global, geFrames :: GifEncode -> [GifFrame]
    geFrames = [GifFrame]
    frames } =
      if [(GifFrame, Int)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(GifFrame, Int)]
    missingTransparency
      then () -> Either String ()
    forall a b. b -> Either a b
    Right ()
      else String -> Either String ()
    forall a b. a -> Either a b
    Left (String -> Either String ()) -> String -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ String
    "GIF transparent index absent from palettes for frames: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Int] -> String
    forall a. Show a => a -> String
    show (((GifFrame, Int) -> Int) -> [(GifFrame, Int)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (GifFrame, Int) -> Int
    forall a b. (a, b) -> b
    snd [(GifFrame, Int)]
    missingTransparency)
      where missingTransparency :: [(GifFrame, Int)]
    missingTransparency = ((GifFrame, Int) -> Bool) -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> ((GifFrame, Int) -> Bool) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GifFrame -> Bool
    transparencyOK (GifFrame -> Bool)
    -> ((GifFrame, Int) -> GifFrame) -> (GifFrame, Int) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GifFrame, Int) -> GifFrame
    forall a b. (a, b) -> a
    fst) ([(GifFrame, Int)] -> [(GifFrame, Int)])
    -> [(GifFrame, Int)] -> [(GifFrame, Int)]
    forall a b. (a -> b) -> a -> b
    $ [GifFrame] -> [Int] -> [(GifFrame, Int)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [GifFrame]
    frames [Int
    0 :: Int ..]
            transparencyOK :: GifFrame -> Bool
    transparencyOK GifFrame { gfTransparent :: GifFrame -> Maybe Int
    gfTransparent = Maybe Int
    Nothing } = Bool
    True
            transparencyOK GifFrame { gfPalette :: GifFrame -> Maybe Palette
    gfPalette = Maybe Palette
    local, gfTransparent :: GifFrame -> Maybe Int
    gfTransparent = Just Int
    transparent } =
              Maybe Palette -> Maybe Palette -> Int -> Bool
    checkIndexInPalette Maybe Palette
    global Maybe Palette
    local Int
    transparent

    checkIndexInPalette :: Maybe Palette -> Maybe Palette -> Int -> Bool
    checkIndexInPalette :: Maybe Palette -> Maybe Palette -> Int -> Bool
    checkIndexInPalette Maybe Palette
    Nothing       Maybe Palette
    Nothing      Int
    _  = Bool
    False
    checkIndexInPalette Maybe Palette
    _             (Just Palette
    local) Int
    ix = Int
    ix Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Palette -> Int
    forall a. Image a -> Int
    imageWidth Palette
    local
    checkIndexInPalette (Just Palette
    global) Maybe Palette
    _            Int
    ix = Int
    ix Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Palette -> Int
    forall a. Image a -> Int
    imageWidth Palette
    global

    checkGifImageSizes :: [(a, b, Image px)] -> Bool
    checkGifImageSizes :: forall a b px. [(a, b, Image px)] -> Bool
    checkGifImageSizes [] = Bool
    False
    checkGifImageSizes ((a
    _, b
    _, Image px
    img) : [(a, b, Image px)]
    rest) = ((a, b, Image px) -> Bool) -> [(a, b, Image px)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (a, b, Image px) -> Bool
    checkDimension [(a, b, Image px)]
    rest
       where width :: Int
    width = Image px -> Int
    forall a. Image a -> Int
    imageWidth Image px
    img
             height :: Int
    height = Image px -> Int
    forall a. Image a -> Int
    imageHeight Image px
    img

             checkDimension :: (a, b, Image px) -> Bool
    checkDimension (a
    _,b
    _,Image { imageWidth :: forall a. Image a -> Int
    imageWidth = Int
    w, imageHeight :: forall a. Image a -> Int
    imageHeight = Int
    h }) =
                 Int
    w Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    width Bool -> Bool -> Bool
    && Int
    h Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    height

    computeColorTableSize :: Palette -> Int
    computeColorTableSize :: Palette -> Int
    computeColorTableSize Image { imageWidth :: forall a. Image a -> Int
    imageWidth = Int
    itemCount } = Int -> Int
    go Int
    1
      where go :: Int -> Int
    go Int
    k | Int
    2 Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    itemCount = Int
    k
                 | Bool
    otherwise = Int -> Int
    go (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

    -- | Encode a complex gif to a bytestring.

    --

    -- * There must be at least one image.

    --

    -- * The screen and every frame dimensions must be between 1 and 65535.

    --

    -- * Every frame image must fit within the screen bounds.

    --

    -- * Every palette must have between one and 256 colors.

    --

    -- * There must be a global palette or every image must have a local palette.

    --

    -- * The background color index must be present in the global palette.

    --

    -- * Every frame's transparent color index, if set, must be present in the palette used by that frame.

    --

    -- * Every color index used in an image must be present in the palette used by that frame.

    --

    encodeComplexGifImage :: GifEncode -> Either String L.ByteString
    encodeComplexGifImage :: GifEncode -> Either String ByteString
    encodeComplexGifImage GifEncode
    spec = do
      Bool -> Either String () -> Either String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([GifFrame] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([GifFrame] -> Bool) -> [GifFrame] -> Bool
    forall a b. (a -> b) -> a -> b
    $ GifEncode -> [GifFrame]
    geFrames GifEncode
    spec) (Either String () -> Either String ())
    -> Either String () -> Either String ()
    forall a b. (a -> b) -> a -> b
    $ String -> Either String ()
    forall a b. a -> Either a b
    Left String
    "No GIF frames"
      GifEncode -> Either String ()
    checkImageSizes GifEncode
    spec
      GifEncode -> Either String ()
    checkImagesInBounds GifEncode
    spec
      GifEncode -> Either String ()
    checkPaletteValidity GifEncode
    spec
      GifEncode -> Either String ()
    checkBackground GifEncode
    spec
      GifEncode -> Either String ()
    checkTransparencies GifEncode
    spec
      GifEncode -> Either String ()
    checkIndexAbsentFromPalette GifEncode
    spec

      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
    $ GifFile -> ByteString
    forall a. Binary a => a -> ByteString
    encode GifFile
    allFile
      where
        GifEncode { geWidth :: GifEncode -> Int
    geWidth      = Int
    width
                  , geHeight :: GifEncode -> Int
    geHeight     = Int
    height
                  , gePalette :: GifEncode -> Maybe Palette
    gePalette    = Maybe Palette
    globalPalette
                  , geBackground :: GifEncode -> Maybe Int
    geBackground = Maybe Int
    background
                  , geLooping :: GifEncode -> GifLooping
    geLooping    = GifLooping
    looping
                  , geFrames :: GifEncode -> [GifFrame]
    geFrames     = [GifFrame]
    frames
                  } = GifEncode
    spec
        allFile :: GifFile
    allFile = GifFile
          { gifHeader :: GifHeader
    gifHeader = GifHeader
            { gifVersion :: GifVersion
    gifVersion          = GifVersion
    version
            , gifScreenDescriptor :: LogicalScreenDescriptor
    gifScreenDescriptor = LogicalScreenDescriptor
    logicalScreen
            , gifGlobalMap :: Maybe Palette
    gifGlobalMap        = Maybe Palette
    globalPalette
            }
          , gifImages :: [(Maybe GraphicControlExtension, GifImage)]
    gifImages           = [(Maybe GraphicControlExtension, GifImage)]
    toSerialize
          , gifLoopingBehaviour :: GifLooping
    gifLoopingBehaviour = GifLooping
    looping
          }

        version :: GifVersion
    version = case [GifFrame]
    frames of
          [] -> GifVersion
    GIF87a
          [GifFrame
    _] -> GifVersion
    GIF87a
          GifFrame
    _:GifFrame
    _:[GifFrame]
    _ -> GifVersion
    GIF89a

        logicalScreen :: LogicalScreenDescriptor
    logicalScreen = LogicalScreenDescriptor
          { screenWidth :: Word16
    screenWidth        = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    width
          , screenHeight :: Word16
    screenHeight       = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    height
          , backgroundIndex :: Word8
    backgroundIndex    = Word8 -> (Int -> Word8) -> Maybe Int -> Word8
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Word8
    0 Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Maybe Int
    background
          , hasGlobalMap :: Bool
    hasGlobalMap       = Bool -> (Palette -> Bool) -> Maybe Palette -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Bool -> Palette -> Bool
    forall a b. a -> b -> a
    const Bool
    True) Maybe Palette
    globalPalette
          , colorResolution :: Word8
    colorResolution    = Word8
    8
          , isColorTableSorted :: Bool
    isColorTableSorted = Bool
    False
          -- Imply a 8 bit global palette size if there's no explicit global palette.

          , colorTableSize :: Word8
    colorTableSize     = Word8 -> (Palette -> Word8) -> Maybe Palette -> Word8
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Word8
    8 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Palette -> Int) -> Palette -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Palette -> Int
    computeColorTableSize) Maybe Palette
    globalPalette
          }

        toSerialize :: [(Maybe GraphicControlExtension, GifImage)]
    toSerialize = [(Int
    -> Maybe Int -> GifDisposalMethod -> Maybe GraphicControlExtension
    forall {a} {a}.
    (Integral a, Integral a) =>
    a -> Maybe a -> GifDisposalMethod -> Maybe GraphicControlExtension
    controlExtension Int
    delay Maybe Int
    transparent GifDisposalMethod
    disposal, GifImage
                         { imgDescriptor :: ImageDescriptor
    imgDescriptor = Int -> Int -> Maybe Palette -> Image Word8 -> ImageDescriptor
    forall {a} {a} {a}.
    (Integral a, Integral a) =>
    a -> a -> Maybe Palette -> Image a -> ImageDescriptor
    imageDescriptor Int
    left Int
    top Maybe Palette
    localPalette Image Word8
    img
                         , imgLocalPalette :: Maybe Palette
    imgLocalPalette = Maybe Palette
    localPalette
                         , imgLzwRootSize :: Word8
    imgLzwRootSize = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    lzwKeySize
                         , imgData :: ByteString
    imgData = [ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString)
    -> (Vector Word8 -> [ByteString]) -> Vector Word8 -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    L.toChunks (ByteString -> [ByteString])
    -> (Vector Word8 -> ByteString) -> Vector Word8 -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Vector Word8 -> ByteString
    lzwEncode Int
    lzwKeySize (Vector Word8 -> ByteString) -> Vector Word8 -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Image Word8 -> Vector (PixelBaseComponent Word8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData Image Word8
    img
                         })
                      | GifFrame { gfXOffset :: GifFrame -> Int
    gfXOffset     = Int
    left
                                 , gfYOffset :: GifFrame -> Int
    gfYOffset     = Int
    top
                                 , gfPalette :: GifFrame -> Maybe Palette
    gfPalette     = Maybe Palette
    localPalette
                                 , gfTransparent :: GifFrame -> Maybe Int
    gfTransparent = Maybe Int
    transparent
                                 , gfDelay :: GifFrame -> Int
    gfDelay       = Int
    delay
                                 , gfDisposal :: GifFrame -> GifDisposalMethod
    gfDisposal    = GifDisposalMethod
    disposal
                                 , gfPixels :: GifFrame -> Image Word8
    gfPixels      = Image Word8
    img } <- [GifFrame]
    frames
                      , let palette :: Palette
    palette = case (Maybe Palette
    globalPalette, Maybe Palette
    localPalette) of
                              (Maybe Palette
    _, Just Palette
    local)        -> Palette
    local
                              (Just Palette
    global, Maybe Palette
    Nothing) -> Palette
    global
                              (Maybe Palette
    Nothing, Maybe Palette
    Nothing)     -> String -> Palette
    forall a. HasCallStack => String -> a
    error String
    "No palette for image" -- redundant, we guard for this

                        -- Some decoders (looking at you, GIMP) don't handle initial LZW key size of 1 correctly.

                        -- We'll waste some space for the sake of interoperability

                      , let lzwKeySize :: Int
    lzwKeySize = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    2 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Palette -> Int
    computeColorTableSize Palette
    palette
                      ]

        controlExtension :: a -> Maybe a -> GifDisposalMethod -> Maybe GraphicControlExtension
    controlExtension a
    0     Maybe a
    Nothing     GifDisposalMethod
    DisposalAny = Maybe GraphicControlExtension
    forall a. Maybe a
    Nothing
        controlExtension a
    delay Maybe a
    transparent GifDisposalMethod
    disposal    = GraphicControlExtension -> Maybe GraphicControlExtension
    forall a. a -> Maybe a
    Just GraphicControlExtension
          { gceDisposalMethod :: GifDisposalMethod
    gceDisposalMethod        = GifDisposalMethod
    disposal
          , gceUserInputFlag :: Bool
    gceUserInputFlag         = Bool
    False
          , gceTransparentFlag :: Bool
    gceTransparentFlag       = Bool -> (a -> Bool) -> Maybe a -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Bool -> a -> Bool
    forall a b. a -> b -> a
    const Bool
    True) Maybe a
    transparent
          , gceDelay :: Word16
    gceDelay                 = a -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    delay
          , gceTransparentColorIndex :: Word8
    gceTransparentColorIndex = Word8 -> (a -> Word8) -> Maybe a -> Word8
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Word8
    0 a -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Maybe a
    transparent
          }

        imageDescriptor :: a -> a -> Maybe Palette -> Image a -> ImageDescriptor
    imageDescriptor a
    left a
    top Maybe Palette
    localPalette Image a
    img = ImageDescriptor
          { gDescPixelsFromLeft :: Word16
    gDescPixelsFromLeft         = a -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    left
          , gDescPixelsFromTop :: Word16
    gDescPixelsFromTop          = a -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    top
          , gDescImageWidth :: Word16
    gDescImageWidth             = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ Image a -> Int
    forall a. Image a -> Int
    imageWidth Image a
    img
          , gDescImageHeight :: Word16
    gDescImageHeight            = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word16) -> Int -> Word16
    forall a b. (a -> b) -> a -> b
    $ Image a -> Int
    forall a. Image a -> Int
    imageHeight Image a
    img
          , gDescHasLocalMap :: Bool
    gDescHasLocalMap            = Bool -> (Palette -> Bool) -> Maybe Palette -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Bool -> Palette -> Bool
    forall a b. a -> b -> a
    const Bool
    True) Maybe Palette
    localPalette
          , gDescIsInterlaced :: Bool
    gDescIsInterlaced           = Bool
    False
          , gDescIsImgDescriptorSorted :: Bool
    gDescIsImgDescriptorSorted  = Bool
    False
          , gDescLocalColorTableSize :: Word8
    gDescLocalColorTableSize    = Word8 -> (Palette -> Word8) -> Maybe Palette -> Word8
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Word8
    0 (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Palette -> Int) -> Palette -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Palette -> Int
    computeColorTableSize) Maybe Palette
    localPalette
          }

    -- | Encode a gif animation to a bytestring.

    --

    -- * Every image must have the same size

    --

    -- * Every palette must have between one and 256 colors.

    --

    encodeGifImages :: GifLooping -> [(Palette, GifDelay, Image Pixel8)]
                    -> Either String L.ByteString
    encodeGifImages :: GifLooping
    -> [(Palette, Int, Image Word8)] -> Either String ByteString
    encodeGifImages GifLooping
    _ [] = String -> Either String ByteString
    forall a b. a -> Either a b
    Left String
    "No image in list"
    encodeGifImages GifLooping
    _ [(Palette, Int, Image Word8)]
    imageList
        | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [(Palette, Int, Image Word8)] -> Bool
    forall a b px. [(a, b, Image px)] -> Bool
    checkGifImageSizes [(Palette, Int, Image Word8)]
    imageList = String -> Either String ByteString
    forall a b. a -> Either a b
    Left String
    "Gif images have different size"
    encodeGifImages GifLooping
    looping imageList :: [(Palette, Int, Image Word8)]
    imageList@((Palette
    firstPalette, Int
    _,Image Word8
    firstImage):[(Palette, Int, Image Word8)]
    _) =
      GifEncode -> Either String ByteString
    encodeComplexGifImage (GifEncode -> Either String ByteString)
    -> GifEncode -> Either String ByteString
    forall a b. (a -> b) -> a -> b
    $ Int
    -> Int
    -> Maybe Palette
    -> Maybe Int
    -> GifLooping
    -> [GifFrame]
    -> GifEncode
    GifEncode (Image Word8 -> Int
    forall a. Image a -> Int
    imageWidth Image Word8
    firstImage) (Image Word8 -> Int
    forall a. Image a -> Int
    imageHeight Image Word8
    firstImage) (Palette -> Maybe Palette
    forall a. a -> Maybe a
    Just Palette
    firstPalette) Maybe Int
    forall a. Maybe a
    Nothing GifLooping
    looping [GifFrame]
    frames
      where
        frames :: [GifFrame]
    frames = [ Int
    -> Int
    -> Maybe Palette
    -> Maybe Int
    -> Int
    -> GifDisposalMethod
    -> Image Word8
    -> GifFrame
    GifFrame Int
    0 Int
    0 Maybe Palette
    localPalette Maybe Int
    forall a. Maybe a
    Nothing Int
    delay GifDisposalMethod
    DisposalAny Image Word8
    image
                 | (Palette
    palette, Int
    delay, Image Word8
    image) <- [(Palette, Int, Image Word8)]
    imageList
                 , let localPalette :: Maybe Palette
    localPalette = if Palette -> Bool
    paletteEqual Palette
    palette then Maybe Palette
    forall a. Maybe a
    Nothing else Palette -> Maybe Palette
    forall a. a -> Maybe a
    Just Palette
    palette ]

        paletteEqual :: Palette -> Bool
    paletteEqual Palette
    p = Palette -> Vector (PixelBaseComponent PixelRGB8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData Palette
    firstPalette Vector Word8 -> Vector Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Palette -> Vector (PixelBaseComponent PixelRGB8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData Palette
    p

    -- | Encode a greyscale image to a bytestring.

    encodeGifImage :: Image Pixel8 -> L.ByteString
    encodeGifImage :: Image Word8 -> ByteString
    encodeGifImage Image Word8
    img = case GifLooping
    -> [(Palette, Int, Image Word8)] -> Either String ByteString
    encodeGifImages GifLooping
    LoopingNever [(Palette
    greyPalette, Int
    0, Image Word8
    img)] of
        Left String
    err -> String -> ByteString
    forall a. HasCallStack => String -> a
    error (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    "Impossible:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    err
        Right ByteString
    v -> ByteString
    v

    -- | Encode an image with a given palette.

    -- Can return errors if the palette is ill-formed.

    --

    -- * A palette must have between 1 and 256 colors

    --

    encodeGifImageWithPalette :: Image Pixel8 -> Palette -> Either String L.ByteString
    encodeGifImageWithPalette :: Image Word8 -> Palette -> Either String ByteString
    encodeGifImageWithPalette Image Word8
    img Palette
    palette =
        GifLooping
    -> [(Palette, Int, Image Word8)] -> Either String ByteString
    encodeGifImages GifLooping
    LoopingNever [(Palette
    palette, Int
    0, Image Word8
    img)]

    -- | Write a greyscale in a gif file on the disk.

    writeGifImage :: FilePath -> Image Pixel8 -> IO ()
    writeGifImage :: String -> Image Word8 -> IO ()
    writeGifImage String
    file = String -> ByteString -> IO ()
    L.writeFile String
    file (ByteString -> IO ())
    -> (Image Word8 -> ByteString) -> Image Word8 -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image Word8 -> ByteString
    encodeGifImage

    -- | Write a list of images as a gif animation in a file.

    --

    -- * Every image must have the same size

    --

    -- * Every palette must have between one and 256 colors.

    --

    writeGifImages :: FilePath -> GifLooping -> [(Palette, GifDelay, Image Pixel8)]
                   -> Either String (IO ())
    writeGifImages :: String
    -> GifLooping
    -> [(Palette, Int, Image Word8)]
    -> Either String (IO ())
    writeGifImages String
    file GifLooping
    looping [(Palette, Int, Image Word8)]
    lst = String -> ByteString -> IO ()
    L.writeFile String
    file (ByteString -> IO ())
    -> Either String ByteString -> Either String (IO ())
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> GifLooping
    -> [(Palette, Int, Image Word8)] -> Either String ByteString
    encodeGifImages GifLooping
    looping [(Palette, Int, Image Word8)]
    lst

    -- | Write a gif image with a palette to a file.

    --

    -- * A palette must have between 1 and 256 colors

    --

    writeGifImageWithPalette :: FilePath -> Image Pixel8 -> Palette
                             -> Either String (IO ())
    writeGifImageWithPalette :: String -> Image Word8 -> Palette -> Either String (IO ())
    writeGifImageWithPalette String
    file Image Word8
    img Palette
    palette =
        String -> ByteString -> IO ()
    L.writeFile String
    file (ByteString -> IO ())
    -> Either String ByteString -> Either String (IO ())
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Image Word8 -> Palette -> Either String ByteString
    encodeGifImageWithPalette Image Word8
    img Palette
    palette

    writeComplexGifImage :: FilePath -> GifEncode -> Either String (IO ())
    writeComplexGifImage :: String -> GifEncode -> Either String (IO ())
    writeComplexGifImage String
    file GifEncode
    spec = String -> ByteString -> IO ()
    L.writeFile String
    file (ByteString -> IO ())
    -> Either String ByteString -> Either String (IO ())
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> GifEncode -> Either String ByteString
    encodeComplexGifImage GifEncode
    spec