{-# LANGUAGE RankNTypes, GeneralizedNewtypeDeriving #-}

{- Defines a Pulsar Monad, which wraps a Managed resource -}
module Pulsar.Internal.Core where

import qualified Control.Logging               as L
import           Control.Monad.Catch
import           Control.Monad.Managed

{- | The main Pulsar monad, which abstracts over a 'Managed' monad. -}
newtype Pulsar a = Pulsar (Managed a)
  deriving (a -> Pulsar b -> Pulsar a
(a -> b) -> Pulsar a -> Pulsar b
(forall a b. (a -> b) -> Pulsar a -> Pulsar b)
-> (forall a b. a -> Pulsar b -> Pulsar a) -> Functor Pulsar
forall a b. a -> Pulsar b -> Pulsar a
forall a b. (a -> b) -> Pulsar a -> Pulsar b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Pulsar b -> Pulsar a
$c<$ :: forall a b. a -> Pulsar b -> Pulsar a
fmap :: (a -> b) -> Pulsar a -> Pulsar b
$cfmap :: forall a b. (a -> b) -> Pulsar a -> Pulsar b
Functor, Functor Pulsar
a -> Pulsar a
Functor Pulsar =>
(forall a. a -> Pulsar a)
-> (forall a b. Pulsar (a -> b) -> Pulsar a -> Pulsar b)
-> (forall a b c.
    (a -> b -> c) -> Pulsar a -> Pulsar b -> Pulsar c)
-> (forall a b. Pulsar a -> Pulsar b -> Pulsar b)
-> (forall a b. Pulsar a -> Pulsar b -> Pulsar a)
-> Applicative Pulsar
Pulsar a -> Pulsar b -> Pulsar b
Pulsar a -> Pulsar b -> Pulsar a
Pulsar (a -> b) -> Pulsar a -> Pulsar b
(a -> b -> c) -> Pulsar a -> Pulsar b -> Pulsar c
forall a. a -> Pulsar a
forall a b. Pulsar a -> Pulsar b -> Pulsar a
forall a b. Pulsar a -> Pulsar b -> Pulsar b
forall a b. Pulsar (a -> b) -> Pulsar a -> Pulsar b
forall a b c. (a -> b -> c) -> Pulsar a -> Pulsar b -> Pulsar c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Pulsar a -> Pulsar b -> Pulsar a
$c<* :: forall a b. Pulsar a -> Pulsar b -> Pulsar a
*> :: Pulsar a -> Pulsar b -> Pulsar b
$c*> :: forall a b. Pulsar a -> Pulsar b -> Pulsar b
liftA2 :: (a -> b -> c) -> Pulsar a -> Pulsar b -> Pulsar c
$cliftA2 :: forall a b c. (a -> b -> c) -> Pulsar a -> Pulsar b -> Pulsar c
<*> :: Pulsar (a -> b) -> Pulsar a -> Pulsar b
$c<*> :: forall a b. Pulsar (a -> b) -> Pulsar a -> Pulsar b
pure :: a -> Pulsar a
$cpure :: forall a. a -> Pulsar a
$cp1Applicative :: Functor Pulsar
Applicative, Applicative Pulsar
a -> Pulsar a
Applicative Pulsar =>
(forall a b. Pulsar a -> (a -> Pulsar b) -> Pulsar b)
-> (forall a b. Pulsar a -> Pulsar b -> Pulsar b)
-> (forall a. a -> Pulsar a)
-> Monad Pulsar
Pulsar a -> (a -> Pulsar b) -> Pulsar b
Pulsar a -> Pulsar b -> Pulsar b
forall a. a -> Pulsar a
forall a b. Pulsar a -> Pulsar b -> Pulsar b
forall a b. Pulsar a -> (a -> Pulsar b) -> Pulsar b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Pulsar a
$creturn :: forall a. a -> Pulsar a
>> :: Pulsar a -> Pulsar b -> Pulsar b
$c>> :: forall a b. Pulsar a -> Pulsar b -> Pulsar b
>>= :: Pulsar a -> (a -> Pulsar b) -> Pulsar b
$c>>= :: forall a b. Pulsar a -> (a -> Pulsar b) -> Pulsar b
$cp1Monad :: Applicative Pulsar
Monad, Monad Pulsar
Monad Pulsar => (forall a. IO a -> Pulsar a) -> MonadIO Pulsar
IO a -> Pulsar a
forall a. IO a -> Pulsar a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Pulsar a
$cliftIO :: forall a. IO a -> Pulsar a
$cp1MonadIO :: Monad Pulsar
MonadIO, MonadIO Pulsar
MonadIO Pulsar =>
(forall a. Managed a -> Pulsar a) -> MonadManaged Pulsar
Managed a -> Pulsar a
forall a. Managed a -> Pulsar a
forall (m :: * -> *).
MonadIO m =>
(forall a. Managed a -> m a) -> MonadManaged m
using :: Managed a -> Pulsar a
$cusing :: forall a. Managed a -> Pulsar a
$cp1MonadManaged :: MonadIO Pulsar
MonadManaged)

{- | Runs a Pulsar computation with default logging to standard output -}
runPulsar :: forall a b . Pulsar a -> (a -> IO b) -> IO b
runPulsar :: Pulsar a -> (a -> IO b) -> IO b
runPulsar (Pulsar mgd :: Managed a
mgd) f :: a -> IO b
f = do
  String -> IO ()
L.setLogTimeFormat "%H:%M:%S%Q"
  IO b -> IO b
forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m) =>
m a -> m a
L.withStdoutLogging (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ Managed a -> (a -> IO b) -> IO b
forall a r. Managed a -> (a -> IO r) -> IO r
with Managed a
mgd a -> IO b
f

{- | Runs a Pulsar computation with the supplied logging options -}
runPulsar' :: forall a b . LogOptions -> Pulsar a -> (a -> IO b) -> IO b
runPulsar' :: LogOptions -> Pulsar a -> (a -> IO b) -> IO b
runPulsar' (LogOptions lvl :: LogLevel
lvl out :: LogOutput
out) (Pulsar mgd :: Managed a
mgd) f :: a -> IO b
f = do
  LogLevel -> IO ()
