logging-effect-extra-file (empty) → 1.0.0

raw patch · 9 files changed

+448/−0 lines, 9 filesdep +basedep +logging-effectdep +logging-effect-extra-filesetup-changed

Dependencies added: base, logging-effect, logging-effect-extra-file, template-haskell, wl-pprint-text

Files

• CHANGELOG.md +5/−0
• LICENSE.md +23/−0
• README.md +48/−0
• Setup.hs +4/−0
• executable/log-file-and-severity.hs +27/−0
• executable/log-file.hs +27/−0
• library/Control/Monad/Log/Extra/File.hs +211/−0
• logging-effect-extra-file.cabal +62/−0
• package.yaml +41/−0

@@ -0,0 +1,5 @@+# Change log++## 1.0.0++Initial release

@@ -0,0 +1,23 @@+[The MIT License (MIT)][]++Copyright (c) 2017 Jason Shipman++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.++[The MIT License (MIT)]: https://opensource.org/licenses/MIT

@@ -0,0 +1,48 @@+# [logging-effect-extra-file][]++## Synopsis++```haskell+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++import Control.Monad.Log (MonadLog, WithSeverity)+import qualified Control.Monad.Log as Log+import Control.Monad.Log.Extra.File (WithFile)+import qualified Control.Monad.Log.Extra.File as Log+import qualified System.IO as IO+import Text.PrettyPrint.Leijen.Text (Doc)++app :: MonadLog (WithSeverity (WithFile Doc)) m => m ()+app = do+  $(Log.logEmergencyTH) "GAH! All systems are down!!!"+  $(Log.logAlertTH) "Red alert!"+  $(Log.logCriticalTH) "Critical hit!"+  $(Log.logErrorTH) "Errors abound!"+  $(Log.logWarningTH) "Cargo number 2331 has commandeered the vessel"+  $(Log.logNoticeTH) "Heads up, but it's no biggie."+  $(Log.logInformationalTH) "Does anyone read these?"+  $(Log.logDebugTH) "Sleuthing with log messages..."++main :: IO ()+main = Log.withFDHandler Log.defaultBatchingOptions IO.stdout 0.4 80 $ \stdoutHandler ->+  Log.runLoggingT app (stdoutHandler . Log.renderWithSeverity (Log.renderWithFile id))+```++## Usage via `stack`++``` sh+# Build the project.+stack build++# Run the `log-file-and-severity` example+stack exec log-file-and-severity++# Run the `log-file` example+stack exec log-file+```++[logging-effect-extra-file]: https://github.com/jship/logging-effect-extra

@@ -0,0 +1,4 @@+import qualified Distribution.Simple++main :: IO ()+main = Distribution.Simple.defaultMain

@@ -0,0 +1,27 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++import Control.Monad.Log (MonadLog, WithSeverity)+import qualified Control.Monad.Log as Log+import Control.Monad.Log.Extra.File (WithFile)+import qualified Control.Monad.Log.Extra.File as Log+import qualified System.IO as IO+import Text.PrettyPrint.Leijen.Text (Doc)++app :: MonadLog (WithSeverity (WithFile Doc)) m => m ()+app = do+  $(Log.logEmergencyTH) "GAH! All systems are down!!!"+  $(Log.logAlertTH) "Red alert!"+  $(Log.logCriticalTH) "Critical hit!"+  $(Log.logErrorTH) "Errors abound!"+  $(Log.logWarningTH) "Cargo number 2331 has commandeered the vessel"+  $(Log.logNoticeTH) "Heads up, but it's no biggie."+  $(Log.logInformationalTH) "Does anyone read these?"+  $(Log.logDebugTH) "Sleuthing with log messages..."++main :: IO ()+main = Log.withFDHandler Log.defaultBatchingOptions IO.stdout 0.4 80 $ \stdoutHandler ->+  Log.runLoggingT app (stdoutHandler . Log.renderWithSeverity (Log.renderWithFile id))

@@ -0,0 +1,27 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++import Control.Monad.Log (MonadLog)+import qualified Control.Monad.Log as Log+import Control.Monad.Log.Extra.File (WithFile)+import qualified Control.Monad.Log.Extra.File as Log+import qualified System.IO as IO+import Text.PrettyPrint.Leijen.Text (Doc)++app :: MonadLog (WithFile Doc) m => m ()+app = do+  $(Log.logMessageTH) "GAH! All systems are down!!!"+  $(Log.logMessageTH) "Red alert!"+  $(Log.logMessageTH) "Critical hit!"+  $(Log.logMessageTH) "Errors abound!"+  $(Log.logMessageTH) "Cargo number 2331 has commandeered the vessel"+  $(Log.logMessageTH) "Heads up, but it's no biggie."+  $(Log.logMessageTH) "Does anyone read these?"+  $(Log.logMessageTH) "Sleuthing with log messages..."++main :: IO ()+main = Log.withFDHandler Log.defaultBatchingOptions IO.stdout 0.4 80 $ \stdoutHandler ->+  Log.runLoggingT app (stdoutHandler . Log.renderWithFile id)

