├── .gitignore ├── .travis.yml ├── Control └── Logging.hs ├── LICENSE ├── README.md ├── Setup.hs ├── flake.lock ├── flake.nix ├── logging.cabal └── test └── Main.hs /.gitignore: -------------------------------------------------------------------------------- 1 | /dist/ 2 | .stack-work/ 3 | *.swp 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: nix 2 | 3 | sudo: true 4 | 5 | git: 6 | depth: 1 7 | 8 | env: 9 | global: 10 | matrix: 11 | - GHCVERSION=ghc802 12 | - GHCVERSION=ghc822 13 | - GHCVERSION=ghc843 14 | 15 | matrix: 16 | allow_failures: 17 | exclude: 18 | 19 | script: 20 | - nix-build --argstr compiler $GHCVERSION 21 | 22 | branches: 23 | only: 24 | - master 25 | -------------------------------------------------------------------------------- /Control/Logging.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | -- | Quick example of how to use this module: 5 | -- 6 | -- @ 7 | -- import Control.Logging 8 | -- 9 | -- main = withStdoutLogging $ do 10 | -- log "This is a log message!" 11 | -- timedLog "This is a timed log message!" $ threadDelay 100000 12 | -- @ 13 | 14 | module Control.Logging 15 | ( log 16 | , log' 17 | , logS 18 | , logS' 19 | , warn 20 | , warn' 21 | , warnS 22 | , warnS' 23 | , debug 24 | , debug' 25 | , debugS 26 | , debugS' 27 | , errorL 28 | , errorL' 29 | , errorSL 30 | , errorSL' 31 | , traceL 32 | , traceL' 33 | , traceSL 34 | , traceSL' 35 | , traceShowL 36 | , traceShowL' 37 | , traceShowSL 38 | , traceShowSL' 39 | , timedLog 40 | , timedLog' 41 | , timedLogS 42 | , timedLogS' 43 | , timedLogEnd 44 | , timedLogEnd' 45 | , timedLogEndS 46 | , timedLogEndS' 47 | , timedDebug 48 | , timedDebug' 49 | , timedDebugS 50 | , timedDebugS' 51 | , timedDebugEnd 52 | , timedDebugEnd' 53 | , timedDebugEndS 54 | , timedDebugEndS' 55 | , withStdoutLogging 56 | , withStderrLogging 57 | , withFileLogging 58 | , flushLog 59 | , loggingLogger 60 | , setLogLevel 61 | , setLogTimeFormat 62 | , setDebugSourceRegex 63 | , LogLevel (..) 64 | ) where 65 | 66 | import Control.Exception.Lifted 67 | import Control.Monad 68 | import Control.Monad.IO.Class 69 | import Control.Monad.Trans.Control 70 | import Data.Functor ((<$)) 71 | import Data.IORef 72 | import Data.Maybe (isJust) 73 | import Data.Monoid 74 | import Data.Text as T 75 | import Data.Time 76 | import Data.Time.Locale.Compat (defaultTimeLocale) 77 | import Prelude hiding (log) 78 | import System.IO.Unsafe 79 | import System.Log.FastLogger 80 | import Text.Regex (Regex, mkRegex, matchRegex) 81 | 82 | data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text 83 | deriving (Eq, Prelude.Show, Prelude.Read, Ord) 84 | 85 | type LogSource = Text 86 | 87 | logLevel :: IORef LogLevel 88 | {-# NOINLINE logLevel #-} 89 | logLevel = unsafePerformIO $ newIORef LevelDebug 90 | 91 | -- | Set the verbosity level. Messages at our higher than this level are 92 | -- displayed. It defaults to 'LevelDebug'. 93 | setLogLevel :: LogLevel -> IO () 94 | setLogLevel = atomicWriteIORef logLevel 95 | 96 | logSet :: IORef LoggerSet 97 | {-# NOINLINE logSet #-} 98 | logSet = unsafePerformIO $ 99 | newIORef (error "Must call withStdoutLogging or withStderrLogging") 100 | 101 | logTimeFormat :: IORef String 102 | {-# NOINLINE logTimeFormat #-} 103 | logTimeFormat = unsafePerformIO $ newIORef "%F %T" 104 | 105 | -- | Set the format used for log timestamps. 106 | setLogTimeFormat :: String -> IO () 107 | setLogTimeFormat = atomicWriteIORef logTimeFormat 108 | 109 | debugSourceRegexp :: IORef (Maybe Regex) 110 | {-# NOINLINE debugSourceRegexp #-} 111 | debugSourceRegexp = unsafePerformIO $ newIORef Nothing 112 | 113 | -- | When printing 'LevelDebug' messages, only display those matching the 114 | -- given regexp applied to the Source parameter. Calls to 'debug' without a 115 | -- source parameter are regarded as having a source of @""@. 116 | setDebugSourceRegex :: String -> IO () 117 | setDebugSourceRegex = 118 | atomicWriteIORef debugSourceRegexp 119 | . Just 120 | . mkRegex 121 | 122 | 123 | loggingLogger :: ToLogStr msg => LogLevel -> LogSource -> msg -> IO () 124 | loggingLogger !lvl !src str = do 125 | maxLvl <- readIORef logLevel 126 | when (lvl >= maxLvl) $ do 127 | mre <- readIORef debugSourceRegexp 128 | let willLog = case mre of 129 | Nothing -> True 130 | Just re -> lvl /= LevelDebug || isJust (matchRegex re (T.unpack src)) 131 | when willLog $ do 132 | now <- getZonedTime 133 | fmt <- readIORef logTimeFormat 134 | let stamp = formatTime defaultTimeLocale fmt now 135 | set <- readIORef logSet 136 | pushLogStr set 137 | $ toLogStr (stamp ++ " " ++ renderLevel lvl 138 | ++ " " ++ renderSource src) 139 | <> toLogStr str 140 | <> toLogStr (pack "\n") 141 | where 142 | renderSource :: Text -> String 143 | renderSource txt 144 | | T.null txt = "" 145 | | otherwise = unpack txt ++ ": " 146 | 147 | renderLevel LevelDebug = "[DEBUG]" 148 | renderLevel LevelInfo = "[INFO]" 149 | renderLevel LevelWarn = "[WARN]" 150 | renderLevel LevelError = "[ERROR]" 151 | renderLevel (LevelOther txt) = "[" ++ unpack txt ++ "]" 152 | 153 | -- | This function, or 'withStderrLogging', must be wrapped around whatever 154 | -- region of your application intends to use logging. Typically it would be 155 | -- wrapped around the body of 'main'. 156 | withStdoutLogging :: (MonadBaseControl IO m, MonadIO m) => m a -> m a 157 | withStdoutLogging f = do 158 | liftIO $ do 159 | set <- newStdoutLoggerSet defaultBufSize 160 | atomicWriteIORef logSet set 161 | f `finally` flushLog 162 | 163 | withStderrLogging :: (MonadBaseControl IO m, MonadIO m) => m a -> m a 164 | withStderrLogging f = do 165 | liftIO $ do 166 | set <- newStderrLoggerSet defaultBufSize 167 | atomicWriteIORef logSet set 168 | f `finally` flushLog 169 | 170 | withFileLogging :: (MonadBaseControl IO m, MonadIO m) => FilePath -> m a -> m a 171 | withFileLogging path f = do 172 | liftIO $ do 173 | set <- newFileLoggerSet defaultBufSize path 174 | atomicWriteIORef logSet set 175 | f `finally` flushLog 176 | 177 | -- | Flush all collected logging messages. This is automatically called by 178 | -- 'withStdoutLogging' and 'withStderrLogging' when those blocks are exited 179 | -- by whatever means. 180 | flushLog :: MonadIO m => m () 181 | flushLog = liftIO $ do 182 | set <- readIORef logSet 183 | flushLogStr set 184 | 185 | -- You must surround the body of your @main@ function with a call to 186 | -- 'withStdoutLogging' or 'withStderrLogging', to ensure that all logging 187 | -- buffers are properly flushed on exit. 188 | log :: Text -> IO () 189 | log = loggingLogger LevelInfo "" 190 | 191 | logError :: Text -> Text -> IO () 192 | logError = loggingLogger LevelError 193 | 194 | logS :: Text -> Text -> IO () 195 | logS = loggingLogger LevelInfo 196 | 197 | -- | The apostrophe varients of the logging functions flush the log after each 198 | -- message. 199 | log' :: MonadIO m => Text -> m () 200 | log' msg = liftIO (log msg) >> flushLog 201 | 202 | logS' :: MonadIO m => Text -> Text -> m () 203 | logS' src msg = liftIO (logS src msg) >> flushLog 204 | 205 | debug :: Text -> IO () 206 | debug = debugS "" 207 | 208 | debugS :: Text -> Text -> IO () 209 | debugS = loggingLogger LevelDebug 210 | 211 | debug' :: MonadIO m => Text -> m () 212 | debug' msg = liftIO (debug msg) >> flushLog 213 | 214 | debugS' :: MonadIO m => Text -> Text -> m () 215 | debugS' src msg = liftIO (debugS src msg) >> flushLog 216 | 217 | warn :: Text -> IO () 218 | warn = warnS "" 219 | 220 | warnS :: Text -> Text -> IO () 221 | warnS = loggingLogger LevelWarn 222 | 223 | warn' :: MonadIO m => Text -> m () 224 | warn' msg = liftIO (warn msg) >> flushLog 225 | 226 | warnS' :: MonadIO m => Text -> Text -> m () 227 | warnS' src msg = liftIO (warnS src msg) >> flushLog 228 | 229 | -- | A logging variant of 'error' which uses 'unsafePerformIO' to output a log 230 | -- message before calling 'error'. 231 | errorL :: Text -> a 232 | errorL str = error (unsafePerformIO (logError "" str) `seq` unpack str) 233 | 234 | errorL' :: Text -> a 235 | errorL' str = error (unsafePerformIO (logError "" str >> flushLog) `seq` unpack str) 236 | 237 | errorSL :: Text -> Text -> a 238 | errorSL src str = error (unsafePerformIO (logError src str) `seq` unpack str) 239 | 240 | errorSL' :: Text -> Text -> a 241 | errorSL' src str = 242 | error (unsafePerformIO (logError src str >> flushLog) `seq` unpack str) 243 | 244 | traceL :: Text -> a -> a 245 | traceL str x = unsafePerformIO (debug str) `seq` x 246 | 247 | traceL' :: Text -> a -> a 248 | traceL' str x = unsafePerformIO (debug str >> flushLog) `seq` x 249 | 250 | traceSL :: Text -> Text -> a -> a 251 | traceSL src str x = unsafePerformIO (debugS src str) `seq` x 252 | 253 | traceSL' :: Text -> Text -> a -> a 254 | traceSL' src str x = 255 | unsafePerformIO (debugS src str >> flushLog) `seq` x 256 | 257 | traceShowL :: Show a => a -> a 258 | traceShowL x = 259 | let s = Prelude.show x 260 | in unsafePerformIO (debug (pack s)) `seq` x 261 | 262 | traceShowL' :: Show a => a -> a 263 | traceShowL' x = 264 | let s = Prelude.show x 265 | in unsafePerformIO (debug (pack s) >> flushLog) `seq` x 266 | 267 | traceShowSL :: Show a => Text -> a -> a 268 | traceShowSL src x = 269 | let s = Prelude.show x 270 | in unsafePerformIO (debugS src (pack s)) `seq` x 271 | 272 | traceShowSL' :: Show a => Text -> a -> a 273 | traceShowSL' src x = 274 | let s = Prelude.show x 275 | in unsafePerformIO (debugS src (pack s) >> flushLog) `seq` x 276 | 277 | doTimedLog :: (MonadBaseControl IO m, MonadIO m) 278 | => (Text -> IO ()) -> Bool -> Text -> m a -> m a 279 | doTimedLog logf wrapped msg f = do 280 | start <- liftIO getCurrentTime 281 | when wrapped $ (liftIO . logf) $ msg <> "..." 282 | res <- f `catch` \e -> do 283 | let str = Prelude.show (e :: SomeException) 284 | wrapup start $ pack $ 285 | if wrapped 286 | then "...FAIL (" ++ str ++ ")" 287 | else " (FAIL: " ++ str ++ ")" 288 | throwIO e 289 | wrapup start $ if wrapped then "...done" else "" 290 | return res 291 | where 292 | wrapup start m = do 293 | end <- liftIO getCurrentTime 294 | liftIO . logf $ 295 | msg <> m <> " [" <> pack (Prelude.show (diffUTCTime end start)) <> "]" 296 | 297 | -- | Output a logging message both before an action begins, and after it ends, 298 | -- reporting the total length of time. If an exception occurred, it is also 299 | -- reported. 300 | timedLog :: (MonadBaseControl IO m, MonadIO m) 301 | => Text -> m a -> m a 302 | timedLog = doTimedLog log True 303 | 304 | timedLog' :: (MonadBaseControl IO m, MonadIO m) 305 | => Text -> m a -> m a 306 | timedLog' msg f = doTimedLog log True msg f >>= (<$ flushLog) 307 | 308 | timedLogS :: (MonadBaseControl IO m, MonadIO m) 309 | => Text -> Text -> m a -> m a 310 | timedLogS src = doTimedLog (logS src) True 311 | 312 | timedLogS' :: (MonadBaseControl IO m, MonadIO m) 313 | => Text -> Text -> m a -> m a 314 | timedLogS' src msg f = doTimedLog (logS src) True msg f >>= (<$ flushLog) 315 | 316 | -- | Like 'timedLog', except that it does only logs when the action has 317 | -- completed or failed after it is done. 318 | timedLogEnd :: (MonadBaseControl IO m, MonadIO m) 319 | => Text -> m a -> m a 320 | timedLogEnd = doTimedLog log False 321 | 322 | timedLogEnd' :: (MonadBaseControl IO m, MonadIO m) 323 | => Text -> m a -> m a 324 | timedLogEnd' msg f = doTimedLog log False msg f >>= (<$ flushLog) 325 | 326 | timedLogEndS :: (MonadBaseControl IO m, MonadIO m) 327 | => Text -> Text -> m a -> m a 328 | timedLogEndS src = doTimedLog (logS src) False 329 | 330 | timedLogEndS' :: (MonadBaseControl IO m, MonadIO m) 331 | => Text -> Text -> m a -> m a 332 | timedLogEndS' src msg f = doTimedLog (logS src) False msg f >>= (<$ flushLog) 333 | 334 | -- | A debug variant of 'timedLog'. 335 | timedDebug :: (MonadBaseControl IO m, MonadIO m) 336 | => Text -> m a -> m a 337 | timedDebug = doTimedLog debug True 338 | 339 | timedDebug' :: (MonadBaseControl IO m, MonadIO m) 340 | => Text -> m a -> m a 341 | timedDebug' msg f = doTimedLog debug True msg f >>= (<$ flushLog) 342 | 343 | timedDebugS :: (MonadBaseControl IO m, MonadIO m) 344 | => Text -> Text -> m a -> m a 345 | timedDebugS src = doTimedLog (debugS src) True 346 | 347 | timedDebugS' :: (MonadBaseControl IO m, MonadIO m) 348 | => Text -> Text -> m a -> m a 349 | timedDebugS' src msg f = doTimedLog (debugS src) True msg f >>= (<$ flushLog) 350 | 351 | timedDebugEnd :: (MonadBaseControl IO m, MonadIO m) 352 | => Text -> m a -> m a 353 | timedDebugEnd = doTimedLog debug False 354 | 355 | timedDebugEnd' :: (MonadBaseControl IO m, MonadIO m) 356 | => Text -> m a -> m a 357 | timedDebugEnd' msg f = doTimedLog debug False msg f >>= (<$ flushLog) 358 | 359 | timedDebugEndS :: (MonadBaseControl IO m, MonadIO m) 360 | => Text -> Text -> m a -> m a 361 | timedDebugEndS src = doTimedLog (debugS src) False 362 | 363 | timedDebugEndS' :: (MonadBaseControl IO m, MonadIO m) 364 | => Text -> Text -> m a -> m a 365 | timedDebugEndS' src msg f = doTimedLog (debugS src) False msg f >>= (<$ flushLog) 366 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | opyright (c) 2014 John Wiegley 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # logging 2 | 3 | `logging` is a wrapper around `fast-logger` which makes 4 | it easy to log from `IO`. It provides the following conveniences on top of 5 | those libraries: 6 | 7 | - A set of shorter functions to type: `debug`, `log`, `warn`, plus others 8 | that flush after each message, or which allow providing a message source 9 | string. 10 | 11 | - Logging variants of `error`, `trace` and `traceShow`, called `errorL`, 12 | `traceL` and `traceShowL`. These use `unsafePerformIO` in order to act as 13 | direct replacements, so the usual caveats apply. 14 | 15 | - A global function, `setDebugLevel`, which uses a global `IORef` to record 16 | the logging level, saving you from having to carry around the notion of 17 | "verbosity level" in a Reader environment. 18 | 19 | - A set of "timed" variants, `timedLog` and `timedDebug`, which report how 20 | long the specified action took to execute in wall-clock time. 21 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "HTTP": { 4 | "flake": false, 5 | "locked": { 6 | "lastModified": 1451647621, 7 | "narHash": "sha256-oHIyw3x0iKBexEo49YeUDV1k74ZtyYKGR2gNJXXRxts=", 8 | "owner": "phadej", 9 | "repo": "HTTP", 10 | "rev": "9bc0996d412fef1787449d841277ef663ad9a915", 11 | "type": "github" 12 | }, 13 | "original": { 14 | "owner": "phadej", 15 | "repo": "HTTP", 16 | "type": "github" 17 | } 18 | }, 19 | "cabal-32": { 20 | "flake": false, 21 | "locked": { 22 | "lastModified": 1603716527, 23 | "narHash": "sha256-X0TFfdD4KZpwl0Zr6x+PLxUt/VyKQfX7ylXHdmZIL+w=", 24 | "owner": "haskell", 25 | "repo": "cabal", 26 | "rev": "48bf10787e27364730dd37a42b603cee8d6af7ee", 27 | "type": "github" 28 | }, 29 | "original": { 30 | "owner": "haskell", 31 | "ref": "3.2", 32 | "repo": "cabal", 33 | "type": "github" 34 | } 35 | }, 36 | "cabal-34": { 37 | "flake": false, 38 | "locked": { 39 | "lastModified": 1645834128, 40 | "narHash": "sha256-wG3d+dOt14z8+ydz4SL7pwGfe7SiimxcD/LOuPCV6xM=", 41 | "owner": "haskell", 42 | "repo": "cabal", 43 | "rev": "5ff598c67f53f7c4f48e31d722ba37172230c462", 44 | "type": "github" 45 | }, 46 | "original": { 47 | "owner": "haskell", 48 | "ref": "3.4", 49 | "repo": "cabal", 50 | "type": "github" 51 | } 52 | }, 53 | "cabal-36": { 54 | "flake": false, 55 | "locked": { 56 | "lastModified": 1669081697, 57 | "narHash": "sha256-I5or+V7LZvMxfbYgZATU4awzkicBwwok4mVoje+sGmU=", 58 | "owner": "haskell", 59 | "repo": "cabal", 60 | "rev": "8fd619e33d34924a94e691c5fea2c42f0fc7f144", 61 | "type": "github" 62 | }, 63 | "original": { 64 | "owner": "haskell", 65 | "ref": "3.6", 66 | "repo": "cabal", 67 | "type": "github" 68 | } 69 | }, 70 | "cardano-shell": { 71 | "flake": false, 72 | "locked": { 73 | "lastModified": 1608537748, 74 | "narHash": "sha256-PulY1GfiMgKVnBci3ex4ptk2UNYMXqGjJOxcPy2KYT4=", 75 | "owner": "input-output-hk", 76 | "repo": "cardano-shell", 77 | "rev": "9392c75087cb9a3d453998f4230930dea3a95725", 78 | "type": "github" 79 | }, 80 | "original": { 81 | "owner": "input-output-hk", 82 | "repo": "cardano-shell", 83 | "type": "github" 84 | } 85 | }, 86 | "flake-compat": { 87 | "flake": false, 88 | "locked": { 89 | "lastModified": 1672831974, 90 | "narHash": "sha256-z9k3MfslLjWQfnjBtEtJZdq3H7kyi2kQtUThfTgdRk0=", 91 | "owner": "input-output-hk", 92 | "repo": "flake-compat", 93 | "rev": "45f2638735f8cdc40fe302742b79f248d23eb368", 94 | "type": "github" 95 | }, 96 | "original": { 97 | "owner": "input-output-hk", 98 | "ref": "hkm/gitlab-fix", 99 | "repo": "flake-compat", 100 | "type": "github" 101 | } 102 | }, 103 | "flake-utils": { 104 | "inputs": { 105 | "systems": "systems" 106 | }, 107 | "locked": { 108 | "lastModified": 1731533236, 109 | "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", 110 | "owner": "numtide", 111 | "repo": "flake-utils", 112 | "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", 113 | "type": "github" 114 | }, 115 | "original": { 116 | "owner": "numtide", 117 | "repo": "flake-utils", 118 | "type": "github" 119 | } 120 | }, 121 | "ghc-8.6.5-iohk": { 122 | "flake": false, 123 | "locked": { 124 | "lastModified": 1600920045, 125 | "narHash": "sha256-DO6kxJz248djebZLpSzTGD6s8WRpNI9BTwUeOf5RwY8=", 126 | "owner": "input-output-hk", 127 | "repo": "ghc", 128 | "rev": "95713a6ecce4551240da7c96b6176f980af75cae", 129 | "type": "github" 130 | }, 131 | "original": { 132 | "owner": "input-output-hk", 133 | "ref": "release/8.6.5-iohk", 134 | "repo": "ghc", 135 | "type": "github" 136 | } 137 | }, 138 | "hackage": { 139 | "flake": false, 140 | "locked": { 141 | "lastModified": 1742603068, 142 | "narHash": "sha256-vNouCgS96CF2EFe4evQGhuJIcys6OAq2WoeYzvT7Ges=", 143 | "owner": "input-output-hk", 144 | "repo": "hackage.nix", 145 | "rev": "da37e8bee6cde2ea8772ac9d3ef52c6cfcb9aa02", 146 | "type": "github" 147 | }, 148 | "original": { 149 | "owner": "input-output-hk", 150 | "repo": "hackage.nix", 151 | "type": "github" 152 | } 153 | }, 154 | "hackage-for-stackage": { 155 | "flake": false, 156 | "locked": { 157 | "lastModified": 1742603057, 158 | "narHash": "sha256-PomsxR2lYkM2zhS1knaoTCsq4Uk22GNDjqC/dKmchwE=", 159 | "owner": "input-output-hk", 160 | "repo": "hackage.nix", 161 | "rev": "581d86e7780150ef23ee7564bbc33cbd3263e88f", 162 | "type": "github" 163 | }, 164 | "original": { 165 | "owner": "input-output-hk", 166 | "ref": "for-stackage", 167 | "repo": "hackage.nix", 168 | "type": "github" 169 | } 170 | }, 171 | "haskellNix": { 172 | "inputs": { 173 | "HTTP": "HTTP", 174 | "cabal-32": "cabal-32", 175 | "cabal-34": "cabal-34", 176 | "cabal-36": "cabal-36", 177 | "cardano-shell": "cardano-shell", 178 | "flake-compat": "flake-compat", 179 | "ghc-8.6.5-iohk": "ghc-8.6.5-iohk", 180 | "hackage": "hackage", 181 | "hackage-for-stackage": "hackage-for-stackage", 182 | "hls": "hls", 183 | "hls-1.10": "hls-1.10", 184 | "hls-2.0": "hls-2.0", 185 | "hls-2.2": "hls-2.2", 186 | "hls-2.3": "hls-2.3", 187 | "hls-2.4": "hls-2.4", 188 | "hls-2.5": "hls-2.5", 189 | "hls-2.6": "hls-2.6", 190 | "hls-2.7": "hls-2.7", 191 | "hls-2.8": "hls-2.8", 192 | "hls-2.9": "hls-2.9", 193 | "hpc-coveralls": "hpc-coveralls", 194 | "iserv-proxy": "iserv-proxy", 195 | "nixpkgs": [ 196 | "haskellNix", 197 | "nixpkgs-unstable" 198 | ], 199 | "nixpkgs-2305": "nixpkgs-2305", 200 | "nixpkgs-2311": "nixpkgs-2311", 201 | "nixpkgs-2405": "nixpkgs-2405", 202 | "nixpkgs-2411": "nixpkgs-2411", 203 | "nixpkgs-unstable": "nixpkgs-unstable", 204 | "old-ghc-nix": "old-ghc-nix", 205 | "stackage": "stackage" 206 | }, 207 | "locked": { 208 | "lastModified": 1742604705, 209 | "narHash": "sha256-VE8OtDFCO5QtzFzjeVCDKpl9R0zKRG88VdFwdUawbgg=", 210 | "owner": "input-output-hk", 211 | "repo": "haskell.nix", 212 | "rev": "cda6af7ad2477e3d8084cdf9d852b440216d9e24", 213 | "type": "github" 214 | }, 215 | "original": { 216 | "owner": "input-output-hk", 217 | "repo": "haskell.nix", 218 | "type": "github" 219 | } 220 | }, 221 | "hls": { 222 | "flake": false, 223 | "locked": { 224 | "lastModified": 1741604408, 225 | "narHash": "sha256-tuq3+Ip70yu89GswZ7DSINBpwRprnWnl6xDYnS4GOsc=", 226 | "owner": "haskell", 227 | "repo": "haskell-language-server", 228 | "rev": "682d6894c94087da5e566771f25311c47e145359", 229 | "type": "github" 230 | }, 231 | "original": { 232 | "owner": "haskell", 233 | "repo": "haskell-language-server", 234 | "type": "github" 235 | } 236 | }, 237 | "hls-1.10": { 238 | "flake": false, 239 | "locked": { 240 | "lastModified": 1680000865, 241 | "narHash": "sha256-rc7iiUAcrHxwRM/s0ErEsSPxOR3u8t7DvFeWlMycWgo=", 242 | "owner": "haskell", 243 | "repo": "haskell-language-server", 244 | "rev": "b08691db779f7a35ff322b71e72a12f6e3376fd9", 245 | "type": "github" 246 | }, 247 | "original": { 248 | "owner": "haskell", 249 | "ref": "1.10.0.0", 250 | "repo": "haskell-language-server", 251 | "type": "github" 252 | } 253 | }, 254 | "hls-2.0": { 255 | "flake": false, 256 | "locked": { 257 | "lastModified": 1687698105, 258 | "narHash": "sha256-OHXlgRzs/kuJH8q7Sxh507H+0Rb8b7VOiPAjcY9sM1k=", 259 | "owner": "haskell", 260 | "repo": "haskell-language-server", 261 | "rev": "783905f211ac63edf982dd1889c671653327e441", 262 | "type": "github" 263 | }, 264 | "original": { 265 | "owner": "haskell", 266 | "ref": "2.0.0.1", 267 | "repo": "haskell-language-server", 268 | "type": "github" 269 | } 270 | }, 271 | "hls-2.2": { 272 | "flake": false, 273 | "locked": { 274 | "lastModified": 1693064058, 275 | "narHash": "sha256-8DGIyz5GjuCFmohY6Fa79hHA/p1iIqubfJUTGQElbNk=", 276 | "owner": "haskell", 277 | "repo": "haskell-language-server", 278 | "rev": "b30f4b6cf5822f3112c35d14a0cba51f3fe23b85", 279 | "type": "github" 280 | }, 281 | "original": { 282 | "owner": "haskell", 283 | "ref": "2.2.0.0", 284 | "repo": "haskell-language-server", 285 | "type": "github" 286 | } 287 | }, 288 | "hls-2.3": { 289 | "flake": false, 290 | "locked": { 291 | "lastModified": 1695910642, 292 | "narHash": "sha256-tR58doOs3DncFehHwCLczJgntyG/zlsSd7DgDgMPOkI=", 293 | "owner": "haskell", 294 | "repo": "haskell-language-server", 295 | "rev": "458ccdb55c9ea22cd5d13ec3051aaefb295321be", 296 | "type": "github" 297 | }, 298 | "original": { 299 | "owner": "haskell", 300 | "ref": "2.3.0.0", 301 | "repo": "haskell-language-server", 302 | "type": "github" 303 | } 304 | }, 305 | "hls-2.4": { 306 | "flake": false, 307 | "locked": { 308 | "lastModified": 1699862708, 309 | "narHash": "sha256-YHXSkdz53zd0fYGIYOgLt6HrA0eaRJi9mXVqDgmvrjk=", 310 | "owner": "haskell", 311 | "repo": "haskell-language-server", 312 | "rev": "54507ef7e85fa8e9d0eb9a669832a3287ffccd57", 313 | "type": "github" 314 | }, 315 | "original": { 316 | "owner": "haskell", 317 | "ref": "2.4.0.1", 318 | "repo": "haskell-language-server", 319 | "type": "github" 320 | } 321 | }, 322 | "hls-2.5": { 323 | "flake": false, 324 | "locked": { 325 | "lastModified": 1701080174, 326 | "narHash": "sha256-fyiR9TaHGJIIR0UmcCb73Xv9TJq3ht2ioxQ2mT7kVdc=", 327 | "owner": "haskell", 328 | "repo": "haskell-language-server", 329 | "rev": "27f8c3d3892e38edaef5bea3870161815c4d014c", 330 | "type": "github" 331 | }, 332 | "original": { 333 | "owner": "haskell", 334 | "ref": "2.5.0.0", 335 | "repo": "haskell-language-server", 336 | "type": "github" 337 | } 338 | }, 339 | "hls-2.6": { 340 | "flake": false, 341 | "locked": { 342 | "lastModified": 1705325287, 343 | "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=", 344 | "owner": "haskell", 345 | "repo": "haskell-language-server", 346 | "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e", 347 | "type": "github" 348 | }, 349 | "original": { 350 | "owner": "haskell", 351 | "ref": "2.6.0.0", 352 | "repo": "haskell-language-server", 353 | "type": "github" 354 | } 355 | }, 356 | "hls-2.7": { 357 | "flake": false, 358 | "locked": { 359 | "lastModified": 1708965829, 360 | "narHash": "sha256-LfJ+TBcBFq/XKoiNI7pc4VoHg4WmuzsFxYJ3Fu+Jf+M=", 361 | "owner": "haskell", 362 | "repo": "haskell-language-server", 363 | "rev": "50322b0a4aefb27adc5ec42f5055aaa8f8e38001", 364 | "type": "github" 365 | }, 366 | "original": { 367 | "owner": "haskell", 368 | "ref": "2.7.0.0", 369 | "repo": "haskell-language-server", 370 | "type": "github" 371 | } 372 | }, 373 | "hls-2.8": { 374 | "flake": false, 375 | "locked": { 376 | "lastModified": 1715153580, 377 | "narHash": "sha256-Vi/iUt2pWyUJlo9VrYgTcbRviWE0cFO6rmGi9rmALw0=", 378 | "owner": "haskell", 379 | "repo": "haskell-language-server", 380 | "rev": "dd1be1beb16700de59e0d6801957290bcf956a0a", 381 | "type": "github" 382 | }, 383 | "original": { 384 | "owner": "haskell", 385 | "ref": "2.8.0.0", 386 | "repo": "haskell-language-server", 387 | "type": "github" 388 | } 389 | }, 390 | "hls-2.9": { 391 | "flake": false, 392 | "locked": { 393 | "lastModified": 1719993701, 394 | "narHash": "sha256-wy348++MiMm/xwtI9M3vVpqj2qfGgnDcZIGXw8sF1sA=", 395 | "owner": "haskell", 396 | "repo": "haskell-language-server", 397 | "rev": "90319a7e62ab93ab65a95f8f2bcf537e34dae76a", 398 | "type": "github" 399 | }, 400 | "original": { 401 | "owner": "haskell", 402 | "ref": "2.9.0.1", 403 | "repo": "haskell-language-server", 404 | "type": "github" 405 | } 406 | }, 407 | "hpc-coveralls": { 408 | "flake": false, 409 | "locked": { 410 | "lastModified": 1607498076, 411 | "narHash": "sha256-8uqsEtivphgZWYeUo5RDUhp6bO9j2vaaProQxHBltQk=", 412 | "owner": "sevanspowell", 413 | "repo": "hpc-coveralls", 414 | "rev": "14df0f7d229f4cd2e79f8eabb1a740097fdfa430", 415 | "type": "github" 416 | }, 417 | "original": { 418 | "owner": "sevanspowell", 419 | "repo": "hpc-coveralls", 420 | "type": "github" 421 | } 422 | }, 423 | "iserv-proxy": { 424 | "flake": false, 425 | "locked": { 426 | "lastModified": 1742121966, 427 | "narHash": "sha256-x4bg4OoKAPnayom0nWc0BmlxgRMMHk6lEPvbiyFBq1s=", 428 | "owner": "stable-haskell", 429 | "repo": "iserv-proxy", 430 | "rev": "e9dc86ed6ad71f0368c16672081c8f26406c3a7e", 431 | "type": "github" 432 | }, 433 | "original": { 434 | "owner": "stable-haskell", 435 | "ref": "iserv-syms", 436 | "repo": "iserv-proxy", 437 | "type": "github" 438 | } 439 | }, 440 | "nixpkgs-2305": { 441 | "locked": { 442 | "lastModified": 1705033721, 443 | "narHash": "sha256-K5eJHmL1/kev6WuqyqqbS1cdNnSidIZ3jeqJ7GbrYnQ=", 444 | "owner": "NixOS", 445 | "repo": "nixpkgs", 446 | "rev": "a1982c92d8980a0114372973cbdfe0a307f1bdea", 447 | "type": "github" 448 | }, 449 | "original": { 450 | "owner": "NixOS", 451 | "ref": "nixpkgs-23.05-darwin", 452 | "repo": "nixpkgs", 453 | "type": "github" 454 | } 455 | }, 456 | "nixpkgs-2311": { 457 | "locked": { 458 | "lastModified": 1719957072, 459 | "narHash": "sha256-gvFhEf5nszouwLAkT9nWsDzocUTqLWHuL++dvNjMp9I=", 460 | "owner": "NixOS", 461 | "repo": "nixpkgs", 462 | "rev": "7144d6241f02d171d25fba3edeaf15e0f2592105", 463 | "type": "github" 464 | }, 465 | "original": { 466 | "owner": "NixOS", 467 | "ref": "nixpkgs-23.11-darwin", 468 | "repo": "nixpkgs", 469 | "type": "github" 470 | } 471 | }, 472 | "nixpkgs-2405": { 473 | "locked": { 474 | "lastModified": 1735564410, 475 | "narHash": "sha256-HB/FA0+1gpSs8+/boEavrGJH+Eq08/R2wWNph1sM1Dg=", 476 | "owner": "NixOS", 477 | "repo": "nixpkgs", 478 | "rev": "1e7a8f391f1a490460760065fa0630b5520f9cf8", 479 | "type": "github" 480 | }, 481 | "original": { 482 | "owner": "NixOS", 483 | "ref": "nixpkgs-24.05-darwin", 484 | "repo": "nixpkgs", 485 | "type": "github" 486 | } 487 | }, 488 | "nixpkgs-2411": { 489 | "locked": { 490 | "lastModified": 1739151041, 491 | "narHash": "sha256-uNszcul7y++oBiyYXjHEDw/AHeLNp8B6pyWOB+RLA/4=", 492 | "owner": "NixOS", 493 | "repo": "nixpkgs", 494 | "rev": "94792ab2a6beaec81424445bf917ca2556fbeade", 495 | "type": "github" 496 | }, 497 | "original": { 498 | "owner": "NixOS", 499 | "ref": "nixpkgs-24.11-darwin", 500 | "repo": "nixpkgs", 501 | "type": "github" 502 | } 503 | }, 504 | "nixpkgs-unstable": { 505 | "locked": { 506 | "lastModified": 1737110817, 507 | "narHash": "sha256-DSenga8XjPaUV5KUFW/i3rNkN7jm9XmguW+qQ1ZJTR4=", 508 | "owner": "NixOS", 509 | "repo": "nixpkgs", 510 | "rev": "041c867bad68dfe34b78b2813028a2e2ea70a23c", 511 | "type": "github" 512 | }, 513 | "original": { 514 | "owner": "NixOS", 515 | "ref": "nixpkgs-unstable", 516 | "repo": "nixpkgs", 517 | "type": "github" 518 | } 519 | }, 520 | "old-ghc-nix": { 521 | "flake": false, 522 | "locked": { 523 | "lastModified": 1631092763, 524 | "narHash": "sha256-sIKgO+z7tj4lw3u6oBZxqIhDrzSkvpHtv0Kki+lh9Fg=", 525 | "owner": "angerman", 526 | "repo": "old-ghc-nix", 527 | "rev": "af48a7a7353e418119b6dfe3cd1463a657f342b8", 528 | "type": "github" 529 | }, 530 | "original": { 531 | "owner": "angerman", 532 | "ref": "master", 533 | "repo": "old-ghc-nix", 534 | "type": "github" 535 | } 536 | }, 537 | "root": { 538 | "inputs": { 539 | "flake-utils": "flake-utils", 540 | "haskellNix": "haskellNix", 541 | "nixpkgs": [ 542 | "haskellNix", 543 | "nixpkgs-unstable" 544 | ] 545 | } 546 | }, 547 | "stackage": { 548 | "flake": false, 549 | "locked": { 550 | "lastModified": 1742515918, 551 | "narHash": "sha256-9tUZlIJJxbzOT1i0lF4o/8g6lxcmbyeqBNgsQr0nCpk=", 552 | "owner": "input-output-hk", 553 | "repo": "stackage.nix", 554 | "rev": "51def33890657fdbbec3d84317507bfb57fe4a2e", 555 | "type": "github" 556 | }, 557 | "original": { 558 | "owner": "input-output-hk", 559 | "repo": "stackage.nix", 560 | "type": "github" 561 | } 562 | }, 563 | "systems": { 564 | "locked": { 565 | "lastModified": 1681028828, 566 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 567 | "owner": "nix-systems", 568 | "repo": "default", 569 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 570 | "type": "github" 571 | }, 572 | "original": { 573 | "owner": "nix-systems", 574 | "repo": "default", 575 | "type": "github" 576 | } 577 | } 578 | }, 579 | "root": "root", 580 | "version": 7 581 | } 582 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "Simplified logging in IO for application writers"; 3 | 4 | inputs = { 5 | nixpkgs.follows = "haskellNix/nixpkgs-unstable"; 6 | haskellNix.url = "github:input-output-hk/haskell.nix"; 7 | flake-utils.url = "github:numtide/flake-utils"; 8 | }; 9 | 10 | outputs = { self, nixpkgs, flake-utils, haskellNix }: 11 | flake-utils.lib.eachDefaultSystem (system: 12 | let 13 | pkgs = import nixpkgs { 14 | inherit system overlays; 15 | inherit (haskellNix) config; 16 | }; 17 | flake = pkgs.logging.flake { 18 | }; 19 | overlays = [ haskellNix.overlay 20 | (final: prev: { 21 | logging = 22 | final.haskell-nix.project' { 23 | src = ./.; 24 | supportHpack = true; 25 | compiler-nix-name = "ghc910"; 26 | shell = { 27 | tools = { 28 | cabal = {}; 29 | haskell-language-server = {}; 30 | # hlint = {}; 31 | ghcid = {}; 32 | }; 33 | buildInputs = with pkgs; [ 34 | pkg-config 35 | ]; 36 | withHoogle = true; 37 | }; 38 | modules = [{ 39 | enableLibraryProfiling = true; 40 | enableProfiling = true; 41 | }]; 42 | }; 43 | }) 44 | ]; 45 | in flake // { 46 | packages.default = flake.packages."logging:lib"; 47 | }); 48 | } 49 | -------------------------------------------------------------------------------- /logging.cabal: -------------------------------------------------------------------------------- 1 | Name: logging 2 | Version: 3.0.6 3 | Synopsis: Simplified logging in IO for application writers. 4 | License-file: LICENSE 5 | License: MIT 6 | Author: John Wiegley, Roy Blankman 7 | Maintainer: riblankman@gmail.com 8 | Build-Type: Simple 9 | Cabal-Version: >=1.10 10 | Category: System 11 | Description: 12 | @logging@ is a wrapper around @fast-logger@ which makes 13 | it easy to log from 'IO'. It provides the following conveniences on top of 14 | those libraries: 15 | . 16 | - A set of shorter functions to type: 'debug', 'log', 'warn', plus others 17 | that flush after each message, or which allow providing a message source 18 | string. 19 | . 20 | - Logging variants of 'error', 'trace' and 'traceShow', called 'errorL', 21 | 'traceL' and 'traceShowL'. These use 'unsafePerformIO' in order to act as 22 | direct replacements, so the usual caveats apply. 23 | . 24 | - A global function, 'setDebugLevel', which uses a global 'IORef' to record 25 | the logging level, saving you from having to carry around the notion of 26 | "verbosity level" in a Reader environment. 27 | . 28 | - A set of "timed" variants, 'timedLog' and 'timedDebug', which report how 29 | long the specified action took to execute in wall-clock time. 30 | 31 | Source-repository head 32 | type: git 33 | location: git://github.com/jwiegley/logging.git 34 | 35 | Library 36 | default-language: Haskell98 37 | ghc-options: -Wall 38 | build-depends: 39 | base >= 3 && < 5 40 | , binary >= 0.5.1.1 41 | , bytestring >= 0.9.2.1 42 | , fast-logger >= 2.1.5 43 | , old-locale >= 1.0.0.5 44 | , time >= 1.4 45 | , monad-control >= 0.3.2.3 46 | , text >= 0.11.3.1 47 | , time-locale-compat >= 0.1.1.0 48 | , transformers >= 0.3.0.0 49 | , lifted-base >= 0.2.2.0 50 | , regex-compat >= 0.95.1 51 | exposed-modules: 52 | Control.Logging 53 | default-extensions: 54 | BangPatterns 55 | FlexibleContexts 56 | -- OverloadedStrings 57 | 58 | test-suite test 59 | hs-source-dirs: test 60 | default-language: Haskell2010 61 | main-is: Main.hs 62 | type: exitcode-stdio-1.0 63 | ghc-options: -Wall -threaded 64 | build-depends: 65 | base 66 | , logging 67 | , unix >= 2.5.1.1 68 | , hspec >= 1.4 69 | default-extensions: 70 | OverloadedStrings 71 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Concurrent 4 | import Control.Exception 5 | import Control.Logging 6 | import Prelude hiding (log) 7 | import Test.Hspec 8 | 9 | tryAny :: IO a -> IO (Either SomeException a) 10 | tryAny = try 11 | 12 | main :: IO () 13 | main = hspec $ 14 | 15 | describe "simple logging" $ do 16 | 17 | it "logs output" $ withStdoutLogging $ do 18 | log "Hello, world!" 19 | warnS "test-suite" "you've been warned" 20 | timedLog "Did a good thing" $ threadDelay 100000 21 | _ <- tryAny $ timedLog "Did a bad thing" $ 22 | threadDelay 100000 >> error "foo" 23 | _ <- tryAny $ errorL "Uh oh" 24 | return () 25 | 26 | it "supports setting log levels" $ do 27 | setLogLevel LevelWarn 28 | 29 | withStdoutLogging $ do 30 | debugS "Set LogLevel test" "This is an unshown debug message" 31 | logS "Set LogLevel test" "This is an unshown info message" 32 | warnS "Set LogLevel test" "This is a shown info message" 33 | _ <- tryAny $ errorSL "Set LogLevel test" "This is a shown error message" 34 | return () 35 | 36 | -- setting the log level back to debug so that following tests run 37 | setLogLevel LevelDebug 38 | 39 | it "supports using debug classes" $ do 40 | setDebugSourceRegex "(foo\\.|baaz).*" 41 | withStdoutLogging $ do 42 | debugS "foo" "This is an unshown debug message" 43 | debugS "foo.bar" "This is a shown debug message" 44 | debugS "baaz.quux" "This is a shown debug message" 45 | debugS "baaz" "This is a shown debug message" 46 | -- checking that non-debug messages aren't filtered 47 | logS "bar" "This is a shown log message" 48 | logS "foo.bar" "This is a shown log message" 49 | warnS "foo" "This is a shown warn message" 50 | --------------------------------------------------------------------------------