{-# LANGUAGE FlexibleInstances #-}

-----------------------------------------------------------------------------
{- |
Module      :  Control.Category.Cont
Description :  Provides a type for Continuation Passing Style development
Copyright   :  (c) Matteo Provenzano 2015

License     :  BSD-style (see the LICENSE file in the distribution)
Maintainer  :  matteo.provenzano@alephdue.com
Stability   :  experimental
Portability :  portable
-}

module Control.Category.Cont ( Cont
                             , forget
                             , withCont
                             , lift
                             , cont
                             -- * Example: Using @Cont@ category
                             -- $ContExample
                             ) where

import Prelude hiding (id, (.))
import Control.Category
import Data.Monoid

-- |A type for the Continuation category.
-- In the Continuation category:
--
--     * object are functions @f :: a -> b@, @g :: c -> d@
--     * arrows are functions @t :: (a -> b) -> (c -> d)@

newtype Cont f g = Cont (f -> g)

instance Category Cont where
    (Cont f) . (Cont g) = Cont (f . g )
    id = Cont id

{- Identity law:
--
-- Cont f . Cont id = Cont f . id = Cont f = Cont id . f = Cont id . Cont f

-- Associativity law:
--
-- (Cont f . Cont g) . Cont h = Cont (f . g) . Cont h = Cont (f . g . h) = Cont (f . (g . h)) = Cont f . Cont (g .h) = Cont f . (Cont g . Cont h)
-}

instance Monoid a => Monoid (Cont t (f -> a)) where
    Cont f `mappend` Cont g = Cont $ \h x -> f h x `mappend` g h x
    mempty = Cont $ \h x -> mempty

-- |Creates a continuation
cont :: (f -> g) -> Cont f g
cont f = Cont f

-- |Forgets the continuation.
forget :: Cont (a -> a) (b -> c) -> b -> c
forget (Cont f) = f id

-- |Apply a function to the continuation.
withCont :: (b -> c) -> Cont (a -> b) (a -> c)
withCont f = Cont $ \g -> f . g

-- |Lift the continuation into a Monad.
lift :: Monad m => Cont (a -> b) (a -> m b)
lift = withCont return

{-$ContExample
'ContT' can be used to add continuation handling to other monads.
Here is an example how to combine it with @IO@ monad:

>import Prelude hiding (id, (.))
>import Control.Category
>import Control.Category.Cont

>withPassword pwd = cont $ \f x -> do
>    putStrLn "Enter the secret password:"
>    pass <- getLine
>    if pass == pwd then
>        f x
>    else
>        return "you are not authorized to execute this action."

>greet = cont $ \f x -> f $ "hello to " ++ x

>secureGreet = forget $ (withPassword "secret") . lift . greet
>verySecureGreet = forget $ (withPassword "secret") . (withPassword "verySecret") . lift . greet

Action @withPassword@ requests user to enter a string. If the string matches the password the input is handed to the continuation.
@lift@ is used to inject the pure code into the IO monad.
-}