{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ConstrainedClassMethods    #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeOperators              #-}

module Control.Compactable
  (
  -- * Compact
    Compactable (..)
  -- * Compact Fold
  , CompactFold (..)
  -- * Handly flips
  , fforMaybe
  , fforFold
  , fforEither
  , fforBifold
  -- * More general lefts and rights
  , mfold'
  , mlefts
  , mrights
  -- * Monad Transformer utils
  , fmapMaybeM
  , fmapEitherM
  , fforMaybeM
  , fforEitherM
  , applyMaybeM
  , bindMaybeM
  , traverseMaybeM
  -- * Alternative Defaults
  , altDefaultCompact
  , altDefaultSeparate
  ) where

import           Control.Applicative
import           Control.Arrow
import           Control.Monad                   (MonadPlus, join)
import           Control.Monad.Trans.Except
import           Control.Monad.Trans.Maybe
import           Data.Bifoldable
import           Data.Bifunctor                  (bimap)
import           Data.Either                     (partitionEithers)
import           Data.Foldable                   as F (foldl', toList)
import           Data.Functor.Compose
import qualified Data.Functor.Product            as FP
import qualified Data.IntMap                     as IntMap
import qualified Data.List                       as List
import qualified Data.Map                        as Map
import           Data.Maybe
import           Data.Monoid
import           Data.Proxy
import           Data.Semigroup
import qualified Data.Sequence                   as Seq
import qualified Data.Set                        as Set
import qualified Data.Vector                     as V
import           GHC.Conc
import           GHC.Generics
import           Text.ParserCombinators.ReadP
import           Text.ParserCombinators.ReadPrec

{-|
Class 'Compactable' provides two methods which can be writen in terms of each other, compact and separate.

is generalization of catMaybes as a new function. Compact
has relations with Functor, Applicative, Monad, Alternative, and Traversable.
In that we can use these class to provide the ability to operate on a data type
by throwing away intermediate Nothings. This is useful for representing
stripping out values or failure.

To be compactable alone, no laws must be satisfied other than the type signature.

If the data type is also a Functor the following should hold:

[/Kleisli composition/]

    @fmapMaybe (l <=< r) = fmapMaybe l . fmapMaybe r@

[/Functor identity 1/]

    @compact . fmap Just = id@

[/Functor identity 2/]

    @fmapMaybe Just = id@

[/Functor relation/]

    @compact = fmapMaybe id@

According to Kmett, (Compactable f, Functor f) is a functor from the
kleisli category of Maybe to the category of haskell data types.
@Kleisli Maybe -> Hask@.

If the data type is also Applicative the following should hold:

[/Applicative left identity/]

    @compact . (pure Just \<*\>) = id@

[/Applicative right identity/]

    @applyMaybe (pure Just) = id@

[/Applicative relation/]

    @compact = applyMaybe (pure id)@

If the data type is also a Monad the following should hold:

[/Monad left identity/]

    @flip bindMaybe (return . Just) = id@

[/Monad right identity/]

    @compact . (return . Just =<<) = id@

[/Monad relation/]

    @compact = flip bindMaybe return@

If the data type is also Alternative the following should hold:

[/Alternative identity/]

    @compact empty = empty@

[/Alternative annihilation/]

    @compact (const Nothing \<$\> xs) = empty@

If the data type is also Traversable the following should hold:

[/Traversable Applicative relation/]

    @traverseMaybe (pure . Just) = pure@

[/Traversable composition/]

    @Compose . fmap (traverseMaybe f) . traverseMaybe g = traverseMaybe (Compose . fmap (traverseMaybe f) . g)@

[/Traversable Functor relation/]

    @traverse f = traverseMaybe (fmap Just . f)@

[/Traversable naturality/]

    @t . traverseMaybe f = traverseMaybe (t . f)@

= Separate and filter
have recently elevated roles in this typeclass, and is not as well explored as compact. Here are the laws known today:

[/Functor identity 3/]

    @fst . separate . fmap Right = id@

[/Functor identity 4/]

    @snd . separate . fmap Left = id@

[/Applicative left identity 2/]

    @snd . separate . (pure Right \<*\>) = id@

[/Applicative right identity 2/]

    @fst . separate . (pure Left \<*\>) = id@

[/Alternative annihilation left/]

    @snd . separate . fmap (const Left) = empty@

[/Alternative annihilation right/]

    @fst , separate . fmap (const Right) = empty@

Docs for relationships between these functions and, a cleanup of laws will happen at some point.

If you know of more useful laws, or have better names for the ones above
(especially those marked "name me"). Please let me know.
-}

class Compactable (f :: * -> *) where
    {-# MINIMAL compact | separate #-}

    compact :: f (Maybe a) -> f a
    default compact :: Functor f => f (Maybe a) -> f a
    compact = (f (), f a) -> f a
forall a b. (a, b) -> b
snd ((f (), f a) -> f a)
-> (f (Maybe a) -> (f (), f a)) -> f (Maybe a) -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Either () a) -> (f (), f a)
forall (f :: * -> *) l r.
Compactable f =>
f (Either l r) -> (f l, f r)
separate (f (Either () a) -> (f (), f a))
-> (f (Maybe a) -> f (Either () a)) -> f (Maybe a) -> (f (), f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Either () a) -> f (Maybe a) -> f (Either () a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\case Just a
x -> a -> Either () a
forall a b. b -> Either a b
Right a
x; Maybe a
_ -> () -> Either () a
forall a b. a -> Either a b
Left ())
    {-# INLINABLE compact #-}

    separate :: f (Either l r) -> (f l, f r)
    default separate :: Functor f => f (Either l r) -> (f l, f r)
    separate f (Either l r)
xs = (f (Maybe l) -> f l
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (f (Maybe l) -> f l) -> f (Maybe l) -> f l
forall a b. (a -> b) -> a -> b
$ Either r l -> Maybe l
forall l r. Either l r -> Maybe r
hush (Either r l -> Maybe l)
-> (Either l r -> Either r l) -> Either l r -> Maybe l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either l r -> Either r l
forall a b. Either a b -> Either b a
flipEither (Either l r -> Maybe l) -> f (Either l r) -> f (Maybe l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Either l r)
xs, f (Maybe r) -> f r
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (f (Maybe r) -> f r) -> f (Maybe r) -> f r
forall a b. (a -> b) -> a -> b
$ Either l r -> Maybe r
forall l r. Either l r -> Maybe r
hush (Either l r -> Maybe r) -> f (Either l r) -> f (Maybe r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Either l r)
xs)
    {-# INLINABLE separate #-}

    filter :: (a -> Bool) -> f a -> f a
    default filter :: Functor f => (a -> Bool) -> f a -> f a
    filter a -> Bool
f = (a -> Maybe a) -> f a -> f a
forall (f :: * -> *) a b.
(Compactable f, Functor f) =>
(a -> Maybe b) -> f a -> f b
fmapMaybe ((a -> Maybe a) -> f a -> f a) -> (a -> Maybe a) -> f a -> f a
forall a b. (a -> b) -> a -> b
$ \a
a -> if a -> Bool
f a
a then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing
    {-# INLINABLE filter #-}

    partition :: (a -> Bool) -> f a -> (f a, f a)
    default partition :: Functor f => (a -> Bool) -> f a -> (f a, f a)
    partition a -> Bool
f = (a -> Either a a) -> f a -> (f a, f a)
forall (f :: * -> *) a l r.
(Compactable f, Functor f) =>
(a -> Either l r) -> f a -> (f l, f r)
fmapEither ((a -> Either a a) -> f a -> (f a, f a))
-> (a -> Either a a) -> f a -> (f a, f a)
forall a b. (a -> b) -> a -> b
$ \a
a -> if a -> Bool
f a
a then a -> Either a a
forall a b. b -> Either a b
Right a
a else a -> Either a a
forall a b. a -> Either a b
Left a
a
    {-# INLINEABLE partition #-}

    fmapMaybe :: Functor f => (a -> Maybe b) -> f a -> f b
    fmapMaybe a -> Maybe b
f = f (Maybe b) -> f b
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (f (Maybe b) -> f b) -> (f a -> f (Maybe b)) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> f a -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe b
f
    {-# INLINABLE fmapMaybe #-}

    fmapEither :: Functor f => (a -> Either l r) -> f a -> (f l, f r)
    fmapEither a -> Either l r
f = f (Either l r) -> (f l, f r)
forall (f :: * -> *) l r.
Compactable f =>
f (Either l r) -> (f l, f r)
separate (f (Either l r) -> (f l, f r))
-> (f a -> f (Either l r)) -> f a -> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either l r) -> f a -> f (Either l r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either l r
f
    {-# INLINABLE fmapEither #-}

    applyMaybe :: Applicative f => f (a -> Maybe b) -> f a -> f b
    applyMaybe f (a -> Maybe b)
fa = f (Maybe b) -> f b
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (f (Maybe b) -> f b) -> (f a -> f (Maybe b)) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (a -> Maybe b)
fa f (a -> Maybe b) -> f a -> f (Maybe b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>)
    {-# INLINABLE applyMaybe #-}

    applyEither :: Applicative f => f (a -> Either l r) -> f a -> (f l, f r)
    applyEither f (a -> Either l r)
fa = f (Either l r) -> (f l, f r)
forall (f :: * -> *) l r.
Compactable f =>
f (Either l r) -> (f l, f r)
separate (f (Either l r) -> (f l, f r))
-> (f a -> f (Either l r)) -> f a -> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (a -> Either l r)
fa f (a -> Either l r) -> f a -> f (Either l r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>)
    {-# INLINABLE applyEither #-}

    bindMaybe :: Monad f => f a -> (a -> f (Maybe b)) -> f b
    bindMaybe f a
x = f (Maybe b) -> f b
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (f (Maybe b) -> f b)
-> ((a -> f (Maybe b)) -> f (Maybe b)) -> (a -> f (Maybe b)) -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a
x f a -> (a -> f (Maybe b)) -> f (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
    {-# INLINABLE bindMaybe #-}

    bindEither :: Monad f => f a -> (a -> f (Either l r)) -> (f l, f r)
    bindEither f a
x = f (Either l r) -> (f l, f r)
forall (f :: * -> *) l r.
Compactable f =>
f (Either l r) -> (f l, f r)
separate (f (Either l r) -> (f l, f r))
-> ((a -> f (Either l r)) -> f (Either l r))
-> (a -> f (Either l r))
-> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a
x f a -> (a -> f (Either l r)) -> f (Either l r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
    {-# INLINABLE bindEither #-}

    traverseMaybe :: (Applicative g, Traversable f)
                  => (a -> g (Maybe b)) -> f a -> g (f b)
    traverseMaybe a -> g (Maybe b)
f = (f (Maybe b) -> f b) -> g (f (Maybe b)) -> g (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Maybe b) -> f b
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (g (f (Maybe b)) -> g (f b))
-> (f a -> g (f (Maybe b))) -> f a -> g (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> g (Maybe b)) -> f a -> g (f (Maybe b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> g (Maybe b)
f
    {-# INLINABLE traverseMaybe #-}

    traverseEither :: (Applicative g, Traversable f)
                   => (a -> g (Either l r)) -> f a -> g (f l, f r)
    traverseEither a -> g (Either l r)
f = (f (Either l r) -> (f l, f r))
-> g (f (Either l r)) -> g (f l, f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (Either l r) -> (f l, f r)
forall (f :: * -> *) l r.
Compactable f =>
f (Either l r) -> (f l, f r)
separate (g (f (Either l r)) -> g (f l, f r))
-> (f a -> g (f (Either l r))) -> f a -> g (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> g (Either l r)) -> f a -> g (f (Either l r))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> g (Either l r)
f
    {-# INLINABLE traverseEither #-}


instance Compactable Maybe where
    compact :: Maybe (Maybe a) -> Maybe a
compact = Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    {-# INLINABLE compact #-}
    fmapMaybe :: (a -> Maybe b) -> Maybe a -> Maybe b
fmapMaybe = (a -> Maybe b) -> Maybe a -> Maybe b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<)
    {-# INLINABLE fmapMaybe #-}
    separate :: Maybe (Either l r) -> (Maybe l, Maybe r)
separate = \case
      Just Either l r
x -> case Either l r
x of
         Left l
l  -> (l -> Maybe l
forall a. a -> Maybe a
Just l
l, Maybe r
forall a. Maybe a
Nothing)
         Right r
r -> (Maybe l
forall a. Maybe a
Nothing, r -> Maybe r
forall a. a -> Maybe a
Just r
r)
      Maybe (Either l r)
_ -> (Maybe l
forall a. Maybe a
Nothing, Maybe r
forall a. Maybe a
Nothing)
    {-# INLINABLE separate #-}

instance Monoid m => Compactable (Either m) where
    compact :: Either m (Maybe a) -> Either m a
compact (Right (Just a
x)) = a -> Either m a
forall a b. b -> Either a b
Right a
x
    compact (Right Maybe a
_)        = m -> Either m a
forall a b. a -> Either a b
Left m
forall a. Monoid a => a
mempty
    compact (Left m
x)         = m -> Either m a
forall a b. a -> Either a b
Left m
x
    {-# INLINABLE compact #-}
    fmapMaybe :: (a -> Maybe b) -> Either m a -> Either m b
fmapMaybe a -> Maybe b
f (Right a
x) = Either m b -> (b -> Either m b) -> Maybe b -> Either m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (m -> Either m b
forall a b. a -> Either a b
Left m
forall a. Monoid a => a
mempty) b -> Either m b
forall a b. b -> Either a b
Right (a -> Maybe b
f a
x)
    fmapMaybe a -> Maybe b
_ (Left m
x)  = m -> Either m b
forall a b. a -> Either a b
Left m
x
    {-# INLINABLE fmapMaybe #-}
    separate :: Either m (Either l r) -> (Either m l, Either m r)
separate = \case
      Right (Left l
l) -> (l -> Either m l
forall a b. b -> Either a b
Right l
l, m -> Either m r
forall a b. a -> Either a b
Left m
forall a. Monoid a => a
mempty)
      Right (Right r
r) -> (m -> Either m l
forall a b. a -> Either a b
Left m
forall a. Monoid a => a
mempty, r -> Either m r
forall a b. b -> Either a b
Right r
r)
      Left m
x -> (m -> Either m l
forall a b. a -> Either a b
Left m
x, m -> Either m r
forall a b. a -> Either a b
Left m
x)
    {-# INLINABLE separate #-}

instance Compactable [] where
    compact :: [Maybe a] -> [a]
compact = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes
    {-# INLINABLE compact #-}
    fmapMaybe :: (a -> Maybe b) -> [a] -> [b]
fmapMaybe a -> Maybe b
_ []    = []
    fmapMaybe a -> Maybe b
f (a
h:[a]
t) = [b] -> (b -> [b]) -> Maybe b -> [b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
(Compactable f, Functor f) =>
(a -> Maybe b) -> f a -> f b
fmapMaybe a -> Maybe b
f [a]
t) (b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
(Compactable f, Functor f) =>
(a -> Maybe b) -> f a -> f b
fmapMaybe a -> Maybe b
f [a]
t) (a -> Maybe b
f a
h)
    {-# INLINABLE fmapMaybe #-}
    filter :: (a -> Bool) -> [a] -> [a]
filter = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter
    {-# INLINABLE filter #-}
    partition :: (a -> Bool) -> [a] -> ([a], [a])
partition = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition
    {-# INLINABLE partition #-}
    separate :: [Either l r] -> ([l], [r])
separate = [Either l r] -> ([l], [r])
forall l r. [Either l r] -> ([l], [r])
partitionEithers
    {-# INLINABLE separate #-}
    fmapEither :: (a -> Either l r) -> [a] -> ([l], [r])
fmapEither a -> Either l r
f = (([l], [r]) -> a -> ([l], [r])) -> ([l], [r]) -> [a] -> ([l], [r])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> Either l r) -> ([l], [r]) -> a -> ([l], [r])
forall t a a. (t -> Either a a) -> ([a], [a]) -> t -> ([a], [a])
deal a -> Either l r
f) ([],[])
      where deal :: (t -> Either a a) -> ([a], [a]) -> t -> ([a], [a])
deal t -> Either a a
g ~([a]
bs, [a]
cs) t
a = case t -> Either a a
g t
a of
             Left a
b  -> (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
bs, [a]
cs)
             Right a
c -> ([a]
bs, a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cs)
    {-# INLINABLE fmapEither #-}
    traverseMaybe :: (a -> g (Maybe b)) -> [a] -> g [b]
traverseMaybe a -> g (Maybe b)
f = [a] -> g [b]
go where
      go :: [a] -> g [b]
go (a
x:[a]
xs) = ([b] -> [b]) -> (b -> [b] -> [b]) -> Maybe b -> [b] -> [b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [b] -> [b]
forall a. a -> a
id (:) (Maybe b -> [b] -> [b]) -> g (Maybe b) -> g ([b] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> g (Maybe b)
f a
x g ([b] -> [b]) -> g [b] -> g [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> g [b]
go [a]
xs
      go []     = [b] -> g [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    {-# INLINE traverseMaybe #-}

instance Compactable ZipList where
  compact :: ZipList (Maybe a) -> ZipList a
compact (ZipList [Maybe a]
xs) = [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList ([a] -> ZipList a) -> [a] -> ZipList a
forall a b. (a -> b) -> a -> b
$ [Maybe a] -> [a]
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact [Maybe a]
xs

instance Compactable IO where
    compact :: IO (Maybe a) -> IO a
compact = IO (Maybe a) -> IO a
forall (f :: * -> *) a.
(Alternative f, Monad f) =>
f (Maybe a) -> f a
altDefaultCompact
    {-# INLINABLE compact #-}

instance Compactable STM where
    compact :: STM (Maybe a) -> STM a
compact = STM (Maybe a) -> STM a
forall (f :: * -> *) a.
(Alternative f, Monad f) =>
f (Maybe a) -> f a
altDefaultCompact
    {-# INLINABLE compact #-}

instance Compactable Proxy where
    compact :: Proxy (Maybe a) -> Proxy a
compact Proxy (Maybe a)
_ = Proxy a
forall k (t :: k). Proxy t
Proxy
    {-# INLINABLE compact #-}
    separate :: Proxy (Either l r) -> (Proxy l, Proxy r)
separate Proxy (Either l r)
_ = (Proxy l
forall k (t :: k). Proxy t
Proxy, Proxy r
forall k (t :: k). Proxy t
Proxy)
    {-# INLINABLE separate #-}
    filter :: (a -> Bool) -> Proxy a -> Proxy a
filter a -> Bool
_ Proxy a
_ = Proxy a
forall k (t :: k). Proxy t
Proxy
    {-# INLINABLE filter #-}
    partition :: (a -> Bool) -> Proxy a -> (Proxy a, Proxy a)
partition a -> Bool
_ Proxy a
_ = (Proxy a
forall k (t :: k). Proxy t
Proxy, Proxy a
forall k (t :: k). Proxy t
Proxy)
    {-# INLINABLE partition #-}
    fmapMaybe :: (a -> Maybe b) -> Proxy a -> Proxy b
fmapMaybe a -> Maybe b
_ Proxy a
_ = Proxy b
forall k (t :: k). Proxy t
Proxy
    {-# INLINABLE fmapMaybe #-}
    applyMaybe :: Proxy (a -> Maybe b) -> Proxy a -> Proxy b
applyMaybe Proxy (a -> Maybe b)
_ Proxy a
_ = Proxy b
forall k (t :: k). Proxy t
Proxy
    {-# INLINABLE applyMaybe #-}
    bindMaybe :: Proxy a -> (a -> Proxy (Maybe b)) -> Proxy b
bindMaybe Proxy a
_ a -> Proxy (Maybe b)
_ = Proxy b
forall k (t :: k). Proxy t
Proxy
    {-# INLINABLE bindMaybe #-}
    fmapEither :: (a -> Either l r) -> Proxy a -> (Proxy l, Proxy r)
fmapEither a -> Either l r
_ Proxy a
_ = (Proxy l
forall k (t :: k). Proxy t
Proxy, Proxy r
forall k (t :: k). Proxy t
Proxy)
    {-# INLINABLE fmapEither #-}
    applyEither :: Proxy (a -> Either l r) -> Proxy a -> (Proxy l, Proxy r)
applyEither Proxy (a -> Either l r)
_ Proxy a
_ = (Proxy l
forall k (t :: k). Proxy t
Proxy, Proxy r
forall k (t :: k). Proxy t
Proxy)
    {-# INLINABLE applyEither #-}
    bindEither :: Proxy a -> (a -> Proxy (Either l r)) -> (Proxy l, Proxy r)
bindEither Proxy a
_ a -> Proxy (Either l r)
_ = (Proxy l
forall k (t :: k). Proxy t
Proxy, Proxy r
forall k (t :: k). Proxy t
Proxy)
    {-# INLINABLE bindEither #-}

instance Compactable U1

instance Compactable Option where
    compact :: Option (Maybe a) -> Option a
compact (Option Maybe (Maybe a)
x) = Maybe a -> Option a
forall a. Maybe a -> Option a
Option (Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe a)
x)
    {-# INLINABLE compact #-}
    fmapMaybe :: (a -> Maybe b) -> Option a -> Option b
fmapMaybe a -> Maybe b
f (Option (Just a
x)) = Maybe b -> Option b
forall a. Maybe a -> Option a
Option (a -> Maybe b
f a
x)
    fmapMaybe a -> Maybe b
_ Option a
_                 = Maybe b -> Option b
forall a. Maybe a -> Option a
Option Maybe b
forall a. Maybe a
Nothing
    {-# INLINABLE fmapMaybe #-}
    separate :: Option (Either l r) -> (Option l, Option r)
separate = Option (Either l r) -> (Option l, Option r)
forall (f :: * -> *) l r.
(Alternative f, Foldable f) =>
f (Either l r) -> (f l, f r)
altDefaultSeparate
    {-# INLINABLE separate #-}

instance Compactable ReadP

instance Compactable ReadPrec

instance ( Functor f, Functor g, Compactable f, Compactable g )
         => Compactable (FP.Product f g) where
    compact :: Product f g (Maybe a) -> Product f g a
compact (FP.Pair f (Maybe a)
x g (Maybe a)
y) = f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
FP.Pair (f (Maybe a) -> f a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact f (Maybe a)
x) (g (Maybe a) -> g a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact g (Maybe a)
y)
    {-# INLINABLE compact #-}

instance ( Functor f, Functor g, Compactable g )
         => Compactable (Compose f g) where
    compact :: Compose f g (Maybe a) -> Compose f g a
compact = (Maybe a -> Maybe a) -> Compose f g (Maybe a) -> Compose f g a
forall (f :: * -> *) a b.
(Compactable f, Functor f) =>
(a -> Maybe b) -> f a -> f b
fmapMaybe Maybe a -> Maybe a
forall a. a -> a
id
    {-# INLINABLE compact #-}
    fmapMaybe :: (a -> Maybe b) -> Compose f g a -> Compose f g b
fmapMaybe a -> Maybe b
f (Compose f (g a)
fg) = f (g b) -> Compose f g b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g b) -> Compose f g b) -> f (g b) -> Compose f g b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> g a -> g b
forall (f :: * -> *) a b.
(Compactable f, Functor f) =>
(a -> Maybe b) -> f a -> f b
fmapMaybe a -> Maybe b
f (g a -> g b) -> f (g a) -> f (g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g a)
fg
    {-# INLINABLE fmapMaybe #-}

instance Compactable IntMap.IntMap where
    compact :: IntMap (Maybe a) -> IntMap a
compact = (Maybe a -> Maybe a) -> IntMap (Maybe a) -> IntMap a
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe Maybe a -> Maybe a
forall a. a -> a
id
    {-# INLINABLE compact #-}
    fmapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
fmapMaybe = (a -> Maybe b) -> IntMap a -> IntMap b
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe
    {-# INLINABLE fmapMaybe #-}
    filter :: (a -> Bool) -> IntMap a -> IntMap a
filter = (a -> Bool) -> IntMap a -> IntMap a
forall a. (a -> Bool) -> IntMap a -> IntMap a
IntMap.filter
    {-# INLINABLE filter #-}
    partition :: (a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
partition = (a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
forall a. (a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
IntMap.partition
    {-# INLINABLE partition #-}
    separate :: IntMap (Either l r) -> (IntMap l, IntMap r)
separate = (Either l r -> Either l r)
-> IntMap (Either l r) -> (IntMap l, IntMap r)
forall a b c. (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
IntMap.mapEither Either l r -> Either l r
forall a. a -> a
id
    {-# INLINABLE separate #-}
    fmapEither :: (a -> Either l r) -> IntMap a -> (IntMap l, IntMap r)
fmapEither = (a -> Either l r) -> IntMap a -> (IntMap l, IntMap r)
forall a b c. (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
IntMap.mapEither
    {-# INLINABLE fmapEither #-}

instance Compactable (Map.Map k) where
    compact :: Map k (Maybe a) -> Map k a
compact = (Maybe a -> Maybe a) -> Map k (Maybe a) -> Map k a
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe a -> Maybe a
forall a. a -> a
id
    {-# INLINABLE compact #-}
    fmapMaybe :: (a -> Maybe b) -> Map k a -> Map k b
fmapMaybe = (a -> Maybe b) -> Map k a -> Map k b
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe
    {-# INLINABLE fmapMaybe #-}
    filter :: (a -> Bool) -> Map k a -> Map k a
filter = (a -> Bool) -> Map k a -> Map k a
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter
    {-# INLINABLE filter #-}
    partition :: (a -> Bool) -> Map k a -> (Map k a, Map k a)
partition = (a -> Bool) -> Map k a -> (Map k a, Map k a)
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition
    {-# INLINABLE partition #-}
    separate :: Map k (Either l r) -> (Map k l, Map k r)
separate = (Either l r -> Either l r)
-> Map k (Either l r) -> (Map k l, Map k r)
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither Either l r -> Either l r
forall a. a -> a
id
    {-# INLINABLE separate #-}
    fmapEither :: (a -> Either l r) -> Map k a -> (Map k l, Map k r)
fmapEither = (a -> Either l r) -> Map k a -> (Map k l, Map k r)
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither
    {-# INLINABLE fmapEither #-}

instance Compactable Seq.Seq where
    compact :: Seq (Maybe a) -> Seq a
compact = (Maybe a -> a) -> Seq (Maybe a) -> Seq a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Seq (Maybe a) -> Seq a)
-> (Seq (Maybe a) -> Seq (Maybe a)) -> Seq (Maybe a) -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Bool) -> Seq (Maybe a) -> Seq (Maybe a)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter Maybe a -> Bool
forall a. Maybe a -> Bool
isJust
    {-# INLINABLE compact #-}
    separate :: Seq (Either l r) -> (Seq l, Seq r)
separate = Seq (Either l r) -> (Seq l, Seq r)
forall (f :: * -> *) l r.
(Alternative f, Foldable f) =>
f (Either l r) -> (f l, f r)
altDefaultSeparate
    {-# INLINABLE separate #-}
    filter :: (a -> Bool) -> Seq a -> Seq a
filter = (a -> Bool) -> Seq a -> Seq a
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter
    {-# INLINABLE filter #-}
    partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
partition = (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.partition
    {-# INLINABLE partition #-}


instance Compactable V.Vector where
    compact :: Vector (Maybe a) -> Vector a
compact = Vector (Maybe a) -> Vector a
forall (f :: * -> *) a.
(Alternative f, Monad f) =>
f (Maybe a) -> f a
altDefaultCompact
    {-# INLINABLE compact #-}
    separate :: Vector (Either l r) -> (Vector l, Vector r)
separate = Vector (Either l r) -> (Vector l, Vector r)
forall (f :: * -> *) l r.
(Alternative f, Foldable f) =>
f (Either l r) -> (f l, f r)
altDefaultSeparate
    {-# INLINABLE separate #-}
    filter :: (a -> Bool) -> Vector a -> Vector a
filter = (a -> Bool) -> Vector a -> Vector a
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter
    {-# INLINABLE filter #-}
    partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a)
partition = (a -> Bool) -> Vector a -> (Vector a, Vector a)
forall a. (a -> Bool) -> Vector a -> (Vector a, Vector a)
V.partition
    {-# INLINABLE partition #-}

instance Compactable (Const r) where
    compact :: Const r (Maybe a) -> Const r a
compact (Const r
r) = r -> Const r a
forall k a (b :: k). a -> Const a b
Const r
r
    {-# INLINABLE compact #-}
    fmapMaybe :: (a -> Maybe b) -> Const r a -> Const r b
fmapMaybe a -> Maybe b
_ (Const r
r) = r -> Const r b
forall k a (b :: k). a -> Const a b
Const r
r
    {-# INLINABLE fmapMaybe #-}
    applyMaybe :: Const r (a -> Maybe b) -> Const r a -> Const r b
applyMaybe Const r (a -> Maybe b)
_ (Const r
r) = r -> Const r b
forall k a (b :: k). a -> Const a b
Const r
r
    {-# INLINABLE applyMaybe #-}
    bindMaybe :: Const r a -> (a -> Const r (Maybe b)) -> Const r b
bindMaybe (Const r
r) a -> Const r (Maybe b)
_ = r -> Const r b
forall k a (b :: k). a -> Const a b
Const r
r
    {-# INLINABLE bindMaybe #-}
    fmapEither :: (a -> Either l r) -> Const r a -> (Const r l, Const r r)
fmapEither a -> Either l r
_ (Const r
r) = (r -> Const r l
forall k a (b :: k). a -> Const a b
Const r
r, r -> Const r r
forall k a (b :: k). a -> Const a b
Const r
r)
    {-# INLINABLE fmapEither #-}
    applyEither :: Const r (a -> Either l r) -> Const r a -> (Const r l, Const r r)
applyEither Const r (a -> Either l r)
_ (Const r
r) = (r -> Const r l
forall k a (b :: k). a -> Const a b
Const r
r, r -> Const r r
forall k a (b :: k). a -> Const a b
Const r
r)
    {-# INLINABLE applyEither #-}
    bindEither :: Const r a -> (a -> Const r (Either l r)) -> (Const r l, Const r r)
bindEither (Const r
r) a -> Const r (Either l r)
_ = (r -> Const r l
forall k a (b :: k). a -> Const a b
Const r
r, r -> Const r r
forall k a (b :: k). a -> Const a b
Const r
r)
    {-# INLINABLE bindEither #-}
    filter :: (a -> Bool) -> Const r a -> Const r a
filter a -> Bool
_ (Const r
r) = r -> Const r a
forall k a (b :: k). a -> Const a b
Const r
r
    {-# INLINABLE filter #-}
    partition :: (a -> Bool) -> Const r a -> (Const r a, Const r a)
partition a -> Bool
_ (Const r
r) = (r -> Const r a
forall k a (b :: k). a -> Const a b
Const r
r, r -> Const r a
forall k a (b :: k). a -> Const a b
Const r
r)
    {-# INLINABLE partition #-}

instance Compactable Set.Set where
    compact :: Set (Maybe a) -> Set a
compact = [a] -> Set a
forall a. [a] -> Set a
Set.fromDistinctAscList ([a] -> Set a) -> (Set (Maybe a) -> [a]) -> Set (Maybe a) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe a] -> [a]
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact ([Maybe a] -> [a])
-> (Set (Maybe a) -> [Maybe a]) -> Set (Maybe a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Maybe a) -> [Maybe a]
forall a. Set a -> [a]
Set.toAscList
    {-# INLINABLE compact #-}
    separate :: Set (Either l r) -> (Set l, Set r)
separate = ([l] -> Set l) -> ([r] -> Set r) -> ([l], [r]) -> (Set l, Set r)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [l] -> Set l
forall a. [a] -> Set a
Set.fromDistinctAscList [r] -> Set r
forall a. [a] -> Set a
Set.fromDistinctAscList (([l], [r]) -> (Set l, Set r))
-> (Set (Either l r) -> ([l], [r]))
-> Set (Either l r)
-> (Set l, Set r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either l r] -> ([l], [r])
forall (f :: * -> *) l r.
Compactable f =>
f (Either l r) -> (f l, f r)
separate ([Either l r] -> ([l], [r]))
-> (Set (Either l r) -> [Either l r])
-> Set (Either l r)
-> ([l], [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either l r) -> [Either l r]
forall a. Set a -> [a]
Set.toAscList
    {-# INLINABLE separate #-}
    filter :: (a -> Bool) -> Set a -> Set a
filter = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
Set.filter
    {-# INLINABLE filter #-}
    partition :: (a -> Bool) -> Set a -> (Set a, Set a)
partition = (a -> Bool) -> Set a -> (Set a, Set a)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition
    {-# INLINABLE partition #-}

instance (ArrowPlus a, ArrowApply a) => Compactable (ArrowMonad a) where
instance Monad a => Compactable (WrappedMonad a) where
instance Functor a => Compactable (Rec1 a) where
instance Functor a => Compactable (Alt a) where
instance (Functor a, Functor b) => Compactable (a :*: b)
instance Functor f => Compactable (M1 i c f)
instance (Functor f, Functor g) => Compactable (f :.: g)

newtype AltSum f a = AltSum { AltSum f a -> f a
unAltSum :: f a }
    deriving (a -> AltSum f b -> AltSum f a
(a -> b) -> AltSum f a -> AltSum f b
(forall a b. (a -> b) -> AltSum f a -> AltSum f b)
-> (forall a b. a -> AltSum f b -> AltSum f a)
-> Functor (AltSum f)
forall a b. a -> AltSum f b -> AltSum f a
forall a b. (a -> b) -> AltSum f a -> AltSum f b
forall (f :: * -> *) a b.
Functor f =>
a -> AltSum f b -> AltSum f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> AltSum f a -> AltSum f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AltSum f b -> AltSum f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> AltSum f b -> AltSum f a
fmap :: (a -> b) -> AltSum f a -> AltSum f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> AltSum f a -> AltSum f b
Functor, Functor (AltSum f)
a -> AltSum f a
Functor (AltSum f)
-> (forall a. a -> AltSum f a)
-> (forall a b. AltSum f (a -> b) -> AltSum f a -> AltSum f b)
-> (forall a b c.
    (a -> b -> c) -> AltSum f a -> AltSum f b -> AltSum f c)
-> (forall a b. AltSum f a -> AltSum f b -> AltSum f b)
-> (forall a b. AltSum f a -> AltSum f b -> AltSum f a)
-> Applicative (AltSum f)
AltSum f a -> AltSum f b -> AltSum f b
AltSum f a -> AltSum f b -> AltSum f a
AltSum f (a -> b) -> AltSum f a -> AltSum f b
(a -> b -> c) -> AltSum f a -> AltSum f b -> AltSum f c
forall a. a -> AltSum f a
forall a b. AltSum f a -> AltSum f b -> AltSum f a
forall a b. AltSum f a -> AltSum f b -> AltSum f b
forall a b. AltSum f (a -> b) -> AltSum f a -> AltSum f b
forall a b c.
(a -> b -> c) -> AltSum f a -> AltSum f b -> AltSum f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (f :: * -> *). Applicative f => Functor (AltSum f)
forall (f :: * -> *) a. Applicative f => a -> AltSum f a
forall (f :: * -> *) a b.
Applicative f =>
AltSum f a -> AltSum f b -> AltSum f a
forall (f :: * -> *) a b.
Applicative f =>
AltSum f a -> AltSum f b -> AltSum f b
forall (f :: * -> *) a b.
Applicative f =>
AltSum f (a -> b) -> AltSum f a -> AltSum f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> AltSum f a -> AltSum f b -> AltSum f c
<* :: AltSum f a -> AltSum f b -> AltSum f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
AltSum f a -> AltSum f b -> AltSum f a
*> :: AltSum f a -> AltSum f b -> AltSum f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
AltSum f a -> AltSum f b -> AltSum f b
liftA2 :: (a -> b -> c) -> AltSum f a -> AltSum f b -> AltSum f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> AltSum f a -> AltSum f b -> AltSum f c
<*> :: AltSum f (a -> b) -> AltSum f a -> AltSum f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
AltSum f (a -> b) -> AltSum f a -> AltSum f b
pure :: a -> AltSum f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> AltSum f a
$cp1Applicative :: forall (f :: * -> *). Applicative f => Functor (AltSum f)
Applicative, Applicative (AltSum f)
AltSum f a
Applicative (AltSum f)
-> (forall a. AltSum f a)
-> (forall a. AltSum f a -> AltSum f a -> AltSum f a)
-> (forall a. AltSum f a -> AltSum f [a])
-> (forall a. AltSum f a -> AltSum f [a])
-> Alternative (AltSum f)
AltSum f a -> AltSum f a -> AltSum f a
AltSum f a -> AltSum f [a]
AltSum f a -> AltSum f [a]
forall a. AltSum f a
forall a. AltSum f a -> AltSum f [a]
forall a. AltSum f a -> AltSum f a -> AltSum f a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (f :: * -> *). Alternative f => Applicative (AltSum f)
forall (f :: * -> *) a. Alternative f => AltSum f a
forall (f :: * -> *) a. Alternative f => AltSum f a -> AltSum f [a]
forall (f :: * -> *) a.
Alternative f =>
AltSum f a -> AltSum f a -> AltSum f a
many :: AltSum f a -> AltSum f [a]
$cmany :: forall (f :: * -> *) a. Alternative f => AltSum f a -> AltSum f [a]
some :: AltSum f a -> AltSum f [a]
$csome :: forall (f :: * -> *) a. Alternative f => AltSum f a -> AltSum f [a]
<|> :: AltSum f a -> AltSum f a -> AltSum f a
$c<|> :: forall (f :: * -> *) a.
Alternative f =>
AltSum f a -> AltSum f a -> AltSum f a
empty :: AltSum f a
$cempty :: forall (f :: * -> *) a. Alternative f => AltSum f a
$cp1Alternative :: forall (f :: * -> *). Alternative f => Applicative (AltSum f)
Alternative)
#if __GLASGOW_HASKELL__ > 840
instance Alternative f => Monoid (AltSum f a) where
    mempty = empty
    AltSum a `mappend` AltSum b = AltSum (a <|> b)
#else
instance Alternative f => Semigroup (AltSum f a) where
    AltSum f a
a <> :: AltSum f a -> AltSum f a -> AltSum f a
<> AltSum f a
b = f a -> AltSum f a
forall (f :: * -> *) a. f a -> AltSum f a
AltSum (f a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
b)
instance Alternative f => Monoid (AltSum f a) where
    mappend :: AltSum f a -> AltSum f a -> AltSum f a
mappend = AltSum f a -> AltSum f a -> AltSum f a
forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>)
    mempty :: AltSum f a
mempty = AltSum f a
forall (f :: * -> *) a. Alternative f => f a
empty
#endif


{-|
class `CompactFold` provides the same methods as `Compactable` but generalized to work on any `Foldable`.

When a type has Alternative (or similar) properties, we can extract the Maybe and the Either, and generalize to Foldable and Bifoldable.

Compactable can always be described in terms of CompactFold, because

  @compact = compactFold@

and

  @separate = separateFold@

as it's just a specialization. More exploration is needed on the relationship here.
-}
class Compactable f => CompactFold (f :: * -> *) where
    compactFold :: Foldable g => f (g a) -> f a
    default compactFold :: (Monad f, Alternative f, Foldable g) => f (g a) -> f a
    compactFold = (f (g a) -> (g a -> f a) -> f a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= g a -> f a
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f a -> m a
mfold')
    {-# INLINEABLE compactFold #-}

    separateFold :: Bifoldable g => f (g a b) -> (f a, f b)
    default separateFold :: (Monad f, Alternative f, Bifoldable g) => f (g a b) -> (f a, f b)
    separateFold f (g a b)
xs = (f (g a b)
xs f (g a b) -> (g a b -> f a) -> f a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= g a b -> f a
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Bifoldable f, Alternative m) =>
f a b -> m a
mlefts, f (g a b)
xs f (g a b) -> (g a b -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= g a b -> f b
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Bifoldable f, Alternative m) =>
f a b -> m b
mrights)
    {-# INLINEABLE separateFold #-}

    fmapFold :: (Functor f, Foldable g) => (a -> g b) -> f a -> f b
    fmapFold a -> g b
f = f (g b) -> f b
forall (f :: * -> *) (g :: * -> *) a.
(CompactFold f, Foldable g) =>
f (g a) -> f a
compactFold (f (g b) -> f b) -> (f a -> f (g b)) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> g b) -> f a -> f (g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> g b
f
    {-# INLINABLE fmapFold #-}

    fmapBifold :: (Functor f, Bifoldable g) => (a -> g l r) -> f a -> (f l, f r)
    fmapBifold a -> g l r
f = f (g l r) -> (f l, f r)
forall (f :: * -> *) (g :: * -> * -> *) a b.
(CompactFold f, Bifoldable g) =>
f (g a b) -> (f a, f b)
separateFold (f (g l r) -> (f l, f r))
-> (f a -> f (g l r)) -> f a -> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> g l r) -> f a -> f (g l r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> g l r
f
    {-# INLINABLE fmapBifold #-}

    applyFold :: (Applicative f, Foldable g) => f (a -> g b) -> f a -> f b
    applyFold f (a -> g b)
f = f (g b) -> f b
forall (f :: * -> *) (g :: * -> *) a.
(CompactFold f, Foldable g) =>
f (g a) -> f a
compactFold (f (g b) -> f b) -> (f a -> f (g b)) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (a -> g b)
f f (a -> g b) -> f a -> f (g b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>)
    {-# INLINABLE applyFold #-}

    applyBifold :: (Applicative f, Bifoldable g) => f (a -> g l r) -> f a -> (f l, f r)
    applyBifold f (a -> g l r)
fa = f (g l r) -> (f l, f r)
forall (f :: * -> *) (g :: * -> * -> *) a b.
(CompactFold f, Bifoldable g) =>
f (g a b) -> (f a, f b)
separateFold (f (g l r) -> (f l, f r))
-> (f a -> f (g l r)) -> f a -> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (a -> g l r)
fa f (a -> g l r) -> f a -> f (g l r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>)
    {-# INLINABLE applyBifold #-}

    bindFold :: (Monad f, Foldable g) => f a -> (a -> f (g b)) -> f b
    bindFold f a
f = f (g b) -> f b
forall (f :: * -> *) (g :: * -> *) a.
(CompactFold f, Foldable g) =>
f (g a) -> f a
compactFold (f (g b) -> f b)
-> ((a -> f (g b)) -> f (g b)) -> (a -> f (g b)) -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a
f f a -> (a -> f (g b)) -> f (g b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
    {-# INLINABLE bindFold #-}

    bindBifold :: (Monad f, Bifoldable g) => f a -> (a -> f (g l r)) -> (f l, f r)
    bindBifold f a
f = f (g l r) -> (f l, f r)
forall (f :: * -> *) (g :: * -> * -> *) a b.
(CompactFold f, Bifoldable g) =>
f (g a b) -> (f a, f b)
separateFold (f (g l r) -> (f l, f r))
-> ((a -> f (g l r)) -> f (g l r))
-> (a -> f (g l r))
-> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a
f f a -> (a -> f (g l r)) -> f (g l r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)
    {-# INLINABLE bindBifold  #-}

    traverseFold :: (Applicative h, Foldable g, Traversable f) => (a -> h (g b)) -> f a -> h (f b)
    traverseFold a -> h (g b)
f = (f (g b) -> f b) -> h (f (g b)) -> h (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (g b) -> f b
forall (f :: * -> *) (g :: * -> *) a.
(CompactFold f, Foldable g) =>
f (g a) -> f a
compactFold (h (f (g b)) -> h (f b)) -> (f a -> h (f (g b))) -> f a -> h (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> h (g b)) -> f a -> h (f (g b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> h (g b)
f
    {-# INLINABLE traverseFold #-}

    traverseBifold :: (Applicative h, Bifoldable g, Traversable f) => (a -> h (g l r)) -> f a -> h (f l, f r)
    traverseBifold a -> h (g l r)
f = (f (g l r) -> (f l, f r)) -> h (f (g l r)) -> h (f l, f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (g l r) -> (f l, f r)
forall (f :: * -> *) (g :: * -> * -> *) a b.
(CompactFold f, Bifoldable g) =>
f (g a b) -> (f a, f b)
separateFold (h (f (g l r)) -> h (f l, f r))
-> (f a -> h (f (g l r))) -> f a -> h (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> h (g l r)) -> f a -> h (f (g l r))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> h (g l r)
f
    {-# INLINABLE traverseBifold #-}


mfold' :: (Foldable f, Alternative m) => f a -> m a
mfold' :: f a -> m a
mfold' = AltSum m a -> m a
forall (f :: * -> *) a. AltSum f a -> f a
unAltSum (AltSum m a -> m a) -> (f a -> AltSum m a) -> f a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> AltSum m a) -> f a -> AltSum m a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m a -> AltSum m a
forall (f :: * -> *) a. f a -> AltSum f a
AltSum (m a -> AltSum m a) -> (a -> m a) -> a -> AltSum m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

mlefts :: (Bifoldable f, Alternative m) => f a b -> m a
mlefts :: f a b -> m a
mlefts = AltSum m a -> m a
forall (f :: * -> *) a. AltSum f a -> f a
unAltSum (AltSum m a -> m a) -> (f a b -> AltSum m a) -> f a b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> AltSum m a) -> (b -> AltSum m a) -> f a b -> AltSum m a
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (m a -> AltSum m a
forall (f :: * -> *) a. f a -> AltSum f a
AltSum (m a -> AltSum m a) -> (a -> m a) -> a -> AltSum m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (AltSum m a -> b -> AltSum m a
forall a b. a -> b -> a
const AltSum m a
forall a. Monoid a => a
mempty)

mrights :: (Bifoldable f, Alternative m) => f a b -> m b
mrights :: f a b -> m b
mrights = AltSum m b -> m b
forall (f :: * -> *) a. AltSum f a -> f a
unAltSum (AltSum m b -> m b) -> (f a b -> AltSum m b) -> f a b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> AltSum m b) -> (b -> AltSum m b) -> f a b -> AltSum m b
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (AltSum m b -> a -> AltSum m b
forall a b. a -> b -> a
const AltSum m b
forall a. Monoid a => a
mempty) (m b -> AltSum m b
forall (f :: * -> *) a. f a -> AltSum f a
AltSum (m b -> AltSum m b) -> (b -> m b) -> b -> AltSum m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure)


instance CompactFold [] where
    compactFold :: [g a] -> [a]
compactFold = ([g a] -> (g a -> [a]) -> [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= g a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList)
    {-# INLINEABLE compactFold #-}

instance CompactFold Maybe
instance CompactFold IO
instance CompactFold ReadP
instance CompactFold ReadPrec
instance CompactFold STM
instance CompactFold ZipList where
  compactFold :: ZipList (g a) -> ZipList a
compactFold (ZipList [g a]
xs) = [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList ([a] -> ZipList a) -> [a] -> ZipList a
forall a b. (a -> b) -> a -> b
$ [g a] -> [a]
forall (f :: * -> *) (g :: * -> *) a.
(CompactFold f, Foldable g) =>
f (g a) -> f a
compactFold [g a]
xs
  separateFold :: ZipList (g a b) -> (ZipList a, ZipList b)
separateFold (ZipList [g a b]
xs) = ([a] -> ZipList a)
-> ([b] -> ZipList b) -> ([a], [b]) -> (ZipList a, ZipList b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList [b] -> ZipList b
forall a. [a] -> ZipList a
ZipList (([a], [b]) -> (ZipList a, ZipList b))
-> ([a], [b]) -> (ZipList a, ZipList b)
forall a b. (a -> b) -> a -> b
$ [g a b] -> ([a], [b])
forall (f :: * -> *) (g :: * -> * -> *) a b.
(CompactFold f, Bifoldable g) =>
f (g a b) -> (f a, f b)
separateFold [g a b]
xs
instance CompactFold Option
instance CompactFold U1
instance CompactFold Proxy
instance (ArrowPlus a, ArrowApply a) => CompactFold (ArrowMonad a)
instance MonadPlus a => CompactFold (WrappedMonad a)
instance (Alternative a, Monad a) => CompactFold (Rec1 a)
instance (Alternative a, Monad a) => CompactFold (Alt a)
instance (Alternative f, Monad f, Alternative g, Monad g) => CompactFold (f :*: g)
instance (Compactable f, Alternative f, Monad f, Compactable g, Alternative g, Monad g) => CompactFold (FP.Product f g)
instance (Alternative f, Monad f) => CompactFold (M1 i c f)


fforMaybe :: (Compactable f, Functor f) => f a -> (a -> Maybe b) -> f b
fforMaybe :: f a -> (a -> Maybe b) -> f b
fforMaybe = ((a -> Maybe b) -> f a -> f b) -> f a -> (a -> Maybe b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Maybe b) -> f a -> f b
forall (f :: * -> *) a b.
(Compactable f, Functor f) =>
(a -> Maybe b) -> f a -> f b
fmapMaybe


fforFold :: (CompactFold f, Functor f, Foldable g) => f a -> (a -> g b) -> f b
fforFold :: f a -> (a -> g b) -> f b
fforFold = ((a -> g b) -> f a -> f b) -> f a -> (a -> g b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> g b) -> f a -> f b
forall (f :: * -> *) (g :: * -> *) a b.
(CompactFold f, Functor f, Foldable g) =>
(a -> g b) -> f a -> f b
fmapFold


fforEither :: (Compactable f, Functor f) => f a -> (a -> Either l r) -> (f l, f r)
fforEither :: f a -> (a -> Either l r) -> (f l, f r)
fforEither = ((a -> Either l r) -> f a -> (f l, f r))
-> f a -> (a -> Either l r) -> (f l, f r)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Either l r) -> f a -> (f l, f r)
forall (f :: * -> *) a l r.
(Compactable f, Functor f) =>
(a -> Either l r) -> f a -> (f l, f r)
fmapEither


fforBifold :: (CompactFold f, Functor f, Bifoldable g) => f a -> (a -> g l r) -> (f l, f r)
fforBifold :: f a -> (a -> g l r) -> (f l, f r)
fforBifold = ((a -> g l r) -> f a -> (f l, f r))
-> f a -> (a -> g l r) -> (f l, f r)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> g l r) -> f a -> (f l, f r)
forall (f :: * -> *) (g :: * -> * -> *) a l r.
(CompactFold f, Functor f, Bifoldable g) =>
(a -> g l r) -> f a -> (f l, f r)
fmapBifold


fmapMaybeM :: (Compactable f, Monad f) => (a -> MaybeT f b) -> f a -> f b
fmapMaybeM :: (a -> MaybeT f b) -> f a -> f b
fmapMaybeM a -> MaybeT f b
f = (f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f (Maybe b) -> f b
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (f (Maybe b) -> f b) -> (a -> f (Maybe b)) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT f b -> f (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT f b -> f (Maybe b))
-> (a -> MaybeT f b) -> a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MaybeT f b
f)


fforMaybeM :: (Compactable f, Monad f) => f a -> (a -> MaybeT f b) -> f b
fforMaybeM :: f a -> (a -> MaybeT f b) -> f b
fforMaybeM = ((a -> MaybeT f b) -> f a -> f b)
-> f a -> (a -> MaybeT f b) -> f b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> MaybeT f b) -> f a -> f b
forall (f :: * -> *) a b.
(Compactable f, Monad f) =>
(a -> MaybeT f b) -> f a -> f b
fmapMaybeM


fmapEitherM :: (Compactable f, Monad f) => (a -> ExceptT l f r) -> f a -> (f l, f r)
fmapEitherM :: (a -> ExceptT l f r) -> f a -> (f l, f r)
fmapEitherM a -> ExceptT l f r
f f a
x = f (Either l r) -> (f l, f r)
forall (f :: * -> *) l r.
Compactable f =>
f (Either l r) -> (f l, f r)
separate (f (Either l r) -> (f l, f r)) -> f (Either l r) -> (f l, f r)
forall a b. (a -> b) -> a -> b
$ ExceptT l f r -> f (Either l r)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT l f r -> f (Either l r))
-> (a -> ExceptT l f r) -> a -> f (Either l r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExceptT l f r
f (a -> f (Either l r)) -> f a -> f (Either l r)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< f a
x


fforEitherM :: (Compactable f, Monad f) => f a -> (a -> ExceptT l f r) -> (f l, f r)
fforEitherM :: f a -> (a -> ExceptT l f r) -> (f l, f r)
fforEitherM = ((a -> ExceptT l f r) -> f a -> (f l, f r))
-> f a -> (a -> ExceptT l f r) -> (f l, f r)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> ExceptT l f r) -> f a -> (f l, f r)
forall (f :: * -> *) a l r.
(Compactable f, Monad f) =>
(a -> ExceptT l f r) -> f a -> (f l, f r)
fmapEitherM


applyMaybeM :: (Compactable f, Monad f) => f (a -> MaybeT f b) -> f a -> f b
applyMaybeM :: f (a -> MaybeT f b) -> f a -> f b
applyMaybeM f (a -> MaybeT f b)
fa = f (Maybe b) -> f b
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (f (Maybe b) -> f b) -> (f a -> f (Maybe b)) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f (Maybe b)) -> f (Maybe b)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (f (f (Maybe b)) -> f (Maybe b))
-> (f a -> f (f (Maybe b))) -> f a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MaybeT f b -> f (Maybe b)) -> f (MaybeT f b) -> f (f (Maybe b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MaybeT f b -> f (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (f (MaybeT f b) -> f (f (Maybe b)))
-> (f a -> f (MaybeT f b)) -> f a -> f (f (Maybe b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (a -> MaybeT f b)
fa f (a -> MaybeT f b) -> f a -> f (MaybeT f b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>)


bindMaybeM :: (Compactable f, Monad f) => f a -> (a -> f (MaybeT f b)) -> f b
bindMaybeM :: f a -> (a -> f (MaybeT f b)) -> f b
bindMaybeM f a
x = f (Maybe b) -> f b
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (f (Maybe b) -> f b)
-> ((a -> f (MaybeT f b)) -> f (Maybe b))
-> (a -> f (MaybeT f b))
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (f (Maybe b)) -> f (Maybe b)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (f (f (Maybe b)) -> f (Maybe b))
-> ((a -> f (MaybeT f b)) -> f (f (Maybe b)))
-> (a -> f (MaybeT f b))
-> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MaybeT f b -> f (Maybe b)) -> f (MaybeT f b) -> f (f (Maybe b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MaybeT f b -> f (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (f (MaybeT f b) -> f (f (Maybe b)))
-> ((a -> f (MaybeT f b)) -> f (MaybeT f b))
-> (a -> f (MaybeT f b))
-> f (f (Maybe b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a
x f a -> (a -> f (MaybeT f b)) -> f (MaybeT f b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=)


traverseMaybeM :: (Monad m, Compactable t, Traversable t) => (a -> MaybeT m b) -> t a -> m (t b)
traverseMaybeM :: (a -> MaybeT m b) -> t a -> m (t b)
traverseMaybeM a -> MaybeT m b
f = WrappedMonad m (t b) -> m (t b)
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad m (t b) -> m (t b))
-> (t a -> WrappedMonad m (t b)) -> t a -> m (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> WrappedMonad m (Maybe b)) -> t a -> WrappedMonad m (t b)
forall (f :: * -> *) (g :: * -> *) a b.
(Compactable f, Applicative g, Traversable f) =>
(a -> g (Maybe b)) -> f a -> g (f b)
traverseMaybe (m (Maybe b) -> WrappedMonad m (Maybe b)
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (m (Maybe b) -> WrappedMonad m (Maybe b))
-> (a -> m (Maybe b)) -> a -> WrappedMonad m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT m b -> m (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m b -> m (Maybe b))
-> (a -> MaybeT m b) -> a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MaybeT m b
f)

-- | While more constrained, when available, this default is going to be faster than the one provided in the typeclass
altDefaultCompact :: (Alternative f, Monad f) => f (Maybe a) -> f a
altDefaultCompact :: f (Maybe a) -> f a
altDefaultCompact = (f (Maybe a) -> (Maybe a -> f a) -> f a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= f a -> (a -> f a) -> Maybe a -> f a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f a
forall (f :: * -> *) a. Alternative f => f a
empty a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return)
{-# INLINABLE altDefaultCompact #-}

-- | While more constrained, when available, this default is going to be faster than the one provided in the typeclass
altDefaultSeparate :: (Alternative f, Foldable f) => f (Either l r) -> (f l, f r)
altDefaultSeparate :: f (Either l r) -> (f l, f r)
altDefaultSeparate = ((f l, f r) -> Either l r -> (f l, f r))
-> (f l, f r) -> f (Either l r) -> (f l, f r)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(f l
l', f r
r') -> \case
  Left l
l  -> (f l
l' f l -> f l -> f l
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> l -> f l
forall (f :: * -> *) a. Applicative f => a -> f a
pure l
l ,f r
r')
  Right r
r -> (f l
l', f r
r' f r -> f r -> f r
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> r -> f r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r)) (f l
forall (f :: * -> *) a. Alternative f => f a
empty, f r
forall (f :: * -> *) a. Alternative f => f a
empty)
{-# INLINABLE altDefaultSeparate #-}


hush :: Either l r -> Maybe r
hush :: Either l r -> Maybe r
hush = \case (Right r
x) -> r -> Maybe r
forall a. a -> Maybe a
Just r
x; Either l r
_ -> Maybe r
forall a. Maybe a
Nothing


flipEither :: Either a b -> Either b a
flipEither :: Either a b -> Either b a
flipEither = \case (Right b
x) -> b -> Either b a
forall a b. a -> Either a b
Left b
x; (Left a
x) -> a -> Either b a
forall a b. b -> Either a b
Right a
x