module Ribosome.Host.IOStack where

import Conc (ConcStack)
import qualified Data.Text.IO as Text
import Polysemy.Chronos (ChronosTime, interpretTimeChronos)
import System.IO (stderr)

import Ribosome.Host.Config (interpretLogConfig)
import Ribosome.Host.Data.BootError (BootError (BootError))
import Ribosome.Host.Data.HostConfig (HostConfig, LogConfig)
import Ribosome.Host.Effect.Log (FileLog, StderrLog)
import Ribosome.Host.Interpreter.Log (interpretLogStderrFile, interpretLogs)

type LogConfStack =
  [
    Log,
    StderrLog,
    FileLog,
    Reader LogConfig,
    Reader HostConfig
  ]

interpretLogConfStack ::
  Members [ChronosTime, Error BootError, Resource, Race, Async, Embed IO] r =>
  HostConfig ->
  InterpretersFor LogConfStack r
interpretLogConfStack :: forall (r :: [(* -> *) -> * -> *]).
Members
  '[ChronosTime, Error BootError, Resource, Race, Async, Embed IO]
  r =>
HostConfig -> InterpretersFor LogConfStack r
interpretLogConfStack HostConfig
conf =
  HostConfig -> Sem (Reader HostConfig : r) a -> Sem r a
forall i (r :: [(* -> *) -> * -> *]) a.
i -> Sem (Reader i : r) a -> Sem r a
runReader HostConfig
conf (Sem (Reader HostConfig : r) a -> Sem r a)
-> (Sem
      (Log
         : StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r)
      a
    -> Sem (Reader HostConfig : r) a)
-> Sem
     (Log
        : StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r)
     a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem (Reader LogConfig : Reader HostConfig : r) a
-> Sem (Reader HostConfig : r) a
forall (r :: [(* -> *) -> * -> *]).
Member (Reader HostConfig) r =>
InterpreterFor (Reader LogConfig) r
interpretLogConfig (Sem (Reader LogConfig : Reader HostConfig : r) a
 -> Sem (Reader HostConfig : r) a)
-> (Sem
      (Log
         : StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r)
      a
    -> Sem (Reader LogConfig : Reader HostConfig : r) a)
-> Sem
     (Log
        : StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r)
     a
-> Sem (Reader HostConfig : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r) a
-> Sem (Reader LogConfig : Reader HostConfig : r) a
forall (r :: [(* -> *) -> * -> *]).
Members
  '[Reader LogConfig, Resource, ChronosTime, Race, Async, Embed IO]
  r =>
InterpretersFor '[StderrLog, FileLog] r
interpretLogs (Sem
   (StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r) a
 -> Sem (Reader LogConfig : Reader HostConfig : r) a)
-> (Sem
      (Log
         : StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r)
      a
    -> Sem
         (StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r) a)
-> Sem
     (Log
        : StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r)
     a
-> Sem (Reader LogConfig : Reader HostConfig : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem
  (Log
     : StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r)
  a
-> Sem
     (StderrLog : FileLog : Reader LogConfig : Reader HostConfig : r) a
forall (r :: [(* -> *) -> * -> *]).
Members '[StderrLog, FileLog] r =>
InterpreterFor Log r
interpretLogStderrFile

type IOStack =
  [
    ChronosTime,
    Error BootError
  ] ++ ConcStack

errorStderr :: IO (Either BootError ()) -> IO ()
errorStderr :: IO (Either BootError ()) -> IO ()
errorStderr IO (Either BootError ())
ma =
  IO (Either BootError ())
ma IO (Either BootError ()) -> (Either BootError () -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left (BootError Text
err) -> Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr Text
err
    Right () -> IO ()
forall (f :: * -> *). Applicative f => f ()
unit

runIOStack ::
  Sem IOStack () ->
  IO ()
runIOStack :: Sem IOStack () -> IO ()
runIOStack =
  IO (Either BootError ()) -> IO ()
errorStderr (IO (Either BootError ()) -> IO ())
-> (Sem (ChronosTime : Error BootError : ConcStack) ()
    -> IO (Either BootError ()))
-> Sem (ChronosTime : Error BootError : ConcStack) ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem ConcStack (Either BootError ()) -> IO (Either BootError ())
forall a. Sem ConcStack a -> IO a
runConc (Sem ConcStack (Either BootError ()) -> IO (Either BootError ()))
-> (Sem (ChronosTime : Error BootError : ConcStack) ()
    -> Sem ConcStack (Either BootError ()))
-> Sem (ChronosTime : Error BootError : ConcStack) ()
-> IO (Either BootError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem (Error BootError : ConcStack) ()
-> Sem ConcStack (Either BootError ())
forall e (r :: [(* -> *) -> * -> *]) a.
(Typeable e, Member (Final IO) r) =>
Sem (Error e : r) a -> Sem r (Either e a)
errorToIOFinal (Sem (Error BootError : ConcStack) ()
 -> Sem ConcStack (Either BootError ()))
-> (Sem (ChronosTime : Error BootError : ConcStack) ()
    -> Sem (Error BootError : ConcStack) ())
-> Sem (ChronosTime : Error BootError : ConcStack) ()
-> Sem ConcStack (Either BootError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Sem (ChronosTime : Error BootError : ConcStack) ()
-> Sem (Error BootError : ConcStack) ()
forall (r :: [(* -> *) -> * -> *]).
Member (Embed IO) r =>
InterpreterFor ChronosTime r
interpretTimeChronos

type BasicStack =
  LogConfStack ++ IOStack

runBasicStack ::
  HostConfig ->
  Sem BasicStack () ->
  IO ()
runBasicStack :: HostConfig -> Sem BasicStack () -> IO ()
runBasicStack HostConfig
conf =
  Sem (ChronosTime : Error BootError : ConcStack) () -> IO ()
Sem IOStack () -> IO ()
runIOStack (Sem (ChronosTime : Error BootError : ConcStack) () -> IO ())
-> (Sem
      (Log
         : StderrLog : FileLog : Reader LogConfig : Reader HostConfig
         : ChronosTime : Error BootError : ConcStack)
      ()
    -> Sem (ChronosTime : Error BootError : ConcStack) ())
-> Sem
     (Log
        : StderrLog : FileLog : Reader LogConfig : Reader HostConfig
        : ChronosTime : Error BootError : ConcStack)
     ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  HostConfig
-> InterpretersFor
     LogConfStack (ChronosTime : Error BootError : ConcStack)
forall (r :: [(* -> *) -> * -> *]).
Members
  '[ChronosTime, Error BootError, Resource, Race, Async, Embed IO]
  r =>
HostConfig -> InterpretersFor LogConfStack r
interpretLogConfStack HostConfig
conf