1 files changed, 44 insertions, 3 deletions

diff --git a/haskell/Data/XDelta.hsc b/haskell/Data/XDelta.hsc
index 03785c0..4d9ffe2 100644
--- a/haskell/Data/XDelta.hsc
+++ b/haskell/Data/XDelta.hsc
@@ -16,7 +16,9 @@ import Data.Bits
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Unsafe as B
 import qualified Data.ByteString.Internal as B
+import qualified Data.ByteString.Lazy as L
 import Data.Coerce
+import qualified Data.IntMap as IntMap
 import Data.Monoid
 import Data.Primitive.Addr
 import Data.Primitive.ByteArray
@@ -258,8 +260,7 @@ withByteString d act =
     in unsafeIOToPrim $ withForeignPtr fp $ \ptr -> unsafePrimToIO $ do
         act (ptr `plusPtr` off) (fromIntegral len)
 
-xdelta :: (PrimBase m, Monoid u) => XDeltaMethods m u -> (Stream m -> IO ErrorCode) -> [B.ByteString]
-    -> m u
+xdelta :: (PrimBase m, Monoid u) => XDeltaMethods m u -> (Stream m -> m ErrorCode) -> [B.ByteString] -> m u
 xdelta x xxcode_input ds = do
     mstream <- config_stream (xConfig x)
     either (\e _ -> xOnError x e "config_stream failed")
@@ -274,7 +275,7 @@ xdelta x xxcode_input ds = do
                 avail_input stream indata len
                 go2 withBlk eof ds
         go2 withBlk eof ds = do
-            ret <- withBlk $ unsafeIOToPrim $ xxcode_input stream
+            ret <- withBlk $ xxcode_input stream
             case ret of
                 XD3_INPUT -> if (not eof) then go withBlk ds else return mempty
                 XD3_OUTPUT -> do
@@ -299,3 +300,43 @@ xdelta x xxcode_input ds = do
                     s <- errorString stream
                     xOnError x e s
     go id ds
+
+
+foreign import ccall "xdelta3.h xd3_decode_input" xd3_decode_input  :: Ptr Xd3Stream -> IO ErrorCode
+foreign import ccall "xdelta3.h xd3_encode_input" xd3_encode_input  :: Ptr Xd3Stream -> IO ErrorCode
+
+decode_input :: PrimMonad m => Stream m -> m ErrorCode
+decode_input stream =
+    unsafeIOToPrim $ xd3_decode_input (ptr $ mutableByteArrayContents $ streamArray stream)
+
+encode_input :: PrimMonad m => Stream m -> m ErrorCode
+encode_input stream =
+    unsafeIOToPrim $ xd3_encode_input (ptr $ mutableByteArrayContents $ streamArray stream)
+
+newtype XDelta = XDelta L.ByteString
+
+chunksOf :: Usize_t -> L.ByteString -> [B.ByteString]
+chunksOf len bs | L.null bs = []
+                | otherwise = let (b,bs') = L.splitAt (fromIntegral len) bs
+                              in L.toStrict b : chunksOf len bs'
+
+computeDiff :: Config -> L.ByteString -> L.ByteString -> XDelta
+computeDiff cfg source patched = XDelta $ xdeltaPure cfg source patched
+
+applyPatch :: Config -> L.ByteString -> XDelta -> L.ByteString
+applyPatch cfg source (XDelta delta) = xdeltaPure cfg source delta
+
+xdeltaPure :: Config -> L.ByteString -> L.ByteString -> L.ByteString
+xdeltaPure cfg source delta =
+    let smap = IntMap.fromList $ zip [0..] (chunksOf 4096 source)
+        x :: XDeltaMethods (ST s) L.ByteString
+        x = XDeltaMethods
+                { xConfig    = cfg
+                , xGetSource = (smap IntMap.!) . fromIntegral -- :: Xoff_t -> B.ByteString
+                , xOutput    = \ptr len -> unsafeIOToST $ L.fromStrict <$> B.packCStringLen (castPtr ptr,len)
+                , xOnError   = \e s -> return L.empty -- :: ErrorCode -> String -> m u
+                , xBlockSize = 4096 -- :: Usize_t
+                , xInterleave = id -- :: forall a. m a -> m a
+                }
+        ds = L.toChunks delta
+    in runST $ xdelta x decode_input ds