1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : Control.Monad.Trans.Conts
-- Copyright : (C) 2011 Edward Kmett
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : provisional
-- Portability : MPTCs, fundeps
--
-- > Cont r ~ Contravariant.Adjoint (Op r) (Op r)
-- > Conts r ~ Contravariant.AdjointT (Op r) (Op r)
-- > ContsT r w m ~ Contravariant.AdjointT (Op (m r)) (Op (m r)) w
----------------------------------------------------------------------------
module Control.Monad.Trans.Conts
(
-- * Continuation passing style
Cont
, cont
, runCont
-- * Multiple-continuation passing style
, Conts
, runConts
, conts
-- * Multiple-continuation passing style transformer
, ContsT(..)
, callCC
) where
import Prelude hiding (sequence)
import Control.Applicative
import Control.Comonad
import Control.Monad.Trans.Class
import Control.Monad (ap)
import Data.Functor.Apply
import Data.Functor.Identity
type Cont r = ContsT r Identity Identity
cont :: ((a -> r) -> r) -> Cont r a
cont f = ContsT $ \ (Identity k) -> Identity $ f $ runIdentity . k
runCont :: Cont r a -> (a -> r) -> r
runCont (ContsT k) f = runIdentity $ k $ Identity (Identity . f)
type Conts r w = ContsT r w Identity
conts :: Functor w => (w (a -> r) -> r) -> Conts r w a
conts k = ContsT $ Identity . k . fmap (runIdentity .)
runConts :: Functor w => Conts r w a -> w (a -> r) -> r
runConts (ContsT k) = runIdentity . k . fmap (Identity .)
newtype ContsT r w m a = ContsT { runContsT :: w (a -> m r) -> m r }
instance Functor w => Functor (ContsT r w m) where
fmap f (ContsT k) = ContsT $ k . fmap (. f)
instance Comonad w => Apply (ContsT r w m) where
(<.>) = ap
instance Comonad w => Applicative (ContsT r w m) where
pure x = ContsT $ \f -> extract f x
(<*>) = ap
instance Comonad w => Monad (ContsT r w m) where
return = pure
ContsT k >>= f = ContsT $ k . extend (\wa a -> runContsT (f a) wa)
callCC :: Comonad w => ((a -> ContsT r w m b) -> ContsT r w m a) -> ContsT r w m a
callCC f = ContsT $ \wamr -> runContsT (f (\a -> ContsT $ \_ -> extract wamr a)) wamr
{-
callCCs :: Comonad w => (w (a -> ContsT r w m b) -> ContsT r w m a) -> ContsT r w m a
callCCs f =
-}
instance Comonad w => MonadTrans (ContsT r w) where
lift m = ContsT $ extract . fmap (m >>=)
|
