-- |
-- Invariant monoidal functors.
-- 
-- This roughly corresponds to "Control.Applicative", but exposes a non-overlapping API so can be imported unqualified.  It does, however, use operators similar to those provided by contravariant.
{-# LANGUAGE CPP, TypeOperators, FlexibleInstances #-}
#if !(defined(VERSION_semigroupoids) && MIN_VERSION_semigroupoids(5,2,2))
{-# LANGUAGE Safe #-}
#endif
module Control.Invertible.Monoidal
  ( Bijection(..)
  , I.biCase
    -- * Functor
  , (>$<)
  , (>$), ($<)
  -- * Monoidal
  , Monoidal(..)
  , unitDefault
  , pairADefault
  , (>*), (*<)
  -- ** Tuple combinators
  , liftI2
  , liftI3
  , liftI4
  , liftI5
  , (>*<<)
  , (>*<<<)
  , (>*<<<<)
  , (>>*<)
  , (>>>*<)
  , (>>>>*<)
  , (>>*<<)
  , pureI
  , constI
  , sequenceI_
  , mapI_
  , forI_
  , sequenceMaybesI
  , mapMaybeI
  -- * MonoidalAlt
  , MonoidalAlt(..)
  , eitherADefault
  , (>|), (|<)
  , optionalI
  , defaulting
  , manyI
  , msumIndex
  , msumFirst, msumLast
  , oneOfI
  ) where

import Prelude
import Control.Applicative (liftA2, Alternative, (<|>))
import Control.Arrow ((&&&), (***))
import Control.Monad.Trans.Maybe (MaybeT(..))
import Data.Void (Void)

import Data.Invertible.Bijection
import qualified Data.Invertible as I

-- |Another synonym for 'fmap' to match other operators in this module.
(>$<) :: I.Functor f => a <-> b -> f a -> f b
>$< :: forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
(>$<) = forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
I.fmap

infixl 4 $<, >$<, >$

-- |Given a value an an invariant for that value, always provide that value and ignore the produced value.
-- @'I.fmap' . flip 'I.consts' ()@
(>$) :: I.Functor f => a -> f a -> f ()
>$ :: forall (f :: * -> *) a. Functor f => a -> f a -> f ()
(>$) a
a = forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
I.fmap forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a <-> b
I.consts a
a ()

-- |@flip ('>$')@
($<) :: I.Functor f => f a -> a -> f ()
$< :: forall (f :: * -> *) a. Functor f => f a -> a -> f ()
($<) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a. Functor f => a -> f a -> f ()
(>$)

-- |Invariant monoidal functor.
-- This roughly corresponds to 'Applicative', which, for covariant functors, is equivalent to a monoidal functor.
-- Invariant functors, however, may admit a monoidal instance but not applicative.
class I.Functor f => Monoidal f where
  -- |Lift a unit value, analogous to @'Control.Applicative.pure' ()@ (but also like @const ()@).
  unit :: f ()
  -- |Merge two functors into a tuple, analogous to @'Control.Applicative.liftA2' (,)@. (Sometimes known as @**@.)
  (>*<) :: f a -> f b -> f (a, b)

-- |Default 'unit' implementation for non-invertible 'Applicative's.
unitDefault :: Applicative f => f ()
unitDefault :: forall (f :: * -> *). Applicative f => f ()
unitDefault = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- |Default '>*< implementation for non-invertible 'Applicative's.
pairADefault :: Applicative f => f a -> f b -> f (a, b)
pairADefault :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f (a, b)
pairADefault = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)

-- |Sequence actions, discarding/inhabiting the unit value of the second argument.
(>*) :: Monoidal f => f a -> f () -> f a
>* :: forall (f :: * -> *) a. Monoidal f => f a -> f () -> f a
(>*) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a. (a, ()) <-> a
I.fst

-- |Sequence actions, discarding/inhabiting the unit value of the first argument.
(*<) :: Monoidal f => f () -> f a -> f a
*< :: forall (f :: * -> *) a. Monoidal f => f () -> f a -> f a
(*<) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a. ((), a) <-> a
I.snd

infixl 4 >*, >*<, *<

-- |Lift an (uncurried) bijection into a monoidal functor.
liftI2 :: Monoidal f => ((a, b) <-> c) -> f a -> f b -> f c
liftI2 :: forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 (a, b) <-> c
f f a
a f b
b = (a, b) <-> c
f forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (f a
a forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< f b
b)

liftI3 :: Monoidal f => ((a, b, c) <-> d) -> f a -> f b -> f c -> f d
liftI3 :: forall (f :: * -> *) a b c d.
Monoidal f =>
((a, b, c) <-> d) -> f a -> f b -> f c -> f d
liftI3 (a, b, c) <-> d
f f a
a f b
b f c
c = (a, b, c) <-> d
f forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (f a
a forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< f b
b forall (f :: * -> *) a b c.
Monoidal f =>
f (a, b) -> f c -> f (a, b, c)
>>*< f c
c)

liftI4 :: Monoidal f => ((a, b, c, d) <-> e) -> f a -> f b -> f c -> f d -> f e
liftI4 :: forall (f :: * -> *) a b c d e.
Monoidal f =>
((a, b, c, d) <-> e) -> f a -> f b -> f c -> f d -> f e
liftI4 (a, b, c, d) <-> e
f f a
a f b
b f c
c f d
d = (a, b, c, d) <-> e
f forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (f a
a forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< f b
b forall (f :: * -> *) a b c.
Monoidal f =>
f (a, b) -> f c -> f (a, b, c)
>>*< f c
c forall (f :: * -> *) a b c d.
Monoidal f =>
f (a, b, c) -> f d -> f (a, b, c, d)
>>>*< f d
d)

liftI5 :: Monoidal f => ((a, b, c, d, e) <-> g) -> f a -> f b -> f c -> f d -> f e -> f g
liftI5 :: forall (f :: * -> *) a b c d e g.
Monoidal f =>
((a, b, c, d, e) <-> g) -> f a -> f b -> f c -> f d -> f e -> f g
liftI5 (a, b, c, d, e) <-> g
f f a
a f b
b f c
c f d
d f e
e = (a, b, c, d, e) <-> g
f forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (f a
a forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< f b
b forall (f :: * -> *) a b c.
Monoidal f =>
f (a, b) -> f c -> f (a, b, c)
>>*< f c
c forall (f :: * -> *) a b c d.
Monoidal f =>
f (a, b, c) -> f d -> f (a, b, c, d)
>>>*< f d
d forall (f :: * -> *) a b c d e.
Monoidal f =>
f (a, b, c, d) -> f e -> f (a, b, c, d, e)
>>>>*< f e
e)

(>>*<) :: Monoidal f => f (a, b) -> f c -> f (a, b, c)
>>*< :: forall (f :: * -> *) a b c.
Monoidal f =>
f (a, b) -> f c -> f (a, b, c)
(>>*<) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a b c. ((a, b), c) <-> (a, b, c)
I.flatten2_1

(>>>*<) :: Monoidal f => f (a, b, c) -> f d -> f (a, b, c, d)
>>>*< :: forall (f :: * -> *) a b c d.
Monoidal f =>
f (a, b, c) -> f d -> f (a, b, c, d)
(>>>*<) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a b c d. ((a, b, c), d) <-> (a, b, c, d)
I.flatten3_1

(>>>>*<) :: Monoidal f => f (a, b, c, d) -> f e -> f (a, b, c, d, e)
>>>>*< :: forall (f :: * -> *) a b c d e.
Monoidal f =>
f (a, b, c, d) -> f e -> f (a, b, c, d, e)
(>>>>*<) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a b c d e. ((a, b, c, d), e) <-> (a, b, c, d, e)
I.flatten4_1

infixl 4 >>*<, >>>*<, >>>>*<

(>*<<) :: Monoidal f => f a -> f (b, c) -> f (a, b, c)
>*<< :: forall (f :: * -> *) a b c.
Monoidal f =>
f a -> f (b, c) -> f (a, b, c)
(>*<<) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a b c. (a, (b, c)) <-> (a, b, c)
I.flatten1_2

(>*<<<) :: Monoidal f => f a -> f (b, c, d) -> f (a, b, c, d)
>*<<< :: forall (f :: * -> *) a b c d.
Monoidal f =>
f a -> f (b, c, d) -> f (a, b, c, d)
(>*<<<) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a b c d. (a, (b, c, d)) <-> (a, b, c, d)
I.flatten1_3

(>*<<<<) :: Monoidal f => f a -> f (b, c, d, e) -> f (a, b, c, d, e)
>*<<<< :: forall (f :: * -> *) a b c d e.
Monoidal f =>
f a -> f (b, c, d, e) -> f (a, b, c, d, e)
(>*<<<<) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a b c d e. (a, (b, c, d, e)) <-> (a, b, c, d, e)
I.flatten1_4

infixr 3 >*<<, >*<<<, >*<<<<

(>>*<<) :: Monoidal f => f (a, b) -> f (c, d) -> f (a, b, c, d)
>>*<< :: forall (f :: * -> *) a b c d.
Monoidal f =>
f (a, b) -> f (c, d) -> f (a, b, c, d)
(>>*<<) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a b c d. ((a, b), (c, d)) <-> (a, b, c, d)
I.flatten2_2

infix 3 >>*<<

-- |A constant monoidal (like 'Control.Applicative.pure'), which always produces the same value and ignores everything.
pureI :: Monoidal f => a -> f a
pureI :: forall (f :: * -> *) a. Monoidal f => a -> f a
pureI a
a = forall a. a -> () <-> a
I.const a
a forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< forall (f :: * -> *). Monoidal f => f ()
unit

-- |Supply a constant value to a monoidal and ignore whatever is produced.
constI :: Monoidal f => a -> f a -> f ()
constI :: forall (f :: * -> *) a. Monoidal f => a -> f a -> f ()
constI a
a = forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
(>$<) forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. BiArrow a => a b c -> a c b
I.invert forall a b. (a -> b) -> a -> b
$ forall a. a -> () <-> a
I.const a
a

-- |Sequence (like 'Data.Foldable.sequenceA_') a list of monoidals, ignoring (@'I.const' ()@) all the results.
sequenceI_ :: (Foldable t, Monoidal f) => t (f ()) -> f ()
sequenceI_ :: forall (t :: * -> *) (f :: * -> *).
(Foldable t, Monoidal f) =>
t (f ()) -> f ()
sequenceI_ = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Monoidal f => f () -> f a -> f a
(*<) forall (f :: * -> *). Monoidal f => f ()
unit

-- |Map each element to a monoidal and 'sequenceI_' the results.
mapI_ :: (Foldable t, Monoidal f) => (a -> f ()) -> t a -> f ()
mapI_ :: forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Monoidal f) =>
(a -> f ()) -> t a -> f ()
mapI_ a -> f ()
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (f :: * -> *) a. Monoidal f => f () -> f a -> f a
(*<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f ()
f) forall (f :: * -> *). Monoidal f => f ()
unit

