-
Notifications
You must be signed in to change notification settings - Fork 721
/
tq.hs
328 lines (283 loc) · 10 KB
/
tq.hs
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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExistentialQuantification #-}
{-
nix-shell OR nix-shell -p ghc cabal-install haskellPackages.eventlog2html jq
Count lines
--------------------------------------------------------------------------------
> ls -lah bench/stdout-tools/5nodes.stdout
-rw-r--r-- 1 fmaste users 6.4G Apr 10 19:28 bench/stdout-tools/5nodes.stdout
> time cat bench/stdout-tools/5nodes.stdout | wc -l
real 0m2.039s
user 0m0.091s
sys 0m2.842s
> time jq --raw-input . bench/stdout-tools/5nodes.stdout | wc -l
25581640
real 1m30.745s
user 1m28.116s
sys 0m8.150s
> time cabal run tq -- --file big-node:bench/stdout-tools/5nodes.stdout --reducer count-lines
25581640
real 0m15.387s
user 0m13.194s
sys 0m2.173s
Count all the ns="Forge.Loop.StartLeadershipCheckPlus"
--------------------------------------------------------------------------------
-- Using jq for everything:
> time jq --raw-input --compact-output 'try fromjson | if (type == "object" and has("at")) then select(.ns=="Forge.Loop.StartLeadershipCheckPlus") else empty end' bench/stdout-tools/5nodes.stdout | wc -l
264150
real 1m28.688s
user 1m27.187s
sys 0m1.555s
-- Using jq but first filter non JSON lines with grep:
> time grep -E "^{.*" bench/stdout-tools/5nodes.stdout | jq --compact-output 'select(.ns == "Forge.Loop.StartLeadershipCheckPlus")' | wc -l
264150
real 1m10.258s
user 1m12.628s
sys 0m5.999s
$ time cabal run tq -- --file big-node:bench/stdout-tools/5nodes.stdout --reducer count-FLSLCP
264150
real 0m30.316s
user 0m28.140s
sys 0m2.167s
Heap changes
--------------------------------------------------------------------------------
> time grep -E "^{.*" bench/stdout-tools/5nodes.stdout | jq 'select(.ns == "Resources") | .data.Heap' | uniq
real 1m8.960s
user 1m11.298s
sys 0m5.972s
> time cabal run tq -- --file big-node:bench/stdout-tools/5nodes.stdout --reducer heap-changes
real 1m1.578s
user 0m59.291s
sys 0m2.264s
Heap changes (52 nodes)
--------------------------------------------------------------------------------
> time for i in `seq 0 51`; do echo "node-$i" && grep -E "^{.*" run/2024-04-05-22-32-6b142-891-value-40M64G-nomadperfssd-bage-nom/node-"$i"/stdout | jq --compact-output 'if .ns == "Resources" then .data.Heap else empty end' | uniq; done
real 9m40.413s
user 9m49.158s
sys 1m4.572s
> cabal run tq -- --run run/2024-04-05-22-32-6b142-891-value-40M64G-nomadperfssd-bage-nom --reducer heap-changes
real 9m10.366s
user 8m12.345s
sys 0m46.550s
-}
{-- RTS params: +RTS -xc -s -l -hc
-N:
There are two ways to run a program on multiple processors: call
Control.Concurrent.setNumCapabilities from your program, or use the RTS -N ⟨x⟩
options. -N⟨x⟩
-s:
Add the -s [⟨file⟩] RTS option when running the program to see timing stats,
which will help to tell you whether your program got faster by using more CPUs
or not. If the user time is greater than the elapsed time, then the program used
more than one CPU. You should also run the program without -N ⟨x⟩ for
comparison.
The output of +RTS -s tells you how many “sparks” were created and executed
during the run of the program (see RTS options to control the garbage
collector), which will give you an idea how well your par annotations are
working.
> eventlog2html stdout-tools.eventlog
Cabal
--enable-profiling Enable Executable and library profiling
--disable-profiling Disable Executable and library profiling
--profiling-detail=level Profiling detail level for executable and
library (default, none, exported-functions,
toplevel-functions, all-functions, late).
--library-profiling-detail=level
Profiling detail level for libraries only.
--}
--------------------------------------------------------------------------------
module Main (main) where
--------------------------------------------------------------------------------
-- base.
import Control.Applicative (some, (<|>))
-- package: time.
import Data.Time.Clock (getCurrentTime, diffUTCTime)
-- package: text.
import qualified Data.Text as Text
-- package: async.
import qualified Control.Concurrent.Async as Async
-- package: optparse-applicative.
import qualified Options.Applicative as Opt
-- library.
import qualified Data.Log as Log
import qualified Cardano.Tracer.Trace as Trace
import qualified Cardano.Tracer.Reducer as Reducer
--------------------------------------------------------------------------------
data CliOpts = CliOpts
{
-- "--file" arguments with an optional file label if ":" separator is found.
files :: [(String, FilePath)]
, inParallel :: Bool
-- "--reducer" arguments.
, reducers :: [ReducerElem]
}
deriving Show
data ReducerElem = forall r. (Show r, Reducer.Reducer r) => MkReducer r
instance Show ReducerElem where
show (MkReducer r) = show r
cliFilterReader :: String -> Either String ReducerElem
cliFilterReader str = case str of
"count-lines" -> Right $ MkReducer Reducer.CountLines
"count-FLSLCP" -> Right $ MkReducer Reducer.CountStartLeadershipCheckPlus
"heap-changes" -> Right $ MkReducer Reducer.HeapChanges
"missed-slots" -> Right $ MkReducer Reducer.MissedSlots
"1s-silences" -> Right $ MkReducer Reducer.OneSecondSilences
_ -> Left str
main :: IO ()
main = do
cliOpts <- Opt.execParser $ Opt.info (optsParser Opt.<**> Opt.helper)
( Opt.fullDesc
<> Opt.progDesc "Print a greeting for TARGET"
<> Opt.header "hello - a test for optparse-applicative"
)
run cliOpts
--------------------------------------------------------------------------------
optsParser :: Opt.Parser CliOpts
optsParser = CliOpts <$>
(
(map
-- Parse the optional file label, looks for ":" as separator.
addFileLabel
<$>
some (
Opt.strOption
( Opt.long "file"
<> Opt.short 'f'
<> Opt.metavar "FILENAME"
<> Opt.help "Input file"
)
)
)
<|>
(
(\runDir -> map
(\n -> ("node-" ++ show n,runDir ++ "/node-" ++ show n ++ "/stdout"))
([0..51]::[Int])
)
<$>
Opt.strOption
( Opt.long "run"
<> Opt.short 'r'
<> Opt.metavar "RUN"
<> Opt.help "Run folder"
)
)
)
<*> Opt.flag False True
( Opt.long "parallel"
<> Opt.help "Process files in parallel"
)
<*> some (
(Opt.option $ Opt.eitherReader cliFilterReader)
( Opt.long "reducer"
<> Opt.short 'r'
<> Opt.metavar "REDUCER"
<> Opt.help "Reducer"
)
)
where
addFileLabel str =
case span (/= ':') str of
(f,"") -> ("",f)
(f, s) -> (f,drop 1 s)
--------------------------------------------------------------------------------
run :: CliOpts -> IO ()
run (CliOpts _ _ []) = putStrLn "Nothing to do, bye!"
run cliOpts@(CliOpts _ parallel ((MkReducer r):_)) = do
t0 <- getCurrentTime
print r
if not parallel
then do
------------------------------------
putStrLn "-------------------------"
putStrLn "Apply filter to all files"
putStrLn "-------------------------"
------------------------------------
mapM_
(\(logName,fp) -> do
ans <- lineFoldl'
(Reducer.reducerOf r)
(Reducer.initialOf r)
fp
print logName
Reducer.printAns r ans
)
(files cliOpts)
else do
---------------------------------------------------------
putStrLn "----------------------------------------------"
putStrLn "Do the same with all files but now in parallel"
putStrLn "----------------------------------------------"
---------------------------------------------------------
ansParallel <- Async.mapConcurrently
(\(logName,fp) -> do
ans <- lineFoldl'
(Reducer.reducerOf r)
(Reducer.initialOf r)
fp
return (logName, ans)
)
(files cliOpts)
mapM_
(\(logName,ans) -> do
print logName
Reducer.printAns r ans
)
ansParallel
t1 <- getCurrentTime
print $ diffUTCTime t1 t0
{-- TODO: Switch to open type families for "sequential" and "parallel" folds.
mapM_
(\(logName,fp) -> do
ans <- lineFoldl'
(\accs cursor -> zipWith (\r' acc -> reducerOf r' acc cursor) rs accs)
(map initialOf rs)
fp
print logName
mapM_ (\(r, acc) -> putStrLn $ showAns r acc) (zip rs ans)
)
(files cliOpts)
--}
-- End
return ()
-- Allow to `fold'` through the log file but in JSON format.
lineFoldl' :: (a -> (Either Text.Text Trace.Trace) -> a) -> a -> FilePath -> IO a
lineFoldl' f initialAcc filePath = do
Log.lineFoldl'
(\acc textLine ->
-- CRITICAL: Has to be "STRICT" to keep `Log.lineFoldl'`'s behaviour.
-- I repeat, the accumulator function has to be strict!
let !nextAcc = f acc (Trace.fromJson textLine)
in nextAcc
)
initialAcc
filePath
--------------------------------------------------------------------------------
-- TODO:
{--
_foldlLog3 :: (
((a -> Cursor -> a), a)
, ((b -> Cursor -> b), b)
, ((c -> Cursor -> c), c)
)
-> FilePath
-> IO (a,b,c)
{-# SCC _foldlLog3 "_foldlLog3" #-}
_foldlLog3 ((fa,a),(fb,b),(fc,c)) filePath = do
(a', b', c') <- lineFoldl'
(\(accA,accB,accC) cursor -> {-# SCC "foldlLog3_f" #-}
(fa accA cursor, fb accB cursor, fc accC cursor)
)
(a,b,c)
filePath
--return $! (a', b', c')
return $ seq a' $ seq b' $ seq c' (a', b', c')
foldlWhile :: Foldable t => (a -> Bool) -> (r -> a -> r) -> r -> t a -> r
foldlWhile t f a xs = foldr cons (\acc -> acc) xs a
where
cons x r acc | t x = r (f acc x)
| otherwise = acc
--}