{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ConstrainedClassMethods    #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeOperators              #-}


module Control.Functor.Compactable
  (
  -- * Compact
    Compactable (..)
  , separate
  -- * Handly flips
  , fforMaybe
  , fforThese
  -- * More general lefts and rights
  , mfold'
  , mlefts
  , mrights
  -- * Monad Transformer utils
  , mapMaybeM
  , mapTheseM
  , fforMaybeM
  , fforTheseM
  , applyMaybeM
  , bindMaybeM
  , traverseMaybeM
  -- * Alternative Defaults
  , altDefaultCompact
  , altDefaultSeparate

  ) where


import           Control.Applicative         (Alternative (empty, (<|>)),
                                              Const (Const), WrappedMonad (..),
                                              ZipList (ZipList))
import           Control.Monad               (join, (<=<))
import           Control.Monad.Trans.Except  (ExceptT, runExceptT)
import           Control.Monad.Trans.Maybe   (MaybeT (runMaybeT))
import           Data.Bifunctor              (bimap)
import           Data.Foldable               as F (foldl', foldr')
import           Data.Functor.Compose        (Compose (Compose))
import           Data.Functor.Contravariant  (Contravariant (contramap))
import qualified Data.Functor.Product        as FP
import           Data.Kind                   (Type)
import qualified Data.List                   as List
import qualified Data.Map                    as Map
import qualified Data.Maybe                  as May
import           Data.Monoid                 (Alt (Alt))
import           Data.Proxy                  (Proxy (..))
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as Set
import qualified Data.Vector                 as V
import           GHC.Conc                    (STM)
import           GHC.Generics                (M1 (M1), Rec1 (Rec1), U1 (U1),
                                              type (:*:) ((:*:)),
                                              type (:.:) (Comp1))

import           Data.These                  (These (..), these)

import           Control.Functor.Dichotomous (Dichotomous (dichotomy), hushLeft,
                                              hushRight, mfold', mlefts,
                                              mrights)
import qualified Data.IntMap                 as IntMap
#if __GLASGOW_HASKELL__ < 900
import           Data.Semigroup              (Option (Option))
#endif


separateMap :: (Dichotomous g, Functor f, Compactable f) => (a -> g l r) -> f a -> (f l, f r)
separateMap :: (a -> g l r) -> f a -> (f l, f r)
separateMap a -> g l r
f = f (These l r) -> (f l, f r)
forall (g :: * -> * -> *) (f :: * -> *) l r.
(Dichotomous g, Functor f, Compactable f) =>
f (g l r) -> (f l, f r)
separate (f (These l r) -> (f l, f r))
-> (f a -> f (These l r)) -> f a -> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe (These l r)) -> f a -> f (These l r)
forall (f :: * -> *) a b.
(Compactable f, Functor f) =>
(a -> Maybe b) -> f a -> f b
mapMaybe (g l r -> Maybe (These l r)
forall (f :: * -> * -> *) a b.
Dichotomous f =>
f a b -> Maybe (These a b)
dichotomy (g l r -> Maybe (These l r))
-> (a -> g l r) -> a -> Maybe (These l r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> g l r
f)
{-# INLINABLE separateMap #-}


separate :: (Dichotomous g, Functor f, Compactable f) => f (g l r) -> (f l, f r)
separate :: f (g l r) -> (f l, f r)
separate = f (These l r) -> (f l, f r)
forall (f :: * -> *) l r.
Compactable f =>
f (These l r) -> (f l, f r)
separateThese (f (These l r) -> (f l, f r))
-> (f (g l r) -> f (These l r)) -> f (g l r) -> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (g l r -> Maybe (These l r)) -> f (g l r) -> f (These l r)
forall (f :: * -> *) a b.
(Compactable f, Functor f) =>
(a -> Maybe b) -> f a -> f b
mapMaybe g l r -> Maybe (These l r)
forall (f :: * -> * -> *) a b.
Dichotomous f =>
f a b -> Maybe (These a b)
dichotomy
{-# INLINABLE separate #-}


-- | A generalization of catMaybes
--
-- prop> compact . map Just = id
-- prop> compact . mapMaybe id
-- prop> compact (pure Just <*> a) = a
-- prop> applyMaybe (pure Just) = id
-- prop> applyMaybe (pure id) = compact
-- prop> bindMaybe (return . Just) = id
-- prop> bindMaybe return = compact
-- prop> compact (return . Just =<< a) = a
-- prop> mapMaybe (l <=< r) = mapMaybe l . mapMaybe r
-- prop> compact (Nothing <$ a) = empty
-- prop> compact (Nothing <$ a) = mempty
-- prop> compact empty = empty
-- prop> compact mempty = mempty
-- prop> traverseMaybe (Just . Just) = Just
-- prop> traverseMaybe (map Just . f) = traverse f
class Compactable (f :: Type -> Type) where
  {-# MINIMAL compact | separateThese #-}

  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 (These () a) -> (f (), f a)
forall (g :: * -> * -> *) (f :: * -> *) l r.
(Dichotomous g, Functor f, Compactable f) =>
f (g l r) -> (f l, f r)
separate (f (These () a) -> (f (), f a))
-> (f (Maybe a) -> f (These () a)) -> f (Maybe a) -> (f (), f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> These () a) -> f (Maybe a) -> f (These () a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\case Just a
x -> a -> These () a
forall a b. b -> These a b
That a
x; Maybe a
_ -> () -> These () a
forall a b. a -> These a b
This ())
  {-# INLINABLE compact #-}

  separateThese :: f (These l r) -> (f l, f r)
  default separateThese :: Functor f => f (These l r) -> (f l, f r)
  separateThese f (These 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
$ These l r -> Maybe l
forall (g :: * -> * -> *) l r. Dichotomous g => g l r -> Maybe l
hushRight (These l r -> Maybe l) -> f (These l r) -> f (Maybe l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (These 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
$ These l r -> Maybe r
forall (g :: * -> * -> *) l r. Dichotomous g => g l r -> Maybe r
hushLeft (These l r -> Maybe r) -> f (These l r) -> f (Maybe r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (These l r)
xs)
  {-# INLINABLE separateThese #-}

  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
mapMaybe ((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 (g :: * -> * -> *) (f :: * -> *) a l r.
(Dichotomous g, Functor f, Compactable f) =>
(a -> g l r) -> f a -> (f l, f r)
separateMap ((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 #-}

  mapMaybe :: Functor f => (a -> Maybe b) -> f a -> f b
  mapMaybe 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 mapMaybe #-}

  contramapMaybe :: Contravariant f => (Maybe b -> a) -> f a -> f b
  contramapMaybe Maybe b -> a
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
. (Maybe b -> a) -> f a -> f (Maybe b)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Maybe b -> a
f
  {-# INLINABLE contramapMaybe #-}

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

  contramapThese :: Contravariant f => (These l r -> a) -> f a -> (f l, f r)
  contramapThese These l r -> a
f = f (These l r) -> (f l, f r)
forall (f :: * -> *) l r.
Compactable f =>
f (These l r) -> (f l, f r)
separateThese (f (These l r) -> (f l, f r))
-> (f a -> f (These l r)) -> f a -> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (These l r -> a) -> f a -> f (These l r)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap These l r -> a
f
  {-# INLINEABLE contramapThese #-}

  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 #-}

  applyThese :: Applicative f => f (a -> These l r) -> f a -> (f l, f r)
  applyThese f (a -> These l r)
fa = f (These l r) -> (f l, f r)
forall (g :: * -> * -> *) (f :: * -> *) l r.
(Dichotomous g, Functor f, Compactable f) =>
f (g l r) -> (f l, f r)
separate (f (These l r) -> (f l, f r))
-> (f a -> f (These l r)) -> f a -> (f l, f r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f (a -> These l r)
fa f (a -> These l r) -> f a -> f (These l r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>)
  {-# INLINABLE applyThese #-}

  bindMaybe :: Monad f => (a -> f (Maybe b)) -> f a -> f b
  bindMaybe a -> f (Maybe b)
f f a
x = f (Maybe b) -> f b
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (f (Maybe b) -> f b) -> f (Maybe b) -> f b
forall a b. (a -> b) -> a -> b
$ 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
>>= a -> f (Maybe b)
f
  {-# INLINABLE bindMaybe #-}

  bindThese :: Monad f => (a -> f (These l r)) -> f a -> (f l, f r)
  bindThese a -> f (These l r)
f f a
x = f (These l r) -> (f l, f r)
forall (g :: * -> * -> *) (f :: * -> *) l r.
(Dichotomous g, Functor f, Compactable f) =>
f (g l r) -> (f l, f r)
separate (f (These l r) -> (f l, f r)) -> f (These l r) -> (f l, f r)
forall a b. (a -> b) -> a -> b
$ f a
x f a -> (a -> f (These l r)) -> f (These l r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> f (These l r)
f
  {-# INLINABLE bindThese #-}

  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 #-}

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


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 #-}
    mapMaybe :: (a -> Maybe b) -> Maybe a -> Maybe b
mapMaybe = (a -> Maybe b) -> Maybe a -> Maybe b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<)
    {-# INLINABLE mapMaybe #-}
    separateThese :: Maybe (These l r) -> (Maybe l, Maybe r)
separateThese = \case
      Just These l r
x -> case These l r
x of
        This  l
l   -> (l -> Maybe l
forall a. a -> Maybe a
Just l
l, Maybe r
forall a. Maybe a
Nothing)
        That    r
r -> (Maybe l
forall a. Maybe a
Nothing, r -> Maybe r
forall a. a -> Maybe a
Just r
r)
        These l
l r
r -> (l -> Maybe l
forall a. a -> Maybe a
Just l
l, r -> Maybe r
forall a. a -> Maybe a
Just r
r)
      Maybe (These l r)
_ -> (Maybe l
forall a. Maybe a
Nothing, Maybe r
forall a. Maybe a
Nothing)
    {-# INLINABLE separateThese #-}


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 #-}
    mapMaybe :: (a -> Maybe b) -> Either m a -> Either m b
mapMaybe 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)
    mapMaybe a -> Maybe b
_ (Left m
x)  = m -> Either m b
forall a b. a -> Either a b
Left m
x
    {-# INLINABLE mapMaybe #-}
    separateThese :: Either m (These l r) -> (Either m l, Either m r)
separateThese = \case
      Right (This  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 (That    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)
      Right (These l
l r
r) -> (l -> Either m l
forall a b. b -> Either a b
Right l
l, 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 separateThese #-}

instance Monoid m => Compactable (These m) where
  compact :: These m (Maybe a) -> These m a
compact = \case
    This m
x           -> m -> These m a
forall a b. a -> These a b
This m
x
    That (Just a
x)    -> a -> These m a
forall a b. b -> These a b
That a
x
    That Maybe a
Nothing     -> m -> These m a
forall a b. a -> These a b
This m
forall a. Monoid a => a
mempty
    These m
x (Just a
y) -> m -> a -> These m a
forall a b. a -> b -> These a b
These m
x a
y
    These m
x Maybe a
Nothing  -> m -> These m a
forall a b. a -> These a b
This m
x
  {-# INLINABLE compact #-}

instance Compactable [] where
    compact :: [Maybe a] -> [a]
compact = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
May.catMaybes
    {-# INLINABLE compact #-}
    mapMaybe :: (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
_ []    = []
    mapMaybe 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
mapMaybe 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
mapMaybe a -> Maybe b
f [a]
t) (a -> Maybe b
f a
h)
    {-# INLINABLE mapMaybe #-}
    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 #-}
    separateThese :: [These l r] -> ([l], [r])
separateThese = (These l r -> ([l], [r]) -> ([l], [r]))
-> ([l], [r]) -> [These l r] -> ([l], [r])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((l -> ([l], [r]) -> ([l], [r]))
-> (r -> ([l], [r]) -> ([l], [r]))
-> (l -> r -> ([l], [r]) -> ([l], [r]))
-> These l r
-> ([l], [r])
-> ([l], [r])
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these l -> ([l], [r]) -> ([l], [r])
forall a b. a -> ([a], b) -> ([a], b)
l_ r -> ([l], [r]) -> ([l], [r])
forall a a. a -> (a, [a]) -> (a, [a])
r_ l -> r -> ([l], [r]) -> ([l], [r])
forall a a. a -> a -> ([a], [a]) -> ([a], [a])
lr_) ([],[])
      where
      l_ :: a -> ([a], b) -> ([a], b)
l_  a
a   ~([a]
l, b
r) = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
l,   b
r)
      r_ :: a -> (a, [a]) -> (a, [a])
r_    a
b ~(a
l, [a]
r) = (  a
l, a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)
      lr_ :: a -> a -> ([a], [a]) -> ([a], [a])
lr_ a
a a
b ~([a]
l, [a]
r) = (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
l, a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
r)
    {-# INLINABLE separateThese #-}
    mapThese :: (a -> These l r) -> [a] -> ([l], [r])
mapThese a -> These l r
f = (a -> ([l], [r]) -> ([l], [r])) -> ([l], [r]) -> [a] -> ([l], [r])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' a -> ([l], [r]) -> ([l], [r])
deal ([],[])
      where deal :: a -> ([l], [r]) -> ([l], [r])
deal a
a ~([l]
bs, [r]
cs) = case a -> These l r
f a
a of
             This  l
b   -> (l
bl -> [l] -> [l]
forall a. a -> [a] -> [a]
:[l]
bs,   [r]
cs)
             That    r
c -> (  [l]
bs, r
cr -> [r] -> [r]
forall a. a -> [a] -> [a]
:[r]
cs)
             These l
b r
c -> (l
bl -> [l] -> [l]
forall a. a -> [a] -> [a]
:[l]
bs, r
cr -> [r] -> [r]
forall a. a -> [a] -> [a]
:[r]
cs)
    {-# INLINABLE mapThese #-}
    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)
x = IO (Maybe a)
x IO (Maybe a) -> (Maybe a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IO a
forall a. HasCallStack => [Char] -> a
error [Char]
"compact called on (x :: IO (Maybe _)) where x = return Nothing") a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    {-# NOINLINE 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 #-}
    separateThese :: Proxy (These l r) -> (Proxy l, Proxy r)
separateThese Proxy (These l r)
_ = (Proxy l
forall k (t :: k). Proxy t
Proxy, Proxy r
forall k (t :: k). Proxy t
Proxy)
    {-# INLINABLE separateThese #-}
    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 #-}
    mapMaybe :: (a -> Maybe b) -> Proxy a -> Proxy b
mapMaybe a -> Maybe b
_ Proxy a
_ = Proxy b
forall k (t :: k). Proxy t
Proxy
    {-# INLINABLE mapMaybe #-}
    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 :: (a -> Proxy (Maybe b)) -> Proxy a -> Proxy b
bindMaybe a -> Proxy (Maybe b)
_ Proxy a
_ = Proxy b
forall k (t :: k). Proxy t
Proxy
    {-# INLINABLE bindMaybe #-}
    mapThese :: (a -> These l r) -> Proxy a -> (Proxy l, Proxy r)
mapThese a -> These l r
_ Proxy a
_ = (Proxy l
forall k (t :: k). Proxy t
Proxy, Proxy r
forall k (t :: k). Proxy t
Proxy)
    {-# INLINABLE mapThese #-}
    applyThese :: Proxy (a -> These l r) -> Proxy a -> (Proxy l, Proxy r)
applyThese Proxy (a -> These l r)
_ Proxy a
_ = (Proxy l
forall k (t :: k). Proxy t
Proxy, Proxy r
forall k (t :: k). Proxy t
Proxy)
    {-# INLINABLE applyThese #-}
    bindThese :: (a -> Proxy (These l r)) -> Proxy a -> (Proxy l, Proxy r)
bindThese a -> Proxy (These l r)
_ Proxy a
_ = (Proxy l
forall k (t :: k). Proxy t
Proxy, Proxy r
forall k (t :: k). Proxy t
Proxy)
    {-# INLINABLE bindThese #-}


instance Compactable U1
  where compact :: U1 (Maybe a) -> U1 a
compact U1 (Maybe a)
U1 = U1 a
forall k (p :: k). U1 p
U1


#if __GLASGOW_HASKELL__ < 900
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 #-}
    mapMaybe :: (a -> Maybe b) -> Option a -> Option b
mapMaybe 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)
    mapMaybe a -> Maybe b
_ Option a
_                 = Maybe b -> Option b
forall a. Maybe a -> Option a
Option Maybe b
forall a. Maybe a
Nothing
    {-# INLINABLE mapMaybe #-}
    separateThese :: Option (These l r) -> (Option l, Option r)
separateThese = Option (These l r) -> (Option l, Option r)
forall (d :: * -> * -> *) (f :: * -> *) l r.
(Dichotomous d, Alternative f, Foldable f) =>
f (d l r) -> (f l, f r)
altDefaultSeparate
    {-# INLINABLE separateThese #-}
#endif


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 f, Compactable g)
         => Compactable (Compose f g) where
    compact :: Compose f g (Maybe a) -> Compose f g a
compact (Compose f (g (Maybe a))
fg) = f (g a) -> Compose f g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a) -> Compose f g a) -> f (g a) -> Compose f g a
forall a b. (a -> b) -> a -> b
$ g (Maybe a) -> g a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (g (Maybe a) -> g a) -> f (g (Maybe a)) -> f (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g (Maybe a))
fg
    {-# INLINABLE compact #-}


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 #-}
    mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
mapMaybe = (a -> Maybe b) -> IntMap a -> IntMap b
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe
    {-# INLINABLE mapMaybe #-}
    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 #-}

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 #-}
    mapMaybe :: (a -> Maybe b) -> Map k a -> Map k b
mapMaybe = (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 mapMaybe #-}
    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 #-}

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
May.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
May.isJust
    {-# INLINABLE compact #-}
    separateThese :: Seq (These l r) -> (Seq l, Seq r)
separateThese = Seq (These l r) -> (Seq l, Seq r)
forall (d :: * -> * -> *) (f :: * -> *) l r.
(Dichotomous d, Alternative f, Foldable f) =>
f (d l r) -> (f l, f r)
altDefaultSeparate
    {-# INLINABLE separateThese #-}
    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 #-}
    separateThese :: Vector (These l r) -> (Vector l, Vector r)
separateThese = Vector (These l r) -> (Vector l, Vector r)
forall (d :: * -> * -> *) (f :: * -> *) l r.
(Dichotomous d, Alternative f, Foldable f) =>
f (d l r) -> (f l, f r)
altDefaultSeparate
    {-# INLINABLE separateThese #-}
    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 #-}
    mapMaybe :: (a -> Maybe b) -> Const r a -> Const r b
mapMaybe a -> Maybe b
_ (Const r
r) = r -> Const r b
forall k a (b :: k). a -> Const a b
Const r
r
    {-# INLINABLE mapMaybe #-}
    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 :: (a -> Const r (Maybe b)) -> Const r a -> Const r b
bindMaybe a -> Const r (Maybe b)
_ (Const r
r) = r -> Const r b
forall k a (b :: k). a -> Const a b
Const r
r
    {-# INLINABLE bindMaybe #-}
    mapThese :: (a -> These l r) -> Const r a -> (Const r l, Const r r)
mapThese a -> These 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 mapThese #-}
    applyThese :: Const r (a -> These l r) -> Const r a -> (Const r l, Const r r)
applyThese Const r (a -> These 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 applyThese #-}
    bindThese :: (a -> Const r (These l r)) -> Const r a -> (Const r l, Const r r)
bindThese a -> Const r (These 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 bindThese #-}
    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 #-}
    separateThese :: Set (These l r) -> (Set l, Set r)
separateThese = ([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 (These l r) -> ([l], [r]))
-> Set (These l r)
-> (Set l, Set r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [These l r] -> ([l], [r])
forall (g :: * -> * -> *) (f :: * -> *) l r.
(Dichotomous g, Functor f, Compactable f) =>
f (g l r) -> (f l, f r)
separate ([These l r] -> ([l], [r]))
-> (Set (These l r) -> [These l r])
-> Set (These l r)
-> ([l], [r])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (These l r) -> [These l r]
forall a. Set a -> [a]
Set.toAscList
    {-# INLINABLE separateThese #-}
    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 (Compactable a, Monad a) => Compactable (WrappedMonad a)
  where compact :: WrappedMonad a (Maybe a) -> WrappedMonad a a
compact (WrapMonad a (Maybe a)
x) = a a -> WrappedMonad a a
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad (a a -> WrappedMonad a a) -> a a -> WrappedMonad a a
forall a b. (a -> b) -> a -> b
$ a (Maybe a) -> a a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact a (Maybe a)
x

instance (Compactable a, Functor a) => Compactable (Rec1 a)
  where compact :: Rec1 a (Maybe a) -> Rec1 a a
compact (Rec1 a (Maybe a)
x) = a a -> Rec1 a a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (a a -> Rec1 a a) -> a a -> Rec1 a a
forall a b. (a -> b) -> a -> b
$ a (Maybe a) -> a a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact a (Maybe a)
x

instance (Compactable a, Functor a) => Compactable (Alt a)
  where compact :: Alt a (Maybe a) -> Alt a a
compact (Alt a (Maybe a)
a) = a a -> Alt a a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt (a a -> Alt a a) -> a a -> Alt a a
forall a b. (a -> b) -> a -> b
$ a (Maybe a) -> a a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact a (Maybe a)
a

instance (Compactable a, Functor a, Compactable b, Functor b) => Compactable (a :*: b)
  where compact :: (:*:) a b (Maybe a) -> (:*:) a b a
compact (a (Maybe a)
a :*: b (Maybe a)
b) = a (Maybe a) -> a a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact a (Maybe a)
a a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b (Maybe a) -> b a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact b (Maybe a)
b

instance (Compactable f, Functor f) => Compactable (M1 i c f)
  where compact :: M1 i c f (Maybe a) -> M1 i c f a
compact (M1 f (Maybe a)
x) = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i c f a) -> f a -> M1 i c f a
forall a b. (a -> b) -> a -> b
$ f (Maybe a) -> f a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact f (Maybe a)
x

instance (Functor f, Compactable g, Functor g) => Compactable (f :.: g)
  where compact :: (:.:) f g (Maybe a) -> (:.:) f g a
compact (Comp1 f (g (Maybe a))
x) = f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g a) -> (:.:) f g a) -> f (g a) -> (:.:) f g a
forall a b. (a -> b) -> a -> b
$ g (Maybe a) -> g a
forall (f :: * -> *) a. Compactable f => f (Maybe a) -> f a
compact (g (Maybe a) -> g a) -> f (g (Maybe a)) -> f (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g (Maybe a))
x


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
mapMaybe


fforThese :: (Compactable f, Functor f) => f a -> (a -> These l r) -> (f l, f r)
fforThese :: f a -> (a -> These l r) -> (f l, f r)
fforThese = ((a -> These l r) -> f a -> (f l, f r))
-> f a -> (a -> These l r) -> (f l, f r)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> These l r) -> f a -> (f l, f r)
forall (f :: * -> *) a l r.
(Compactable f, Functor f) =>
(a -> These l r) -> f a -> (f l, f r)
mapThese


mapMaybeM :: (Compactable f, Monad f) => (a -> MaybeT f b) -> f a -> f b
mapMaybeM :: (a -> MaybeT f b) -> f a -> f b
mapMaybeM 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
mapMaybeM


mapTheseM :: (Compactable f, Monad f) => (a -> ExceptT l f r) -> f a -> (f l, f r)
mapTheseM :: (a -> ExceptT l f r) -> f a -> (f l, f r)
mapTheseM a -> ExceptT l f r
f f a
x = f (Either l r) -> (f l, f r)
forall (g :: * -> * -> *) (f :: * -> *) l r.
(Dichotomous g, Functor f, Compactable f) =>
f (g 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


fforTheseM :: (Compactable f, Monad f) => f a -> (a -> ExceptT l f r) -> (f l, f r)
fforTheseM :: f a -> (a -> ExceptT l f r) -> (f l, f r)
fforTheseM = ((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)
mapTheseM


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)
-> (MaybeT f b -> f (Maybe b)) -> MaybeT f b -> 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 b) -> (f a -> f (MaybeT f b)) -> f a -> f b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m 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)
-> (MaybeT f b -> f (Maybe b)) -> MaybeT f b -> 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 b)
-> ((a -> f (MaybeT f b)) -> f (MaybeT f b))
-> (a -> f (MaybeT f b))
-> f b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m 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 :: (Dichotomous d, Alternative f, Foldable f) => f (d l r) -> (f l, f r)
altDefaultSeparate :: f (d l r) -> (f l, f r)
altDefaultSeparate = ((f l, f r) -> d l r -> (f l, f r))
-> (f l, f r) -> f (d 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') d l r
d -> case d l r -> Maybe (These l r)
forall (f :: * -> * -> *) a b.
Dichotomous f =>
f a b -> Maybe (These a b)
dichotomy d l r
d of
  Maybe (These l r)
Nothing          -> (f l
l', f r
r')
  Just (This 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')
  Just (That 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)
  Just (These l
l r
r) -> (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' 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 #-}