{-# LANGUAGE GADTs #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | This module contains useful functions for working with 'Either's.
module Data.Either.Linear
  ( Either (..)
  , either
  , lefts
  , rights
  , fromLeft
  , fromRight
  , partitionEithers
  )
  where

import Data.Unrestricted.Linear
import Prelude (Either(..))


-- XXX Design Notes
-- Functions like isLeft do not make sense in a linear program.
--------------------------------------------------------------------------------


-- | Linearly consume an @Either@ by applying the first linear function on a
-- value constructed with @Left@ and the second linear function on a value
-- constructed with @Right@.
either :: (a %1-> c) -> (b %1-> c) -> Either a b %1-> c
either :: forall a c b. (a %1 -> c) -> (b %1 -> c) -> Either a b %1 -> c
either a %1 -> c
f b %1 -> c
_ (Left a
x) = a %1 -> c
f a
x
either a %1 -> c
_ b %1 -> c
g (Right b
y) = b %1 -> c
g b
y


-- | Get all the left elements in order, and consume the right ones.
lefts :: Consumable b => [Either a b] %1-> [a]
lefts :: forall b a. Consumable b => [Either a b] %1 -> [a]
lefts [] = []
lefts (Left a
a : [Either a b]
xs) = a
a a %1 -> [a] %1 -> [a]
forall a. a -> [a] -> [a]
: [Either a b] %1 -> [a]
forall b a. Consumable b => [Either a b] %1 -> [a]
lefts [Either a b]
xs
lefts (Right b
b : [Either a b]
xs) = b %1 -> [a] %1 -> [a]
forall a b. Consumable a => a %1 -> b %1 -> b
lseq b
b ([Either a b] %1 -> [a]
forall b a. Consumable b => [Either a b] %1 -> [a]
lefts [Either a b]
xs)


-- | Get all the right elements in order, and consume the left ones.
rights :: Consumable a => [Either a b] %1-> [b]
rights :: forall a b. Consumable a => [Either a b] %1 -> [b]
rights [] = []
rights (Left a
a : [Either a b]
xs) = a %1 -> [b] %1 -> [b]
forall a b. Consumable a => a %1 -> b %1 -> b
lseq a
a ([Either a b] %1 -> [b]
forall a b. Consumable a => [Either a b] %1 -> [b]
rights [Either a b]
xs)
rights (Right b
b : [Either a b]
xs) = b
b b %1 -> [b] %1 -> [b]
forall a. a -> [a] -> [a]
: [Either a b] %1 -> [b]
forall a b. Consumable a => [Either a b] %1 -> [b]
rights [Either a b]
xs


-- | Get the left element of a consumable @Either@ with a default
fromLeft :: (Consumable a, Consumable b) => a %1-> Either a b %1-> a
fromLeft :: forall a b.
(Consumable a, Consumable b) =>
a %1 -> Either a b %1 -> a
fromLeft a
x (Left a
a) = a %1 -> a %1 -> a
forall a b. Consumable a => a %1 -> b %1 -> b
lseq a
x a
a
fromLeft a
x (Right b
b) = b %1 -> a %1 -> a
forall a b. Consumable a => a %1 -> b %1 -> b
lseq b
b a
x

-- | Get the right element of a consumable @Either@ with a default
fromRight :: (Consumable a, Consumable b) => b %1-> Either a b %1-> b
fromRight :: forall a b.
(Consumable a, Consumable b) =>
b %1 -> Either a b %1 -> b
fromRight b
x (Left a
a) = a %1 -> b %1 -> b
forall a b. Consumable a => a %1 -> b %1 -> b
lseq a
a b
x
fromRight b
x (Right b
b) = b %1 -> b %1 -> b
forall a b. Consumable a => a %1 -> b %1 -> b
lseq b
x b
b

-- | Partition and consume a list of @Either@s into two lists with all the
-- lefts in one and the rights in the second, in the order they appeared in the
-- initial list.
partitionEithers :: [Either a b] %1-> ([a], [b])
partitionEithers :: forall a b. [Either a b] %1 -> ([a], [b])
partitionEithers [] = ([], [])
partitionEithers (Either a b
x:[Either a b]
xs) = Either a b %1 -> ([a], [b]) %1 -> ([a], [b])
forall a b. Either a b %1 -> ([a], [b]) %1 -> ([a], [b])
fromRecur Either a b
x ([Either a b] %1 -> ([a], [b])
forall a b. [Either a b] %1 -> ([a], [b])
partitionEithers [Either a b]
xs)
  where
    fromRecur :: Either a b %1-> ([a], [b]) %1-> ([a], [b])
    fromRecur :: forall a b. Either a b %1 -> ([a], [b]) %1 -> ([a], [b])
fromRecur (Left a
a) ([a]
as, [b]
bs) = (a
aa %1 -> [a] %1 -> [a]
forall a. a -> [a] -> [a]
:[a]
as, [b]
bs)
    fromRecur (Right b
b) ([a]
as, [b]
bs) = ([a]
as, b
bb %1 -> [b] %1 -> [b]
forall a. a -> [a] -> [a]
:[b]
bs)