module DomainDriven.Persistance.Postgres.Types where

import Control.Monad.Catch
import Data.Aeson
import Data.Int
import Data.Time
import Data.Typeable
import Data.UUID (UUID)
import Database.PostgreSQL.Simple (Connection)
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.FromField as FF
import DomainDriven.Persistance.Class
import GHC.Generics (Generic)
import UnliftIO.Pool (LocalPool)
import Prelude

data PersistanceError
    = EncodingError String
    | ValueError String
    deriving (Int -> PersistanceError -> ShowS
[PersistanceError] -> ShowS
PersistanceError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistanceError] -> ShowS
$cshowList :: [PersistanceError] -> ShowS
show :: PersistanceError -> String
$cshow :: PersistanceError -> String
showsPrec :: Int -> PersistanceError -> ShowS
$cshowsPrec :: Int -> PersistanceError -> ShowS
Show, PersistanceError -> PersistanceError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersistanceError -> PersistanceError -> Bool
$c/= :: PersistanceError -> PersistanceError -> Bool
== :: PersistanceError -> PersistanceError -> Bool
$c== :: PersistanceError -> PersistanceError -> Bool
Eq, Typeable, Show PersistanceError
Typeable PersistanceError
SomeException -> Maybe PersistanceError
PersistanceError -> String
PersistanceError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: PersistanceError -> String
$cdisplayException :: PersistanceError -> String
fromException :: SomeException -> Maybe PersistanceError
$cfromException :: SomeException -> Maybe PersistanceError
toException :: PersistanceError -> SomeException
$ctoException :: PersistanceError -> SomeException
Exception)

type EventTableBaseName = String
type EventVersion = Int
type EventTableName = String
type PreviousEventTableName = String
type ChunkSize = Int

type EventMigration = PreviousEventTableName -> EventTableName -> Connection -> IO ()

data EventTable
    = MigrateUsing EventMigration EventTable
    | InitialVersion EventTableBaseName

newtype EventNumber = EventNumber {EventNumber -> Int64
unEventNumber :: Int64}
    deriving (Int -> EventNumber -> ShowS
[EventNumber] -> ShowS
EventNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventNumber] -> ShowS
$cshowList :: [EventNumber] -> ShowS
show :: EventNumber -> String
$cshow :: EventNumber -> String
showsPrec :: Int -> EventNumber -> ShowS
$cshowsPrec :: Int -> EventNumber -> ShowS
Show, forall x. Rep EventNumber x -> EventNumber
forall x. EventNumber -> Rep EventNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventNumber x -> EventNumber
$cfrom :: forall x. EventNumber -> Rep EventNumber x
Generic)
    deriving newtype (EventNumber -> EventNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventNumber -> EventNumber -> Bool
$c/= :: EventNumber -> EventNumber -> Bool
== :: EventNumber -> EventNumber -> Bool
$c== :: EventNumber -> EventNumber -> Bool
Eq, Eq EventNumber
EventNumber -> EventNumber -> Bool
EventNumber -> EventNumber -> Ordering
EventNumber -> EventNumber -> EventNumber
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
min :: EventNumber -> EventNumber -> EventNumber
$cmin :: EventNumber -> EventNumber -> EventNumber
max :: EventNumber -> EventNumber -> EventNumber
$cmax :: EventNumber -> EventNumber -> EventNumber
>= :: EventNumber -> EventNumber -> Bool
$c>= :: EventNumber -> EventNumber -> Bool
> :: EventNumber -> EventNumber -> Bool
$c> :: EventNumber -> EventNumber -> Bool
<= :: EventNumber -> EventNumber -> Bool
$c<= :: EventNumber -> EventNumber -> Bool
< :: EventNumber -> EventNumber -> Bool
$c< :: EventNumber -> EventNumber -> Bool
compare :: EventNumber -> EventNumber -> Ordering
$ccompare :: EventNumber -> EventNumber -> Ordering
Ord, Integer -> EventNumber
EventNumber -> EventNumber
EventNumber -> EventNumber -> EventNumber
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> EventNumber
$cfromInteger :: Integer -> EventNumber
signum :: EventNumber -> EventNumber
$csignum :: EventNumber -> EventNumber
abs :: EventNumber -> EventNumber
$cabs :: EventNumber -> EventNumber
negate :: EventNumber -> EventNumber
$cnegate :: EventNumber -> EventNumber
* :: EventNumber -> EventNumber -> EventNumber
$c* :: EventNumber -> EventNumber -> EventNumber
- :: EventNumber -> EventNumber -> EventNumber
$c- :: EventNumber -> EventNumber -> EventNumber
+ :: EventNumber -> EventNumber -> EventNumber
$c+ :: EventNumber -> EventNumber -> EventNumber
Num)

instance FF.FromField EventNumber where
    fromField :: FieldParser EventNumber
fromField Field
f Maybe ByteString
bs = Int64 -> EventNumber
EventNumber forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromField a => FieldParser a
FF.fromField Field
f Maybe ByteString
bs