-- |@flip 'mapI_'@
forI_ :: (Foldable t, Monoidal f) => t a -> (a -> f ()) -> f ()
forI_ :: forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Monoidal f) =>
t a -> (a -> f ()) -> f ()
forI_ = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Monoidal f) =>
(a -> f ()) -> t a -> f ()
mapI_

-- |Sequence (like 'Data.Traversable.sequenceA') and filter (like 'Data.Maybe.catMaybes') a list of monoidals, producing the list of non-'Nothing' values.
-- Shorter input lists pad with 'Nothing's and longer ones are ignored.
sequenceMaybesI :: Monoidal f => [f (Maybe a)] -> f [a]
sequenceMaybesI :: forall (f :: * -> *) a. Monoidal f => [f (Maybe a)] -> f [a]
sequenceMaybesI [] = forall (f :: * -> *) a. Monoidal f => a -> f a
pureI []
sequenceMaybesI (f (Maybe a)
x:[f (Maybe a)]
l) = forall (f :: * -> *) a b c.
Monoidal f =>
((a, b) <-> c) -> f a -> f b -> f c
liftI2 forall a. (Maybe a, [a]) <-> [a]
I.consMaybe f (Maybe a)
x (forall (f :: * -> *) a. Monoidal f => [f (Maybe a)] -> f [a]
sequenceMaybesI [f (Maybe a)]
l)

