{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TypeFamilies          #-}
module Data.VCDIFF.XDelta where

import Control.Monad
import Control.Monad.Primitive
import Data.Bits
import qualified Data.ByteString     as B
import Data.Coerce
import Data.Int
import Data.Primitive.ByteArray
import Data.Primitive.ByteArray.Util
import qualified Data.Text           as T
import Data.Text.Encoding
import Data.VCDIFF.Types
import Data.Word
import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr

#ifndef SIZEOF_SIZE_T
#define SIZEOF_SIZE_T __SIZEOF_SIZE_T__
#define SIZEOF_UNSIGNED_INT __SIZEOF_INT__
#define SIZEOF_UNSIGNED_LONG __SIZEOF_LONG__
#define SIZEOF_UNSIGNED_LONG_LONG __SIZEOF_LONG_LONG__
#define static_assert(...)
#endif
#include <xdelta3.h>

#include "offset.h"

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)


data Xd3Source

newtype Source m = Source (MutableByteArray (PrimState m))

newSource :: PrimMonad m =>
                    String  -- ^ name for debug/print purposes.
                    -> Usize_t -- ^ block size
                    -> Xoff_t  -- ^ maximum visible buffer (Suggested: set same as block size).
                               -- Rounds up to approx 16k.
                    -> m (Source m)
newSource nm blksz maxwinsz = do
    let bsname = encodeUtf8 $ T.pack nm
    src <- newPinnedByteArray $ 1 + B.length bsname + #{const sizeof(xd3_source)}
    fillByteArray src 0 #{const sizeof(xd3_source)} (0 :: Word8)
    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)
    return $ Source src

sourcePtr :: Source m -> Ptr Xd3Source
sourcePtr (Source src) = ptr (mutableByteArrayContents src)

sourceRequestedBlocknumber :: PrimMonad m => Source m -> m Xoff_t
sourceRequestedBlocknumber (Source 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
    }

