{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Description : Main interface for reading CBF files
--
-- Look at 'readCBF' as a starting point.
module Data.CBF (CBFImage (..), readCBF, decodePixels) where

import Control.Monad (mzero, void, when)
import Control.Monad.ST (runST)
import Data.Attoparsec.ByteString.Lazy qualified as A
import Data.Bifunctor (bimap, first)
import Data.Binary.Get (getInt16le, getInt32le, getInt64le, runGet)
import Data.Bits
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as BS8
import Data.ByteString.Lazy qualified as BSL
import Data.Int
import Data.Text qualified as Text
import Data.Text.Encoding (decodeLatin1)
import Data.Vector.Unboxed qualified as V
import Data.Vector.Unboxed.Mutable qualified as MV
import Data.Word
import Unsafe.Coerce (unsafeCoerce)

-- | Decoded CBF image data, with contents
data CBFImage = CBFImage
  { -- | Raw image properties, after the binary format section header (not the comments at the begining of the file)
    CBFImage -> [(Text, Text)]
imageProperties :: ![(Text.Text, Text.Text)],
    -- | Fastest image dimension (CBF avoids "x" and "y" or "width"/"height" here)
    CBFImage -> Int
imageFastestDimension :: !Int,
    -- | Second image dimension (CBF avoids "x" and "y" or "width"/"height" here)
    CBFImage -> Int
imageSecondDimension :: !Int,
    -- | Raw image data, to be decoded/decompressed using 'decodePixels'
    CBFImage -> ByteString
imageDataRaw :: !BSL.ByteString
  }

breakSubstringWithoutDelimiter :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString)
breakSubstringWithoutDelimiter :: ByteString -> ByteString -> (ByteString, ByteString)
breakSubstringWithoutDelimiter ByteString
needle ByteString
haystack =
  let (ByteString
prefix, ByteString
suffix) = ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
needle ByteString
haystack
   in (ByteString
prefix, Int -> ByteString -> ByteString
BS.drop (ByteString -> Int
BS.length ByteString
needle) ByteString
suffix)

cbfParser :: A.Parser CBFImage
cbfParser :: Parser CBFImage
cbfParser = do
  let takeLine :: Parser ByteString ByteString
takeLine = do
        ByteString
contents <- (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile (\Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0xd Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0xa)
        Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> Parser ByteString ByteString
A.string ByteString
"\r\n")
        ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
contents
      cbfStartingLine :: Parser ByteString ()
cbfStartingLine = do
        ByteString
line <- Parser ByteString ByteString
takeLine
        Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
"--CIF-BINARY-FORMAT-SECTION--" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
line) Parser ByteString ()
forall a. Parser ByteString a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
A.skipMany Parser ByteString ()
cbfStartingLine
  -- skip the starting line
  Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ByteString
takeLine
  let cbfPropertyLine :: Parser ByteString (ByteString, ByteString)
cbfPropertyLine = do
        ByteString
line <- Parser ByteString ByteString
takeLine
        if ByteString -> Bool
BS.null ByteString
line
          then Parser ByteString (ByteString, ByteString)
forall a. Parser ByteString a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
          else do
            -- Example of a suffix:
            -- Content-Type: application/octet-stream;
            --      conversions="x-CBF_BYTE_OFFSET"
            ByteString
