Request.hs

-- |
-- Module:     FRP.NetWire.Request
-- Copyright:  (c) 2011 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
--
-- Unique identifiers.

module FRP.NetWire.Request
    ( -- * Identifiers.
      identifier
    )
    where

import Control.Monad.IO.Class
import Control.Concurrent.STM
import FRP.NetWire.Wire


-- | Choose a unique identifier when switching in and keep it.
--
-- Never inhibits.

identifier :: MonadIO m => Wire m a Int
identifier =
    mkGen $ \ws _ -> do
        let reqVar = wsReqVar ws
        req <- liftIO . atomically $ do
                   req' <- readTVar reqVar
                   let req = succ req'
                   req `seq` writeTVar reqVar (succ req')
                   return req'
        return (Right req, WConst req)