-- |
-- Module      :  Data.BAM.Version1_6.Read.Parser.BAM.Alignment.Internal
-- Copyright   :  (c) Matthew Mosior 2024
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this library are expected to track development
-- closely.
--
-- All credit goes to the author(s)/maintainer(s) of the
-- [containers](https://hackage.haskell.org/package/containers) library
-- for the above warning text.
--
-- = Description
--
-- This library enables the decoding/encoding of SAM, BAM and CRAM file formats.

module Data.BAM.Version1_6.Read.Parser.BAM.Alignment.Internal ( -- * BAM_V1_6_BAM_BAMAlignments parser - internal functions
                                                                decodeSeqField  
                                                              , dropUpTo
                                                              , takeUpTo
                                                              ) where

import Data.Bits
import Data.ByteString as DB hiding (concatMap)
import Data.Word

-- | Decode SEQ field to a [Word8]
-- (each byte represents two bases).
decodeSeqField :: DB.ByteString
               -> [Word8]
decodeSeqField :: ByteString -> [Word8]
decodeSeqField ByteString
bytes =
  (Word8 -> [Word8]) -> [Word8] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> [Word8]
decodeByte (ByteString -> [Word8]
DB.unpack ByteString
bytes)
  where
    decodeByte :: Word8
               -> [Word8]
    decodeByte :: Word8 -> [Word8]
decodeByte Word8
byte =
      [ Word8
byte Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
      , Word8
byte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F
      ]

-- | Extract a sub ByteString starting from
-- and including the first occurrence of the given byte.
dropUpTo :: Word8
         -> ByteString
         -> ByteString
dropUpTo :: Word8 -> ByteString -> ByteString
dropUpTo Word8
byte ByteString
bs = 
  let (ByteString
_,ByteString
suffix) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
DB.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
byte) ByteString
bs
    in case ByteString -> Maybe (Word8, ByteString)
DB.uncons ByteString
suffix of
         Maybe (Word8, ByteString)
Nothing ->
           ByteString
DB.empty -- Specified byte not found, return an empty ByteString.
         Just (Word8, ByteString)
_  ->
           ByteString
suffix

-- | Extract a sub ByteString up to
-- and including the first occurrence of a given byte.
takeUpTo :: Word8
         -> ByteString
         -> ByteString
takeUpTo :: Word8 -> ByteString -> ByteString
takeUpTo Word8
byte
         ByteString
bs = 
  let (ByteString
prefix,ByteString
suffix) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
DB.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
byte) ByteString
bs
    in case ByteString -> Maybe (Word8, ByteString)
DB.uncons ByteString
suffix of
         Maybe (Word8, ByteString)
Nothing    ->
           ByteString
prefix -- No 0x00 found, return the entire ByteString.
         Just (Word8
_,ByteString
_) ->
           [ByteString] -> ByteString
DB.concat [ ByteString
prefix
                     , Word8 -> ByteString
DB.singleton Word8
byte
                     ]