module Control.Comonad.Trans.Discont.Strict
(
Discont
, discont
, runDiscont
, DiscontT(..)
, runDiscontT
, callCV
, label
) where
import Data.Functor.Identity
import Control.Comonad
import Control.Comonad.Trans.Class
#ifdef __GLASGOW_HASKELL__
import Data.Typeable
instance (Typeable s, Typeable1 w) => Typeable1 (DiscontT s w) where
typeOf1 dswa = mkTyConApp discontTTyCon [typeOf (s dswa), typeOf1 (w dswa)]
where
s :: DiscontT s w a -> s
s = undefined
w :: DiscontT s w a -> w a
w = undefined
discontTTyCon :: TyCon
discontTTyCon = mkTyCon "Control.Comonad.Trans.Discont.Strict.DiscontT"
#endif
type Discont s = DiscontT s Identity
data DiscontT s w a = DiscontT (w s -> a) (w s)
discont :: (s -> a) -> s -> Discont s a
discont f s = DiscontT (f . runIdentity) (Identity s)
runDiscont :: Discont s a -> (s -> a, s)
runDiscont (DiscontT f (Identity s)) = (f . Identity, s)
runDiscontT :: DiscontT s w a -> (w s -> a, w s)
runDiscontT (DiscontT f s) = (f, s)
instance Functor (DiscontT s w) where
fmap g (DiscontT f ws) = DiscontT (g . f) ws
instance Extend (DiscontT s w) where
duplicate (DiscontT f ws) = DiscontT (DiscontT f) ws
extend g (DiscontT f ws) = DiscontT (g . DiscontT f) ws
instance Comonad (DiscontT s w) where
extract (DiscontT f ws) = f ws
instance ComonadTrans (DiscontT s) where
lower (DiscontT f s) = extend f s
callCV :: DiscontT s w (DiscontT s w (DiscontT s w a -> a) -> b) -> b
callCV (DiscontT k s) = k s (DiscontT (\s' (DiscontT k' _) -> k' s') s)
label :: Comonad w => DiscontT s w a -> s
label (DiscontT _ ws) = extract ws