    {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
    -- avoid a flood of warnings
    {-|

    Module      :  Codec.Image.PBM
    Copyright   :  (c) Claude Heiland-Allen 2012,2018
    License     :  BSD3

    Maintainer  :  claude@mathr.co.uk
    Stability   :  unstable
    Portability :  portable

    Encode and decode both versions (binary P4 and plain P1) of PBM: the
    portable bitmap lowest common denominator monochrome image file format.

    References:

      * pbm(5)

      * The PBM Format <http://netpbm.sourceforge.net/doc/pbm.html>

    Bugs:

      * This implementation is not fully compliant with the PBM specification,
        with respect to point 8 in the second reference above which states that
        /a comment can actually be in the middle of what you might consider a token/
        Such a pathological PBM file might be rejected by 'decodePBM', but
        may instead be wrongly decoded if (for example) the comment were in
        the middle of the image width token, leading to it being interpreted
        as a (smaller) width and height.

    -}
    module Codec.Image.PBM
      ( PBM(..)
      -- * Encoding PBM images.
      , encodePBM
      , encodePlainPBM
      , EncodeError(..)
      , encodePBM'
      -- * Decoding PBM images.
      , DecodeError(..)
      , decodePBM
      , decodePlainPBM
      , decodePBMs
      -- * Padding and trimming PBM images.
      , padPBM
      , trimPBM
      , repadPBM
      ) where

    import Data.Bits (shiftL, shiftR, (.&.))
    import Data.Ix (range)
    import Data.Word (Word8)
    import qualified Data.Array.Unboxed as U
    import qualified Data.ByteString as BS

    import Data.Bits.Bitwise (fromListBE, toListLE)
    import Data.Array.BitArray (BitArray, bounds, elems, listArray, false, (//), assocs, ixmap)
    import Data.Array.BitArray.ByteString (toByteString, fromByteString)

    -- | A decoded PBM image.  'pbmWidth' must be less or equal to the
    --   width of the 'pbmPixels' array (which has its first index in Y
    --   and the second in X, with lowest coordinates at the top left).
    --
    --   False pixels are white, True pixels are black.  Pixels to the
    --   right of 'pbmWidth' are don't care padding bits.  However, these
    --   padding bits are likely to invalidate aggregrate 'BitArray.fold'
    --   operations.  See 'trimPBM'.
    --
    data PBM = PBM{ PBM -> Int
    pbmWidth :: !Int, PBM -> BitArray (Int, Int)
    pbmPixels :: !(BitArray (Int, Int)) }

    -- | Encode a binary PBM (P4) image, padding rows to multiples of 8
    --   bits as necessary.
    --
    encodePBM :: BitArray (Int, Int) {- ^ pixels -} -> BS.ByteString
    encodePBM :: BitArray (Int, Int) -> ByteString
    encodePBM BitArray (Int, Int)
    pixels = case PBM -> Either EncodeError ByteString
    encodePBM' PBM
    pbm of
      Right ByteString
    string -> ByteString
    string
      Either EncodeError ByteString
    _ -> [Char] -> ByteString
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Codec.Image.PBM.encodePBM: internal error"
      where
        ((Int
    _, Int
    xlo), (Int
    _, Int
    xhi)) = BitArray (Int, Int) -> ((Int, Int), (Int, Int))
    forall i. Ix i => BitArray i -> (i, i)
    bounds BitArray (Int, Int)
    pixels
        width :: Int
    width  = Int
    xhi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xlo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
        pbm :: PBM
    pbm = PBM -> PBM
    padPBM PBM{ pbmWidth :: Int
    pbmWidth = Int
    width, pbmPixels :: BitArray (Int, Int)
    pbmPixels = BitArray (Int, Int)
    pixels }

    -- | Possible reasons for encoding to fail.
    data EncodeError
      = BadPixelWidth{ EncodeError -> PBM
    encErrPBM :: PBM } -- ^ array width is not a multiple of 8 bits
      | BadSmallWidth{ encErrPBM :: PBM } -- ^ image width is too smaller than array width
      | BadLargeWidth{ encErrPBM :: PBM } -- ^ image width is larger than array width

    -- | Encode a plain PBM (P1) image.
    --
    --   No restrictions on pixels array size, but the file format is
    --   exceedingly wasteful of space.
    --
    encodePlainPBM :: BitArray (Int, Int) {- ^ pixels -} -> String
    encodePlainPBM :: BitArray (Int, Int) -> [Char]
    encodePlainPBM BitArray (Int, Int)
    pixels = [[Char]] -> [Char]
    unlines ([Char]
    header [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    raster)
      where
        ((Int
    ylo, Int
    xlo), (Int
    yhi, Int
    xhi)) = BitArray (Int, Int) -> ((Int, Int), (Int, Int))
    forall i. Ix i => BitArray i -> (i, i)
    bounds BitArray (Int, Int)
    pixels
        width :: Int
    width  = Int
    xhi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xlo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
        height :: Int
    height = Int
    yhi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ylo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
        header :: [Char]
    header = [Char]
    "P1\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    width [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    height
        raster :: [[Char]]
    raster = ([Char] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Int -> [Char] -> [[Char]]
    forall {a}. Int -> [a] -> [[a]]
    chunk Int
    64) ([[Char]] -> [[Char]])
    -> (BitArray (Int, Int) -> [[Char]])
    -> BitArray (Int, Int)
    -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Char] -> [[Char]]
    forall {a}. Int -> [a] -> [[a]]
    chunk Int
    width ([Char] -> [[Char]])
    -> (BitArray (Int, Int) -> [Char])
    -> BitArray (Int, Int)
    -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool -> Char) -> [Bool] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Bool -> Char
    char ([Bool] -> [Char])
    -> (BitArray (Int, Int) -> [Bool]) -> BitArray (Int, Int) -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BitArray (Int, Int) -> [Bool]
    forall i. Ix i => BitArray i -> [Bool]
    elems (BitArray (Int, Int) -> [[Char]])
    -> BitArray (Int, Int) -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ BitArray (Int, Int)
    pixels
        char :: Bool -> Char
    char Bool
    False = Char
    '0'
        char Bool
    True  = Char
    '1'
        chunk :: Int -> [a] -> [[a]]
    chunk Int
    n [a]
    _ | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0 = [Char] -> [[a]]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Codec.Image.PBM.encodePlainPBM: internal error"
        chunk Int
    _ [] = []
        chunk Int
    n [a]
    xs = let ([a]
    ys, [a]
    zs) = Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n [a]
    xs in [a]
    ys [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : Int -> [a] -> [[a]]
    chunk Int
    n [a]
    zs

    -- | Encode a pre-padded 'PBM' to a binary PBM (P4) image.
    --
    --   The pixels array must have a multiple of 8 bits per row.  The image
    --   width may be less than the pixel array width, with up to 7 padding
    --   bits at the end of each row.
    --
    encodePBM' :: PBM -> Either EncodeError BS.ByteString
    encodePBM' :: PBM -> Either EncodeError ByteString
    encodePBM' PBM
    pbm
      | (Int
    pixelWidth Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    7) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0 = EncodeError -> Either EncodeError ByteString
    forall a b. a -> Either a b
    Left (PBM -> EncodeError
    BadPixelWidth PBM
    pbm)
      | Int
    width Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    pixelWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    8 = EncodeError -> Either EncodeError ByteString
    forall a b. a -> Either a b
    Left (PBM -> EncodeError
    BadSmallWidth PBM
    pbm)
      | Int
    width Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >  Int
    pixelWidth     = EncodeError -> Either EncodeError ByteString
    forall a b. a -> Either a b
    Left (PBM -> EncodeError
    BadLargeWidth PBM
    pbm)
      | Bool
    otherwise = ByteString -> Either EncodeError ByteString
    forall a b. b -> Either a b
    Right (ByteString
    header ByteString -> ByteString -> ByteString
    `BS.append` ByteString
    raster)
      where
        width :: Int
    width = PBM -> Int
    pbmWidth PBM
    pbm
        pixels :: BitArray (Int, Int)
    pixels = PBM -> BitArray (Int, Int)
    pbmPixels PBM
    pbm
        ((Int
    ylo, Int
    xlo), (Int
    yhi, Int
    xhi)) = BitArray (Int, Int) -> ((Int, Int), (Int, Int))
    forall i. Ix i => BitArray i -> (i, i)
    bounds BitArray (Int, Int)
    pixels
        pixelWidth :: Int
    pixelWidth  = Int
    xhi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xlo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
        pixelHeight :: Int
    pixelHeight = Int
    yhi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ylo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
        height :: Int
    height = Int
    pixelHeight
        header :: ByteString
    header = [Word8] -> ByteString
    BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Char -> Word8) -> [Char] -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Word8
    forall a. Enum a => Int -> a
    toEnum (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) [Char]
    headerStr
        headerStr :: [Char]
    headerStr = [Char]
    "P4\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    width [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    height [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\n"
        raster :: ByteString
    raster = ByteString -> ByteString
    reverseByteBits (BitArray (Int, Int) -> ByteString
    forall i. Ix i => BitArray i -> ByteString
    toByteString BitArray (Int, Int)
    pixels)

    -- | Possible reasons for decoding to fail, with the input that failed.
    data DecodeError a
      = BadMagicP a -- ^ First character was not P.
      | BadMagicN a -- ^ Second character was not 4 (binary) or 1 (plain).
      | BadWidth  a -- ^ The width could not be parsed, or was non-positive.
      | BadHeight a -- ^ The height could not be parsed, or was non-positive.
      | BadSpace  a -- ^ Parsing failed at the space before the pixel data.
      | BadPixels a -- ^ There weren't enough bytes of pixel data.
      deriving (DecodeError a -> DecodeError a -> Bool
    (DecodeError a -> DecodeError a -> Bool)
    -> (DecodeError a -> DecodeError a -> Bool) -> Eq (DecodeError a)
    forall a. Eq a => DecodeError a -> DecodeError a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => DecodeError a -> DecodeError a -> Bool
    == :: DecodeError a -> DecodeError a -> Bool
    $c/= :: forall a. Eq a => DecodeError a -> DecodeError a -> Bool
    /= :: DecodeError a -> DecodeError a -> Bool
    Eq, Eq (DecodeError a)
    Eq (DecodeError a) =>
    (DecodeError a -> DecodeError a -> Ordering)
    -> (DecodeError a -> DecodeError a -> Bool)
    -> (DecodeError a -> DecodeError a -> Bool)
    -> (DecodeError a -> DecodeError a -> Bool)
    -> (DecodeError a -> DecodeError a -> Bool)
    -> (DecodeError a -> DecodeError a -> DecodeError a)
    -> (DecodeError a -> DecodeError a -> DecodeError a)
    -> Ord (DecodeError a)
    DecodeError a -> DecodeError a -> Bool
    DecodeError a -> DecodeError a -> Ordering
    DecodeError a -> DecodeError a -> DecodeError a
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    forall a. Ord a => Eq (DecodeError a)
    forall a. Ord a => DecodeError a -> DecodeError a -> Bool
    forall a. Ord a => DecodeError a -> DecodeError a -> Ordering
    forall a. Ord a => DecodeError a -> DecodeError a -> DecodeError a
    $ccompare :: forall a. Ord a => DecodeError a -> DecodeError a -> Ordering
    compare :: DecodeError a -> DecodeError a -> Ordering
    $c< :: forall a. Ord a => DecodeError a -> DecodeError a -> Bool
    < :: DecodeError a -> DecodeError a -> Bool
    $c<= :: forall a. Ord a => DecodeError a -> DecodeError a -> Bool
    <= :: DecodeError a -> DecodeError a -> Bool
    $c> :: forall a. Ord a => DecodeError a -> DecodeError a -> Bool
    > :: DecodeError a -> DecodeError a -> Bool
    $c>= :: forall a. Ord a => DecodeError a -> DecodeError a -> Bool
    >= :: DecodeError a -> DecodeError a -> Bool
    $cmax :: forall a. Ord a => DecodeError a -> DecodeError a -> DecodeError a
    max :: DecodeError a -> DecodeError a -> DecodeError a
    $cmin :: forall a. Ord a => DecodeError a -> DecodeError a -> DecodeError a
    min :: DecodeError a -> DecodeError a -> DecodeError a
    Ord, ReadPrec [DecodeError a]
    ReadPrec (DecodeError a)
    Int -> ReadS (DecodeError a)
    ReadS [DecodeError a]
    (Int -> ReadS (DecodeError a))
    -> ReadS [DecodeError a]
    -> ReadPrec (DecodeError a)
    -> ReadPrec [DecodeError a]
    -> Read (DecodeError a)
    forall a. Read a => ReadPrec [DecodeError a]
    forall a. Read a => ReadPrec (DecodeError a)
    forall a. Read a => Int -> ReadS (DecodeError a)
    forall a. Read a => ReadS [DecodeError a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Read a => Int -> ReadS (DecodeError a)
    readsPrec :: Int -> ReadS (DecodeError a)
    $creadList :: forall a. Read a => ReadS [DecodeError a]
    readList :: ReadS [DecodeError a]
    $creadPrec :: forall a. Read a => ReadPrec (DecodeError a)
    readPrec :: ReadPrec (DecodeError a)
    $creadListPrec :: forall a. Read a => ReadPrec [DecodeError a]
    readListPrec :: ReadPrec [DecodeError a]
    Read, Int -> DecodeError a -> [Char] -> [Char]
    [DecodeError a] -> [Char] -> [Char]
    DecodeError a -> [Char]
    (Int -> DecodeError a -> [Char] -> [Char])
    -> (DecodeError a -> [Char])
    -> ([DecodeError a] -> [Char] -> [Char])
    -> Show (DecodeError a)
    forall a. Show a => Int -> DecodeError a -> [Char] -> [Char]
    forall a. Show a => [DecodeError a] -> [Char] -> [Char]
    forall a. Show a => DecodeError a -> [Char]
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> DecodeError a -> [Char] -> [Char]
    showsPrec :: Int -> DecodeError a -> [Char] -> [Char]
    $cshow :: forall a. Show a => DecodeError a -> [Char]
    show :: DecodeError a -> [Char]
    $cshowList :: forall a. Show a => [DecodeError a] -> [Char] -> [Char]
    showList :: [DecodeError a] -> [Char] -> [Char]
    Show)

    -- | Decode a binary PBM (P4) image.
    decodePBM :: BS.ByteString -> Either (DecodeError BS.ByteString) (PBM, BS.ByteString)
    decodePBM :: ByteString -> Either (DecodeError ByteString) (PBM, ByteString)
    decodePBM ByteString
    s =                    case ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    s of
      Just (Word8
    cP, ByteString
    s) | Word8
    cP Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    char Char
    'P' -> case ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    s of
        Just (Word8
    c4, ByteString
    s) | Word8
    c4 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    char Char
    '4' -> case Either (DecodeError ByteString) ByteString
    -> Maybe (Int, ByteString)
    forall {a} {a}.
    Read a =>
    Either a ByteString -> Maybe (a, ByteString)
    int (ByteString -> Either (DecodeError ByteString) ByteString
    skipSpaceComment ByteString
    s) of
          Just (Int
    iw, ByteString
    s) | Int
    iw Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0         -> case Either (DecodeError ByteString) ByteString
    -> Maybe (Int, ByteString)
    forall {a} {a}.
    Read a =>
    Either a ByteString -> Maybe (a, ByteString)
    int (ByteString -> Either (DecodeError ByteString) ByteString
    skipSpaceComment ByteString
    s) of
            Just (Int
    ih, ByteString
    s) | Int
    ih Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0         -> case ByteString -> Maybe ByteString
    skipSingleSpace ByteString
    s of
              Just ByteString
    s                        ->
                let rowBytes :: Int
    rowBytes = (Int
    iw Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    7) Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    3
                    imgBytes :: Int
    imgBytes = Int
    ih Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    rowBytes
                in                             case Int -> ByteString -> (ByteString, ByteString)
    BS.splitAt Int
    imgBytes ByteString
    s of
                (ByteString
    raster, ByteString
    s) | ByteString -> Int
    BS.length ByteString
    raster Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    imgBytes ->
                  let ibs :: ((Int, Int), (Int, Int))
    ibs = ((Int
    0, Int
    0), (Int
    ih Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, (Int
    rowBytes Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    3) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
                  in  (PBM, ByteString)
    -> Either (DecodeError ByteString) (PBM, ByteString)
    forall a b. b -> Either a b
    Right (PBM{ pbmWidth :: Int
    pbmWidth = Int
    iw, pbmPixels :: BitArray (Int, Int)
    pbmPixels = ((Int, Int), (Int, Int)) -> ByteString -> BitArray (Int, Int)
    forall i. Ix i => (i, i) -> ByteString -> BitArray i
    fromByteString ((Int, Int), (Int, Int))
    ibs (ByteString -> ByteString
    reverseByteBits ByteString
    raster) }, ByteString
    s)
                (ByteString, ByteString)
    _ -> DecodeError ByteString
    -> Either (DecodeError ByteString) (PBM, ByteString)
    forall a b. a -> Either a b
    Left (ByteString -> DecodeError ByteString
    forall a. a -> DecodeError a
    BadPixels ByteString
    s)
              Maybe ByteString
    _ -> DecodeError ByteString
    -> Either (DecodeError ByteString) (PBM, ByteString)
    forall a b. a -> Either a b
    Left (ByteString -> DecodeError ByteString
    forall a. a -> DecodeError a
    BadSpace ByteString
    s)
            Maybe (Int, ByteString)
    _ -> DecodeError ByteString
    -> Either (DecodeError ByteString) (PBM, ByteString)
    forall a b. a -> Either a b
    Left (ByteString -> DecodeError ByteString
    forall a. a -> DecodeError a
    BadHeight ByteString
    s)
          Maybe (Int, ByteString)
    _ -> DecodeError ByteString
    -> Either (DecodeError ByteString) (PBM, ByteString)
    forall a b. a -> Either a b
    Left (ByteString -> DecodeError ByteString
    forall a. a -> DecodeError a
    BadWidth ByteString
    s)
        Maybe (Word8, ByteString)
    _ -> DecodeError ByteString
    -> Either (DecodeError ByteString) (PBM, ByteString)
    forall a b. a -> Either a b
    Left (ByteString -> DecodeError ByteString
    forall a. a -> DecodeError a
    BadMagicN ByteString
    s)
      Maybe (Word8, ByteString)
    _ -> DecodeError ByteString
    -> Either (DecodeError ByteString) (PBM, ByteString)
    forall a b. a -> Either a b
    Left (ByteString -> DecodeError ByteString
    forall a. a -> DecodeError a
    BadMagicP ByteString
    s)
      where
        skipSpaceComment :: ByteString -> Either (DecodeError ByteString) ByteString
    skipSpaceComment ByteString
    t = case (\ByteString
    t -> (ByteString
    t, ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    t)) ((Word8 -> Bool) -> ByteString -> ByteString
    BS.dropWhile Word8 -> Bool
    isSpace ByteString
    t) of
          (ByteString
    _, Just (Word8
    cH, ByteString
    t)) | Word8
    cH Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    char Char
    '#' -> case ByteString -> Maybe (Word8, ByteString)
    BS.uncons ((Word8 -> Bool) -> ByteString -> ByteString
    BS.dropWhile (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char -> Word8
    char Char
    '\n') ByteString
    t) of
            Just (Word8
    cL, ByteString
    t) | Word8
    cL Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Word8
    char Char
    '\n' -> ByteString -> Either (DecodeError ByteString) ByteString
    skipSpaceComment ByteString
    t
            Maybe (Word8, ByteString)
    _ -> DecodeError ByteString
    -> Either (DecodeError ByteString) ByteString
    forall a b. a -> Either a b
    Left (ByteString -> DecodeError ByteString
    forall a. a -> DecodeError a
    BadSpace ByteString
    t)
          (ByteString
    t, Maybe (Word8, ByteString)
    _) -> ByteString -> Either (DecodeError ByteString) ByteString
    forall a b. b -> Either a b
    Right ByteString
    t
        skipSingleSpace :: ByteString -> Maybe ByteString
    skipSingleSpace ByteString
    t = case ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    t of
          Just (Word8
    cS, ByteString
    t) | Word8 -> Bool
    isSpace Word8
    cS -> ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    t
          Maybe (Word8, ByteString)
    _ -> Maybe ByteString
    forall a. Maybe a
    Nothing
        int :: Either a ByteString -> Maybe (a, ByteString)
    int (Left a
    _) = Maybe (a, ByteString)
    forall a. Maybe a
    Nothing
        int (Right ByteString
    t) = case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
    BS.span Word8 -> Bool
    isDigit ByteString
    t of
          (ByteString
    d, ByteString
    t)
            | ByteString -> Int
    BS.length ByteString
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 Bool -> Bool -> Bool
    &&
              ((Word8, ByteString) -> Bool)
    -> Maybe (Word8, ByteString) -> Maybe Bool
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char -> Word8
    char Char
    '0') (Word8 -> Bool)
    -> ((Word8, ByteString) -> Word8) -> (Word8, ByteString) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word8, ByteString) -> Word8
    forall a b. (a, b) -> a
    fst) (ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    d) Maybe Bool -> Maybe Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True -> case ReadS a
    forall a. Read a => ReadS a
    reads ((Word8 -> Char) -> [Word8] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Word8 -> Char
    unchar ([Word8] -> [Char]) -> [Word8] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Word8]
    BS.unpack ByteString
    d) of
                [(a
    d, [Char]
    "")] -> (a, ByteString) -> Maybe (a, ByteString)
    forall a. a -> Maybe a
    Just (a
    d, ByteString
    t)
                [(a, [Char])]
    _ -> Maybe (a, ByteString)
    forall a. Maybe a
    Nothing
          (ByteString, ByteString)
    _ -> Maybe (a, ByteString)
    forall a. Maybe a
    Nothing
        isSpace :: Word8 -> Bool
    isSpace Word8
    c = Word8
    c Word8 -> [Word8] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (Char -> Word8) -> [Char] -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Word8
    char [Char]
    pbmSpace
        isDigit :: Word8 -> Bool
    isDigit Word8
    c = Word8
    c Word8 -> [Word8] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (Char -> Word8) -> [Char] -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Word8
    char [Char]
    "0123456789"
        char :: Char -> Word8
    char = Int -> Word8
    forall a. Enum a => Int -> a
    toEnum (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
        unchar :: Word8 -> Char
    unchar = 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

    -- | Decode a sequence of binary PBM (P4) images.
    --
    --   Keeps decoding until end of input (in which case the 'snd' of the
    --   result is 'Nothing') or an error occurred.
    --
    decodePBMs :: BS.ByteString -> ([PBM], Maybe (DecodeError BS.ByteString))
    decodePBMs :: ByteString -> ([PBM], Maybe (DecodeError ByteString))
    decodePBMs ByteString
    s
      | ByteString -> Bool
    BS.null ByteString
    s = ([], Maybe (DecodeError ByteString)
    forall a. Maybe a
    Nothing)
      | Bool
    otherwise = case ByteString -> Either (DecodeError ByteString) (PBM, ByteString)
    decodePBM ByteString
    s of
          Left DecodeError ByteString
    err -> ([], DecodeError ByteString -> Maybe (DecodeError ByteString)
    forall a. a -> Maybe a
    Just DecodeError ByteString
    err)
          Right (PBM
    pbm, ByteString
    s) -> PBM
    -> ([PBM], Maybe (DecodeError ByteString))
    -> ([PBM], Maybe (DecodeError ByteString))
    forall {a} {b}. a -> ([a], b) -> ([a], b)
    prepend PBM
    pbm (ByteString -> ([PBM], Maybe (DecodeError ByteString))
    decodePBMs ByteString
    s)
      where
        prepend :: a -> ([a], b) -> ([a], b)
    prepend a
    pbm ([a]
    pbms, b
    merr) = (a
    pbma -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    pbms, b
    merr)

    -- | Decode a plain PBM (P1) image.
    --
    --   Note that the pixel array size is kept as-is (with the width not
    --   necessarily a multiple of 8 bits).
    --
    decodePlainPBM :: String -> Either (DecodeError String) (PBM, String)
    decodePlainPBM :: [Char] -> Either (DecodeError [Char]) (PBM, [Char])
    decodePlainPBM [Char]
    s = case [Char]
    s of
      (Char
    'P':[Char]
    s) -> case [Char]
    s of
        (Char
    '1':[Char]
    s) -> case Either (DecodeError [Char]) [Char] -> Maybe (Int, [Char])
    forall {a} {a}. Read a => Either a [Char] -> Maybe (a, [Char])
    int ([Char] -> Either (DecodeError [Char]) [Char]
    skipSpaceComment [Char]
    s) of
          Just (Int
    iw, [Char]
    s) | Int
    iw Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 -> case Either (DecodeError [Char]) [Char] -> Maybe (Int, [Char])
    forall {a} {a}. Read a => Either a [Char] -> Maybe (a, [Char])
    int ([Char] -> Either (DecodeError [Char]) [Char]
    skipSpaceComment [Char]
    s) of
            Just (Int
    ih, [Char]
    s) | Int
    ih Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 -> case Int -> [Char] -> Maybe ([Bool], [Char])
    forall {t}. (Eq t, Num t) => t -> [Char] -> Maybe ([Bool], [Char])
    collapseRaster (Int
    iw Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    ih) [Char]
    s of
              Just ([Bool]
    raster, [Char]
    s) ->
                let ibs :: ((Int, Int), (Int, Int))
    ibs = ((Int
    0, Int
    0), (Int
    ih Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    iw Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1))
                in  (PBM, [Char]) -> Either (DecodeError [Char]) (PBM, [Char])
    forall a b. b -> Either a b
    Right (PBM{ pbmWidth :: Int
    pbmWidth = Int
    iw, pbmPixels :: BitArray (Int, Int)
    pbmPixels = ((Int, Int), (Int, Int)) -> [Bool] -> BitArray (Int, Int)
    forall i. Ix i => (i, i) -> [Bool] -> BitArray i
    listArray ((Int, Int), (Int, Int))
    ibs [Bool]
    raster }, [Char]
    s)
              Maybe ([Bool], [Char])
    _ -> DecodeError [Char] -> Either (DecodeError [Char]) (PBM, [Char])
    forall a b. a -> Either a b
    Left ([Char] -> DecodeError [Char]
    forall a. a -> DecodeError a
    BadPixels [Char]
    s)
            Maybe (Int, [Char])
    _ -> DecodeError [Char] -> Either (DecodeError [Char]) (PBM, [Char])
    forall a b. a -> Either a b
    Left ([Char] -> DecodeError [Char]
    forall a. a -> DecodeError a
    BadHeight [Char]
    s)
          Maybe (Int, [Char])
    _ -> DecodeError [Char] -> Either (DecodeError [Char]) (PBM, [Char])
    forall a b. a -> Either a b
    Left ([Char] -> DecodeError [Char]
    forall a. a -> DecodeError a
    BadWidth [Char]
    s)
        [Char]
    _ -> DecodeError [Char] -> Either (DecodeError [Char]) (PBM, [Char])
    forall a b. a -> Either a b
    Left ([Char] -> DecodeError [Char]
    forall a. a -> DecodeError a
    BadMagicN [Char]
    s)
      [Char]
    _ -> DecodeError [Char] -> Either (DecodeError [Char]) (PBM, [Char])
    forall a b. a -> Either a b
    Left ([Char] -> DecodeError [Char]
    forall a. a -> DecodeError a
    BadMagicP [Char]
    s)
      where
        skipSpaceComment :: [Char] -> Either (DecodeError [Char]) [Char]
    skipSpaceComment [Char]
    t = case (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace [Char]
    t of
          (Char
    '#':[Char]
    t) -> case (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n') [Char]
    t of
            (Char
    '\n':[Char]
    t) -> [Char] -> Either (DecodeError [Char]) [Char]
    skipSpaceComment [Char]
    t
            [Char]
    _ -> DecodeError [Char] -> Either (DecodeError [Char]) [Char]
    forall a b. a -> Either a b
    Left ([Char] -> DecodeError [Char]
    forall a. a -> DecodeError a
    BadSpace [Char]
    t)
          [Char]
    t -> [Char] -> Either (DecodeError [Char]) [Char]
    forall a b. b -> Either a b
    Right [Char]
    t
        int :: Either a [Char] -> Maybe (a, [Char])
    int (Left a
    _) = Maybe (a, [Char])
    forall a. Maybe a
    Nothing
        int (Right [Char]
    t) = case (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    isDigit [Char]
    t of
          (d :: [Char]
    d@(Char
    d0:[Char]
    _), [Char]
    t) | Char
    d0 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '0' -> case ReadS a
    forall a. Read a => ReadS a
    reads [Char]
    d of
            [(a
    d, [Char]
    "")] -> (a, [Char]) -> Maybe (a, [Char])
    forall a. a -> Maybe a
    Just (a
    d, [Char]
    t)
            [(a, [Char])]
    _ -> Maybe (a, [Char])
    forall a. Maybe a
    Nothing
          ([Char], [Char])
    _ -> Maybe (a, [Char])
    forall a. Maybe a
    Nothing
        collapseRaster :: t -> [Char] -> Maybe ([Bool], [Char])
    collapseRaster t
    0 [Char]
    t = ([Bool], [Char]) -> Maybe ([Bool], [Char])
    forall a. a -> Maybe a
    Just ([], [Char]
    t)
        collapseRaster t
    n [Char]
    t = case (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace [Char]
    t of
          (Char
    '0':[Char]
    t) -> Bool -> Maybe ([Bool], [Char]) -> Maybe ([Bool], [Char])
    forall {a} {b}. a -> Maybe ([a], b) -> Maybe ([a], b)
    prepend Bool
    False (t -> [Char] -> Maybe ([Bool], [Char])
    collapseRaster (t
    n t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1) [Char]
    t)
          (Char
    '1':[Char]
    t) -> Bool -> Maybe ([Bool], [Char]) -> Maybe ([Bool], [Char])
    forall {a} {b}. a -> Maybe ([a], b) -> Maybe ([a], b)
    prepend Bool
    True  (t -> [Char] -> Maybe ([Bool], [Char])
    collapseRaster (t
    n t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1) [Char]
    t)
          [Char]
    _ -> Maybe ([Bool], [Char])
    forall a. Maybe a
    Nothing
        prepend :: a -> Maybe ([a], b) -> Maybe ([a], b)
    prepend a
    _ Maybe ([a], b)
    Nothing = Maybe ([a], b)
    forall a. Maybe a
    Nothing
        prepend a
    b (Just ([a]
    bs, b
    t)) = ([a], b) -> Maybe ([a], b)
    forall a. a -> Maybe a
    Just (a
    ba -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    bs, b
    t)
        isSpace :: Char -> Bool
    isSpace Char
    c = Char
    c Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char]
    pbmSpace
        isDigit :: Char -> Bool
    isDigit Char
    c = Char
    c Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char]
    "0123456789"

    -- | Add padding bits at the end of each row to make the array width a
    --   multiple of 8 bits, required for binary PBM (P4) encoding.
    --
    padPBM :: PBM -> PBM
    padPBM :: PBM -> PBM
    padPBM PBM
    pbm
      | (Int
    pixelWidth Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    7) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = PBM
    pbm
      | Bool
    otherwise = PBM
    pbm{ pbmPixels = false paddedBounds // assocs (pbmPixels pbm) }
      where
        ((Int
    ylo, Int
    xlo), (Int
    yhi, Int
    xhi)) = BitArray (Int, Int) -> ((Int, Int), (Int, Int))
    forall i. Ix i => BitArray i -> (i, i)
    bounds (PBM -> BitArray (Int, Int)
    pbmPixels PBM
    pbm)
        pixelWidth :: Int
    pixelWidth = Int
    xhi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xlo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
        rowBytes :: Int
    rowBytes = (Int
    pixelWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    7) Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    3
        paddedWidth :: Int
    paddedWidth = Int
    rowBytes Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    3
        paddedBounds :: ((Int, Int), (Int, Int))
    paddedBounds = ((Int
    ylo, Int
    xlo), (Int
    yhi, Int
    xhi'))
        xhi' :: Int
    xhi' = Int
    paddedWidth Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    xlo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

    -- | Trim any padding bits, required for 'fold' operations to give
    --   meaningful results.
    --
    --   Fails for invalid 'PBM' with image width greater than array width.
    --
    trimPBM :: PBM -> Maybe PBM
    trimPBM :: PBM -> Maybe PBM
    trimPBM PBM
    pbm
      | PBM -> Int
    pbmWidth PBM
    pbm Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    pixelWidth = Maybe PBM
    forall a. Maybe a
    Nothing
      | PBM -> Int
    pbmWidth PBM
    pbm Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    pixelWidth = PBM -> Maybe PBM
    forall a. a -> Maybe a
    Just PBM
    pbm
      | Bool
    otherwise = PBM -> Maybe PBM
    forall a. a -> Maybe a
    Just PBM
    pbm{ pbmPixels = ixmap trimmedBounds id (pbmPixels pbm) }
      where
        ((Int
    ylo, Int
    xlo), (Int
    yhi, Int
    xhi)) = BitArray (Int, Int) -> ((Int, Int), (Int, Int))
    forall i. Ix i => BitArray i -> (i, i)
    bounds (PBM -> BitArray (Int, Int)
    pbmPixels PBM
    pbm)
        pixelWidth :: Int
    pixelWidth = Int
    xhi Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    xlo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
        trimmedBounds :: ((Int, Int), (Int, Int))
    trimmedBounds = ((Int
    ylo, Int
    xlo), (Int
    yhi, Int
    xhi'))
        xhi' :: Int
    xhi' = PBM -> Int
    pbmWidth PBM
    pbm Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    xlo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1

    -- | Trim then pad.  The resulting 'PBM' (if any) is suitable for
    --   encoding to binary PBM (P4), moreover its padding bits will
    --   be cleared.
    repadPBM :: PBM -> Maybe PBM
    repadPBM :: PBM -> Maybe PBM
    repadPBM PBM
    pbm = PBM -> PBM
    padPBM (PBM -> PBM) -> Maybe PBM -> Maybe PBM
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` PBM -> Maybe PBM
    trimPBM PBM
    pbm

    -- | Reverse the bit order of all bytes.
    --
    --   PBM specifies that the most significant bit is leftmost, which is
    --   opposite to the convention used by BitArray.
    --
    reverseByteBits :: BS.ByteString -> BS.ByteString
    reverseByteBits :: ByteString -> ByteString
    reverseByteBits = (Word8 -> Word8) -> ByteString -> ByteString
    BS.map Word8 -> Word8
    reverseBits

    -- | Fast reversal of the bit order of a byte using a lookup table.
    reverseBits :: Word8 -> Word8
    reverseBits :: Word8 -> Word8
    reverseBits Word8
    w = UArray Word8 Word8
    bitReversed UArray Word8 Word8 -> Word8 -> Word8
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    a i e -> i -> e
    U.! Word8
    w

    -- | A lookup table for bit order reversal.
    bitReversed :: U.UArray Word8 Word8
    bitReversed :: UArray Word8 Word8
    bitReversed = (Word8, Word8) -> [Word8] -> UArray Word8 Word8
    forall (a :: * -> * -> *) e i.
    (IArray a e, Ix i) =>
    (i, i) -> [e] -> a i e
    U.listArray (Word8, Word8)
    bs [ Word8 -> Word8
    bitReverse Word8
    w | Word8
    w <- (Word8, Word8) -> [Word8]
    forall a. Ix a => (a, a) -> [a]
    range (Word8, Word8)
    bs ]
      where bs :: (Word8, Word8)
    bs = (Word8
    forall a. Bounded a => a
    minBound, Word8
    forall a. Bounded a => a
    maxBound)

    -- | A slow way to reverse bit order.
    bitReverse :: Word8 -> Word8
    bitReverse :: Word8 -> Word8
    bitReverse = [Bool] -> Word8
    forall b. Bits b => [Bool] -> b
    fromListBE ([Bool] -> Word8) -> (Word8 -> [Bool]) -> Word8 -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> [Bool]
    forall b. Bits b => b -> [Bool]
    toListLE

    -- | White space characters as defined by the PBM specification.
    pbmSpace :: String
    pbmSpace :: [Char]
    pbmSpace = [Char]
    " \t\n\v\f\r"