{-# LANGUAGE
        CPP,
        MultiParamTypeClasses,
        FlexibleInstances
  #-}

-- |This module exports no new symbols of its own.  It defines several 
--  basic class instances for creating, reading, and writing standard
--  reference types, and re-exports the types for which it defines instances.
--  
--  TODO: add millions of SPECIALIZE INSTANCE pragmas, for IO monad at
--  a minimum.
module Data.StateRef.Instances
    ( IORef
    , MVar
    , MonadIO(..)
    
    , STRef
    , ST
    , RealWorld
    
    , ForeignPtr
    
#ifdef useSTM
    , module Data.StateRef.Instances.STM
#endif
    
    , module Data.StateRef.Instances.Undecidable
    
    ) where

#ifdef useSTM
import Data.StateRef.Instances.STM
#endif

import Data.StateRef.Types
import Data.StateRef.Instances.Undecidable

import Data.IORef
import Control.Concurrent.MVar

import Control.Monad.Trans
import Control.Monad.ST
import Data.STRef

import qualified Control.Monad.ST.Lazy
import qualified Data.STRef.Lazy

import Foreign.Storable
import Foreign.ForeignPtr

-- @Ref m@ in @m@:
instance HasRef m => NewRef (Ref m a) m a where
    newReference :: a -> m (Ref m a)
newReference = a -> m (Ref m a)
forall (m :: * -> *) a. HasRef m => a -> m (Ref m a)
newRef
instance ReadRef (Ref m a) m a where
    readReference :: Ref m a -> m a
readReference (Ref sr :: sr
sr) = sr -> m a
forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
readReference sr
sr
instance WriteRef (Ref m a) m a where
    writeReference :: Ref m a -> a -> m ()
writeReference (Ref sr :: sr
sr) = sr -> a -> m ()
forall sr (m :: * -> *) a. WriteRef sr m a => sr -> a -> m ()
writeReference sr
sr
instance ModifyRef (Ref m a) m a where
    atomicModifyReference :: Ref m a -> (a -> (a, b)) -> m b
atomicModifyReference (Ref sr :: sr
sr) = sr -> (a -> (a, b)) -> m b
forall sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (a, b)) -> m b
atomicModifyReference sr
sr
    modifyReference :: Ref m a -> (a -> a) -> m ()
modifyReference (Ref sr :: sr
sr) = sr -> (a -> a) -> m ()
forall sr (m :: * -> *) a.
ModifyRef sr m a =>
sr -> (a -> a) -> m ()
modifyReference sr
sr

-- m a in semi-arbitrary monad m
-- (cannot have instance Monad m => ReadRef (m a) m a, because this activates
-- functional dependencies that would overconstrain totally unrelated instances
-- because of the possibility of the future addition of, e.g., instance Monad TMVar)
instance Monad m => NewRef (IO a) m a where
    newReference :: a -> m (IO a)
newReference ro :: a
ro = IO a -> m (IO a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
ro)
instance MonadIO m => ReadRef (IO a) m a where
    readReference :: IO a -> m a
readReference = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance Monad m => NewRef (ST s a) m a where
    newReference :: a -> m (ST s a)
newReference ro :: a
ro = ST s a -> m (ST s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
ro)
instance ReadRef (ST s a) (ST s) a where
    readReference :: ST s a -> ST s a
readReference = ST s a -> ST s a
forall a. a -> a
id
instance MonadIO m => ReadRef (ST RealWorld a) m a where
    readReference :: ST RealWorld a -> m a
readReference = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (ST RealWorld a -> IO a) -> ST RealWorld a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ST RealWorld a -> IO a
forall a. ST RealWorld a -> IO a
stToIO

-- IORef in IO-compatible monads
instance HasRef IO where
    newRef :: a -> IO (Ref IO a)
newRef x :: a
x = do
        IORef a
