{-# 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 <- Sh Text -> IO Text
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh Text -> IO Text) -> Sh Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Sh Text -> Sh Text
forall a. Sh a -> Sh a
silently (Sh Text -> Sh Text) -> Sh Text -> Sh Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Sh Text -> Sh Text
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 (Text -> Maybe Double) -> [Text] -> Maybe [Double]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath -> Maybe Double
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe Double)
-> (Text -> FilePath) -> Text -> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
3 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
rawOutput) of
                         Just [Double
a,Double
b,Double
c] -> [Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double
a,Double
b,Double
c]
                         Maybe [Double]
_            -> Maybe [Double]
forall a. Maybe a
Nothing

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

  Vector Double -> IO (Vector Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Double -> IO (Vector Double))
-> (Maybe [Double] -> Vector Double)
-> Maybe [Double]
-> IO (Vector Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> Vector Double
forall a. [a] -> Vector a
V.fromList ([Double] -> Vector Double)
-> (Maybe [Double] -> [Double]) -> Maybe [Double] -> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Double] -> [Double]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Double] -> IO (Vector Double))
-> Maybe [Double] -> IO (Vector Double)
forall a b. (a -> b) -> a -> b
$ Maybe [Double]
standardFormat Maybe [Double] -> Maybe [Double] -> Maybe [Double]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe [Double]
alternativeFormat Maybe [Double] -> Maybe [Double] -> Maybe [Double]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Double] -> Maybe [Double]
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 Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
0) Gauge
cpu1m
  Double -> Gauge -> IO ()
P.set (Vector Double
loadVec Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
`V.unsafeIndex` Int
1) Gauge
cpu5m
  Double -> Gauge -> IO ()
P.set (Vector Double
loadVec Vector Double -> Int -> Double
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 = Text
-> (Gauge, Gauge, Gauge)
-> ((Gauge, Gauge, Gauge) -> Bool -> IO ())
-> Bool
-> RidleyMetricHandler
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