{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Graphula
(
HasDependencies(..)
, Only(..)
, only
, node
, edit
, ensure
, GraphulaT
, runGraphulaT
, GenerationFailure(..)
, KeySourceType(..)
, nodeKeyed
, GraphulaLoggedT
, runGraphulaLoggedT
, runGraphulaLoggedWithFileT
, GraphulaIdempotentT
, runGraphulaIdempotentT
, GraphulaContext
, GraphulaNode
, MonadGraphula
, MonadGraphulaBackend(..)
, MonadGraphulaFrontend(..)
, NodeOptions
, GenerateKey
, NoConstraint
) where
import Prelude hiding (readFile)
import Control.Monad.IO.Unlift
import Control.Monad.Reader (MonadReader, ReaderT, asks, runReaderT)
import Control.Monad.Trans (MonadTrans, lift)
import Data.IORef (IORef, newIORef)
import Data.Kind (Constraint, Type)
import Data.Typeable (Typeable)
import Database.Persist
( PersistEntity
, PersistEntityBackend
, checkUnique
, delete
, get
, getEntity
, insertKey
, insertUnique
)
import Database.Persist.Sql (SqlBackend)
import Graphula.Class
import Graphula.Dependencies
import Graphula.Idempotent
import Graphula.Logged
import Graphula.NoConstraint
import Graphula.Node
import System.Random (randomIO)
import Test.HUnit.Lang
(FailureReason(..), HUnitFailure(..), formatFailureReason)
import Test.QuickCheck (Arbitrary(..))
import Test.QuickCheck.Random (QCGen, mkQCGen)
import UnliftIO.Exception (catch, throwIO)
type family GraphulaContext (m :: Type -> Type) (ts :: [Type]) :: Constraint where
GraphulaContext m '[] = MonadGraphula m
GraphulaContext m (t ': ts) = (GraphulaNode m t, GraphulaContext m ts)
data Args backend n m = Args
{ Args backend n m -> RunDB backend n m
dbRunner :: RunDB backend n m
, Args backend n m -> IORef QCGen
gen :: IORef QCGen
}
newtype RunDB backend n m = RunDB (forall b. ReaderT backend n b -> m b)
newtype GraphulaT n m a =
GraphulaT { GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
runGraphulaT' :: ReaderT (Args SqlBackend n m) m a }
deriving newtype (a -> GraphulaT n m b -> GraphulaT n m a
(a -> b) -> GraphulaT n m a -> GraphulaT n m b
(forall a b. (a -> b) -> GraphulaT n m a -> GraphulaT n m b)
-> (forall a b. a -> GraphulaT n m b -> GraphulaT n m a)
-> Functor (GraphulaT n m)
forall a b. a -> GraphulaT n m b -> GraphulaT n m a
forall a b. (a -> b) -> GraphulaT n m a -> GraphulaT n m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (n :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> GraphulaT n m b -> GraphulaT n m a
forall (n :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> GraphulaT n m a -> GraphulaT n m b
<$ :: a -> GraphulaT n m b -> GraphulaT n m a
$c<$ :: forall (n :: * -> *) (m :: * -> *) a b.
Functor m =>
a -> GraphulaT n m b -> GraphulaT n m a
fmap :: (a -> b) -> GraphulaT n m a -> GraphulaT n m b
$cfmap :: forall (n :: * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> GraphulaT n m a -> GraphulaT n m b
Functor, Functor (GraphulaT n m)
a -> GraphulaT n m a
Functor (GraphulaT n m)
-> (forall a. a -> GraphulaT n m a)
-> (forall a b.
GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b)
-> (forall a b c.
(a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c)
-> (forall a b.
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b)
-> (forall a b.
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a)
-> Applicative (GraphulaT n m)
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
(a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c
forall a. a -> GraphulaT n m a
forall a b. GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
forall a b. GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall a b.
GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
forall a b c.
(a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n 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 (n :: * -> *) (m :: * -> *).
Applicative m =>
Functor (GraphulaT n m)
forall (n :: * -> *) (m :: * -> *) a.
Applicative m =>
a -> GraphulaT n m a
forall (n :: * -> *) (m :: * -> *) a b.
Applicative m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
forall (n :: * -> *) (m :: * -> *) a b.
Applicative m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall (n :: * -> *) (m :: * -> *) a b.
Applicative m =>
GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
forall (n :: * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c
<* :: GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
$c<* :: forall (n :: * -> *) (m :: * -> *) a b.
Applicative m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m a
*> :: GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
$c*> :: forall (n :: * -> *) (m :: * -> *) a b.
Applicative m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
liftA2 :: (a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c
$cliftA2 :: forall (n :: * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m c
<*> :: GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
$c<*> :: forall (n :: * -> *) (m :: * -> *) a b.
Applicative m =>
GraphulaT n m (a -> b) -> GraphulaT n m a -> GraphulaT n m b
pure :: a -> GraphulaT n m a
$cpure :: forall (n :: * -> *) (m :: * -> *) a.
Applicative m =>
a -> GraphulaT n m a
$cp1Applicative :: forall (n :: * -> *) (m :: * -> *).
Applicative m =>
Functor (GraphulaT n m)
Applicative, Applicative (GraphulaT n m)
a -> GraphulaT n m a
Applicative (GraphulaT n m)
-> (forall a b.
GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b)
-> (forall a b.
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b)
-> (forall a. a -> GraphulaT n m a)
-> Monad (GraphulaT n m)
GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall a. a -> GraphulaT n m a
forall a b. GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall a b.
GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n 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
forall (n :: * -> *) (m :: * -> *).
Monad m =>
Applicative (GraphulaT n m)
forall (n :: * -> *) (m :: * -> *) a.
Monad m =>
a -> GraphulaT n m a
forall (n :: * -> *) (m :: * -> *) a b.
Monad m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
forall (n :: * -> *) (m :: * -> *) a b.
Monad m =>
GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b
return :: a -> GraphulaT n m a
$creturn :: forall (n :: * -> *) (m :: * -> *) a.
Monad m =>
a -> GraphulaT n m a
>> :: GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
$c>> :: forall (n :: * -> *) (m :: * -> *) a b.
Monad m =>
GraphulaT n m a -> GraphulaT n m b -> GraphulaT n m b
>>= :: GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b
$c>>= :: forall (n :: * -> *) (m :: * -> *) a b.
Monad m =>
GraphulaT n m a -> (a -> GraphulaT n m b) -> GraphulaT n m b
$cp1Monad :: forall (n :: * -> *) (m :: * -> *).
Monad m =>
Applicative (GraphulaT n m)
Monad, Monad (GraphulaT n m)
Monad (GraphulaT n m)
-> (forall a. IO a -> GraphulaT n m a) -> MonadIO (GraphulaT n m)
IO a -> GraphulaT n m a
forall a. IO a -> GraphulaT n m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (n :: * -> *) (m :: * -> *).
MonadIO m =>
Monad (GraphulaT n m)
forall (n :: * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> GraphulaT n m a
liftIO :: IO a -> GraphulaT n m a
$cliftIO :: forall (n :: * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> GraphulaT n m a
$cp1MonadIO :: forall (n :: * -> *) (m :: * -> *).
MonadIO m =>
Monad (GraphulaT n m)
MonadIO, MonadReader (Args SqlBackend n m))
instance MonadTrans (GraphulaT n) where
lift :: m a -> GraphulaT n m a
lift = ReaderT (Args SqlBackend n m) m a -> GraphulaT n m a
forall (n :: * -> *) (m :: * -> *) a.
ReaderT (Args SqlBackend n m) m a -> GraphulaT n m a
GraphulaT (ReaderT (Args SqlBackend n m) m a -> GraphulaT n m a)
-> (m a -> ReaderT (Args SqlBackend n m) m a)
-> m a
-> GraphulaT n m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (Args SqlBackend n m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadUnliftIO m => MonadUnliftIO (GraphulaT n m) where
{-# INLINE withRunInIO #-}
withRunInIO :: ((forall a. GraphulaT n m a -> IO a) -> IO b) -> GraphulaT n m b
withRunInIO (forall a. GraphulaT n m a -> IO a) -> IO b
inner =
ReaderT (Args SqlBackend n m) m b -> GraphulaT n m b
forall (n :: * -> *) (m :: * -> *) a.
ReaderT (Args SqlBackend n m) m a -> GraphulaT n m a
GraphulaT (ReaderT (Args SqlBackend n m) m b -> GraphulaT n m b)
-> ReaderT (Args SqlBackend n m) m b -> GraphulaT n m b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT (Args SqlBackend n m) m a -> IO a) -> IO b)
-> ReaderT (Args SqlBackend n m) m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT (Args SqlBackend n m) m a -> IO a) -> IO b)
-> ReaderT (Args SqlBackend n m) m b)
-> ((forall a. ReaderT (Args SqlBackend n m) m a -> IO a) -> IO b)
-> ReaderT (Args SqlBackend n m) m b
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT (Args SqlBackend n m) m a -> IO a
run -> (forall a. GraphulaT n m a -> IO a) -> IO b
inner ((forall a. GraphulaT n m a -> IO a) -> IO b)
-> (forall a. GraphulaT n m a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ ReaderT (Args SqlBackend n m) m a -> IO a
forall a. ReaderT (Args SqlBackend n m) m a -> IO a
run (ReaderT (Args SqlBackend n m) m a -> IO a)
-> (GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a)
-> GraphulaT n m a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
forall (n :: * -> *) (m :: * -> *) a.
GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
runGraphulaT'
instance MonadIO m => MonadGraphulaBackend (GraphulaT n m) where
type Logging (GraphulaT n m) = NoConstraint
askGen :: GraphulaT n m (IORef QCGen)
askGen = (Args SqlBackend n m -> IORef QCGen) -> GraphulaT n m (IORef QCGen)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Args SqlBackend n m -> IORef QCGen
forall backend (n :: * -> *) (m :: * -> *).
Args backend n m -> IORef QCGen
gen
logNode :: a -> GraphulaT n m ()
logNode a
_ = () -> GraphulaT n m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance (MonadIO m, Applicative n, MonadIO n) => MonadGraphulaFrontend (GraphulaT n m) where
insert :: Maybe (Key a) -> a -> GraphulaT n m (Maybe (Entity a))
insert Maybe (Key a)
mKey a
n = do
RunDB forall b. ReaderT SqlBackend n b -> m b
runDB <- (Args SqlBackend n m -> RunDB SqlBackend n m)
-> GraphulaT n m (RunDB SqlBackend n m)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Args SqlBackend n m -> RunDB SqlBackend n m
forall backend (n :: * -> *) (m :: * -> *).
Args backend n m -> RunDB backend n m
dbRunner
m (Maybe (Entity a)) -> GraphulaT n m (Maybe (Entity a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Entity a)) -> GraphulaT n m (Maybe (Entity a)))
-> (ReaderT SqlBackend n (Maybe (Entity a))
-> m (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
-> GraphulaT n m (Maybe (Entity a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend n (Maybe (Entity a)) -> m (Maybe (Entity a))
forall b. ReaderT SqlBackend n b -> m b
runDB (ReaderT SqlBackend n (Maybe (Entity a))
-> GraphulaT n m (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
-> GraphulaT n m (Maybe (Entity a))
forall a b. (a -> b) -> a -> b
$ case Maybe (Key a)
mKey of
Maybe (Key a)
Nothing -> a -> ReaderT SqlBackend n (Maybe (Key a))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique a
n ReaderT SqlBackend n (Maybe (Key a))
-> (Maybe (Key a) -> ReaderT SqlBackend n (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (Key a)
Nothing -> Maybe (Entity a) -> ReaderT SqlBackend n (Maybe (Entity a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Entity a)
forall a. Maybe a
Nothing
Just Key a
key -> Key a -> ReaderT SqlBackend n (Maybe (Entity a))
forall e backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend e backend,
MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
getEntity Key a
key
Just Key a
key -> do
Maybe a
existingKey <- Key a -> ReaderT SqlBackend n (Maybe a)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key a
key
Maybe a
-> ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall (m :: * -> *) a b.
Applicative m =>
Maybe a -> m (Maybe b) -> m (Maybe b)
whenNothing Maybe a
existingKey (ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall a b. (a -> b) -> a -> b
$ do
Maybe (Unique a)
existingUnique <- a -> ReaderT SqlBackend n (Maybe (Unique a))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
PersistUniqueRead backend) =>
record -> ReaderT backend m (Maybe (Unique record))
checkUnique a
n
Maybe (Unique a)
-> ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall (m :: * -> *) a b.
Applicative m =>
Maybe a -> m (Maybe b) -> m (Maybe b)
whenNothing Maybe (Unique a)
existingUnique (ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a)))
-> ReaderT SqlBackend n (Maybe (Entity a))
-> ReaderT SqlBackend n (Maybe (Entity a))
forall a b. (a -> b) -> a -> b
$ do
Key a -> a -> ReaderT SqlBackend n ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
insertKey Key a
key a
n
Key a -> ReaderT SqlBackend n (Maybe (Entity a))
forall e backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend e backend,
MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
getEntity Key a
key
remove :: Key a -> GraphulaT n m ()
remove Key a
key = do
RunDB forall b. ReaderT SqlBackend n b -> m b
runDB <- (Args SqlBackend n m -> RunDB SqlBackend n m)
-> GraphulaT n m (RunDB SqlBackend n m)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Args SqlBackend n m -> RunDB SqlBackend n m
forall backend (n :: * -> *) (m :: * -> *).
Args backend n m -> RunDB backend n m
dbRunner
m () -> GraphulaT n m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GraphulaT n m ())
-> (ReaderT SqlBackend n () -> m ())
-> ReaderT SqlBackend n ()
-> GraphulaT n m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlBackend n () -> m ()
forall b. ReaderT SqlBackend n b -> m b
runDB (ReaderT SqlBackend n () -> GraphulaT n m ())
-> ReaderT SqlBackend n () -> GraphulaT n m ()
forall a b. (a -> b) -> a -> b
$ Key a -> ReaderT SqlBackend n ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key a
key
whenNothing :: Applicative m => Maybe a -> m (Maybe b) -> m (Maybe b)
whenNothing :: Maybe a -> m (Maybe b) -> m (Maybe b)
whenNothing Maybe a
Nothing m (Maybe b)
f = m (Maybe b)
f
whenNothing (Just a
_) m (Maybe b)
_ = Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
runGraphulaT
:: (MonadUnliftIO m)
=> Maybe Int
-> (forall b . ReaderT SqlBackend n b -> m b)
-> GraphulaT n m a
-> m a
runGraphulaT :: Maybe Int
-> (forall b. ReaderT SqlBackend n b -> m b)
-> GraphulaT n m a
-> m a
runGraphulaT Maybe Int
mSeed forall b. ReaderT SqlBackend n b -> m b
runDB GraphulaT n m a
action = do
Int
seed <- m Int -> (Int -> m Int) -> Maybe Int -> m Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO) Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
mSeed
IORef QCGen
qcGen <- IO (IORef QCGen) -> m (IORef QCGen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef QCGen) -> m (IORef QCGen))
-> IO (IORef QCGen) -> m (IORef QCGen)
forall a b. (a -> b) -> a -> b
$ QCGen -> IO (IORef QCGen)
forall a. a -> IO (IORef a)
newIORef (QCGen -> IO (IORef QCGen)) -> QCGen -> IO (IORef QCGen)
forall a b. (a -> b) -> a -> b
$ Int -> QCGen
mkQCGen Int
seed
ReaderT (Args SqlBackend n m) m a -> Args SqlBackend n m -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
forall (n :: * -> *) (m :: * -> *) a.
GraphulaT n m a -> ReaderT (Args SqlBackend n m) m a
runGraphulaT' GraphulaT n m a
action) (RunDB SqlBackend n m -> IORef QCGen -> Args SqlBackend n m
forall backend (n :: * -> *) (m :: * -> *).
RunDB backend n m -> IORef QCGen -> Args backend n m
Args ((forall b. ReaderT SqlBackend n b -> m b) -> RunDB SqlBackend n m
forall backend (n :: * -> *) (m :: * -> *).
(forall b. ReaderT backend n b -> m b) -> RunDB backend n m
RunDB forall b. ReaderT SqlBackend n b -> m b
runDB) IORef QCGen
qcGen)
m a -> (HUnitFailure -> m a) -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` Int -> HUnitFailure -> m a
forall (m :: * -> *) a. MonadIO m => Int -> HUnitFailure -> m a
logFailingSeed Int
seed
logFailingSeed :: MonadIO m => Int -> HUnitFailure -> m a
logFailingSeed :: Int -> HUnitFailure -> m a
logFailingSeed Int
seed = String -> HUnitFailure -> m a
forall (m :: * -> *) a. MonadIO m => String -> HUnitFailure -> m a
rethrowHUnitWith (String
"Graphula with seed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
seed)
rethrowHUnitWith :: MonadIO m => String -> HUnitFailure -> m a
rethrowHUnitWith :: String -> HUnitFailure -> m a
rethrowHUnitWith String
message (HUnitFailure Maybe SrcLoc
l FailureReason
r) =
HUnitFailure -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (HUnitFailure -> m a) -> (String -> HUnitFailure) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe SrcLoc -> FailureReason -> HUnitFailure
HUnitFailure Maybe SrcLoc
l (FailureReason -> HUnitFailure)
-> (String -> FailureReason) -> String -> HUnitFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FailureReason
Reason (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
message String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FailureReason -> String
formatFailureReason FailureReason
r
type GraphulaNode m a
= ( HasDependencies a
, Logging m a
, PersistEntityBackend a ~ SqlBackend
, PersistEntity a
, Typeable a
, Arbitrary a
)