Bounds monitor

BoundsMonitor.hs

{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PackageImports    #-}
{-# LANGUAGE UnicodeSyntax     #-}

module BoundsMonitor where

import "base" Control.Monad           ( return )
import "base" Control.Concurrent.MVar ( MVar, newMVar, modifyMVar, modifyMVar_ )
import "base" Data.Bool               ( Bool(False, True) )
import "base" Data.Function           ( ($) )
import "base" Data.List               ( map, maximum )
import "base" Data.Maybe              ( Maybe(Nothing, Just) )
import "base" Data.Ord                ( Ord, (<), (>) )
import "base" Data.String             ( String )
import "base" Data.Tuple              ( snd )
import "base" Prelude                 ( Double )
import "base" System.IO               ( IO )
import           "containers" Data.Map ( Map )
import qualified "containers" Data.Map as M ( empty, insert, insertWith )
import "dimensional-tf" Numeric.Units.Dimensional.TF ( Time )
import "time" Data.Time.Clock ( UTCTime, getCurrentTime )

--------------------------------------------------------------------------------

type BoundsMonitor name = MVar (BM name)

data BM name =
    BM
    { bmVars ∷ Map name Variable
    }

data Variable =
    Var
    { vSamples    ∷ [Sample]
    , vPredicates ∷ [Predicate]
    }

type Sample = (UTCTime, Double)

data Predicate name =
    Pred
    { predAnalysisType  ∷ AnalysisType
    , predFunc          ∷ (Double → Bool)
    , predMaxCheckDelay ∷ Maybe (Time Double)
      -- ^ The predicate must be checked every predMaxCheckDelay time
      -- units.
    , predOnFail ∷ name → Predicate → IO ()
    }

-- | Different types of analyses that can be performed on a variable.
data AnalysisType =
      Absolute -- ^ The value of the last sample.
    | TimeSinceLastUpdate
    | Difference (Time Double)
      -- ^ Difference between smallest and largest sample in a certain
      -- time span.
    | Frequency (Time Double)
      -- ^ Update frequency in a certain time span.


--------------------------------------------------------------------------------

mkBoundsMonitor ∷ (Ord name) ⇒ IO (BoundsMonitor name)
mkBoundsMonitor =
  newMVar BM { bmVars = M.empty
             }

startMonitor ∷ BoundsMonitor name → IO ()
startMonitor bm = return ()

stopMonitor ∷ BoundsMonitor name → IO ()
stopMonitor bm = return ()

add ∷ (Ord name) ⇒ name → BoundsMonitor name → IO ()
add varName bmMV =
    modifyMVar_ bmMV $ \bm@BM{bmVars} → do
      let newVar = Var {vSamples = []}
      return bm {bmVars = M.insert varName newVar bmVars}

update ∷ (Ord name) ⇒ name → Double → BoundsMonitor name → IO ()
update varName value bmMV =
    modifyMVar_ bmMV $ \bm@BM{bmVars} → do
      t ← getCurrentTime
      return bm {bmVars = updateVars bmVars (t, value)}
  where
    updateVars bmVars sample =
        M.insertWith (\_ old → old {vSamples = sample : vSamples old})
                     varName
                     (Var { vSamples = [sample]
                          }
                     )
                     bmVars

predicate ∷ (Ord name) ⇒ name → Predicate name → BoundsMonitor name → IO ()
predicate varName pred bmMV = return ()