@@ -0,0 +1,211 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++module Control.Monad.Log.Extra.File+  ( -- * Getting Started+    -- $intro++    -- ** Quickstart using file info and severity+    -- $quickStartFileInfoAndSeverity++    -- ** Quickstart using only file info+    -- $quickStartFileInfo++    -- * Convenience logging combinators (TH)+    -- $convenience++    -- ** With severity+    logEmergencyTH+  , logAlertTH+  , logCriticalTH+  , logErrorTH+  , logWarningTH+  , logNoticeTH+  , logInformationalTH+  , logDebugTH+    -- ** Without severity+  , logMessageTH++    -- * Message transformers+    -- ** File info+  , WithFile(..)+  , renderWithFile++    -- * Utilities+  , logSeverityMessageTH+  , liftLoc++    -- * Re-exports+  , Loc(..)+  ) where++import Control.Monad.Log (WithSeverity(..), Severity(..))+import qualified Control.Monad.Log as Log+import Language.Haskell.TH (Exp, Loc(..), Q)+import Language.Haskell.TH.Syntax (Lift(lift))+import qualified Language.Haskell.TH.Syntax as TH+import Text.PrettyPrint.Leijen.Text (Doc)+import qualified Text.PrettyPrint.Leijen.Text as Pretty++-- | Generates a function that logs an 'Emergency' message with info from the+-- source file.+--+-- > $(logEmergencyTH) "GAH! All systems are down!!!"+logEmergencyTH :: Q Exp+logEmergencyTH = logSeverityMessageTH Emergency++-- | Generates a function that logs an 'Alert' message with info from the+-- source file.+--+-- > $(logAlertTH) "Red alert!"+logAlertTH :: Q Exp+logAlertTH = logSeverityMessageTH Alert++-- | Generates a function that logs a 'Critical' message with info from the+-- source file.+--+-- > $(logCriticalTH) "Critical hit!"+logCriticalTH :: Q Exp+logCriticalTH = logSeverityMessageTH Critical++-- | Generates a function that logs an 'Error' message with info from the+-- source file.+--+-- > $(logErrorTH) "Errors abound!"+logErrorTH :: Q Exp+logErrorTH = logSeverityMessageTH Error++-- | Generates a function that logs a 'Warning' message with info from the+-- source file.+--+-- > $(logWarningTH) "Cargo number 2331 has commandeered the vessel"+logWarningTH :: Q Exp+logWarningTH = logSeverityMessageTH Warning++-- | Generates a function that logs a 'Notice' message with info from the+-- source file.+--+-- > $(logNoticeTH) "Heads up, but it's no biggie."+logNoticeTH :: Q Exp+logNoticeTH = logSeverityMessageTH Notice++-- | Generates a function that logs an 'Informational' message with info from the+-- source file.+--+-- > $(logInformationalTH) "Does anyone read these?"+logInformationalTH :: Q Exp+logInformationalTH = logSeverityMessageTH Informational++-- | Generates a function that logs a 'Debug' message with info from the+-- source file.+--+-- > $(logDebugTH) "Sleuthing with log messages..."+logDebugTH :: Q Exp+logDebugTH = logSeverityMessageTH Debug++-- | Generates a function that logs a message with info from the+-- source file.+--+-- > $(logMessageTH) "Burn after reading."+logMessageTH :: Q Exp+logMessageTH = [|Log.logMessage . WithFile $(TH.qLocation >>= liftLoc)|]++--------------------------------------------------------------------------------+-- | Add \"File\" information to a log message.+data WithFile a = WithFile+  { msgLoc      :: Loc -- ^ Retrieve the file location info.+  , discardFile :: a   -- ^ View the underlying message.+  } deriving (Eq, Ord, Show, Functor, Traversable, Foldable) -- no Read instance (Loc)++-- | Given a way to render the underlying message @a@, render a message with its+-- file info.+--+-- >>> let loc = Loc "SomeFile.hs" "some-package" "SomeModule" (1, 1) (1, 1)+-- >>> renderWithFile id (WithFile loc "Some message")+-- [SomeModule:1] Some message+renderWithFile :: (a -> Doc) -> (WithFile a -> Doc)+renderWithFile k (WithFile (Loc {loc_module, loc_start}) a) = result where+  result = Pretty.brackets fileInfo Pretty.<+> rest+  fileInfo = Pretty.hcat (Pretty.punctuate Pretty.colon fileInfoList)+  fileInfoList = [Pretty.pretty loc_module, Pretty.pretty (fst loc_start)]+  rest = Pretty.align (k a)++-- | Generates a function that logs a message with the given 'Severity' and+-- info from the source file.+logSeverityMessageTH :: Severity -> Q Exp+logSeverityMessageTH severity =+  [|Log.logMessage . WithSeverity $(lift severity)+                   . WithFile $(TH.qLocation >>= liftLoc)|]++-- | Lift a location into an 'Exp'.+liftLoc :: Loc -> Q Exp+liftLoc (Loc {loc_filename, loc_package, loc_module, loc_start, loc_end}) =+  [|Loc $(lift loc_filename)+        $(lift loc_package)+        $(lift loc_module)+        ($(lift (fst loc_start)), $(lift (snd loc_start)))+        ($(lift (fst loc_end)), $(lift (snd loc_end)))|]++instance Lift Severity where+  lift Emergency     = [|Emergency|]+  lift Alert         = [|Alert|]+  lift Critical      = [|Critical|]+  lift Error         = [|Error|]+  lift Warning       = [|Warning|]+  lift Notice        = [|Notice|]+  lift Informational = [|Informational|]+  lift Debug         = [|Debug|]++{- $intro++@logging-effect-extra-file@ supplements [logging-effect](https://github.com/ocharles/logging-effect)+with TH splices that capture file information.++-}++{- $quickStartFileInfo++@+testAppFileOnly :: 'Log.MonadLog' ('WithFile' 'Pretty.Doc') m => m ()+testAppFileOnly = $('logMessageTH') "Heyo!!!"+@++-}++{- $quickStartFileInfoAndSeverity++@+testAppFileAndSeverity :: 'Log.MonadLog' ('WithSeverity' ('WithFile' 'Doc')) m => m ()+testAppFileAndSeverity = do+  $('logEmergencyTH') "GAH! All systems are down!!!"+  $('logAlertTH') "Red alert!"+  $('logCriticalTH') "Critical hit!"+  $('logErrorTH') "Errors abound!"+  $('logWarningTH') "Cargo number 2331 has commandeered the vessel"+  $('logNoticeTH') "Heads up, but it's no biggie."+  $('logInformationalTH') "Does anyone read these?"+  $('logDebugTH') "Sleuthing with log messages..."+@++-}++{- $convenience++@logging-effect-extra-file@ provides combinators for:++* adding file info to messages (module name and line number)+* adding both file info and severity to messages++In the former case, 'WithFile' will be at the outer-most level of your log+message stack.  In the latter case, 'WithSeverity' will be at the outer-most+level of your log message stack, wrapping 'WithFile'.++The package makes no assumptions on what is inside your log messages though.+There is a @logXTH@ combinator for each level in 'Severity'.++-}