data NumberedModel m = NumberedModel
    { forall m. NumberedModel m -> m
model :: !m
    , forall m. NumberedModel m -> EventNumber
eventNumber :: !EventNumber
    }
    deriving (Int -> NumberedModel m -> ShowS
forall m. Show m => Int -> NumberedModel m -> ShowS
forall m. Show m => [NumberedModel m] -> ShowS
forall m. Show m => NumberedModel m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumberedModel m] -> ShowS
$cshowList :: forall m. Show m => [NumberedModel m] -> ShowS
show :: NumberedModel m -> String
$cshow :: forall m. Show m => NumberedModel m -> String
showsPrec :: Int -> NumberedModel m -> ShowS
$cshowsPrec :: forall m. Show m => Int -> NumberedModel m -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall m x. Rep (NumberedModel m) x -> NumberedModel m
forall m x. NumberedModel m -> Rep (NumberedModel m) x
$cto :: forall m x. Rep (NumberedModel m) x -> NumberedModel m
$cfrom :: forall m x. NumberedModel m -> Rep (NumberedModel m) x
Generic)

data NumberedEvent e = NumberedEvent
    { forall e. NumberedEvent e -> Stored e
event :: !(Stored e)
    , forall e. NumberedEvent e -> EventNumber
eventNumber :: !EventNumber
    }
    deriving (Int -> NumberedEvent e -> ShowS
forall e. Show e => Int -> NumberedEvent e -> ShowS
forall e. Show e => [NumberedEvent e] -> ShowS
forall e. Show e => NumberedEvent e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumberedEvent e] -> ShowS
$cshowList :: forall e. Show e => [NumberedEvent e] -> ShowS
show :: NumberedEvent e -> String
$cshow :: forall e. Show e => NumberedEvent e -> String
showsPrec :: Int -> NumberedEvent e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> NumberedEvent e -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (NumberedEvent e) x -> NumberedEvent e
forall e x. NumberedEvent e -> Rep (NumberedEvent e) x
$cto :: forall e x. Rep (NumberedEvent e) x -> NumberedEvent e
$cfrom :: forall e x. NumberedEvent e -> Rep (NumberedEvent e) x
Generic)

data OngoingTransaction = OngoingTransaction
    { OngoingTransaction -> Connection
connection :: Connection
    , OngoingTransaction -> LocalPool Connection
localPool :: LocalPool Connection
    }
    deriving (forall x. Rep OngoingTransaction x -> OngoingTransaction
forall x. OngoingTransaction -> Rep OngoingTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OngoingTransaction x -> OngoingTransaction
$cfrom :: forall x. OngoingTransaction -> Rep OngoingTransaction x
Generic)

data EventRowOut = EventRowOut
    { EventRowOut -> UUID
key :: UUID
    , EventRowOut -> EventNumber
commitNumber :: EventNumber
    , EventRowOut -> UTCTime
timestamp :: UTCTime
    , EventRowOut -> Value
event :: Value
    }
    deriving (Int -> EventRowOut -> ShowS
[EventRowOut] -> ShowS
EventRowOut -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventRowOut] -> ShowS
$cshowList :: [EventRowOut] -> ShowS
show :: EventRowOut -> String
$cshow :: EventRowOut -> String
showsPrec :: Int -> EventRowOut -> ShowS
$cshowsPrec :: Int -> EventRowOut -> ShowS
Show, EventRowOut -> EventRowOut -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventRowOut -> EventRowOut -> Bool
$c/= :: EventRowOut -> EventRowOut -> Bool
== :: EventRowOut -> EventRowOut -> Bool
$c== :: EventRowOut -> EventRowOut -> Bool
Eq, forall x. Rep EventRowOut x -> EventRowOut
forall x. EventRowOut -> Rep EventRowOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventRowOut x -> EventRowOut
$cfrom :: forall x. EventRowOut -> Rep EventRowOut x
Generic, RowParser EventRowOut
forall a. RowParser a -> FromRow a
fromRow :: RowParser EventRowOut
$cfromRow :: RowParser EventRowOut
PG.FromRow)

fromEventRow :: (FromJSON e, MonadThrow m) => EventRowOut -> m (Stored e, EventNumber)
fromEventRow :: forall e (m :: * -> *).
(FromJSON e, MonadThrow m) =>
EventRowOut -> m (Stored e, EventNumber)
fromEventRow (EventRowOut UUID
evKey EventNumber
no UTCTime
ts Value
ev) = case forall a. FromJSON a => Value -> Result a
fromJSON Value
ev of
    Success e
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> UTCTime -> UUID -> Stored a
Stored e
a UTCTime
ts UUID
evKey, EventNumber
no)
    Error String
err ->
        forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PersistanceError
EncodingError
            forall a b. (a -> b) -> a -> b
$ String
"Failed to parse event "
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show UUID
evKey
                forall a. Semigroup a => a -> a -> a
<> String
": "
                forall a. Semigroup a => a -> a -> a
<> String
err
                forall a. Semigroup a => a -> a -> a
<> String
"\nWhen trying to parse:\n"
                forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Value
ev