{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
module FMonad.Cont.Exp(
  Cont(..)
) where

import FFunctor
import FMonad

import Data.Functor.Exp

-- | \"Continuation monad\" using 'Exp1'.
newtype Cont k f a = Cont { forall (k :: * -> *) (f :: * -> *) a.
Cont k f a -> Exp1 (Exp1 f k) k a
runCont :: ((f `Exp1` k) `Exp1` k) a }
    deriving (forall a b. (a -> b) -> Cont k f a -> Cont k f b)
-> (forall a b. a -> Cont k f b -> Cont k f a)
-> Functor (Cont k f)
forall a b. a -> Cont k f b -> Cont k f a
forall a b. (a -> b) -> Cont k f a -> Cont k f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (k :: * -> *) (f :: * -> *) a b.
a -> Cont k f b -> Cont k f a
forall (k :: * -> *) (f :: * -> *) a b.
(a -> b) -> Cont k f a -> Cont k f b
$cfmap :: forall (k :: * -> *) (f :: * -> *) a b.
(a -> b) -> Cont k f a -> Cont k f b
fmap :: forall a b. (a -> b) -> Cont k f a -> Cont k f b
$c<$ :: forall (k :: * -> *) (f :: * -> *) a b.
a -> Cont k f b -> Cont k f a
<$ :: forall a b. a -> Cont k f b -> Cont k f a
Functor

flmap :: (f ~> g) -> Exp1 g h ~> Exp1 f h
flmap :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Exp1 g h ~> Exp1 f h
flmap f ~> g
fg Exp1 g h x
gh = (forall r. f r -> (x -> r) -> h r) -> Exp1 f h x
forall (f :: * -> *) (g :: * -> *) a.
(forall r. f r -> (a -> r) -> g r) -> Exp1 f g a
Exp1 ((forall r. f r -> (x -> r) -> h r) -> Exp1 f h x)
-> (forall r. f r -> (x -> r) -> h r) -> Exp1 f h x
forall a b. (a -> b) -> a -> b
$ \f r
f x -> r
ar -> Exp1 g h x -> forall r. g r -> (x -> r) -> h r
forall (f :: * -> *) (g :: * -> *) a.
Exp1 f g a -> forall r. f r -> (a -> r) -> g r
unExp1 Exp1 g h x
gh (f r -> g r
f ~> g
fg f r
f) x -> r
ar

instance FFunctor (Cont k) where
  ffmap :: forall (g :: * -> *) (h :: * -> *) x.
(Functor g, Functor h) =>
(g ~> h) -> Cont k g x -> Cont k h x
ffmap g ~> h
gh (Cont Exp1 (Exp1 g k) k x
gkk) = Exp1 (Exp1 h k) k x -> Cont k h x
forall (k :: * -> *) (f :: * -> *) a.
Exp1 (Exp1 f k) k a -> Cont k f a
Cont (Exp1 (Exp1 h k) k x -> Cont k h x)
-> Exp1 (Exp1 h k) k x -> Cont k h x
forall a b. (a -> b) -> a -> b
$ (Exp1 h k ~> Exp1 g k) -> Exp1 (Exp1 g k) k ~> Exp1 (Exp1 h k) k
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Exp1 g h ~> Exp1 f h
flmap ((g ~> h) -> Exp1 h k ~> Exp1 g k
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Exp1 g h ~> Exp1 f h
flmap g x -> h x
g ~> h
gh) Exp1 (Exp1 g k) k x
gkk

unit :: Functor g => g ~> ((g `Exp1` k) `Exp1` k)
unit :: forall (g :: * -> *) (k :: * -> *).
Functor g =>
g ~> Exp1 (Exp1 g k) k
unit g x
gx = (forall r. Exp1 g k r -> (x -> r) -> k r) -> Exp1 (Exp1 g k) k x
forall (f :: * -> *) (g :: * -> *) a.
(forall r. f r -> (a -> r) -> g r) -> Exp1 f g a
Exp1 ((forall r. Exp1 g k r -> (x -> r) -> k r) -> Exp1 (Exp1 g k) k x)
-> (forall r. Exp1 g k r -> (x -> r) -> k r) -> Exp1 (Exp1 g k) k x
forall a b. (a -> b) -> a -> b
$ \Exp1 g k r
gk x -> r
ar -> Exp1 g k r -> forall r. g r -> (r -> r) -> k r
forall (f :: * -> *) (g :: * -> *) a.
Exp1 f g a -> forall r. f r -> (a -> r) -> g r
unExp1 Exp1 g k r
gk (x -> r
ar (x -> r) -> g x -> g r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g x
gx) r -> r
forall a. a -> a
id

instance FMonad (Cont k) where
  fpure :: Functor g => g ~> Cont k g
  fpure :: forall (g :: * -> *). Functor g => g ~> Cont k g
fpure g x
gx = Exp1 (Exp1 g k) k x -> Cont k g x
forall (k :: * -> *) (f :: * -> *) a.
Exp1 (Exp1 f k) k a -> Cont k f a
Cont (g x -> Exp1 (Exp1 g k) k x
g ~> Exp1 (Exp1 g k) k
forall (g :: * -> *) (k :: * -> *).
Functor g =>
g ~> Exp1 (Exp1 g k) k
unit g x
gx)

  fbind :: forall g h a. (Functor g, Functor h) => (g ~> Cont k h) -> Cont k g a -> Cont k h a
  fbind :: forall (g :: * -> *) (h :: * -> *) a.
(Functor g, Functor h) =>
(g ~> Cont k h) -> Cont k g a -> Cont k h a
fbind g ~> Cont k h
rest (Cont Exp1 (Exp1 g k) k a
gkk) =
    let hkkkk :: ((((h `Exp1` k) `Exp1` k) `Exp1` k) `Exp1` k) a
        hkkkk :: Exp1 (Exp1 (Exp1 (Exp1 h k) k) k) k a
hkkkk = (Exp1 (Exp1 (Exp1 h k) k) k ~> Exp1 g k)
-> Exp1 (Exp1 g k) k ~> Exp1 (Exp1 (Exp1 (Exp1 h k) k) k) k
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Exp1 g h ~> Exp1 f h
flmap ((g ~> Exp1 (Exp1 h k) k) -> Exp1 (Exp1 (Exp1 h k) k) k ~> Exp1 g k
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Exp1 g h ~> Exp1 f h
flmap (Cont k h x -> Exp1 (Exp1 h k) k x
forall (k :: * -> *) (f :: * -> *) a.
Cont k f a -> Exp1 (Exp1 f k) k a
runCont (Cont k h x -> Exp1 (Exp1 h k) k x)
-> (g x -> Cont k h x) -> g x -> Exp1 (Exp1 h k) k x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g x -> Cont k h x
g ~> Cont k h
rest)) Exp1 (Exp1 g k) k a
gkk

        hkk :: Exp1 (Exp1 h k) k a
hkk = (Exp1 h k ~> Exp1 (Exp1 (Exp1 h k) k) k)
-> Exp1 (Exp1 (Exp1 (Exp1 h k) k) k) k ~> Exp1 (Exp1 h k) k
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Exp1 g h ~> Exp1 f h
flmap Exp1 h k x -> Exp1 (Exp1 (Exp1 h k) k) k x
Exp1 h k ~> Exp1 (Exp1 (Exp1 h k) k) k
forall (g :: * -> *) (k :: * -> *).
Functor g =>
g ~> Exp1 (Exp1 g k) k
unit Exp1 (Exp1 (Exp1 (Exp1 h k) k) k) k a
hkkkk
    in Exp1 (Exp1 h k) k a -> Cont k h a
forall (k :: * -> *) (f :: * -> *) a.
Exp1 (Exp1 f k) k a -> Cont k f a
Cont Exp1 (Exp1 h k) k a
hkk