{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RecordWildCards           #-}

-- | Batch operations.

module Pos.DB.BatchOp
       ( RocksBatchOp (..)
       , EmptyBatchOp
       , SomeBatchOp (..)
       , SomePrettyBatchOp (..)
       , dbWriteBatch'
       , rocksWriteBatch
       ) where

import           Universum

import qualified Database.RocksDB as Rocks
import           Formatting (bprint)
import qualified Formatting.Buildable
import           Serokell.Util.Text (listJson)

import           Pos.DB.Class (DBTag, MonadDB (dbWriteBatch))
import           Pos.DB.Rocks.Types (DB (..))

class RocksBatchOp a where
    toBatchOp :: a -> [Rocks.BatchOp]

instance RocksBatchOp Rocks.BatchOp where
    toBatchOp = one

data EmptyBatchOp

instance RocksBatchOp EmptyBatchOp where
    toBatchOp _ = []

instance Buildable EmptyBatchOp where
    build _ = ""

data SomeBatchOp =
    forall a. RocksBatchOp a =>
              SomeBatchOp a

instance Semigroup SomeBatchOp where
    a <> b = SomeBatchOp [a, b]

instance Monoid SomeBatchOp where
    mempty = SomeBatchOp ([]::[EmptyBatchOp])
    mappend = (<>)

instance RocksBatchOp SomeBatchOp where
    toBatchOp (SomeBatchOp a) = toBatchOp a

data SomePrettyBatchOp =
    forall a. (RocksBatchOp a, Buildable a) =>
              SomePrettyBatchOp a

instance Semigroup SomePrettyBatchOp where
    a <> b = SomePrettyBatchOp [a, b]

instance Monoid SomePrettyBatchOp where
    mempty = SomePrettyBatchOp ([]::[SomePrettyBatchOp])
    mappend = (<>)

instance RocksBatchOp SomePrettyBatchOp where
    toBatchOp (SomePrettyBatchOp a) = toBatchOp a

instance Buildable SomePrettyBatchOp where
    build (SomePrettyBatchOp x) = Formatting.Buildable.build x

-- instance (Foldable t, RocksBatchOp a) => RocksBatchOp (t a) where
--     toBatchOp = concatMap toBatchOp -- overlapping instances, wtf ?????

instance RocksBatchOp a => RocksBatchOp [a] where
    toBatchOp = concatMap toBatchOp

instance RocksBatchOp a => RocksBatchOp (NonEmpty a) where
    toBatchOp = concatMap toBatchOp

instance Buildable [SomePrettyBatchOp] where
    build = bprint listJson

-- | Write a batch of some operations using 'MonadDB' interface.
-- The only difference from 'dbWriteBatch' is that this function
-- works with whatever types which are instances of 'RocksBatchOp'.
dbWriteBatch' :: (RocksBatchOp a, MonadDB m) => DBTag -> [a] -> m ()
dbWriteBatch' tag batch = dbWriteBatch tag (concatMap toBatchOp batch)

-- | Write a batch of some operations to RocksDB.
rocksWriteBatch :: (RocksBatchOp a, MonadIO m) => [a] -> DB -> m ()
rocksWriteBatch batch DB {..} =
    Rocks.write rocksDB rocksWriteOpts (concatMap toBatchOp batch)