sourceWriteCurrentBlock :: PrimMonad m => Source m -> CurrentBlock -> m ()
sourceWriteCurrentBlock (Source src) (CurrentBlock no sz ptr) = do
    writeAtByte src (#{off xd3_source, curblkno}) no
    writeAtByte src (#{off xd3_source, onblk})    sz
    when (ptr /= nullPtr)
        $ writeAtByte src (#{off xd3_source, curblk})   ptr

sourceWriteEOFKnown :: PrimMonad m => Source m -> Bool -> m ()
sourceWriteEOFKnown (Source src) False = writeAtByte src (#{off xd3_source, eof_known}) (0 :: #{type int})
sourceWriteEOFKnown (Source src) True  = writeAtByte src (#{off xd3_source, eof_known}) (1 :: #{type int})

newtype StreamArray m = StreamArray (MutableByteArray (PrimState m))

newStreamArray :: PrimMonad m =>
                        Maybe String -> m (StreamArray m, CString)
newStreamArray mmatcher = do
    let (len,n) = case mmatcher of
            Just m  -> let n = encodeUtf8 $ T.pack m
                       in ( #{const sizeof(xd3_stream)} + B.length n + 1
                          , n )
            Nothing -> ( #{const sizeof(xd3_stream)}, B.empty )
    s <- newPinnedByteArray len
    fillByteArray s 0 #{const sizeof(xd3_stream)} 0
    nptr <- case mmatcher of
        Nothing -> writeStringAt s #{const sizeof(xd3_stream)} n
        Just _  -> return nullPtr
    return (StreamArray s,nptr)

streamArrayPtr :: StreamArray m -> Ptr Xd3Stream
streamArrayPtr (StreamArray s) = ptr (mutableByteArrayContents s)

setFlag :: PrimMonad m => Flags -> StreamArray m -> Bool -> m ()
setFlag b (StreamArray s) wantFlush = do
    f <- readAtByte s (#{off xd3_stream, flags})
    writeAtByte s (#{off xd3_stream, flags})
        . (coerce :: Flags -> Word32)
        $ if wantFlush then Flags f .|. b
                       else Flags f .&. complement b

setFlush :: PrimMonad m => StreamArray m -> Bool -> m ()
setFlush = setFlag XD3_FLUSH

setSkipWindow :: PrimMonad m => StreamArray m -> Bool -> m ()
setSkipWindow = setFlag XD3_SKIP_WINDOW


avail_input :: PrimMonad m => StreamArray m -> Ptr a -> Usize_t -> m ()
avail_input (StreamArray s) p sz = do
    writeAtByte s (#{off xd3_stream, next_in}) p
    writeAtByte s (#{off xd3_stream, avail_in}) sz


nextOut :: PrimMonad m => StreamArray m -> ((Ptr Word8, Usize_t) -> m a) -> m a
nextOut (StreamArray s) action = do
    buf <- (,)
        <$> readAtByte s (#{off xd3_stream, next_out})
        <*> readAtByte s (#{off xd3_stream, avail_out})
    a <- action buf
    -- unsafeIOToPrim $ xd3_consume_output (ptr $ mutableByteArrayContents $ streamArray stream)
    writeAtByte s #{off xd3_stream, avail_out} (0 :: Usize_t)
    return a


-- | Gives some extra information about the latest library error, if any
-- is known.
errorString :: PrimMonad m => StreamArray m -> m String
errorString (StreamArray s) = do
    cstring <- readAtByte s (#{off xd3_stream, msg})
    if cstring /= nullPtr
        then unsafeIOToPrim $ peekCString cstring -- TODO: avoid unsafeIOToPrim
        else return ""

writeCompressorConfig :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> CompressorConfig -> m ()
writeCompressorConfig c o sec = do
    writeAtByte c (o +. #{off xd3_sec_cfg,ngroups}) (ngroups sec)
    writeAtByte c (o +. #{off xd3_sec_cfg,sector_size}) (sector_size sec)
    writeAtByte c (o +. #{off xd3_sec_cfg,inefficient}) (inefficient sec)

writeMatcher :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> StringMatcher -> m ()
writeMatcher c o sm = do
    -- handled elsewhere: const char *name; <- smName :: String
    writeAtByte c (o +. #{off xd3_smatcher, string_match }) (smStringMatch sm)
    writeAtByte c (o +. #{off xd3_smatcher, large_look   }) (smLargeLook sm)
    writeAtByte c (o +. #{off xd3_smatcher, large_step   }) (smLargeStep sm)
    writeAtByte c (o +. #{off xd3_smatcher, small_look   }) (smSmallLook sm)
    writeAtByte c (o +. #{off xd3_smatcher, small_chain  }) (smSmallChain sm)
    writeAtByte c (o +. #{off xd3_smatcher, small_lchain }) (smSmallLchain sm)
    writeAtByte c (o +. #{off xd3_smatcher, max_lazy     }) (smMaxLazy sm)
    writeAtByte c (o +. #{off xd3_smatcher, long_enough  }) (smLongEnough sm)

packConfig :: PrimMonad m => CString -- ^ Name of software matcher or nullPtr.
                          -> Config
                          -> m ByteArray
packConfig nptr cfg = do
    c <- newPinnedByteArray #const sizeof(xd3_config)
    fillByteArray c 0 #{const sizeof(xd3_config)} 0
    writeAtByte c #{off xd3_config, winsize} (winsize cfg)
    writeAtByte c #{off xd3_config, sprevsz} (sprevsz cfg)
    writeAtByte c #{off xd3_config, iopt_size} (iopt_size cfg)
    writeAtByte c #{off xd3_config, flags} (coerce (flags cfg) :: Word32)
    writeCompressorConfig c #{off xd3_config, sec_data} (sec_data cfg)
    writeCompressorConfig c #{off xd3_config, sec_inst} (sec_inst cfg)
    writeCompressorConfig c #{off xd3_config, sec_addr} (sec_addr cfg)
    let msel :: #type xd3_smatch_cfg
        msel = either (const #{const XD3_SMATCH_SOFT})
                      (fromIntegral . fromEnum)
                      (smatch_cfg cfg)
    writeAtByte c (#{off xd3_config, smatch_cfg}) msel
    let mmatcher = either Just (const Nothing) $ smatch_cfg cfg
    forM_ mmatcher $ \matcher -> do
            let o = #off xd3_config,smatcher_soft
            writeAtByte c (o +. (#{off xd3_smatcher, name})) nptr
            writeMatcher c o matcher
    unsafeFreezeByteArray c

foreign import ccall "xdelta3.h xd3_config_stream" xd3_config_stream :: Ptr Xd3Stream -> Ptr Config -> IO ErrorCode

foreign import ccall "xdelta3.h xd3_free_stream" xd3_free_stream :: Ptr Xd3Stream -> IO ()

foreign import ccall "xdelta3.h xd3_abort_stream" xd3_abort_stream :: Ptr Xd3Stream -> IO ()

foreign import ccall "xdelta3.h xd3_close_stream" xd3_close_stream :: Ptr Xd3Stream -> IO ErrorCode


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


foreign import ccall "xdelta3.h xd3_set_source" xd3_set_source :: Ptr Xd3Stream -> Ptr Xd3Source -> IO ErrorCode