{-# language NoImplicitPrelude #-}
{-# options_haddock prune #-}
module Zeugma.Run where
import qualified Chronos
import Chronos (datetimeToTime)
import Conc (
Critical,
Gates,
interpretCritical,
interpretGates,
interpretInterrupt,
interpretMaskFinal,
interpretRace,
interpretUninterruptibleMaskFinal,
)
import Hedgehog (TestT)
import Hedgehog.Internal.Property (Failure)
import Incipit
import Log (Severity (Crit, Debug, Trace), interpretLogStderrLevelConc)
import Polysemy.Chronos (ChronosTime, interpretTimeChronos, interpretTimeChronosConstant)
import Polysemy.Test (Hedgehog, Test, TestError (TestError), runTestAuto)
import Time (mkDatetime)
type ConcTestStack' =
[
Log,
Interrupt,
Critical,
Gates,
Mask,
UninterruptibleMask,
Race,
Async,
Stop Text,
Error Text
]
type ConcTestStack =
ChronosTime : ConcTestStack'
type TestStack =
ConcTestStack ++ [
Test,
Fail,
Error TestError,
Hedgehog IO,
Error Failure,
Embed IO,
Resource,
Final IO
]
interpretTest' ::
Members [Error TestError, Resource, Embed IO, Final IO] r =>
Severity ->
InterpretersFor ConcTestStack' r
interpretTest' :: forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack' r
interpretTest' Severity
level =
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError Text -> TestError
TestError forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall err (r :: EffectRow) a.
Member (Error err) r =>
Sem (Stop err : r) a -> Sem r a
stopToError forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Async : r) a -> Sem r a
asyncToIOFinal forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor Race r
interpretRace forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor UninterruptibleMask r
interpretUninterruptibleMaskFinal forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor UninterruptibleMask r
interpretMaskFinal forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor (Scoped_ Gate) r
interpretGates forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor Critical r
interpretCritical forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Members '[Critical, Race, Async, Embed IO] r =>
InterpreterFor Interrupt r
interpretInterrupt forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Members '[Resource, Async, Race, Embed IO] r =>
Maybe Severity -> InterpreterFor Log r
interpretLogStderrLevelConc (forall a. a -> Maybe a
Just Severity
level)
interpretTest ::
Members [Error TestError, Resource, Embed IO, Final IO] r =>
Severity ->
InterpretersFor ConcTestStack r
interpretTest :: forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack r
interpretTest Severity
level =
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack' r
interpretTest' Severity
level forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
interpretTimeChronos
testTime :: Chronos.Time
testTime :: Time
testTime =
Datetime -> Time
datetimeToTime (forall dt.
Calendar dt =>
Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> dt
mkDatetime Int64
2030 Int64
5 Int64
23 Int64
12 Int64
0 Int64
0)
interpretTestFrozen ::
Members [Error TestError, Resource, Embed IO, Final IO] r =>
Severity ->
InterpretersFor ConcTestStack r
interpretTestFrozen :: forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack r
interpretTestFrozen Severity
level =
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack' r
interpretTest' Severity
level forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (r :: EffectRow).
Member (Embed IO) r =>
Time -> InterpreterFor ChronosTime r
interpretTimeChronosConstant Time
testTime
runTestLevel ::
Severity ->
Sem TestStack a ->
TestT IO a
runTestLevel :: forall a. Severity -> Sem TestStack a -> TestT IO a
runTestLevel Severity
level =
forall a.
HasCallStack =>
Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a
-> TestT IO a
runTestAuto forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack r
interpretTest Severity
level
runTestFrozenLevel ::
Severity ->
Sem TestStack a ->
TestT IO a
runTestFrozenLevel :: forall a. Severity -> Sem TestStack a -> TestT IO a
runTestFrozenLevel Severity
level =
forall a.
HasCallStack =>
Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a
-> TestT IO a
runTestAuto forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack r
interpretTestFrozen Severity
level
runTestTrace :: Sem TestStack a -> TestT IO a
runTestTrace :: forall a. Sem TestStack a -> TestT IO a
runTestTrace =
forall a. Severity -> Sem TestStack a -> TestT IO a
runTestLevel Severity
Trace
runTestDebug :: Sem TestStack a -> TestT IO a
runTestDebug :: forall a. Sem TestStack a -> TestT IO a
runTestDebug =
forall a. Severity -> Sem TestStack a -> TestT IO a
runTestLevel Severity
Debug
runTest :: Sem TestStack a -> TestT IO a
runTest :: forall a. Sem TestStack a -> TestT IO a
runTest =
forall a. Severity -> Sem TestStack a -> TestT IO a
runTestLevel Severity
Crit
runTestFrozenTrace :: Sem TestStack a -> TestT IO a
runTestFrozenTrace :: forall a. Sem TestStack a -> TestT IO a
runTestFrozenTrace =
forall a. Severity -> Sem TestStack a -> TestT IO a
runTestFrozenLevel Severity
Trace
runTestFrozenDebug :: Sem TestStack a -> TestT IO a
runTestFrozenDebug :: forall a. Sem TestStack a -> TestT IO a
runTestFrozenDebug =
forall a. Severity -> Sem TestStack a -> TestT IO a
runTestFrozenLevel Severity
Debug
runTestFrozen :: Sem TestStack a -> TestT IO a
runTestFrozen :: forall a. Sem TestStack a -> TestT IO a
runTestFrozen =
forall a. Severity -> Sem TestStack a -> TestT IO a
runTestFrozenLevel Severity
Crit