    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TupleSections   #-}
    -- | Module dedicated of Radiance file decompression (.hdr or .pic) file.

    -- Radiance file format is used for High dynamic range imaging.

    module Codec.Picture.HDR( decodeHDR
                            , decodeHDRWithMetadata
                            , encodeHDR
                            , encodeRawHDR
                            , encodeRLENewStyleHDR
                            , writeHDR
                            , writeRLENewStyleHDR
                            ) where

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

    import Data.Bits( Bits, (.&.), (.|.), unsafeShiftL, unsafeShiftR )
    import Data.Char( ord, chr, isDigit )
    import Data.Word( Word8 )

    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid( (<>) )
    #endif

    import Control.Monad( when, foldM, foldM_, forM, forM_, unless )
    import Control.Monad.Trans.Class( lift )
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Lazy as L
    import qualified Data.ByteString.Char8 as BC

    import Data.List( partition )
    import Data.Binary( Binary( .. ), encode )
    import Data.Binary.Get( Get, getByteString, getWord8 )
    import Data.Binary.Put( putByteString, putLazyByteString )

    import Control.Monad.ST( ST, runST )
    import Foreign.Storable ( Storable )
    import Control.Monad.Primitive ( PrimState, PrimMonad )
    import qualified Data.Vector.Storable as V
    import qualified Data.Vector.Storable.Mutable as M

    import Codec.Picture.Metadata( Metadatas
                                 , SourceFormat( SourceHDR )
                                 , basicMetadata )
    import Codec.Picture.InternalHelper
    import Codec.Picture.Types
    import Codec.Picture.VectorByteConversion

    #if MIN_VERSION_transformers(0, 4, 0)
    import Control.Monad.Trans.Except( ExceptT, throwE, runExceptT )
    #else
    -- Transfomers 0.3 compat

    import Control.Monad.Trans.Error( Error, ErrorT, throwError, runErrorT )

    type ExceptT = ErrorT

    throwE :: (Monad m, Error e) => e -> ErrorT e m a
    throwE = throwError

    runExceptT :: ErrorT e m a -> m (Either e a)
    runExceptT = runErrorT
    #endif

    {-# INLINE (.<<.) #-}
    (.<<.), (.>>.) :: (Bits a) => a -> Int -> a
    .<<. :: forall a. Bits a => a -> Int -> a
    (.<<.) = a -> Int -> a
    forall a. Bits a => a -> Int -> a
    unsafeShiftL
    .>>. :: forall a. Bits a => a -> Int -> a
    (.>>.) = a -> Int -> a
    forall a. Bits a => a -> Int -> a
    unsafeShiftR

    {-# INLINE (.<-.) #-}
    (.<-.) :: (PrimMonad m, Storable a)
           => M.STVector (PrimState m) a -> Int -> a -> m ()
    .<-. :: forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    (.<-.) = MVector (PrimState m) a -> Int -> a -> m ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    M.write
             {-M.unsafeWrite-}

    type HDRReader s a = ExceptT String (ST s) a

    data RGBE = RGBE !Word8 !Word8 !Word8 !Word8

    instance Binary RGBE where
        put :: RGBE -> Put
    put (RGBE Word8
    r Word8
    g Word8
    b Word8
    e) = Word8 -> Put
    forall t. Binary t => t -> Put
    put Word8
    r Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    forall t. Binary t => t -> Put
    put Word8
    g Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    forall t. Binary t => t -> Put
    put Word8
    b Put -> Put -> Put
    forall a b. PutM a -> PutM b -> PutM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Word8 -> Put
    forall t. Binary t => t -> Put
    put Word8
    e
        get :: Get RGBE
    get = Word8 -> Word8 -> Word8 -> Word8 -> RGBE
    RGBE (Word8 -> Word8 -> Word8 -> Word8 -> RGBE)
    -> Get Word8 -> Get (Word8 -> Word8 -> Word8 -> RGBE)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word8
    forall t. Binary t => Get t
    get Get (Word8 -> Word8 -> Word8 -> RGBE)
    -> Get Word8 -> Get (Word8 -> Word8 -> RGBE)
    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
    forall t. Binary t => Get t
    get Get (Word8 -> Word8 -> RGBE) -> Get Word8 -> Get (Word8 -> RGBE)
    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
    forall t. Binary t => Get t
    get Get (Word8 -> RGBE) -> Get Word8 -> Get RGBE
    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
    forall t. Binary t => Get t
    get

    checkLineLength :: RGBE -> Int
    checkLineLength :: RGBE -> Int
    checkLineLength (RGBE Word8
    _ Word8
    _ Word8
    a Word8
    b) =
        (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    a Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    .<<. Int
    8) Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    b

    isNewRunLengthMarker :: RGBE -> Bool
    isNewRunLengthMarker :: RGBE -> Bool
    isNewRunLengthMarker (RGBE Word8
    2 Word8
    2 Word8
    _ Word8
    _) = Bool
    True
    isNewRunLengthMarker RGBE
    _ = Bool
    False

    data RadianceFormat =
          FormatRGBE
        | FormatXYZE

    radiance32bitRleRGBEFormat, radiance32bitRleXYZEFromat :: B.ByteString
    radiance32bitRleRGBEFormat :: ByteString
    radiance32bitRleRGBEFormat = String -> ByteString
    BC.pack String
    "32-bit_rle_rgbe"
    radiance32bitRleXYZEFromat :: ByteString
    radiance32bitRleXYZEFromat = String -> ByteString
    BC.pack String
    "32-bit_rle_xyze"

    instance Binary RadianceFormat where
      put :: RadianceFormat -> Put
    put RadianceFormat
    FormatRGBE = ByteString -> Put
    putByteString ByteString
    radiance32bitRleRGBEFormat
      put RadianceFormat
    FormatXYZE = ByteString -> Put
    putByteString ByteString
    radiance32bitRleXYZEFromat

      get :: Get RadianceFormat
    get = Int -> Get ByteString
    getByteString (ByteString -> Int
    B.length ByteString
    radiance32bitRleRGBEFormat) Get ByteString
    -> (ByteString -> Get RadianceFormat) -> Get RadianceFormat
    forall a b. Get a -> (a -> Get b) -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> Get RadianceFormat
    forall {f :: * -> *}. MonadFail f => ByteString -> f RadianceFormat
    format
        where format :: ByteString -> f RadianceFormat
    format ByteString
    sig
                | ByteString
    sig ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    radiance32bitRleRGBEFormat = RadianceFormat -> f RadianceFormat
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure RadianceFormat
    FormatRGBE
                | ByteString
    sig ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    radiance32bitRleXYZEFromat = RadianceFormat -> f RadianceFormat
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure RadianceFormat
    FormatXYZE
                | Bool
    otherwise = String -> f RadianceFormat
    forall a. String -> f a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Unrecognized Radiance format"

    toRGBE :: PixelRGBF -> RGBE
    toRGBE :: PixelRGBF -> RGBE
    toRGBE (PixelRGBF Float
    r Float
    g Float
    b)
        | Float
    d Float -> Float -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Float
    1e-32 = Word8 -> Word8 -> Word8 -> Word8 -> RGBE
    RGBE Word8
    0 Word8
    0 Word8
    0 Word8
    0
        | Bool
    otherwise = Word8 -> Word8 -> Word8 -> Word8 -> RGBE
    RGBE (Float -> Word8
    fix Float
    r) (Float -> Word8
    fix Float
    g) (Float -> Word8
    fix Float
    b) (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    128)
      where d :: Float
    d = [Float] -> Float
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [Float
    r, Float
    g, Float
    b]
            e :: Int
    e = Float -> Int
    forall a. RealFloat a => a -> Int
    exponent Float
    d
            coeff :: Float
    coeff = Float -> Float
    forall a. RealFloat a => a -> a
    significand Float
    d Float -> Float -> Float
    forall a. Num a => a -> a -> a
    *  Float
    255.9999 Float -> Float -> Float
    forall a. Fractional a => a -> a -> a
    / Float
    d
            fix :: Float -> Word8
    fix Float
    v = Float -> Word8
    forall b. Integral b => Float -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate (Float -> Word8) -> Float -> Word8
    forall a b. (a -> b) -> a -> b
    $ Float
    v Float -> Float -> Float
    forall a. Num a => a -> a -> a
    * Float
    coeff

    dropUntil :: Word8 -> Get ()
    dropUntil :: Word8 -> Get ()
    dropUntil Word8
    c = Get Word8
    getWord8 Get Word8 -> (Word8 -> 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
    >>= Word8 -> Get ()
    inner
      where inner :: Word8 -> Get ()
    inner Word8
    val | Word8
    val Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    c = () -> Get ()
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
            inner Word8
    _ = Get Word8
    getWord8 Get Word8 -> (Word8 -> 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
    >>= Word8 -> Get ()
    inner

    getUntil :: (Word8 -> Bool) -> B.ByteString -> Get B.ByteString
    getUntil :: (Word8 -> Bool) -> ByteString -> Get ByteString
    getUntil Word8 -> Bool
    f ByteString
    initialAcc = 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
    >>= ByteString -> Word8 -> Get ByteString
    inner ByteString
    initialAcc
      where inner :: ByteString -> Word8 -> Get ByteString
    inner ByteString
    acc Word8
    c | Word8 -> Bool
    f Word8
    c = ByteString -> Get ByteString
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ByteString
    acc
            inner ByteString
    acc Word8
    c = 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
    >>= ByteString -> Word8 -> Get ByteString
    inner (ByteString -> Word8 -> ByteString
    B.snoc ByteString
    acc Word8
    c)

    data RadianceHeader = RadianceHeader
      { RadianceHeader -> [(ByteString, ByteString)]
    radianceInfos :: [(B.ByteString, B.ByteString)]
      , RadianceHeader -> RadianceFormat
    radianceFormat :: RadianceFormat
      , RadianceHeader -> Int
    radianceHeight :: !Int
      , RadianceHeader -> Int
    radianceWidth  :: !Int
      , RadianceHeader -> ByteString
    radianceData   :: L.ByteString
      }

    radianceFileSignature :: B.ByteString
    radianceFileSignature :: ByteString
    radianceFileSignature = String -> ByteString
    BC.pack String
    "#?RADIANCE\n"

    unpackColor :: L.ByteString -> Int -> RGBE
    unpackColor :: ByteString -> Int -> RGBE
    unpackColor ByteString
    str Int
    idx = Word8 -> Word8 -> Word8 -> Word8 -> RGBE
    RGBE (Int -> Word8
    at Int
    0) (Int -> Word8
    at Int
    1) (Int -> Word8
    at Int
    2) (Int -> Word8
    at Int
    3)
      where at :: Int -> Word8
    at Int
    n = HasCallStack => ByteString -> Int64 -> Word8
    ByteString -> Int64 -> Word8
    L.index ByteString
    str (Int64 -> Word8) -> (Int -> Int64) -> Int -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n

    storeColor :: M.STVector s Word8 -> Int -> RGBE -> ST s ()
    storeColor :: forall s. STVector s Word8 -> Int -> RGBE -> ST s ()
    storeColor STVector s Word8
    vec Int
    idx (RGBE Word8
    r Word8
    g Word8
    b Word8
    e) = do
        (STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    .<-. (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    0)) Word8
    r
        (STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    .<-. (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) Word8
    g
        (STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    .<-. (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2)) Word8
    b
        (STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    .<-. (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    3)) Word8
    e

    parsePair :: Char -> Get (B.ByteString, B.ByteString)
    parsePair :: Char -> Get (ByteString, ByteString)
    parsePair Char
    firstChar = do
        let eol :: a -> Bool
    eol a
    c = a
    c a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    '\n')
        line <- (Word8 -> Bool) -> ByteString -> Get ByteString
    getUntil Word8 -> Bool
    forall {a}. (Eq a, Num a) => a -> Bool
    eol ByteString
    B.empty
        case BC.split '=' line of
          [] -> (ByteString, ByteString) -> Get (ByteString, ByteString)
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Char -> ByteString
    BC.singleton Char
    firstChar, ByteString
    B.empty)
          [ByteString
    val] -> (ByteString, ByteString) -> Get (ByteString, ByteString)
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Char -> ByteString
    BC.singleton Char
    firstChar, ByteString
    val)
          [ByteString
    key, ByteString
    val] -> (ByteString, ByteString) -> Get (ByteString, ByteString)
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Char -> ByteString
    BC.singleton Char
    firstChar ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    key, ByteString
    val)
          (ByteString
    key : [ByteString]
    vals) -> (ByteString, ByteString) -> Get (ByteString, ByteString)
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Char -> ByteString
    BC.singleton Char
    firstChar ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    key, [ByteString] -> ByteString
    B.concat [ByteString]
    vals)

    decodeInfos :: Get [(B.ByteString, B.ByteString)]
    decodeInfos :: Get [(ByteString, ByteString)]
    decodeInfos = do
        char <- Get Char
    getChar8
        case char of
          -- comment

          Char
    '#' -> Word8 -> Get ()
    dropUntil (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    '\n') Get ()
    -> Get [(ByteString, ByteString)] -> Get [(ByteString, ByteString)]
    forall a b. Get a -> Get b -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Get [(ByteString, ByteString)]
    decodeInfos
          -- end of header, no more information

          Char
    '\n' -> [(ByteString, ByteString)] -> Get [(ByteString, ByteString)]
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
          -- Classical parsing

          Char
    c -> (:) ((ByteString, ByteString)
     -> [(ByteString, ByteString)] -> [(ByteString, ByteString)])
    -> Get (ByteString, ByteString)
    -> Get ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Char -> Get (ByteString, ByteString)
    parsePair Char
    c Get ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
    -> Get [(ByteString, ByteString)] -> Get [(ByteString, 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 [(ByteString, ByteString)]
    decodeInfos

    -- | Decode an HDR (radiance) image, the resulting image can be:

    --

    --  * 'ImageRGBF'

    --

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

    -- | Equivalent to decodeHDR but with aditional metadatas.

    decodeHDRWithMetadata :: B.ByteString -> Either String (DynamicImage, Metadatas)
    decodeHDRWithMetadata :: ByteString -> Either String (DynamicImage, Metadatas)
    decodeHDRWithMetadata ByteString
    str = (forall s. ST s (Either String (DynamicImage, Metadatas)))
    -> Either String (DynamicImage, Metadatas)
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s (Either String (DynamicImage, Metadatas)))
     -> Either String (DynamicImage, Metadatas))
    -> (forall s. ST s (Either String (DynamicImage, Metadatas)))
    -> Either String (DynamicImage, Metadatas)
    forall a b. (a -> b) -> a -> b
    $ ExceptT String (ST s) (DynamicImage, Metadatas)
    -> ST s (Either String (DynamicImage, Metadatas))
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT String (ST s) (DynamicImage, Metadatas)
     -> ST s (Either String (DynamicImage, Metadatas)))
    -> ExceptT String (ST s) (DynamicImage, Metadatas)
    -> ST s (Either String (DynamicImage, Metadatas))
    forall a b. (a -> b) -> a -> b
    $
      case Get RadianceHeader -> ByteString -> Either String RadianceHeader
    forall a. Get a -> ByteString -> Either String a
    runGet Get RadianceHeader
    decodeHeader (ByteString -> Either String RadianceHeader)
    -> ByteString -> Either String RadianceHeader
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    L.fromChunks [ByteString
    str] of
        Left String
    err -> String -> ExceptT String (ST s) (DynamicImage, Metadatas)
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE String
    err
        Right RadianceHeader
    rez ->
          let meta :: Metadatas
    meta = SourceFormat -> Int -> Int -> Metadatas
    forall nSize.
    Integral nSize =>
    SourceFormat -> nSize -> nSize -> Metadatas
    basicMetadata SourceFormat
    SourceHDR (Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ RadianceHeader -> Int
    radianceWidth RadianceHeader
    rez) (Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ RadianceHeader -> Int
    radianceHeight RadianceHeader
    rez) in
          (, Metadatas
    meta) (DynamicImage -> (DynamicImage, Metadatas))
    -> (Image PixelRGBF -> DynamicImage)
    -> Image PixelRGBF
    -> (DynamicImage, Metadatas)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Image PixelRGBF -> DynamicImage
    ImageRGBF (Image PixelRGBF -> (DynamicImage, Metadatas))
    -> ExceptT String (ST s) (Image PixelRGBF)
    -> ExceptT String (ST s) (DynamicImage, Metadatas)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (RadianceHeader -> HDRReader s (MutableImage s PixelRGBF)
    forall s. RadianceHeader -> HDRReader s (MutableImage s PixelRGBF)
    decodeRadiancePicture RadianceHeader
    rez HDRReader s (MutableImage s PixelRGBF)
    -> (MutableImage s PixelRGBF
        -> ExceptT String (ST s) (Image PixelRGBF))
    -> ExceptT String (ST s) (Image PixelRGBF)
    forall a b.
    ExceptT String (ST s) a
    -> (a -> ExceptT String (ST s) b) -> ExceptT String (ST s) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ST s (Image PixelRGBF) -> ExceptT String (ST s) (Image PixelRGBF)
    forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s (Image PixelRGBF) -> ExceptT String (ST s) (Image PixelRGBF))
    -> (MutableImage s PixelRGBF -> ST s (Image PixelRGBF))
    -> MutableImage s PixelRGBF
    -> ExceptT String (ST s) (Image PixelRGBF)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MutableImage s PixelRGBF -> ST s (Image PixelRGBF)
    MutableImage (PrimState (ST s)) PixelRGBF -> ST s (Image PixelRGBF)
    forall a (m :: * -> *).
    (Storable (PixelBaseComponent a), PrimMonad m) =>
    MutableImage (PrimState m) a -> m (Image a)
    unsafeFreezeImage)

    getChar8 :: Get Char
    getChar8 :: Get Char
    getChar8 = Int -> Char
    chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Char) -> Get Word8 -> Get Char
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word8
    getWord8

    isSign :: Char -> Bool
    isSign :: Char -> Bool
    isSign Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '+' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-'

    isAxisLetter :: Char -> Bool
    isAxisLetter :: Char -> Bool
    isAxisLetter Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'X' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    'Y'

    decodeNum :: Get Int
    decodeNum :: Get Int
    decodeNum = do
        sign <- Get Char
    getChar8
        letter <- getChar8
        space <- getChar8

        unless (isSign sign && isAxisLetter letter && space == ' ')
               (fail "Invalid radiance size declaration")

        let numDec Int
    acc Char
    c | Char -> Bool
    isDigit Char
    c =
                Get Char
    getChar8 Get Char -> (Char -> Get Int) -> Get Int
    forall a b. Get a -> (a -> Get b) -> Get b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> Char -> Get Int
    numDec (Int
    acc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Char -> Int
    ord Char
    '0')
            numDec Int
    acc Char
    _
                | Char
    sign Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '-' = Int -> Get Int
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int -> Get Int) -> Int -> Get Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Num a => a -> a
    negate Int
    acc
                | Bool
    otherwise = Int -> Get Int
    forall a. a -> Get a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    acc

        getChar8 >>= numDec 0

    copyPrevColor :: M.STVector s Word8 -> Int -> ST s ()
    copyPrevColor :: forall s. STVector s Word8 -> Int -> ST s ()
    copyPrevColor STVector s Word8
    scanLine Int
    idx = do
        r <- STVector s Word8
    MVector (PrimState (ST s)) Word8
    scanLine MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    4)
        g <- scanLine `M.unsafeRead` (idx - 3)
        b <- scanLine `M.unsafeRead` (idx - 2)
        e <- scanLine `M.unsafeRead` (idx - 1)

        (scanLine `M.unsafeWrite` (idx + 0)) r
        (scanLine `M.unsafeWrite` (idx + 1)) g
        (scanLine `M.unsafeWrite` (idx + 2)) b
        (scanLine `M.unsafeWrite` (idx + 3)) e

    oldStyleRLE :: L.ByteString -> Int -> M.STVector s Word8
                -> HDRReader s Int
    oldStyleRLE :: forall s. ByteString -> Int -> STVector s Word8 -> HDRReader s Int
    oldStyleRLE ByteString
    inputData Int
    initialIdx STVector s Word8
    scanLine = Int -> Int -> Int -> ExceptT String (ST s) Int
    inner Int
    initialIdx Int
    0 Int
    0
      where maxOutput :: Int
    maxOutput = STVector s Word8 -> Int
    forall a s. Storable a => MVector s a -> Int
    M.length STVector s Word8
    scanLine
            maxInput :: Int
    maxInput = Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    L.length ByteString
    inputData

            inner :: Int -> Int -> Int -> ExceptT String (ST s) Int
    inner Int
    readIdx Int
    writeIdx Int
    _
                | Int
    readIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxInput Bool -> Bool -> Bool
    || Int
    writeIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxOutput = Int -> ExceptT String (ST s) Int
    forall a. a -> ExceptT String (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    readIdx
            inner Int
    readIdx Int
    writeIdx Int
    shift = do
              let color :: RGBE
    color@(RGBE Word8
    r Word8
    g Word8
    b Word8
    e) = ByteString -> Int -> RGBE
    unpackColor ByteString
    inputData Int
    readIdx
                  isRun :: Bool
    isRun = Word8
    r Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    1 Bool -> Bool -> Bool
    && Word8
    g Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    1 Bool -> Bool -> Bool
    && Word8
    b Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    1

              if Bool -> Bool
    not Bool
    isRun
                then do
                  ST s () -> ExceptT String (ST s) ()
    forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> ExceptT String (ST s) ())
    -> ST s () -> ExceptT String (ST s) ()
    forall a b. (a -> b) -> a -> b
    $ STVector s Word8 -> Int -> RGBE -> ST s ()
    forall s. STVector s Word8 -> Int -> RGBE -> ST s ()
    storeColor STVector s Word8
    scanLine Int
    writeIdx RGBE
    color
                  Int -> Int -> Int -> ExceptT String (ST s) Int
    inner (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4) Int
    0

                else do
                  let count :: Int
    count = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    e Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    .<<. Int
    shift
                  ST s () -> ExceptT String (ST s) ()
    forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> ExceptT String (ST s) ())
    -> ST s () -> ExceptT String (ST s) ()
    forall a b. (a -> b) -> a -> b
    $ [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    0 .. Int
    count] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    i -> STVector s Word8 -> Int -> ST s ()
    forall s. STVector s Word8 -> Int -> ST s ()
    copyPrevColor STVector s Word8
    scanLine (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    i)
                  Int -> Int -> Int -> ExceptT String (ST s) Int
    inner (Int
    readIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4) (Int
    writeIdx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    count) (Int
    shift Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    8)

    newStyleRLE :: L.ByteString -> Int -> M.STVector s Word8
                -> HDRReader s Int
    newStyleRLE :: forall s. ByteString -> Int -> STVector s Word8 -> HDRReader s Int
    newStyleRLE ByteString
    inputData Int
    initialIdx STVector s Word8
    scanline = (Int -> Int -> ExceptT String (ST s) Int)
    -> Int -> [Int] -> ExceptT String (ST s) Int
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM Int -> Int -> ExceptT String (ST s) Int
    inner Int
    initialIdx [Int
    0 .. Int
    3]
      where dataAt :: Int -> ExceptT String (ST s) Word8
    dataAt Int
    idx
                | Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxInput = String -> ExceptT String (ST s) Word8
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE (String -> ExceptT String (ST s) Word8)
    -> String -> ExceptT String (ST s) Word8
    forall a b. (a -> b) -> a -> b
    $ String
    "Read index out of bound (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    idx String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                | Bool
    otherwise = Word8 -> ExceptT String (ST s) Word8
    forall a. a -> ExceptT String (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Word8 -> ExceptT String (ST s) Word8)
    -> Word8 -> ExceptT String (ST s) Word8
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => ByteString -> Int64 -> Word8
    ByteString -> Int64 -> Word8
    L.index ByteString
    inputData (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    idx)

            maxOutput :: Int
    maxOutput = STVector s Word8 -> Int
    forall a s. Storable a => MVector s a -> Int
    M.length STVector s Word8
    scanline
            maxInput :: Int
    maxInput = Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    L.length ByteString
    inputData
            stride :: Int
    stride = Int
    4

            strideSet :: Int -> Int -> Word8 -> ExceptT String (ST s) Int
    strideSet Int
    count Int
    destIndex Word8
    _ | Int
    endIndex Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxOutput Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    stride =
              String -> ExceptT String (ST s) Int
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE (String -> ExceptT String (ST s) Int)
    -> String -> ExceptT String (ST s) Int
    forall a b. (a -> b) -> a -> b
    $ String
    "Out of bound HDR scanline " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    endIndex String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " (max " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    maxOutput String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
                where endIndex :: Int
    endIndex = Int
    destIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    stride
            strideSet Int
    count Int
    destIndex Word8
    val = Int -> Int -> ExceptT String (ST s) Int
    aux Int
    destIndex Int
    count
                where aux :: Int -> Int -> ExceptT String (ST s) Int
    aux Int
    i Int
    0 =  Int -> ExceptT String (ST s) Int
    forall a. a -> ExceptT String (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    i
                      aux Int
    i Int
    c = do
                        ST s () -> ExceptT String (ST s) ()
    forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s () -> ExceptT String (ST s) ())
    -> ST s () -> ExceptT String (ST s) ()
    forall a b. (a -> b) -> a -> b
    $ (STVector s Word8
    MVector (PrimState (ST s)) Word8
    scanline MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    .<-. Int
    i) Word8
    val
                        Int -> Int -> ExceptT String (ST s) Int
    aux (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    stride) (Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

            strideCopy :: Int -> Int -> Int -> ExceptT String (ST s) Int
    strideCopy Int
    _ Int
    count Int
    destIndex
                | Int
    writeEndBound Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    maxOutput Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    stride = String -> ExceptT String (ST s) Int
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE String
    "Out of bound HDR scanline"
                    where writeEndBound :: Int
    writeEndBound = Int
    destIndex Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    stride
            strideCopy Int
    sourceIndex Int
    count Int
    destIndex = Int -> Int -> Int -> ExceptT String (ST s) Int
    aux Int
    sourceIndex Int
    destIndex Int
    count
              where aux :: Int -> Int -> Int -> ExceptT String (ST s) Int
    aux Int
    _ Int
    j Int
    0 = Int -> ExceptT String (ST s) Int
    forall a. a -> ExceptT String (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    j
                    aux Int
    i Int
    j Int
    c = do
                        val <- Int -> ExceptT String (ST s) Word8
    dataAt Int
    i
                        lift $ (scanline .<-. j) val
                        aux (i + 1) (j + stride) (c - 1)

            inner :: Int -> Int -> ExceptT String (ST s) Int
    inner Int
    readIdx Int
    writeIdx
                | Int
    readIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxInput Bool -> Bool -> Bool
    || Int
    writeIdx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxOutput = Int -> ExceptT String (ST s) Int
    forall a. a -> ExceptT String (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    readIdx
            inner Int
    readIdx Int
    writeIdx = do
              code <- Int -> ExceptT String (ST s) Word8
    dataAt Int
    readIdx
              if code > 128
                then do
                  let repeatCount = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    code Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    0x7F
                  newVal <- dataAt $ readIdx + 1
                  endIndex <- strideSet repeatCount writeIdx newVal
                  inner (readIdx + 2) endIndex

                else do
                  let iCode = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    code
                  endIndex <- strideCopy (readIdx + 1) iCode writeIdx
                  inner (readIdx + iCode + 1) endIndex

    instance Binary RadianceHeader where
        get :: Get RadianceHeader
    get = Get RadianceHeader
    decodeHeader
        put :: RadianceHeader -> Put
    put RadianceHeader
    hdr = do
            ByteString -> Put
    putByteString ByteString
    radianceFileSignature
            ByteString -> Put
    putByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    BC.pack String
    "FORMAT="
            RadianceFormat -> Put
    forall t. Binary t => t -> Put
    put (RadianceFormat -> Put) -> RadianceFormat -> Put
    forall a b. (a -> b) -> a -> b
    $ RadianceHeader -> RadianceFormat
    radianceFormat RadianceHeader
    hdr
            let sizeString :: ByteString
    sizeString =
                  String -> ByteString
    BC.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    "\n\n-Y " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (RadianceHeader -> Int
    radianceHeight RadianceHeader
    hdr)
                            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " +X " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (RadianceHeader -> Int
    radianceWidth RadianceHeader
    hdr) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
            ByteString -> Put
    putByteString ByteString
    sizeString
            ByteString -> Put
    putLazyByteString (ByteString -> Put) -> ByteString -> Put
    forall a b. (a -> b) -> a -> b
    $ RadianceHeader -> ByteString
    radianceData RadianceHeader
    hdr

    decodeHeader :: Get RadianceHeader
    decodeHeader :: Get RadianceHeader
    decodeHeader = do
        sig <- Int -> Get ByteString
    getByteString (Int -> Get ByteString) -> Int -> Get ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    B.length ByteString
    radianceFileSignature
        when (sig /= radianceFileSignature)
             (fail "Invalid radiance file signature")

        infos <- decodeInfos
        let formatKey = String -> ByteString
    BC.pack String
    "FORMAT"
        case partition (\(ByteString
    k,ByteString
    _) -> ByteString
    k ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    formatKey) infos of
          ([(ByteString, ByteString)]
    _, []) -> String -> Get RadianceHeader
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "No radiance format specified"
          ([(ByteString, ByteString)]
    info, [(ByteString
    _, ByteString
    formatString)]) ->
            case Get RadianceFormat -> ByteString -> Either String RadianceFormat
    forall a. Get a -> ByteString -> Either String a
    runGet Get RadianceFormat
    forall t. Binary t => Get t
    get (ByteString -> Either String RadianceFormat)
    -> ByteString -> Either String RadianceFormat
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> ByteString
    L.fromChunks [ByteString
    formatString] of
              Left String
    err -> String -> Get RadianceHeader
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    err
              Right RadianceFormat
    format -> do
                  (n1, n2, b) <- (,,) (Int -> Int -> ByteString -> (Int, Int, ByteString))
    -> Get Int -> Get (Int -> ByteString -> (Int, Int, ByteString))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Int
    decodeNum
                                      Get (Int -> ByteString -> (Int, Int, ByteString))
    -> Get Int -> Get (ByteString -> (Int, Int, 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 Int
    decodeNum
                                      Get (ByteString -> (Int, Int, ByteString))
    -> Get ByteString -> Get (Int, Int, 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 ByteString
    getRemainingBytes
                  return . RadianceHeader info format n1 n2 $ L.fromChunks [b]

          ([(ByteString, ByteString)], [(ByteString, ByteString)])
    _ -> String -> Get RadianceHeader
    forall a. String -> Get a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Multiple radiance format specified"

    toFloat :: RGBE -> PixelRGBF
    toFloat :: RGBE -> PixelRGBF
    toFloat (RGBE Word8
    r Word8
    g Word8
    b Word8
    e) = Float -> Float -> Float -> PixelRGBF
    PixelRGBF Float
    rf Float
    gf Float
    bf
      where f :: Float
    f = Integer -> Int -> Float
    forall a. RealFloat a => Integer -> Int -> a
    encodeFloat Integer
    1 (Int -> Float) -> Int -> Float
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    e Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Int
    128 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    8)
            rf :: Float
    rf = (Word8 -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    r Float -> Float -> Float
    forall a. Num a => a -> a -> a
    + Float
    0.0) Float -> Float -> Float
    forall a. Num a => a -> a -> a
    * Float
    f
            gf :: Float
    gf = (Word8 -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    g Float -> Float -> Float
    forall a. Num a => a -> a -> a
    + Float
    0.0) Float -> Float -> Float
    forall a. Num a => a -> a -> a
    * Float
    f
            bf :: Float
    bf = (Word8 -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    b Float -> Float -> Float
    forall a. Num a => a -> a -> a
    + Float
    0.0) Float -> Float -> Float
    forall a. Num a => a -> a -> a
    * Float
    f

    encodeScanlineColor :: M.STVector s Word8
                        -> M.STVector s Word8
                        -> Int
                        -> ST s Int
    encodeScanlineColor :: forall s. STVector s Word8 -> STVector s Word8 -> Int -> ST s Int
    encodeScanlineColor STVector s Word8
    vec STVector s Word8
    outVec Int
    outIdx = do
        val <- STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    0
        runLength 1 0 val 1 outIdx
      where maxIndex :: Int
    maxIndex = STVector s Word8 -> Int
    forall a s. Storable a => MVector s a -> Int
    M.length STVector s Word8
    vec

            pushRun :: Int -> Word8 -> Int -> ST s Int
    pushRun Int
    len Word8
    val Int
    at = do
                (STVector s Word8
    MVector (PrimState (ST s)) Word8
    outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    at) (Word8 -> ST s ()) -> Word8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Int
    len Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Int
    0x80
                (STVector s Word8
    MVector (PrimState (ST s)) Word8
    outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` (Int
    at Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)) Word8
    val
                Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    at Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2

            pushData :: Int -> Int -> Int -> ST s Int
    pushData Int
    start Int
    len Int
    at = do
                (STVector s Word8
    MVector (PrimState (ST s)) Word8
    outVec MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    at) (Word8 -> ST s ()) -> Word8 -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len
                let first :: Int
    first = Int
    start Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    len
                    end :: Int
    end = Int
    start Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                    offset :: Int
    offset = Int
    at Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    first Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                [Int] -> (Int -> ST s ()) -> ST s ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Int
    first .. Int
    end] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    i -> do
                    v <- STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    i
                    (outVec `M.unsafeWrite` (offset + i)) v

                Int -> ST s Int
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> ST s Int) -> Int -> ST s Int
    forall a b. (a -> b) -> a -> b
    $ Int
    at Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1

            -- End of scanline, empty the thing

            runLength :: Int -> Int -> Word8 -> Int -> Int -> ST s Int
    runLength Int
    run Int
    cpy Word8
    prev Int
    idx Int
    at | Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    maxIndex =
                case (Int
    run, Int
    cpy) of
                    (Int
    0, Int
    0) -> Int -> ST s Int
    forall a. a -> ST s a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    at
                    (Int
    0, Int
    n) -> Int -> Int -> Int -> ST s Int
    pushData Int
    idx Int
    n Int
    at
                    (Int
    n, Int
    0) -> Int -> Word8 -> Int -> ST s Int
    pushRun Int
    n Word8
    prev Int
    at
                    (Int
    _, Int
    _) -> String -> ST s Int
    forall a. HasCallStack => String -> a
    error String
    "HDR - Run length algorithm is wrong"

            -- full runlength, we must write the packet

            runLength r :: Int
    r@Int
    127   Int
    _ Word8
    prev Int
    idx Int
    at = do
                val <- STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    idx
                pushRun r prev at >>=
                    runLength 1 0 val (idx + 1)

            -- full copy, we must write the packet

            runLength   Int
    _ c :: Int
    c@Int
    127    Word8
    _ Int
    idx Int
    at = do
                val <- STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    idx
                pushData idx c at >>=
                    runLength 1 0 val (idx + 1)

            runLength Int
    n Int
    0 Word8
    prev Int
    idx Int
    at = do
                val <- STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    idx
                case val == prev of
                   Bool
    True -> Int -> Int -> Word8 -> Int -> Int -> ST s Int
    runLength (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int
    0 Word8
    prev (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int
    at
                   Bool
    False | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    4 -> Int -> Int -> Word8 -> Int -> Int -> ST s Int
    runLength Int
    0 (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Word8
    val (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Int
    at
                   Bool
    False ->
                        Int -> Word8 -> Int -> ST s Int
    pushRun Int
    n Word8
    prev Int
    at ST s Int -> (Int -> ST s Int) -> ST s Int
    forall a b. ST s a -> (a -> ST s b) -> ST s b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                            Int -> Int -> Word8 -> Int -> Int -> ST s Int
    runLength Int
    1 Int
    0 Word8
    val (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

            runLength Int
    0 Int
    n Word8
    prev Int
    idx Int
    at = do
                val <- STVector s Word8
    MVector (PrimState (ST s)) Word8
    vec MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    MVector (PrimState m) a -> Int -> m a
    `M.unsafeRead` Int
    idx
                if val /= prev
                   then runLength 0 (n + 1) val (idx + 1) at
                   else
                    pushData (idx - 1) (n - 1) at >>=
                        runLength (2 :: Int) 0 val (idx + 1)

            runLength Int
    _ Int
    _ Word8
    _ Int
    _ Int
    _ =
                String -> ST s Int
    forall a. HasCallStack => String -> a
    error String
    "HDR RLE inconsistent state"

    -- | Write an High dynamic range image into a radiance

    -- image file on disk.

    writeHDR :: FilePath -> Image PixelRGBF -> IO ()
    writeHDR :: String -> Image PixelRGBF -> IO ()
    writeHDR String
    filename Image PixelRGBF
    img = String -> ByteString -> IO ()
    L.writeFile String
    filename (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Image PixelRGBF -> ByteString
    encodeHDR Image PixelRGBF
    img

    -- | Write a RLE encoded High dynamic range image into a radiance

    -- image file on disk.

    writeRLENewStyleHDR :: FilePath -> Image PixelRGBF -> IO ()
    writeRLENewStyleHDR :: String -> Image PixelRGBF -> IO ()
    writeRLENewStyleHDR String
    filename Image PixelRGBF
    img =
        String -> ByteString -> IO ()
    L.writeFile String
    filename (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Image PixelRGBF -> ByteString
    encodeRLENewStyleHDR Image PixelRGBF
    img

    -- | Encode an High dynamic range image into a radiance image

    -- file format.

    -- Alias for encodeRawHDR

    encodeHDR :: Image PixelRGBF -> L.ByteString
    encodeHDR :: Image PixelRGBF -> ByteString
    encodeHDR = Image PixelRGBF -> ByteString
    encodeRawHDR

    -- | Encode an High dynamic range image into a radiance image

    -- file format. without compression

    encodeRawHDR :: Image PixelRGBF -> L.ByteString
    encodeRawHDR :: Image PixelRGBF -> ByteString
    encodeRawHDR Image PixelRGBF
    pic = RadianceHeader -> ByteString
    forall a. Binary a => a -> ByteString
    encode RadianceHeader
    descriptor
      where
        newImage :: Image PixelRGBA8
    newImage = (PixelRGBF -> PixelRGBA8) -> Image PixelRGBF -> Image PixelRGBA8
    forall a b. (Pixel a, Pixel b) => (a -> b) -> Image a -> Image b
    pixelMap PixelRGBF -> PixelRGBA8
    rgbeInRgba Image PixelRGBF
    pic
        -- we are cheating to death here, the layout we want

        -- correspond to the layout of pixelRGBA8, so we

        -- convert

        rgbeInRgba :: PixelRGBF -> PixelRGBA8
    rgbeInRgba PixelRGBF
    pixel = Word8 -> Word8 -> Word8 -> Word8 -> PixelRGBA8
    PixelRGBA8 Word8
    r Word8
    g Word8
    b Word8
    e
          where RGBE Word8
    r Word8
    g Word8
    b Word8
    e = PixelRGBF -> RGBE
    toRGBE PixelRGBF
    pixel

        descriptor :: RadianceHeader
    descriptor = RadianceHeader
            { radianceInfos :: [(ByteString, ByteString)]
    radianceInfos = []
            , radianceFormat :: RadianceFormat
    radianceFormat = RadianceFormat
    FormatRGBE
            , radianceHeight :: Int
    radianceHeight = Image PixelRGBF -> Int
    forall a. Image a -> Int
    imageHeight Image PixelRGBF
    pic
            , radianceWidth :: Int
    radianceWidth  = Image PixelRGBF -> Int
    forall a. Image a -> Int
    imageWidth Image PixelRGBF
    pic
            , radianceData :: ByteString
    radianceData = [ByteString] -> ByteString
    L.fromChunks [Vector Word8 -> ByteString
    forall a. Storable a => Vector a -> ByteString
    toByteString (Vector Word8 -> ByteString) -> Vector Word8 -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Image PixelRGBA8 -> Vector (PixelBaseComponent PixelRGBA8)
    forall a. Image a -> Vector (PixelBaseComponent a)
    imageData Image PixelRGBA8
    newImage]
            }

    -- | Encode an High dynamic range image into a radiance image

    -- file format using a light RLE compression. Some problems

    -- seem to arise with some image viewer.

    encodeRLENewStyleHDR :: Image PixelRGBF -> L.ByteString
    encodeRLENewStyleHDR :: Image PixelRGBF -> ByteString
    encodeRLENewStyleHDR Image PixelRGBF
    pic = RadianceHeader -> ByteString
    forall a. Binary a => a -> ByteString
    encode (RadianceHeader -> ByteString) -> RadianceHeader -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (forall s. ST s RadianceHeader) -> RadianceHeader
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s RadianceHeader) -> RadianceHeader)
    -> (forall s. ST s RadianceHeader) -> RadianceHeader
    forall a b. (a -> b) -> a -> b
    $ do
        let w :: Int
    w = Image PixelRGBF -> Int
    forall a. Image a -> Int
    imageWidth Image PixelRGBF
    pic
            h :: Int
    h = Image PixelRGBF -> Int
    forall a. Image a -> Int
    imageHeight Image PixelRGBF
    pic

        scanLineR <- Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new Int
    w :: ST s (M.STVector s Word8)
        scanLineG <- M.new w
        scanLineB <- M.new w
        scanLineE <- M.new w

        encoded <-
            forM [0 .. h - 1] $ \Int
    line -> do
                buff <- Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new (Int -> ST s (MVector (PrimState (ST s)) Word8))
    -> Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall a b. (a -> b) -> a -> b
    $ Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    w Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    127 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
                let columner Int
    col | Int
    col Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    w = () -> ST s ()
    forall a. a -> ST s a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    columner Int
    col = do
                          let RGBE Word8
    r Word8
    g Word8
    b Word8
    e = PixelRGBF -> RGBE
    toRGBE (PixelRGBF -> RGBE) -> PixelRGBF -> RGBE
    forall a b. (a -> b) -> a -> b
    $ Image PixelRGBF -> Int -> Int -> PixelRGBF
    forall a. Pixel a => Image a -> Int -> Int -> a
    pixelAt Image PixelRGBF
    pic Int
    col Int
    line
                          (STVector s Word8
    MVector (PrimState (ST s)) Word8
    scanLineR MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    col) Word8
    r
                          (STVector s Word8
    MVector (PrimState (ST s)) Word8
    scanLineG MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    col) Word8
    g
                          (STVector s Word8
    MVector (PrimState (ST s)) Word8
    scanLineB MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    col) Word8
    b
                          (STVector s Word8
    MVector (PrimState (ST s)) Word8
    scanLineE MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    STVector (PrimState m) a -> Int -> a -> m ()
    `M.unsafeWrite` Int
    col) Word8
    e

                          Int -> ST s ()
    columner (Int
    col Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

                columner 0

                (buff `M.unsafeWrite` 0) 2
                (buff `M.unsafeWrite` 1) 2
                (buff `M.unsafeWrite` 2) $ fromIntegral ((w .>>. 8) .&. 0xFF)
                (buff `M.unsafeWrite` 3) $ fromIntegral (w .&. 0xFF)

                i1 <- encodeScanlineColor scanLineR buff 4
                i2 <- encodeScanlineColor scanLineG buff i1
                i3 <- encodeScanlineColor scanLineB buff i2
                endIndex <- encodeScanlineColor scanLineE buff i3

                (\Vector Word8
    v -> Vector Word8 -> Int -> Int -> ByteString
    blitVector Vector Word8
    v Int
    0 Int
    endIndex) <$> V.unsafeFreeze buff

        pure RadianceHeader
            { radianceInfos = []
            , radianceFormat = FormatRGBE
            , radianceHeight = h
            , radianceWidth  = w
            , radianceData = L.fromChunks encoded
            }

    decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s PixelRGBF)
    decodeRadiancePicture :: forall s. RadianceHeader -> HDRReader s (MutableImage s PixelRGBF)
    decodeRadiancePicture RadianceHeader
    hdr = do
        let width :: Int
    width = Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ RadianceHeader -> Int
    radianceWidth RadianceHeader
    hdr
            height :: Int
    height = Int -> Int
    forall a. Num a => a -> a
    abs (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ RadianceHeader -> Int
    radianceHeight RadianceHeader
    hdr
            packedData :: ByteString
    packedData = RadianceHeader -> ByteString
    radianceData RadianceHeader
    hdr

        scanLine <- ST s (STVector s Word8) -> ExceptT String (ST s) (STVector s Word8)
    forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s (STVector s Word8)
     -> ExceptT String (ST s) (STVector s Word8))
    -> ST s (STVector s Word8)
    -> ExceptT String (ST s) (STVector s Word8)
    forall a b. (a -> b) -> a -> b
    $ Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall (m :: * -> *) a.
    (PrimMonad m, Storable a) =>
    Int -> m (MVector (PrimState m) a)
    M.new (Int -> ST s (MVector (PrimState (ST s)) Word8))
    -> Int -> ST s (MVector (PrimState (ST s)) Word8)
    forall a b. (a -> b) -> a -> b
    $ Int
    width Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4
        resultBuffer <- lift $ M.new $ width * height * 3

        let scanLineImage = MutableImage
                          { mutableImageWidth :: Int
    mutableImageWidth = Int
    width
                          , mutableImageHeight :: Int
    mutableImageHeight = Int
    1
                          , mutableImageData :: STVector s (PixelBaseComponent PixelRGBA8)
    mutableImageData = STVector s Word8
    STVector s (PixelBaseComponent PixelRGBA8)
    scanLine
                          }

            finalImage = MutableImage
                       { mutableImageWidth :: Int
    mutableImageWidth = Int
    width
                       , mutableImageHeight :: Int
    mutableImageHeight = Int
    height
                       , mutableImageData :: STVector s (PixelBaseComponent PixelRGBF)
    mutableImageData = MVector s Float
    STVector s (PixelBaseComponent PixelRGBF)
    resultBuffer
                       }

        let scanLineExtractor Int
    readIdx Int
    line = do
              let color :: RGBE
    color = ByteString -> Int -> RGBE
    unpackColor ByteString
    packedData Int
    readIdx
                  inner :: ExceptT
      String
      (ST s)
      (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    inner | RGBE -> Bool
    isNewRunLengthMarker RGBE
    color = do
                              let calcSize :: Int
    calcSize = RGBE -> Int
    checkLineLength RGBE
    color
                              Bool -> ExceptT String (ST s) () -> ExceptT String (ST s) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    calcSize Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    width)
                                   (String -> ExceptT String (ST s) ()
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE String
    "Invalid sanline size")
                              (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    -> ExceptT
         String
         (ST s)
         (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    forall a. a -> ExceptT String (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Int -> STVector s Word8 -> ExceptT String (ST s) Int)
     -> ExceptT
          String
          (ST s)
          (Int -> STVector s Word8 -> ExceptT String (ST s) Int))
    -> (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    -> ExceptT
         String
         (ST s)
         (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    forall a b. (a -> b) -> a -> b
    $ \Int
    idx -> ByteString -> Int -> STVector s Word8 -> ExceptT String (ST s) Int
    forall s. ByteString -> Int -> STVector s Word8 -> HDRReader s Int
    newStyleRLE ByteString
    packedData (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4)
                        | Bool
    otherwise = (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    -> ExceptT
         String
         (ST s)
         (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    forall a. a -> ExceptT String (ST s) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Int -> STVector s Word8 -> ExceptT String (ST s) Int)
     -> ExceptT
          String
          (ST s)
          (Int -> STVector s Word8 -> ExceptT String (ST s) Int))
    -> (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    -> ExceptT
         String
         (ST s)
         (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int -> STVector s Word8 -> ExceptT String (ST s) Int
    forall s. ByteString -> Int -> STVector s Word8 -> HDRReader s Int
    oldStyleRLE ByteString
    packedData
              f <- ExceptT
      String
      (ST s)
      (Int -> STVector s Word8 -> ExceptT String (ST s) Int)
    inner
              newRead <- f readIdx scanLine
              forM_ [0 .. width - 1] $ \Int
    i -> do
                  -- mokay, it's a hack, but I don't want to define a

                  -- pixel instance of RGBE...

                  PixelRGBA8 r g b e <- ST s PixelRGBA8 -> ExceptT String (ST s) PixelRGBA8
    forall (m :: * -> *) a. Monad m => m a -> ExceptT String m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ST s PixelRGBA8 -> ExceptT String (ST s) PixelRGBA8)
    -> ST s PixelRGBA8 -> ExceptT String (ST s) PixelRGBA8
    forall a b. (a -> b) -> a -> b
    $ MutableImage (PrimState (ST s)) PixelRGBA8
    -> Int -> Int -> ST s PixelRGBA8
    forall a (m :: * -> *).
    (Pixel a, PrimMonad m) =>
    MutableImage (PrimState m) a -> Int -> Int -> m a
    forall (m :: * -> *).
    PrimMonad m =>
    MutableImage (PrimState m) PixelRGBA8 -> Int -> Int -> m PixelRGBA8
    readPixel MutableImage s PixelRGBA8
    MutableImage (PrimState (ST s)) PixelRGBA8
    scanLineImage Int
    i Int
    0
                  lift $ writePixel finalImage i line . toFloat $ RGBE r g b e

              return newRead

        foldM_ scanLineExtractor 0 [0 .. height - 1]

        return finalImage