diff options
author | Joe Crayne <joe@jerkface.net> | 2018-10-24 03:52:46 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2018-10-24 03:52:46 -0400 |
commit | 32e5ed671ff84186c69a066ddab4d57ec3bd73d4 (patch) | |
tree | 715df081b1545b9c481782048692982c466ee92c | |
parent | 87c1aaeb9f38e65f99e70f6fe8ff37a8dfb0bbad (diff) |
applyPatch/computeDiff high-level interface
-rw-r--r-- | haskell/Data/XDelta.hsc | 47 | ||||
-rw-r--r-- | xdelta3.cabal | 2 |
2 files changed, 45 insertions, 4 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 | |||
16 | import qualified Data.ByteString as B | 16 | import qualified Data.ByteString as B |
17 | import qualified Data.ByteString.Unsafe as B | 17 | import qualified Data.ByteString.Unsafe as B |
18 | import qualified Data.ByteString.Internal as B | 18 | import qualified Data.ByteString.Internal as B |
19 | import qualified Data.ByteString.Lazy as L | ||
19 | import Data.Coerce | 20 | import Data.Coerce |
21 | import qualified Data.IntMap as IntMap | ||
20 | import Data.Monoid | 22 | import Data.Monoid |
21 | import Data.Primitive.Addr | 23 | import Data.Primitive.Addr |
22 | import Data.Primitive.ByteArray | 24 | import Data.Primitive.ByteArray |
@@ -258,8 +260,7 @@ withByteString d act = | |||
258 | in unsafeIOToPrim $ withForeignPtr fp $ \ptr -> unsafePrimToIO $ do | 260 | in unsafeIOToPrim $ withForeignPtr fp $ \ptr -> unsafePrimToIO $ do |
259 | act (ptr `plusPtr` off) (fromIntegral len) | 261 | act (ptr `plusPtr` off) (fromIntegral len) |
260 | 262 | ||
261 | xdelta :: (PrimBase m, Monoid u) => XDeltaMethods m u -> (Stream m -> IO ErrorCode) -> [B.ByteString] | 263 | xdelta :: (PrimBase m, Monoid u) => XDeltaMethods m u -> (Stream m -> m ErrorCode) -> [B.ByteString] -> m u |
262 | -> m u | ||
263 | xdelta x xxcode_input ds = do | 264 | xdelta x xxcode_input ds = do |
264 | mstream <- config_stream (xConfig x) | 265 | mstream <- config_stream (xConfig x) |
265 | either (\e _ -> xOnError x e "config_stream failed") | 266 | either (\e _ -> xOnError x e "config_stream failed") |
@@ -274,7 +275,7 @@ xdelta x xxcode_input ds = do | |||
274 | avail_input stream indata len | 275 | avail_input stream indata len |
275 | go2 withBlk eof ds | 276 | go2 withBlk eof ds |
276 | go2 withBlk eof ds = do | 277 | go2 withBlk eof ds = do |
277 | ret <- withBlk $ unsafeIOToPrim $ xxcode_input stream | 278 | ret <- withBlk $ xxcode_input stream |
278 | case ret of | 279 | case ret of |
279 | XD3_INPUT -> if (not eof) then go withBlk ds else return mempty | 280 | XD3_INPUT -> if (not eof) then go withBlk ds else return mempty |
280 | XD3_OUTPUT -> do | 281 | XD3_OUTPUT -> do |
@@ -299,3 +300,43 @@ xdelta x xxcode_input ds = do | |||
299 | s <- errorString stream | 300 | s <- errorString stream |
300 | xOnError x e s | 301 | xOnError x e s |
301 | go id ds | 302 | go id ds |
303 | |||
304 | |||
305 | foreign import ccall "xdelta3.h xd3_decode_input" xd3_decode_input :: Ptr Xd3Stream -> IO ErrorCode | ||
306 | foreign import ccall "xdelta3.h xd3_encode_input" xd3_encode_input :: Ptr Xd3Stream -> IO ErrorCode | ||
307 | |||
308 | decode_input :: PrimMonad m => Stream m -> m ErrorCode | ||
309 | decode_input stream = | ||
310 | unsafeIOToPrim $ xd3_decode_input (ptr $ mutableByteArrayContents $ streamArray stream) | ||
311 | |||
312 | encode_input :: PrimMonad m => Stream m -> m ErrorCode | ||
313 | encode_input stream = | ||
314 | unsafeIOToPrim $ xd3_encode_input (ptr $ mutableByteArrayContents $ streamArray stream) | ||
315 | |||
316 | newtype XDelta = XDelta L.ByteString | ||
317 | |||
318 | chunksOf :: Usize_t -> L.ByteString -> [B.ByteString] | ||
319 | chunksOf len bs | L.null bs = [] | ||
320 | | otherwise = let (b,bs') = L.splitAt (fromIntegral len) bs | ||
321 | in L.toStrict b : chunksOf len bs' | ||
322 | |||
323 | computeDiff :: Config -> L.ByteString -> L.ByteString -> XDelta | ||
324 | computeDiff cfg source patched = XDelta $ xdeltaPure cfg source patched | ||
325 | |||
326 | applyPatch :: Config -> L.ByteString -> XDelta -> L.ByteString | ||
327 | applyPatch cfg source (XDelta delta) = xdeltaPure cfg source delta | ||
328 | |||
329 | xdeltaPure :: Config -> L.ByteString -> L.ByteString -> L.ByteString | ||
330 | xdeltaPure cfg source delta = | ||
331 | let smap = IntMap.fromList $ zip [0..] (chunksOf 4096 source) | ||
332 | x :: XDeltaMethods (ST s) L.ByteString | ||
333 | x = XDeltaMethods | ||
334 | { xConfig = cfg | ||
335 | , xGetSource = (smap IntMap.!) . fromIntegral -- :: Xoff_t -> B.ByteString | ||
336 | , xOutput = \ptr len -> unsafeIOToST $ L.fromStrict <$> B.packCStringLen (castPtr ptr,len) | ||
337 | , xOnError = \e s -> return L.empty -- :: ErrorCode -> String -> m u | ||
338 | , xBlockSize = 4096 -- :: Usize_t | ||
339 | , xInterleave = id -- :: forall a. m a -> m a | ||
340 | } | ||
341 | ds = L.toChunks delta | ||
342 | in runST $ xdelta x decode_input ds | ||
diff --git a/xdelta3.cabal b/xdelta3.cabal index 9bb6715..5cc3a30 100644 --- a/xdelta3.cabal +++ b/xdelta3.cabal | |||
@@ -34,6 +34,6 @@ library | |||
34 | cxx-sources: haskell/xdelta3.cc | 34 | cxx-sources: haskell/xdelta3.cc |
35 | 35 | ||
36 | hs-source-dirs: haskell | 36 | hs-source-dirs: haskell |
37 | build-depends: base >=4.10, bytestring, text, primitive | 37 | build-depends: base >=4.10, bytestring, text, primitive, containers |
38 | default-language: Haskell2010 | 38 | default-language: Haskell2010 |
39 | ghc-options: -Wmissing-signatures | 39 | ghc-options: -Wmissing-signatures |