@@ -14,6 +14,7 @@ import Control.Applicative
1414import Control.AutoUpdate
1515import Control.Concurrent
1616import Control.Lens
17+import Control.Monad.Catch
1718import Control.Monad.Reader
1819import Data.Aeson (ToJSON (..))
1920import qualified Data.Aeson as A
@@ -26,6 +27,7 @@ import Data.String
2627import Data.String.Conv
2728import Data.Text (Text)
2829import qualified Data.Text as T
30+import qualified Data.Text.Lazy.Builder as B
2931import Data.Time
3032import GHC.Generics hiding (to)
3133import Language.Haskell.TH
@@ -98,6 +100,29 @@ instance ToJSON Severity where
98100 toJSON s = A.String (renderSeverity s)
99101
100102
103+-------------------------------------------------------------------------------
104+-- | Log message with Builder unerneath; use '<>' to concat in O(1).
105+newtype LogStr = LogStr { unLogStr :: B.Builder }
106+ deriving (Generic)
107+
108+instance IsString LogStr where
109+ fromString = LogStr . B.fromString
110+
111+
112+-------------------------------------------------------------------------------
113+-- | Pack any string-like thing into a 'LogMsg'. This will
114+-- automatically work on 'String', 'ByteString, 'Text' and any of the
115+-- lazy variants.
116+logStr :: StringConv a Text => a -> LogStr
117+logStr t = LogStr (B.fromText $ toS t)
118+
119+
120+-------------------------------------------------------------------------------
121+-- | Shorthand for 'logMsg'
122+ls :: StringConv a Text => a -> LogStr
123+ls = logStr
124+
125+
101126-------------------------------------------------------------------------------
102127-- | This has everything each log message will contain.
103128data Item a = Item {
@@ -108,7 +133,7 @@ data Item a = Item {
108133 , itemHost :: HostName
109134 , itemProcess :: ProcessID
110135 , itemPayload :: a
111− , itemMessage :: Text
136+ , itemMessage :: LogStr
112137 , itemTime :: UTCTime
113138 , itemNamespace :: Namespace
114139 , itemLoc :: Maybe Loc
@@ -125,7 +150,7 @@ instance ToJSON a => ToJSON (Item a) where
125150 , "host" A..= itemHost
126151 , "pid" A..= A.String (toS (show itemProcess))
127152 , "data" A..= itemPayload
128− , "msg" A..= itemMessage
153+ , "msg" A..= (B.toLazyText $ unLogStr itemMessage)
129154 , "at" A..= itemTime
130155 , "ns" A..= itemNamespace
131156 , "loc" A..= fmap LocJs itemLoc
@@ -236,6 +261,19 @@ class Katip m where
236261 getLogEnv :: m LogEnv
237262
238263
264+-------------------------------------------------------------------------------
265+-- | A concrete monad you can use to run logging actions.
266+newtype KatipT m a = KatipT { unKatipT :: ReaderT LogEnv m a }
267+ deriving ( Monad, MonadIO, MonadMask, MonadCatch, MonadThrow
268+ , MonadReader LogEnv)
269+
270+
271+-------------------------------------------------------------------------------
272+-- | Execute 'KatipT' on a log env.
273+runKatipT :: LogEnv -> KatipT m a -> m a
274+runKatipT le (KatipT f) = runReaderT f le
275+
276+
239277-------------------------------------------------------------------------------
240278-- | Log with everything, including a source code location. This is
241279-- very low level and you typically can use 'logT' in its place.
@@ -245,7 +283,7 @@ logI
245283 -> Namespace
246284 -> Maybe Loc
247285 -> Severity
248− -> Text
286+ -> LogStr
249287 -> m ()
250288logI a ns loc sev msg = do
251289 LogEnv{..} <- getLogEnv
@@ -274,7 +312,7 @@ logF
274312 -- ^ Specific namespace of the message.
275313 -> Severity
276314 -- ^ Severity of the message
277− -> Text
315+ -> LogStr
278316 -- ^ The log message
279317 -> m ()
280318logF a ns sev msg = logI a ns Nothing sev msg
@@ -286,7 +324,7 @@ logM
286324 :: (Applicative m, MonadIO m, Katip m)
287325 => Namespace
288326 -> Severity
289− -> Text
327+ -> LogStr
290328 -> m ()
291329logM ns sev msg = logF () ns sev msg
292330