1-- | 2-- Module : Basement.Monad 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : portable 7-- 8-- Allow to run operation in ST and IO, without having to 9-- distinguinsh between the two. Most operations exposes 10-- the bare nuts and bolts of how IO and ST actually 11-- works, and relatively easy to shoot yourself in the foot 12-- 13-- this is highly similar to the Control.Monad.Primitive 14-- in the primitive package 15-- 16{-# LANGUAGE MagicHash #-} 17{-# LANGUAGE UnboxedTuples #-} 18{-# LANGUAGE ExistentialQuantification #-} 19{-# LANGUAGE ConstraintKinds #-} 20module Basement.Monad 21 ( PrimMonad(..) 22 , MonadFailure(..) 23 , unPrimMonad_ 24 , unsafePrimCast 25 , unsafePrimToST 26 , unsafePrimToIO 27 , unsafePrimFromIO 28 , primTouch 29 ) where 30 31import qualified Prelude 32import GHC.ST 33import GHC.STRef 34import GHC.IORef 35import GHC.IO 36import GHC.Prim 37import Basement.Compat.Base (Exception, (.), ($), Applicative, Monad) 38 39-- | Primitive monad that can handle mutation. 40-- 41-- For example: IO and ST. 42class (Prelude.Functor m, Applicative m, Prelude.Monad m) => PrimMonad m where 43 -- | type of state token associated with the PrimMonad m 44 type PrimState m 45 -- | type of variable associated with the PrimMonad m 46 type PrimVar m :: * -> * 47 -- | Unwrap the State# token to pass to a function a primitive function that returns an unboxed state and a value. 48 primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a 49 -- | Throw Exception in the primitive monad 50 primThrow :: Exception e => e -> m a 51 -- | Run a Prim monad from a dedicated state# 52 unPrimMonad :: m a -> State# (PrimState m) -> (# State# (PrimState m), a #) 53 54 -- | Build a new variable in the Prim Monad 55 primVarNew :: a -> m (PrimVar m a) 56 -- | Read the variable in the Prim Monad 57 primVarRead :: PrimVar m a -> m a 58 -- | Write the variable in the Prim Monad 59 primVarWrite :: PrimVar m a -> a -> m () 60 61-- | just like `unwrapPrimMonad` but throw away the result and return just the new State# 62unPrimMonad_ :: PrimMonad m => m () -> State# (PrimState m) -> State# (PrimState m) 63unPrimMonad_ p st = 64 case unPrimMonad p st of 65 (# st', () #) -> st' 66{-# INLINE unPrimMonad_ #-} 67 68instance PrimMonad IO where 69 type PrimState IO = RealWorld 70 type PrimVar IO = IORef 71 primitive = IO 72 {-# INLINE primitive #-} 73 primThrow = throwIO 74 unPrimMonad (IO p) = p 75 {-# INLINE unPrimMonad #-} 76 primVarNew = newIORef 77 primVarRead = readIORef 78 primVarWrite = writeIORef 79 80instance PrimMonad (ST s) where 81 type PrimState (ST s) = s 82 type PrimVar (ST s) = STRef s 83 primitive = ST 84 {-# INLINE primitive #-} 85 primThrow = unsafeIOToST . throwIO 86 unPrimMonad (ST p) = p 87 {-# INLINE unPrimMonad #-} 88 primVarNew = newSTRef 89 primVarRead = readSTRef 90 primVarWrite = writeSTRef 91 92-- | Convert a prim monad to another prim monad. 93-- 94-- The net effect is that it coerce the state repr to another, 95-- so the runtime representation should be the same, otherwise 96-- hilary ensues. 97unsafePrimCast :: (PrimMonad m1, PrimMonad m2) => m1 a -> m2 a 98unsafePrimCast m = primitive (unsafeCoerce# (unPrimMonad m)) 99{-# INLINE unsafePrimCast #-} 100 101-- | Convert any prim monad to an ST monad 102unsafePrimToST :: PrimMonad prim => prim a -> ST s a 103unsafePrimToST = unsafePrimCast 104{-# INLINE unsafePrimToST #-} 105 106-- | Convert any prim monad to an IO monad 107unsafePrimToIO :: PrimMonad prim => prim a -> IO a 108unsafePrimToIO = unsafePrimCast 109{-# INLINE unsafePrimToIO #-} 110 111-- | Convert any IO monad to a prim monad 112unsafePrimFromIO :: PrimMonad prim => IO a -> prim a 113unsafePrimFromIO = unsafePrimCast 114{-# INLINE unsafePrimFromIO #-} 115 116-- | Touch primitive lifted to any prim monad 117primTouch :: PrimMonad m => a -> m () 118primTouch x = unsafePrimFromIO $ primitive $ \s -> case touch# x s of { s2 -> (# s2, () #) } 119{-# INLINE primTouch #-} 120 121-- | Monad that can represent failure 122-- 123-- Similar to MonadFail but with a parametrized Failure linked to the Monad 124class Monad m => MonadFailure m where 125 -- | The associated type with the MonadFailure, representing what 126 -- failure can be encoded in this monad 127 type Failure m 128 129 -- | Raise a Failure through a monad. 130 mFail :: Failure m -> m () 131 132instance MonadFailure Prelude.Maybe where 133 type Failure Prelude.Maybe = () 134 mFail _ = Prelude.Nothing 135instance MonadFailure (Prelude.Either a) where 136 type Failure (Prelude.Either a) = a 137 mFail a = Prelude.Left a 138