-- GENERATED by C->Haskell Compiler, version 0.16.5 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./BioInf/ViennaRNA/Bindings/FFI/CoFold.chs" #-}{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module BioInf.ViennaRNA.Bindings.FFI.CoFold
  ( ffiCoFold
  , ffiCoEnergyOfStructure
  , ffiCoPartitionFunction
  , ffiCoPartitionConstrained
  , CofoldF (..)
  ) where

import           Control.Applicative
import           Control.Monad
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.Marshal.Alloc
import           Foreign.Marshal.Array
import           Foreign.Ptr
import           Foreign.Storable
import           GHC.Float
import qualified Data.Array.IArray as A
import           Unsafe.Coerce

import           BioInf.ViennaRNA.Bindings.FFI.Utils




type CofoldFPtr = Ptr (CofoldF)
{-# LINE 33 "./BioInf/ViennaRNA/Bindings/FFI/CoFold.chs" #-}

data CofoldF = CofoldF
  { f0ab :: Double
  , fab  :: Double
  , fcab :: Double
  , fa   :: Double
  , fb   :: Double
  }
  deriving (Show)

instance Storable CofoldF where
  sizeOf _ = 40
{-# LINE 45 "./BioInf/ViennaRNA/Bindings/FFI/CoFold.chs" #-}
  alignment _ = sizeOf (undefined :: CDouble)
  peek p = CofoldF <$> liftM unsafeCoerce ((\ptr -> do {peekByteOff ptr 0 ::IO CDouble}) p)
                   <*> liftM unsafeCoerce ((\ptr -> do {peekByteOff ptr 8 ::IO CDouble}) p)
                   <*> liftM unsafeCoerce ((\ptr -> do {peekByteOff ptr 16 ::IO CDouble}) p)
                   <*> liftM unsafeCoerce ((\ptr -> do {peekByteOff ptr 24 ::IO CDouble}) p)
                   <*> liftM unsafeCoerce ((\ptr -> do {peekByteOff ptr 32 ::IO CDouble}) p)

-- |

ffiCoFold :: Int -> String -> IO (Double,String)
ffiCoFold cp inp = withCAString inp $ \cinp ->
                   withCAString inp $ \struc -> do
  setCutPoint cp
  e <- cofold cinp struc
  s <- peekCAString struc
  return (cf2d e, s)

-- |

ffiCoEnergyOfStructure :: Int -> String -> String -> Int -> IO Double
ffiCoEnergyOfStructure cp inp struc verb =
  withCAString inp   $ \i ->
  withCAString struc $ \s ->
    setCutPoint cp
    >>  energy_of_structure i s (fromIntegral verb :: CInt)
    >>= (return . cf2d)

-- |

ffiCoPartitionFunction :: Int -> String -> IO (CofoldF,String,A.Array (Int,Int) Double)
ffiCoPartitionFunction cutpoint i =
  withCAString i $ \ci ->
  withCAString i $ \cs -> do
  setCutPoint cutpoint
  let n = length i
  let z = n * (n+1) `div` 2 +1
  eF <- co_pf_fold_p ci cs >>= peek
  s  <- peekCAString cs
  bp <- export_co_bppm
{-# LINE 84 "./BioInf/ViennaRNA/Bindings/FFI/CoFold.chs" #-}
  xs <- peekArray z (bp :: Ptr CDouble)
  let ar = A.accumArray (const id) 0 ((1,1),(n,n)) $ zip [ (ii,jj) | ii <- [n,n-1..1], jj <- [n,n-1..ii]] (drop 1 $ map unsafeCoerce xs)
  return (eF, s, ar)

-- | Constrained partition function
--
-- NOTE the wrapped C function we @foreign import@ use very dirty
-- return-pointer-from-stack stuff. We should fix that. On the other hand, it just
-- works, because we immediately peek into the structure and marshall to Haskell.

ffiCoPartitionConstrained :: Int -> String -> String -> IO (CofoldF,String,A.Array (Int,Int) Double)
ffiCoPartitionConstrained cutpoint sq st =
  withCAString sq $ \csq ->
  withCAString st $ \cst -> do
  print sq
  print st
  print cutpoint
  setCutPoint cutpoint
  let n = length sq
  let z = n * (n+1) `div` 2 +1
  eF <- co_pf_fold_constrained_p csq cst 1 >>= peek
  s  <- peekCAString cst
  bp <- export_co_bppm
{-# LINE 107 "./BioInf/ViennaRNA/Bindings/FFI/CoFold.chs" #-}
  xs <- peekArray z (bp :: Ptr CDouble)
  let ar = A.accumArray (const id) 0 ((1,1),(n,n)) $ zip [ (ii,jj) | ii <- [n,n-1..1], jj <- [n,n-1..ii]] (drop 1 $ map unsafeCoerce xs)
  return (eF, s, ar)



foreign import ccall "ffiwrap_co_pf_fold" co_pf_fold_p :: CString -> CString -> IO CofoldFPtr

foreign import ccall "ffiwrap_co_pf_fold_constrained" co_pf_fold_constrained_p :: CString -> CString -> Int -> IO CofoldFPtr


foreign import ccall safe "BioInf/ViennaRNA/Bindings/FFI/CoFold.chs.h cofold"
  cofold :: ((Ptr CChar) -> ((Ptr CChar) -> (IO CFloat)))

foreign import ccall safe "BioInf/ViennaRNA/Bindings/FFI/CoFold.chs.h energy_of_structure"
  energy_of_structure :: ((Ptr CChar) -> ((Ptr CChar) -> (CInt -> (IO CFloat))))

foreign import ccall safe "BioInf/ViennaRNA/Bindings/FFI/CoFold.chs.h export_co_bppm"
  export_co_bppm :: (IO (Ptr CDouble))