bin/gargantext-client/Tracking.hs

   1 {-# LANGUAGE TupleSections #-}
   2 module Tracking
   3   ( tracking
   4   , ppTracked
   5   , EkgMetric
   6   , Step
   7   ) where
   8
   9 import Core
  10 import Options
  11
  12 import Control.Monad.IO.Class
  13 import Data.List (intersperse)
  14 import Data.Text (Text)
  15 import Servant.Client
  16 import System.Metrics.Json (Value)
  17
  18 import Gargantext.API.Client
  19
  20 import qualified Data.Text as T
  21
  22 -- | e.g @["rts", "gc", "bytes_allocated"]@
  23 type EkgMetric = [Text]
  24 -- | Any textual description of a step
  25 type Step      = Text
  26
  27 -- | Track EKG metrics before/after running a bunch of computations
  28 --   that can talk to the backend.
  29 tracking
  30   :: ClientOpts
  31   -> [Text] -- ^ e.g @["rts.gc.bytes_allocated"]@
  32   -> [(Step, ClientM a)]
  33   -> ClientM [Either [(EkgMetric, Value)] (Step, a)]
  34 -- no steps, nothing to do
  35 tracking _    _   []    = return []
  36 -- no metrics to track, we just run the steps
  37 tracking _    []  steps = traverse runStep steps
  38 -- metrics to track: we intersperse metric fetching and steps,
  39 -- starting and ending with metric fetching
  40 tracking opts ms' steps = mix (Left <$> fetchMetrics) (map runStep steps)
  41
  42   where fetchMetrics :: ClientM [(EkgMetric, Value)]
  43         fetchMetrics = flip traverse ms $ \metric -> do
  44           whenVerbose opts $
  45             liftIO . putStrLn $ "[Debug] metric to track: " ++ T.unpack (T.intercalate "." metric)
  46           dat <- (metric,) <$> getMetricSample metric
  47           whenVerbose opts $
  48             liftIO . putStrLn $ "[Debug] metric pulled: " ++ show dat
  49           return dat
  50         mix :: ClientM a -> [ClientM a] -> ClientM [a]
  51         mix x xs = sequence $ [x] ++ intersperse x xs ++ [x]
  52         ms = map (T.splitOn ".") ms'
  53
  54 -- ^ A trivial function to print results of steps and sampled metrics
  55 ppTracked :: Show a => [Either [(EkgMetric, Value)] (Step, a)] -> ClientM ()
  56 ppTracked [] = return ()
  57 ppTracked (Right (step, a) : rest) = do
  58   liftIO . putStrLn $ "[step: " ++ T.unpack step ++ "] returned: " ++ show a
  59   ppTracked rest
  60 ppTracked (Left ms : rest) = do
  61   liftIO . putStrLn $ unlines
  62     [ T.unpack (T.intercalate "." metric) ++ " = " ++ show val
  63     | (metric, val) <- ms
  64     ]
  65   ppTracked rest
  66
  67 runStep :: (Step, ClientM a) -> ClientM (Either e (Step, a))
  68 runStep (step, act) = Right . (step,) <$> act