Catana.hs

{- |
Module      : Control.Monad.Catana
Copyright   : (c) Dustin DeWeese 2011
License     : BSD3
Maintainer  : dustin.deweese@gmail.com
Stability   : experimental
Portability : portable

[Computation type:] Computations that both consume and produce elements lazily with support for advanced control flow using continuations

[Binding Strategy:] Binding a function to a monadic value produces a continuation which passes the unconsumed input and the combined output function in turn to the next continuation.

[Useful for:] Lazily processing a list with complex control structures.

[Zero and plus:] None.

[Example type:] @'Catana' i o b a@

The Catana monad represents computations that are both catamorphisms and anamorphisms; they both consume and produce values.  In addition, the Catana monad represents the computation in continuation-passing style, allowing the continuations to be manipulated as is Control.Monad.Cont
-}

module Control.Monad.Catana (
    -- * The Catana monad
    Catana(..),
    consume,
    top,
--    consumeOnly, -- too dangerous
    push,
    produce,
    stop,
    more,
    evalCatana,
    evalCatana'
    -- * Example 1: Usage of the Catana monad
    -- $catanaExample1
  ) where

import Control.Applicative
import Control.Monad
import Control.Monad.Cont

{- $catanaExample1

An example of complex control structure using Catana:

>catanaExample1 =
>  forever $ do
>    z <- callCC $ \exit -> do
>      (x, y) <- (,) <$> consume <*> consume
>      produce (x + y)
>      produce (x * y)
>      if x > 1
>        then exit 0
>        else do
>          produce (x - y)
>          produce (x / y)
>          return 1
>    produce z

Catana monads can be converted into a function over lists using 'evalCatana'.

> evalCatana catanaExample1 [1..4]
> -- result: [3.0,2.0,-1.0,0.5,1.0,7.0,12.0,0.0] 
-}

data Catana i o b a = Catana { runCatana :: [i] -> (CatanaIO i o a -> CatanaIO i o b) -> CatanaIO i o b }
type CatanaIO i o a = (a, [i], [o] -> [o])

instance Functor (Catana i o b) where
  fmap f (Catana l) = Catana $ \i k ->
                      l i $ \(x, i', o') ->
                      k (f x, i', o')

instance Applicative (Catana i o b) where
  Catana fl <*> x = Catana $ \i k ->
                    fl i $ \(f, i', o1) ->
                      let (x', i'', o2) = runCatana (fmap f x) i' k
                        in (x', i'', o1 . o2)
  pure x = Catana $ \i k -> k (x, i, id)

instance Monad (Catana i o b) where
  return = pure
  Catana l >>= f = Catana $ \i k ->
                   l i $ \(x, i', o1) ->
                     let (x', i'', o2) = runCatana (f x) i' k
                       in (x', i'', o1 . o2)

instance MonadCont (Catana i o b) where
  callCC f = Catana $ \i k ->
               let g x = Catana $ \i' _ -> k (x, i', id)
                 in runCatana (f g) i k

-- |Consumes an element from the input list, returning it
-- If there is no more input, the chain of continuations ends
-- immediately; no more computations will be processed
consume :: Catana i o a i
consume = Catana f
  where f (x : i) k = k (x, i, id)
        f i k = (undefined, i, id)

-- |Returns the next input without consuming it
top :: Catana i o a i
top = Catana f
  where f i@(x : _) k = k (x, i, id)
        f i k = (undefined, i, id)

-- |Consumes only the element satisfying p, leaving the other
-- elements in the input list.  This could cause space leaks if
-- the input is never fully consumed
consumeOnly :: (i -> Bool) -> Catana i o a i
consumeOnly p = Catana f
  where f i k | null b = (undefined, i, id)
              | otherwise = k (head b, a ++ tail b, id)
          where (a, b) = span (not . p) i

-- |Stops computation, ending the continuation chain
stop :: Catana i o () a
stop = Catana $ \i k -> ((), i, id)

-- |Tests for more input
more :: Catana i o a Bool
more = Catana f
  where f [] k = k (False, [], id)
        f i k = k (True, i, id)

-- |Pushes 'x' into the input
push :: i -> Catana i o a ()
push x = Catana $ \i k -> k ((), x:i, id)

-- |Produces 'x' in the output
produce :: o -> Catana i o a ()
produce x = Catana $ \i k -> k ((), i, (x:))

-- |Converts a Catana monad into a function over lists
evalCatana :: Catana i o a a -> [i] -> [o]
evalCatana c i = o []
  where (_, _, o) = runCatana c i id

-- |Evaluates a Catana monad over a list returning the result and output
evalCatana' :: Catana i o a a -> [i] -> (a, [o])
evalCatana' c i = (x, o [])
  where (x, _, o) = runCatana c i id