{- | 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