From f8bb9011375e39b71fe1764159e034a97ea70f2e Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Thu, 25 Oct 2018 19:24:54 -0400 Subject: it works --- examples/testdiff.hs | 10 ++++++++-- haskell/Data/XDelta.hsc | 44 ++++++++++++++++++++++---------------------- haskell/XDelta/Types.hsc | 3 +++ xdelta3.cabal | 10 ++++++++-- 4 files changed, 41 insertions(+), 26 deletions(-) diff --git a/examples/testdiff.hs b/examples/testdiff.hs index 4ed7dd4..9360545 100644 --- a/examples/testdiff.hs +++ b/examples/testdiff.hs @@ -19,5 +19,11 @@ main = do mapM_ putStrLn $ xxd2 0 (L.toStrict patched) putStrLn "" case delta of - XSuccess (XDelta d) -> mapM_ putStrLn $ xxd2 0 (L.toChunks d !! 0) - _ -> print delta + XResult δ@(XDelta d) me -> do + -- mapM_ (mapM_ putStrLn . xxd2 0) (chunksOf 16 d) + mapM_ putStrLn $ xxd2 0 (L.toStrict d) + print me + putStrLn "" + let XResult patched' pe = applyPatch defaultConfig source δ + mapM_ putStrLn $ xxd2 0 (L.toStrict patched') -- $ L.take 48 patched') + print pe diff --git a/haskell/Data/XDelta.hsc b/haskell/Data/XDelta.hsc index 4ebdd51..bb08cb6 100644 --- a/haskell/Data/XDelta.hsc +++ b/haskell/Data/XDelta.hsc @@ -30,7 +30,6 @@ import Data.STRef import qualified Data.Text as T import Data.Text.Encoding import Data.Word -import Debug.Trace import Foreign.C.Types import Foreign.C.String import Foreign.ForeignPtr (withForeignPtr) @@ -53,7 +52,10 @@ import XDelta.Types data Stream m = Stream { streamArray :: MutableByteArray (PrimState m) - , streamPtr :: ForeignPtr Xd3Stream + , streamPtr :: ForeignPtr Xd3Stream -- ^ HACK: this is only used to attach a finalizer + -- to 'streamArray'. Don't use this pointer. + -- This would be unnecessary if I could create a + -- MutableByteArray with a finalizer attached. , streamSource :: MutVar (PrimState m) (Maybe (MutableByteArray (PrimState m))) } @@ -138,6 +140,7 @@ config_stream cfg = do xd3_abort_stream sptr xd3_close_stream sptr xd3_free_stream sptr + seq s $ return () -- Keep array s alive until the ffi functions finish. fp <- newForeignPtr sptr finalize return Stream { streamArray = s @@ -278,7 +281,8 @@ xdelta x xxcode_input ds = do (flip ($)) mstream $ \stream -> do set_source stream "xdelta" (xBlockSize x) (xBlockSize x) - let go withBlk (d:ds) = do + let go withBlk [] = return mempty + go withBlk (d:ds) = do let (fp,off,len) = B.toForeignPtr d eof = null ds when eof $ setFlush stream True @@ -291,9 +295,8 @@ xdelta x xxcode_input ds = do XD3_INPUT -> if (not eof) then go withBlk ds else return mempty XD3_OUTPUT -> do m' <- nextOut stream (\(p,len) -> xOutput x p (fromIntegral len)) - ms <- xInterleave x $ undefined -- go2 withBlk eof ds - return $ trace "chunk" m' <> ms - -- XXX: This output is to test for laziness. + ms <- xInterleave x $ go2 withBlk eof ds + return $ m' <> ms XD3_GETSRCBLK -> do Just n <- requestedBlockNumber stream let blk = xGetSource x n @@ -314,7 +317,7 @@ xdelta x xxcode_input ds = do e -> do s <- errorString stream xOnError x e s - go id ds + xInterleave x $ go id ds foreign import ccall "xdelta3.h xd3_decode_input" xd3_decode_input :: Ptr Xd3Stream -> IO ErrorCode @@ -342,39 +345,36 @@ computeDiff cfg source patched = fmap XDelta $ xdeltaPure encode_input cfg sourc applyPatch :: Config -> L.ByteString -> XDelta -> XDeltaFailable L.ByteString applyPatch cfg source (XDelta delta) = xdeltaPure decode_input cfg source delta -data XDeltaFailable x = XError ErrorCode String - | XSuccess x +data XDeltaFailable x = XResult { xresult :: x, xerror :: (Maybe (ErrorCode,String)) } deriving (Show,Functor) instance Monoid x => Monoid (XDeltaFailable x) where - mempty = XSuccess mempty - mappend (XSuccess x) (XSuccess y) = XSuccess $ mappend x y - mappend x@XError{} _ = x - mappend _ y@XError{} = y + mempty = XResult mempty Nothing + mappend (XResult x xe) y = XResult (mappend x $ xresult y) (maybe (xerror y) Just xe) xdeltaPure :: (forall s. Stream (ST s) -> ST s ErrorCode) -> Config -> L.ByteString -> L.ByteString -> XDeltaFailable L.ByteString xdeltaPure codec cfg source delta = - let smap = IntMap.fromList $ zip [0..] (chunksOf 16 source) + let smap = IntMap.fromList $ zip [0..] (chunksOf bsize source) + bsize = 4096 x :: XDeltaMethods (ST s) (XDeltaFailable L.ByteString) x = XDeltaMethods { xConfig = cfg , xGetSource = \i -> case IntMap.lookup (fromIntegral i) smap of Nothing -> B.empty Just bs -> bs - , xOutput = \ptr len -> unsafeIOToST $ XSuccess . L.fromStrict <$> B.packCStringLen (castPtr ptr,len) - , xOnError = \e s -> return (XError e s) -- :: ErrorCode -> String -> m u - , xBlockSize = 16 -- 4096 -- :: Usize_t + , xOutput = \ptr len -> unsafeIOToST $ flip XResult Nothing . L.fromStrict <$> B.packCStringLen (castPtr ptr,len) + , xOnError = \e s -> return (XResult L.empty (Just (e,s))) -- :: ErrorCode -> String -> m u + , xBlockSize = bsize -- :: Usize_t , xInterleave = unsafeInterleaveST -- :: forall a. m a -> m a - -- XXX: Why isn't unsafeInterleaveST making it lazy? } - ds = chunksOf 16 delta -- L.toChunks delta + ds = chunksOf bsize delta -- L.toChunks delta in runST $ xdelta x codec ds defaultConfig :: Config defaultConfig = Config - { winsize = 4096 - , sprevsz = 0 - , iopt_size = 0 + { winsize = XD3_DEFAULT_WINSIZE + , sprevsz = XD3_DEFAULT_SPREVSZ + , iopt_size = XD3_DEFAULT_IOPT_SIZE , flags = mempty , sec_data = CompressorConfig 0 0 0 , sec_inst = CompressorConfig 0 0 0 diff --git a/haskell/XDelta/Types.hsc b/haskell/XDelta/Types.hsc index f1d98ce..a0f2cfa 100644 --- a/haskell/XDelta/Types.hsc +++ b/haskell/XDelta/Types.hsc @@ -115,6 +115,9 @@ data Config = Config , smatch_cfg :: Either StringMatcher SMatchSelect -- ^ See enum: use fields below for soft config } +pattern XD3_DEFAULT_WINSIZE = #const XD3_DEFAULT_WINSIZE +pattern XD3_DEFAULT_SPREVSZ = #const XD3_DEFAULT_SPREVSZ +pattern XD3_DEFAULT_IOPT_SIZE = #const XD3_DEFAULT_IOPT_SIZE newtype Flags = Flags Word32 deriving (Storable,Eq,Bits,FiniteBits) diff --git a/xdelta3.cabal b/xdelta3.cabal index e773d6e..bc8a81b 100644 --- a/xdelta3.cabal +++ b/xdelta3.cabal @@ -25,7 +25,7 @@ library -- extra-lib-dirs: xdelta3_lib include-dirs: haskell . -- cc-options: -std=c++14 -Wno-literal-suffix - cxx-options: -Wno-literal-suffix + cxx-options: -Wno-literal-suffix -g cpp-options: -DNOT_MAIN=1 -DREGRESSION_TEST=1 -DSECONDARY_DJW=1 -DSECONDARY_FGK=1 -DXD3_MAIN=1 -DXD3_DEBUG=0 -DHAVE_CONFIG -- cpp-options: -DHAVE_CONFIG_H -DSIZEOF_SIZE_T=__SIZEOF_SIZE_T__ -DSIZEOF_UNSIGNED_INT=__SIZEOF_INT__ -DSIZEOF_UNSIGNED_LONG=__SIZEOF_LONG__ -- cpp-options: -DSIZEOF_UNSIGNED_LONG_LONG=__SIZEOF_LONG_LONG__ @@ -34,7 +34,7 @@ library cxx-sources: haskell/xdelta3.cc hs-source-dirs: haskell - build-depends: base >=4.10, bytestring, text, primitive, containers + build-depends: base >=4.9, bytestring, text, primitive >=0.6.2, containers default-language: Haskell2010 ghc-options: -Wmissing-signatures @@ -43,3 +43,9 @@ executable testdiff other-modules: Text.XXD hs-source-dirs: haskell examples . build-depends: base, bytestring, memory, xdelta + +executable lazy + main-is: lazy.hs + other-modules: Text.XXD + hs-source-dirs: haskell examples . + build-depends: base, bytestring, memory, xdelta -- cgit v1.2.3