{-# LANGUAGE DeriveDataTypeable #-}

module Control.Monad.Bool
       ( -- * Introduction
         -- $intro

         -- * Boolean Monoids
         -- $monoids
         And(..), andm, (&&?)
       , Or(..), orm, (||?)
         -- * Boolean Monads
         -- $monads
       , AndM(..), AndMT(..), onlyIf, evalAndMT, evalAndM
       , OrM(..), OrMT(..), endIf, evalOrMT, evalOrM
       ) where

import Control.Applicative
import Control.Conditional
import Control.Exception
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Either
import Data.Attempt
import Data.Functor.Identity
import Data.Maybe
import Data.Monoid
import Data.Typeable
import Unsafe.Coerce

{- $intro

   This library implements a pair of Boolean monoids and monads, to support
   short-circuited, value-returning computations similar to what Python and
   Ruby offer in their native @&&@ and @||@ operators.

   For example, in Python you might see this:

   @
   x = [1,2,3,0]
   print x[1] || x[3]               -- this will print "2"
   @

   With this library, you can now mirror such code in Haskell:

   @
   let x = [1,2,3,0]
   print $ (x !! 1) ||? (x !! 3)   -- this will print "Success 2"
   @

   "Booleanness" is based on each type having an instance of the
   'Control.Conditional.ToBool' type, for which only the basic types are
   covered.  If you wish to define a truth value for your own types, simply
   provide an instance for 'Control.Conditional.ToBool':

   @
   instance ToBool MyType where
       toBool = ...
   @
-}

instance ToBool Int where
    toBool = (/=0)

instance ToBool Integer where
    toBool = (/=0)

instance ToBool (Maybe a) where
    toBool = isJust

instance ToBool (Either a b) where
    toBool = either (const False) (const True)

instance ToBool [a] where
    toBool = not . null

instance ToBool (Attempt a) where
    toBool = isSuccess

{- $monoids

   The Boolean Monoids are helpful for short-circuiting chains of boolean
   logic, while returning the actual value that caused the chain to complete
   with a true value.
 -}

data LogicException = LogicalAndFailed
                    | LogicalOrFailed
                    deriving (Show, Typeable)

instance Exception LogicException

-- | And is a short-circuiting Monoid representing chains of boolean logic.
-- It mimicks the "return sucessful result" behavior of the boolean operators
-- in languages like Python and Ruby.
newtype And a = And { getAnd :: Attempt a } deriving Show

instance ToBool a => Monoid (And a) where
    mempty = And (Failure LogicalAndFailed)

    x@(And (Failure _))  `mappend` And (Failure _) = x
    And (Success _) `mappend` y@(And (Failure _))  = y
    x@(And (Failure _))  `mappend` And (Success _) = x

    And (Success x') `mappend` y@(And (Success y')) =
        if toBool x' && toBool y'
        then y
        else mempty

-- | You can use 'andm' to lift values of any type supporting
-- 'Control.Conditional.ToBool' into the And Monoid.  Appending such values
-- together yields 'And (Success x)' if the last of all such values represents
-- "true".  For Example:
--
-- >>> getAnd $ andm "foo" <> andm "bar"
-- Success "bar"
-- >>> getAnd $ andm "" <> andm "bar"
-- Failure LogicalAndFailed
-- >>> getAnd $ andm "foo" <> andm "bar" <> andm "baz"
-- Success "baz"
andm :: a -> And a
andm = And . Success

-- | As a convenience, '&&?' allows you to work only with 'Maybe' types:
--
-- >>> Success "foo" &&? Success "bar"
-- Success "bar"
-- >>> Success "" &&? Success "bar"
-- Failure LogicalAndFailed
-- >>> Success "foo" &&? Success "bar" &&? Success "baz"
-- Success "baz"
--
-- Note that if you want to use 'Maybe' itself to represent truth, you will
-- have to doubly wrap it:
--
-- >>> Success (Just 1) &&? Success (Just 2)
-- Success (Just 2)
-- >>> Success (Just 1) &&? Success Nothing
-- Failure LogicalAndFailed
-- >>> Success (Just 1) &&? Failure LogicalAndFailed
-- Failure LogicalAndFailed
(&&?) :: ToBool a => Attempt a -> Attempt a -> Attempt a
x &&? y = getAnd (And x <> And y)

-- | Or is a short-circuiting Monoid representing chains of boolean logic.
-- It mimicks the "return sucessful result" behavior of the boolean operators
-- in languages like Python and Ruby.
newtype Or a = Or { getOr :: Attempt a } deriving Show

instance ToBool a => Monoid (Or a) where
    mempty = Or (Failure LogicalOrFailed)

    x@(Or (Failure _)) `mappend` Or (Failure _) = x
    x@(Or (Success _)) `mappend` Or (Failure _) = x
    Or (Failure _) `mappend` y@(Or (Success _)) = y

    x@(Or (Success x')) `mappend` y@(Or (Success y')) =
        if toBool x'
        then x
        else if toBool y'
             then y
             else mempty

