{-# 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 =
(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