{-# LANGUAGE TypeFamilies #-}
-- | Parsers and Printers for BAM and SAM.

module Bio.Bam.Rec (
    BamRaw,
    bamRaw,
    virt_offset,
    raw_data,
    br_copy,

    BamRec(..),
    unpackBam,
    nullBamRec,
    getMd,
    LengthMismatch(..),
    BrokenRecord(..),

    Cigar(..),
    CigOp(..),
    alignedLength,

    Nucleotides(..), Vector_Nucs_half(..),
    Extensions, Ext(..),
    extAsInt, extAsString, setQualFlag,
    deleteE, insertE, updateE, adjustE,

    isPaired,
    isProperlyPaired,
    isUnmapped,
    isMateUnmapped,
    isReversed,
    isMateReversed,
    isFirstMate,
    isSecondMate,
    isSecondary,
    isFailsQC,
    isDuplicate,
    isSupplementary,
    isTrimmed,
    isMerged,
    isAlternative,
    isExactIndex,
    type_mask
) where

import Bio.Bam.Header
import Bio.Prelude
import Bio.Util.Storable

import Control.Monad.Primitive      ( unsafePrimToPrim, unsafeInlineIO )
import Foreign.C.Types              ( CInt(..), CSize(..) )
import Foreign.Marshal.Alloc        ( alloca )

import qualified Data.ByteString                    as B
import qualified Data.ByteString.Char8              as S
import qualified Data.ByteString.Internal           as B
import qualified Data.ByteString.Unsafe             as B
import qualified Data.Vector.Generic                as V
import qualified Data.Vector.Generic.Mutable        as VM
import qualified Data.Vector.Storable               as VS
import qualified Data.Vector.Unboxed                as U


-- | Cigar line in BAM coding
-- Bam encodes an operation and a length into a single integer, we keep
-- those integers in an array.
data Cigar = !CigOp :* !Int deriving (Cigar -> Cigar -> Bool
(Cigar -> Cigar -> Bool) -> (Cigar -> Cigar -> Bool) -> Eq Cigar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cigar -> Cigar -> Bool
$c/= :: Cigar -> Cigar -> Bool
== :: Cigar -> Cigar -> Bool
$c== :: Cigar -> Cigar -> Bool
Eq, Eq Cigar
Eq Cigar =>
(Cigar -> Cigar -> Ordering)
-> (Cigar -> Cigar -> Bool)
-> (Cigar -> Cigar -> Bool)
-> (Cigar -> Cigar -> Bool)
-> (Cigar -> Cigar -> Bool)
-> (Cigar -> Cigar -> Cigar)
-> (Cigar -> Cigar -> Cigar)
-> Ord Cigar
Cigar -> Cigar -> Bool
Cigar -> Cigar -> Ordering
Cigar -> Cigar -> Cigar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Cigar -> Cigar -> Cigar
$cmin :: Cigar -> Cigar -> Cigar
max :: Cigar -> Cigar -> Cigar
$cmax :: Cigar -> Cigar -> Cigar
>= :: Cigar -> Cigar -> Bool
$c>= :: Cigar -> Cigar -> Bool
> :: Cigar -> Cigar -> Bool
$c> :: Cigar -> Cigar -> Bool
<= :: Cigar -> Cigar -> Bool
$c<= :: Cigar -> Cigar -> Bool
< :: Cigar -> Cigar -> Bool
$c< :: Cigar -> Cigar -> Bool
compare :: Cigar -> Cigar -> Ordering
$ccompare :: Cigar -> Cigar -> Ordering
$cp1Ord :: Eq Cigar
Ord)
infix 9 :*

data CigOp = Mat | Ins | Del | Nop | SMa | HMa | Pad
    deriving ( CigOp -> CigOp -> Bool
(CigOp -> CigOp -> Bool) -> (CigOp -> CigOp -> Bool) -> Eq CigOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CigOp -> CigOp -> Bool
$c/= :: CigOp -> CigOp -> Bool
== :: CigOp -> CigOp -> Bool
$c== :: CigOp -> CigOp -> Bool
Eq, Eq CigOp
Eq CigOp =>
(CigOp -> CigOp -> Ordering)
-> (CigOp -> CigOp -> Bool)
-> (CigOp -> CigOp -> Bool)
-> (CigOp -> CigOp -> Bool)
-> (CigOp -> CigOp -> Bool)
-> (CigOp -> CigOp -> CigOp)
-> (CigOp -> CigOp -> CigOp)
-> Ord CigOp
CigOp -> CigOp -> Bool
CigOp -> CigOp -> Ordering
CigOp -> CigOp -> CigOp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CigOp -> CigOp -> CigOp
$cmin :: CigOp -> CigOp -> CigOp
max :: CigOp -> CigOp -> CigOp
$cmax :: CigOp -> CigOp -> CigOp
>= :: CigOp -> CigOp -> Bool
$c>= :: CigOp -> CigOp -> Bool
> :: CigOp -> CigOp -> Bool
$c> :: CigOp -> CigOp -> Bool
<= :: CigOp -> CigOp -> Bool
$c<= :: CigOp -> CigOp -> Bool
< :: CigOp -> CigOp -> Bool
$c< :: CigOp -> CigOp -> Bool
compare :: CigOp -> CigOp -> Ordering
$ccompare :: CigOp -> CigOp -> Ordering
$cp1Ord :: Eq CigOp
Ord, Int -> CigOp
CigOp -> Int
CigOp -> [CigOp]
CigOp -> CigOp
CigOp -> CigOp -> [CigOp]
CigOp -> CigOp -> CigOp -> [CigOp]
(CigOp -> CigOp)
-> (CigOp -> CigOp)
-> (Int -> CigOp)
-> (CigOp -> Int)
-> (CigOp -> [CigOp])
-> (CigOp -> CigOp -> [CigOp])
-> (CigOp -> CigOp -> [CigOp])
-> (CigOp -> CigOp -> CigOp -> [CigOp])
-> Enum CigOp
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CigOp -> CigOp -> CigOp -> [CigOp]
$cenumFromThenTo :: CigOp -> CigOp -> CigOp -> [CigOp]
enumFromTo :: CigOp -> CigOp -> [CigOp]
$cenumFromTo :: CigOp -> CigOp -> [CigOp]
enumFromThen :: CigOp -> CigOp -> [CigOp]
$cenumFromThen :: CigOp -> CigOp -> [CigOp]
enumFrom :: CigOp -> [CigOp]
$cenumFrom :: CigOp -> [CigOp]
fromEnum :: CigOp -> Int
$cfromEnum :: CigOp -> Int
toEnum :: Int -> CigOp
$ctoEnum :: Int -> CigOp
pred :: CigOp -> CigOp
$cpred :: CigOp -> CigOp
succ :: CigOp -> CigOp
$csucc :: CigOp -> CigOp
Enum, Int -> CigOp -> ShowS
[CigOp] -> ShowS
CigOp -> String
(Int -> CigOp -> ShowS)
-> (CigOp -> String) -> ([CigOp] -> ShowS) -> Show CigOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CigOp] -> ShowS
$cshowList :: [CigOp] -> ShowS
show :: CigOp -> String
$cshow :: CigOp -> String
showsPrec :: Int -> CigOp -> ShowS
$cshowsPrec :: Int -> CigOp -> ShowS
Show, CigOp
CigOp -> CigOp -> Bounded CigOp
forall a. a -> a -> Bounded a
maxBound :: CigOp
$cmaxBound :: CigOp
minBound :: CigOp
$cminBound :: CigOp
Bounded, Ord CigOp
Ord CigOp =>
((CigOp, CigOp) -> [CigOp])
-> ((CigOp, CigOp) -> CigOp -> Int)
-> ((CigOp, CigOp) -> CigOp -> Int)
-> ((CigOp, CigOp) -> CigOp -> Bool)
-> ((CigOp, CigOp) -> Int)
-> ((CigOp, CigOp) -> Int)
-> Ix CigOp
(CigOp, CigOp) -> Int
(CigOp, CigOp) -> [CigOp]
(CigOp, CigOp) -> CigOp -> Bool
(CigOp, CigOp) -> CigOp -> Int
forall a.
Ord a =>
((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (CigOp, CigOp) -> Int
$cunsafeRangeSize :: (CigOp, CigOp) -> Int
rangeSize :: (CigOp, CigOp) -> Int
$crangeSize :: (CigOp, CigOp) -> Int
inRange :: (CigOp, CigOp) -> CigOp -> Bool
$cinRange :: (CigOp, CigOp) -> CigOp -> Bool
unsafeIndex :: (CigOp, CigOp) -> CigOp -> Int
$cunsafeIndex :: (CigOp, CigOp) -> CigOp -> Int
index :: (CigOp, CigOp) -> CigOp -> Int
$cindex :: (CigOp, CigOp) -> CigOp -> Int
range :: (CigOp, CigOp) -> [CigOp]
$crange :: (CigOp, CigOp) -> [CigOp]
$cp1Ix :: Ord CigOp
Ix )

instance Show Cigar where
    showsPrec :: Int -> Cigar -> ShowS
showsPrec _ (op :: CigOp
op :* num :: Int
num) = Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
num ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:) (ByteString -> Int -> Char
S.index "MIDNSHP" (CigOp -> Int
forall a. Enum a => a -> Int
fromEnum CigOp
op))

instance Storable Cigar where
    sizeOf :: Cigar -> Int
sizeOf    _ = 4
    alignment :: Cigar -> Int
alignment _ = 1

    peek :: Ptr Cigar -> IO Cigar
peek p :: Ptr Cigar
p = do Int
w <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Cigar -> IO Word32
forall a. Ptr a -> IO Word32
peekUnalnWord32LE Ptr Cigar
p
                Cigar -> IO Cigar
forall (m :: * -> *) a. Monad m => a -> m a
return (Cigar -> IO Cigar) -> Cigar -> IO Cigar
forall a b. (a -> b) -> a -> b
$ Int -> CigOp
forall a. Enum a => Int -> a
toEnum (Int
w Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xf) CigOp -> Int -> Cigar
:* Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
w 4

    poke :: Ptr Cigar -> Cigar -> IO ()
poke p :: Ptr Cigar
p (op :: CigOp
op :* num :: Int
num) = Ptr Cigar -> Word32 -> IO ()
forall a. Ptr a -> Word32 -> IO ()
pokeUnalnWord32LE Ptr Cigar
p (Word32 -> IO ()) -> (Int -> Word32) -> Int -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ CigOp -> Int
forall a. Enum a => a -> Int
fromEnum CigOp
op Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftL Int
num 4


-- | Extracts the aligned length from a cigar line.
-- This gives the length of an alignment as measured on the reference,
-- which is different from the length on the query or the length of the
-- alignment.
{-# INLINE alignedLength #-}
alignedLength :: V.Vector v Cigar => v Cigar -> Int
alignedLength :: v Cigar -> Int
alignedLength = (Int -> Cigar -> Int) -> Int -> v Cigar -> Int
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
V.foldl' (\a :: Int
a -> (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Cigar -> Int) -> Cigar -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Cigar -> Int
l) 0
  where l :: Cigar -> Int
l (op :: CigOp
op :* n :: Int
n) = if CigOp
op CigOp -> CigOp -> Bool
forall a. Eq a => a -> a -> Bool
== CigOp
Mat Bool -> Bool -> Bool
|| CigOp
op CigOp -> CigOp -> Bool
forall a. Eq a => a -> a -> Bool
== CigOp
Del Bool -> Bool -> Bool
|| CigOp
op CigOp -> CigOp -> Bool
forall a. Eq a => a -> a -> Bool
== CigOp
Nop then Int
n else 0


-- | More convenient representation of a BAM record.
-- Invariant: Either @b_qual == Nothing@ or
-- @fmap V.length b_qual == Just (V.length b_seq)@.
data BamRec = BamRec {
        BamRec -> ByteString
b_qname :: Bytes,
        BamRec -> Int
b_flag  :: Int,
        BamRec -> Refseq
b_rname :: Refseq,
        BamRec -> Int
b_pos   :: Int,
        BamRec -> Qual
b_mapq  :: Qual,
        BamRec -> Vector Cigar
b_cigar :: VS.Vector Cigar,
        BamRec -> Refseq
b_mrnm  :: Refseq,
        BamRec -> Int
b_mpos  :: Int,
        BamRec -> Int
b_isize :: Int,
        BamRec -> Vector_Nucs_half Nucleotides
b_seq   :: Vector_Nucs_half Nucleotides,
        BamRec -> Maybe (Vector Qual)
b_qual  :: Maybe (VS.Vector Qual),
        BamRec -> Extensions
b_exts  :: Extensions,
        BamRec -> Int64
b_virtual_offset :: Int64 -- ^ virtual offset for indexing purposes
    } deriving Int -> BamRec -> ShowS
[BamRec] -> ShowS
BamRec -> String
(Int -> BamRec -> ShowS)
-> (BamRec -> String) -> ([BamRec] -> ShowS) -> Show BamRec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BamRec] -> ShowS
$cshowList :: [BamRec] -> ShowS
show :: BamRec -> String
$cshow :: BamRec -> String
showsPrec :: Int -> BamRec -> ShowS
$cshowsPrec :: Int -> BamRec -> ShowS
Show

