-- |
-- Module      : Basement.These
-- License     : BSD-style
-- Maintainer  : Nicolas Di Prima <nicolas@primetype.co.uk>
-- Stability   : stable
-- Portability : portable
--
-- @These a b@, sum type to represent either @a@ or @b@ or both.
--
module Basement.These
    ( These(..)
    ) where

import Basement.Compat.Base
import Basement.NormalForm
import Basement.Compat.Bifunctor

-- | Either a or b or both.
data These a b
    = This a
    | That b
    | These a b
  deriving (These a b -> These a b -> Bool
(These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool) -> Eq (These a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
/= :: These a b -> These a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
== :: These a b -> These a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
Eq, Eq (These a b)
Eq (These a b)
-> (These a b -> These a b -> Ordering)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool)
-> (These a b -> These a b -> These a b)
-> (These a b -> These a b -> These a b)
-> Ord (These a b)
These a b -> These a b -> Bool
These a b -> These a b -> Ordering
These a b -> These a b -> These a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (These a b)
forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
forall a b. (Ord a, Ord b) => These a b -> These a b -> Ordering
forall a b. (Ord a, Ord b) => These a b -> These a b -> These a b
min :: These a b -> These a b -> These a b
$cmin :: forall a b. (Ord a, Ord b) => These a b -> These a b -> These a b
max :: These a b -> These a b -> These a b
$cmax :: forall a b. (Ord a, Ord b) => These a b -> These a b -> These a b
>= :: These a b -> These a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
> :: These a b -> These a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
<= :: These a b -> These a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
< :: These a b -> These a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Bool
compare :: These a b -> These a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => These a b -> These a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (These a b)
Ord, Int -> These a b -> ShowS
[These a b] -> ShowS
These a b -> String
(Int -> These a b -> ShowS)
-> (These a b -> String)
-> ([These a b] -> ShowS)
-> Show (These a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> These a b -> ShowS
forall a b. (Show a, Show b) => [These a b] -> ShowS
forall a b. (Show a, Show b) => These a b -> String
showList :: [These a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [These a b] -> ShowS
show :: These a b -> String
$cshow :: forall a b. (Show a, Show b) => These a b -> String
showsPrec :: Int -> These a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> These a b -> ShowS
Show, Typeable)

instance (NormalForm a, NormalForm b) => NormalForm (These a b) where
    toNormalForm :: These a b -> ()
toNormalForm (This a
a) = a -> ()
forall a. NormalForm a => a -> ()
toNormalForm a
a
    toNormalForm (That b
b) = b -> ()
forall a. NormalForm a => a -> ()
toNormalForm b
b
    toNormalForm (These a
a b
b) = a -> ()
forall a. NormalForm a => a -> ()
toNormalForm a
a () -> () -> ()
`seq` b -> ()
forall a. NormalForm a => a -> ()
toNormalForm b
b

instance Bifunctor These where
    bimap :: (a -> b) -> (c -> d) -> These a c -> These b d
bimap a -> b
fa c -> d
_  (This a
a)    = b -> These b d
forall a b. a -> These a b
This  (a -> b
fa a
a)
    bimap a -> b
_  c -> d
fb (That c
b)    = d -> These b d
forall a b. b -> These a b
That  (c -> d
fb c
b)
    bimap a -> b
fa c -> d
fb (These a
a c
b) = b -> d -> These b d
forall a b. a -> b -> These a b
These (a -> b
fa a
a) (c -> d
fb c
b)

instance Functor (These a) where
    fmap :: (a -> b) -> These a a -> These a b
fmap = (a -> b) -> These a a -> These a b
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second