module System.Metrics.RRDTool
(
IntervalSeconds
, SourceValue
, DataSource(..)
, DataSourceType(..)
, gcSources
, ConsolidationFunction(..)
, RoundRobinArchive(..)
, RoundRobinDatabase
, newRRD
, rrdStore
, MonitorThread
, runMonitor
, killMonitor
) where
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Maybe
import Data.Time
import System.Directory
import System.Metrics
import System.Process
import qualified Data.HashMap.Strict as HM
import System.Metrics.RRDTool.Internals
newRRD
:: FilePath
-> IntervalSeconds
-> Maybe FilePath
-> [RoundRobinArchive]
-> [DataSource]
-> IO RoundRobinDatabase
newRRD dbPath step maybeToolPath archives sources = do
store <- newStore
let rrd = RoundRobinDatabase
{ rrdToolPath = fromMaybe "rrdtool" maybeToolPath
, rrdFilePath = dbPath
, rrdArchives = archives
, rrdSources = HM.fromList [(dsMetric source, source) | source <- sources]
, rrdStore = store
, rrdStep = step
}
rrdExists <- doesFileExist $ rrdFilePath rrd
unless rrdExists $ runTool rrd $ createRRDArgs rrd
return rrd
runTool :: RoundRobinDatabase -> [String] -> IO ()
runTool = callProcess . rrdToolPath
data MonitorThread = MonitorThread
{ killMonitor :: IO ()
}
runMonitor :: RoundRobinDatabase -> IO MonitorThread
runMonitor rrd = do
joinVar <- newEmptyMVar
monitorThreadId <- mask $ \restore -> forkIO $ monitorThread restore `finally` putMVar joinVar ()
return MonitorThread
{ killMonitor = killThread monitorThreadId >> takeMVar joinVar
}
where
monitorThread restore = forever $ do
threadDelay $ rrdStep rrd * 1000000
void $ forkIO $ restore rrdUpdate
ignoreIOException :: IOException -> IO ()
ignoreIOException = const $ return ()
rrdUpdate = do
now <- getCurrentTime
sample <- sampleAll $ rrdStore rrd
case updateRRDArgs rrd sample now of
Nothing -> return ()
Just args -> handle ignoreIOException $ runTool rrd args