-
Notifications
You must be signed in to change notification settings - Fork 1
/
event.clj
168 lines (135 loc) · 5.84 KB
/
event.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
(ns active.clojure.logger.event
"Facilities for logging events."
(:require [clojure.string :as string]
[active.clojure.logger.timbre :as timbre]
[active.clojure.logger.internal :as internal]
[active.clojure.monad :as monad]
[active.clojure.record :refer [define-record-type]]))
;;;; Configuration
(def set-global-log-events-config! timbre/set-global-timbre-config!)
(def set-global-log-events-config-from-map! timbre/set-global-timbre-config-from-map!)
;;;; Data definition and DSL
(define-record-type ^:no-doc LogEvent
(^{:doc "Log an event.
`level` must be one of `[:trace :debug :info :warn :error :fatal :report]`."}
make-log-event level origin vargs-delay map)
log-event?
[level log-event-level
origin log-event-origin
^{:doc "Delayed seq of arguments to log; throwable may be first."}
vargs-delay log-event-vargs-delay
^{:doc "Map with more data or `nil`. The context is a map that is merged
with the log context that's already active, if present."}
map log-event-map])
(define-record-type ^:no-doc LogExceptionEvent
(^{:doc "Log an exception event.
`level` must be one of `[:trace :debug :info :warn :error :fatal :report]`."}
make-log-exception-event level origin vargs-delay exception map)
log-exception-event?
[level log-exception-event-level
origin log-exception-event-origin
^{:doc "Delayed seq of arguments to log; throwable may be first."}
vargs-delay log-exception-event-vargs-delay
exception log-exception-event-exception
^{:doc "Map with more data or `nil`. The context is a map that is merged
with the log context that's already active, if present."}
map log-exception-event-map])
(define-record-type ^{:doc "Execute a command within
a log context. The context is a map that is merged
with the log context that's already active, if present."}
WithLogContext
(with-log-context context body)
with-log-context?
[context with-log-context-context
body with-log-context-body])
;;; Actions
(defn nil->str
[x]
(if (nil? x) "nil" x))
(defmacro log-msg
"Convenience macro for assembling a log message from objects."
[& ?args]
`(string/join " " (mapv nil->str [~@?args])))
(defmacro log-event*
"Log an event with more data, described by a level and the arguments (monadic version).
Uses current namespace as origin."
[?level ?msg ?map]
`(make-log-event ~?level ~(str *ns*) (delay [~?msg]) ~?map))
(defmacro log-exception-event
"Log an exception event, described by a level and the arguments (monadic version).
Uses current namespace as origin."
[?level ?msg ?throwable]
`(make-log-exception-event ~?level ~(str *ns*) (delay [~?msg (str ~?throwable)]) ~?throwable nil))
(defmacro log-exception-event*
"Log an exception event, described by a level and the arguments (monadic version).
Uses current namespace as origin."
[?level ?msg ?throwable ?map]
`(make-log-exception-event ~?level ~(str *ns*) (delay [~?msg (str ~?throwable)]) ~?throwable ~?map))
(defmacro log-event!
"Log an event, described by a level and the arguments
(imperative version; global config).
Uses current namespace as origin."
[?level ?msg]
`(internal/log-event!-internal "event"
~(str *ns*)
~?level
nil
(delay [~?msg])))
(defmacro log-exception-event!
"Log an exception event."
[?level ?msg ?throwable]
`(internal/log-exception-event!-internal "event"
~(str *ns*)
~?level
nil
(delay [~?msg (str ~?throwable)])
~?throwable))
(defmacro log-event-with-context!
"Log an event, described by a level and the arguments
(imperative version; global config).
Uses current namespace as origin."
[?context ?level ?msg]
`(internal/log-event!-internal "event"
~(str *ns*)
~?level
~?context
(delay [~?msg])))
(defmacro log-exception-event-with-context!
"Log an exception event."
[?context ?level ?msg ?throwable]
`(internal/log-exception-event!-internal "event"
~(str *ns*)
~?level
~?context
(delay [~?msg (str ~?throwable)]) ~?throwable))
(defmacro log-event
"Log an event, described by a level and the arguments (monadic version).
Uses current namespace as origin."
[?level ?msg]
`(make-log-event ~?level ~(str *ns*) (delay [~?msg]) nil))
;;;; Interpreter
(defn run-log-events
[run-any env mstate m]
(cond
(log-event? m)
(do
(internal/log-event!-internal "event"
(log-event-origin m) (log-event-level m) (log-event-map m)
(log-event-vargs-delay m))
[nil mstate])
(log-exception-event? m)
(do
(internal/log-exception-event!-internal "event"
(log-exception-event-origin m) (log-exception-event-level m)
(log-exception-event-map m)
(log-exception-event-vargs-delay m)
(log-exception-event-exception m))
[nil mstate])
(with-log-context? m)
(timbre/with-context (merge timbre/*context*
(with-log-context-context m))
(run-any env mstate (with-log-context-body m)))
:else
monad/unknown-command))
(def log-events-command-config
(monad/make-monad-command-config run-log-events {} {}))