sr <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
x
        Ref IO a -> IO (Ref IO a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef a -> Ref IO a
forall sr (m :: * -> *) a. ModifyRef sr m a => sr -> Ref m a
Ref IORef a
sr)
instance MonadIO m => NewRef (IORef a) m a where
    newReference :: a -> m (IORef a)
newReference = IO (IORef a) -> m (IORef a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef a) -> m (IORef a))
-> (a -> IO (IORef a)) -> a -> m (IORef a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef
instance MonadIO m => ReadRef (IORef a) m a where
    readReference :: IORef a -> m a
readReference = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (IORef a -> IO a) -> IORef a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> IO a
forall a. IORef a -> IO a
readIORef
instance MonadIO m => WriteRef (IORef a) m a where
    writeReference :: IORef a -> a -> m ()
writeReference r :: IORef a
r = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
r
instance MonadIO m => ModifyRef (IORef a) m a where
    atomicModifyReference :: IORef a -> (a -> (a, b)) -> m b
atomicModifyReference r :: IORef a
r = IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> ((a -> (a, b)) -> IO b) -> (a -> (a, b)) -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> (a -> (a, b)) -> IO b
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef a
r
    modifyReference :: IORef a -> (a -> a) -> m ()
modifyReference r :: IORef a
r = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> ((a -> a) -> IO ()) -> (a -> a) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef a
r

-- @Ref IO@ in IO-compatible monads
--   (maybe...)
-- instance MonadIO m => NewRef (Ref IO a) m a where
--         newReference (Ref sr) = liftIO (newIORef sr)
-- instance MonadIO m => ReadRef (Ref IO a) m a where
--         readReference (Ref sr) = liftIO (readIORef sr)
-- instance MonadIO m => WriteRef (Ref IO a) m a where
--         writeReference (Ref sr) = liftIO . writeIORef sr
-- instance MonadIO m => ModifyRef (Ref IO a) m a where
--         atomicModifyReference (Ref sr) = liftIO . atomicModifyIORef sr
--         modifyReference (Ref sr) = liftIO . modifyIORef sr

-- (STRef s) in (ST s) monad
instance HasRef (ST s) where
    newRef :: a -> ST s (Ref (ST s) a)
newRef x :: a
x = do
        STRef s a
sr <- a -> ST s (STRef s a)
forall a s. a -> ST s (STRef s a)
newSTRef a
x
        Ref (ST s) a -> ST s (Ref (ST s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (STRef s a -> Ref (ST s) a
forall sr (m :: * -> *) a. ModifyRef sr m a => sr -> Ref m a
Ref STRef s a
sr)
instance NewRef (STRef s a) (ST s) a where
    newReference :: a -> ST s (STRef s a)
newReference = a -> ST s (STRef s a)
forall a s. a -> ST s (STRef s a)
newSTRef
instance ReadRef (STRef s a) (ST s) a where
    readReference :: STRef s a -> ST s a
readReference = STRef s a -> ST s a
forall s a. STRef s a -> ST s a
readSTRef
instance WriteRef (STRef s a) (ST s) a where
    writeReference :: STRef s a -> a -> ST s ()
writeReference = STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef
instance ModifyRef (STRef s a) (ST s) a where
    atomicModifyReference :: STRef s a -> (a -> (a, b)) -> ST s b
atomicModifyReference   = STRef s a -> (a -> (a, b)) -> ST s b
forall (m :: * -> *) sr t a b.
(Monad m, ReadRef sr m t, WriteRef sr m a) =>
sr -> (t -> (a, b)) -> m b
defaultAtomicModifyReference
    modifyReference :: STRef s a -> (a -> a) -> ST s ()
modifyReference         = STRef s a -> (a -> a) -> ST s ()
forall (m :: * -> *) sr t a.
(Monad m, ReadRef sr m t, WriteRef sr m a) =>
sr -> (t -> a) -> m ()
defaultModifyReference

-- (STRef RealWorld) in IO monad (not MonadIO instances, because the m
--  would overlap with (ST s) even though there's no instance MonadIO (ST a))
instance NewRef (STRef RealWorld a) IO a where
    newReference :: a -> IO (STRef RealWorld a)
newReference = ST RealWorld (STRef RealWorld a) -> IO (STRef RealWorld a)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (STRef RealWorld a) -> IO (STRef RealWorld a))
-> (a -> ST RealWorld (STRef RealWorld a))
-> a
-> IO (STRef RealWorld a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ST RealWorld (STRef RealWorld a)
forall sr (m :: * -> *) a. NewRef sr m a => a -> m sr
newReference
instance ReadRef (STRef RealWorld a) IO a where
    readReference :: STRef RealWorld a -> IO a
readReference = ST RealWorld a -> IO a
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld a -> IO a)
-> (STRef RealWorld a -> ST RealWorld a)
-> STRef RealWorld a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STRef RealWorld a -> ST RealWorld a
forall sr (m :: * -> *) a. ReadRef sr m a => sr -> m a
readReference
instance WriteRef (STRef RealWorld a) IO a where
    writeReference :: STRef RealWorld a -> a -> IO ()
writeReference r :: STRef RealWorld a
r = ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> (a -> ST RealWorld ()) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STRef RealWorld a -> a -> ST RealWorld ()
forall sr (m :: * -> *) a. WriteRef sr m a => sr -> a -> m ()
writeReference STRef RealWorld a
r
instance ModifyRef (STRef RealWorld a) IO a where
    modifyReference :: STRef RealWorld a -> (a -> a) -> IO ()
modifyReference r :: STRef RealWorld a
r       = ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ())
-> ((a -> a) -> ST RealWorld ()) -> (a -> a) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STRef RealWorld a -> (a -> a) -> ST RealWorld ()
forall sr (m :: * -> *) a.
ModifyRef sr m a =>
sr -> (a -> a) -> m ()
modifyReference STRef RealWorld a
r
    atomicModifyReference :: STRef RealWorld a -> (a -> (a, b)) -> IO b
atomicModifyReference r :: STRef RealWorld a
r = ST RealWorld b -> IO b
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld b -> IO b)
-> ((a -> (a, b)) -> ST RealWorld b) -> (a -> (a, b)) -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STRef RealWorld a -> (a -> (a, b)) -> ST RealWorld b
forall sr (m :: * -> *) a b.
ModifyRef sr m a =>
sr -> (a -> (a, b)) -> m b
atomicModifyReference STRef RealWorld a
r

-- (STRef s) in lazy (ST s) monad
instance HasRef (Control.Monad.ST.Lazy.ST s) where
    newRef :: a -> ST s (Ref (ST s) a)
newRef x :: a
x = do
        STRef s a
sr <- a -> ST s (STRef s a)
forall a s. a -> ST s (STRef s a)
Data.STRef.Lazy.newSTRef a
x
        Ref (ST s) a -> ST s (Ref (ST s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (STRef s a -> Ref (ST s) a
forall sr (m :: * -> *) a. ModifyRef sr m a => sr -> Ref m a
Ref STRef s a
sr)
instance NewRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where
    newReference :: a -> ST s (STRef s a)
newReference = a -> ST s (STRef s a)
forall a s. a -> ST s (STRef s a)
Data.STRef.Lazy.newSTRef
instance ReadRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where
    readReference :: STRef s a -> ST s a
readReference = STRef s a -> ST s a
forall s a. STRef s a -> ST s a
Data.STRef.Lazy.readSTRef
instance WriteRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where
    writeReference :: STRef s a -> a -> ST s ()
writeReference = STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
Data.STRef.Lazy.writeSTRef
instance ModifyRef (STRef s a) (Control.Monad.ST.Lazy.ST s) a where
    atomicModifyReference :: STRef s a -> (a -> (a, b)) -> ST s b
atomicModifyReference   = STRef s a -> (a -> (a, b)) -> ST s b
forall (m :: * -> *) sr t a b.
(Monad m, ReadRef sr m t, WriteRef sr m a) =>
sr -> (t -> (a, b)) -> m b
defaultAtomicModifyReference
    modifyReference :: STRef s a -> (a -> a) -> ST s ()
modifyReference         = STRef s a -> (a -> a) -> ST s ()
forall (m :: * -> *) sr t a.
(Monad m, ReadRef sr m t, WriteRef sr m a) =>
sr -> (t -> a) -> m ()
defaultModifyReference

-- MVar in IO-compatible monads (constructable but not usable as a "normal" state ref)
instance MonadIO m => NewRef (MVar a) m (Maybe a) where
    newReference :: Maybe a -> m (MVar a)
newReference Nothing = IO (MVar a) -> m (MVar a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
    newReference (Just x :: a
x) = IO (MVar a) -> m (MVar a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO (MVar a)
forall a. a -> IO (MVar a)
newMVar a
x)

-- ForeignPtrs, Ptrs, etc., in IO-compatible monads
instance (Storable a, MonadIO m) => NewRef (ForeignPtr a) m a where
    newReference :: a -> m (ForeignPtr a)
newReference val :: a
val = IO (ForeignPtr a) -> m (ForeignPtr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ForeignPtr a) -> m (ForeignPtr a))
-> IO (ForeignPtr a) -> m (ForeignPtr a)
forall a b. (a -> b) -> a -> b
$ do
        ForeignPtr a
ptr <- IO (ForeignPtr a)
forall a. Storable a => IO (ForeignPtr a)
mallocForeignPtr
        ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
ptr (\ptr :: Ptr a
ptr -> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
val)
        ForeignPtr a -> IO (ForeignPtr a)
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr a
ptr
instance (Storable a, MonadIO m) => ReadRef (ForeignPtr a) m a where
    readReference :: ForeignPtr a -> m a
readReference ptr :: ForeignPtr a
ptr = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ForeignPtr a -> (Ptr a -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
ptr Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek)
instance (Storable a, MonadIO m) => WriteRef (ForeignPtr a) m a where
    writeReference :: ForeignPtr a -> a -> m ()
writeReference ptr :: ForeignPtr a
ptr val :: a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ForeignPtr a -> (Ptr a -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
ptr (\ptr :: Ptr a
ptr -> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
val))
instance (Storable a, MonadIO m) => ModifyRef (ForeignPtr a) m a where
    atomicModifyReference :: ForeignPtr a -> (a -> (a, b)) -> m b
atomicModifyReference   = ForeignPtr a -> (a -> (a, b)) -> m b
forall (m :: * -> *) sr t a b.
(Monad m, ReadRef sr m t, WriteRef sr m a) =>
sr -> (t -> (a, b)) -> m b
defaultAtomicModifyReference
    modifyReference :: ForeignPtr a -> (a -> a) -> m ()
modifyReference         = ForeignPtr a -> (a -> a) -> m ()
forall (m :: * -> *) sr t a.
(Monad m, ReadRef sr m t, WriteRef sr m a) =>
sr -> (t -> a) -> m ()
defaultModifyReference

-- this is an instance I would like to make, but it opens
-- a big can of worms... it requires incoherent instances, for one.
-- perhaps I ought to give up the abstractness of 'sr' in the class
-- definition; i don't know if that gets me anywhere though... 
--
-- note that as long as only these instances exist, there is no
-- actual overlap.  maybe it's not such a bad idea.  on the other
-- hand, a corresponding instance for Reader would be nice too, and
-- that would be a duplicate instance (because only the context would
-- differ).
--
-- instance (MonadState s1 m,
--           StateRef s2 m a)
--                 => StateRef (s1 -> s2) m a
--         where
--                 readReference f       = do
--                         s1 <- get
--                         readReference (f s1)
--                 writeReference f val  = do
--                         s1 <- get
--                         writeReference (f s1) val
--                 modifyReference f g = do
--                         s1 <- get
--                         modifyReference (f s1) g