git.iko.soy/typeable/katip
on master help sign in
Several minor fixes and tweaks
cdb4ee7Ozgun Ataman
katip/examples/Main.hs+5−5
compare with master
unifiedsplit
@@ -4,19 +4,19 @@ module Main where
4
4
5-------------------------------------------------------------------------------
5-------------------------------------------------------------------------------
6import Data.Aeson
6import Data.Aeson
7−
8import Data.Text
7import Data.Text
9-------------------------------------------------------------------------------
8-------------------------------------------------------------------------------
10import Katip
9import Katip
10+import Katip.Scribes.Handle
11-------------------------------------------------------------------------------
11-------------------------------------------------------------------------------
12
12
13
13
14
14
15main :: IO ()
15main :: IO ()
16−main = do
16+main = runKatipT _ioLogEnv $ do
17− logM "example" Info "Easy to emit from IO directly!"
17+ logM "example" InfoS "Easy to emit from IO directly!"
18− logF myContext "example" Info "Here's a more stateful item."
18+ logF myContext "example" InfoS "Here's a more stateful item."
19− $(logT) myContext "example" Info "Here's one with code location."
19+ $(logT) myContext "example" InfoS "Here's one with code location."
20
20
21
21
22
22
katip/katip.cabal+29−29
@@ -28,24 +28,24 @@ library
28 TemplateHaskell
28 TemplateHaskell
29 OverloadedStrings
29 OverloadedStrings
30
30
31− build-depends:
31+ build-depends: base >=4.5 && <4.7
32− base >=4.6 && <4.7
33− , aeson >=0.7 && <0.8
32+ , aeson >=0.6 && <0.9
34− , auto-update >= 0.1 && < 0.2
33+ , auto-update >= 0.1 && < 0.2
35− , bytestring >= 0.9 && < 0.11
34+ , bytestring >= 0.9 && < 0.11
36− , containers >=0.5 && <0.6
35+ , containers >=0.4 && <0.6
36+ , either >= 4 && < 4.4
37− , exceptions >= 0.5 && < 0.7
37+ , exceptions >= 0.5 && < 0.7
38− , hostname >=1.0 && <1.1
38+ , hostname >=1.0 && <1.1
39− , lens >=4.2 && <4.7
39+ , lens >= 4.4 && <4.8
40− , lens-aeson >= 1.0 && < 1.1
40+ , lens-aeson < 1.1
41− , mtl >=2.1 && <2.2
42− , old-locale >= 1.0 && < 1.1
41+ , old-locale >= 1.0 && < 1.1
43− , string-conv >= 0.1 && < 0.2
42+ , string-conv >= 0.1 && < 0.2
44− , template-haskell >= 2.8 && < 2.10
43+ , template-haskell >= 2.8 && < 2.10
45− , text >=1.2 && <1.3
44+ , text >= 0.11 && <1.3
46− , time >= 1.2 && < 1.5
45+ , time >= 1 && < 1.6
46+ , transformers >= 0.3 && < 0.5
47− , unix >= 2.5 && < 2.8
47+ , unix >= 2.5 && < 2.8
48− , unordered-containers >= 0.2 && < 0.3
48+ , unordered-containers >= 0.2 && < 0.3
49
49
50 hs-source-dirs: src
50 hs-source-dirs: src
51 default-language: Haskell2010
51 default-language: Haskell2010
@@ -58,14 +58,14 @@ benchmark bench
58 hs-source-dirs: bench
58 hs-source-dirs: bench
59 default-language: Haskell2010
59 default-language: Haskell2010
60 ghc-options: -O2
60 ghc-options: -O2
61− build-depends:
61+ build-depends:
62− base
62+ base
63− , aeson
63+ , aeson
64− , blaze-builder
64+ , blaze-builder
65− , katip
65+ , katip
66− , criterion >= 0.8 && < 1.0
66+ , criterion >= 0.8 && < 1.0
67− , criterion-plus
67+ , criterion-plus
68− , unix
68+ , unix
69− , text
69+ , text
70− , time
70+ , time
71− , transformers
71+ , transformers
katip/src/Katip.hs+8−2
@@ -1,5 +1,9 @@
1module Katip
1module Katip
2− ( module Katip.Scribes.Handle
2+ (
3+
4+ -- * Framework Types
5+
6+ Katip (..)
3 , Namespace (..)
7 , Namespace (..)
4 , Environment (..)
8 , Environment (..)
5 , Severity (..), renderSeverity
9 , Severity (..), renderSeverity
@@ -8,6 +12,8 @@ module Katip
8 , PayloadSelection (..)
12 , PayloadSelection (..)
9 , Scribe (..)
13 , Scribe (..)
10 , LogEnv (..)
14 , LogEnv (..)
15+
16+ -- * A Built-in Monad For Logging
11 , KatipT (..)
17 , KatipT (..)
12 , runKatipT
18 , runKatipT
13
19
@@ -18,7 +24,7 @@ module Katip
18
24
19 -- * Logging Functions
25 -- * Logging Functions
20 , LogStr (..)
26 , LogStr (..)
21− , logStr, ls
27+ , logStr, ls, showLS
22
28
23 , logF
29 , logF
24 , logM
30 , logM
katip/src/Katip/Core.hs+67−27
@@ -1,5 +1,6 @@
1{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE OverloadedStrings #-}
@@ -14,8 +15,15 @@ import Control.Applicative
14import Control.AutoUpdate
15import Control.AutoUpdate
15import Control.Concurrent
16import Control.Concurrent
16import Control.Lens
17import Control.Lens
18+import Control.Monad
17import Control.Monad.Catch
19import 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
19import Data.Aeson (ToJSON (..))
27import Data.Aeson (ToJSON (..))
20import qualified Data.Aeson as A
28import qualified Data.Aeson as A
21import Data.Aeson.Lens
29import Data.Aeson.Lens
@@ -59,14 +67,14 @@ newtype Environment = Environment { getEnvironment :: Text }
59
67
60-------------------------------------------------------------------------------
68-------------------------------------------------------------------------------
61data Severity
69data Severity
62− = Debug -- ^ Debug messages
70+ = DebugS -- ^ Debug messages
63− | Info -- ^ Information
71+ | InfoS -- ^ Information
64− | Notice -- ^ Normal runtime Conditions
72+ | NoticeS -- ^ Normal runtime Conditions
65− | Warning -- ^ General Warnings
73+ | WarningS -- ^ General Warnings
66− | Error -- ^ General Errors
74+ | ErrorS -- ^ General Errors
67− | Critical -- ^ Severe situations
75+ | CriticalS -- ^ Severe situations
68− | Alert -- ^ Take immediate action
76+ | AlertS -- ^ Take immediate action
69− | Emergency -- ^ System is unusable
77+ | EmergencyS -- ^ System is unusable
70 deriving (Eq, Ord, Show, Read, Generic)
78 deriving (Eq, Ord, Show, Read, Generic)
71
79
72
80
@@ -85,14 +93,14 @@ data Verbosity = V0 | V1 | V2 | V3
85-------------------------------------------------------------------------------
93-------------------------------------------------------------------------------
86renderSeverity :: Severity -> Text
94renderSeverity :: Severity -> Text
87renderSeverity s = case s of
95renderSeverity s = case s of
88− Debug -> "Debug"
96+ DebugS -> "Debug"
89− Info -> "Info"
97+ InfoS -> "Info"
90− Notice -> "Notice"
98+ NoticeS -> "Notice"
91− Warning -> "Warning"
99+ WarningS -> "Warning"
92− Error -> "Error"
100+ ErrorS -> "Error"
93− Critical -> "Critical"
101+ CriticalS -> "Critical"
94− Alert -> "Alert"
102+ AlertS -> "Alert"
95− Emergency -> "Emergency"
103+ EmergencyS -> "Emergency"
96
104
97
105
98-------------------------------------------------------------------------------
106-------------------------------------------------------------------------------
@@ -108,6 +116,9 @@ newtype LogStr = LogStr { unLogStr :: B.Builder }
108instance IsString LogStr where
116instance IsString LogStr where
109 fromString = LogStr . B.fromString
117 fromString = LogStr . B.fromString
110
118
119+instance Monoid LogStr where
120+ mappend (LogStr a) (LogStr b) = LogStr (a `mappend` b)
121+ mempty = LogStr mempty
111
122
112-------------------------------------------------------------------------------
123-------------------------------------------------------------------------------
113-- | Pack any string-like thing into a 'LogMsg'. This will
124-- | Pack any string-like thing into a 'LogMsg'. This will
@@ -123,6 +134,11 @@ ls :: StringConv a Text => a -> LogStr
123ls = logStr
134ls = logStr
124
135
125
136
137+-------------------------------------------------------------------------------
138+showLS :: Show a => a -> LogStr
139+showLS = ls . show
140+
141+
126-------------------------------------------------------------------------------
142-------------------------------------------------------------------------------
127-- | This has everything each log message will contain.
143-- | This has everything each log message will contain.
128data Item a = Item {
144data Item a = Item {
@@ -263,11 +279,35 @@ class MonadIO m => Katip m where
263 getLogEnv :: m LogEnv
279 getLogEnv :: m LogEnv
264
280
265
281
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+
266-------------------------------------------------------------------------------
302-------------------------------------------------------------------------------
267-- | A concrete monad you can use to run logging actions.
303-- | A concrete monad you can use to run logging actions.
268newtype KatipT m a = KatipT { unKatipT :: ReaderT LogEnv m a }
304newtype KatipT m a = KatipT { unKatipT :: ReaderT LogEnv m a }
305+ deriving ( Functor, Applicative, Monad, MonadIO
269− deriving ( Monad, MonadIO, MonadMask, MonadCatch, MonadThrow
306+ , MonadMask, MonadCatch, MonadThrow )
270− , MonadReader LogEnv)
307+
308+
309+instance MonadIO m => Katip (KatipT m) where
310+ getLogEnv = KatipT ask
271
311
272
312
273-------------------------------------------------------------------------------
313-------------------------------------------------------------------------------
@@ -345,14 +385,14 @@ instance TH.Lift Verbosity where
345
385
346
386
347instance TH.Lift Severity where
387instance TH.Lift Severity where
348− lift Debug = [| Debug |]
388+ lift DebugS = [| DebugS |]
349− lift Info = [| Info |]
389+ lift InfoS = [| InfoS |]
350− lift Notice = [| Notice |]
390+ lift NoticeS = [| NoticeS |]
351− lift Warning = [| Warning |]
391+ lift WarningS = [| WarningS |]
352− lift Error = [| Error |]
392+ lift ErrorS = [| ErrorS |]
353− lift Critical = [| Critical |]
393+ lift CriticalS = [| CriticalS |]
354− lift Alert = [| Alert |]
394+ lift AlertS = [| AlertS |]
355− lift Emergency = [| Emergency |]
395+ lift EmergencyS = [| EmergencyS |]
356
396
357
397
358-- | Lift a location into an Exp.
398-- | Lift a location into an Exp.
katip/src/Katip/Scribes/Handle.hs+10−10
@@ -76,11 +76,11 @@ formatItem withColor verb Item{..} =
76 nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime
76 nowStr = fromString $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" itemTime
77 ks = map brackets $ getKeys verb itemPayload
77 ks = map brackets $ getKeys verb itemPayload
78 renderSeverity' s = case s of
78 renderSeverity' s = case s of
79− Emergency -> red $ renderSeverity s
79+ EmergencyS -> red $ renderSeverity s
80− Alert -> red $ renderSeverity s
80+ AlertS -> red $ renderSeverity s
81− Critical -> red $ renderSeverity s
81+ CriticalS -> red $ renderSeverity s
82− Error -> red $ renderSeverity s
82+ ErrorS -> red $ renderSeverity s
83− Warning -> yellow $ renderSeverity s
83+ WarningS -> yellow $ renderSeverity s
84 _ -> renderSeverity s
84 _ -> renderSeverity s
85 red = colorize "31"
85 red = colorize "31"
86 yellow = colorize "33"
86 yellow = colorize "33"
@@ -94,12 +94,12 @@ formatItem withColor verb Item{..} =
94_ioLogEnv :: LogEnv
94_ioLogEnv :: LogEnv
95_ioLogEnv = unsafePerformIO $ do
95_ioLogEnv = unsafePerformIO $ do
96 le <- initLogEnv "io" "io"
96 le <- initLogEnv "io" "io"
97− lh <- mkHandleScribe ColorIfTerminal stdout Debug V3
97+ lh <- mkHandleScribe ColorIfTerminal stdout DebugS V3
98 return $ registerScribe "stdout" lh le
98 return $ registerScribe "stdout" lh le
99{-# NOINLINE _ioLogEnv #-}
99{-# NOINLINE _ioLogEnv #-}
100
100
101
101
102−-------------------------------------------------------------------------------
102+-- -------------------------------------------------------------------------------
103−-- | A default IO instance to make prototype development easy. User
103+-- -- | A default IO instance to make prototype development easy. User
104−-- your own 'Monad' for production.
104+-- -- your own 'Monad' for production.
105−instance Katip IO where getLogEnv = return _ioLogEnv
105+-- instance Katip IO where getLogEnv = return _ioLogEnv