@@ -0,0 +1,62 @@+-- This file has been generated from package.yaml by hpack version 0.17.1.+--+-- see: https://github.com/sol/hpack++name:           logging-effect-extra-file+version:        1.0.0+synopsis:       TH splices to augment log messages with file info+description:    TH splices to augment log messages with file info.+category:       Other+homepage:       https://github.com/jship/logging-effect-extra#readme+bug-reports:    https://github.com/jship/logging-effect-extra/issues+maintainer:     Jason Shipman+license:        MIT+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    CHANGELOG.md+    LICENSE.md+    package.yaml+    README.md++source-repository head+  type: git+  location: https://github.com/jship/logging-effect-extra++library+  hs-source-dirs:+      library+  ghc-options: -Wall+  build-depends:+      base >=4.8 && <4.11+    , logging-effect >= 1.1.0 && <1.3+    , wl-pprint-text >=1.1.0.4 && <1.2+    , template-haskell+  exposed-modules:+      Control.Monad.Log.Extra.File+  default-language: Haskell2010++executable log-file+  main-is: log-file.hs+  hs-source-dirs:+      executable+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base >=4.8 && <4.11+    , logging-effect >= 1.1.0 && <1.3+    , wl-pprint-text >=1.1.0.4 && <1.2+    , logging-effect-extra-file+  default-language: Haskell2010++executable log-file-and-severity+  main-is: log-file-and-severity.hs+  hs-source-dirs:+      executable+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base >=4.8 && <4.11+    , logging-effect >= 1.1.0 && <1.3+    , wl-pprint-text >=1.1.0.4 && <1.2+    , logging-effect-extra-file+  default-language: Haskell2010

@@ -0,0 +1,41 @@+category: Other+dependencies:+- base >=4.8 && <4.11+- logging-effect >= 1.1.0 && <1.3+- wl-pprint-text >=1.1.0.4 && <1.2+description: TH splices to augment log messages with file info.+executables:+  log-file:+    dependencies:+    - logging-effect-extra-file+    ghc-options:+    - -rtsopts+    - -threaded+    - -with-rtsopts=-N+    main: log-file.hs+    source-dirs: executable+  log-file-and-severity:+    dependencies:+    - logging-effect-extra-file+    ghc-options:+    - -rtsopts+    - -threaded+    - -with-rtsopts=-N+    main: log-file-and-severity.hs+    source-dirs: executable+extra-source-files:+- CHANGELOG.md+- LICENSE.md+- package.yaml+- README.md+ghc-options: -Wall+github: jship/logging-effect-extra+library:+  dependencies:+  - template-haskell+  source-dirs: library+license: MIT+maintainer: Jason Shipman+name: logging-effect-extra-file+synopsis: TH splices to augment log messages with file info+version: '1.0.0'