nullBamRec :: BamRec
nullBamRec :: BamRec
nullBamRec = BamRec :: ByteString
-> Int
-> Refseq
-> Int
-> Qual
-> Vector Cigar
-> Refseq
-> Int
-> Int
-> Vector_Nucs_half Nucleotides
-> Maybe (Vector Qual)
-> Extensions
-> Int64
-> BamRec
BamRec {
        b_qname :: ByteString
b_qname = ByteString
S.empty,
        b_flag :: Int
b_flag  = Int
flagUnmapped,
        b_rname :: Refseq
b_rname = Refseq
invalidRefseq,
        b_pos :: Int
b_pos   = Int
invalidPos,
        b_mapq :: Qual
b_mapq  = Word8 -> Qual
Q 0,
        b_cigar :: Vector Cigar
b_cigar = Vector Cigar
forall a. Storable a => Vector a
VS.empty,
        b_mrnm :: Refseq
b_mrnm  = Refseq
invalidRefseq,
        b_mpos :: Int
b_mpos  = Int
invalidPos,
        b_isize :: Int
b_isize = 0,
        b_seq :: Vector_Nucs_half Nucleotides
b_seq   = Vector_Nucs_half Nucleotides
forall (v :: * -> *) a. Vector v a => v a
V.empty,
        b_qual :: Maybe (Vector Qual)
b_qual  = Maybe (Vector Qual)
forall a. Maybe a
Nothing,
        b_exts :: Extensions
b_exts  = [],
        b_virtual_offset :: Int64
b_virtual_offset = 0
    }

