{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- Copyright : (c) 2010, 2011 Simon Meier
-- License : GPL v3 (see LICENSE)
--
-- Maintainer : Simon Meier <iridcode@gmail.com>
-- Portability : GHC only
--
-- Computations that need perform case distinctions.
module Control.Monad.Disj (
-- * MonadDisj class
MonadDisj(..)
, contradictory
, contradictoryIf
, contradiction
, contradictionIf
, disjunctions
, disjunctionOfList
-- * The DisjT monad transformer
, DisjT(..)
, disjT
, runDisjT
-- * Convencience exports
, module Control.Monad
, module Control.Monad.Fix
, module Control.Monad.Trans
) where
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Trans
import Control.Monad.Disj.Class
import Control.Monad.Trans.Disj
-- | @contradiction reason@ denotes the logical false, but also
-- provides the @reason@ as meta-information.
contradiction :: MonadDisj m => String -> m a
contradiction = contradictoryBecause . Just
-- | @contradictionIf b reason@ is logically equivalent to @not b@, but also
-- provides the @reason@ as meta-information.
contradictionIf :: MonadDisj m => Bool -> String -> m ()
contradictionIf b reason | b = contradiction reason
| otherwise = return ()
-- | @contradictory@ denotes the logical false.
contradictory :: MonadDisj m => m a
contradictory = contradictoryBecause Nothing
-- | @contradictoryIf b@ is logically equivalent to @not b@
contradictoryIf :: MonadDisj m => Bool -> m ()
contradictoryIf b | b = contradictory
| otherwise = return ()
-- | @disjunctions ds@ builds the disjunction of all the @ds@ values.
disjunctions :: MonadDisj m => [m a] -> m a
disjunctions = foldr disjunction contradictory
-- | @disjunctionOfList xs@ build the disjunction of the values in list @xs@.
disjunctionOfList :: MonadDisj m => [a] -> m a
disjunctionOfList = disjunctions . map return