{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
{-# LANGUAGE CPP #-}
----------------------------------------------------------------
--                                                    2021.10.17
-- |
-- Module      :  Data.Or
-- Copyright   :  Copyright (c) 2010--2021 wren gayle romano
-- License     :  BSD
-- Maintainer  :  wren@cpan.org
-- Stability   :  provisional
-- Portability :  Haskell98 + CPP
--
-- A data type for non-exclusive disjunction. This is helpful for
-- things like a generic merge function on sets\/maps which could
-- be union, mutual difference, etc. based on which 'Or' value a
-- function argument returns. Also useful for non-truncating zips
-- (cf. 'zipOr') and other cases where you sometimes want an 'Either'
-- and sometimes want a pair.
----------------------------------------------------------------
module Data.Or
    ( Or(Fst,Both,Snd), elimOr, eitherOr
    -- * Non-truncating zipping functions
    , zipOr, zipOrWith, zipOrBy, zipOrWithBy
    ) where

#ifdef __GLASGOW_HASKELL__
import GHC.Base (build)
#endif
----------------------------------------------------------------

-- | A data type for non-exclusive disjunction.
data Or a b = Fst a | Both a b | Snd b
    deriving (ReadPrec [Or a b]
ReadPrec (Or a b)
Int -> ReadS (Or a b)
ReadS [Or a b]
(Int -> ReadS (Or a b))
-> ReadS [Or a b]
-> ReadPrec (Or a b)
-> ReadPrec [Or a b]
-> Read (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, Int -> Or a b -> ShowS
[Or a b] -> ShowS
Or a b -> String
(Int -> Or a b -> ShowS)
-> (Or a b -> String) -> ([Or a b] -> ShowS) -> Show (Or a b)
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, Or a b -> Or a b -> Bool
(Or a b -> Or a b -> Bool)
-> (Or a b -> Or a b -> Bool) -> Eq (Or a b)
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)


-- | Functional eliminator for 'Or'.
elimOr :: (a -> c) -> (a -> b -> c) -> (b -> c) -> Or a b -> c
elimOr :: (a -> c) -> (a -> b -> c) -> (b -> c) -> Or a b -> c
elimOr a -> c
f a -> b -> c
_ b -> c
_ (Fst  a
a)   = a -> c
f a
a
elimOr a -> c
_ a -> b -> c
g b -> c
_ (Both a
a b
b) = a -> b -> c
g a
a b
b
elimOr a -> c
_ a -> b -> c
_ b -> c
h (Snd    b
b) = b -> c
h   b
b
{-# INLINE elimOr #-}


-- | Convert an 'Either' into an 'Or'.
eitherOr :: Either a b -> Or a b
eitherOr :: Either a b -> Or a b
eitherOr (Left  a
a) = a -> Or a b
forall a b. a -> Or a b
Fst a
a
eitherOr (Right b
b) = b -> Or a b
forall a b. b -> Or a b
Snd b
b
{-# INLINE eitherOr #-}

----------------------------------------------------------------

-- | A variant of 'zip' which exhausts both lists, annotating which
-- list the elements came from. It will return zero or more @Both@,
-- followed by either zero or more @Fst@ or else zero or more @Snd@.
--
-- On GHC this is a \"good producer\" for list fusion.
zipOr :: [a] -> [b] -> [Or a b]
#ifdef __GLASGOW_HASKELL__
zipOr :: [a] -> [b] -> [Or a b]
zipOr [a]
xs [b]
ys = (forall b. (Or a b -> b -> b) -> b -> b) -> [Or a b]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\Or a b -> b -> b
f b
z -> (Or a b -> Or a b) -> (Or a b -> b -> b) -> b -> [a] -> [b] -> b
forall a b c d.
(Or a b -> c) -> (c -> d -> d) -> d -> [a] -> [b] -> d
zipOrWithBy Or a b -> Or a b
forall a. a -> a
id Or a b -> b -> b
f b
z [a]
xs [b]
ys)
#else
zipOr = zipOrWithBy id (:) []
#endif
{-# INLINE zipOr #-}


-- | A variant of 'zipOr' with a custom 'Or'-homomorphism.
--
-- On GHC this is a \"good producer\" for list fusion.
zipOrWith :: (Or a b -> c) -> [a] -> [b] -> [c]
#ifdef __GLASGOW_HASKELL__
zipOrWith :: (Or a b -> c) -> [a] -> [b] -> [c]
zipOrWith Or a b -> c
k [a]
xs [b]
ys = (forall b. (c -> b -> b) -> b -> b) -> [c]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (\c -> b -> b
f b
z -> (Or a b -> c) -> (c -> b -> b) -> b -> [a] -> [b] -> b
forall a b c d.
(Or a b -> c) -> (c -> d -> d) -> d -> [a] -> [b] -> d
zipOrWithBy Or a b -> c
k c -> b -> b
f b
z [a]
xs [b]
ys)
#else
zipOrWith k = zipOrWithBy k (:) []
#endif
{-# INLINE zipOrWith #-}


-- | A variant of 'zipOr' with a custom list-homomorphism.
zipOrBy :: (Or a b -> c -> c) -> c -> [a] -> [b] -> c
zipOrBy :: (Or a b -> c -> c) -> c -> [a] -> [b] -> c
zipOrBy = (Or a b -> Or a b) -> (Or a b -> c -> c) -> c -> [a] -> [b] -> c
forall a b c d.
(Or a b -> c) -> (c -> d -> d) -> d -> [a] -> [b] -> d
zipOrWithBy Or a b -> Or a b
forall a. a -> a
id
{-# INLINE zipOrBy #-}


-- | A variant of 'zipOr' with both a custom 'Or'-homomorphism and
-- a custom list-homomorphism. This is no more powerful than
-- 'zipOrBy', but it may be more convenient to separate the handling
-- of 'Or' from the handling of @(:)@.
zipOrWithBy
    :: (Or a b -> c)    -- ^ 'Or' homomorphism
    -> (c -> d -> d)    -- ^ list homomorphism, @(:)@ part
    -> d                -- ^ list homomorphism, @[]@ part
    -> [a] -> [b] -> d
zipOrWithBy :: (Or a b -> c) -> (c -> d -> d) -> d -> [a] -> [b] -> d
zipOrWithBy Or a b -> c
k c -> d -> d
f d
z = [a] -> [b] -> d
go
    where
    go :: [a] -> [b] -> d
go []     []     = d
z
    go []     (b
y:[b]
ys) = c -> d -> d
f (Or a b -> c
k (b -> Or a b
forall a b. b -> Or a b
Snd    b
y)) ([a] -> [b] -> d
go [] [b]
ys)
    go (a
x:[a]
xs) []     = c -> d -> d
f (Or a b -> c
k (a -> Or a b
forall a b. a -> Or a b
Fst  a
x  )) ([a] -> [b] -> d
go [a]
xs [])
    go (a
x:[a]
xs) (b
y:[b]
ys) = c -> d -> d
f (Or a b -> c
k (a -> b -> Or a b
forall a b. a -> b -> Or a b
Both a
x b
y)) ([a] -> [b] -> d
go [a]
xs [b]
ys)

----------------------------------------------------------------
----------------------------------------------------------- fin.