{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.SequenceId
       ( checkSeqId
       , incrementSeqId

         -- * Monadic
       , checkSeqIdM
       , incrementSeqIdM
       , lastSeqIdM
       , SequenceIdT (..)
       , runSequenceIdT
       , execSequenceIdT
       , evalSequenceIdT

         -- * Types
       , 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 { forall s (m :: * -> *) a. SequenceIdT s m a -> StateT s m a
unSequenceIdT :: StateT s m a }
    deriving (forall a. a -> SequenceIdT s m a
forall a b.
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m b
forall a b.
SequenceIdT s m a -> (a -> SequenceIdT s m b) -> SequenceIdT s m b
forall {s} {m :: * -> *}. Monad m => Applicative (SequenceIdT s m)
forall s (m :: * -> *) a. Monad m => a -> SequenceIdT s m a
forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m b
forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m a -> (a -> SequenceIdT s m b) -> SequenceIdT s m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> SequenceIdT s m a
$creturn :: forall s (m :: * -> *) a. Monad m => a -> SequenceIdT s m a
>> :: forall a b.
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m b
$c>> :: forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m b
>>= :: forall a b.
SequenceIdT s m a -> (a -> SequenceIdT s m b) -> SequenceIdT s m b
$c>>= :: forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m a -> (a -> SequenceIdT s m b) -> SequenceIdT s m b
Monad, forall a. a -> SequenceIdT s m a
forall a b.
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m a
forall a b.
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m b
forall a b.
SequenceIdT s m (a -> b) -> SequenceIdT s m a -> SequenceIdT s m b
forall a b c.
(a -> b -> c)
-> SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m c
forall {s} {m :: * -> *}. Monad m => Functor (SequenceIdT s m)
forall s (m :: * -> *) a. Monad m => a -> SequenceIdT s m a
forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m a
forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m b
forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m (a -> b) -> SequenceIdT s m a -> SequenceIdT s m b
forall s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m a
$c<* :: forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m a
*> :: forall a b.
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m b
$c*> :: forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m b
liftA2 :: forall a b c.
(a -> b -> c)
-> SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m c
$cliftA2 :: forall s (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> SequenceIdT s m a -> SequenceIdT s m b -> SequenceIdT s m c
<*> :: forall a b.
SequenceIdT s m (a -> b) -> SequenceIdT s m a -> SequenceIdT s m b
$c<*> :: forall s (m :: * -> *) a b.
Monad m =>
SequenceIdT s m (a -> b) -> SequenceIdT s m a -> SequenceIdT s m b
pure :: forall a. a -> SequenceIdT s m a
$cpure :: forall s (m :: * -> *) a. Monad m => a -> SequenceIdT s m a
Applicative, forall a b. a -> SequenceIdT s m b -> SequenceIdT s m a
forall a b. (a -> b) -> SequenceIdT s m a -> SequenceIdT s m b
forall s (m :: * -> *) a b.
Functor m =>
a -> SequenceIdT s m b -> SequenceIdT s m a
forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> SequenceIdT s m a -> SequenceIdT s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SequenceIdT s m b -> SequenceIdT s m a
$c<$ :: forall s (m :: * -> *) a b.
Functor m =>
a -> SequenceIdT s m b -> SequenceIdT s m a
fmap :: forall a b. (a -> b) -> SequenceIdT s m a -> SequenceIdT s m b
$cfmap :: forall s (m :: * -> *) a b.
Functor m =>
(a -> b) -> SequenceIdT s m a -> SequenceIdT s m b
Functor, MonadState s, forall s (m :: * -> *) a. Monad m => m a -> SequenceIdT s m a
forall (m :: * -> *) a. Monad m => m a -> SequenceIdT s m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> SequenceIdT s m a
$clift :: forall s (m :: * -> *) a. Monad m => m a -> SequenceIdT s m a
MonadTrans)


evalSequenceIdT :: Monad m => SequenceIdT s m b -> s -> m b
evalSequenceIdT :: forall (m :: * -> *) s b. Monad m => SequenceIdT s m b -> s -> m b
evalSequenceIdT = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. SequenceIdT s m a -> StateT s m a
unSequenceIdT


execSequenceIdT :: Monad m => SequenceIdT s m b -> s -> m s
execSequenceIdT :: forall (m :: * -> *) s b. Monad m => SequenceIdT s m b -> s -> m s
execSequenceIdT = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. SequenceIdT s m a -> StateT s m a
unSequenceIdT


runSequenceIdT :: Monad m => SequenceIdT s m b -> s -> m (b, s)
runSequenceIdT :: forall (m :: * -> *) s b.
Monad m =>
SequenceIdT s m b -> s -> m (b, s)
runSequenceIdT = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. SequenceIdT s m a -> StateT s m a
unSequenceIdT


data SequenceIdError a = SequenceIdError
    { forall a. SequenceIdError a -> SequenceIdErrorType
errType   :: !SequenceIdErrorType
    , forall a. SequenceIdError a -> a
lastSeqId :: !a
    , forall a. SequenceIdError a -> a
currSeqId :: !a
    } deriving (SequenceIdError a -> SequenceIdError a -> Bool
forall a. Eq a => SequenceIdError a -> SequenceIdError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SequenceIdError a -> SequenceIdError a -> Bool
$c/= :: forall a. Eq a => SequenceIdError a -> SequenceIdError a -> Bool
== :: SequenceIdError a -> SequenceIdError a -> Bool
$c== :: forall a. Eq a => SequenceIdError a -> SequenceIdError a -> Bool
Eq, Int -> SequenceIdError a -> ShowS
forall a. Show a => Int -> SequenceIdError a -> ShowS
forall a. Show a => [SequenceIdError a] -> ShowS
forall a. Show a => SequenceIdError a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SequenceIdError a] -> ShowS
$cshowList :: forall a. Show a => [SequenceIdError a] -> ShowS
show :: SequenceIdError a -> String
$cshow :: forall a. Show a => SequenceIdError a -> String
showsPrec :: Int -> SequenceIdError a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SequenceIdError a -> ShowS
Show)


data SequenceIdErrorType
    = SequenceIdDropped
    | SequenceIdDuplicated
    deriving (SequenceIdErrorType -> SequenceIdErrorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SequenceIdErrorType -> SequenceIdErrorType -> Bool
$c/= :: SequenceIdErrorType -> SequenceIdErrorType -> Bool
== :: SequenceIdErrorType -> SequenceIdErrorType -> Bool
$c== :: SequenceIdErrorType -> SequenceIdErrorType -> Bool
Eq, Int -> SequenceIdErrorType -> ShowS
[SequenceIdErrorType] -> ShowS
SequenceIdErrorType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SequenceIdErrorType] -> ShowS
$cshowList :: [SequenceIdErrorType] -> ShowS
show :: SequenceIdErrorType -> String
$cshow :: SequenceIdErrorType -> String
showsPrec :: Int -> SequenceIdErrorType -> ShowS
$cshowsPrec :: Int -> SequenceIdErrorType -> ShowS
Show)


-- | If the current sequence ID is greater than 1 more than the last
-- sequence ID then the appropriate error is returned.
checkSeqIdM :: (Integral s, Monad m)
            => s -- ^ Current sequence ID
            -> SequenceIdT s m (Maybe (SequenceIdError s))
checkSeqIdM :: forall s (m :: * -> *).
(Integral s, Monad m) =>
s -> SequenceIdT s m (Maybe (SequenceIdError s))
checkSeqIdM s
currSeq = do
    s
lastSeq <- forall s (m :: * -> *). MonadState s m => m s
get
    forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max s
lastSeq s
currSeq
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. Integral s => s -> s -> Maybe (SequenceIdError s)
checkSeqId s
lastSeq s
currSeq


-- | If the difference between the sequence IDs is not 1 then the
-- appropriate error is returned.
checkSeqId :: Integral s
           => s -- ^ Last sequence ID
           -> s -- ^ Current sequence ID
           -> Maybe (SequenceIdError s)
checkSeqId :: forall s. Integral s => s -> s -> Maybe (SequenceIdError s)
checkSeqId s
lastSeq s
currSeq
    | forall s. Integral s => s -> s -> Int
delta s
lastSeq s
currSeq forall a. Ord a => a -> a -> Bool
> Int
1 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. SequenceIdErrorType -> a -> a -> SequenceIdError a
SequenceIdError SequenceIdErrorType
SequenceIdDropped    s
lastSeq s
currSeq
    | forall s. Integral s => s -> s -> Int
delta s
lastSeq s
currSeq forall a. Ord a => a -> a -> Bool
< Int
1 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. SequenceIdErrorType -> a -> a -> SequenceIdError a
SequenceIdError SequenceIdErrorType
SequenceIdDuplicated s
lastSeq s
currSeq
    | Bool
otherwise                 = forall a. Maybe a
Nothing


delta :: Integral s => s -> s -> Int
delta :: forall s. Integral s => s -> s -> Int
delta s
lastSeq s
currSeq = forall a b. (Integral a, Num b) => a -> b
fromIntegral s
currSeq forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral s
lastSeq


-- | Update to the next sequense ID
incrementSeqIdM :: (Monad m, Integral s) => SequenceIdT s m s -- ^ Next sequence ID
incrementSeqIdM :: forall (m :: * -> *) s. (Monad m, Integral s) => SequenceIdT s m s
incrementSeqIdM = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' forall s. Integral s => s -> s
incrementSeqId forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *). MonadState s m => m s
get


-- | Increment to the next sequense ID
incrementSeqId :: Integral s
               => s -- ^ Last sequence ID
               -> s -- ^ Next sequence ID
incrementSeqId :: forall s. Integral s => s -> s
incrementSeqId = (forall a. Num a => a -> a -> a
+s
1)


-- | Last seen sequense ID
lastSeqIdM :: Monad m => SequenceIdT s m s -- ^ Last sequence ID
lastSeqIdM :: forall (m :: * -> *) s. Monad m => SequenceIdT s m s
lastSeqIdM = forall s (m :: * -> *). MonadState s m => m s
get