AVar-0.0.3: Data/AVar.hs

{-# LANGUAGE BangPatterns, ScopedTypeVariables, GADTs #-}
--
-- Copyright (c) 2009 Alex Mason - http://axman6.homeip.net/blog/
-- BSD licence - http://www.opensource.org/licenses/bsd-license.php
--

-- |AVars are a form of transactional variables. They internally use a tail
-- recursive function to carry the 'state' of the variable, and allow for
-- use in concurrent systems, where actions are guaranteed to happen. They
-- are designed to cope with exceptions thrown by any modifying functions;
-- any exception thrown during a transaction will either be passed back to
-- the caller or ignored, and the variable keeps on running.
--
-- They are handy for applications like keeping track of resources by
-- incrementing and decrementing the variable. They should not be used in
-- a way which you would read the variable, then modify it based on the
-- result recieved, but rather using the provided functions. If this was
-- not done, the variable's value is very likely to have changed in the
-- mean time.

module Data.AVar (
    -- * Types
    AVar,
    Transaction(..),
    -- * functions on AVars
    putAVar,
    newAVar,
    putMVar,
    modAVar,
    modAVar',
    justModAVar,
    getAVar,
    condModAVar,
    swapAVar) where
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Concurrent.Chan
import qualified Control.Exception as E

-- * Types

-- |A 'Transaction' describes what should happen to a variable.
-- They are only used internally, and are here just for reference.
data Transaction a =
      Put a
    -- ^puts the a into the variable
    | Get (MVar a)
    -- ^reads the variable
    | Mod (a -> a) (MVar (Maybe E.SomeException))
    -- ^modifies the variable
    | JustMod (a -> a)
    -- ^ Just modifies the variable (unless an exception occurs)
    | forall b. Mod' (a -> (a,b)) (MVar (Either E.SomeException b))
    -- ^ modifies the variable, returning the b result to the caller
    | Atom (a -> Bool) (a -> a) (a -> a) (MVar (Either E.SomeException Bool))
    -- ^conditionally modifies a variable

    --Swap a (MVar a)

-- |'AVar's are the means through communication with the variable are conducted.
-- They contain a Chan that is 'connected' to the variable, and is read by the
-- variable's 'handler' function.
data AVar a = AVar (Chan (Transaction a)) 

-- * Functions on AVars

-- |'newAVar' creates a new variable. It forks off the 'handler' that does the
-- work for the variable itself and creates a new AVar.
newAVar :: a -> IO (AVar a)
newAVar x = do
    E.evaluate x
    chan <- newChan :: IO (Chan (Transaction a))
    forkIO (handler chan x)
    return (AVar chan)

-- |'handler' stores the state of the variable in an accumulatin parameter.
-- It reads the chan it was forked with, and takes action depending on the
-- Transaction is recieves. Handler is not something to be used outside of
-- an AVar, and is not exported.
handler :: Chan (Transaction a) -> a -> IO b 
handler chan !x = do
  req <- readChan chan
  case req of
    Put a         -> handler chan a
    Get mvar      -> do
        putMVar mvar x
        handler chan x
    
    Mod f mvar    -> do
        let x' = f x
        p <- E.catch (E.evaluate x' >> return Nothing)
                     (\e -> return (Just e))
        putMVar mvar p
        case p of
          Nothing -> handler chan x'
          _       -> handler chan x
    JustMod f     -> do
        let x' = f x
        res <- E.try (E.evaluate x')
        case res of
            Right _                    -> handler chan x'
            Left  (_::E.SomeException) -> handler chan x
      
    Mod' f mvar    -> do
          let y@(a,b) = f x
          p <- E.try (E.evaluate a >> E.evaluate b)
          case p of
              Right _  -> do
                  putMVar mvar (Right b)
                  handler chan a
              (Left e) -> do
                  putMVar mvar (Left e)
                  handler chan x
    
    Atom test y n res -> do
        let t' = test x
            y' = y x
            n' = n x
        tres <- E.try (E.evaluate t')
        case tres of
            rT@(Right True) -> do
                run <- E.try (E.evaluate y')
                case run of
                    Right x' -> putMVar res rT >> handler chan x'
                    Left e   -> putMVar res (Left e) >> handler chan x
            rF@(Right False) -> do
                run <- E.try (E.evaluate n')
                case run of 
                    Right x' -> putMVar res rF >> handler chan x'
                    Left e   -> putMVar res (Left e) >> handler chan x
            Left e           -> putMVar res (Left e) >> handler chan x
        -- if test x
        --     then do
        --         putMVar res True
        --         handler chan (y x)
        --       else do
        --           putMVar res False
        --           handler chan (n x)


-- |'getAVar' reads the current value inside the AVar.
getAVar :: AVar a -> IO a
getAVar (AVar chan)   = do
    res <- newEmptyMVar
    writeChan chan (Get res)
    takeMVar res


-- |'putAVar' replaces the currect value in the variable with the given x
putAVar :: AVar a -> a -> IO ()
putAVar (AVar chan) x = writeChan chan (Put x)

-- |'modAVar' takes a function from a to a, and returns Nothing if nothing went
-- wrong, or Just e, where e is an exception thrown by the function.
modAVar :: AVar a -> (a -> a) -> IO (Maybe E.SomeException)
modAVar (AVar chan) f = do
    res <- newEmptyMVar
    writeChan chan (Mod f res)
    takeMVar res

-- |'modAVar'' is like modAVar, but it modifies the variable, along with
-- returning a result of type b, within an Either e b.
modAVar' :: AVar a -> (a -> (a,b)) -> IO (Either E.SomeException b)
modAVar' (AVar chan) f = do
    res <- newEmptyMVar
    writeChan chan (Mod' f res)
    takeMVar res

-- |'justModAVar' will attempt to run the given function on the variable.
-- It does not report back on its sucess or failure, and if the function
-- produces an exception, the variable is left unchanged. It should be
-- used when you just want to modify the variable, and keep running,
-- without waiting for the action to complete.
justModAVar :: AVar a -> (a -> a) -> IO ()
justModAVar (AVar chan) f = writeChan chan (JustMod f)

-- |'condModAVar' applies the first finction to the current value in the
-- AVar, and if true will modify the value using the second function if
-- it results in True, or the third function if it results in Fasle.
condModAVar :: AVar a
            -> (a -> Bool)
            -> (a -> a)
            -> (a -> a)
            -> IO (Either E.SomeException Bool)
condModAVar (AVar chan) p t f = do
    res <- newEmptyMVar
    writeChan chan (Atom p t f res)
    takeMVar res

-- |'swapAVar' takes a new value, puts it into the AVar, and returns the old value.
swapAVar :: (AVar a) -> a -> IO (Either E.SomeException a)
swapAVar (AVar chan) new = do
    res <- newEmptyMVar
    writeChan chan (Mod' (\old -> (new, old)) res)
    takeMVar res