module Alignment where
import Foreign.Ptr
import Foreign.ForeignPtr.Safe
import Foreign.ForeignPtr.Unsafe
import Foreign.Storable
import Foreign.Marshal.Alloc
import Foreign.C.Types
import Control.Applicative
import System.IO.Unsafe
import Data.Word
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Unsafe
import qualified Data.Vector.Storable as V
import Data.Bits
foreign import ccall unsafe "c_degenshtein" cDist :: Ptr Word8 -> CSize -> Ptr Word8 -> CSize -> IO CInt
editDistance :: B.ByteString -> B.ByteString -> Int
editDistance b1@(B.PS ps1 s1 l1) b2@(B.PS ps2 s2 l2) = unsafePerformIO $ do
let p1 = unsafeForeignPtrToPtr ps1
let p2 = unsafeForeignPtrToPtr ps2
r <- cDist (castPtr p1 `plusPtr` s1) (fromIntegral l1) (castPtr p2 `plusPtr` s2) (fromIntegral l2)
touchForeignPtr ps1
touchForeignPtr ps2
return (fromIntegral r)
data KSWR = KSWR {
score :: CInt,
targend :: CInt,
querend :: CInt,
score2 :: CInt,
targend2 :: CInt,
targbeg :: CInt,
querbeg :: CInt } deriving (Show, Read, Eq)
instance Storable KSWR where
sizeOf _ = 28
alignment = sizeOf
peek ptr = KSWR <$> pb 0 <*> pb 4 <*> pb 8 <*> pb 12 <*> pb 16 <*> pb 20 <*> pb 24 where
pb = peekByteOff ptr
foreign import ccall "default_align" cLocalAlign ::
CInt -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> CInt -> Ptr KSWR -> IO ()
bs_align :: B.ByteString -> B.ByteString -> KSWR
bs_align (B.PS ptra offa lena) (B.PS ptrb offb lenb) = unsafePerformIO $ do
let aptr = unsafeForeignPtrToPtr ptra `plusPtr` offa
bptr = unsafeForeignPtrToPtr ptrb `plusPtr` offb
kswrptr <- mallocBytes 28
cLocalAlign (fromIntegral lena) aptr (fromIntegral lenb) bptr 5 2 (0x80000 + 0x40000) kswrptr
kswr <- peek kswrptr
touchForeignPtr ptra
touchForeignPtr ptrb
free kswrptr
return kswr
foreign import ccall "cigar_align" cCigarAlign ::
CInt -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> CInt -> Ptr CInt -> Ptr (Ptr CInt) -> IO CInt
foreign import ccall unsafe "static stdlib.h &free" free_finalizer
:: FunPtr (Ptr a -> IO ())
cigar_align :: B.ByteString -> B.ByteString -> (Int, [(Char,Int)])
cigar_align (B.PS ptra offa lena) (B.PS ptrb offb lenb) = unsafePerformIO $ do
let aptr = unsafeForeignPtrToPtr ptra `plusPtr` offa
bptr = unsafeForeignPtrToPtr ptrb `plusPtr` offb
ncigar_p <- mallocBytes 4
cigar_pp <- mallocBytes 8
r <- cCigarAlign (fromIntegral lena) aptr (fromIntegral lenb) bptr 1 1 10 ncigar_p cigar_pp
ncigar <- peek ncigar_p
cigar_p <- peek cigar_pp
touchForeignPtr ptra
touchForeignPtr ptrb
free ncigar_p
free cigar_pp
fp <- newForeignPtr free_finalizer cigar_p
let v = V.unsafeFromForeignPtr0 fp (fromIntegral ncigar)
cigar = map pcigar $ V.toList v
pcigar i = (code, fromIntegral $ i `shiftR` 4) where
code = case i .&. 15 of
0 -> 'M'
1 -> 'I'
2 -> 'D'
3 -> 'N'
4 -> 'S'
5 -> 'H'
6 -> 'P'
7 -> '='
8 -> 'X'
return (fromIntegral r, cigar)