{-- |
Module      : DumpDB
Description : Database agnostic dump file format
Copyright   : (c) Mihai Giurgeanu, 2017
License     : GPL-3
Maintainer  : mihai.giurgeanu@gmail.com
Stability   : experimental
Portability : Portable
--}

{-# LANGUAGE TemplateHaskell #-}
module Database.TransferDB.DumpDB.Format where

import Prelude hiding (fail)

import SQL.CLI (SQLSMALLINT, SQLINTEGER)
import Database.TransferDB.Commons (faillog)

import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Fail (MonadFail, fail)

import Data.Store       (Store(size, peek, poke), Size(ConstSize, VarSize), Peek, Poke, encode)
import Data.Store.Core  (pokeFromPtr, pokeFromForeignPtr, peekToPlainForeignPtr, unsafeEncodeWith)

import Data.String      (fromString)
import Data.Word        (Word8, Word16, Word32)

import Data.Time.Clock  (UTCTime)

import Foreign.ForeignPtr (ForeignPtr, newForeignPtr_)
import Foreign.Ptr (Ptr)

import TH.Derive        (derive, Deriving)

import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString as B

-- | dump file format version
data Version = V1 deriving (Show, Ord, Eq)

-- | the version size is dependent on 

instance Store Version where
  size = ConstSize 1

  poke V1 = poke (1::Word8)

  peek = do
    v <- peek :: Peek Word8
    case v of
      _ | v == 1        -> return V1
        | otherwise     -> fail $ "Unkown version tag found " ++ (show v)

-- | dump file header for version 1
data HeaderV1 = HeaderV1 {
  hv1_MaxChunkSize      :: SQLINTEGER,    -- ^ the maximum size of a data chunk; a field may have multiple data chunks
  hv1_Timestamp         :: UTCTime,       -- ^ the timestamp when the dump was made
  hv1_Description       :: C.ByteString   -- ^ the dump description provided by the user
  } deriving (Show, Eq)

$($(derive [d|
    instance Deriving (Store HeaderV1)
    |]))

-- | the schema reffers to the information about each field in one table
data SchemaV1 = SchemaV1 {
  schema_DBSchemaName   :: C.ByteString,    -- ^ database schema name
  schema_TableName      :: C.ByteString,    -- ^ the name of the table
  schema_Fields         :: [FieldInfoV1]    -- ^ information about each field in the table
  } deriving (Show, Eq)

-- | make a <schema>.<table_name> qualified table name
schema_QualifiedTableName :: SchemaV1 -> C.ByteString
schema_QualifiedTableName schema = (schema_DBSchemaName schema) `C.append` (C.pack ".") `C.append` (schema_TableName schema)


-- | information about the name of the field, the length, precision, type, etc
data FieldInfoV1 = FieldInfoV1 {
  fi_ColumnName         :: C.ByteString,
  fi_DataType           :: SQLSMALLINT,
  fi_ColumnSize         :: Maybe SQLINTEGER,
  fi_BufferLength       :: Maybe SQLINTEGER,
  fi_DecimalDigits      :: Maybe SQLSMALLINT,
  fi_NumPrecRadix       :: Maybe SQLSMALLINT,
  fi_Nullable           :: SQLSMALLINT,
  fi_OrdinalPosition    :: SQLINTEGER
  } deriving (Show, Eq)

instance Ord FieldInfoV1 where
  compare f1 f2 = compare (fi_OrdinalPosition f1) (fi_OrdinalPosition f2)

$($(derive [d|
    instance Deriving (Store FieldInfoV1)
    |]))

$($(derive [d|
    instance Deriving (Store SchemaV1)
    |]))

-- | there are 2 types of record indicators:
--     * RI means that the following data is a new record in the current table;
--     * EOT (end of table) means that there is no more data for the current table
--
-- The current table is defined by the previous SCHEMA block in the dump file
data RecordIndicator = RI | EOT deriving (Show, Eq)

instance Store RecordIndicator where
  size = ConstSize 1

  poke RI  = poke (255::Word8)
  poke EOT = poke (0  ::Word8)

  peek = do
    v <- peek :: Peek Word8
    case v of
      _ | v == 255  -> return RI
        | v == 0    -> return EOT
        | otherwise -> fail $ "Unknown value for record indicator found: " ++ (show v)

-- | indicates if a nullable field is Null or not Null; it is the first byte in encoded field value,
-- only for fields that are nullable; non-nullable fields have no null indicator
data NullIndicator = Null | NotNull deriving (Show, Eq)

instance Store NullIndicator where
  size = ConstSize 1

  poke Null    = poke (0  ::Word8)
  poke NotNull = poke (255::Word8)

  peek = do
    v <- peek :: Peek Word8
    case v of
      _ | v == 255  -> return NotNull
        | v == 0    -> return Null
        | otherwise -> fail $ "Unknown value for null indicator: " ++ (show v)

-- | declare type Size as instance of Show class to be used in the tests and log messages
instance Show (Size a) where
  show (ConstSize sz) = "(ConstSize " ++ (show sz) ++ ")"
  show (VarSize _)    = "VarSize"

-- | declare type Size as instance of Eq class to be used in test cases
instance Eq (Size a) where
  (==) (ConstSize sz1) (ConstSize sz2) = sz1 == sz2
  (==) _ _ = False


-- | helper function to compute the store size in bytes of a value
sizeOf :: Size a -> a -> Int
sizeOf sza x = case sza of
                 VarSize f   -> f x
                 ConstSize s -> s


-- | the version is written as an Word8 length followed by the version
writeVersion :: Version -> B.ByteString
writeVersion v = let v' = encode v
                     sz = fromIntegral $ B.length v'
                 in
                   B.cons sz v'

-- | the header is written as an Word16 length followed by the header itself
writeHeader :: HeaderV1 -> B.ByteString
writeHeader h = let h' = encode h
                    sz = fromIntegral $ B.length h'
                in
                  B.append (encode (sz :: Word16)) h'

-- | the schema is written as an Word32 length followed by the encoded schema
writeSchema :: SchemaV1 -> B.ByteString
writeSchema s = let s' = encode s
                    sz = fromIntegral $ B.length s'
                in
                  B.append (encode (sz :: Word32)) s'

-- | write an RI record indicator
writeRI :: B.ByteString
writeRI = encode RI

-- | write an EOT record indicator
writeEOT :: B.ByteString
writeEOT = encode EOT

-- | write a null indicator
writeNullIndicator :: NullIndicator -> B.ByteString
writeNullIndicator i = encode i

-- | a chunk of data consists of the length of the binary data and a pointer to
-- the memory of the data
data Chunk a = Chunk a (ForeignPtr Word8)

instance (Integral a, Store a) => Store (Chunk a) where
  size = VarSize $ \ (Chunk sz _) -> (sizeOf size sz) + (fromIntegral sz)

  poke (Chunk sz ptr) = do
    poke sz
    pokeFromForeignPtr ptr 0 (fromIntegral sz)

  peek = do
    sz  <- peek
    ptr <- peekToPlainForeignPtr "Database.TransferDB.DumpDB.Format.Chunk" (fromIntegral sz)
    return $ Chunk sz ptr


-- | write a chunk of binary data; the chunk has a length field followed by the binary data; the
-- length field may be on 1, 2 or 4 bytes; the first parameter is the length in bytes of the length
-- field, the second parameter is the length in bytes of the data
writeChunk :: Int -> Int -> Ptr Word8 -> B.ByteString
writeChunk lenlen sz ptr =
  let
    lenbs = case lenlen of
              1 -> encode ((fromIntegral sz) :: Word8)
              2 -> encode ((fromIntegral sz) :: Word16)
              4 -> encode ((fromIntegral sz) :: Word32)
              _ -> error $ "encoding chunk failed because the length of chunk size field is " ++ (show lenlen) ++ " bytes; it should be either 1, 2 or 4 bytes"
    bufbs = writePlainBuf ptr sz
  in
    B.append lenbs bufbs

-- | encodes the memory buffer into a ByteString
writePlainBuf :: Ptr Word8 -> Int -> B.ByteString
writePlainBuf p l = unsafeEncodeWith pokeBytes l
  where
    pokeBytes :: Poke ()
    pokeBytes = pokeFromPtr p 0 l