module Ribosome.Host.Test.Run where

import qualified Chronos
import Conc (GatesIO, Restoration, interpretGates, interpretMaskFinal, interpretRace, interpretUninterruptibleMaskFinal)
import Hedgehog.Internal.Property (Failure)
import Log (Severity (Debug, Trace, Warn), interpretLogStderrLevelConc)
import Polysemy.Chronos (ChronosTime, interpretTimeChronos, interpretTimeChronosConstant)
import Polysemy.Test (Hedgehog, Test, TestError (TestError), UnitTest, runTestAuto)
import Time (mkDatetime)

import Ribosome.Host.Data.BootError (BootError (unBootError))
import Ribosome.Host.Data.HostConfig (setStderr)
import Ribosome.Host.Data.RpcHandler (RpcHandler)
import Ribosome.Host.Effect.Rpc (Rpc)
import Ribosome.Host.Embed (HostEmbedStack, embedNvim, embedNvim_)
import Ribosome.Host.IOStack (LogConfStack, interpretLogConfStack)
import Ribosome.Host.Test.Data.TestConfig (TestConfig (TestConfig), host)

type TestIOStack =
  [
    Log,
    Mask Restoration,
    UninterruptibleMask Restoration,
    GatesIO,
    Race,
    Async,
    Error BootError,
    Test,
    Fail,
    Error TestError,
    Hedgehog IO,
    Error Failure,
    Embed IO,
    Resource,
    Final IO
  ]

type TestConfStack =
  LogConfStack ++ '[ChronosTime]

type TestStack =
  TestConfStack ++ TestIOStack

type EmbedTestStack =
  HostEmbedStack ++ TestStack

testTime :: Chronos.Time
testTime :: Time
testTime =
  Datetime -> Time
Chronos.datetimeToTime (Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Datetime
forall dt.
Calendar dt =>
Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> dt
mkDatetime Int64
2025 Int64
6 Int64
15 Int64
12 Int64
30 Int64
30)

runUnitTest ::
  HasCallStack =>
  Sem TestIOStack () ->
  UnitTest
runUnitTest :: HasCallStack => Sem TestIOStack () -> UnitTest
runUnitTest =
  Sem
  '[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
    Embed IO, Resource, Final IO]
  ()
-> UnitTest
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]
   ()
 -> UnitTest)
-> (Sem TestIOStack ()
    -> Sem
         '[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
           Embed IO, Resource, Final IO]
         ())
-> Sem TestIOStack ()
-> UnitTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (BootError -> TestError)
-> Sem
     '[Error BootError, Test, Fail, Error TestError, Hedgehog IO,
       Error Failure, Embed IO, Resource, Final IO]
     ()
-> Sem
     '[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
       Embed IO, Resource, Final IO]
     ()
forall e1 e2 (r :: [(* -> *) -> * -> *]) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError (Text -> TestError
TestError (Text -> TestError)
-> (BootError -> Text) -> BootError -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BootError -> Text
unBootError) (Sem
   '[Error BootError, Test, Fail, Error TestError, Hedgehog IO,
     Error Failure, Embed IO, Resource, Final IO]
   ()
 -> Sem
      '[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
        Embed IO, Resource, Final IO]
      ())
-> (Sem TestIOStack ()
    -> Sem
         '[Error BootError, Test, Fail, Error TestError, Hedgehog IO,
           Error Failure, Embed IO, Resource, Final IO]
         ())
-> Sem TestIOStack ()
-> Sem
     '[Test, Fail, Error TestError, Hedgehog IO, Error Failure,
       Embed IO, Resource, Final IO]
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  '[Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
    Error Failure, Embed IO, Resource, Final IO]
  ()
-> Sem
     '[Error BootError, Test, Fail, Error TestError, Hedgehog IO,
       Error Failure, Embed IO, Resource, Final IO]
     ()
