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

import FFunctor
import FMonad

import Data.Functor.Day.Curried

-- | \"Continuation monad\" using 'Curried'.
newtype Cont k f a = Cont { forall (k :: * -> *) (f :: * -> *) a.
Cont k f a -> Curried (Curried f k) k a
runCont :: ((f `Curried` k) `Curried` 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.
Functor f =>
a -> Cont k f b -> Cont k f a
forall (k :: * -> *) (f :: * -> *) a b.
Functor f =>
(a -> b) -> Cont k f a -> Cont k f b
$cfmap :: forall (k :: * -> *) (f :: * -> *) a b.
Functor f =>
(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.
Functor f =>
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) -> ((g `Curried` h) ~> (f `Curried` h))
flmap :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Curried g h ~> Curried f h
flmap f ~> g
fg Curried g h x
gh = (forall r. f (x -> r) -> h r) -> Curried f h x
forall (g :: * -> *) (h :: * -> *) a.
(forall r. g (a -> r) -> h r) -> Curried g h a
Curried ((forall r. f (x -> r) -> h r) -> Curried f h x)
-> (forall r. f (x -> r) -> h r) -> Curried f h x
forall a b. (a -> b) -> a -> b
$ \f (x -> r)
f -> Curried g h x -> forall r. g (x -> r) -> h r
forall (g :: * -> *) (h :: * -> *) a.
Curried g h a -> forall r. g (a -> r) -> h r
runCurried Curried g h x
gh (f (x -> r) -> g (x -> r)
f ~> g
fg f (x -> r)
f)

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 Curried (Curried g k) k x
gkk) = Curried (Curried h k) k x -> Cont k h x
forall (k :: * -> *) (f :: * -> *) a.
Curried (Curried f k) k a -> Cont k f a
Cont (Curried (Curried h k) k x -> Cont k h x)
-> Curried (Curried h k) k x -> Cont k h x
forall a b. (a -> b) -> a -> b
$ (Curried h k ~> Curried g k)
-> Curried (Curried g k) k ~> Curried (Curried h k) k
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Curried g h ~> Curried f h
flmap ((g ~> h) -> Curried h k ~> Curried g k
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Curried g h ~> Curried f h
flmap g x -> h x
g ~> h
gh) Curried (Curried g k) k x
gkk

unit :: Functor g => g ~> ((g `Curried` k) `Curried` k)
unit :: forall (g :: * -> *) (k :: * -> *).
Functor g =>
g ~> Curried (Curried g k) k
unit g x
gx = (forall r. Curried g k (x -> r) -> k r)
-> Curried (Curried g k) k x
forall (g :: * -> *) (h :: * -> *) a.
(forall r. g (a -> r) -> h r) -> Curried g h a
Curried ((forall r. Curried g k (x -> r) -> k r)
 -> Curried (Curried g k) k x)
-> (forall r. Curried g k (x -> r) -> k r)
-> Curried (Curried g k) k x
forall a b. (a -> b) -> a -> b
$ \Curried g k (x -> r)
gk -> Curried g k (x -> r) -> forall r. g ((x -> r) -> r) -> k r
forall (g :: * -> *) (h :: * -> *) a.
Curried g h a -> forall r. g (a -> r) -> h r
runCurried Curried g k (x -> r)
gk (((x -> r) -> x -> r) -> x -> (x -> r) -> r
forall a b c. (a -> b -> c) -> b -> a -> c
flip (x -> r) -> x -> r
forall a b. (a -> b) -> a -> b
($) (x -> (x -> r) -> r) -> g x -> g ((x -> r) -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g x
gx)

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 = Curried (Curried g k) k x -> Cont k g x
forall (k :: * -> *) (f :: * -> *) a.
Curried (Curried f k) k a -> Cont k f a
Cont (g x -> Curried (Curried g k) k x
g ~> Curried (Curried g k) k
forall (g :: * -> *) (k :: * -> *).
Functor g =>
g ~> Curried (Curried 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 Curried (Curried g k) k a
gkk) =
    let hkkkk :: ((((h `Curried` k) `Curried` k) `Curried` k) `Curried` k) a
        hkkkk :: Curried (Curried (Curried (Curried h k) k) k) k a
hkkkk = (Curried (Curried (Curried h k) k) k ~> Curried g k)
-> Curried (Curried g k) k
   ~> Curried (Curried (Curried (Curried h k) k) k) k
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Curried g h ~> Curried f h
flmap ((g ~> Curried (Curried h k) k)
-> Curried (Curried (Curried h k) k) k ~> Curried g k
forall (f :: * -> *) (g :: * -> *) (h :: * -> *).
(f ~> g) -> Curried g h ~> Curried f h
flmap (Cont k h x -> Curried (Curried h k) k x
forall (k :: * -> *) (f :: * -> *) a.
Cont k f a -> Curried (Curried f k) k a
runCont (Cont k h x -> Curried (Curried h k) k x)
-> (g x -> Cont k h x) -> g x -> Curried (Curried 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)) Curried (Curried g k) k a
gkk

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