{-# LANGUAGE ForeignFunctionInterface #-}
module Bio.Streaming.Bgzf (
bgunzip,
getBgzfHdr,
BB(..),
newBuffer,
fillBuffer,
expandBuffer,
encodeBgzf,
BgzfTokens(..),
BclArgs(..),
BclSpecialType(..),
loop_dec_int,
loop_bcl_special,
CompressionError(..),
DecompressionError(..)
) where
import Bio.Prelude
import Bio.Streaming
import Foreign.C.Types ( CInt(..) )
import Foreign.Marshal.Utils ( copyBytes, fillBytes, with )
import qualified Bio.Streaming.Bytes as S
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.Vector.Storable as V
bgunzip :: MonadIO m => ByteStream m r -> ByteStream m r
bgunzip :: ByteStream m r -> ByteStream m r
bgunzip s :: ByteStream m r
s = do
Int
np <- IO Int -> ByteStream m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> ByteStream m Int) -> IO Int -> ByteStream m Int
forall a b. (a -> b) -> a -> b
$ IO Int
getNumCapabilities
Stream (Of Bytes) m r -> ByteStream m r
forall (m :: * -> *) r.
Monad m =>
Stream (Of Bytes) m r -> ByteStream m r
S.fromChunks (Stream (Of Bytes) m r -> ByteStream m r)
-> Stream (Of Bytes) m r -> ByteStream m r
forall a b. (a -> b) -> a -> b
$ Int -> Stream (Of (IO Bytes)) m r -> Stream (Of Bytes) m r
forall (m :: * -> *) a b.
MonadIO m =>
Int -> Stream (Of (IO a)) m b -> Stream (Of a) m b
psequence (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
np) (Stream (Of (IO Bytes)) m r -> Stream (Of Bytes) m r)
-> Stream (Of (IO Bytes)) m r -> Stream (Of Bytes) m r
forall a b. (a -> b) -> a -> b
$ m (Maybe Int, Bytes, ByteStream m r)
-> Stream (Of (IO Bytes)) m (Maybe Int, Bytes, ByteStream m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ByteStream m r -> m (Maybe Int, Bytes, ByteStream m r)
forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Maybe Int, Bytes, ByteStream m r)
getBgzfHdr ByteStream m r
s) Stream (Of (IO Bytes)) m (Maybe Int, Bytes, ByteStream m r)
-> ((Maybe Int, Bytes, ByteStream m r)
-> Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Int, Bytes, ByteStream m r) -> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) r.
Monad m =>
(Maybe Int, Bytes, ByteStream m r) -> Stream (Of (IO Bytes)) m r
go
where
go :: (Maybe Int, Bytes, ByteStream m r) -> Stream (Of (IO Bytes)) m r
go (Nothing, _hdr :: Bytes
_hdr, s1 :: ByteStream m r
s1) = m r -> Stream (Of (IO Bytes)) m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ByteStream m r -> m r
forall (m :: * -> *) r. Monad m => ByteStream m r -> m r
S.effects ByteStream m r
s1)
go (Just bsize :: Int
bsize, _hdr :: Bytes
_hdr, s1 :: ByteStream m r
s1) = do
blk :: Bytes
blk :> s2 :: ByteStream m r
s2 <- m (Of Bytes (ByteStream m r))
-> Stream (Of (IO Bytes)) m (Of Bytes (ByteStream m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Of Bytes (ByteStream m r))
-> Stream (Of (IO Bytes)) m (Of Bytes (ByteStream m r)))
-> m (Of Bytes (ByteStream m r))
-> Stream (Of (IO Bytes)) m (Of Bytes (ByteStream m r))
forall a b. (a -> b) -> a -> b
$ Int -> ByteStream m r -> m (Of Bytes (ByteStream m r))
forall (m :: * -> *) r.
Monad m =>
Int -> ByteStream m r -> m (Of Bytes (ByteStream m r))
S.splitAt' Int
bsize ByteStream m r
s1
Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (Bytes -> IO Bytes
decompressChunk Bytes
blk IO Bytes
-> Stream (Of (IO Bytes)) m r
-> Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
forall a b. a -> b -> Of a b
:> (m (Maybe Int, Bytes, ByteStream m r)
-> Stream (Of (IO Bytes)) m (Maybe Int, Bytes, ByteStream m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ByteStream m r -> m (Maybe Int, Bytes, ByteStream m r)
forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Maybe Int, Bytes, ByteStream m r)
getBgzfHdr ByteStream m r
s2) Stream (Of (IO Bytes)) m (Maybe Int, Bytes, ByteStream m r)
-> ((Maybe Int, Bytes, ByteStream m r)
-> Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Int, Bytes, ByteStream m r) -> Stream (Of (IO Bytes)) m r
go))
{-# INLINABLE bgunzip #-}
getBgzfHdr :: Monad m => ByteStream m r -> m (Maybe Int, B.ByteString, ByteStream m r)
getBgzfHdr :: ByteStream m r -> m (Maybe Int, Bytes, ByteStream m r)
getBgzfHdr s0 :: ByteStream m r
s0 = do
hdr :: Bytes
hdr :> s1 :: ByteStream m r
s1 <- Int -> ByteStream m r -> m (Of Bytes (ByteStream m r))
forall (m :: * -> *) r.
Monad m =>
Int -> ByteStream m r -> m (Of Bytes (ByteStream m r))
S.splitAt' 18 ByteStream m r
s0
if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ Bytes -> Int
B.length Bytes
hdr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 18
, Bytes -> Int -> Word8
B.index Bytes
hdr 0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 139
, Bytes -> Int -> Word8
B.index Bytes
hdr 1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 31
, Bytes -> Int -> Word8
B.index Bytes
hdr 3 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 4 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 4
, Bytes -> Int -> Word8
B.index Bytes
hdr 10 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 6
, Bytes -> Int -> Word8
B.index Bytes
hdr 11 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0
, Bytes -> Int -> Word8
B.index Bytes
hdr 12 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 66
, Bytes -> Int -> Word8
B.index Bytes
hdr 13 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 67 ]
then (Maybe Int, Bytes, ByteStream m r)
-> m (Maybe Int, Bytes, ByteStream m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int
forall a. Maybe a
Nothing, Bytes
hdr, ByteStream m r
s1)
else do
let bsize :: Int
bsize = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Int -> Word8
B.index Bytes
hdr 16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Int -> Word8
B.index Bytes
hdr 17) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 16
(Maybe Int, Bytes, ByteStream m r)
-> m (Maybe Int, Bytes, ByteStream m r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
bsize, Bytes
hdr, ByteStream m r
s1)
{-# INLINE getBgzfHdr #-}
data BB = BB { BB -> ForeignPtr Word8
buffer :: {-# UNPACK #-} !(ForeignPtr Word8)
, BB -> Int
size :: {-# UNPACK #-} !Int
, BB -> Int
off :: {-# UNPACK #-} !Int
, BB -> Int
used :: {-# UNPACK #-} !Int
, BB -> Int
mark :: {-# UNPACK #-} !Int
, BB -> Int
mark2 :: {-# UNPACK #-} !Int }
data BgzfTokens = TkWord32 {-# UNPACK #-} !Word32 BgzfTokens
| TkWord16 {-# UNPACK #-} !Word16 BgzfTokens
| TkWord8 {-# UNPACK #-} !Word8 BgzfTokens
| TkFloat {-# UNPACK #-} !Float BgzfTokens
| TkDouble {-# UNPACK #-} !Double BgzfTokens
| TkString {-# UNPACK #-} !B.ByteString BgzfTokens
| TkDecimal {-# UNPACK #-} !Int BgzfTokens
| TkMemFill {-# UNPACK #-} !Int {-# UNPACK #-} !Word8 BgzfTokens
| TkMemCopy {-# UNPACK #-} !(V.Vector Word8) BgzfTokens
| TkSetMark BgzfTokens
| TkEndRecord BgzfTokens
| TkEndRecordPart1 BgzfTokens
| TkEndRecordPart2 BgzfTokens
| TkEnd
| TkBclSpecial !BclArgs BgzfTokens
| TkLowLevel {-# UNPACK #-} !Int (BB -> IO BB) BgzfTokens
data BclSpecialType = BclNucsBin | BclNucsAsc | BclNucsAscRev | BclNucsWide
| BclQualsBin | BclQualsAsc | BclQualsAscRev
data BclArgs = BclArgs BclSpecialType
{-# UNPACK #-} !(V.Vector Word8)
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
newBuffer :: Int -> IO BB
newBuffer :: Int -> IO BB
newBuffer sz :: Int
sz = Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sz IO (ForeignPtr Word8) -> (ForeignPtr Word8 -> IO BB) -> IO BB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ar :: ForeignPtr Word8
ar -> BB -> IO BB
forall (m :: * -> *) a. Monad m => a -> m a
return (BB -> IO BB) -> BB -> IO BB
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Int -> BB
BB ForeignPtr Word8
ar Int
sz 0 0 Int
forall a. Bounded a => a
maxBound Int
forall a. Bounded a => a
maxBound
expandBuffer :: Int -> BB -> IO BB
expandBuffer :: Int -> BB -> IO BB
expandBuffer minsz :: Int
minsz b :: BB
b = do
let sz' :: Int
sz' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (BB -> Int
size BB
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
used BB
b)) Int
minsz
ForeignPtr Word8
arr1 <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sz'
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
arr1 ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \d :: Ptr Word8
d ->
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (BB -> ForeignPtr Word8
buffer BB
b) ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: Ptr Word8
s ->
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
d (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
s (BB -> Int
off BB
b)) (BB -> Int
used BB
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
off BB
b)
BB -> IO BB
forall (m :: * -> *) a. Monad m => a -> m a
return $WBB :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Int -> BB
BB{ buffer :: ForeignPtr Word8
buffer = ForeignPtr Word8
arr1
, size :: Int
size = Int
sz'
, off :: Int
off = 0
, used :: Int
used = BB -> Int
used BB
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
off BB
b
, mark :: Int
mark = if BB -> Int
mark BB
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound then Int
forall a. Bounded a => a
maxBound else BB -> Int
mark BB
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
off BB
b
, mark2 :: Int
mark2 = if BB -> Int
mark2 BB
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound then Int
forall a. Bounded a => a
maxBound else BB -> Int
mark2 BB
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
off BB
b }
data CompressionError = CompressionError !CInt deriving (Typeable,Int -> CompressionError -> ShowS
[CompressionError] -> ShowS
CompressionError -> String
(Int -> CompressionError -> ShowS)
-> (CompressionError -> String)
-> ([CompressionError] -> ShowS)
-> Show CompressionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionError] -> ShowS
$cshowList :: [CompressionError] -> ShowS
show :: CompressionError -> String
$cshow :: CompressionError -> String
showsPrec :: Int -> CompressionError -> ShowS
$cshowsPrec :: Int -> CompressionError -> ShowS
Show)
instance Exception CompressionError where
displayException :: CompressionError -> String
displayException (CompressionError rc :: CInt
rc) = "compress_chunk failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
rc
data DecompressionError = DecompressionError !CInt deriving (Typeable,Int -> DecompressionError -> ShowS
[DecompressionError] -> ShowS
DecompressionError -> String
(Int -> DecompressionError -> ShowS)
-> (DecompressionError -> String)
-> ([DecompressionError] -> ShowS)
-> Show DecompressionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecompressionError] -> ShowS
$cshowList :: [DecompressionError] -> ShowS
show :: DecompressionError -> String
$cshow :: DecompressionError -> String
showsPrec :: Int -> DecompressionError -> ShowS
$cshowsPrec :: Int -> DecompressionError -> ShowS
Show)
instance Exception DecompressionError where
displayException :: DecompressionError -> String
displayException (DecompressionError rc :: CInt
rc) = "decompress_chunk failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
rc
compressChunk :: Int -> ForeignPtr Word8 -> Int -> Int -> IO B.ByteString
compressChunk :: Int -> ForeignPtr Word8 -> Int -> Int -> IO Bytes
compressChunk lv :: Int
lv fptr :: ForeignPtr Word8
fptr off :: Int
off slen :: Int
slen =
ForeignPtr Word8 -> (Ptr Word8 -> IO Bytes) -> IO Bytes
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO Bytes) -> IO Bytes)
-> (Ptr Word8 -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr ->
Int -> (Ptr Word8 -> IO Int) -> IO Bytes
B.createAndTrim 65536 ((Ptr Word8 -> IO Int) -> IO Bytes)
-> (Ptr Word8 -> IO Int) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \buf :: Ptr Word8
buf ->
CInt -> (Ptr CInt -> IO Int) -> IO Int
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with 65536 ((Ptr CInt -> IO Int) -> IO Int) -> (Ptr CInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \p_len :: Ptr CInt
p_len -> do
CInt
rc <- Ptr Word8 -> Ptr CInt -> Ptr Word8 -> CInt -> CInt -> IO CInt
compress_chunk Ptr Word8
buf Ptr CInt
p_len (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
ptr Int
off) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
slen) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lv)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
&& CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ CompressionError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (CompressionError -> IO ()) -> CompressionError -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CompressionError
CompressionError CInt
rc
CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
p_len
decompressChunk :: B.ByteString -> IO B.ByteString
decompressChunk :: Bytes -> IO Bytes
decompressChunk ck :: Bytes
ck =
Bytes -> (CString -> IO Bytes) -> IO Bytes
forall a. Bytes -> (CString -> IO a) -> IO a
B.unsafeUseAsCString Bytes
ck ((CString -> IO Bytes) -> IO Bytes)
-> (CString -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \psrc :: CString
psrc ->
CString -> Int -> IO Word32
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff CString
psrc (Bytes -> Int
B.length Bytes
ck Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4) IO Word32 -> (Word32 -> IO Bytes) -> IO Bytes
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \dlen :: Word32
dlen ->
Int -> (Ptr Word8 -> IO ()) -> IO Bytes
B.create (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
dlen::Word32)) ((Ptr Word8 -> IO ()) -> IO Bytes)
-> (Ptr Word8 -> IO ()) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \pdest :: Ptr Word8
pdest -> do
CInt
rc <- Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO CInt
decompress_chunk Ptr Word8
pdest (Word32 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dlen) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
psrc) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ Bytes -> Int
B.length Bytes
ck)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DecompressionError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (DecompressionError -> IO ()) -> DecompressionError -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> DecompressionError
DecompressionError CInt
rc
encodeBgzf :: MonadIO m => Int -> Stream (Of (Endo BgzfTokens)) m b -> S.ByteStream m b
encodeBgzf :: Int -> Stream (Of (Endo BgzfTokens)) m b -> ByteStream m b
encodeBgzf lv :: Int
lv str :: Stream (Of (Endo BgzfTokens)) m b
str = do
Int
np <- IO Int -> ByteStream m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> ByteStream m Int) -> IO Int -> ByteStream m Int
forall a b. (a -> b) -> a -> b
$ IO Int
getNumCapabilities
BB
bb <- IO BB -> ByteStream m BB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BB -> ByteStream m BB) -> IO BB -> ByteStream m BB
forall a b. (a -> b) -> a -> b
$ Int -> IO BB
newBuffer (1024Int -> Int -> Int
forall a. Num a => a -> a -> a
*1024)
Stream (Of Bytes) m b -> ByteStream m b
forall (m :: * -> *) r.
Monad m =>
Stream (Of Bytes) m r -> ByteStream m r
S.fromChunks (Stream (Of Bytes) m b -> ByteStream m b)
-> Stream (Of Bytes) m b -> ByteStream m b
forall a b. (a -> b) -> a -> b
$ Int -> Stream (Of (IO Bytes)) m b -> Stream (Of Bytes) m b
forall (m :: * -> *) a b.
MonadIO m =>
Int -> Stream (Of (IO a)) m b -> Stream (Of a) m b
psequence (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
np) (Stream (Of (IO Bytes)) m b -> Stream (Of Bytes) m b)
-> Stream (Of (IO Bytes)) m b -> Stream (Of Bytes) m b
forall a b. (a -> b) -> a -> b
$ m (Either
b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b)))
-> Stream
(Of (IO Bytes))
m
(Either
b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of (Endo BgzfTokens)) m b
-> m (Either
b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream (Of (Endo BgzfTokens)) m b
str) Stream
(Of (IO Bytes))
m
(Either
b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b)))
-> (Either
b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b))
-> Stream (Of (IO Bytes)) m b)
-> Stream (Of (IO Bytes)) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BB
-> Either
b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b))
-> Stream (Of (IO Bytes)) m b
forall (m :: * -> *) b.
MonadIO m =>
BB
-> Either
b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b))
-> Stream (Of (IO Bytes)) m b
go BB
bb
where
go :: MonadIO m
=> BB
-> Either b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b))
-> Stream (Of (IO Bytes)) m b
go :: BB
-> Either
b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b))
-> Stream (Of (IO Bytes)) m b
go bb0 :: BB
bb0 (Left r :: b
r) = BB -> b -> Stream (Of (IO Bytes)) m b
forall (m :: * -> *) r.
Monad m =>
BB -> r -> Stream (Of (IO Bytes)) m r
final_flush BB
bb0 b
r
go bb0 :: BB
bb0 (Right (f :: Endo BgzfTokens
f :> s :: Stream (Of (Endo BgzfTokens)) m b
s))
| BB -> Int
size BB
bb0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
used BB
bb0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1024 = IO BB -> Stream (Of (IO Bytes)) m BB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> BB -> IO BB
expandBuffer (1024Int -> Int -> Int
forall a. Num a => a -> a -> a
*1024) BB
bb0) Stream (Of (IO Bytes)) m BB
-> (BB -> Stream (Of (IO Bytes)) m b) -> Stream (Of (IO Bytes)) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \bb' :: BB
bb' -> BB
-> BgzfTokens
-> Stream (Of (Endo BgzfTokens)) m b
-> Stream (Of (IO Bytes)) m b
forall (m :: * -> *) r.
MonadIO m =>
BB
-> BgzfTokens
-> Stream (Of (Endo BgzfTokens)) m r
-> Stream (Of (IO Bytes)) m r
go' BB
bb' (Endo BgzfTokens -> BgzfTokens -> BgzfTokens
forall a. Endo a -> a -> a
appEndo Endo BgzfTokens
f BgzfTokens
TkEnd) Stream (Of (Endo BgzfTokens)) m b
s
| Bool
otherwise = BB
-> BgzfTokens
-> Stream (Of (Endo BgzfTokens)) m b
-> Stream (Of (IO Bytes)) m b
forall (m :: * -> *) r.
MonadIO m =>
BB
-> BgzfTokens
-> Stream (Of (Endo BgzfTokens)) m r
-> Stream (Of (IO Bytes)) m r
go' BB
bb0 (Endo BgzfTokens -> BgzfTokens -> BgzfTokens
forall a. Endo a -> a -> a
appEndo Endo BgzfTokens
f BgzfTokens
TkEnd) Stream (Of (Endo BgzfTokens)) m b
s
go' :: BB
-> BgzfTokens
-> Stream (Of (Endo BgzfTokens)) m r
-> Stream (Of (IO Bytes)) m r
go' bb0 :: BB
bb0 tk :: BgzfTokens
tk s :: Stream (Of (Endo BgzfTokens)) m r
s = IO (BB, BgzfTokens) -> Stream (Of (IO Bytes)) m (BB, BgzfTokens)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BB -> BgzfTokens -> IO (BB, BgzfTokens)
fillBuffer BB
bb0 BgzfTokens
tk) Stream (Of (IO Bytes)) m (BB, BgzfTokens)
-> ((BB, BgzfTokens) -> Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(bb' :: BB
bb',tk' :: BgzfTokens
tk') -> BgzfTokens
-> BB
-> Stream (Of (Endo BgzfTokens)) m r
-> Stream (Of (IO Bytes)) m r
flush_blocks BgzfTokens
tk' BB
bb' Stream (Of (Endo BgzfTokens)) m r
s
flush_blocks :: BgzfTokens
-> BB
-> Stream (Of (Endo BgzfTokens)) m r
-> Stream (Of (IO Bytes)) m r
flush_blocks tk :: BgzfTokens
tk bb :: BB
bb s :: Stream (Of (Endo BgzfTokens)) m r
s
| Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (BB -> Int
mark BB
bb) (BB -> Int
used BB
bb) Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
off BB
bb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxBlockSize =
case BgzfTokens
tk of TkEnd -> m (Either
r (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m r)))
-> Stream
(Of (IO Bytes))
m
(Either
r (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m r)))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Stream (Of (Endo BgzfTokens)) m r
-> m (Either
r (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m r)))
forall (m :: * -> *) (f :: * -> *) r.
Monad m =>
Stream f m r -> m (Either r (f (Stream f m r)))
inspect Stream (Of (Endo BgzfTokens)) m r
s) Stream
(Of (IO Bytes))
m
(Either
r (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m r)))
-> (Either
r (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m r))
-> Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BB
-> Either
r (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m r))
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) b.
MonadIO m =>
BB
-> Either
b (Of (Endo BgzfTokens) (Stream (Of (Endo BgzfTokens)) m b))
-> Stream (Of (IO Bytes)) m b
go BB
bb
_ ->
IO BB -> Stream (Of (IO Bytes)) m BB
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Int -> BB -> IO BB
expandBuffer (1024Int -> Int -> Int
forall a. Num a => a -> a -> a
*1024) BB
bb) Stream (Of (IO Bytes)) m BB
-> (BB -> Stream (Of (IO Bytes)) m r) -> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \bb' :: BB
bb' -> BB
-> BgzfTokens
-> Stream (Of (Endo BgzfTokens)) m r
-> Stream (Of (IO Bytes)) m r
go' BB
bb' BgzfTokens
tk Stream (Of (Endo BgzfTokens)) m r
s
| Bool
otherwise =
Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r)
-> Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall a b. (a -> b) -> a -> b
$ Int -> ForeignPtr Word8 -> Int -> Int -> IO Bytes
compressChunk Int
lv (BB -> ForeignPtr Word8
buffer BB
bb) (BB -> Int
off BB
bb) Int
maxBlockSize
IO Bytes
-> Stream (Of (IO Bytes)) m r
-> Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
forall a b. a -> b -> Of a b
:> BgzfTokens
-> BB
-> Stream (Of (Endo BgzfTokens)) m r
-> Stream (Of (IO Bytes)) m r
flush_blocks BgzfTokens
tk BB
bb { off :: Int
off = BB -> Int
off BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxBlockSize } Stream (Of (Endo BgzfTokens)) m r
s
final_flush :: BB -> r -> Stream (Of (IO Bytes)) m r
final_flush bb :: BB
bb r :: r
r
| BB -> Int
used BB
bb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> BB -> Int
off BB
bb =
Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r)
-> Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall a b. (a -> b) -> a -> b
$ Int -> ForeignPtr Word8 -> Int -> Int -> IO Bytes
compressChunk Int
lv (BB -> ForeignPtr Word8
buffer BB
bb) (BB -> Int
off BB
bb) (BB -> Int
used BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
off BB
bb)
IO Bytes
-> Stream (Of (IO Bytes)) m r
-> Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
forall a b. a -> b -> Of a b
:> Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
bgzfEofMarker IO Bytes
-> Stream (Of (IO Bytes)) m r
-> Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
forall a b. a -> b -> Of a b
:> r -> Stream (Of (IO Bytes)) m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r)
| Bool
otherwise =
Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
-> Stream (Of (IO Bytes)) m r
forall (m :: * -> *) (f :: * -> *) r.
(Monad m, Functor f) =>
f (Stream f m r) -> Stream f m r
wrap (Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
bgzfEofMarker IO Bytes
-> Stream (Of (IO Bytes)) m r
-> Of (IO Bytes) (Stream (Of (IO Bytes)) m r)
forall a b. a -> b -> Of a b
:> r -> Stream (Of (IO Bytes)) m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r)
maxBlockSize :: Int
maxBlockSize = 65478
fillBuffer :: BB -> BgzfTokens -> IO (BB, BgzfTokens)
fillBuffer :: BB -> BgzfTokens -> IO (BB, BgzfTokens)
fillBuffer bb0 :: BB
bb0 tk :: BgzfTokens
tk = ForeignPtr Word8
-> (Ptr Word8 -> IO (BB, BgzfTokens)) -> IO (BB, BgzfTokens)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (BB -> ForeignPtr Word8
buffer BB
bb0) (\p :: Ptr Word8
p -> Ptr Word8 -> BB -> BgzfTokens -> IO (BB, BgzfTokens)
forall a. Ptr a -> BB -> BgzfTokens -> IO (BB, BgzfTokens)
go_slowish Ptr Word8
p BB
bb0 BgzfTokens
tk)
where
go_slowish :: Ptr a -> BB -> BgzfTokens -> IO (BB, BgzfTokens)
go_slowish p :: Ptr a
p bb :: BB
bb = Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (BB -> Int
used BB
bb)
go_fast :: Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast p :: Ptr a
p bb :: BB
bb use :: Int
use tk1 :: BgzfTokens
tk1 = case BgzfTokens
tk1 of
_ | BB -> Int
size BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
use Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1024 -> (BB, BgzfTokens) -> IO (BB, BgzfTokens)
forall (m :: * -> *) a. Monad m => a -> m a
return (BB
bb { used :: Int
used = Int
use },BgzfTokens
tk1)
TkEnd -> (BB, BgzfTokens) -> IO (BB, BgzfTokens)
forall (m :: * -> *) a. Monad m => a -> m a
return (BB
bb { used :: Int
used = Int
use },BgzfTokens
tk1)
TkWord32 x :: Word32
x tk' :: BgzfTokens
tk' -> do Ptr a -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
use Word32
x
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4) BgzfTokens
tk'
TkWord16 x :: Word16
x tk' :: BgzfTokens
tk' -> do Ptr a -> Int -> Word16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
use Word16
x
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) BgzfTokens
tk'
TkWord8 x :: Word8
x tk' :: BgzfTokens
tk' -> do Ptr a -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
use Word8
x
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) BgzfTokens
tk'
TkFloat x :: Float
x tk' :: BgzfTokens
tk' -> do Ptr a -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
use Float
x
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4) BgzfTokens
tk'
TkDouble x :: Double
x tk' :: BgzfTokens
tk' -> do Ptr a -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
use Double
x
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 8) BgzfTokens
tk'
TkString s :: Bytes
s tk' :: BgzfTokens
tk'
| Bytes -> Int
B.length Bytes
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> BB -> Int
size BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
use -> (BB, BgzfTokens) -> IO (BB, BgzfTokens)
forall (m :: * -> *) a. Monad m => a -> m a
return (BB
bb { used :: Int
used = Int
use },BgzfTokens
tk1)
| Bool
otherwise -> do let ln :: Int
ln = Bytes -> Int
B.length Bytes
s
Bytes -> (CString -> IO ()) -> IO ()
forall a. Bytes -> (CString -> IO a) -> IO a
B.unsafeUseAsCString Bytes
s ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \q :: CString
q ->
CString -> CString -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr a
p Ptr a -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
use) CString
q Int
ln
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ln) BgzfTokens
tk'
TkMemFill ln :: Int
ln c :: Word8
c tk' :: BgzfTokens
tk'
| Int
ln Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> BB -> Int
size BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
use -> (BB, BgzfTokens) -> IO (BB, BgzfTokens)
forall (m :: * -> *) a. Monad m => a -> m a
return (BB
bb { used :: Int
used = Int
use },BgzfTokens
tk1)
| Bool
otherwise -> do Ptr Any -> Word8 -> Int -> IO ()
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes (Ptr a
p Ptr a -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
use) Word8
c Int
ln
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ln) BgzfTokens
tk'
TkMemCopy v :: Vector Word8
v tk' :: BgzfTokens
tk'
| Vector Word8 -> Int
forall a. Storable a => Vector a -> Int
V.length Vector Word8
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> BB -> Int
size BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
use -> (BB, BgzfTokens) -> IO (BB, BgzfTokens)
forall (m :: * -> *) a. Monad m => a -> m a
return (BB
bb { used :: Int
used = Int
use },BgzfTokens
tk1)
| Bool
otherwise -> do let ln :: Int
ln = Vector Word8 -> Int
forall a. Storable a => Vector a -> Int
V.length Vector Word8
v
Vector Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
V.unsafeWith Vector Word8
v ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \q :: Ptr Word8
q ->
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr a
p Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
use) Ptr Word8
q Int
ln
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ln) BgzfTokens
tk'
TkDecimal x :: Int
x tk' :: BgzfTokens
tk' -> do CInt
ln <- Ptr Word8 -> CInt -> IO CInt
int_loop (Ptr a
p Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
use) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
ln) BgzfTokens
tk'
TkSetMark tk' :: BgzfTokens
tk' -> Ptr a -> BB -> BgzfTokens -> IO (BB, BgzfTokens)
go_slowish Ptr a
p BB
bb { used :: Int
used = Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4, mark :: Int
mark = Int
use } BgzfTokens
tk'
TkEndRecord tk' :: BgzfTokens
tk' -> do let !l :: Int
l = Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
mark BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4
Ptr a -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p (BB -> Int
mark BB
bb) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l :: Word32)
Ptr a -> BB -> BgzfTokens -> IO (BB, BgzfTokens)
go_slowish Ptr a
p BB
bb { used :: Int
used = Int
use, mark :: Int
mark = Int
forall a. Bounded a => a
maxBound } BgzfTokens
tk'
TkEndRecordPart1 tk' :: BgzfTokens
tk' -> do let !l :: Int
l = Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
mark BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4
Ptr a -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p (BB -> Int
mark BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l :: Word32)
Ptr a -> BB -> BgzfTokens -> IO (BB, BgzfTokens)
go_slowish Ptr a
p BB
bb { used :: Int
used = Int
use, mark2 :: Int
mark2 = Int
use } BgzfTokens
tk'
TkEndRecordPart2 tk' :: BgzfTokens
tk' -> do let !l :: Int
l = Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
- BB -> Int
mark2 BB
bb
Ptr a -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p (BB -> Int
mark BB
bb) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l :: Word32)
Ptr a -> BB -> BgzfTokens -> IO (BB, BgzfTokens)
go_slowish Ptr a
p BB
bb { used :: Int
used = Int
use, mark :: Int
mark = Int
forall a. Bounded a => a
maxBound } BgzfTokens
tk'
TkBclSpecial special_args :: BclArgs
special_args tk' :: BgzfTokens
tk' -> do
Int
l <- Ptr Word8 -> BclArgs -> IO Int
loop_bcl_special (Ptr a
p Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
use) BclArgs
special_args
Ptr a -> BB -> Int -> BgzfTokens -> IO (BB, BgzfTokens)
go_fast Ptr a
p BB
bb (Int
use Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) BgzfTokens
tk'
TkLowLevel minsize :: Int
minsize proc :: BB -> IO BB
proc tk' :: BgzfTokens
tk'
| BB -> Int
size BB
bb Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
use Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minsize -> (BB, BgzfTokens) -> IO (BB, BgzfTokens)
forall (m :: * -> *) a. Monad m => a -> m a
return (BB
bb { used :: Int
used = Int
use },BgzfTokens
tk1)
| Bool
otherwise -> do BB
bb' <- BB -> IO BB
proc BB
bb { used :: Int
used = Int
use }
Ptr a -> BB -> BgzfTokens -> IO (BB, BgzfTokens)
go_slowish Ptr a
p BB
bb' BgzfTokens
tk'
bgzfEofMarker :: Bytes
bgzfEofMarker :: Bytes
bgzfEofMarker = "\x1f\x8b\x8\x4\0\0\0\0\0\xff\x6\0\x42\x43\x2\0\x1b\0\x3\0\0\0\0\0\0\0\0\0"
loop_dec_int :: Ptr Word8 -> Int -> IO Int
loop_dec_int :: Ptr Word8 -> Int -> IO Int
loop_dec_int p :: Ptr Word8
p i :: Int
i = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> CInt -> IO CInt
int_loop Ptr Word8
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
loop_bcl_special :: Ptr Word8 -> BclArgs -> IO Int
loop_bcl_special :: Ptr Word8 -> BclArgs -> IO Int
loop_bcl_special p :: Ptr Word8
p (BclArgs tp :: BclSpecialType
tp vec :: Vector Word8
vec stride :: Int
stride u :: Int
u v :: Int
v i :: Int
i) =
Vector Word8 -> (Ptr Word8 -> IO Int) -> IO Int
forall a b. Storable a => Vector a -> (Ptr a -> IO b) -> IO b
V.unsafeWith Vector Word8
vec ((Ptr Word8 -> IO Int) -> IO Int)
-> (Ptr Word8 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \q :: Ptr Word8
q -> case BclSpecialType
tp of
BclNucsBin -> do
Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
nuc_loop Ptr Word8
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stride) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
q Int
i) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
BclNucsWide -> do
Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
nuc_loop_wide Ptr Word8
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stride) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
q Int
i) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
BclNucsAsc -> do
Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
nuc_loop_asc Ptr Word8
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stride) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
q Int
i) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
BclNucsAscRev -> do
Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
nuc_loop_asc_rev Ptr Word8
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stride) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
q Int
i) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
BclQualsBin -> do
Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
qual_loop Ptr Word8
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stride) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
q Int
i) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
BclQualsAsc -> do
Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
qual_loop_asc Ptr Word8
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stride) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
q Int
i) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
BclQualsAscRev -> do
Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
qual_loop_asc_rev Ptr Word8
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stride) (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
q Int
i) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
u Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
foreign import ccall unsafe "nuc_loop"
nuc_loop :: Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
foreign import ccall unsafe "nuc_loop_wide"
nuc_loop_wide :: Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
foreign import ccall unsafe "nuc_loop_asc"
nuc_loop_asc :: Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
foreign import ccall unsafe "nuc_loop_asc_rev"
nuc_loop_asc_rev :: Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
foreign import ccall unsafe "qual_loop"
qual_loop :: Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
foreign import ccall unsafe "qual_loop_asc"
qual_loop_asc :: Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
foreign import ccall unsafe "qual_loop_asc_rev"
qual_loop_asc_rev :: Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO ()
foreign import ccall unsafe "int_loop"
int_loop :: Ptr Word8 -> CInt -> IO CInt
foreign import ccall unsafe "compress_chunk"
compress_chunk :: Ptr Word8 -> Ptr CInt -> Ptr Word8 -> CInt -> CInt -> IO CInt
foreign import ccall unsafe "decompress_chunk"
decompress_chunk :: Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO CInt