Reorganizing layers.

3 files changed, 31 insertions, 47 deletions

diff --git a/haskell/Data/Primitive/ByteArray/Util.hs b/haskell/Data/Primitive/ByteArray/Util.hs
index 1776286..de944e7 100644
--- a/haskell/Data/Primitive/ByteArray/Util.hs
+++ b/haskell/Data/Primitive/ByteArray/Util.hs
@@ -9,10 +9,16 @@
 {-# LANGUAGE TypeOperators         #-}
 module Data.Primitive.ByteArray.Util where
 
+import GHC.Exts (Ptr(..))
 import GHC.TypeLits
 import Control.Monad.Primitive
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Unsafe as B
+import Data.Primitive.Addr
 import Data.Primitive.Types
 import Data.Primitive.ByteArray
+import Data.Word
+import Foreign.Ptr
 
 newtype Offset (n :: Nat) = Offset Int
 
@@ -43,3 +49,18 @@ readAtByte :: forall a m n.
                ) => MutableByteArray (PrimState m) -> Offset n -> m a
 readAtByte buf (Offset offset) = readByteArray buf (div offset $ (sizeOf (undefined :: a)))
 {-# INLINE readAtByte #-}
+
+writeStringAt :: PrimMonad m => MutableByteArray s -> Int -> B.ByteString -> m (Ptr a)
+writeStringAt src o bsname = do
+    (p,cnt) <- unsafeIOToPrim $ B.unsafeUseAsCStringLen bsname return
+    let nptr = ptr (mutableByteArrayContents src) `plusPtr` o
+    copyAddr (adr nptr) (adr p) cnt
+    writeOffAddr (adr nptr) cnt (0 :: Word8)
+    return nptr
+
+ptr :: Addr -> Ptr a
+ptr (Addr a) = Ptr a
+
+adr :: Ptr a -> Addr
+adr (Ptr a) = Addr a
+
diff --git a/haskell/Data/VCDIFF.hsc b/haskell/Data/VCDIFF.hsc
index 5e484e1..804b119 100644
--- a/haskell/Data/VCDIFF.hsc
+++ b/haskell/Data/VCDIFF.hsc
@@ -47,6 +47,7 @@ import GHC.Exts
 import GHC.TypeLits
 
 import Data.VCDIFF.Types
+import Data.VCDIFF.XDelta
 
 #ifndef SIZEOF_SIZE_T
 #define SIZEOF_SIZE_T __SIZEOF_SIZE_T__
@@ -65,7 +66,7 @@ data Stream m = Stream
                                            -- 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)))
+    , streamSource :: MutVar (PrimState m) (Maybe (Source m))
     }
 
 foreign import ccall "xdelta3.h xd3_config_stream" xd3_config_stream :: Ptr Xd3Stream -> Ptr Config -> IO ErrorCode
@@ -76,12 +77,6 @@ foreign import ccall "xdelta3.h xd3_abort_stream" xd3_abort_stream :: Ptr Xd3Str
 
 foreign import ccall "xdelta3.h xd3_close_stream" xd3_close_stream :: Ptr Xd3Stream -> IO ErrorCode
 
-type instance SizeOf Usize_t              = #const sizeof(usize_t)
-type instance SizeOf (FunPtr a)           = #const sizeof(void(*)())
-type instance SizeOf (Ptr a)              = #const sizeof(void*)
-type instance SizeOf #{type int}          = #const sizeof(int)
-type instance SizeOf #{type unsigned int} = #const sizeof(unsigned int)
-
 
 
 writeCompressorConfig :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> CompressorConfig -> m ()