lineSuffix <- if (ByteString
";" ByteString -> ByteString -> Bool
`BS.isSuffixOf` ByteString
line) then ((ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" ") (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS8.strip) (ByteString -> ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
takeLine else ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""
            (ByteString, ByteString)
-> Parser ByteString (ByteString, ByteString)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteString -> (ByteString, ByteString)
breakSubstringWithoutDelimiter ByteString
": " (ByteString
line ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
lineSuffix))
  [(ByteString, ByteString)]
propertyLines <- Parser ByteString (ByteString, ByteString)
-> Parser ByteString [(ByteString, ByteString)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser ByteString (ByteString, ByteString)
cbfPropertyLine
  -- the empty line
  Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ByteString
takeLine
  (Word8 -> Parser ByteString Word8)
-> [Word8] -> Parser ByteString ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word8 -> Parser ByteString Word8
A.word8 [Word8
0x0c, Word8
0x1a, Word8
0x04, Word8
0xd5]
  let properties :: [(Text, Text)]
properties = (ByteString -> Text)
-> (ByteString -> Text) -> (ByteString, ByteString) -> (Text, Text)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ByteString -> Text
decodeLatin1 ByteString -> Text
decodeLatin1 ((ByteString, ByteString) -> (Text, Text))
-> [(ByteString, ByteString)] -> [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ByteString, ByteString)]
propertyLines
      bsToInt :: BS.ByteString -> Maybe Int
      bsToInt :: ByteString -> Maybe Int
bsToInt = ((Int, ByteString) -> Int
forall a b. (a, b) -> a
fst ((Int, ByteString) -> Int) -> Maybe (Int, ByteString) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (Int, ByteString) -> Maybe Int)
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
BS8.readInt
  case (,) (Int -> Int -> (Int, Int))
-> Maybe Int -> Maybe (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"X-Binary-Size-Fastest-Dimension" [(ByteString, ByteString)]
propertyLines Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Int
bsToInt) Maybe (Int -> (Int, Int)) -> Maybe Int -> Maybe (Int, Int)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"X-Binary-Size-Second-Dimension" [(ByteString, ByteString)]
propertyLines Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Int
bsToInt) of
    Just (Int
fastestDimension, Int
secondDimension) ->
      [(Text, Text)] -> Int -> Int -> ByteString -> CBFImage
CBFImage [(Text, Text)]
properties Int
fastestDimension Int
secondDimension (ByteString -> CBFImage)
-> Parser ByteString ByteString -> Parser CBFImage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
A.takeLazyByteString
    Maybe (Int, Int)
Nothing -> String -> Parser CBFImage
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"couldn't extract dimensions from properties")

-- | Read a CBF file, without decoding its contents (see 'decodePixels' for that)
readCBF :: FilePath -> IO (Either Text.Text CBFImage)
readCBF :: String -> IO (Either Text CBFImage)
readCBF String
fn = do
  ByteString
c <- String -> IO ByteString
BSL.readFile String
fn
  Either Text CBFImage -> IO (Either Text CBFImage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String -> Text) -> Either String CBFImage -> Either Text CBFImage
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
Text.pack (Parser CBFImage -> ByteString -> Either String CBFImage
forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser CBFImage
cbfParser ByteString
c))

unconsW8 :: BSL.ByteString -> Maybe (Word8, BSL.ByteString)
unconsW8 :: ByteString -> Maybe (Word8, ByteString)
unconsW8 = ByteString -> Maybe (Word8, ByteString)
BSL.uncons

unconsW16 :: BSL.ByteString -> Maybe (Word16, BSL.ByteString)
unconsW16 :: ByteString -> Maybe (Word16, ByteString)
unconsW16 ByteString
bs = do
  (Word8
x, ByteString
bs') <- ByteString -> Maybe (Word8, ByteString)
unconsW8 ByteString
bs
  (Word8
y, ByteString
bs'') <- ByteString -> Maybe (Word8, ByteString)
unconsW8 ByteString
bs'
  (Word16, ByteString) -> Maybe (Word16, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8), ByteString
bs'')

unconsW32 :: BSL.ByteString -> Maybe (Word32, BSL.ByteString)
unconsW32 :: ByteString -> Maybe (Word32, ByteString)
unconsW32 ByteString
bs = do
  (Word16
x, ByteString
bs') <- ByteString -> Maybe (Word16, ByteString)
unconsW16 ByteString
bs
  (Word16
y, ByteString
bs'') <- ByteString -> Maybe (Word16, ByteString)
unconsW16 ByteString
bs'
  (Word32, ByteString) -> Maybe (Word32, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16), ByteString
bs'')

unconsW64 :: BSL.ByteString -> Maybe (Word64, BSL.ByteString)
unconsW64 :: ByteString -> Maybe (Word64, ByteString)
unconsW64 ByteString
bs = do
  (Word32
x, ByteString
bs') <- ByteString -> Maybe (Word32, ByteString)
unconsW32 ByteString
bs
  (Word32
y, ByteString
bs'') <- ByteString -> Maybe (Word32, ByteString)
unconsW32 ByteString
bs'
  (Word64, ByteString) -> Maybe (Word64, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
y Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32), ByteString
bs'')

