-- | Overloaded @if@-expression.
module Overloaded.If (
    ToBool (..),
    ifte,
    ) where

import Data.Maybe (isJust)
import Data.Either (isRight)

-- | Class for 'Bool'-like datastrucutres
--
-- An @if-@-expression @if b then t else e@ is desugared to
--
-- @
-- ifte ('toBool' b) t e
-- @
--
-- Enabled with:
--
-- @
-- {-\# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:If #-}
-- @
--
class ToBool b where
    toBool :: b -> Bool

instance ToBool Bool where
    toBool :: Bool -> Bool
toBool = Bool -> Bool
forall a. a -> a
id

-- | 'Just' is 'True'
instance ToBool (Maybe a) where
    toBool :: Maybe a -> Bool
toBool = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust

-- | 'Right' is 'True'
instance ToBool (Either b a) where
    toBool :: Either b a -> Bool
toBool = Either b a -> Bool
forall b a. Either b a -> Bool
isRight

-- | 'ToBool' overloaded @if@-expression.
ifte :: ToBool b => b -> a -> a -> a
ifte :: b -> a -> a -> a
ifte b
b a
t a
e = if b -> Bool
forall b. ToBool b => b -> Bool
toBool b
b then a
t else a
e