git.iko.soy/typeable/katip
on master help sign in
Several minor fixes and tweaks
commitcdb4ee7ac550620b9dd8f32bf7518367afd46d7a authorOzgun Ataman <ozgun.ataman@soostone.com> dateWed 4 Mar 2015, 12:29 (12 years ago) parent5ee7a2f
5 files changed+119−73
compare with master
unifiedsplit
katip/examples/Main.hs+5−5 katip/katip.cabal+29−29 katip/src/Katip.hs+8−2 katip/src/Katip/Core.hs+67−27 katip/src/Katip/Scribes/Handle.hs+10−10
katip/examples/Main.hs+5−5
@@ -4,19 +4,19 @@ module Main where
44
55-------------------------------------------------------------------------------
66import Data.Aeson
7−
87import Data.Text
98-------------------------------------------------------------------------------
109import Katip
10+import Katip.Scribes.Handle
1111-------------------------------------------------------------------------------
1212
1313
1414
1515main :: IO ()
16−main = do
17− logM "example" Info "Easy to emit from IO directly!"
18− logF myContext "example" Info "Here's a more stateful item."
19− $(logT) myContext "example" Info "Here's one with code location."
16+main = runKatipT _ioLogEnv $ do
17+ logM "example" InfoS "Easy to emit from IO directly!"
18+ logF myContext "example" InfoS "Here's a more stateful item."
19+ $(logT) myContext "example" InfoS "Here's one with code location."
2020
2121
2222
katip/katip.cabal+29−29
@@ -28,24 +28,24 @@ library
2828 TemplateHaskell
2929 OverloadedStrings
3030
31− build-depends:
32− base >=4.6 && <4.7
33− , aeson >=0.7 && <0.8
34− , auto-update >= 0.1 && < 0.2
35− , bytestring >= 0.9 && < 0.11
36− , containers >=0.5 && <0.6
37− , exceptions >= 0.5 && < 0.7
38− , hostname >=1.0 && <1.1
39− , lens >=4.2 && <4.7
40− , lens-aeson >= 1.0 && < 1.1
41− , mtl >=2.1 && <2.2
42− , old-locale >= 1.0 && < 1.1
43− , string-conv >= 0.1 && < 0.2
44− , template-haskell >= 2.8 && < 2.10
45− , text >=1.2 && <1.3
46− , time >= 1.2 && < 1.5
47− , unix >= 2.5 && < 2.8
48− , unordered-containers >= 0.2 && < 0.3
31+ build-depends: base >=4.5 && <4.7
32+ , aeson >=0.6 && <0.9
33+ , auto-update >= 0.1 && < 0.2
34+ , bytestring >= 0.9 && < 0.11
35+ , containers >=0.4 && <0.6
36+ , either >= 4 && < 4.4
37+ , exceptions >= 0.5 && < 0.7
38+ , hostname >=1.0 && <1.1
39+ , lens >= 4.4 && <4.8
40+ , lens-aeson < 1.1
41+ , old-locale >= 1.0 && < 1.1
42+ , string-conv >= 0.1 && < 0.2
43+ , template-haskell >= 2.8 && < 2.10
44+ , text >= 0.11 && <1.3
45+ , time >= 1 && < 1.6
46+ , transformers >= 0.3 && < 0.5
47+ , unix >= 2.5 && < 2.8
48+ , unordered-containers >= 0.2 && < 0.3
4949
5050 hs-source-dirs: src
5151 default-language: Haskell2010
@@ -58,14 +58,14 @@ benchmark bench
5858 hs-source-dirs: bench
5959 default-language: Haskell2010
6060 ghc-options: -O2
61− build-depends:
62− base
63− , aeson
64− , blaze-builder
65− , katip
66− , criterion >= 0.8 && < 1.0
67− , criterion-plus
68− , unix
69− , text
70− , time
71− , transformers
61+ build-depends:
62+ base
63+ , aeson
64+ , blaze-builder
65+ , katip
66+ , criterion >= 0.8 && < 1.0
67+ , criterion-plus
68+ , unix
69+ , text
70+ , time
71+ , transformers
katip/src/Katip.hs+8−2
@@ -1,5 +1,9 @@
11module Katip
2− ( module Katip.Scribes.Handle
2+ (
3+
4+ -- * Framework Types
5+
6+ Katip (..)
37 , Namespace (..)
48 , Environment (..)
59 , Severity (..), renderSeverity
@@ -8,6 +12,8 @@ module Katip
812 , PayloadSelection (..)
913 , Scribe (..)
1014 , LogEnv (..)
15+
16+ -- * A Built-in Monad For Logging
1117 , KatipT (..)
1218 , runKatipT
1319
@@ -18,7 +24,7 @@ module Katip
1824
1925 -- * Logging Functions
2026 , LogStr (..)
21− , logStr, ls
27+ , logStr, ls, showLS
2228
2329 , logF
2430 , logM
katip/src/Katip/Core.hs+67−27
@@ -1,5 +1,6 @@
11{-# LANGUAGE DeriveGeneric #-}
22{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE FlexibleInstances #-}
34{-# LANGUAGE GeneralizedNewtypeDeriving #-}
45{-# LANGUAGE MultiParamTypeClasses #-}
56{-# LANGUAGE OverloadedStrings #-}
@@ -14,8 +15,15 @@ import Control.Applicative
1415import Control.AutoUpdate
1516import Control.Concurrent
1617import Control.Lens
18+import Control.Monad
1719import Control.Monad.Catch
18−import Control.Monad.Reader
20+import Control.Monad.IO.Class
21+import Control.Monad.Trans.Class
22+import Control.Monad.Trans.Either
23+import Control.Monad.Trans.Maybe
24+import Control.Monad.Trans.Reader
25+import Control.Monad.Trans.State
26+import Control.Monad.Trans.Writer
1927import Data.Aeson (ToJSON (..))
2028import qualified Data.Aeson as A
2129import Data.Aeson.Lens
@@ -59,14 +67,14 @@ newtype Environment = Environment { getEnvironment :: Text }
5967
6068-------------------------------------------------------------------------------
6169data Severity
62− = Debug -- ^ Debug messages
63− | Info -- ^ Information
64− | Notice -- ^ Normal runtime Conditions
65− | Warning -- ^ General Warnings
66− | Error -- ^ General Errors
67− | Critical -- ^ Severe situations
68− | Alert -- ^ Take immediate action
69− | Emergency -- ^ System is unusable
70+ = DebugS -- ^ Debug messages
71+ | InfoS -- ^ Information
72+ | NoticeS -- ^ Normal runtime Conditions
73+ | WarningS -- ^ General Warnings
74+ | ErrorS -- ^ General Errors
75+ | CriticalS -- ^ Severe situations
76+ | AlertS -- ^ Take immediate action
77+ | EmergencyS -- ^ System is unusable
7078 deriving (Eq, Ord, Show, Read, Generic)
7179
7280
@@ -85,14 +93,14 @@ data Verbosity = V0 | V1 | V2 | V3
8593-------------------------------------------------------------------------------
8694renderSeverity :: Severity -> Text
8795renderSeverity s = case s of
88− Debug -> "Debug"
89− Info -> "Info"
90− Notice -> "Notice"
91− Warning -> "Warning"
92− Error -> "Error"
93− Critical -> "Critical"
94− Alert -> "Alert"
95− Emergency -> "Emergency"
96+ DebugS -> "Debug"
97+ InfoS -> "Info"
98+ NoticeS -> "Notice"
99+ WarningS -> "Warning"
100+ ErrorS -> "Error"
101+ CriticalS -> "Critical"
102+ AlertS -> "Alert"
103+ EmergencyS -> "Emergency"
96104
97105
98106-------------------------------------------------------------------------------
@@ -108,6 +116,9 @@ newtype LogStr = LogStr { unLogStr :: B.Builder }
108116instance IsString LogStr where
109117 fromString = LogStr . B.fromString
110118
119+instance Monoid LogStr where
120+ mappend (LogStr a) (LogStr b) = LogStr (a `mappend` b)
121+ mempty = LogStr mempty
111122
112123-------------------------------------------------------------------------------
113124-- | Pack any string-like thing into a 'LogMsg'. This will
@@ -123,6 +134,11 @@ ls :: StringConv a Text => a -> LogStr
123134ls = logStr
124135
125136
137+-------------------------------------------------------------------------------
138+showLS :: Show a => a -> LogStr
139+showLS = ls . show
140+
141+
126142-------------------------------------------------------------------------------
127143-- | This has everything each log message will contain.
128144data Item a = Item {
@@ -263,11 +279,35 @@ class MonadIO m => Katip m where
263279 getLogEnv :: m LogEnv
264280
265281
282+instance Katip m => Katip (ReaderT s m) where
283+ getLogEnv = lift getLogEnv
284+
285+
286+instance Katip m => Katip (EitherT s m) where
287+ getLogEnv = lift getLogEnv
288+
289+
290+instance Katip m => Katip (MaybeT m) where
291+ getLogEnv = lift getLogEnv
292+
293+
294+instance Katip m => Katip (StateT s m) where
295+ getLogEnv = lift getLogEnv
296+
297+
298+instance (Katip m, Monoid s) => Katip (WriterT s m) where
299+ getLogEnv = lift getLogEnv
300+
301+
266302-------------------------------------------------------------------------------
267303-- | A concrete monad you can use to run logging actions.
268304newtype KatipT m a = KatipT { unKatipT :: ReaderT LogEnv m a }
269− deriving ( Monad, MonadIO, MonadMask, MonadCatch, MonadThrow
270− , MonadReader LogEnv)
305+ deriving ( Functor, Applicative, Monad, MonadIO
306+ , MonadMask, MonadCatch, MonadThrow )
307+
308+
309+instance MonadIO m => Katip (KatipT m) where
310+ getLogEnv = KatipT ask
271311
272312
273313-------------------------------------------------------------------------------
@@ -345,14 +385,14 @@ instance TH.Lift Verbosity where
345385
346386
347387instance TH.Lift Severity where
348− lift Debug = [| Debug |]
349− lift Info = [| Info |]
350− lift Notice = [| Notice |]
351− lift Warning = [| Warning |]
352− lift Error = [| Error |]
353− lift Critical = [| Critical |]
354− lift Alert = [| Alert |]
355− lift Emergency = [| Emergency |]
388+ lift DebugS = [| DebugS |]
389+ lift InfoS = [| InfoS |]
390+ lift NoticeS = [| NoticeS |]
391+ lift WarningS = [| WarningS |]
392+ lift ErrorS = [| ErrorS |]
393+ lift CriticalS = [| CriticalS |]
394+ lift AlertS = [| AlertS |]
395+ lift EmergencyS = [| EmergencyS |]
356396
357397
358398-- | Lift a location into an Exp.
katip/src/Katip/Scribes/Handle.hs+10−10
@@ -76,11 +76,11 @@ formatItem withColor verb Item{..} =
7676 nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime
7777 ks = map brackets $ getKeys verb itemPayload
7878 renderSeverity' s = case s of
79− Emergency -> red $ renderSeverity s
80− Alert -> red $ renderSeverity s
81− Critical -> red $ renderSeverity s
82− Error -> red $ renderSeverity s
83− Warning -> yellow $ renderSeverity s
79+ EmergencyS -> red $ renderSeverity s
80+ AlertS -> red $ renderSeverity s
81+ CriticalS -> red $ renderSeverity s
82+ ErrorS -> red $ renderSeverity s
83+ WarningS -> yellow $ renderSeverity s
8484 _ -> renderSeverity s
8585 red = colorize "31"
8686 yellow = colorize "33"
@@ -94,12 +94,12 @@ formatItem withColor verb Item{..} =
9494_ioLogEnv :: LogEnv
9595_ioLogEnv = unsafePerformIO $ do
9696 le <- initLogEnv "io" "io"
97− lh <- mkHandleScribe ColorIfTerminal stdout Debug V3
97+ lh <- mkHandleScribe ColorIfTerminal stdout DebugS V3
9898 return $ registerScribe "stdout" lh le
9999{-# NOINLINE _ioLogEnv #-}
100100
101101
102−-------------------------------------------------------------------------------
103−-- | A default IO instance to make prototype development easy. User
104−-- your own 'Monad' for production.
105−instance Katip IO where getLogEnv = return _ioLogEnv
102+-- -------------------------------------------------------------------------------
103+-- -- | A default IO instance to make prototype development easy. User
104+-- -- your own 'Monad' for production.
105+-- instance Katip IO where getLogEnv = return _ioLogEnv