forall (r :: [(* -> *) -> * -> *]) a.
Member (Final IO) r =>
Sem (Async : r) a -> Sem r a
asyncToIOFinal (Sem
   '[Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
     Error Failure, Embed IO, Resource, Final IO]
   ()
 -> Sem
      '[Error BootError, Test, Fail, Error TestError, Hedgehog IO,
        Error Failure, Embed IO, Resource, Final IO]
      ())
-> (Sem TestIOStack ()
    -> Sem
         '[Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
           Error Failure, Embed IO, Resource, Final IO]
         ())
-> Sem TestIOStack ()
-> Sem
     '[Error BootError, Test, Fail, Error TestError, Hedgehog IO,
       Error Failure, Embed IO, Resource, Final IO]
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  '[Race, Async, Error BootError, Test, Fail, Error TestError,
    Hedgehog IO, Error Failure, Embed IO, Resource, Final IO]
  ()
-> Sem
     '[Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
       Error Failure, Embed IO, Resource, Final IO]
     ()
forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
InterpreterFor Race r
interpretRace (Sem
   '[Race, Async, Error BootError, Test, Fail, Error TestError,
     Hedgehog IO, Error Failure, Embed IO, Resource, Final IO]
   ()
 -> Sem
      '[Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
        Error Failure, Embed IO, Resource, Final IO]
      ())
-> (Sem TestIOStack ()
    -> Sem
         '[Race, Async, Error BootError, Test, Fail, Error TestError,
           Hedgehog IO, Error Failure, Embed IO, Resource, Final IO]
         ())
-> Sem TestIOStack ()
-> Sem
     '[Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
       Error Failure, Embed IO, Resource, Final IO]
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  '[Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
    Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
    Final IO]
  ()
-> Sem
     '[Race, Async, Error BootError, Test, Fail, Error TestError,
       Hedgehog IO, Error Failure, Embed IO, Resource, Final IO]
     ()
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor (Scoped (MVar ()) Gate) r
interpretGates (Sem
   '[Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
     Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
     Final IO]
   ()
 -> Sem
      '[Race, Async, Error BootError, Test, Fail, Error TestError,
        Hedgehog IO, Error Failure, Embed IO, Resource, Final IO]
      ())
-> (Sem TestIOStack ()
    -> Sem
         '[Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
           Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
           Final IO]
         ())
-> Sem TestIOStack ()
-> Sem
     '[Race, Async, Error BootError, Test, Fail, Error TestError,
       Hedgehog IO, Error Failure, Embed IO, Resource, Final IO]
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  '[UninterruptibleMask Restoration, Scoped (MVar ()) Gate, Race,
    Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
    Error Failure, Embed IO, Resource, Final IO]
  ()
-> Sem
     '[Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
       Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
       Final IO]
     ()
forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
InterpreterFor (UninterruptibleMask Restoration) r
interpretUninterruptibleMaskFinal (Sem
   '[UninterruptibleMask Restoration, Scoped (MVar ()) Gate, Race,
     Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
     Error Failure, Embed IO, Resource, Final IO]
   ()
 -> Sem
      '[Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
        Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
        Final IO]
      ())
-> (Sem TestIOStack ()
    -> Sem
         '[UninterruptibleMask Restoration, Scoped (MVar ()) Gate, Race,
           Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
           Error Failure, Embed IO, Resource, Final IO]
         ())
-> Sem TestIOStack ()
-> Sem
     '[Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
       Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
       Final IO]
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  '[UninterruptibleMask Restoration, UninterruptibleMask Restoration,
    Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
    Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
    Final IO]
  ()
-> Sem
     '[UninterruptibleMask Restoration, Scoped (MVar ()) Gate, Race,
       Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
       Error Failure, Embed IO, Resource, Final IO]
     ()
