Safe Haskell | None |
---|---|
Language | Haskell2010 |
Extensions |
|
- data Catch' v e
- data Catch m e o v a
- = CatchOuter (o m e)
- | CatchAction (Catch' v e)
- | CatchResult a
- type CatchArgT v r = v -> r
- type CatchResT r = r
- effCatch :: EffClass Catch' v e => Catch' v r -> Eff e r
- runEffCatch :: forall t u m z v m1 e o w a r. Monad m => (u t r -> (r -> m (CatchResT z)) -> m (CatchResT z)) -> (Catch m1 e o w a -> r) -> (r -> Catch t r u v z) -> CatchArgT v z -> Eff r a -> m (CatchResT z)
- throwCtch :: EffClass Catch' v e => v -> Eff e ()
- throwCtchIf :: EffClass Catch' v e => v -> (v -> Bool) -> Eff e ()
Overview
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} import Control.THEff import Control.THEff.Catch mkEff "MyCatch" ''Catch ''Float ''NoEff foo:: Float -> Eff (MyCatch m String) String foo x = do throwCtchIf x (==0) return $ "1/" ++ show x ++ " = " ++ (show $ 1 / x) hndlr :: Float -> String hndlr x = "Error : x=" ++ show x
>>>
runMyCatch hndlr $ foo 4
"1/4.0 = 0.25"
>>>
runMyCatch hndlr $ foo 0
"Error : x=0.0"
Types and functions used in mkEff
Actually, the effect type - v - Type - the parameter of the effect. - e - mkEff generated type.
Type implements link in the chain of effects.
Constructors must be named {EffectName}{Outer|WriterAction|WriterResult}
and have a specified types of fields.
- m - Or Monad (if use the Lift
) or phantom type - stub (if used NoEff
).
- o - Type of outer effect.
- a - The result of mkEff generated runEEEE function.
CatchOuter (o m e) | |
CatchAction (Catch' v e) | |
CatchResult a |
type CatchArgT v r = v -> r Source
Type of fourth argument of runEffCatch and first argument of runEEEE.
effCatch :: EffClass Catch' v e => Catch' v r -> Eff e r Source
This function is used in the mkEff
generated runEEEE functions and typically
in effect action functions. Calling the effect action.
:: forall (t :: * -> *) (u :: (* -> *) -> * -> *) (m :: * -> *) (m1 :: * -> *) (o :: (* -> *) -> * -> *). Monad m | |
=> (u t r -> (r -> m (CatchResT z)) -> m (CatchResT z)) | The outer effect function |
-> (Catch m1 e o w a -> r) | The chain of effects link wrapper. |
-> (r -> Catch t r u v z) | The chain of effects link unwrapper. |
-> CatchArgT v z | The argument of effect. Checking and/or correction function. |
-> Eff r a | |
-> m (CatchResT z) |
The main function of the effect implementing.
This function is used in the mkEff
generated runEEEE functions.