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