summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorejconlon <>2020-10-16 19:50:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-10-16 19:50:00 (GMT)
commit7d8b6d623c254872b3461ecbcab751d8c650e496 (patch)
treefa54869cc05c06a8272502d54cb7df67d6b4505c
parent17eda367802e029758829945b5632aae5bf08b45 (diff)
version 0.3.00.3.0
-rw-r--r--little-logger.cabal9
-rw-r--r--src/LittleLogger.hs79
-rw-r--r--src/LittleLogger/Common.hs32
-rw-r--r--src/LittleLogger/Manual.hs39
-rw-r--r--src/LittleLogger/Reader.hs65
5 files changed, 147 insertions, 77 deletions
diff --git a/little-logger.cabal b/little-logger.cabal
index 6a5c743..d7e8c5b 100644
--- a/little-logger.cabal
+++ b/little-logger.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
--- hash: 04ccafa118c9aff9469b3f6df3b75e278af4e203909e6cbc86a24b134f6125d3
+-- hash: aba3bd1382858101a107dccd5d1945a8fd38e248c5f95f8ebfa7c9f8c01e72e5
name: little-logger
-version: 0.2.0
+version: 0.3.0
synopsis: Basic logging based on co-log
description: Please see the README on GitHub at <https://github.com/ejconlon/little-logger#readme>
category: Logging
@@ -29,7 +29,10 @@ source-repository head
library
exposed-modules:
LittleLogger
+ LittleLogger.Manual
+ LittleLogger.Reader
other-modules:
+ LittleLogger.Common
Paths_little_logger
hs-source-dirs:
src
@@ -41,6 +44,7 @@ library
, microlens >=0.4 && <1
, mtl >=2.2 && <3
, text >=1.2 && <2
+ , unliftio-core >=0.1.2.0 && <2
default-language: Haskell2010
test-suite little-logger-test
@@ -61,4 +65,5 @@ test-suite little-logger-test
, tasty >=1.2.3 && <2
, tasty-hunit >=0.10.0.2 && <1
, text >=1.2 && <2
+ , unliftio-core >=0.1.2.0 && <2
default-language: Haskell2010
diff --git a/src/LittleLogger.hs b/src/LittleLogger.hs
index ff582e2..d212725 100644
--- a/src/LittleLogger.hs
+++ b/src/LittleLogger.hs
@@ -3,81 +3,10 @@
{-# LANGUAGE Rank2Types #-}
-- | Basic logging based on co-log. Meant to give you what you need to get started with a single module import.
+-- The root module exports 'LittleLogger.Reader' for use with RIO-style stacks, but if you want to manually
+-- pass a 'SimpleLogAction' around, import 'LittleLogger.Manual' instead.
module LittleLogger
- ( LogAction (..)
- , HasSimpleLog (..)
- , Message
- , Msg (..)
- , Severity (..)
- , SimpleLogAction
- , WithSimpleLog
- , defaultSimpleLogAction
- , filterActionSeverity
- , logMsg
- , logDebug
- , logError
- , logException
- , logInfo
- , logWarning
- , logWithSeverity
- , runWithSimpleLogAction
+ ( module LittleLogger.Reader
) where
-import Colog.Actions (richMessageAction)
-import Colog.Core.Action (LogAction (..))
-import Colog.Core.Severity (Severity (..))
-import Colog.Message (Message, Msg (..))
-import Control.Exception (Exception, displayException)
-import Control.Monad.IO.Class (MonadIO (..))
-import Control.Monad.Reader (MonadReader (..), ReaderT (..))
-import Data.Text (Text)
-import qualified Data.Text as Text
-import GHC.Stack (HasCallStack, callStack, withFrozenCallStack)
-import Lens.Micro (Lens')
-import Lens.Micro.Extras (view)
-import Prelude
-
-type SimpleLogAction = LogAction IO Message
-
-class HasSimpleLog env where
- simpleLogL :: Lens' env SimpleLogAction
-
-instance HasSimpleLog SimpleLogAction where
- simpleLogL = id
-
-type WithSimpleLog env m = (MonadIO m, MonadReader env m, HasSimpleLog env, HasCallStack)
-
-defaultSimpleLogAction :: SimpleLogAction
-defaultSimpleLogAction = richMessageAction
-
-filterActionSeverity :: Severity -> SimpleLogAction -> SimpleLogAction
-filterActionSeverity lim (LogAction f) = LogAction (\msg -> if msgSeverity msg >= lim then f msg else pure ())
-
-logMsg :: WithSimpleLog env m => Message -> m ()
-logMsg msg = do
- env <- ask
- let LogAction act = view simpleLogL env
- liftIO (act msg)
-
-logWithSeverity :: WithSimpleLog env m => Severity -> Text -> m ()
-logWithSeverity sev txt = withFrozenCallStack (logMsg Msg { msgStack = callStack, msgSeverity = sev, msgText = txt })
-
-logDebug :: WithSimpleLog env m => Text -> m ()
-logDebug = withFrozenCallStack (logWithSeverity Debug)
-
-logInfo :: WithSimpleLog env m => Text -> m ()
-logInfo = withFrozenCallStack (logWithSeverity Info)
-
-logWarning :: WithSimpleLog env m => Text -> m ()
-logWarning = withFrozenCallStack (logWithSeverity Warning)
-
-logError :: WithSimpleLog env m => Text -> m ()
-logError = withFrozenCallStack (logWithSeverity Error)
-
-logException :: (WithSimpleLog env m, Exception e) => e -> m ()
-logException = withFrozenCallStack (logError . Text.pack . displayException)
-
--- | Usually 'm' will be some kind of 'Reader' monad. In the case where you don't care what it
--- is and you only need to do logging and IO, you can use this.
-runWithSimpleLogAction :: SimpleLogAction -> (forall env m. WithSimpleLog env m => m a) -> IO a
-runWithSimpleLogAction = flip runReaderT
+import LittleLogger.Reader
diff --git a/src/LittleLogger/Common.hs b/src/LittleLogger/Common.hs
new file mode 100644
index 0000000..4840d57
--- /dev/null
+++ b/src/LittleLogger/Common.hs
@@ -0,0 +1,32 @@
+module LittleLogger.Common
+ ( LogAction (..)
+ , Message
+ , Msg (..)
+ , Severity (..)
+ , SimpleLogAction
+ , defaultSimpleLogAction
+ , filterActionSeverity
+ , newSimpleLogAction
+ , runSimpleLogAction
+ ) where
+
+import Colog.Actions (richMessageAction)
+import Colog.Core.Action (LogAction (..))
+import Colog.Core.Severity (Severity (..))
+import Colog.Message (Message, Msg (..))
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.IO.Unlift (MonadUnliftIO, askRunInIO)
+
+type SimpleLogAction = LogAction IO Message
+
+newSimpleLogAction :: MonadUnliftIO m => (Message -> m ()) -> m SimpleLogAction
+newSimpleLogAction f = fmap (\run -> LogAction (run . f)) askRunInIO
+
+runSimpleLogAction :: MonadIO m => SimpleLogAction -> Message -> m ()
+runSimpleLogAction (LogAction actIO) = liftIO . actIO
+
+defaultSimpleLogAction :: SimpleLogAction
+defaultSimpleLogAction = richMessageAction
+
+filterActionSeverity :: Severity -> SimpleLogAction -> SimpleLogAction
+filterActionSeverity lim (LogAction f) = LogAction (\msg -> if msgSeverity msg >= lim then f msg else pure ())
diff --git a/src/LittleLogger/Manual.hs b/src/LittleLogger/Manual.hs
new file mode 100644
index 0000000..0a28314
--- /dev/null
+++ b/src/LittleLogger/Manual.hs
@@ -0,0 +1,39 @@
+-- | A logging "backend" where you pass around the log action manually.
+module LittleLogger.Manual
+ ( module LittleLogger.Common
+ , logMsg
+ , logDebug
+ , logError
+ , logException
+ , logInfo
+ , logWarning
+ , logWithSeverity
+ ) where
+
+import Control.Exception (Exception, displayException)
+import Control.Monad.IO.Class (MonadIO)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import GHC.Stack (HasCallStack, callStack, withFrozenCallStack)
+import LittleLogger.Common
+
+logMsg :: MonadIO m => SimpleLogAction -> Message -> m ()
+logMsg = runSimpleLogAction
+
+logWithSeverity :: (MonadIO m, HasCallStack) => SimpleLogAction -> Severity -> Text -> m ()
+logWithSeverity act sev txt = withFrozenCallStack (logMsg act Msg { msgStack = callStack, msgSeverity = sev, msgText = txt })
+
+logDebug :: (MonadIO m, HasCallStack) => SimpleLogAction -> Text -> m ()
+logDebug act = withFrozenCallStack (logWithSeverity act Debug)
+
+logInfo :: (MonadIO m, HasCallStack) => SimpleLogAction -> Text -> m ()
+logInfo act = withFrozenCallStack (logWithSeverity act Info)
+
+logWarning :: (MonadIO m, HasCallStack) => SimpleLogAction -> Text -> m ()
+logWarning act = withFrozenCallStack (logWithSeverity act Warning)
+
+logError :: (MonadIO m, HasCallStack) => SimpleLogAction -> Text -> m ()
+logError act = withFrozenCallStack (logWithSeverity act Error)
+
+logException :: (MonadIO m, Exception e, HasCallStack) => SimpleLogAction -> e -> m ()
+logException act = withFrozenCallStack (logError act . Text.pack . displayException)
diff --git a/src/LittleLogger/Reader.hs b/src/LittleLogger/Reader.hs
new file mode 100644
index 0000000..ee34fc7
--- /dev/null
+++ b/src/LittleLogger/Reader.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE Rank2Types #-}
+
+-- | A logging "backend" where you get the log action from the environment.
+module LittleLogger.Reader
+ ( module LittleLogger.Common
+ , HasSimpleLog (..)
+ , WithSimpleLog
+ , logMsg
+ , logDebug
+ , logError
+ , logException
+ , logInfo
+ , logWarning
+ , logWithSeverity
+ , runWithSimpleLogAction
+ ) where
+
+import Control.Exception (Exception, displayException)
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Reader (MonadReader (..), ReaderT (..))
+import Data.Text (Text)
+import qualified Data.Text as Text
+import GHC.Stack (HasCallStack, callStack, withFrozenCallStack)
+import Lens.Micro (Lens')
+import Lens.Micro.Extras (view)
+import LittleLogger.Common
+
+class HasSimpleLog env where
+ simpleLogL :: Lens' env SimpleLogAction
+
+instance HasSimpleLog SimpleLogAction where
+ simpleLogL = id
+
+type WithSimpleLog env m = (MonadIO m, MonadReader env m, HasSimpleLog env, HasCallStack)
+
+logMsg :: WithSimpleLog env m => Message -> m ()
+logMsg msg = do
+ env <- ask
+ let LogAction act = view simpleLogL env
+ liftIO (act msg)
+
+logWithSeverity :: WithSimpleLog env m => Severity -> Text -> m ()
+logWithSeverity sev txt = withFrozenCallStack (logMsg Msg { msgStack = callStack, msgSeverity = sev, msgText = txt })
+
+logDebug :: WithSimpleLog env m => Text -> m ()
+logDebug = withFrozenCallStack (logWithSeverity Debug)
+
+logInfo :: WithSimpleLog env m => Text -> m ()
+logInfo = withFrozenCallStack (logWithSeverity Info)
+
+logWarning :: WithSimpleLog env m => Text -> m ()
+logWarning = withFrozenCallStack (logWithSeverity Warning)
+
+logError :: WithSimpleLog env m => Text -> m ()
+logError = withFrozenCallStack (logWithSeverity Error)
+
+logException :: (WithSimpleLog env m, Exception e) => e -> m ()
+logException = withFrozenCallStack (logError . Text.pack . displayException)
+
+-- | Usually 'm' will be some kind of 'Reader' monad. In the case where you don't care what it
+-- is and you only need to do logging and IO, you can use this.
+runWithSimpleLogAction :: SimpleLogAction -> (forall env m. WithSimpleLog env m => m a) -> IO a
+runWithSimpleLogAction = flip runReaderT