diff options
Diffstat (limited to 'hsm-log/Hsm/Log.hs')
| -rw-r--r-- | hsm-log/Hsm/Log.hs | 28 |
1 files changed, 21 insertions, 7 deletions
diff --git a/hsm-log/Hsm/Log.hs b/hsm-log/Hsm/Log.hs index 5321910..088be8e 100644 --- a/hsm-log/Hsm/Log.hs +++ b/hsm-log/Hsm/Log.hs @@ -5,6 +5,7 @@ module Hsm.Log ( Severity (Attention, Info, Trace) , Log + , getLoggerIO , logMsg , runLog ) @@ -31,7 +32,7 @@ data Severity = Attention | Info | Trace - deriving (Eq, Ord, Show) + deriving (Enum, Eq, Ord, Show) data Log (d :: Symbol) (a :: * -> *) (b :: *) @@ -40,18 +41,31 @@ type instance DispatchOf (Log d) = Static WithSideEffects newtype instance StaticRep (Log d) = Log Severity +getLoggerIO + :: forall d es + . (KnownSymbol d, Log d :> es) + => Eff es (Severity -> String -> IO ()) +getLoggerIO = do + Log level <- getStaticRep + return $ \severity message -> + when (severity <= level) $ do + time <- formatISO8601Millis <$> getCurrentTime + putStrLn . applyWhen (severity == Attention) red $ + printf + "%s %s [%s] %s" + time + (symbolVal $ Proxy @d) + (show severity) + message + logMsg :: forall d es . (KnownSymbol d, Log d :> es) => Severity -> String -> Eff es () -logMsg severity message = do - Log level <- getStaticRep - unsafeEff_ . when (severity <= level) $ do - time <- formatISO8601Millis <$> getCurrentTime - putStrLn . applyWhen (severity == Attention) red $ - printf "%s %s [%s] %s" time (symbolVal $ Proxy @d) (show level) message +logMsg severity message = + getLoggerIO >>= \loggerIO -> unsafeEff_ $ loggerIO severity message runLog :: forall d es a |