-- |Map each element to a 'Maybe' monoidal and sequence the results (like 'Data.Traversable.traverse' and 'Data.Maybe.mapMaybe').
mapMaybeI :: Monoidal f => (a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeI :: forall (f :: * -> *) a b.
Monoidal f =>
(a -> f (Maybe b)) -> [a] -> f [b]
mapMaybeI = (forall (f :: * -> *) a. Monoidal f => [f (Maybe a)] -> f [a]
sequenceMaybesI forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map

-- |Monoidal functors that allow choice.
class Monoidal f => MonoidalAlt f where
  -- |An always-failing (and thus impossible) value.
  zero :: f Void
  -- |Associative binary choice.
  (>|<) :: f a -> f b -> f (Either a b)

-- |Default '>|<' implementation for non-invertible 'Alternative's.
eitherADefault :: Alternative f => f a -> f b -> f (Either a b)
eitherADefault :: forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
eitherADefault f a
a f b
b = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b

-- |Assymetric (and therefore probably not bijective) version of '>|<' that returns whichever action succeeds but always uses the left one on inputs.
(>|) :: MonoidalAlt f => f a -> f a -> f a
f a
a >| :: forall (f :: * -> *) a. MonoidalAlt f => f a -> f a -> f a
>| f a
b = (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall a b. a -> Either a b
Left) forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (f a
a forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
>|< f a
b)

-- |Assymetric (and therefore probably not bijective) version of '>|<' that returns whichever action succeeds but always uses the right one on inputs.
(|<) :: MonoidalAlt f => f a -> f a -> f a
f a
a |< :: forall (f :: * -> *) a. MonoidalAlt f => f a -> f a -> f a
|< f a
b = (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall a b. b -> Either a b
Right) forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (f a
a forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
>|< f a
b)

infixl 3 >|, >|<, |<

-- |Analogous to 'Control.Applicative.optional': always succeeds.
optionalI :: MonoidalAlt f => f a -> f (Maybe a)
optionalI :: forall (f :: * -> *) a. MonoidalAlt f => f a -> f (Maybe a)
optionalI f a
f = forall a. Either a () <-> Maybe a
I.lft forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (f a
f forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
>|< forall (f :: * -> *). Monoidal f => f ()
unit)

-- |Return a default value if a monoidal functor fails, and only apply it to non-default values.
defaulting :: (MonoidalAlt f, Eq a) => a -> f a -> f a
defaulting :: forall (f :: * -> *) a. (MonoidalAlt f, Eq a) => a -> f a -> f a
defaulting a
a f a
f = forall a. Eq a => a -> Maybe a <-> a
I.fromMaybe a
a forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< forall (f :: * -> *) a. MonoidalAlt f => f a -> f (Maybe a)
optionalI f a
f

-- |Repeatedly apply a monoidal functor until it fails.  Analogous to 'Control.Applicative.many'.
manyI :: MonoidalAlt f => f a -> f [a]
manyI :: forall (f :: * -> *) a. MonoidalAlt f => f a -> f [a]
manyI f a
f = forall a. Maybe (a, [a]) <-> [a]
I.cons forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< forall (f :: * -> *) a. MonoidalAlt f => f a -> f (Maybe a)
optionalI (f a
f forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< forall (f :: * -> *) a. MonoidalAlt f => f a -> f [a]
manyI f a
f)

-- |Try a list of monoidal actions in sequence, producing the index of the first successful action, and evaluating the action with the given index.
msumIndex :: MonoidalAlt f => [f ()] -> f Int
msumIndex :: forall (f :: * -> *). MonoidalAlt f => [f ()] -> f Int
msumIndex [] = forall a. HasCallStack => [Char] -> a
error [Char]
"msumIndex: empty list"
msumIndex [f ()
x]   = (       (\() -> Int
0)      forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {a}. (Ord a, Num a) => a -> ()
which) forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< f ()
x where
  which :: a -> ()
which a
i = case forall a. Ord a => a -> a -> Ordering
compare a
i a
0 of
    Ordering
LT -> forall a. HasCallStack => [Char] -> a
error [Char]
"msumIndex: negative index"
    Ordering
EQ -> ()
    Ordering
GT -> forall a. HasCallStack => [Char] -> a
error [Char]
"msumIndex: index too large"
msumIndex (f ()
x:[f ()]
l) = (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\() -> Int
0) forall a. Enum a => a -> a
succ forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {b}. (Ord b, Num b, Enum b) => b -> Either () b
which) forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (f ()
x forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
>|< forall (f :: * -> *). MonoidalAlt f => [f ()] -> f Int
msumIndex [f ()]
l) where
  which :: b -> Either () b
which b
i = case forall a. Ord a => a -> a -> Ordering
compare b
i b
0 of
    Ordering
LT -> forall a. HasCallStack => [Char] -> a
error [Char]
"msumIndex: negative index"
    Ordering
EQ -> forall a b. a -> Either a b
Left ()
    Ordering
GT -> forall a b. b -> Either a b
Right (forall a. Enum a => a -> a
pred b
i)

-- |Fold a structure with '>|' ('|<'), thus always applying the input to the first (last) item for generation.
msumFirst, msumLast :: (MonoidalAlt f, Traversable t) => t (f a) -> f a
msumFirst :: forall (f :: * -> *) (t :: * -> *) a.
(MonoidalAlt f, Traversable t) =>
t (f a) -> f a
msumFirst = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall (f :: * -> *) a. MonoidalAlt f => f a -> f a -> f a
(>|)
msumLast :: forall (f :: * -> *) (t :: * -> *) a.
(MonoidalAlt f, Traversable t) =>
t (f a) -> f a
msumLast = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall (f :: * -> *) a. MonoidalAlt f => f a -> f a -> f a
(|<)

-- |Take a list of items and apply them to the action in sequence until one succeeds and return the cooresponding item; match the input with the list and apply the corresponding action (or produce an error if the input is not an element of the list).
oneOfI :: (MonoidalAlt f, Eq a) => (a -> f ()) -> [a] -> f a
oneOfI :: forall (f :: * -> *) a.
(MonoidalAlt f, Eq a) =>
(a -> f ()) -> [a] -> f a
oneOfI a -> f ()
_ [] = forall a. HasCallStack => [Char] -> a
error [Char]
"oneOfI: empty list"
oneOfI a -> f ()
f [a
x] = ((\() -> a
x) forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
I.:<->: (\a
y -> if a
x forall a. Eq a => a -> a -> Bool
== a
y then () else forall a. HasCallStack => [Char] -> a
error [Char]
"oneOfI: invalid option")) forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< a -> f ()
f a
x
oneOfI a -> f ()
f (a
x:[a]
l) = (forall a. Eq a => a -> Maybe a <-> a
I.fromMaybe a
x forall b c a. (b <-> c) -> (a <-> b) -> a <-> c
I.. forall a. Either () a <-> Maybe a
I.rgt) forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (a -> f ()
f a
x forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
>|< forall (f :: * -> *) a.
(MonoidalAlt f, Eq a) =>
(a -> f ()) -> [a] -> f a
oneOfI a -> f ()
f [a]
l)

instance Monoidal (Bijection (->) ()) where
  unit :: Bijection (->) () ()
unit = forall a. a <-> a
I.id
  -- |Uses the 'Monoid' instance to combine '()'s.
  (() -> a
ua :<->: a -> ()
au) >*< :: forall a b.
Bijection (->) () a
-> Bijection (->) () b -> Bijection (->) () (a, b)
>*< (() -> b
ub :<->: b -> ()
bu) = () -> a
ua forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& () -> b
ub forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ()
au forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** b -> ()
bu)

