-- |
-- Module:     Control.ContStuff.Monads
-- Copyright:  (c) 2010 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <es@ertes.de>
-- Stability:  experimental
--
-- This module implements the non-transformer variants of the monad
-- transformers found in "Control.ContStuff.Trans".

module Control.ContStuff.Monads
    ( -- * Monads
      -- ** Choice
      Choice, listChoice, maybeChoice,
      -- ** Cont
      Cont, runCont, evalCont, modifyCont,
      -- ** State
      State, runState, evalState, execState,
      -- ** Writer
      OldWriter, runOldWriter, evalOldWriter, execOldWriter
    )
    where

import Control.Applicative
import Control.ContStuff.Trans
import Data.Monoid


------------
-- Choice --
------------

-- | The choice monad.  Derived from 'ChoiceT'.

type Choice r i a = ChoiceT r i Id a


-- | Get list of solutions.

listChoice :: Choice [a] [a] a -> [a]
listChoice = getId . listChoiceT


-- | Get one solution.

maybeChoice :: Choice (Maybe a) (Maybe a) a -> Maybe a
maybeChoice = getId . maybeChoiceT


----------
-- Cont --
----------

-- | Pure CPS monad derived from ContT.

type Cont r a = ContT r Id a


-- | Run a pure CPS computation.

runCont :: (a -> r) -> Cont r a -> r
runCont k (ContT c) = getId $ c (Id . k)


-- | Evaluate a pure CPS computation to its final result.

evalCont :: Cont r r -> r
evalCont (ContT c) = getId $ c pure


-- | Modify the result of a CPS computation along the way.

modifyCont :: (r -> r) -> Cont r ()
modifyCont = modifyContT


---------------
-- OldWriter --
---------------

-- | The traditional writer monad.

type OldWriter r w a = ContT (r, w) Id a


-- | Run a traditional writer computation.

runOldWriter :: Monoid w => OldWriter r w r -> (r, w)
runOldWriter = getId . runOldWriterT


-- | Run a traditional writer computation and return its result.

evalOldWriter :: Monoid w => OldWriter r w r -> r
evalOldWriter = fst . getId . runOldWriterT


-- | Run a traditional writer computation and return its log.

execOldWriter :: Monoid w => OldWriter r w r -> w
execOldWriter = snd . getId . runOldWriterT


-----------
-- State --
-----------

-- | Pure state monad derived from StateT.

type State r s a = StateT r s Id a


-- | Run a stateful computation.

runState :: s -> (s -> a -> r) -> State r s a -> r
runState s0 k c = getId $ runStateT s0 (\s1 -> Id . k s1) c


-- | Run a stateful computation returning its result.

evalState :: s -> State r s r -> r
evalState = (getId .) . evalStateT


-- | Run a stateful computation returning its result.

execState :: s -> State s s a -> s
execState = (getId .) . execStateT