getMd :: BamRec -> Maybe [MdOp]
getMd :: BamRec -> Maybe [MdOp]
getMd r :: BamRec
r = case BamKey -> Extensions -> Maybe Ext
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "MD" (Extensions -> Maybe Ext) -> Extensions -> Maybe Ext
forall a b. (a -> b) -> a -> b
$ BamRec -> Extensions
b_exts BamRec
r of
    Just (Text mdfield :: ByteString
mdfield) -> ByteString -> Maybe [MdOp]
readMd ByteString
mdfield
    Just (Char mdfield :: Word8
mdfield) -> ByteString -> Maybe [MdOp]
readMd (ByteString -> Maybe [MdOp]) -> ByteString -> Maybe [MdOp]
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString
B.singleton Word8
mdfield
    _                   -> Maybe [MdOp]
forall a. Maybe a
Nothing

data LengthMismatch = LengthMismatch !Bytes deriving (Typeable, Int -> LengthMismatch -> ShowS
[LengthMismatch] -> ShowS
LengthMismatch -> String
(Int -> LengthMismatch -> ShowS)
-> (LengthMismatch -> String)
-> ([LengthMismatch] -> ShowS)
-> Show LengthMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LengthMismatch] -> ShowS
$cshowList :: [LengthMismatch] -> ShowS
show :: LengthMismatch -> String
$cshow :: LengthMismatch -> String
showsPrec :: Int -> LengthMismatch -> ShowS
$cshowsPrec :: Int -> LengthMismatch -> ShowS
Show)
instance Exception LengthMismatch where
    displayException :: LengthMismatch -> String
displayException (LengthMismatch nm :: ByteString
nm) =
        "length of nucleotide and quality sequences" String -> ShowS
forall a. [a] -> [a] -> [a]
++
        (if ByteString -> Bool
B.null ByteString
nm then "" else " in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall s. Unpack s => s -> String
unpack ByteString
nm) String -> ShowS
forall a. [a] -> [a] -> [a]
++
        " must be equal"


-- | A vector that packs two 'Nucleotides' into one byte, just like Bam does.
data Vector_Nucs_half a = Vector_Nucs_half !Int !Int !(ForeignPtr Word8)

-- | A mutable vector that packs two 'Nucleotides' into one byte, just like Bam does.
data MVector_Nucs_half s a = MVector_Nucs_half !Int !Int !(ForeignPtr Word8)

type instance V.Mutable Vector_Nucs_half = MVector_Nucs_half

