Logger.hs

{-# LANGUAGE FlexibleInstances #-}
{-|
    Module      :  Control.ERNet.Deployment.Local.Logger
    Description :  logger implementation using an STM channel
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable

    A simple logger implementation using an STM channel.
-}
module Control.ERNet.Deployment.Local.Logger 
(
    LoggerLocal()
)
where

import Control.ERNet.Foundations.Event
import qualified Control.ERNet.Foundations.Event.Logger as LG

--import Control.Concurrent as Concurrent
import Control.Concurrent.STM as STM

newtype LoggerLocal = LoggerLocal (TChan ERNetEvent)

instance LG.Logger LoggerLocal where
    new = 
        do
        logTV <- newTChanIO
        return $ LoggerLocal logTV
    addEvent (LoggerLocal logTV) event = 
        atomically $
            writeTChan logTV event
    emptyAndDo (LoggerLocal logTV) processEvent =
        keepProcessing
        where
        keepProcessing =
            do
            event <- atomically $ readTChan logTV
            processEvent event
            keepProcessing
    emptyAndGetEvents (LoggerLocal logTV) =
        keepProcessing
        where
        keepProcessing =
            do
            empty <- atomically $ isEmptyTChan logTV
            if empty 
                then return []
                else
                    do
                    event <- atomically $ readTChan logTV
                    rest <- keepProcessing
                    return $ event : rest