@@ -102,12 +97,6 @@ writeMatcher c o sm = do
     writeAtByte c (o +. #{off xd3_smatcher, max_lazy     }) (smMaxLazy sm)
     writeAtByte c (o +. #{off xd3_smatcher, long_enough  }) (smLongEnough sm)
 
-ptr :: Addr -> Ptr a
-ptr (Addr a) = Ptr a
-
-adr :: Ptr a -> Addr
-adr (Ptr a) = Addr a
-
 -- The xd3_config structure is used to initialize a stream - all data
 -- is copied into stream so config may be a temporary variable.  See
 -- the [documentation] or comments on the xd3_config structure.
@@ -165,18 +154,9 @@ config_stream cfg = do
         XD3_SUCCESS -> return $ c `seq` Right stream
         ecode       -> return $ Left ecode
 
-writeStringAt :: PrimMonad m => MutableByteArray s -> Int -> B.ByteString -> m (Ptr a)
-writeStringAt src o bsname = do
-    (p,cnt) <- unsafeIOToPrim $ B.unsafeUseAsCStringLen bsname return
-    let nptr = ptr (mutableByteArrayContents src) `plusPtr` o
-    copyAddr (adr nptr) (adr p) cnt
-    writeOffAddr (adr nptr) cnt (0 :: Word8)
-    return nptr
-
-data Xd3Source
-
 foreign import ccall "xdelta3.h xd3_set_source" xd3_set_source :: Ptr Xd3Stream -> Ptr Xd3Source -> IO ErrorCode
 
+
 set_source :: PrimMonad m =>
                     Stream m -> String  -- ^ name for debug/print purposes.
                        -> Usize_t -- ^ block size
@@ -184,21 +164,14 @@ set_source :: PrimMonad m =>
                                   -- Rounds up to approx 16k.
                        -> m ()
 set_source stream nm blksz maxwinsz = do
-    let bsname = encodeUtf8 $ T.pack nm
-    src <- newPinnedByteArray $ 1 + B.length bsname + #{const sizeof(xd3_source)}
-    nptr <- writeStringAt src #{const sizeof(xd3_source)} bsname
-    writeAtByte src (#{off xd3_source, blksize    }) blksz
-    writeAtByte src (#{off xd3_source, name       }) nptr
-    writeAtByte src (#{off xd3_source, max_winsize}) maxwinsz
-    writeAtByte src (#{off xd3_source, curblkno   }) (maxBound :: Xoff_t)
+    src <- newSource nm blksz maxwinsz
     {-
     writeAtByte (streamArray stream)
                 #{offset xd3_stream, getblk}
                 nullPtr -- xdelta3.h documents this as an internal field.
     -}
     let strm = ptr (mutableByteArrayContents $ streamArray stream)
-        srcptr = ptr (mutableByteArrayContents src)
-    unsafeIOToPrim (xd3_set_source strm srcptr)
+    unsafeIOToPrim (xd3_set_source strm $ sourcePtr src)
     writeMutVar (streamSource stream) (Just src)
 
 data XDeltaMethods m u = XDeltaMethods
@@ -250,17 +223,10 @@ nextOut stream action = do
     writeAtByte (streamArray stream) (#{off xd3_stream, avail_out}) (0 :: Usize_t)
     return a
 
-
 requestedBlockNumber :: PrimMonad m => Stream m -> m (Maybe Xoff_t)
 requestedBlockNumber stream = do
     msrc <- readMutVar $ streamSource stream
-    forM msrc $ \src -> readAtByte src (#{off xd3_source, getblkno})
-
-data CurrentBlock = CurrentBlock
-    { blkno   :: !Xoff_t      -- ^ current block number
-    , blkSize :: !Usize_t     -- ^ number of bytes on current block: must be >= 0 and <= 'srcBlockSize'
-    , blkPtr  :: !(Ptr Word8) -- ^ current block array
-    }
+    forM msrc sourceRequestedBlocknumber
 
 -- -- declared static
 -- foreign import ccall "xdelta3.h xd3_errstring" xd3_errstring :: Ptr Xd3Stream -> IO CString
@@ -275,13 +241,9 @@ errorString stream = do
         else return ""
 
 pokeCurrentBlock :: PrimMonad m => Stream m -> CurrentBlock -> m ()
-pokeCurrentBlock stream (CurrentBlock no sz ptr) = do
+pokeCurrentBlock stream blk = do
     msrc <- readMutVar $ streamSource stream
-    forM_ msrc $ \src -> do
-        writeAtByte src (#{off xd3_source, curblkno}) no
-        writeAtByte src (#{off xd3_source, onblk})    sz
-        writeAtByte src (#{off xd3_source, curblk})   ptr
-
+    forM_ msrc (`sourceWriteCurrentBlock` blk)
 
 withByteString :: PrimBase m => B.ByteString -> (Ptr b -> Usize_t -> m a) -> m a
 withByteString d act =
@@ -319,7 +281,7 @@ xdelta x xxcode_input ds = do
                                     pokeCurrentBlock stream $ CurrentBlock n len p
                                     when (len < xBlockSize x) $ do
                                         Just src <- readMutVar $ streamSource stream
-                                        writeAtByte src (#{off xd3_source, eof_known}) (1 :: #{type int})
+                                        sourceWriteEOFKnown src True
                                     act
                     go2 withBlk' eof ds
                 XD3_GOTHEADER -> go2 withBlk eof ds -- No
diff --git a/xdelta.cabal b/xdelta.cabal
index e75e761..6540559 100644
--- a/xdelta.cabal
+++ b/xdelta.cabal
@@ -15,6 +15,7 @@ extra-source-files:  xdelta3/*.h xdelta3/*.c
 
 library
   exposed-modules:  Data.VCDIFF.Types
+                  , Data.VCDIFF.XDelta
                   , Data.VCDIFF
                   , Data.Primitive.ByteArray.Util