diff --git a/libatrade.cabal b/libatrade.cabal index d8fef77..15a1ab7 100644 --- a/libatrade.cabal +++ b/libatrade.cabal @@ -1,5 +1,5 @@ name: libatrade -version: 0.10.0.0 +version: 0.11.0.0 synopsis: ATrade infrastructure core library description: Please see README.md homepage: https://github.com/asakul/libatrade.git @@ -18,6 +18,7 @@ library ghc-options: -Wincomplete-patterns exposed-modules: ATrade.Types , ATrade.Price + , ATrade.Logging , ATrade.QuoteSource.Client , ATrade.QuoteSource.Server , ATrade.Broker.Backend @@ -57,6 +58,8 @@ library , utf8-string , zeromq4-haskell , zeromq4-haskell-zap + , co-log + , ansi-terminal default-language: Haskell2010 diff --git a/src/ATrade/Logging.hs b/src/ATrade/Logging.hs new file mode 100644 index 0000000..f2a039f --- /dev/null +++ b/src/ATrade/Logging.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module ATrade.Logging + ( + Severity(..), + Message(..), + fmtMessage, + showSeverity, + log, + logTrace, + logDebug, + logInfo, + logWarning, + logError, + logWith, + logTraceWith, + logDebugWith, + logInfoWith, + logWarningWith, + logErrorWith + ) where + +import Colog (LogAction (unLogAction), WithLog, + logMsg) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import qualified Data.Text as T +import Data.Time (UTCTime, defaultTimeLocale, + getCurrentTime) +import Data.Time.Format.ISO8601 (iso8601Show) +import Prelude hiding (log) +import System.Console.ANSI (Color (Cyan, Green, Red, White, Yellow), + ColorIntensity (Dull, Vivid), + ConsoleLayer (Foreground), + SGR (Reset, SetColor), setSGRCode) + + +data Severity = + Trace + | Debug + | Info + | Warning + | Error + deriving (Show, Eq, Ord) + +data Message = + Message + { + msgTimestamp :: UTCTime, + msgComponent :: T.Text, + msgSeverity :: Severity, + msgText :: T.Text + } deriving (Show, Eq) + +fmtMessage :: Message -> T.Text +fmtMessage Message{..} = + (bracketed . T.pack . iso8601Show) msgTimestamp <> + bracketed msgComponent <> + showSeverity msgSeverity <> + " " <> + msgText + where + bracketed txt = "[" <> txt <> "]" + +showSeverity :: Severity -> T.Text +showSeverity = \case + Trace -> color White Dull "[Trace] " + Debug -> color Cyan Dull "[Debug] " + Info -> color Green Vivid "[Info] " + Warning -> color Yellow Vivid "[Warning]" + Error -> color Red Vivid "[Error] " + where + color c h txt = T.pack (setSGRCode [SetColor Foreground h c]) + <> txt + <> T.pack (setSGRCode [Reset]) + +logWith :: (MonadIO m) => LogAction m Message -> Severity -> T.Text -> T.Text -> m () +logWith act sev comp txt = do + now <- liftIO getCurrentTime + unLogAction act $ Message now comp sev txt + +logTraceWith :: (MonadIO m) => LogAction m Message -> T.Text -> T.Text -> m () +logTraceWith act = logWith act Trace + +logDebugWith :: (MonadIO m) => LogAction m Message -> T.Text -> T.Text -> m () +logDebugWith act = logWith act Debug + +logInfoWith :: (MonadIO m) => LogAction m Message -> T.Text -> T.Text -> m () +logInfoWith act = logWith act Info + +logWarningWith :: (MonadIO m) => LogAction m Message -> T.Text -> T.Text -> m () +logWarningWith act = logWith act Warning + +logErrorWith :: (MonadIO m) => LogAction m Message -> T.Text -> T.Text -> m () +logErrorWith act = logWith act Error + +log :: (MonadIO m, WithLog env Message m) => Severity -> T.Text -> T.Text -> m () +log sev comp txt = do + now <- liftIO getCurrentTime + logMsg $ Message now comp sev txt + +logTrace :: (MonadIO m, WithLog env Message m) => T.Text -> T.Text -> m () +logTrace = log Trace + +logDebug :: (MonadIO m, WithLog env Message m) => T.Text -> T.Text -> m () +logDebug = log Debug + +logInfo :: (MonadIO m, WithLog env Message m) => T.Text -> T.Text -> m () +logInfo = log Info + +logWarning :: (MonadIO m, WithLog env Message m) => T.Text -> T.Text -> m () +logWarning = log Warning + +logError :: (MonadIO m, WithLog env Message m) => T.Text -> T.Text -> m () +logError = log Error diff --git a/stack.yaml b/stack.yaml index 30bb862..2d5c77e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-17.14 +resolver: lts-18.18 # User packages to be built. # Various formats can be used as shown in the example below. @@ -40,7 +40,11 @@ packages: - '../zeromq4-haskell-zap' # Dependency packages to be pulled from upstream that are not in the resolver # (e.g., acme-missiles-0.3) -extra-deps: [ "datetime-0.3.1", "hexdump-0.1"] +extra-deps: +- datetime-0.3.1 +- hexdump-0.1 +- co-log-0.4.0.1@sha256:3d4c17f37693c80d1aa2c41669bc3438fac3e89dc5f479e57d79bc3ddc4dfcc5,5087 +- ansi-terminal-0.10.3@sha256:e2fbcef5f980dc234c7ad8e2fa433b0e8109132c9e643bc40ea5608cd5697797,3226 # Override default flag values for local packages and extra-deps flags: {}