module Control.Monad.Trans.Cont.Comonadic where

import Control.Comonad
import Control.Applicative
import Control.Monad (ap)
import Data.Functor.Apply
import Data.Functor.Identity

type Cont r = ContW r Identity

cont :: ((a -> r) -> r) -> Cont r a 
cont f = ContW (f . runIdentity) 

runCont :: Cont r a -> (a -> r) -> r
runCont (ContW k) = k . Identity

newtype ContW r w a = ContW { runContW :: w (a -> r) -> r }

instance Functor w => Functor (ContW r w) where
  fmap f (ContW k) = ContW $ k . fmap (. f)

instance Comonad w => FunctorApply (ContW r w) where
  (<.>) = ap

instance Comonad w => Applicative (ContW r w) where
  pure x = ContW $ \wk -> extract wk x
  (<*>) = ap -- TODO: expand

instance Comonad w => Monad (ContW r w) where
  return = pure
  ContW k >>= f = ContW $ k . extend (\wa a -> runContW (f a) wa)

-- callCC :: Comonad w => ((forall b. a -> ContW r w b) -> ContW r w a) -> ContW r w a
callCC :: Comonad w => ((a -> ContW r w b) -> ContW r w a) -> ContW r w a
callCC f = ContW $ \wc -> runContW (f (\a -> ContW $ \_ -> extract wc a)) wc

{- instance Comonad w => MonadCont (ContT r w) where callCC = callCC #-}