diff options
Diffstat (limited to 'hsm-log/Hsm/Log.hs')
-rw-r--r-- | hsm-log/Hsm/Log.hs | 44 |
1 files changed, 15 insertions, 29 deletions
diff --git a/hsm-log/Hsm/Log.hs b/hsm-log/Hsm/Log.hs index 73da4bd..3c25501 100644 --- a/hsm-log/Hsm/Log.hs +++ b/hsm-log/Hsm/Log.hs @@ -3,27 +3,20 @@ {-# LANGUAGE UndecidableInstances #-} module Hsm.Log - ( Severity (Attention, Info, Trace) + ( Severity(Attention, Info, Trace) , Log , getLoggerIO , logMsg , runLog - ) -where + ) where import Control.Monad (when) import Data.Function (applyWhen) -import Data.Proxy (Proxy (Proxy)) +import Data.Proxy (Proxy(Proxy)) import Data.Time.Clock (getCurrentTime) import Data.Time.ISO8601 (formatISO8601Millis) -import Effectful (Dispatch (Static), DispatchOf, Eff, Effect, IOE, (:>)) -import Effectful.Dispatch.Static - ( SideEffects (WithSideEffects) - , StaticRep - , evalStaticRep - , getStaticRep - , unsafeEff_ - ) +import Effectful (Dispatch(Static), DispatchOf, Eff, Effect, IOE, (:>)) +import Effectful.Dispatch.Static (SideEffects(WithSideEffects), StaticRep, evalStaticRep, getStaticRep, unsafeEff_) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import GHC.TypeLits.Printf (printf) import String.ANSI (red) @@ -38,32 +31,28 @@ data Log (d :: Symbol) (a :: * -> *) (b :: *) type instance DispatchOf (Log d) = Static WithSideEffects -newtype instance StaticRep (Log d) - = Log Severity +newtype instance StaticRep (Log d) = + Log Severity -getLoggerIO - :: forall d es - . (KnownSymbol d, Log d :> es) +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 + 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) +logMsg :: + forall d es. (KnownSymbol d, Log d :> es) => Severity -> String -> Eff es () logMsg severity message = getLoggerIO >>= \loggerIO -> unsafeEff_ $ loggerIO severity message -runLog - :: forall d es a - . IOE :> es +runLog :: + forall d es a. IOE :> es => Severity -> Eff (Log d : es) a -> Eff es a @@ -77,9 +66,6 @@ instance Logs ('[] :: [Symbol]) (es :: [Effect]) where type Insert '[] es = es runLogs _ = id -instance - (IOE :> Insert ds es, KnownSymbol d, Logs ds es) - => Logs (d : ds :: [Symbol]) (es :: [Effect]) - where +instance (IOE :> Insert ds es, KnownSymbol d, Logs ds es) => Logs (d : ds :: [Symbol]) (es :: [Effect]) where type Insert (d : ds) es = Log d : Insert ds es runLogs level = runLogs @ds level . runLog @d level |