{-# LANGUAGE LambdaCase #-}

{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Data.Or (
	Or(..), or, lefts, rights, fromLeft, fromRight, partitionOrs ) where

import Prelude hiding (or)

import Control.Arrow (first, second, (***))

data Or a b = L a | R b | LR a b deriving (Int -> Or a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Or a b -> ShowS
forall a b. (Show a, Show b) => [Or a b] -> ShowS
forall a b. (Show a, Show b) => Or a b -> String
showList :: [Or a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Or a b] -> ShowS
show :: Or a b -> String
$cshow :: forall a b. (Show a, Show b) => Or a b -> String
showsPrec :: Int -> Or a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Or a b -> ShowS
Show, ReadPrec [Or a b]
ReadPrec (Or a b)
ReadS [Or a b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a b. (Read a, Read b) => ReadPrec [Or a b]
forall a b. (Read a, Read b) => ReadPrec (Or a b)
forall a b. (Read a, Read b) => Int -> ReadS (Or a b)
forall a b. (Read a, Read b) => ReadS [Or a b]
readListPrec :: ReadPrec [Or a b]
$creadListPrec :: forall a b. (Read a, Read b) => ReadPrec [Or a b]
readPrec :: ReadPrec (Or a b)
$creadPrec :: forall a b. (Read a, Read b) => ReadPrec (Or a b)
readList :: ReadS [Or a b]
$creadList :: forall a b. (Read a, Read b) => ReadS [Or a b]
readsPrec :: Int -> ReadS (Or a b)
$creadsPrec :: forall a b. (Read a, Read b) => Int -> ReadS (Or a b)
Read, Or a b -> Or a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => Or a b -> Or a b -> Bool
/= :: Or a b -> Or a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => Or a b -> Or a b -> Bool
== :: Or a b -> Or a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => Or a b -> Or a b -> Bool
Eq, Or a b -> Or a b -> Bool
Or a b -> Or a b -> Ordering
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 (Or a b)
forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Bool
forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Ordering
forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Or a b
min :: Or a b -> Or a b -> Or a b
$cmin :: forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Or a b
max :: Or a b -> Or a b -> Or a b
$cmax :: forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Or a b
>= :: Or a b -> Or a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Bool
> :: Or a b -> Or a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Bool
<= :: Or a b -> Or a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Bool
< :: Or a b -> Or a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Bool
compare :: Or a b -> Or a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => Or a b -> Or a b -> Ordering
Ord)

or :: (a -> c) -> (b -> c) -> (a -> b -> c) -> Or a b -> c
or :: forall a c b. (a -> c) -> (b -> c) -> (a -> b -> c) -> Or a b -> c
or a -> c
f b -> c
g a -> b -> c
h = \case L a
x -> a -> c
f a
x; R b
y -> b -> c
g b
y; LR a
x b
y -> a -> b -> c
h a
x b
y

lefts :: [Or a b] -> [a]
lefts :: forall a b. [Or a b] -> [a]
lefts [] = []
lefts (L a
x : [Or a b]
os) = a
x forall a. a -> [a] -> [a]
: forall a b. [Or a b] -> [a]
lefts [Or a b]
os
lefts (R b
_ : [Or a b]
os) = forall a b. [Or a b] -> [a]
lefts [Or a b]
os
lefts (LR a
x b
_ : [Or a b]
os) = a
x forall a. a -> [a] -> [a]
: forall a b. [Or a b] -> [a]
lefts [Or a b]
os

rights :: [Or a b] -> [b]
rights :: forall a b. [Or a b] -> [b]
rights [] = []
rights (L a
_ : [Or a b]
os) = forall a b. [Or a b] -> [b]
rights [Or a b]
os
rights (R b
y : [Or a b]
os) = b
y forall a. a -> [a] -> [a]
: forall a b. [Or a b] -> [b]
rights [Or a b]
os
rights (LR a
_ b
y : [Or a b]
os) = b
y forall a. a -> [a] -> [a]
: forall a b. [Or a b] -> [b]
rights [Or a b]
os

fromLeft :: a -> Or a b -> a
fromLeft :: forall a b. a -> Or a b -> a
fromLeft a
_ (L a
x) = a
x
fromLeft a
d (R b
_) = a
d
fromLeft a
_ (LR a
x b
_) = a
x

fromRight :: b -> Or a b -> b
fromRight :: forall b a. b -> Or a b -> b
fromRight b
d (L a
_) = b
d
fromRight b
_ (R b
y) = b
y
fromRight b
_ (LR a
_ b
y) = b
y

partitionOrs :: [Or a b] -> ([a], [b])
partitionOrs :: forall a b. [Or a b] -> ([a], [b])
partitionOrs [] = ([], [])
partitionOrs (L a
x : [Or a b]
os) = (a
x forall a. a -> [a] -> [a]
:) forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
`first` forall a b. [Or a b] -> ([a], [b])
partitionOrs [Or a b]
os
partitionOrs (R b
y : [Or a b]
os) = (b
y forall a. a -> [a] -> [a]
:) forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
`second` forall a b. [Or a b] -> ([a], [b])
partitionOrs [Or a b]
os
partitionOrs (LR a
x b
y : [Or a b]
os) = (a
x forall a. a -> [a] -> [a]
:) forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** (b
y forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ forall a b. [Or a b] -> ([a], [b])
partitionOrs [Or a b]
os