{-# LANGUAGE MultiParamTypeClasses #-}

{-|
Module      : Mealstrom.WALStore
Description : Store WALEntries
Copyright   : (c) Max Amanshauser, 2016
License     : MIT
Maintainer  : max@lambdalifting.org

A WALStore is anything being able to store WALEntries.
WALEntries indicate how often a recovery process has been started for
an instance.
-}
module Mealstrom.WALStore where

import Data.Time.Clock

class WALStore st k where
    walUpsertIncrement :: st -> k -> IO ()
    walDecrement       :: st -> k -> IO ()
    walScan            :: st -> Int  -> IO [WALEntry k]

data WALEntry k = WALEntry {
    WALEntry k -> k
walId    :: k,
    WALEntry k -> UTCTime
walTime  :: UTCTime,
    WALEntry k -> Int
walCount :: Int
} deriving (Int -> WALEntry k -> ShowS
[WALEntry k] -> ShowS
WALEntry k -> String
(Int -> WALEntry k -> ShowS)
-> (WALEntry k -> String)
-> ([WALEntry k] -> ShowS)
-> Show (WALEntry k)
forall k. Show k => Int -> WALEntry k -> ShowS
forall k. Show k => [WALEntry k] -> ShowS
forall k. Show k => WALEntry k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WALEntry k] -> ShowS
$cshowList :: forall k. Show k => [WALEntry k] -> ShowS
show :: WALEntry k -> String
$cshow :: forall k. Show k => WALEntry k -> String
showsPrec :: Int -> WALEntry k -> ShowS
$cshowsPrec :: forall k. Show k => Int -> WALEntry k -> ShowS
Show,WALEntry k -> WALEntry k -> Bool
(WALEntry k -> WALEntry k -> Bool)
-> (WALEntry k -> WALEntry k -> Bool) -> Eq (WALEntry k)
forall k. Eq k => WALEntry k -> WALEntry k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WALEntry k -> WALEntry k -> Bool
$c/= :: forall k. Eq k => WALEntry k -> WALEntry k -> Bool
== :: WALEntry k -> WALEntry k -> Bool
$c== :: forall k. Eq k => WALEntry k -> WALEntry k -> Bool
Eq)

openTxn :: WALStore st k => st -> k -> IO ()
openTxn :: st -> k -> IO ()
openTxn = st -> k -> IO ()
forall st k. WALStore st k => st -> k -> IO ()
walUpsertIncrement

closeTxn :: WALStore st k => st -> k -> IO ()
closeTxn :: st -> k -> IO ()
closeTxn = st -> k -> IO ()
forall st k. WALStore st k => st -> k -> IO ()
walDecrement