{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Bio.HTS.Types
    ( BAM(..)
    , BAMHeader(..)
    , showBamHeader
    , SortOrder(..)
    , SAM(..)
    , AuxiliaryData(..)
    , showSam
    ) where

import qualified Data.ByteString              as BS
import qualified Data.ByteString.Char8        as B
import           Data.ByteString.Lex.Integral
import           Data.Maybe                   (fromJust, fromMaybe)
import           System.IO.Unsafe         (unsafePerformIO)
import           Data.Word
import           Foreign.ForeignPtr

import Bio.HTS.Internal

-- | The BAM format.
newtype BAM = BAM { unbam :: ForeignPtr Bam1 }

newtype BAMHeader = BAMHeader {unbamHeader :: ForeignPtr BamHdr}

showBamHeader :: BAMHeader -> B.ByteString
showBamHeader header = unsafePerformIO $
    withForeignPtr (unbamHeader header) $ \ptr -> do
        s <- getHeaderText ptr
        l <- getHeaderSize ptr
        B.packCStringLen (s, l)

-- | BAM sort order.
data SortOrder = Unknown
               | Unsorted
               | Queryname
               | Coordinate
               deriving (Show, Eq)

-- | The SAM format.
data SAM = SAM
    { _sam_qname :: !B.ByteString
    , _sam_flag  :: !Word16
    , _sam_rname :: !(Maybe B.ByteString)
    , _sam_pos   :: !Int
    , _sam_mapq  :: !Word8
    , _sam_cigar :: !(Maybe [(Int, Char)])
    , _sam_rnext :: !(Maybe B.ByteString)
    , _sam_pnext :: !Int
    , _sam_tlen  :: !Int
    , _sam_seq   :: !(Maybe B.ByteString)
    , _sam_qual  :: !(Maybe B.ByteString)
    , _sam_aux   :: [((Char,Char), AuxiliaryData)]
    }

showSam :: SAM -> B.ByteString
showSam SAM{..} = B.intercalate "\t" $
    [ _sam_qname, pack' _sam_flag, fromMaybe "*" _sam_rname, pack' $ _sam_pos + 1
    , pack' _sam_mapq, fromMaybe "*" $ f <$> _sam_cigar, fromMaybe "*" _sam_rnext
    , pack' $ _sam_pnext + 1, pack' _sam_tlen, fromMaybe "*" _sam_seq
    , fromMaybe "*" $ BS.map (+33) <$> _sam_qual ] ++ map showAuxiliaryData _sam_aux
  where
    f = B.concat . concatMap (\(i, x) -> [pack' i, B.singleton x])
    pack' :: Integral a => a -> B.ByteString
    pack' = fromJust . packDecimal

-- | Auxiliary data
data AuxiliaryData = AuxChar Char
                   | AuxInt Int
                   | AuxFloat Float
                   | AuxString B.ByteString
                   | AuxByteArray BS.ByteString
                   | AuxIntArray [Int]
                   | AuxFloatArray [Float]
                   deriving (Show)

showAuxiliaryData :: ((Char, Char), AuxiliaryData) -> B.ByteString
showAuxiliaryData ((x1,x2), aux) = B.pack [x1,x2] <> aux'
  where
    aux' = case aux of
        AuxChar x -> B.pack [':', 'A', ':', x]
        AuxInt x -> B.pack $ ":i:" <> show x
        AuxFloat x -> B.pack $ ":f:" <> show x
        AuxString x -> ":Z:" <> x
        _ -> error "Not implemented"

{-
-- | SAM record flag
newtype Flag = Flag Word16
-}