module Data.TypeRig.Summable where

import Control.Applicative
import Control.Arrow
import Control.Category
import Data.Either
import Data.Functor
import Data.Functor.Invariant
import Data.Kind
import Data.Semigroup
import Data.Void
import Prelude hiding ((.), id)
import qualified Text.ParserCombinators.ReadPrec as ReadPrec

infixr 2 <+++>

-- | Composability via type sum 'Either' and empty type 'Void'.
type Summable :: (Type -> Type) -> Constraint
class Invariant f => Summable f where
    rVoid :: f Void
    default rVoid :: Alternative f => f Void
    rVoid = forall (f :: Type -> Type) a. Alternative f => f a
empty
    (<+++>) :: f a -> f b -> f (Either a b)
    default (<+++>) :: Alternative f => f a -> f b -> f (Either a b)
    f a
fa <+++> f b
fb = (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left f a
fa) forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right f b
fb)

instance Summable Endo where
    rVoid :: Endo Void
rVoid = forall a. (a -> a) -> Endo a
Endo forall {k} (cat :: k -> k -> Type) (a :: k).
Category cat =>
cat a a
id
    Endo a -> a
p <+++> :: forall a b. Endo a -> Endo b -> Endo (Either a b)
<+++> Endo b -> b
q =
        forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ \case
            Left a
a -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ a -> a
p a
a
            Right b
b -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ b -> b
q b
b

instance Summable m => Summable (Kleisli m a) where
    rVoid :: Kleisli m a Void
rVoid = forall (m :: Type -> Type) a b. (a -> m b) -> Kleisli m a b
Kleisli forall a b. (a -> b) -> a -> b
$ \a
_ -> forall (f :: Type -> Type). Summable f => f Void
rVoid
    Kleisli a -> m a
p <+++> :: forall a b.
Kleisli m a a -> Kleisli m a b -> Kleisli m a (Either a b)
<+++> Kleisli a -> m b
q = forall (m :: Type -> Type) a b. (a -> m b) -> Kleisli m a b
Kleisli forall a b. (a -> b) -> a -> b
$ \a
a -> a -> m a
p a
a forall (f :: Type -> Type) a b.
Summable f =>
f a -> f b -> f (Either a b)
<+++> a -> m b
q a
a

instance Summable ReadPrec.ReadPrec where
    ReadPrec a
ra <+++> :: forall a b. ReadPrec a -> ReadPrec b -> ReadPrec (Either a b)
<+++> ReadPrec b
rb = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left ReadPrec a
ra forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
ReadPrec.<++ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right ReadPrec b
rb