Model.hs

{-# LANGUAGE RecordWildCards #-}
module Model where
import Control.Applicative
import Control.Concurrent.STM (STM, TVar, newTVar, readTVar, writeTVar)
import Data.Map (Map)
import ProfilingReport (ProfilingReport(..))
import qualified Data.Map as M

type ReportID = Integer

data Reports = Reports
  { newReportId :: TVar ReportID
  , reports     :: TVar (Map ReportID ProfilingReport)
  }

emptyReports :: STM Reports
emptyReports = do
  uid <- newTVar 0
  rs  <- newTVar M.empty
  return $ Reports { newReportId = uid
                   , reports     = rs }

insertReport :: ProfilingReport -> Reports -> STM ReportID
insertReport r Reports{..} = do
  uid <- readTVar newReportId
  rs  <- readTVar reports
  writeTVar newReportId (succ uid)
  writeTVar reports (M.insert uid r rs)
  return uid

deleteReport :: ReportID -> Reports -> STM ()
deleteReport i Reports{..} = do
  rs <- readTVar reports
  writeTVar reports (M.delete i rs)

lookupReport :: ReportID -> Reports -> STM (Maybe ProfilingReport)
lookupReport i Reports{..} = do
  rs <- readTVar reports
  return $ M.lookup i rs

memberReport :: ReportID -> Reports -> STM Bool
memberReport i Reports{..} = do
  rs <- readTVar reports
  return $ M.member i rs

allReports :: Reports -> STM [(ReportID, ProfilingReport)]
allReports (Reports _ rs) = M.toList <$> readTVar rs

allProfilingReports :: Reports -> STM [ProfilingReport]
allProfilingReports r = map snd <$> allReports r