{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module DomainDriven.Persistance.Class where

import Control.DeepSeq (NFData)
import Control.Monad.Reader
import Data.Aeson
import Data.Kind
import Data.Time
import Data.UUID (UUID)
import GHC.Generics (Generic)
import Streamly.Prelude (SerialT)
import System.Random
import UnliftIO
import Prelude

class ReadModel p where
    type Model p :: Type
    type Event p :: Type
    applyEvent :: p -> Model p -> Stored (Event p) -> Model p
    getModel :: p -> IO (Model p)
    getEventList :: p -> IO [Stored (Event p)]
    getEventStream :: p -> SerialT IO (Stored (Event p))

class ReadModel p => WriteModel p where
    transactionalUpdate
        :: forall m a
         . MonadUnliftIO m
        => p
        -> (Model p -> m (Model p -> a, [Event p]))
        -> m a

-- | Wrapper for stored data
-- This ensures all events have a unique ID and a timestamp, without having to deal with
-- that when implementing the model.
data Stored a = Stored
    { forall a. Stored a -> a
storedEvent :: a
    , forall a. Stored a -> UTCTime
storedTimestamp :: UTCTime
    , forall a. Stored a -> UUID
storedUUID :: UUID
    }
    deriving
        ( Int -> Stored a -> ShowS
forall a. Show a => Int -> Stored a -> ShowS
forall a. Show a => [Stored a] -> ShowS
forall a. Show a => Stored a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stored a] -> ShowS
$cshowList :: forall a. Show a => [Stored a] -> ShowS
show :: Stored a -> String
$cshow :: forall a. Show a => Stored a -> String
showsPrec :: Int -> Stored a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Stored a -> ShowS
Show
        , Stored a -> Stored a -> Bool
forall a. Eq a => Stored a -> Stored a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stored a -> Stored a -> Bool
$c/= :: forall a. Eq a => Stored a -> Stored a -> Bool
== :: Stored a -> Stored a -> Bool
$c== :: forall a. Eq a => Stored a -> Stored a -> Bool
Eq
        , Stored a -> Stored a -> Bool
Stored a -> Stored a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Stored a)
forall a. Ord a => Stored a -> Stored a -> Bool
forall a. Ord a => Stored a -> Stored a -> Ordering
forall a. Ord a => Stored a -> Stored a -> Stored a
min :: Stored a -> Stored a -> Stored a
$cmin :: forall a. Ord a => Stored a -> Stored a -> Stored a
max :: Stored a -> Stored a -> Stored a
$cmax :: forall a. Ord a => Stored a -> Stored a -> Stored a
>= :: Stored a -> Stored a -> Bool
$c>= :: forall a. Ord a => Stored a -> Stored a -> Bool
> :: Stored a -> Stored a -> Bool
$c> :: forall a. Ord a => Stored a -> Stored a -> Bool
<= :: Stored a -> Stored a -> Bool
$c<= :: forall a. Ord a => Stored a -> Stored a -> Bool
< :: Stored a -> Stored a -> Bool
$c< :: forall a. Ord a => Stored a -> Stored a -> Bool
compare :: Stored a -> Stored a -> Ordering
$ccompare :: forall a. Ord a => Stored a -> Stored a -> Ordering
Ord
        , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Stored a) x -> Stored a
forall a x. Stored a -> Rep (Stored a) x
$cto :: forall a x. Rep (Stored a) x -> Stored a
$cfrom :: forall a x. Stored a -> Rep (Stored a) x
Generic
        , forall a. FromJSON a => Value -> Parser [Stored a]
forall a. FromJSON a => Value -> Parser (Stored a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Stored a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Stored a]
parseJSON :: Value -> Parser (Stored a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Stored a)
FromJSON
        , forall a. ToJSON a => [Stored a] -> Encoding
forall a. ToJSON a => [Stored a] -> Value
forall a. ToJSON a => Stored a -> Encoding
forall a. ToJSON a => Stored a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Stored a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [Stored a] -> Encoding
toJSONList :: [Stored a] -> Value
$ctoJSONList :: forall a. ToJSON a => [Stored a] -> Value
toEncoding :: Stored a -> Encoding
$ctoEncoding :: forall a. ToJSON a => Stored a -> Encoding
toJSON :: Stored a -> Value
$ctoJSON :: forall a. ToJSON a => Stored a -> Value
ToJSON
        , forall a b. a -> Stored b -> Stored a
forall a b. (a -> b) -> Stored a -> Stored 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 -> Stored b -> Stored a
$c<$ :: forall a b. a -> Stored b -> Stored a
fmap :: forall a b. (a -> b) -> Stored a -> Stored b
$cfmap :: forall a b. (a -> b) -> Stored a -> Stored b
Functor
        , forall a. Eq a => a -> Stored a -> Bool
forall a. Num a => Stored a -> a
forall a. Ord a => Stored a -> a
forall m. Monoid m => Stored m -> m
forall a. Stored a -> Bool
forall a. Stored a -> Int
forall a. Stored a -> [a]
forall a. (a -> a -> a) -> Stored a -> a
forall m a. Monoid m => (a -> m) -> Stored a -> m
forall b a. (b -> a -> b) -> b -> Stored a -> b
forall a b. (a -> b -> b) -> b -> Stored a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Stored a -> a
$cproduct :: forall a. Num a => Stored a -> a
sum :: forall a. Num a => Stored a -> a
$csum :: forall a. Num a => Stored a -> a
minimum :: forall a. Ord a => Stored a -> a
$cminimum :: forall a. Ord a => Stored a -> a
maximum :: forall a. Ord a => Stored a -> a
$cmaximum :: forall a. Ord a => Stored a -> a
elem :: forall a. Eq a => a -> Stored a -> Bool
$celem :: forall a. Eq a => a -> Stored a -> Bool
length :: forall a. Stored a -> Int
$clength :: forall a. Stored a -> Int
null :: forall a. Stored a -> Bool
$cnull :: forall a. Stored a -> Bool
toList :: forall a. Stored a -> [a]
$ctoList :: forall a. Stored a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Stored a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Stored a -> a
foldr1 :: forall a. (a -> a -> a) -> Stored a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Stored a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Stored a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Stored a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Stored a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Stored a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Stored a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Stored a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Stored a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Stored a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Stored a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Stored a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Stored a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Stored a -> m
fold :: forall m. Monoid m => Stored m -> m
$cfold :: forall m. Monoid m => Stored m -> m
Foldable
        , Functor Stored
Foldable Stored
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Stored (m a) -> m (Stored a)
forall (f :: * -> *) a.
Applicative f =>
Stored (f a) -> f (Stored a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stored a -> m (Stored b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stored a -> f (Stored b)
sequence :: forall (m :: * -> *) a. Monad m => Stored (m a) -> m (Stored a)
$csequence :: forall (m :: * -> *) a. Monad m => Stored (m a) -> m (Stored a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stored a -> m (Stored b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stored a -> m (Stored b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Stored (f a) -> f (Stored a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Stored (f a) -> f (Stored a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stored a -> f (Stored b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Stored a -> f (Stored b)
Traversable
        , forall a. NFData a => Stored a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Stored a -> ()
$crnf :: forall a. NFData a => Stored a -> ()
NFData
        )

mkId :: MonadIO m => m UUID
mkId :: forall (m :: * -> *). MonadIO m => m UUID
mkId = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO

toStored :: MonadIO m => e -> m (Stored e)
toStored :: forall (m :: * -> *) e. MonadIO m => e -> m (Stored e)
toStored e
e = forall a. a -> UTCTime -> UUID -> Stored a
Stored e
e forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadIO m => m UUID
mkId