{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module System.Metrics.Prometheus.Ridley.Metrics.CPU.Unix
  ( getLoadAvg
  , processCPULoad
  ) where

import           Control.Applicative ((<|>))
import           Data.Maybe (fromJust)
import qualified Data.Text as T
import           Data.Traversable
import qualified Data.Vector as V
import           Shelly
import qualified System.Metrics.Prometheus.Metric.Gauge as P
import           System.Metrics.Prometheus.Ridley.Types
import           Text.Read (readMaybe)

--------------------------------------------------------------------------------
getLoadAvg :: IO (V.Vector Double)
getLoadAvg :: IO (Vector Double)
getLoadAvg = do
  Text
rawOutput <- forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly forall a b. (a -> b) -> a -> b
$ forall a. Sh a -> Sh a
silently forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [Text] -> Sh Text
run FilePath
"cat" [Text
"/proc/loadavg"]
  let standardFormat :: Maybe [Double]
standardFormat = case forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. Read a => FilePath -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) (forall a. Int -> [a] -> [a]
take Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Text
rawOutput) of
                         Just [Double
a,Double
b,Double
c] -> forall a. a -> Maybe a
Just [Double
a,Double
b,Double
c]
                         Maybe [Double]
_            -> forall a. Maybe a
Nothing

  -- See: https://github.com/iconnect/ridley/issues/8
  let alternativeFormat :: Maybe [Double]
alternativeFormat = case forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a. Read a => FilePath -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) (forall a. Int -> [a] -> [a]
take Int
3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
" " forall a b. (a -> b) -> a -> b
$ Text
rawOutput) of
                         Just [Double
a,Double
b,Double
c] -> forall a. a -> Maybe a
Just [Double
a,Double
b,Double
c]
                         Maybe [Double]
_            -> forall a. Maybe a
Nothing

  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Maybe [Double]
standardFormat forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Double]
alternativeFormat forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just [Double]
noAvgInfo
  where
    noAvgInfo :: [Double]
noAvgInfo = [-Double
1.0, -Double
1.0, -Double
1.0]

--------------------------------------------------------------------------------
-- | As we have 3 gauges, it makes no sense flushing them.
updateCPULoad :: (P.Gauge, P.Gauge, P.Gauge) -> Bool -> IO ()
updateCPULoad :: (Gauge, Gauge, Gauge) -> Bool -> IO ()
updateCPULoad (Gauge
cpu1m, Gauge
cpu5m, Gauge
cpu15m) Bool
_ = do
  Vector Double
loadVec <- IO (Vector Double)
getLoadAvg
  Double -> Gauge -> IO ()
P.set (Vector Double
loadVec forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
0) Gauge
cpu1m
  Double -> Gauge -> IO ()
P.set (Vector Double
loadVec forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
1) Gauge
cpu5m
  Double -> Gauge -> IO ()
P.set (Vector Double
loadVec forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
2) Gauge
cpu15m

--------------------------------------------------------------------------------
processCPULoad :: (P.Gauge, P.Gauge, P.Gauge) -> RidleyMetricHandler
processCPULoad :: (Gauge, Gauge, Gauge) -> RidleyMetricHandler
processCPULoad (Gauge, Gauge, Gauge)
g = forall c.
HasCallStack =>
Text -> c -> (c -> Bool -> IO ()) -> Bool -> RidleyMetricHandler
mkRidleyMetricHandler Text
"ridley-process-cpu-load" (Gauge, Gauge, Gauge)
g (Gauge, Gauge, Gauge) -> Bool -> IO ()
updateCPULoad Bool
False