-- | You can use 'orm' to lift values of any type supporting
-- 'Control.Conditional.ToBool' into the And Monoid.  Appending such values
-- together yields 'And (Success x)' if any of these values represents "true".
-- For Example:
--
-- >>> getOr $ orm "foo" <> orm "bar"
-- Success "foo"
-- >>> getOr $ orm "" <> orm "bar"
-- Success "bar"
-- >>> getOr $ orm "foo" <> orm "bar" <> orm "baz"
-- Success "foo"
orm :: a -> Or a
orm = Or . Success

-- | As a convenience, '||?' allows you to work only with
-- 'Data.Attempt.Attempt' value:
--
-- >>> Success "foo" ||? Success "bar"
-- Success "foo"
-- >>> Success "" ||? Success "bar"
-- Success "bar"
-- >>> Success "foo" ||? Success "bar" ||? Success "baz"
-- Success "foo"
--
-- Note that if you want to use 'Maybe' to represent truth, you will
-- have to doubly wrap it:
--
-- >>> Success (Just 1) ||? Success (Just 2)
-- Success (Just 1)
-- >>> Success Nothing ||? Success (Just 2)
-- Success (Just 2)
-- >>> Failure LogicalOrFailed ||? Success (Just 2)
-- Success (Just 2)
(||?) :: ToBool a => Attempt a -> Attempt a -> Attempt a
x ||? y = getOr (Or x <> Or y)

{- $monads

   The Boolean Monads are helpful for short-circuiting chains of logic,
   returning the actual value that caused the chain to complete with a true
   value.  By using the 'AndMT' transformers, you can add short-circuiting,
   value-yielding logic to any Monad.
 -}

-- | 'AndM' is a Boolean, short-circuiting monad.
--
-- Use 'onlyIf' to guard later statements, which are only executed if every
-- preceding 'onlyIf' evaluates to True.  For example:
--
-- @
-- foo :: AndM Int
-- foo = do onlyIf (True == True)
--          return 100
--          onlyIf (True == True)
--          return 150
--          onlyIf (True == False)
--          return 200
-- @
--
-- When run with `evalAndM foo (-1)` (where @(-1)@ is the default value),
-- 'foo' returns 150.

type AndM = AndMT Identity

-- | 'AndMT' is the monad transformer for 'AndM'.
newtype AndMT m a = AndMT { runAndMT :: a -> EitherT a m a }

instance Functor m => Functor (AndMT m) where
    fmap f (AndMT g) = AndMT (fmap f . unsafeCoerce . g . unsafeCoerce)

instance Monad m => Monad (AndMT m) where
    return  = AndMT . const . return
    g >>= f = unsafeCoerce <$>
              AndMT $ \prev -> let x = runAndMT g prev
                               in do x' <- x
                                     runAndMT (unsafeCoerce f x') x'

-- | Combinator used to guard logic in the 'AndM' Monad.
onlyIf :: Monad m => Bool -> AndMT m a
onlyIf p = AndMT $ \prev -> if p then right prev else left prev

evalAndMT :: Monad m => AndMT m a -> a -> m a
evalAndMT (AndMT f) = eitherT return return . f

-- | Combinator used to guard logic in the 'AndM' Monad.
evalAndM :: AndMT Identity a -> a -> a
evalAndM (AndMT f) = runIdentity . eitherT return return . f

-- | OrM is a Boolean, short-circuiting monad transformer.
--
-- Use 'endIf' to chain statements, which are only executed if every preceding
-- 'endIf' evaluates to False.  For example:
--
-- @
-- bar :: OrM Int
-- bar = do endIf (True == False)
--          return 100
--          endIf (True == False)
--          return 150
--          endIf (True == True)
--          return 200
-- @
--
-- When run with `evalOrM bar (-1)` (where @(-1)@ is the default value), 'foo'
-- returns 150.
type OrM = OrMT Identity

newtype OrMT m a = OrMT { runOrMT :: a -> EitherT a m a }

instance Functor m => Functor (OrMT m) where
    fmap f (OrMT g) = OrMT (fmap f . unsafeCoerce . g . unsafeCoerce)

instance Monad m => Monad (OrMT m) where
    return  = OrMT . const . return
    g >>= f = unsafeCoerce <$>
              OrMT $ \prev -> let x = runOrMT g prev
                               in do x' <- x
                                     runOrMT (unsafeCoerce f x') x'

endIf :: Monad m => Bool -> OrMT m a
endIf p = OrMT $ \prev -> if p then left prev else right prev

evalOrMT :: Monad m => OrMT m a -> a -> m a
evalOrMT (OrMT f) = eitherT return return . f

evalOrM :: OrMT Identity a -> a -> a
evalOrM (OrMT f) = runIdentity . eitherT return return . f

-- Bool.hs ends here