L.setLogLevel (LogLevel -> IO ()) -> LogLevel -> IO ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> LogLevel
convertLogLevel LogLevel
lvl
  String -> IO ()
L.setLogTimeFormat "%H:%M:%S%Q"
  case LogOutput
out of
    StdOut  -> IO b -> IO b
forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m) =>
m a -> m a
L.withStdoutLogging (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ Managed a -> (a -> IO b) -> IO b
forall a r. Managed a -> (a -> IO r) -> IO r
with Managed a
mgd a -> IO b
f
    File fp :: String
fp -> String -> IO b -> IO b
forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadIO m) =>
String -> m a -> m a
L.withFileLogging String
fp (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ Managed a -> (a -> IO b) -> IO b
forall a r. Managed a -> (a -> IO r) -> IO r
with Managed a
mgd a -> IO b
f

instance MonadThrow Pulsar where
  throwM :: e -> Pulsar a
throwM = IO a -> Pulsar a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Pulsar a) -> (e -> IO a) -> e -> Pulsar a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

{- | Internal logging options. Can be used together with `runPulsar'`. -}
data LogOptions = LogOptions
  { LogOptions -> LogLevel
logLevel :: LogLevel
  , LogOptions -> LogOutput
logOutput :: LogOutput
  } deriving Int -> LogOptions -> ShowS
[LogOptions] -> ShowS
LogOptions -> String
(Int -> LogOptions -> ShowS)
-> (LogOptions -> String)
-> ([LogOptions] -> ShowS)
-> Show LogOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogOptions] -> ShowS
$cshowList :: [LogOptions] -> ShowS
show :: LogOptions -> String
$cshow :: LogOptions -> String
showsPrec :: Int -> LogOptions -> ShowS
$cshowsPrec :: Int -> LogOptions -> ShowS
Show

{- | Internal logging level, part of 'LogOptions'. Can be used together with `runPulsar'`. -}
data LogLevel = Error | Warn | Info | Debug deriving Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show

{- | Internal logging output, part of 'LogOptions'. Can be used together with `runPulsar'`. -}
data LogOutput = StdOut | File FilePath deriving Int -> LogOutput -> ShowS
[LogOutput] -> ShowS
LogOutput -> String
(Int -> LogOutput -> ShowS)
-> (LogOutput -> String)
-> ([LogOutput] -> ShowS)
-> Show LogOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogOutput] -> ShowS
$cshowList :: [LogOutput] -> ShowS
show :: LogOutput -> String
$cshow :: LogOutput -> String
showsPrec :: Int -> LogOutput -> ShowS
$cshowsPrec :: Int -> LogOutput -> ShowS
Show

convertLogLevel :: LogLevel -> L.LogLevel
convertLogLevel :: LogLevel -> LogLevel
convertLogLevel Error = LogLevel
L.LevelError
convertLogLevel Warn  = LogLevel
L.LevelWarn
convertLogLevel Info  = LogLevel
L.LevelInfo
convertLogLevel Debug = LogLevel
L.LevelDebug