Proposal: Improve the API for TChan, TMVar, and TVar
wren ng thornton
wren at freegeek.org
Sat Mar 26 22:02:47 CET 2011
On 3/26/11 7:26 AM, Bas van Dijk wrote:
> On 26 March 2011 10:29, wren ng thornton<wren at freegeek.org> wrote:
>> modifyTVar :: TVar a -> (a -> a) -> STM ()
>> modifyTVar' :: TVar a -> (a -> a) -> STM ()
>
> These are highly useful; I use them myself quite often. There's one
> issue though that has always bugged me about the current API: The
> types of modifyIORef and modifyMVar don't "line up":
>
> modifyIORef :: IORef a -> (a -> a) -> IO ()
> modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
>
> It would have been nicer if modifyMVar lined up with modifyIORef:
> modifyMVar :: MVar a -> (a -> a) -> IO ()
>
> and have a separate:
> modifyMVarM :: MVar a -> (a -> IO (a,b)) -> IO b
>
> I guess it's difficult to change that at this stage.
Perhaps the solution at this stage would be to:
(1) add modifyMVarM :: MVar a -> (a -> IO (a,b)) -> IO b
(2) deprecate modifyMVar
(3) wait a cycle
(4) remove modifyMVar (if needed)
(5) wait a cycle (if needed)
(6) add modifyMVar :: MVar a -> (a -> a) -> IO ()
It'll take forever, but I think it's important to get the names right
for this kind of thing rather than letting the inconsistency linger. Of
course, this would best be done through a separate proposal IMO.
The modify* names are already in wide currency with pretty consistent
semantics and types, clearly MVars are the outliers:
modifyIORef :: IORef a -> (a -> a) -> IO ()
modifySTRef :: STRef s a -> (a -> a) -> ST s ()
modifyIOError :: (IOError -> IOError) -> IO a -> IO a
transformers:Control.Monad.Trans.RWS.Lazy.modify
transformers:Control.Monad.Trans.RWS.Strict.modify
:: (Monoid w, Monad m) => (s -> s) -> RWST r w s m ()
transformers:Control.Monad.Trans.State.Lazy.modify
transformers:Control.Monad.Trans.State.Strict.modify
:: Monad m => (s -> s) -> StateT s m ()
mtl:Control.Monad.State.Class.modify
:: MonadState s m => (s -> s) -> m ()
parsec-3:Text.Parsec.Prim.modifyState
:: Monad m => (u -> u) -> ParsecT s u m ()
Perhaps when considering the new name for the current modifyMVar, we
should consider the following:
atomicModifyIORef :: IORef a -> (a -> (a, b)) -> IO b
The use of the modify* naming convention isn't universal, but the
alternative naming conventions, update* and adjust*, seem mostly
confined to containers:
-- alias for modifyState, for backwards compatibility.
parsec-3:Text.Parsec.Prim.updateState
:: Monad m => (u -> u) -> ParsecT s u m ()
containers:Data.Sequence.adjust
:: (a -> a) -> Int -> Seq a -> Seq a
containers:Data.IntMap.adjust
:: (a -> a) -> Key -> IntMap a -> IntMap a
containers:Data.Map.adjust
:: Ord k => (a -> a) -> k -> Map k a -> Map k a
And there's some confusion about what the update* functions should mean:
containers:Data.Sequence.update
:: Int -> a -> Seq a -> Seq a
containers:Data.IntMap.update
:: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
containers:Data.Map.update
:: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
containers:Data.Map.updateMin
:: (a -> Maybe a) -> Map k a -> Map k a
containers:Data.IntMap.updateMin
:: (a -> a) -> IntMap a -> IntMap a
containers:Data.Map.updateMax
:: (a -> Maybe a) -> Map k a -> Map k a
containers:Data.IntMap.updateMax
:: (a -> a) -> IntMap a -> IntMap a
containers:Data.IntMap.updateMaxWithKey
:: (Key -> a -> a) -> IntMap a -> IntMap a
containers:Data.Map.updateMaxWithKey
:: (k -> a -> Maybe a) -> Map k a -> Map k a
But fixing containers' API is far beyond the scope of the current
proposal or the proposal for deprecate-renaming modifyMVar.
--
Live well,
~wren
More information about the Libraries
mailing list