{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.SequenceId
( checkSeqId
, incrementSeqId
, checkSeqIdM
, incrementSeqIdM
, lastSeqIdM
, SequenceIdT (..)
, runSequenceIdT
, execSequenceIdT
, evalSequenceIdT
, SequenceIdError (..)
, SequenceIdErrorType (..)
) where
import Control.Applicative (Applicative)
import Control.Monad.State.Class (MonadState, get, modify', put)
import Control.Monad.Trans.Class (MonadTrans)
import Control.Monad.Trans.State (StateT (..), evalStateT, execStateT)
newtype SequenceIdT s m a = SequenceIdT { unSequenceIdT :: StateT s m a }
deriving (Monad, Applicative, Functor, MonadState s, MonadTrans)
evalSequenceIdT :: Monad m => SequenceIdT s m b -> s -> m b
evalSequenceIdT = evalStateT . unSequenceIdT
execSequenceIdT :: Monad m => SequenceIdT s m b -> s -> m s
execSequenceIdT = execStateT . unSequenceIdT
runSequenceIdT :: Monad m => SequenceIdT s m b -> s -> m (b, s)
runSequenceIdT = runStateT . unSequenceIdT
data SequenceIdError a = SequenceIdError
{ errType :: !SequenceIdErrorType
, lastSeqId :: !a
, currSeqId :: !a
} deriving (Eq, Show)
data SequenceIdErrorType
= SequenceIdDropped
| SequenceIdDuplicated
deriving (Eq, Show)
checkSeqIdM :: (Integral s, Monad m)
=> s
-> SequenceIdT s m (Maybe (SequenceIdError s))
checkSeqIdM currSeq = do
lastSeq <- get
put $ max lastSeq currSeq
return $ checkSeqId lastSeq currSeq
checkSeqId :: Integral s
=> s
-> s
-> Maybe (SequenceIdError s)
checkSeqId lastSeq currSeq
| delta lastSeq currSeq > 1 = Just $ SequenceIdError SequenceIdDropped lastSeq currSeq
| delta lastSeq currSeq < 1 = Just $ SequenceIdError SequenceIdDuplicated lastSeq currSeq
| otherwise = Nothing
delta :: Integral s => s -> s -> Int
delta lastSeq currSeq = fromIntegral currSeq - fromIntegral lastSeq
incrementSeqIdM :: (Monad m, Integral s) => SequenceIdT s m s
incrementSeqIdM = modify' incrementSeqId >> get
incrementSeqId :: Integral s
=> s
-> s
incrementSeqId = (+1)
lastSeqIdM :: Monad m => SequenceIdT s m s
lastSeqIdM = get