instance V.Vector Vector_Nucs_half Nucleotides where
    {-# INLINE basicUnsafeFreeze #-}
    basicUnsafeFreeze :: Mutable Vector_Nucs_half (PrimState m) Nucleotides
-> m (Vector_Nucs_half Nucleotides)
basicUnsafeFreeze (MVector_Nucs_half o l fp) = Vector_Nucs_half Nucleotides -> m (Vector_Nucs_half Nucleotides)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector_Nucs_half Nucleotides -> m (Vector_Nucs_half Nucleotides))
-> Vector_Nucs_half Nucleotides -> m (Vector_Nucs_half Nucleotides)
forall a b. (a -> b) -> a -> b
$  Int -> Int -> ForeignPtr Word8 -> Vector_Nucs_half Nucleotides
forall a. Int -> Int -> ForeignPtr Word8 -> Vector_Nucs_half a
Vector_Nucs_half Int
o Int
l ForeignPtr Word8
fp
    {-# INLINE basicUnsafeThaw #-}
    basicUnsafeThaw :: Vector_Nucs_half Nucleotides
-> m (Mutable Vector_Nucs_half (PrimState m) Nucleotides)
basicUnsafeThaw    (Vector_Nucs_half o :: Int
o l :: Int
l fp :: ForeignPtr Word8
fp) = MVector_Nucs_half (PrimState m) Nucleotides
-> m (Mutable Vector_Nucs_half (PrimState m) Nucleotides)
forall (m :: * -> *) a. Monad m => a -> m a
return (MVector_Nucs_half (PrimState m) Nucleotides
 -> m (Mutable Vector_Nucs_half (PrimState m) Nucleotides))
-> MVector_Nucs_half (PrimState m) Nucleotides
-> m (Mutable Vector_Nucs_half (PrimState m) Nucleotides)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> ForeignPtr Word8
-> MVector_Nucs_half (PrimState m) Nucleotides
forall s a. Int -> Int -> ForeignPtr Word8 -> MVector_Nucs_half s a
MVector_Nucs_half Int
o Int
l ForeignPtr Word8
fp

    {-# INLINE basicLength #-}
    basicLength :: Vector_Nucs_half Nucleotides -> Int
basicLength          (Vector_Nucs_half _ l :: Int
l  _) = Int
l
    {-# INLINE basicUnsafeSlice #-}
    basicUnsafeSlice :: Int
-> Int
-> Vector_Nucs_half Nucleotides
-> Vector_Nucs_half Nucleotides
basicUnsafeSlice s :: Int
s l :: Int
l (Vector_Nucs_half o :: Int
o _ fp :: ForeignPtr Word8
fp) = Int -> Int -> ForeignPtr Word8 -> Vector_Nucs_half Nucleotides
forall a. Int -> Int -> ForeignPtr Word8 -> Vector_Nucs_half a
Vector_Nucs_half (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) Int
l ForeignPtr Word8
fp

    {-# INLINE basicUnsafeIndexM #-}
    basicUnsafeIndexM :: Vector_Nucs_half Nucleotides -> Int -> m Nucleotides
basicUnsafeIndexM (Vector_Nucs_half o :: Int
o _ fp :: ForeignPtr Word8
fp) i :: Int
i
        | Int -> Bool
forall a. Integral a => a -> Bool
even (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) = Nucleotides -> m Nucleotides
forall (m :: * -> *) a. Monad m => a -> m a
return (Nucleotides -> m Nucleotides)
-> (Word8 -> Nucleotides) -> Word8 -> m Nucleotides
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Nucleotides
Ns (Word8 -> m Nucleotides) -> Word8 -> m Nucleotides
forall a b. (a -> b) -> a -> b
$! (Word8
b Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xF
        | Bool
otherwise  = Nucleotides -> m Nucleotides
forall (m :: * -> *) a. Monad m => a -> m a
return (Nucleotides -> m Nucleotides)
-> (Word8 -> Nucleotides) -> Word8 -> m Nucleotides
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Nucleotides
Ns (Word8 -> m Nucleotides) -> Word8 -> m Nucleotides
forall a b. (a -> b) -> a -> b
$!  Word8
b             Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xF
      where !b :: Word8
b = IO Word8 -> Word8
forall a. IO a -> a
unsafeInlineIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Word8
p -> Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p ((Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 1)

instance VM.MVector MVector_Nucs_half Nucleotides where
    {-# INLINE basicLength #-}
    basicLength :: MVector_Nucs_half s Nucleotides -> Int
basicLength          (MVector_Nucs_half _ l :: Int
l  _) = Int
l
    {-# INLINE basicUnsafeSlice #-}
    basicUnsafeSlice :: Int
-> Int
-> MVector_Nucs_half s Nucleotides
-> MVector_Nucs_half s Nucleotides
basicUnsafeSlice s :: Int
s l :: Int
l (MVector_Nucs_half o :: Int
o _ fp :: ForeignPtr Word8
fp) = Int -> Int -> ForeignPtr Word8 -> MVector_Nucs_half s Nucleotides
forall s a. Int -> Int -> ForeignPtr Word8 -> MVector_Nucs_half s a
MVector_Nucs_half (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s) Int
l ForeignPtr Word8
fp

    {-# INLINE basicOverlaps #-}
    basicOverlaps :: MVector_Nucs_half s Nucleotides
-> MVector_Nucs_half s Nucleotides -> Bool
basicOverlaps (MVector_Nucs_half _ _ fp1 :: ForeignPtr Word8
fp1) (MVector_Nucs_half _ _ fp2 :: ForeignPtr Word8
fp2) = ForeignPtr Word8
fp1 ForeignPtr Word8 -> ForeignPtr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignPtr Word8
fp2
    {-# INLINE basicUnsafeNew #-}
    basicUnsafeNew :: Int -> m (MVector_Nucs_half (PrimState m) Nucleotides)
basicUnsafeNew l :: Int
l = IO (MVector_Nucs_half (PrimState m) Nucleotides)
-> m (MVector_Nucs_half (PrimState m) Nucleotides)
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO (MVector_Nucs_half (PrimState m) Nucleotides)
 -> m (MVector_Nucs_half (PrimState m) Nucleotides))
-> IO (MVector_Nucs_half (PrimState m) Nucleotides)
-> m (MVector_Nucs_half (PrimState m) Nucleotides)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> ForeignPtr Word8
-> MVector_Nucs_half (PrimState m) Nucleotides
forall s a. Int -> Int -> ForeignPtr Word8 -> MVector_Nucs_half s a
MVector_Nucs_half 0 Int
l (ForeignPtr Word8 -> MVector_Nucs_half (PrimState m) Nucleotides)
-> IO (ForeignPtr Word8)
-> IO (MVector_Nucs_half (PrimState m) Nucleotides)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes ((Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 1)

    {-# INLINE basicInitialize #-}
    basicInitialize :: MVector_Nucs_half (PrimState m) Nucleotides -> m ()
basicInitialize v :: MVector_Nucs_half (PrimState m) Nucleotides
v@(MVector_Nucs_half o :: Int
o l :: Int
l fp :: ForeignPtr Word8
fp)

        | Int -> Bool
forall a. Integral a => a -> Bool
even    Int
o = do IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Word8
p ->
                            Ptr Word8 -> CInt -> CSize -> IO ()
memset (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p (Int
o Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 1)) 0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Int
l Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 1)
                         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
forall a. Integral a => a -> Bool
odd Int
l) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MVector_Nucs_half (PrimState m) Nucleotides
-> Int -> Nucleotides -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VM.basicUnsafeWrite MVector_Nucs_half (PrimState m) Nucleotides
v (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (Word8 -> Nucleotides
Ns 0)

        | Bool
otherwise = do Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
forall a. Integral a => a -> Bool
odd Int
o) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MVector_Nucs_half (PrimState m) Nucleotides
-> Int -> Nucleotides -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VM.basicUnsafeWrite MVector_Nucs_half (PrimState m) Nucleotides
v 0 (Word8 -> Nucleotides
Ns 0)
                         IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Word8
p ->
                            Ptr Word8 -> CInt -> CSize -> IO ()
memset (Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
p ((Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 1)) 0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 1)
                         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
forall a. Integral a => a -> Bool
even Int
l) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MVector_Nucs_half (PrimState m) Nucleotides
-> Int -> Nucleotides -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VM.basicUnsafeWrite MVector_Nucs_half (PrimState m) Nucleotides
v (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) (Word8 -> Nucleotides
Ns 0)


    {-# INLINE basicUnsafeRead #-}
    basicUnsafeRead :: MVector_Nucs_half (PrimState m) Nucleotides -> Int -> m Nucleotides
basicUnsafeRead (MVector_Nucs_half o :: Int
o _ fp :: ForeignPtr Word8
fp) i :: Int
i
        | Int -> Bool
forall a. Integral a => a -> Bool
even (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) = (Word8 -> Nucleotides) -> m Word8 -> m Nucleotides
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Word8 -> Nucleotides
Ns (Word8 -> Nucleotides) -> (Word8 -> Word8) -> Word8 -> Nucleotides
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.&.) 0xF (Word8 -> Word8) -> (Word8 -> Word8) -> Word8 -> Word8
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` 4)) m Word8
b
        | Bool
otherwise  = (Word8 -> Nucleotides) -> m Word8 -> m Nucleotides
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Word8 -> Nucleotides
Ns (Word8 -> Nucleotides) -> (Word8 -> Word8) -> Word8 -> Nucleotides
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.&.) 0xF               ) m Word8
b
      where b :: m Word8
b = IO Word8 -> m Word8
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO Word8) -> IO Word8)
-> (Ptr Word8 -> IO Word8) -> IO Word8
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Word8
p -> Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p ((Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 1)

    {-# INLINE basicUnsafeWrite #-}
    basicUnsafeWrite :: MVector_Nucs_half (PrimState m) Nucleotides
-> Int -> Nucleotides -> m ()
basicUnsafeWrite (MVector_Nucs_half o :: Int
o _ fp :: ForeignPtr Word8
fp) i :: Int
i (Ns x :: Word8
x) =
        IO () -> m ()
forall (m1 :: * -> *) (m2 :: * -> *) a.
(PrimBase m1, PrimMonad m2) =>
m1 a -> m2 a
unsafePrimToPrim (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \p :: Ptr Word8
p -> do
            Word8
y <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p ((Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 1)
            let y' :: Word8
y' | Int -> Bool
forall a. Integral a => a -> Bool
even (Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) = Word8
x Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` 4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
y Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0x0F
                   | Bool
otherwise  = Word8
x            Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
y Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xF0
            Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
p ((Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 1) Word8
y'

foreign import ccall unsafe "string.h memset" memset
    :: Ptr Word8 -> CInt -> CSize -> IO ()

instance Show (Vector_Nucs_half Nucleotides) where
    show :: Vector_Nucs_half Nucleotides -> String
show = [Nucleotides] -> String
forall a. Show a => a -> String
show ([Nucleotides] -> String)
-> (Vector_Nucs_half Nucleotides -> [Nucleotides])
-> Vector_Nucs_half Nucleotides
-> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector_Nucs_half Nucleotides -> [Nucleotides]
forall (v :: * -> *) a. Vector v a => v a -> [a]
V.toList

-- | Bam record in its native encoding along with virtual address.
data BamRaw = BamRaw { BamRaw -> Int64
virt_offset :: {-# UNPACK #-} !Int64
                     , BamRaw -> ByteString
raw_data    :: {-# UNPACK #-} !Bytes }

br_copy :: BamRaw -> BamRaw
br_copy :: BamRaw -> BamRaw
br_copy (BamRaw o :: Int64
o r :: ByteString
r) = Int64 -> ByteString -> BamRaw
BamRaw Int64
o (ByteString -> BamRaw) -> ByteString -> BamRaw
forall a b. (a -> b) -> a -> b
$! ByteString -> ByteString
B.copy ByteString
r

data BrokenRecord = BrokenRecord !Int [Int] !Bytes deriving (Typeable, Int -> BrokenRecord -> ShowS
[BrokenRecord] -> ShowS
BrokenRecord -> String
(Int -> BrokenRecord -> ShowS)
-> (BrokenRecord -> String)
-> ([BrokenRecord] -> ShowS)
-> Show BrokenRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BrokenRecord] -> ShowS
$cshowList :: [BrokenRecord] -> ShowS
show :: BrokenRecord -> String
$cshow :: BrokenRecord -> String
showsPrec :: Int -> BrokenRecord -> ShowS
$cshowsPrec :: Int -> BrokenRecord -> ShowS
Show)
instance Exception BrokenRecord where
    displayException :: BrokenRecord -> String
displayException (BrokenRecord ln :: Int
ln m :: [Int]
m raw :: ByteString
raw) =
        "broken BAM record of length " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
ln " , need offsets " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> ShowS
forall a. Show a => a -> ShowS
shows [Int]
m ", begins with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
forall a. Show a => a -> String
show (ByteString -> [Word8]
B.unpack ByteString
raw)

-- | Smart constructor.  Makes sure we got a at least a full record.
{-# INLINE bamRaw #-}
bamRaw :: MonadThrow m => Int64 -> Bytes -> m BamRaw
bamRaw :: Int64 -> ByteString -> m BamRaw
bamRaw o :: Int64
o s :: ByteString
s
    | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<    32  =  BrokenRecord -> m BamRaw
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (BrokenRecord -> m BamRaw) -> BrokenRecord -> m BamRaw
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> ByteString -> BrokenRecord
BrokenRecord (ByteString -> Int
S.length ByteString
s) [32] (Int -> ByteString -> ByteString
S.take 16 ByteString
s)
    | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
m  =  BrokenRecord -> m BamRaw
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (BrokenRecord -> m BamRaw) -> BrokenRecord -> m BamRaw
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> ByteString -> BrokenRecord
BrokenRecord (ByteString -> Int
S.length ByteString
s)   [Int]
m  (Int -> ByteString -> ByteString
S.take 16 ByteString
s)
    | Bool
otherwise           =  BamRaw -> m BamRaw
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BamRaw -> m BamRaw) -> BamRaw -> m BamRaw
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> BamRaw
BamRaw Int64
o ByteString
s
  where
    m :: [Int]
m = [ 32, Int
l_rnm, Int
l_seq, (Int
l_seqInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2, Int
l_cig Int -> Int -> Int
forall a. Num a => a -> a -> a
* 4 ]
    l_rnm :: Int
l_rnm = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.unsafeIndex ByteString
s  8) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
    l_cig :: Int
l_cig = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.unsafeIndex ByteString
s 12)             Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.unsafeIndex ByteString
s 13) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL`  8
    l_seq :: Int
l_seq = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.unsafeIndex ByteString
s 16)             Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.unsafeIndex ByteString
s 17) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL`  8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|.
            Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.unsafeIndex ByteString
s 18) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.unsafeIndex ByteString
s 19) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 24

{-# INLINE[1] unpackBam #-}
unpackBam :: BamRaw -> BamRec
unpackBam :: BamRaw -> BamRec
unpackBam br :: BamRaw
br = BamRec :: ByteString
-> Int
-> Refseq
-> Int
-> Qual
-> Vector Cigar
-> Refseq
-> Int
-> Int
-> Vector_Nucs_half Nucleotides
-> Maybe (Vector Qual)
-> Extensions
-> Int64
-> BamRec
BamRec {
        b_rname :: Refseq
b_rname =      Word32 -> Refseq
Refseq (Word32 -> Refseq) -> Word32 -> Refseq
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a. Num a => Int -> a
getWord32  0,
        b_pos :: Int
b_pos   =               Int -> Int
forall a. Num a => Int -> a
getInt32   4,
        b_mapq :: Qual
b_mapq  =           Word8 -> Qual
Q (Word8 -> Qual) -> Word8 -> Qual
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a. Num a => Int -> a
getInt8    9,
        b_flag :: Int
b_flag  =               Int -> Int
forall a. Num a => Int -> a
getInt16  14,
        b_mrnm :: Refseq
b_mrnm  =      Word32 -> Refseq
Refseq (Word32 -> Refseq) -> Word32 -> Refseq
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a. Num a => Int -> a
getWord32 20,
        b_mpos :: Int
b_mpos  =               Int -> Int
forall a. Num a => Int -> a
getInt32  24,
        b_isize :: Int
b_isize =               Int -> Int
forall a. Num a => Int -> a
getInt32  28,

        b_qname :: ByteString
b_qname = Int -> ByteString -> ByteString
B.unsafeTake Int
l_read_name (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.unsafeDrop 32 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BamRaw -> ByteString
raw_data BamRaw
br,
        b_cigar :: Vector Cigar
b_cigar = Vector Word8 -> Vector Cigar
forall a b. (Storable a, Storable b) => Vector a -> Vector b
VS.unsafeCast (Vector Word8 -> Vector Cigar) -> Vector Word8 -> Vector Cigar
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> Vector Word8
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
VS.unsafeFromForeignPtr ForeignPtr Word8
fp (Int
off0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off_c) (4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
l_cigar),
        b_seq :: Vector_Nucs_half Nucleotides
b_seq   = Int -> Int -> ForeignPtr Word8 -> Vector_Nucs_half Nucleotides
forall a. Int -> Int -> ForeignPtr Word8 -> Vector_Nucs_half a
Vector_Nucs_half (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
off_sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off0)) Int
l_seq ForeignPtr Word8
fp,
        b_qual :: Maybe (Vector Qual)
b_qual  = Maybe (Vector Qual)
mk_qual,
        b_exts :: Extensions
b_exts  = ByteString -> Extensions
unpackExtensions (ByteString -> Extensions) -> ByteString -> Extensions
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
S.drop Int
off_e (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BamRaw -> ByteString
raw_data BamRaw
br,
        b_virtual_offset :: Int64
b_virtual_offset = BamRaw -> Int64
virt_offset BamRaw
br }
  where
        (fp :: ForeignPtr Word8
fp, off0 :: Int
off0, _) = ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr (ByteString -> (ForeignPtr Word8, Int, Int))
-> ByteString -> (ForeignPtr Word8, Int, Int)
forall a b. (a -> b) -> a -> b
$ BamRaw -> ByteString
raw_data BamRaw
br
        off_c :: Int
off_c =    33 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l_read_name
        off_s :: Int
off_s = Int
off_c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
l_cigar
        off_q :: Int
off_q = Int
off_s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
l_seq Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
        off_e :: Int
off_e = Int
off_q Int -> Int -> Int
forall a. Num a => a -> a -> a
+  Int
l_seq

        l_read_name :: Int
l_read_name = Int -> Int
forall a. Num a => Int -> a
getInt8    8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
        l_seq :: Int
l_seq       = Int -> Int
forall a. Num a => Int -> a
getWord32 16
        l_cigar :: Int
l_cigar     = Int -> Int
forall a. Num a => Int -> a
getInt16  12

        mk_qual :: Maybe (Vector Qual)
mk_qual | Int
l_seq Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0                                 =  Vector Qual -> Maybe (Vector Qual)
forall a. a -> Maybe a
Just Vector Qual
forall a. Storable a => Vector a
VS.empty
                | ByteString -> Int -> Word8
B.unsafeIndex (BamRaw -> ByteString
raw_data BamRaw
br) Int
off_q Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0xff  =  Maybe (Vector Qual)
forall a. Maybe a
Nothing
                | Bool
otherwise  =  Vector Qual -> Maybe (Vector Qual)
forall a. a -> Maybe a
Just (Vector Qual -> Maybe (Vector Qual))
-> Vector Qual -> Maybe (Vector Qual)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Qual -> Int -> Int -> Vector Qual
forall a. Storable a => ForeignPtr a -> Int -> Int -> Vector a
VS.unsafeFromForeignPtr (ForeignPtr Word8 -> ForeignPtr Qual
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fp) (Int
off0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
off_q) Int
l_seq

        getInt8 :: Num a => Int -> a
        getInt8 :: Int -> a
getInt8  o :: Int
o = Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.unsafeIndex (BamRaw -> ByteString
raw_data BamRaw
br) Int
o)

        getInt16 :: Num a => Int -> a
        getInt16 :: Int -> a
getInt16 o :: Int
o = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString (BamRaw -> ByteString
raw_data BamRaw
br) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
                     (Word16 -> a) -> IO Word16 -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word16 -> IO a) -> (CString -> IO Word16) -> CString -> IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Any -> IO Word16
forall a. Ptr a -> IO Word16
peekUnalnWord16LE (Ptr Any -> IO Word16)
-> (CString -> Ptr Any) -> CString -> IO Word16
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CString -> Int -> Ptr Any) -> Int -> CString -> Ptr Any
forall a b c. (a -> b -> c) -> b -> a -> c
flip CString -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Int
o

        getWord32 :: Num a => Int -> a
        getWord32 :: Int -> a
getWord32 o :: Int
o = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString (BamRaw -> ByteString
raw_data BamRaw
br) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
                      (Word32 -> a) -> IO Word32 -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word32 -> IO a) -> (CString -> IO Word32) -> CString -> IO a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Ptr Any -> IO Word32
forall a. Ptr a -> IO Word32
peekUnalnWord32LE (Ptr Any -> IO Word32)
-> (CString -> Ptr Any) -> CString -> IO Word32
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CString -> Int -> Ptr Any) -> Int -> CString -> Ptr Any
forall a b c. (a -> b -> c) -> b -> a -> c
flip CString -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
plusPtr Int
o

        -- ensures proper sign extension
        getInt32 :: Num a => Int -> a
        getInt32 :: Int -> a
getInt32 o :: Int
o = Int32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32
forall a. Num a => Int -> a
getWord32 Int
o :: Int32)


-- | A collection of extension fields.  A 'BamKey' is actually two ASCII
-- characters.
type Extensions = [( BamKey, Ext )]

-- | Deletes all occurences of some extension field.
deleteE :: BamKey -> Extensions -> Extensions
deleteE :: BamKey -> Extensions -> Extensions
deleteE k :: BamKey
k = ((BamKey, Ext) -> Bool) -> Extensions -> Extensions
forall a. (a -> Bool) -> [a] -> [a]
filter (BamKey -> BamKey -> Bool
forall a. Eq a => a -> a -> Bool
(/=) BamKey
k (BamKey -> Bool)
-> ((BamKey, Ext) -> BamKey) -> (BamKey, Ext) -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (BamKey, Ext) -> BamKey
forall a b. (a, b) -> a
fst)

-- | Blindly inserts an extension field.  This can create duplicates
-- (and there is no telling how other tools react to that).
insertE :: BamKey -> Ext -> Extensions -> Extensions
insertE :: BamKey -> Ext -> Extensions -> Extensions
insertE k :: BamKey
k v :: Ext
v = (:) (BamKey
k,Ext
v)

-- | Deletes all occurences of an extension field, then inserts it with
-- a new value.  This is safer than 'insertE', but also more expensive.
updateE :: BamKey -> Ext -> Extensions -> Extensions
updateE :: BamKey -> Ext -> Extensions -> Extensions
updateE k :: BamKey
k v :: Ext
v = BamKey -> Ext -> Extensions -> Extensions
insertE BamKey
k Ext
v (Extensions -> Extensions)
-> (Extensions -> Extensions) -> Extensions -> Extensions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamKey -> Extensions -> Extensions
deleteE BamKey
k

-- | Adjusts a named extension by applying a function.
adjustE :: (Ext -> Ext) -> BamKey -> Extensions -> Extensions
adjustE :: (Ext -> Ext) -> BamKey -> Extensions -> Extensions
adjustE _ _ [         ]             = []
adjustE f :: Ext -> Ext
f k :: BamKey
k ((k' :: BamKey
k',v :: Ext
v):es :: Extensions
es) | BamKey
k  BamKey -> BamKey -> Bool
forall a. Eq a => a -> a -> Bool
==  BamKey
k' = (BamKey
k', Ext -> Ext
f Ext
v) (BamKey, Ext) -> Extensions -> Extensions
forall a. a -> [a] -> [a]
: Extensions
es
                        | Bool
otherwise = (BamKey
k',   Ext
v) (BamKey, Ext) -> Extensions -> Extensions
forall a. a -> [a] -> [a]
: (Ext -> Ext) -> BamKey -> Extensions -> Extensions
adjustE Ext -> Ext
f BamKey
k Extensions
es

data Ext = Int Int | Float Float | Text Bytes | Bin Bytes | Char Word8
         | IntArr (U.Vector Int) | FloatArr (U.Vector Float)
    deriving (Int -> Ext -> ShowS
[Ext] -> ShowS
Ext -> String
(Int -> Ext -> ShowS)
-> (Ext -> String) -> ([Ext] -> ShowS) -> Show Ext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ext] -> ShowS
$cshowList :: [Ext] -> ShowS
show :: Ext -> String
$cshow :: Ext -> String
showsPrec :: Int -> Ext -> ShowS
$cshowsPrec :: Int -> Ext -> ShowS
Show, Ext -> Ext -> Bool
(Ext -> Ext -> Bool) -> (Ext -> Ext -> Bool) -> Eq Ext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ext -> Ext -> Bool
$c/= :: Ext -> Ext -> Bool
== :: Ext -> Ext -> Bool
$c== :: Ext -> Ext -> Bool
Eq, Eq Ext
Eq Ext =>
(Ext -> Ext -> Ordering)
-> (Ext -> Ext -> Bool)
-> (Ext -> Ext -> Bool)
-> (Ext -> Ext -> Bool)
-> (Ext -> Ext -> Bool)
-> (Ext -> Ext -> Ext)
-> (Ext -> Ext -> Ext)
-> Ord Ext
Ext -> Ext -> Bool
Ext -> Ext -> Ordering
Ext -> Ext -> Ext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Ext -> Ext -> Ext
$cmin :: Ext -> Ext -> Ext
max :: Ext -> Ext -> Ext
$cmax :: Ext -> Ext -> Ext
>= :: Ext -> Ext -> Bool
$c>= :: Ext -> Ext -> Bool
> :: Ext -> Ext -> Bool
$c> :: Ext -> Ext -> Bool
<= :: Ext -> Ext -> Bool
$c<= :: Ext -> Ext -> Bool
< :: Ext -> Ext -> Bool
$c< :: Ext -> Ext -> Bool
compare :: Ext -> Ext -> Ordering
$ccompare :: Ext -> Ext -> Ordering
$cp1Ord :: Eq Ext
Ord)

{-# INLINE unpackExtensions #-}
unpackExtensions :: Bytes -> Extensions
unpackExtensions :: ByteString -> Extensions
unpackExtensions = ByteString -> Extensions
forall a. IsString a => ByteString -> [(a, Ext)]
go
  where
    go :: ByteString -> [(a, Ext)]
go s :: ByteString
s | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 4 = []
         | Bool
otherwise = let key :: a
key = String -> a
forall a. IsString a => String -> a
fromString [ ByteString -> Int -> Char
S.index ByteString
s 0, ByteString -> Int -> Char
S.index ByteString
s 1 ]
                       in case ByteString -> Int -> Char
S.index ByteString
s 2 of
                         'Z' -> case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\0') (Int -> ByteString -> ByteString
S.drop 3 ByteString
s) of (l :: ByteString
l,r :: ByteString
r) -> (a
key, ByteString -> Ext
Text ByteString
l) (a, Ext) -> [(a, Ext)] -> [(a, Ext)]
forall a. a -> [a] -> [a]
: ByteString -> [(a, Ext)]
go (Int -> ByteString -> ByteString
S.drop 1 ByteString
r)
                         'H' -> case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\0') (Int -> ByteString -> ByteString
S.drop 3 ByteString
s) of (l :: ByteString
l,r :: ByteString
r) -> (a
key, ByteString -> Ext
Bin  ByteString
l) (a, Ext) -> [(a, Ext)] -> [(a, Ext)]
forall a. a -> [a] -> [a]
: ByteString -> [(a, Ext)]
go (Int -> ByteString -> ByteString
S.drop 1 ByteString
r)
                         'A' -> (a
key, Word8 -> Ext
Char (ByteString -> Int -> Word8
B.index ByteString
s 3)) (a, Ext) -> [(a, Ext)] -> [(a, Ext)]
forall a. a -> [a] -> [a]
: ByteString -> [(a, Ext)]
go (Int -> ByteString -> ByteString
S.drop 4 ByteString
s)
                         'B' -> let tp :: Char
