module Control.ContStuff.Classes
(
Abortable(..),
CallCC(..), Label, labelCC, goto,
HasExceptions(..),
bracket, bracket_, catch, finally, forbid, handle, raiseUnless,
raiseWhen, require,
Stateful(..),
getField, modify, modifyField, modifyFieldLazy, modifyLazy,
Writable(..)
)
where
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Prelude hiding (catch)
class Abortable m where
type Result m
abort :: Result m -> m a
class CallCC m where
callCC :: ((a -> m b) -> m a) -> m a
newtype Label m a = Label (a -> Label m a -> m ())
labelCC :: (Applicative m, CallCC m) => a -> m (a, Label m a)
labelCC x = callCC $ \k -> pure (x, Label $ curry k)
goto :: Label m a -> a -> m ()
goto lk@(Label k) x = k x lk
class HasExceptions m where
type Exception m
raise :: Exception m -> m a
try :: m a -> m (Either (Exception m) a)
bracket :: (HasExceptions m, Monad m) => m res -> (res -> m b) -> (res -> m a) -> m a
bracket acquire release use = do
resource <- acquire
result <- try (use resource)
try (release resource)
either raise return result
bracket_ :: (HasExceptions m, Monad m) => m a -> m b -> m c -> m c
bracket_ init cleanup run = do
init
result <- try run
try cleanup
either raise return result
catch :: (HasExceptions m, Monad m) => m a -> (Exception m -> m a) -> m a
catch c h = try c >>= either h return
finally :: (HasExceptions m, Monad m) => m a -> m b -> m a
finally c d = try c >>= either (\exp -> d >> raise exp) (\x -> d >> return x)
forbid ::
( Exception (t m) ~ (), HasExceptions (t m),
Monad m, Monad (t m), MonadTrans t ) =>
m Bool -> t m ()
forbid = raiseWhen () . lift
handle :: (HasExceptions m, Monad m) => (Exception m -> m a) -> m a -> m a
handle h c = try c >>= either h return
raiseUnless :: (HasExceptions m, Monad m) => Exception m -> m Bool -> m ()
raiseUnless ex c = do b <- c; unless b (raise ex)
raiseWhen :: (HasExceptions m, Monad m) => Exception m -> m Bool -> m ()
raiseWhen ex c = do b <- c; when b (raise ex)
require ::
( Exception (t m) ~ (), HasExceptions (t m),
Monad m, Monad (t m), MonadTrans t ) =>
m Bool -> t m ()
require = raiseUnless () . lift
class Stateful m where
type StateOf m
get :: m (StateOf m)
put :: StateOf m -> m ()
put x = x `seq` putLazy x
putLazy :: StateOf m -> m ()
getField :: (Functor m, Stateful m) => (StateOf m -> a) -> m a
getField = (<$> get)
modify :: (Monad m, Stateful m) => (StateOf m -> StateOf m) -> m ()
modify f = liftM f get >>= put
modifyField :: (Monad m, Stateful m) =>
(StateOf m -> a) -> (a -> StateOf m) -> m ()
modifyField accessor f = liftM (f . accessor) get >>= put
modifyFieldLazy :: (Monad m, Stateful m) =>
(StateOf m -> a) -> (a -> StateOf m) -> m ()
modifyFieldLazy accessor f = liftM (f . accessor) get >>= putLazy
modifyLazy :: (Monad m, Stateful m) => (StateOf m -> StateOf m) -> m ()
modifyLazy f = liftM f get >>= putLazy
class Writable m w where
tell :: w -> m ()