forall (r :: [(* -> *) -> * -> *]).
Member (Final IO) r =>
InterpreterFor (UninterruptibleMask Restoration) r
interpretMaskFinal (Sem
   '[UninterruptibleMask Restoration, UninterruptibleMask Restoration,
     Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
     Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
     Final IO]
   ()
 -> Sem
      '[UninterruptibleMask Restoration, Scoped (MVar ()) Gate, Race,
        Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
        Error Failure, Embed IO, Resource, Final IO]
      ())
-> (Sem TestIOStack ()
    -> Sem
         '[UninterruptibleMask Restoration, UninterruptibleMask Restoration,
           Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
           Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
           Final IO]
         ())
-> Sem TestIOStack ()
-> Sem
     '[UninterruptibleMask Restoration, Scoped (MVar ()) Gate, Race,
       Async, Error BootError, Test, Fail, Error TestError, Hedgehog IO,
       Error Failure, Embed IO, Resource, Final IO]
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Maybe Severity
-> InterpreterFor
     Log
     '[UninterruptibleMask Restoration, UninterruptibleMask Restoration,
       Scoped (MVar ()) Gate, Race, Async, Error BootError, Test, Fail,
       Error TestError, Hedgehog IO, Error Failure, Embed IO, Resource,
       Final IO]
forall (r :: [(* -> *) -> * -> *]).
Members '[Resource, Async, Race, Embed IO] r =>
Maybe Severity -> InterpreterFor Log r
interpretLogStderrLevelConc (Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Warn)

runTestLogConf ::
  Members [Error BootError, Resource, Race, Async, Embed IO] r =>
  TestConfig ->
  InterpretersFor TestConfStack r
runTestLogConf :: forall (r :: [(* -> *) -> * -> *]).
Members '[Error BootError, Resource, Race, Async, Embed IO] r =>
TestConfig -> InterpretersFor TestConfStack r
runTestLogConf (TestConfig Bool
freezeTime HostConfig
conf) =
  (if Bool
freezeTime then Time -> InterpreterFor ChronosTime r
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
Time -> InterpreterFor ChronosTime r
interpretTimeChronosConstant Time
testTime else Sem (ChronosTime : r) a -> Sem r a
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
interpretTimeChronos) (Sem (ChronosTime : r) a -> Sem r a)
-> (Sem
      (Log
         : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
         : Reader HostConfig : ChronosTime : r)
      a
    -> Sem (ChronosTime : r) a)
-> Sem
     (Log
        : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
        : Reader HostConfig : ChronosTime : r)
     a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  HostConfig -> InterpretersFor LogConfStack (ChronosTime : r)
forall (r :: [(* -> *) -> * -> *]).
Members
  '[ChronosTime, Error BootError, Resource, Race, Async, Embed IO]
  r =>
HostConfig -> InterpretersFor LogConfStack r
interpretLogConfStack HostConfig
conf

runTestConf ::
  HasCallStack =>
  TestConfig ->
  Sem TestStack () ->
  UnitTest
runTestConf :: HasCallStack => TestConfig -> Sem TestStack () -> UnitTest
runTestConf TestConfig
conf =
  HasCallStack => Sem TestIOStack () -> UnitTest
Sem TestIOStack () -> UnitTest
runUnitTest (Sem TestIOStack () -> UnitTest)
-> (Sem
      (Log
         : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
         : Reader HostConfig : ChronosTime : TestIOStack)
      ()
    -> Sem TestIOStack ())
-> Sem
     (Log
        : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
        : Reader HostConfig : ChronosTime : TestIOStack)
     ()
-> UnitTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  TestConfig -> InterpretersFor TestConfStack TestIOStack
forall (r :: [(* -> *) -> * -> *]).
Members '[Error BootError, Resource, Race, Async, Embed IO] r =>
TestConfig -> InterpretersFor TestConfStack r
runTestLogConf TestConfig
conf

runTest ::
  HasCallStack =>
  Sem TestStack () ->
  UnitTest