unconsI8 :: BSL.ByteString -> Maybe (Int8, BSL.ByteString)
unconsI8 :: ByteString -> Maybe (Int8, ByteString)
unconsI8 ByteString
bs = do
  (Word8
x, ByteString
bs') <- ByteString -> Maybe (Word8, ByteString)
unconsW8 ByteString
bs
  (Int8, ByteString) -> Maybe (Int8, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x, ByteString
bs')

unconsI16 :: BSL.ByteString -> Maybe (Int16, BSL.ByteString)
unconsI16 :: ByteString -> Maybe (Int16, ByteString)
unconsI16 ByteString
bs = do
  (Word16
x, ByteString
bs') <- ByteString -> Maybe (Word16, ByteString)
unconsW16 ByteString
bs
  (Int16, ByteString) -> Maybe (Int16, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x, ByteString
bs')

unconsI32 :: BSL.ByteString -> Maybe (Int32, BSL.ByteString)
unconsI32 :: ByteString -> Maybe (Int32, ByteString)
unconsI32 ByteString
bs = do
  (Word32
x, ByteString
bs') <- ByteString -> Maybe (Word32, ByteString)
unconsW32 ByteString
bs
  (Int32, ByteString) -> Maybe (Int32, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x, ByteString
bs')

unconsI64 :: BSL.ByteString -> Maybe (Int64, BSL.ByteString)
unconsI64 :: ByteString -> Maybe (Int64, ByteString)
unconsI64 ByteString
bs = do
  (Word64
x, ByteString
bs') <- ByteString -> Maybe (Word64, ByteString)
unconsW64 ByteString
bs
  (Int64, ByteString) -> Maybe (Int64, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x, ByteString
bs')

decompressBinary :: Int -> Int64 -> BSL.ByteString -> [Int64]
decompressBinary :: Int -> Int64 -> ByteString -> [Int64]
decompressBinary !Int
0 !Int64
_ ByteString
_ = []
decompressBinary !Int
i !Int64
x ByteString
bs = do
  case ByteString -> Maybe (Int8, ByteString)
unconsI8 ByteString
bs of
    Maybe (Int8, ByteString)
Nothing -> [] -- fail
    Just (Int8
delta8, ByteString
bs1)
      | -Int8
127 Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int8
delta8 Bool -> Bool -> Bool
&& Int8
delta8 Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int8
127 ->
          let !y :: Int64
y = Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
delta8
           in Int64
y Int64 -> [Int64] -> [Int64]
forall a. a -> [a] -> [a]
: Int -> Int64 -> ByteString -> [Int64]
decompressBinary (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int64
y ByteString
bs1
      | Bool
otherwise ->
          case ByteString -> Maybe (Int16, ByteString)
unconsI16 ByteString
bs1 of
            Maybe (Int16, ByteString)
Nothing -> [] -- fail
            Just (Int16
delta16, ByteString
bs2)
              | -Int16
32767 Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int16
delta16 Bool -> Bool -> Bool
&& Int16
delta16 Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int16
32767 ->
                  let !y :: Int64
y = Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
delta16
                   in Int64
y Int64 -> [Int64] -> [Int64]
forall a. a -> [a] -> [a]
: Int -> Int64 -> ByteString -> [Int64]
decompressBinary (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int64
y ByteString
bs2
              | Bool
otherwise ->
                  case ByteString -> Maybe (Int32, ByteString)
unconsI32 ByteString
bs2 of
                    Maybe (Int32, ByteString)
Nothing -> [] -- fail
                    Just (Int32
delta32, ByteString
bs3)
                      | -Int32
2147483647 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
delta32 Bool -> Bool -> Bool
&& Int32
delta32 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
2147483647 ->
                          let !y :: Int64
y = Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
delta32
                           in Int64
y Int64 -> [Int64] -> [Int64]
forall a. a -> [a] -> [a]
: Int -> Int64 -> ByteString -> [Int64]
decompressBinary (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int64
y ByteString
bs3
                      | Bool
otherwise ->
                          case ByteString -> Maybe (Int64, ByteString)
unconsI64 ByteString
bs3 of
                            Maybe (Int64, ByteString)
Nothing -> [] -- fail
                            Just (Int64
delta64, ByteString
bs4) ->
                              let !y :: Int64
y = Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
delta64
                               in Int64
y Int64 -> [Int64] -> [Int64]
forall a. a -> [a] -> [a]
: Int -> Int64 -> ByteString -> [Int64]
decompressBinary (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int64
y ByteString
bs4

decompressBinaryBSL :: Int -> BSL.ByteString -> Either String [Int64]
decompressBinaryBSL :: Int -> ByteString -> Either String [Int64]
decompressBinaryBSL Int
numberOfElements ByteString
s = [Int64] -> Either String [Int64]
forall a b. b -> Either a b
Right ([Int64] -> Either String [Int64])
-> [Int64] -> Either String [Int64]
forall a b. (a -> b) -> a -> b
$ Int -> Int64 -> ByteString -> [Int64]
decompressBinary Int
numberOfElements Int64
0 ByteString
s

decompressST :: (MV.PrimMonad m) => Int -> BSL.ByteString -> m (V.Vector Int64)
decompressST :: forall (m :: * -> *).
PrimMonad m =>
Int -> ByteString -> m (Vector Int64)
decompressST Int
numberOfElements ByteString
s = do
  MVector (PrimState m) Int64
mutableVector <- Int -> m (MVector (PrimState m) Int64)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MV.new Int
numberOfElements
  ()
_ <- Int64
-> ByteString
-> MVector (PrimState m) Int64
-> Int
-> Int64
-> Int64
-> m ()
forall (m :: * -> *).
PrimMonad m =>
Int64
-> ByteString
-> MVector (PrimState m) Int64
-> Int
-> Int64
-> Int64
-> m ()
decompressSingleChunk (ByteString -> Int64
BSL.length ByteString
s) ByteString
s MVector (PrimState m) Int64
mutableVector Int
0 Int64
0 Int64
0
  MVector (PrimState m) Int64 -> m (Vector Int64)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
V.freeze MVector (PrimState m) Int64
mutableVector

decompress :: Int -> BSL.ByteString -> V.Vector Int64
decompress :: Int -> ByteString -> Vector Int64
decompress Int
numberOfElements ByteString
s = (forall s. ST s (Vector Int64)) -> Vector Int64
forall a. (forall s. ST s a) -> a
runST (Int -> ByteString -> ST s (Vector Int64)
forall (m :: * -> *).
PrimMonad m =>
Int -> ByteString -> m (Vector Int64)
decompressST Int
numberOfElements ByteString
s)

decompressSingleChunk ::
  (MV.PrimMonad m) =>
  Int64 ->
  BSL.ByteString ->
  MV.MVector (MV.PrimState m) Int64 ->
  Int ->
  Int64 ->
  Int64 ->
  m ()
decompressSingleChunk :: forall (m :: * -> *).
PrimMonad m =>
Int64
-> ByteString
-> MVector (PrimState m) Int64
-> Int
-> Int64
-> Int64
-> m ()
decompressSingleChunk Int64
slen ByteString
s MVector (PrimState m) Int64
mutableVector Int
outPos Int64
inPos Int64
value = do
  if Int64
inPos Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
slen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1
    then () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else do
      let readInt8 :: Int64 -> Maybe Int64
          readInt8 :: Int64 -> Maybe Int64
readInt8 Int64
p =
            case {-# SCC "read8" #-} ByteString -> Int64 -> Maybe Word8
BSL.indexMaybe ByteString
s Int64
p of
              Maybe Word8
Nothing -> Maybe Int64
forall a. Maybe a
Nothing
              Just Word8
v -> Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8
forall a b. a -> b
unsafeCoerce Word8
v :: Int8))
          readInt16 :: Int64 -> Maybe Int64
          readInt16 :: Int64 -> Maybe Int64
readInt16 Int64
p
            | Int64
p Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
slen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
2 = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ {-# SCC "read16" #-} Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Int16 -> ByteString -> Int16
forall a. Get a -> ByteString -> a
runGet Get Int16
getInt16le (Int64 -> ByteString -> ByteString
BSL.drop Int64
p ByteString
s))
            | Bool
otherwise = Maybe Int64
forall a. Maybe a
Nothing
          readInt32 :: Int64 -> Maybe Int64
          readInt32 :: Int64 -> Maybe Int64
readInt32 Int64
p
            | Int64
p Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
slen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
4 = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ {-# SCC "read32" #-} Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Int32 -> ByteString -> Int32
forall a. Get a -> ByteString -> a
runGet Get Int32
getInt32le (Int64 -> ByteString -> ByteString
BSL.drop Int64
p ByteString
s))
            | Bool
otherwise = Maybe Int64
forall a. Maybe a
Nothing
          readInt64 :: Int64 -> Maybe Int64
          readInt64 :: Int64 -> Maybe Int64
readInt64 Int64
p
            | Int64
p Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
slen Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
8 = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ {-# SCC "read64" #-} Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Int64 -> ByteString -> Int64
forall a. Get a -> ByteString -> a
runGet Get Int64
getInt64le (Int64 -> ByteString -> ByteString
BSL.drop Int64
p ByteString
s))
            | Bool
otherwise = Maybe Int64
forall a. Maybe a
Nothing
          recurse :: p -> Int64 -> Int64 -> f ()
recurse p
_bitDepth Int64
newInPos Int64
d = do
            if Int
outPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= MVector (PrimState m) Int64 -> Int
forall a s. Unbox a => MVector s a -> Int
MV.length MVector (PrimState m) Int64
mutableVector
              then () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              else
                {-# SCC "writeV" #-}
                do
                  MVector (PrimState f) Int64 -> Int -> Int64 -> f ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.write MVector (PrimState m) Int64
MVector (PrimState f) Int64
mutableVector Int
outPos (Int64
value Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
d)
                  Int64
-> ByteString
-> MVector (PrimState f) Int64
-> Int
-> Int64
-> Int64
-> f ()
forall (m :: * -> *).
PrimMonad m =>
Int64
-> ByteString
-> MVector (PrimState m) Int64
-> Int
-> Int64
-> Int64
-> m ()
decompressSingleChunk Int64
slen ByteString
s MVector (PrimState m) Int64
MVector (PrimState f) Int64
mutableVector (Int
outPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int64
newInPos (Int64
value Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
d)
      case Int64 -> Maybe Int64
readInt8 Int64
inPos of
        Maybe Int64
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Int64
delta8 ->
          if -Int64
127 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
delta8 Bool -> Bool -> Bool
&& Int64
delta8 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
127
            then Int -> Int64 -> Int64 -> m ()
forall {f :: * -> *} {p}.
(PrimState f ~ PrimState m, PrimMonad f) =>
p -> Int64 -> Int64 -> f ()
recurse (Int
8 :: Int) (Int64
inPos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) Int64
delta8
            else case Int64 -> Maybe Int64
readInt16 (Int64
inPos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) of
              Maybe Int64
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Just Int64
delta16 ->
                if -Int64
32767 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
delta16 Bool -> Bool -> Bool
&& Int64
delta16 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
32767
                  then Int -> Int64 -> Int64 -> m ()
forall {f :: * -> *} {p}.
(PrimState f ~ PrimState m, PrimMonad f) =>
p -> Int64 -> Int64 -> f ()
recurse (Int
16 :: Int) (Int64
inPos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
3) Int64
delta16
                  else case Int64 -> Maybe Int64
readInt32 (Int64
inPos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
3) of
                    Maybe Int64
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    Just Int64
delta32 ->
                      if -Int64
2147483647 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
delta32 Bool -> Bool -> Bool
&& Int64
delta32 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
2147483647
                        then Int -> Int64 -> Int64 -> m ()
forall {f :: * -> *} {p}.
(PrimState f ~ PrimState m, PrimMonad f) =>
p -> Int64 -> Int64 -> f ()
recurse (Int
32 :: Int) (Int64
inPos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
7) Int64
delta32
                        else case Int64 -> Maybe Int64
readInt64 (Int64
inPos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
7) of
                          Maybe Int64
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                          Just Int64
delta64 -> Int -> Int64 -> Int64 -> m ()
forall {f :: * -> *} {p}.
(PrimState f ~ PrimState m, PrimMonad f) =>
p -> Int64 -> Int64 -> f ()
recurse (Int
64 :: Int) (Int64
inPos Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
11) Int64
delta64

-- | Decode the actual pixel values inside the CBF file, possibly decompressing it.
decodePixels :: CBFImage -> Either String [Int64]
decodePixels :: CBFImage -> Either String [Int64]
decodePixels (CBFImage {ByteString
imageDataRaw :: CBFImage -> ByteString
imageDataRaw :: ByteString
imageDataRaw, Int
imageFastestDimension :: CBFImage -> Int
imageFastestDimension :: Int
imageFastestDimension, Int
imageSecondDimension :: CBFImage -> Int
imageSecondDimension :: Int
imageSecondDimension}) =
  let numberOfElements :: Int
numberOfElements = Int
imageFastestDimension Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
imageSecondDimension
   in Int -> ByteString -> Either String [Int64]
decompressBinaryBSL Int
numberOfElements ByteString
imageDataRaw