-- |
-- Module      :  Data.BAM.Version1_6.Write.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.Write.Internal ( -- * BAM_V1_6 writing - internal functions
                                            encodeSeqField  
                                          ) where

import Data.ByteString as DB hiding (concatMap,length)
import Data.Bits
import Data.List       as DL
import Data.Word

-- | Encode a [Word8] (each byte represents two bases)
-- into a ByteString representing the SEQ field.
encodeSeqField :: [Word8]
               -> DB.ByteString
encodeSeqField :: [Word8] -> ByteString
encodeSeqField [Word8]
bases =
  [Word8] -> ByteString
DB.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$
    ((Word8, Word8) -> [Word8]) -> [(Word8, Word8)] -> [Word8]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Word8, Word8) -> [Word8]
encodeByte [(Word8, Word8)]
pairs
  where
    pairs :: [(Word8, Word8)]
pairs =
      case ( Int -> Bool
forall a. Integral a => a -> Bool
odd (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
DL.length [Word8]
bases
           ) of
        Bool
True  ->
          [Word8] -> [(Word8, Word8)]
pairsWithPadding [Word8]
bases
        Bool
False ->
          [Word8] -> [(Word8, Word8)]
pairsWithoutPadding [Word8]
bases
    encodeByte :: (Word8,Word8)
               -> [Word8]
    encodeByte :: (Word8, Word8) -> [Word8]
encodeByte (Word8
high,Word8
low) =
      [ (Word8
high Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftL` Int
4)
        Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|.
        Word8
low
      ]
    pairsWithPadding :: [Word8]
                     -> [(Word8,Word8)]
    pairsWithPadding :: [Word8] -> [(Word8, Word8)]
pairsWithPadding []       = []
    pairsWithPadding [Word8
x]      = [(Word8
x,Word8
0)]
    pairsWithPadding (Word8
x:Word8
y:[Word8]
xs) = (Word8
x,Word8
y) (Word8, Word8) -> [(Word8, Word8)] -> [(Word8, Word8)]
forall a. a -> [a] -> [a]
: [Word8] -> [(Word8, Word8)]
pairsWithPadding [Word8]
xs
    pairsWithoutPadding :: [Word8]
                        -> [(Word8,Word8)]
    pairsWithoutPadding :: [Word8] -> [(Word8, Word8)]
pairsWithoutPadding []       = []
    pairsWithoutPadding [Word8
_]      = []
    pairsWithoutPadding (Word8
x:Word8
y:[Word8]
xs) = (Word8
x,Word8
y) (Word8, Word8) -> [(Word8, Word8)] -> [(Word8, Word8)]
forall a. a -> [a] -> [a]
: [Word8] -> [(Word8, Word8)]
pairsWithoutPadding [Word8]
xs