tp = ByteString -> Int -> Char
S.index ByteString
s 3
                                    n :: Int
n  = Char -> ByteString -> Int
forall p. Num p => Char -> ByteString -> p
getInt 'I' (Int -> ByteString -> ByteString
S.drop 4 ByteString
s)
                                in case Char
tp of
                                      'f' -> (a
key, Vector Float -> Ext
FloatArr (Int -> [Float] -> Vector Float
forall a. Unbox a => Int -> [a] -> Vector a
U.fromListN (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [ ByteString -> Float
forall a. Storable a => ByteString -> a
getFloat (Int -> ByteString -> ByteString
S.drop Int
i ByteString
s) | Int
i <- [8, 12 ..] ]))
                                             (a, Ext) -> [(a, Ext)] -> [(a, Ext)]
forall a. a -> [a] -> [a]
: ByteString -> [(a, Ext)]
go (Int -> ByteString -> ByteString
S.drop (12Int -> Int -> Int
forall a. Num a => a -> a -> a
+4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n) ByteString
s)
                                      _   -> (a
key, Vector Int -> Ext
IntArr (Int -> [Int] -> Vector Int
forall a. Unbox a => Int -> [a] -> Vector a
U.fromListN (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [ Char -> ByteString -> Int
forall p. Num p => Char -> ByteString -> p
getInt Char
tp (Int -> ByteString -> ByteString
S.drop Int
i ByteString
s) | Int
i <- [8, 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall p. Num p => Char -> p
size Char
tp ..] ]))
                                             (a, Ext) -> [(a, Ext)] -> [(a, Ext)]
forall a. a -> [a] -> [a]
: ByteString -> [(a, Ext)]
go (Int -> ByteString -> ByteString
S.drop (8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall p. Num p => Char -> p
size Char
tp Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)) ByteString
s)
                         'f' -> (a
key, Float -> Ext
Float (ByteString -> Float
forall a. Storable a => ByteString -> a
getFloat (Int -> ByteString -> ByteString
S.drop 3 ByteString
s))) (a, Ext) -> [(a, Ext)] -> [(a, Ext)]
forall a. a -> [a] -> [a]
: ByteString -> [(a, Ext)]
go (Int -> ByteString -> ByteString
S.drop 7 ByteString
s)
                         tp :: Char
tp  -> (a
key, Int -> Ext
Int  (Char -> ByteString -> Int
forall p. Num p => Char -> ByteString -> p
getInt Char
tp (Int -> ByteString -> ByteString
S.drop 3 ByteString
s))) (a, Ext) -> [(a, Ext)] -> [(a, Ext)]
forall a. a -> [a] -> [a]
: ByteString -> [(a, Ext)]
go (Int -> ByteString -> ByteString
S.drop (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall p. Num p => Char -> p
size Char
tp) ByteString
s)

    size :: Char -> p
size 'C' = 1
    size 'c' = 1
    size 'S' = 2
    size 's' = 2
    size 'I' = 4
    size 'i' = 4
    size 'f' = 4
    size  _  = 0

    getInt :: Char -> ByteString -> p
getInt 'C' s :: ByteString
s | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 = Word8 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral              ((ByteString -> Int -> Word8
B.index ByteString
s 0) :: Word8)
    getInt 'c' s :: ByteString
s | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 = Int8 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.index ByteString
s 0) ::  Int8)
    getInt 'S' s :: ByteString
s | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2 = Word16 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral                         (Word16
i :: Word16)
        where i :: Word16
i = IO Word16 -> Word16
forall a. IO a -> a
unsafeDupablePerformIO (IO Word16 -> Word16) -> IO Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO Word16) -> IO Word16
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
s ((CString -> IO Word16) -> IO Word16)
-> (CString -> IO Word16) -> IO Word16
forall a b. (a -> b) -> a -> b
$ CString -> IO Word16
forall a. Ptr a -> IO Word16
peekUnalnWord16LE
    getInt 's' s :: ByteString
s | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2 = Int16 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral            (Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i ::  Int16)
        where i :: Word16
i = IO Word16 -> Word16
forall a. IO a -> a
unsafeDupablePerformIO (IO Word16 -> Word16) -> IO Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO Word16) -> IO Word16
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
s ((CString -> IO Word16) -> IO Word16)
-> (CString -> IO Word16) -> IO Word16
forall a b. (a -> b) -> a -> b
$ CString -> IO Word16
forall a. Ptr a -> IO Word16
peekUnalnWord16LE
    getInt 'I' s :: ByteString
s | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 4 = Word32 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral                         (Word32
i :: Word32)
        where i :: Word32
i = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO Word32) -> IO Word32
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
s ((CString -> IO Word32) -> IO Word32)
-> (CString -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ CString -> IO Word32
forall a. Ptr a -> IO Word32
peekUnalnWord32LE
    getInt 'i' s :: ByteString
s | ByteString -> Int
S.length ByteString
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 4 = Int32 -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral            (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i ::  Int32)
        where i :: Word32
i = IO Word32 -> Word32
forall a. IO a -> a
unsafeDupablePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO Word32) -> IO Word32
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
s ((CString -> IO Word32) -> IO Word32)
-> (CString -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ CString -> IO Word32
forall a. Ptr a -> IO Word32
peekUnalnWord32LE
    getInt _ _ = 0

    getFloat :: ByteString -> a
getFloat s :: ByteString
s = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ (Ptr a -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \buf :: Ptr a
buf ->
                 Ptr a -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
buf 0 (Char -> ByteString -> Word32
forall p. Num p => Char -> ByteString -> p
getInt 'I' ByteString
s :: Word32) IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
buf


isPaired, isProperlyPaired, isUnmapped, isMateUnmapped, isReversed,
    isMateReversed, isFirstMate, isSecondMate, isSecondary,
    isFailsQC, isDuplicate, isSupplementary,
    isTrimmed, isMerged, isAlternative, isExactIndex :: BamRec -> Bool

isPaired :: BamRec -> Bool
isPaired         = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  0 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isProperlyPaired :: BamRec -> Bool
isProperlyPaired = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  1 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isUnmapped :: BamRec -> Bool
isUnmapped       = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  2 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isMateUnmapped :: BamRec -> Bool
isMateUnmapped   = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  3 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isReversed :: BamRec -> Bool
isReversed       = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  4 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isMateReversed :: BamRec -> Bool
isMateReversed   = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  5 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isFirstMate :: BamRec -> Bool
isFirstMate      = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  6 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isSecondMate :: BamRec -> Bool
isSecondMate     = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  7 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isSecondary :: BamRec -> Bool
isSecondary      = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  8 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isFailsQC :: BamRec -> Bool
isFailsQC        = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit  9 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isDuplicate :: BamRec -> Bool
isDuplicate      = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit 10 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag
isSupplementary :: BamRec -> Bool
isSupplementary  = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit 11 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BamRec -> Int
b_flag

isTrimmed :: BamRec -> Bool
isTrimmed        = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit 0 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> BamKey -> BamRec -> Int
extAsInt 0 "FF"
isMerged :: BamRec -> Bool
isMerged         = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit 1 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> BamKey -> BamRec -> Int
extAsInt 0 "FF"
isAlternative :: BamRec -> Bool
isAlternative    = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit 2 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> BamKey -> BamRec -> Int
extAsInt 0 "FF"
isExactIndex :: BamRec -> Bool
isExactIndex     = (Int -> Int -> Bool) -> Int -> Int -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit 3 (Int -> Bool) -> (BamRec -> Int) -> BamRec -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> BamKey -> BamRec -> Int
extAsInt 0 "FF"

type_mask :: Int
type_mask :: Int
type_mask = Int
flagFirstMate Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
flagSecondMate Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
flagPaired

extAsInt :: Int -> BamKey -> BamRec -> Int
extAsInt :: Int -> BamKey -> BamRec -> Int
extAsInt d :: Int
d nm :: BamKey
nm br :: BamRec
br = case BamKey -> Extensions -> Maybe Ext
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup BamKey
nm (BamRec -> Extensions
b_exts BamRec
br) of Just (Int i :: Int
i) -> Int
i ; _ -> Int
d

extAsString :: BamKey -> BamRec -> Bytes
extAsString :: BamKey -> BamRec -> ByteString
extAsString nm :: BamKey
nm br :: BamRec
br = case BamKey -> Extensions -> Maybe Ext
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup BamKey
nm (BamRec -> Extensions
b_exts BamRec
br) of
    Just (Char c :: Word8
c) -> Word8 -> ByteString
B.singleton Word8
c
    Just (Text s :: ByteString
s) -> ByteString
s
    _             -> ByteString
B.empty

setQualFlag :: Char -> BamRec -> BamRec
setQualFlag :: Char -> BamRec -> BamRec
setQualFlag c :: Char
c br :: BamRec
br = BamRec
br { b_exts :: Extensions
b_exts = BamKey -> Ext -> Extensions -> Extensions
updateE "ZQ" (ByteString -> Ext
Text ByteString
s') (Extensions -> Extensions) -> Extensions -> Extensions
forall a b. (a -> b) -> a -> b
$ BamRec -> Extensions
b_exts BamRec
br }
  where
    s :: ByteString
s  = BamKey -> BamRec -> ByteString
extAsString "ZQ" BamRec
br
    s' :: ByteString
s' = if Char
c Char -> ByteString -> Bool
`S.elem` ByteString
s then ByteString
s else Char
c Char -> ByteString -> ByteString
`S.cons` ByteString
s