instance I.Functor m => I.Functor (MaybeT m) where
  fmap :: forall a b. (a <-> b) -> MaybeT m a -> MaybeT m b
fmap a <-> b
f (MaybeT m (Maybe a)
m) = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
I.fmap (forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a <-> f b
I.bifmap a <-> b
f) m (Maybe a)
m

instance Monoidal m => Monoidal (MaybeT m) where
  unit :: MaybeT m ()
unit = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. BiArrow a => a b c -> a c b
I.invert forall a. Maybe a <-> a
I.fromJust forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< forall (f :: * -> *). Monoidal f => f ()
unit
  MaybeT m (Maybe a)
f >*< :: forall a b. MaybeT m a -> MaybeT m b -> MaybeT m (a, b)
>*< MaybeT m (Maybe b)
g = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
    forall a b. (a -> b) -> a -> b
$ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: * -> *) a b. Applicative f => f a -> f b -> f (a, b)
pairADefault forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. a -> Maybe a
Just))
    forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (m (Maybe a)
f forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< m (Maybe b)
g)

instance Monoidal m => MonoidalAlt (MaybeT m) where
  zero :: MaybeT m Void
zero = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall a. a -> () <-> a
I.const forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< forall (f :: * -> *). Monoidal f => f ()
unit
  MaybeT m (Maybe a)
f >|< :: forall a b. MaybeT m a -> MaybeT m b -> MaybeT m (Either a b)
>|< MaybeT m (Maybe b)
g = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
    forall a b. (a -> b) -> a -> b
$ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: * -> *) a b.
Alternative f =>
f a -> f b -> f (Either a b)
eitherADefault forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall {a} {a}. Maybe (Either a a) -> (Maybe a, Maybe a)
ue)
    forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
>$< (m (Maybe a)
f forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< m (Maybe b)
g)
    where
    ue :: Maybe (Either a a) -> (Maybe a, Maybe a)
ue Maybe (Either a a)
Nothing = (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
    ue (Just (Left a
a)) = (forall a. a -> Maybe a
Just a
a, forall a. Maybe a
Nothing)
    ue (Just (Right a
b)) = (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just a
b)