-- The Loop-While Monad Transformer.
-- Copyright (c) 2008--2010, Neil Brown.
-- All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
--  * Redistributions of source code must retain the above copyright
--    notice, this list of conditions and the following disclaimer.
--  * Redistributions in binary form must reproduce the above copyright
--    notice, this list of conditions and the following disclaimer in the
--    documentation and/or other materials provided with the distribution.
--  * Neither the name of the University of Kent nor the names of its
--    contributors may be used to endorse or promote products derived from
--    this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- | A module containing a monad transformer for performing while loops.  There
-- is nothing here that can't be built using if-then-else, but it can allow you
-- to express control more succinctly.
--
-- For example, here is a loop that executes until a certain time is reached:
--
-- > loop $ do lift performAction
-- >           t <- lift getTime
-- >           while (t < endTime)
--
-- This would commonly be called a do-while loop in other languages.  But the while
-- statement does not have to be at the end of the loop:
--
-- > loop $ do lift performAction
-- >           t <- lift getTime
-- >           while (t < endTime)
-- >           lift $ putStrLn ("Cur Time: " ++ show t)
--
-- This is sometimes known as do-while-do.  Note that like other monad
-- transformers, you'll either need to explicitly lift the actions from the
-- transformed monad, or use an mtl-style type-class to do so.
module Control.Monad.LoopWhile (LoopWhileT, loop, while) where

import Control.Applicative (Applicative(..))
import Control.Monad (ap, liftM, when)
import Control.Monad.Trans (MonadTrans(..), MonadIO(..))
import Data.Maybe (isJust)


-- | A monad transformer for easier looping.  See 'loop' and 'while'.
newtype LoopWhileT m a = LWT { getLoop :: m (Maybe a) }

instance Monad m => Monad (LoopWhileT m) where
  m >>= f = LWT $ getLoop m >>= maybe (return Nothing) (getLoop . f)
  return = LWT . return . Just

instance Monad m => Functor (LoopWhileT m) where
  fmap = liftM

instance Monad m => Applicative (LoopWhileT m) where
  pure = return
  (<*>) = ap

instance MonadTrans LoopWhileT where
  lift = LWT . liftM Just

instance MonadIO m => MonadIO (LoopWhileT m) where
  liftIO = lift . liftIO

-- | Runs the given action in a loop, executing it repeatedly until a 'while'
-- statement inside it has a False condition.  If you use 'loop' without 'while',
-- the effect is the same as 'forever'.
loop :: Monad m => LoopWhileT m a -> m ()
loop l = body
  where
    body = do x <- getLoop l
              when (isJust x) body

-- | Continues executing the loop if the given value is True.  If the value
-- is False, the loop is broken immediately, and control returns to the
-- caller of the 'loop' statement.  Thus you can build pre-condition,
-- post-condition, and \"mid-condition\" loops, placing the condition wherever
-- you like.
while :: Monad m => Bool -> LoopWhileT m ()
while b = LWT $ return $ if b then Just () else Nothing