runTest :: HasCallStack => Sem TestStack () -> UnitTest
runTest =
  HasCallStack => TestConfig -> Sem TestStack () -> UnitTest
TestConfig -> Sem TestStack () -> UnitTest
runTestConf TestConfig
forall a. Default a => a
def

runTestLevel ::
  HasCallStack =>
  Severity ->
  Sem TestStack () ->
  UnitTest
runTestLevel :: HasCallStack => Severity -> Sem TestStack () -> UnitTest
runTestLevel Severity
level =
  HasCallStack => TestConfig -> Sem TestStack () -> UnitTest
TestConfig -> Sem TestStack () -> UnitTest
runTestConf TestConfig
forall a. Default a => a
def { $sel:host:TestConfig :: HostConfig
host = Severity -> HostConfig -> HostConfig
setStderr Severity
level HostConfig
forall a. Default a => a
def }

runTestDebug ::
  HasCallStack =>
  Sem TestStack () ->
  UnitTest
runTestDebug :: HasCallStack => Sem TestStack () -> UnitTest
runTestDebug =
  HasCallStack => Severity -> Sem TestStack () -> UnitTest
Severity -> Sem TestStack () -> UnitTest
runTestLevel Severity
Debug

runTestTrace ::
  HasCallStack =>
  Sem TestStack () ->
  UnitTest
runTestTrace :: HasCallStack => Sem TestStack () -> UnitTest
runTestTrace =
  HasCallStack => Severity -> Sem TestStack () -> UnitTest
Severity -> Sem TestStack () -> UnitTest
runTestLevel Severity
Trace

embedTestConf ::
  HasCallStack =>
  TestConfig ->
  [RpcHandler EmbedTestStack] ->
  Sem (Rpc : EmbedTestStack) () ->
  UnitTest
embedTestConf :: HasCallStack =>
TestConfig
-> [RpcHandler EmbedTestStack]
-> Sem (Rpc : EmbedTestStack) ()
-> UnitTest
embedTestConf TestConfig
conf [RpcHandler EmbedTestStack]
handlers =
  HasCallStack => TestConfig -> Sem TestStack () -> UnitTest
TestConfig -> Sem TestStack () -> UnitTest
runTestConf TestConfig
conf (Sem
   (Log
      : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
      : Reader HostConfig : ChronosTime : TestIOStack)
   ()
 -> UnitTest)
-> (Sem
      (Rpc
         : Log : DataLog LogReport : Resumable RpcError Rpc
         : Resumable RpcError (Responses RequestId Response)
         : Events (OutChan Event) Event
         : PScoped () (EventChan Event) (Consume Event) : Reports
         : Events (OutChan RpcMessage) RpcMessage
         : PScoped () (EventChan RpcMessage) (Consume RpcMessage)
         : Process RpcMessage (Either Text RpcMessage) : UserError : Log
         : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
         : Reader HostConfig : ChronosTime : TestIOStack)
      ()
    -> Sem
         (Log
            : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
            : Reader HostConfig : ChronosTime : TestIOStack)
         ())
-> Sem
     (Rpc
        : Log : DataLog LogReport : Resumable RpcError Rpc
        : Resumable RpcError (Responses RequestId Response)
        : Events (OutChan Event) Event
        : PScoped () (EventChan Event) (Consume Event) : Reports
        : Events (OutChan RpcMessage) RpcMessage
        : PScoped () (EventChan RpcMessage) (Consume RpcMessage)
        : Process RpcMessage (Either Text RpcMessage) : UserError : Log
        : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
        : Reader HostConfig : ChronosTime : TestIOStack)
     ()
-> UnitTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [RpcHandler
   (HostEmbedStack
    ++ (Log
          : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
          : Reader HostConfig : ChronosTime : TestIOStack))]
-> InterpretersFor
     (Rpc : HostEmbedStack)
     (Log
        : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
        : Reader HostConfig : ChronosTime : TestIOStack)
