Minor clean up.

2 files changed, 17 insertions, 68 deletions

diff --git a/haskell/Data/VCDIFF.hs b/haskell/Data/VCDIFF.hs
index f06be9c..fe4cc98 100644
--- a/haskell/Data/VCDIFF.hs
+++ b/haskell/Data/VCDIFF.hs
@@ -24,7 +24,6 @@ module Data.VCDIFF
   , computeDiff
   , applyPatch) where
 
--- import Debug.Trace
 import Control.Monad
 import Control.Monad.Primitive
 import Control.Monad.ST
@@ -69,6 +68,7 @@ data Stream m = Stream
     , streamSource :: MutVar (PrimState m) (Maybe (Source m))
     }
 
+keepAlive :: a1 -> a2 -> IO ()
 keepAlive srcvar s = do
     seq srcvar $ seq s $ return () -- Keep array s alive until the ffi functions finish.
 {-# NOINLINE keepAlive #-}
@@ -89,7 +89,6 @@ config_stream cfg = do
                 xd3_abort_stream sptr
                 xd3_close_stream sptr
                 xd3_free_stream sptr
-                putStrLn $ "finalized " ++ show sptr
                 keepAlive srcvar s
         fp <- newForeignPtr sptr finalize
         return Stream
@@ -122,7 +121,7 @@ set_source stream nm blksz maxwinsz = do
 
 data XDeltaMethods m u = XDeltaMethods
     { xConfig    :: Config
-    , xGetSource :: Xoff_t -> B.ByteString
+    , xGetSource :: Xoff_t -> m B.ByteString
     , xOutput    :: Ptr Word8 -> Int -> m u
     , xOnError   :: ErrorCode -> String -> m u
     , xBlockSize :: Usize_t
@@ -173,12 +172,11 @@ outputChunks :: (Monoid b, Num t, PrimMonad m, Show b) =>
 outputChunks strm interleave encode output next = fix $ \loop -> do
     encode >>= \case
         XD3_OUTPUT -> do u1 <- nextOut strm $ \(p,len) -> output p (fromIntegral len)
-                         trace ("u1 = " ++ show u1) $ return ()
                          u <- interleave $ loop
                          return $ u1 <> u
-        XD3_GOTHEADER -> trace "XD3_GOTHEADER" loop
-        XD3_WINSTART  -> trace "XD3_WINSTART" loop
-        XD3_WINFINISH -> trace "XD3_WINFINISH" loop
+        XD3_GOTHEADER -> loop
+        XD3_WINSTART  -> loop
+        XD3_WINFINISH -> loop
         xd3           -> next xd3
 
 withBlocks :: PrimBase m => B.ByteString -> Maybe B.ByteString -> m a -> m a
@@ -196,7 +194,7 @@ updateBlock :: (Monoid u, PrimBase m, Show u) =>
                      -> ErrorCode
                      -> m u
 updateBlock stream code_input mblk x _ [] XD3_INPUT = return mempty
-updateBlock stream code_input mblk x _ (d:ds) XD3_INPUT = trace "XD3_INPUT" $ do
+updateBlock stream code_input mblk x _ (d:ds) XD3_INPUT = do
     withByteString d $ \p len -> avail_input (streamArray stream) p len
     when (null ds) $ setFlush (streamArray stream) True
     outputChunks (streamArray stream) (xInterleave x)
@@ -205,10 +203,9 @@ updateBlock stream code_input mblk x _ (d:ds) XD3_INPUT = trace "XD3_INPUT" $ do
         $ updateBlock stream code_input mblk x d ds
 updateBlock stream code_input mblk x d ds XD3_GETSRCBLK = do
     Just n <- requestedBlockNumber stream
-    let blk = xGetSource x n
+    blk <- xGetSource x n
     withByteString blk $ \p len -> do
         pokeCurrentBlock stream $ CurrentBlock n len p
-        trace ("XD3_GETSRCBLK " ++ show (n,len,p,xBlockSize x)) $ return ()
         when (len < xBlockSize x) $ do
             Just src <- readMutVar $ streamSource stream
             sourceWriteEOFKnown src True
@@ -216,59 +213,18 @@ updateBlock stream code_input mblk x d ds XD3_GETSRCBLK = do
         (withBlocks d (Just blk) code_input)
         (xOutput x)
         $ updateBlock stream code_input mblk x d ds
-updateBlock stream code_input mblk x d ds e = trace (show e) $ do
+updateBlock stream code_input mblk x d ds e = do
     s <- errorString (streamArray stream)
     xOnError x e s
 
-trace _ = id
-
 xdelta :: (Show u, PrimBase m, Monoid u) => XDeltaMethods m u -> (Stream m -> m ErrorCode) -> [B.ByteString] -> m u
-xdelta x xxcode_input ds = trace ("ds = "++show ds) $ do
+xdelta x xxcode_input ds = do
     mstream <- config_stream (xConfig x)
     either (\e _ -> xOnError x e "config_stream failed")
            (flip ($))
            mstream $ \stream -> do
     src <- set_source stream "VCDIFF" (xBlockSize x) (xBlockSize x)
     updateBlock stream (xxcode_input stream) Nothing x B.empty ds XD3_INPUT
-    {-
-    let go withBlk [] = return mempty
-        go withBlk (d:ds) = do
-            let (fp,off,len) = B.toForeignPtr d
-                eof = null ds || len < fromIntegral (xBlockSize x)
-            when eof $ setFlush (streamArray stream) True
-            withByteString d $ \indata len -> do
-                avail_input (streamArray stream) indata len
-                go2 withBlk eof ds
-        go2 withBlk eof ds = do
-            ret <- withBlk $ xxcode_input stream
-            case ret of
-                XD3_INPUT -> if (not eof) then go withBlk ds else return mempty
-                XD3_OUTPUT -> do
-                    m' <- nextOut (streamArray stream) (\(p,len) -> xOutput x p (fromIntegral len))
-                    ms <- xInterleave x $ go2 withBlk eof ds
-                    return $ m' <> ms
-                XD3_GETSRCBLK -> do
-                    Just n <- requestedBlockNumber stream
-                    let blk = xGetSource x n
-                        withBlk' act = withByteString blk $ \p len -> do
-                                    pokeCurrentBlock stream $ CurrentBlock n len p
-                                    when (len < xBlockSize x) $ do
-                                        Just src <- readMutVar $ streamSource stream
-                                        sourceWriteEOFKnown src True
-                                    act
-                    go2 withBlk' eof ds
-                XD3_GOTHEADER -> go2 withBlk eof ds -- No
-                XD3_WINSTART  -> go2 withBlk eof ds --  action
-                XD3_WINFINISH -> go2 withBlk eof ds --   neccessary
-                            -- -- These are set for each XD3_WINFINISH return.
-                            -- xd3_encoder_used_source :: Ptr Stream -> IO Bool
-                            -- xd3_encoder_srcbase :: Ptr Stream -> IO Xoff_t
-                            -- xd3_encoder_srclen :: Ptr Stream -> IO Usize_t
-                e -> do
-                    s <- errorString (streamArray stream)
-                    xOnError x e s
-    xInterleave x $ go id ds
-    -}
 
 decode_input :: PrimMonad m => Stream m -> m ErrorCode
 decode_input stream =
@@ -329,14 +285,14 @@ xdeltaPure codec cfg source input =
         x :: XDeltaMethods (ST s) (Result L.ByteString)
         x = XDeltaMethods
                 { xConfig     = cfg
-                , xGetSource  = \i -> case IntMap.lookup (fromIntegral i) smap of
+                , xGetSource  = \i -> return $ case IntMap.lookup (fromIntegral i) smap of
                                     Nothing -> B.empty
                                     Just bs -> bs
                 , xOutput     = \ptr len -> unsafeIOToST $ flip Result Nothing . L.fromStrict
                                                            <$> B.packCStringLen (castPtr ptr,len)
                 , xOnError    = \e s -> return (Result L.empty (Just (e,s)))
                 , xBlockSize  = bsize
-                , xInterleave = id -- unsafeInterleaveST
+                , xInterleave = unsafeInterleaveST
                 }
     in runST $ xdelta x codec ds
 
diff --git a/haskell/examples/testdiff.hs b/haskell/examples/testdiff.hs
index 08229d3..d2b99f5 100644
--- a/haskell/examples/testdiff.hs
+++ b/haskell/examples/testdiff.hs
@@ -25,10 +25,6 @@ delta3 = computeDiff defaultConfig { flags = XD3_ADLER32 } source target
 delta4 :: Result VCDIFF
 delta4 = computeDiff defaultConfig { flags = XD3_ADLER32 } source target
 
-delta5 :: Result VCDIFF
-delta5 = computeDiff defaultConfig { flags = XD3_ADLER32 } source target
-
-
 
 dump title bs kont = do
     putStrLn title
@@ -38,17 +34,14 @@ dump title bs kont = do
 main = do
     dump "source" source $ putStrLn ""
     dump "target" target $ putStrLn ""
-    go source "XD3_ADLER32" delta3
-    go source "XD3_ADLER32" delta4
-    go source "XD3_ADLER32" delta5
     go source "default" delta
     go source "default" delta2
-    {-
-    go source2 "default" delta
-    go source2 "default" delta2
-    go source2 "XD3_ADLER32" delta3
-    go source2 "XD3_ADLER32" delta4
-    -}
+    go source2 "default2" delta
+    go source2 "default2" delta2
+    go source "XD3_ADLER32" delta3
+    go source2 "XD3_ADLER32-2" delta3
+    go source "XD3_ADLER32" delta4
+    go source2 "XD3_ADLER32-2"delta4
     print source
     print source2
     print target