little-logger 1.0.1 → 1.0.2
raw patch · 5 files changed
+68/−33 lines, 5 filesdep ~textsetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: text
API changes (from Hackage documentation)
Files
- README.md +0/−2
- Setup.hs +0/−2
- little-logger.cabal +4/−4
- src/LittleLogger.hs +40/−16
- test/Main.hs +24/−9
README.md view
@@ -1,5 +1,3 @@ # little-logger -[](https://circleci.com/gh/ejconlon/little-logger/tree/master)- Basic logging based on monad-logger. Meant to give you what you need to get started with a single module import.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
little-logger.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: little-logger-version: 1.0.1+version: 1.0.2 synopsis: Basic logging based on monad-logger description: Please see the README on GitHub at <https://github.com/ejconlon/little-logger#readme> category: Logging@@ -42,7 +42,7 @@ , microlens >=0.4 && <1 , monad-logger ==0.3.* , mtl >=2.2 && <3- , text >=1.2 && <2+ , text >=1.2 && <2.1 , unliftio-core >=0.1.2.0 && <2 default-language: Haskell2010 @@ -69,6 +69,6 @@ , tasty >=1.2.3 && <2 , tasty-hunit >=0.10.0.2 && <1 , temporary ==1.3.*- , text >=1.2 && <2+ , text >=1.2 && <2.1 , unliftio-core >=0.1.2.0 && <2 default-language: Haskell2010
src/LittleLogger.hs view
@@ -29,24 +29,47 @@ , logWarnN , logErrorN , logOtherN- ) where+ )+where +import Control.Monad (when) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.IO.Unlift (MonadUnliftIO, askRunInIO)-import Control.Monad.Logger.CallStack (Loc (..), LogLevel (..), LogSource, LogStr, MonadLogger (..), ToLogStr (..),- defaultOutput, fromLogStr, logDebugN, logErrorN, logInfoN, logOtherN, logWarnN)+import Control.Monad.Logger.CallStack+ ( Loc (..)+ , LogLevel (..)+ , LogSource+ , LogStr+ , MonadLogger (..)+ , ToLogStr (..)+ , defaultOutput+ , fromLogStr+ , logDebugN+ , logErrorN+ , logInfoN+ , logOtherN+ , logWarnN+ ) import Control.Monad.Reader (MonadReader, ReaderT (..), asks) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8) import Lens.Micro (Lens') import Lens.Micro.Extras (view)-import System.IO (BufferMode (LineBuffering), Handle, IOMode (AppendMode), hClose, hSetBuffering, openFile, stderr,- withFile)+import System.IO+ ( BufferMode (LineBuffering)+ , Handle+ , IOMode (AppendMode)+ , hClose+ , hSetBuffering+ , openFile+ , stderr+ , withFile+ ) textLogStr :: LogStr -> Text textLogStr = decodeUtf8 . fromLogStr -newtype LogAction = LogAction { unLogAction :: Loc -> LogSource -> LogLevel -> LogStr -> IO () }+newtype LogAction = LogAction {unLogAction :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()} instance Semigroup LogAction where LogAction act1 <> LogAction act2 = LogAction (\loc src lvl msg -> act1 loc src lvl msg >> act2 loc src lvl msg)@@ -55,31 +78,32 @@ mempty = LogAction (\_ _ _ _ -> pure ()) mappend = (<>) -newLogAction :: MonadUnliftIO m => (Loc -> LogSource -> LogLevel -> LogStr -> m ()) -> m LogAction+newLogAction :: (MonadUnliftIO m) => (Loc -> LogSource -> LogLevel -> LogStr -> m ()) -> m LogAction newLogAction act = fmap (\run -> LogAction (\loc src lvl msg -> run (act loc src lvl msg))) askRunInIO -runLogAction :: MonadIO m => LogAction -> Loc -> LogSource -> LogLevel -> LogStr -> m ()+runLogAction :: (MonadIO m) => LogAction -> Loc -> LogSource -> LogLevel -> LogStr -> m () runLogAction (LogAction act) loc src lvl msg = liftIO (act loc src lvl msg) defaultLogAction :: LogAction defaultLogAction = LogAction (defaultOutput stderr) filterActionSeverity :: LogLevel -> LogAction -> LogAction-filterActionSeverity lim (LogAction act) = LogAction (\loc src lvl msg -> if lvl >= lim then act loc src lvl msg else pure ())+filterActionSeverity lim (LogAction act) =+ LogAction (\loc src lvl msg -> when (lvl >= lim) (act loc src lvl msg)) handleLogAction :: Handle -> LogAction handleLogAction = LogAction . defaultOutput -openLoggingHandle :: MonadIO m => FilePath -> m Handle+openLoggingHandle :: (MonadIO m) => FilePath -> m Handle openLoggingHandle fp = do handle <- liftIO (openFile fp AppendMode) liftIO (hSetBuffering handle LineBuffering) pure handle -closeLoggingHandle :: MonadIO m => Handle -> m ()+closeLoggingHandle :: (MonadIO m) => Handle -> m () closeLoggingHandle = liftIO . hClose -fileLogAction :: MonadUnliftIO m => FilePath -> (LogAction -> m a) -> m a+fileLogAction :: (MonadUnliftIO m) => FilePath -> (LogAction -> m a) -> m a fileLogAction fp f = do run <- askRunInIO liftIO $ withFile fp AppendMode $ \handle -> do@@ -98,17 +122,17 @@ askLogAction = asks (view logActionL) -- | Use deriving-via with this wrapper to add MonadLogger instances to your types-newtype LogActionWrapperM env m a = LogActionM { unLogActionM :: m a }+newtype LogActionWrapperM env m a = LogActionM {unLogActionM :: m a} deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader env) -instance WithLogAction env m => MonadLogger (LogActionWrapperM env m) where+instance (WithLogAction env m) => MonadLogger (LogActionWrapperM env m) where monadLoggerLog loc src lvl msg = do LogAction act <- askLogAction liftIO (act loc src lvl (toLogStr msg)) -newtype LogActionT m a = LogActionT { unLogActionT :: ReaderT LogAction m a }+newtype LogActionT m a = LogActionT {unLogActionT :: ReaderT LogAction m a} deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader LogAction)- deriving MonadLogger via (LogActionWrapperM LogAction (LogActionT m))+ deriving (MonadLogger) via (LogActionWrapperM LogAction (LogActionT m)) runLogActionT :: LogActionT m a -> LogAction -> m a runLogActionT = runReaderT . unLogActionT
test/Main.hs view
@@ -5,8 +5,19 @@ import Control.Exception (finally) import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Data.Text (Text)-import LittleLogger (LogAction (..), LogActionM, LogLevel (..), fileLogAction, filterActionSeverity, logDebugN,- logErrorN, logInfoN, logWarnN, runLogActionM, textLogStr)+import LittleLogger+ ( LogAction (..)+ , LogActionM+ , LogLevel (..)+ , fileLogAction+ , filterActionSeverity+ , logDebugN+ , logErrorN+ , logInfoN+ , logWarnN+ , runLogActionM+ , textLogStr+ ) import System.Directory (removeFile) import System.IO.Temp (emptySystemTempFile) import Test.Tasty (TestTree, defaultMain, testGroup)@@ -22,7 +33,7 @@ refAction :: IORef [(LogLevel, Text)] -> LogAction refAction ref = LogAction (\_ _ lvl msg -> modifyIORef' ref (++ [(lvl, textLogStr msg)])) -runWithRefAction :: (LogAction -> LogAction) -> (LogActionM ()) -> IO [(LogLevel, Text)]+runWithRefAction :: (LogAction -> LogAction) -> LogActionM () -> IO [(LogLevel, Text)] runWithRefAction f m = do ref <- newIORef [] let action = f (refAction ref)@@ -39,7 +50,8 @@ expectedUnfiltered = [ (LevelDebug, "debug") , (LevelInfo, "info")- ] ++ expectedFiltered+ ]+ ++ expectedFiltered testUnfiltered :: TestTree testUnfiltered = testCase "Unfiltered" $ do@@ -63,8 +75,11 @@ length (lines secondContents) @?= 8 main :: IO ()-main = defaultMain $ testGroup "LittleLogger" $- [ testUnfiltered- , testFiltered- , testFile- ]+main =+ defaultMain $+ testGroup+ "LittleLogger"+ [ testUnfiltered+ , testFiltered+ , testFile+ ]