{-# language NoImplicitPrelude, CPP #-}
{-# options_haddock prune #-}
module Zeugma.Run where
import qualified Chronos
import Chronos (datetimeToTime)
import Conc (
Critical,
Gates,
interpretCritical,
interpretGates,
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)
#if MIN_VERSION_polysemy_process(0, 14, 0)
import Polysemy.Process (Interrupt, interpretInterrupt)
#else
import Conc (interpretInterrupt)
#endif
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 =
(Text -> TestError) -> Sem (Error Text : r) a -> Sem r a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError (HasCallStack, HasCallStack) => Text -> TestError
Text -> TestError
TestError (Sem (Error Text : r) a -> Sem r a)
-> (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem (Error Text : r) a)
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Stop Text : Error Text : r) a -> Sem (Error Text : r) a
forall err (r :: EffectRow) a.
Member (Error err) r =>
Sem (Stop err : r) a -> Sem r a
stopToError (Sem (Stop Text : Error Text : r) a -> Sem (Error Text : r) a)
-> (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem (Stop Text : Error Text : r) a)
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem (Error Text : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Async : Stop Text : Error Text : r) a
-> Sem (Stop Text : Error Text : r) a
forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Async : r) a -> Sem r a
asyncToIOFinal (Sem (Async : Stop Text : Error Text : r) a
-> Sem (Stop Text : Error Text : r) a)
-> (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem (Async : Stop Text : Error Text : r) a)
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem (Stop Text : Error Text : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem (Race : Async : Stop Text : Error Text : r) a
-> Sem (Async : Stop Text : Error Text : r) a
forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor Race r
InterpreterFor Race (Async : Stop Text : Error Text : r)
interpretRace (Sem (Race : Async : Stop Text : Error Text : r) a
-> Sem (Async : Stop Text : Error Text : r) a)
-> (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem (Race : Async : Stop Text : Error Text : r) a)
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem (Async : Stop Text : Error Text : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem
(UninterruptibleMask : Race : Async : Stop Text : Error Text : r) a
-> Sem (Race : Async : Stop Text : Error Text : r) a
forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor UninterruptibleMask r
InterpreterFor
UninterruptibleMask (Race : Async : Stop Text : Error Text : r)
interpretUninterruptibleMaskFinal (Sem
(UninterruptibleMask : Race : Async : Stop Text : Error Text : r) a
-> Sem (Race : Async : Stop Text : Error Text : r) a)
-> (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a)
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem (Race : Async : Stop Text : Error Text : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem
(UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(UninterruptibleMask : Race : Async : Stop Text : Error Text : r) a
forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor UninterruptibleMask r
InterpreterFor
UninterruptibleMask
(UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
interpretMaskFinal (Sem
(UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a)
-> (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a)
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(UninterruptibleMask : Race : Async : Stop Text : Error Text : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem
(Scoped_ Gate
: UninterruptibleMask : UninterruptibleMask : Race : Async
: Stop Text : Error Text : r)
a
-> Sem
(UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor (Scoped_ Gate) r
InterpreterFor
(Scoped_ Gate)
(UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
interpretGates (Sem
(Scoped_ Gate
: UninterruptibleMask : UninterruptibleMask : Race : Async
: Stop Text : Error Text : r)
a
-> Sem
(UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a)
-> (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Scoped_ Gate
: UninterruptibleMask : UninterruptibleMask : Race : Async
: Stop Text : Error Text : r)
a)
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem
(Critical
: Scoped_ Gate : UninterruptibleMask : UninterruptibleMask : Race
: Async : Stop Text : Error Text : r)
a
-> Sem
(Scoped_ Gate
: UninterruptibleMask : UninterruptibleMask : Race : Async
: Stop Text : Error Text : r)
a
forall (r :: EffectRow).
Member (Final IO) r =>
InterpreterFor Critical r
InterpreterFor
Critical
(Scoped_ Gate
: UninterruptibleMask : UninterruptibleMask : Race : Async
: Stop Text : Error Text : r)
interpretCritical (Sem
(Critical
: Scoped_ Gate : UninterruptibleMask : UninterruptibleMask : Race
: Async : Stop Text : Error Text : r)
a
-> Sem
(Scoped_ Gate
: UninterruptibleMask : UninterruptibleMask : Race : Async
: Stop Text : Error Text : r)
a)
-> (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Critical
: Scoped_ Gate : UninterruptibleMask : UninterruptibleMask : Race
: Async : Stop Text : Error Text : r)
a)
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Scoped_ Gate
: UninterruptibleMask : UninterruptibleMask : Race : Async
: Stop Text : Error Text : r)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem
(Interrupt
: Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Critical
: Scoped_ Gate : UninterruptibleMask : UninterruptibleMask : Race
: Async : Stop Text : Error Text : r)
a
forall (r :: EffectRow).
Members '[Critical, Race, Async, Embed IO] r =>
InterpreterFor Interrupt r
InterpreterFor
Interrupt
(Critical
: Scoped_ Gate : UninterruptibleMask : UninterruptibleMask : Race
: Async : Stop Text : Error Text : r)
interpretInterrupt (Sem
(Interrupt
: Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Critical
: Scoped_ Gate : UninterruptibleMask : UninterruptibleMask : Race
: Async : Stop Text : Error Text : r)
a)
-> (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Interrupt
: Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a)
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Critical
: Scoped_ Gate : UninterruptibleMask : UninterruptibleMask : Race
: Async : Stop Text : Error Text : r)
a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Maybe Severity
-> InterpreterFor
Log
(Interrupt
: Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
forall (r :: EffectRow).
Members '[Resource, Async, Race, Embed IO] r =>
Maybe Severity -> InterpreterFor Log r
interpretLogStderrLevelConc (Severity -> Maybe Severity
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 =
Severity -> InterpretersFor ConcTestStack' r
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack' r
interpretTest' Severity
level (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem r a)
-> (Sem
(ChronosTime
: Log : Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a)
-> Sem
(ChronosTime
: Log : Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Sem
(ChronosTime
: Log : Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
forall (r :: EffectRow).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
InterpreterFor
ChronosTime
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
interpretTimeChronos
testTime :: Chronos.Time
testTime :: Time
testTime =
Datetime -> Time
datetimeToTime (Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Datetime
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 =
Severity -> InterpretersFor ConcTestStack' r
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack' r
interpretTest' Severity
level (Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem r a)
-> (Sem
(ChronosTime
: Log : Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a)
-> Sem
(ChronosTime
: Log : Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Time
-> InterpreterFor
ChronosTime
(Log
: Interrupt : Critical : Scoped_ Gate : UninterruptibleMask
: UninterruptibleMask : Race : Async : Stop Text : Error Text : r)
forall (r :: EffectRow).
Member (Embed IO) r =>
Time -> InterpreterFor ChronosTime r
interpretTimeChronosConstant Time
testTime
runTestLevel ::
HasCallStack =>
Severity ->
Sem TestStack a ->
TestT IO a
runTestLevel :: forall a. HasCallStack => Severity -> Sem TestStack a -> TestT IO a
runTestLevel Severity
level =
Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a
-> TestT IO a
forall a.
HasCallStack =>
Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a
-> TestT IO a
runTestAuto (Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a
-> TestT IO a)
-> (Sem
'[ChronosTime, Log, Interrupt, Critical, Scoped_ Gate,
UninterruptibleMask, UninterruptibleMask, Race, Async, Stop Text,
Error Text, Test, Fail, Error TestError, Hedgehog IO,
Error Failure, Embed IO, Resource, Final IO]
a
-> Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a)
-> Sem
'[ChronosTime, Log, Interrupt, Critical, Scoped_ Gate,
UninterruptibleMask, UninterruptibleMask, Race, Async, Stop Text,
Error Text, Test, Fail, Error TestError, Hedgehog IO,
Error Failure, Embed IO, Resource, Final IO]
a
-> TestT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity
-> InterpretersFor
ConcTestStack
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack r
interpretTest Severity
level
runTestFrozenLevel ::
HasCallStack =>
Severity ->
Sem TestStack a ->
TestT IO a
runTestFrozenLevel :: forall a. HasCallStack => Severity -> Sem TestStack a -> TestT IO a
runTestFrozenLevel Severity
level =
Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a
-> TestT IO a
forall a.
HasCallStack =>
Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a
-> TestT IO a
runTestAuto (Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a
-> TestT IO a)
-> (Sem
'[ChronosTime, Log, Interrupt, Critical, Scoped_ Gate,
UninterruptibleMask, UninterruptibleMask, Race, Async, Stop Text,
Error Text, Test, Fail, Error TestError, Hedgehog IO,
Error Failure, Embed IO, Resource, Final IO]
a
-> Sem
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
a)
-> Sem
'[ChronosTime, Log, Interrupt, Critical, Scoped_ Gate,
UninterruptibleMask, UninterruptibleMask, Race, Async, Stop Text,
Error Text, Test, Fail, Error TestError, Hedgehog IO,
Error Failure, Embed IO, Resource, Final IO]
a
-> TestT IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity
-> InterpretersFor
ConcTestStack
'[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
Embed IO, Resource, Final IO]
forall (r :: EffectRow).
Members '[Error TestError, Resource, Embed IO, Final IO] r =>
Severity -> InterpretersFor ConcTestStack r
interpretTestFrozen Severity
level
runTestTrace ::
HasCallStack =>
Sem TestStack a ->
TestT IO a
runTestTrace :: forall a. HasCallStack => Sem TestStack a -> TestT IO a
runTestTrace =
Severity -> Sem TestStack a -> TestT IO a
forall a. HasCallStack => Severity -> Sem TestStack a -> TestT IO a
runTestLevel Severity
Trace
runTestDebug ::
HasCallStack =>
Sem TestStack a ->
TestT IO a
runTestDebug :: forall a. HasCallStack => Sem TestStack a -> TestT IO a
runTestDebug =
Severity -> Sem TestStack a -> TestT IO a
forall a. HasCallStack => Severity -> Sem TestStack a -> TestT IO a
runTestLevel Severity
Debug
runTest ::
HasCallStack =>
Sem TestStack a ->
TestT IO a
runTest :: forall a. HasCallStack => Sem TestStack a -> TestT IO a
runTest =
Severity -> Sem TestStack a -> TestT IO a
forall a. HasCallStack => Severity -> Sem TestStack a -> TestT IO a
runTestLevel Severity
Crit
runTestFrozenTrace ::
HasCallStack =>
Sem TestStack a ->
TestT IO a
runTestFrozenTrace :: forall a. HasCallStack => Sem TestStack a -> TestT IO a
runTestFrozenTrace =
Severity -> Sem TestStack a -> TestT IO a
forall a. HasCallStack => Severity -> Sem TestStack a -> TestT IO a
runTestFrozenLevel Severity
Trace
runTestFrozenDebug ::
HasCallStack =>
Sem TestStack a ->
TestT IO a
runTestFrozenDebug :: forall a. HasCallStack => Sem TestStack a -> TestT IO a
runTestFrozenDebug =
Severity -> Sem TestStack a -> TestT IO a
forall a. HasCallStack => Severity -> Sem TestStack a -> TestT IO a
runTestFrozenLevel Severity
Debug
runTestFrozen ::
HasCallStack =>
Sem TestStack a ->
TestT IO a
runTestFrozen :: forall a. HasCallStack => Sem TestStack a -> TestT IO a
runTestFrozen =
Severity -> Sem TestStack a -> TestT IO a
forall a. HasCallStack => Severity -> Sem TestStack a -> TestT IO a
runTestFrozenLevel Severity
Crit