forall (r :: [(* -> *) -> * -> *]).
Members BasicStack r =>
[RpcHandler (HostEmbedStack ++ r)]
-> InterpretersFor (Rpc : HostEmbedStack) r
embedNvim [RpcHandler
   (HostEmbedStack
    ++ (Log
          : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
          : Reader HostConfig : ChronosTime : TestIOStack))]
[RpcHandler EmbedTestStack]
handlers

embedTest ::
  HasCallStack =>
  [RpcHandler EmbedTestStack] ->
  Sem (Rpc : EmbedTestStack) () ->
  UnitTest
embedTest :: HasCallStack =>
[RpcHandler EmbedTestStack]
-> Sem (Rpc : EmbedTestStack) () -> UnitTest
embedTest =
  HasCallStack =>
TestConfig
-> [RpcHandler EmbedTestStack]
-> Sem (Rpc : EmbedTestStack) ()
-> UnitTest
TestConfig
-> [RpcHandler EmbedTestStack]
-> Sem (Rpc : EmbedTestStack) ()
-> UnitTest
embedTestConf TestConfig
forall a. Default a => a
def

embedTest_ ::
  HasCallStack =>
  Sem (Rpc : EmbedTestStack) () ->
  UnitTest
embedTest_ :: HasCallStack => Sem (Rpc : EmbedTestStack) () -> UnitTest
embedTest_ =
  HasCallStack => Sem TestStack () -> UnitTest
Sem
  (Log
     : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
     : Reader HostConfig : ChronosTime : TestIOStack)
  ()
-> UnitTest
runTest (Sem
   (Log
      : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
      : Reader HostConfig : ChronosTime : TestIOStack)
   ()
 -> UnitTest)
-> (Sem
      (Rpc
         : Log : DataLog LogReport : Resumable RpcError Rpc
         : Resumable RpcError (Responses RequestId Response)
         : Events (OutChan Event) Event
         : PScoped () (EventChan Event) (Consume Event) : Reports
         : Events (OutChan RpcMessage) RpcMessage
         : PScoped () (EventChan RpcMessage) (Consume RpcMessage)
         : Process RpcMessage (Either Text RpcMessage) : UserError : Log
         : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
         : Reader HostConfig : ChronosTime : TestIOStack)
      ()
    -> Sem
         (Log
            : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
            : Reader HostConfig : ChronosTime : TestIOStack)
         ())
-> Sem
     (Rpc
        : Log : DataLog LogReport : Resumable RpcError Rpc
        : Resumable RpcError (Responses RequestId Response)
        : Events (OutChan Event) Event
        : PScoped () (EventChan Event) (Consume Event) : Reports
        : Events (OutChan RpcMessage) RpcMessage
        : PScoped () (EventChan RpcMessage) (Consume RpcMessage)
        : Process RpcMessage (Either Text RpcMessage) : UserError : Log
        : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
        : Reader HostConfig : ChronosTime : TestIOStack)
     ()
-> UnitTest
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (Rpc
     : Log : DataLog LogReport : Resumable RpcError Rpc
     : Resumable RpcError (Responses RequestId Response)
     : Events (OutChan Event) Event
     : PScoped () (EventChan Event) (Consume Event) : Reports
     : Events (OutChan RpcMessage) RpcMessage
     : PScoped () (EventChan RpcMessage) (Consume RpcMessage)
     : Process RpcMessage (Either Text RpcMessage) : UserError : Log
     : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
     : Reader HostConfig : ChronosTime : TestIOStack)
  ()
-> Sem
     (Log
        : Tagged "stderr" Log : Tagged "file" Log : Reader LogConfig
        : Reader HostConfig : ChronosTime : TestIOStack)
     ()
forall (r :: [(* -> *) -> * -> *]).
Members BasicStack r =>
InterpretersFor (Rpc : HostEmbedStack) r
embedNvim_