-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Bio/HTS/Internal.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module Bio.HTS.Internal
    ( HTSFile
    , withHTSFile
    , htsOpen
    , htsClose

    -- * BGZF
    , BGZF
    , getBgzf

    -- * Bam Header
    , BamHdr
    , bamHdrRead
    , bamHdrWrite
    , getHeaderText
    , getHeaderSize

    -- * Bam
    , Bam1
    , bamRead1
    , bamWrite1
    , bamChr
    , bamEndpos
    , bamIsRev
    , bamGetSeq
    , bamGetQual
    , bamGetCigar
    , bamGetAux
    , bamGetLAux
    , bamAuxGet
    , bamAuxAppend
    ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Control.Exception (bracket)
import Foreign
import Foreign.C.Types
import Foreign.C.String
import System.IO (IOMode(..))



-- | Opaque data representing the hts file.
data HTSFile

withHTSFile :: FilePath -> IOMode -> (Ptr HTSFile -> IO a) -> IO a
withHTSFile fl mode = bracket (htsOpen fl md) htsClose
  where
    md = case mode of
        ReadMode -> "r"
        WriteMode -> "wb"
        _ -> error "Not a supported mode"

-- | Open a hts file.
htsOpen :: (String) -> (String) -> IO ((Ptr HTSFile))
htsOpen a1 a2 =
  withCString a1 $ \a1' ->
  withCString a2 $ \a2' ->
  htsOpen'_ a1' a2' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 70 "src/Bio/HTS/Internal.chs" #-}


-- | Close the hts file.
htsClose :: (Ptr HTSFile) -> IO ()
htsClose a1 =
  let {a1' = castPtr a1} in
  htsClose'_ a1' >>= \res ->
  return ()

{-# LINE 73 "src/Bio/HTS/Internal.chs" #-}



--------------------------------------------------------------------------------
-- BGZF
--------------------------------------------------------------------------------

-- | Opaque data representing the Blocked GNU Zip Format (BGZF) used
-- by Bam.
data BGZF

-- | Get the location of BGZF block.
getBgzf :: (Ptr HTSFile) -> IO ((Ptr BGZF))
getBgzf a1 =
  let {a1' = castPtr a1} in
  getBgzf'_ a1' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 85 "src/Bio/HTS/Internal.chs" #-}



--------------------------------------------------------------------------------
-- BAM
--------------------------------------------------------------------------------

-- | Opaque data representing Bam type.
data Bam1

-- | Read one Bam record.
bamRead1 :: (Ptr BGZF) -> (Ptr Bam1) -> IO ((CInt))
bamRead1 a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = castPtr a2} in
  bamRead1'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 96 "src/Bio/HTS/Internal.chs" #-}


-- | Save one Bam record.
bamWrite1 :: (Ptr BGZF) -> (Ptr Bam1) -> IO ((CInt))
bamWrite1 a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = castPtr a2} in
  bamWrite1'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 99 "src/Bio/HTS/Internal.chs" #-}


-- | Get chromosome.
bamChr :: (Ptr BamHdr) -> (Int) -> IO ((CString))
bamChr a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = fromIntegral a2} in
  bamChr'_ a1' a2' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 102 "src/Bio/HTS/Internal.chs" #-}


-- | Get end position.
bamEndpos :: (Ptr Bam1) -> IO ((Int))
bamEndpos a1 =
  let {a1' = castPtr a1} in
  bamEndpos'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 105 "src/Bio/HTS/Internal.chs" #-}


-- | Is reverse.
bamIsRev :: (Ptr Bam1) -> IO ((Bool))
bamIsRev a1 =
  let {a1' = castPtr a1} in
  bamIsRev'_ a1' >>= \res ->
  let {res' = C2HSImp.toBool res} in
  return (res')

{-# LINE 108 "src/Bio/HTS/Internal.chs" #-}


bamGetSeq :: (Ptr Bam1) -> (CString) -> (Int) -> IO ()
bamGetSeq a1 a2 a3 =
  let {a1' = castPtr a1} in
  (flip ($)) a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  bamGetSeq'_ a1' a2' a3' >>
  return ()

{-# LINE 110 "src/Bio/HTS/Internal.chs" #-}


bamGetQual :: (Ptr Bam1) -> (CString) -> (Int) -> IO ((CInt))
bamGetQual a1 a2 a3 =
  let {a1' = castPtr a1} in
  (flip ($)) a2 $ \a2' ->
  let {a3' = fromIntegral a3} in
  bamGetQual'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 112 "src/Bio/HTS/Internal.chs" #-}


bamGetCigar :: (Ptr Bam1) -> (Ptr CInt) -> (CString) -> (Int) -> IO ()
bamGetCigar a1 a2 a3 a4 =
  let {a1' = castPtr a1} in
  let {a2' = castPtr a2} in
  (flip ($)) a3 $ \a3' ->
  let {a4' = fromIntegral a4} in
  bamGetCigar'_ a1' a2' a3' a4' >>
  return ()

{-# LINE 115 "src/Bio/HTS/Internal.chs" #-}


bamGetAux :: (Ptr Bam1) -> IO ((Ptr ()))
bamGetAux a1 =
  let {a1' = castPtr a1} in
  bamGetAux'_ a1' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 117 "src/Bio/HTS/Internal.chs" #-}


bamGetLAux :: (Ptr Bam1) -> IO ((Int))
bamGetLAux a1 =
  let {a1' = castPtr a1} in
  bamGetLAux'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 119 "src/Bio/HTS/Internal.chs" #-}


bamAuxGet :: (Ptr Bam1) -> (String) -> IO ((Ptr ()))
bamAuxGet a1 a2 =
  let {a1' = castPtr a1} in
  C2HSImp.withCString a2 $ \a2' ->
  bamAuxGet'_ a1' a2' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 121 "src/Bio/HTS/Internal.chs" #-}


bamAuxAppend :: (Ptr Bam1) -> (String) -> (Char) -> (Int) -> (Ptr ()) -> IO ((CInt))
bamAuxAppend a1 a2 a3 a4 a5 =
  let {a1' = castPtr a1} in
  C2HSImp.withCString a2 $ \a2' ->
  let {a3' = C2HSImp.castCharToCChar a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = castPtr a5} in
  bamAuxAppend'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 125 "src/Bio/HTS/Internal.chs" #-}


--------------------------------------------------------------------------------
-- BAM Header
--------------------------------------------------------------------------------

-- | Opaque data representing Bam header type.
data BamHdr

-- | Get the bam header.
bamHdrRead :: (Ptr BGZF) -> IO ((Ptr BamHdr))
bamHdrRead a1 =
  let {a1' = castPtr a1} in
  bamHdrRead'_ a1' >>= \res ->
  let {res' = castPtr res} in
  return (res')

{-# LINE 135 "src/Bio/HTS/Internal.chs" #-}


-- | Save the bam header.
bamHdrWrite :: (Ptr BGZF) -> (Ptr BamHdr) -> IO ((CInt))
bamHdrWrite a1 a2 =
  let {a1' = castPtr a1} in
  let {a2' = castPtr a2} in
  bamHdrWrite'_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 138 "src/Bio/HTS/Internal.chs" #-}


getHeaderText :: (Ptr BamHdr) -> IO ((CString))
getHeaderText a1 =
  let {a1' = castPtr a1} in
  getHeaderText'_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 140 "src/Bio/HTS/Internal.chs" #-}

getHeaderSize :: (Ptr BamHdr) -> IO ((Int))
getHeaderSize a1 =
  let {a1' = castPtr a1} in
  getHeaderSize'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 67 "src/Bio/HTS/Internal.chs" #-}

foreign import ccall safe "Bio/HTS/Internal.chs.h hts_open"
  htsOpen'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Bio/HTS/Internal.chs.h hts_close"
  htsClose'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Bio/HTS/Internal.chs.h get_bgzf"
  getBgzf'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_read1"
  bamRead1'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_write1"
  bamWrite1'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_chr"
  bamChr'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar))))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_endpos"
  bamEndpos'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_is_rev_"
  bamIsRev'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_get_seq_"
  bamGetSeq'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO ()))))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_get_qual_"
  bamGetQual'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_get_cigar_"
  bamGetCigar'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO ())))))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_get_aux_"
  bamGetAux'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CUChar)))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_get_l_aux_"
  bamGetLAux'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_aux_get"
  bamAuxGet'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr C2HSImp.CUChar))))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_aux_append"
  bamAuxAppend'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CChar -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (IO C2HSImp.CInt))))))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_hdr_read"
  bamHdrRead'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Bio/HTS/Internal.chs.h bam_hdr_write"
  bamHdrWrite'_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Bio/HTS/Internal.chs.h get_header_text"
  getHeaderText'_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Bio/HTS/Internal.chs.h get_header_size"
  getHeaderSize'_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))