stacked-0.1.0: A modern indexed monad stack
Safe HaskellNone
LanguageGHC2021

Control.Additive

Description

This module defines a variant of the Alternative and MonadPlus type class. Thanks to quantified constraints, there's really nothing preventing us, in modern Haskell, to define it once and for all at every arity.

Effectively, this is just a clone of the Monoid type class. The reason for preferring to define another class is that applicatives have a natural Monoid instance:

instance (Applicative f, Monoid a) => Monoid (f a) where
  mempty = pure mempty
  (<>) = liftA2 (<>)

In Base, the Monoid instances for ST, IO, and STM are defined like this, and that of Maybe a and Const a b are of a similar nature. See also Ap.

So we typically want a second one. An approach would be to give a monoid instance to a newtype-wrapped version of our functor gadget. But that's very syntactically heave (see Adding, below, though). So instead we propose a dedicated type class, named after the fact that Alternative function have an additive flavour to them (msum, etc…), and situated in the Control hierarchy to represent that it's intended to represent choice between computations.

Synopsis

Documentation

class Additive a where Source #

Methods

empty :: a Source #

(<|>) :: a -> a -> a infixl 3 Source #

Instances

Instances details
Monoid a => Additive (Monoidaly a) Source # 
Instance details

Defined in Control.Additive

Alternative f => Additive (Alternatively f a) Source # 
Instance details

Defined in Control.Additive

Additive (Cont2W w r r' a) Source # 
Instance details

Defined in Control.Monad.Indexed.Cont2

Methods

empty :: Cont2W w r r' a Source #

(<|>) :: Cont2W w r r' a -> Cont2W w r r' a -> Cont2W w r r' a Source #

Alternative m => Additive (IgnoreIndices m r r' a) Source # 
Instance details

Defined in Control.Monad.Indexed

Methods

empty :: IgnoreIndices m r r' a Source #

(<|>) :: IgnoreIndices m r r' a -> IgnoreIndices m r r' a -> IgnoreIndices m r r' a Source #

(Additive (f r r' a), Additive (g r r' a)) => Additive ((f :*: g) r r' a) Source # 
Instance details

Defined in Control.Monad.Indexed

Methods

empty :: (f :*: g) r r' a Source #

(<|>) :: (f :*: g) r r' a -> (f :*: g) r r' a -> (f :*: g) r r' a Source #

sum :: (Additive a, Foldable f) => f a -> a Source #

Iterates (<|>) over a container.

Additives as monoids

newtype Adding a Source #

Make any Additive into a Monoid, and leverage any monoid functions.

Constructors

Adding a 

Instances

Instances details
Additive a => Monoid (Adding a) Source # 
Instance details

Defined in Control.Additive

Methods

mempty :: Adding a #

mappend :: Adding a -> Adding a -> Adding a #

mconcat :: [Adding a] -> Adding a #

Additive a => Semigroup (Adding a) Source # 
Instance details

Defined in Control.Additive

Methods

(<>) :: Adding a -> Adding a -> Adding a #

sconcat :: NonEmpty (Adding a) -> Adding a #

stimes :: Integral b => b -> Adding a -> Adding a #

Deriving-via combinators

newtype Monoidaly a Source #

Derive Additive instances with deriving via

Constructors

Monoidaly a 

Instances

Instances details
Monoid a => Additive (Monoidaly a) Source # 
Instance details

Defined in Control.Additive

newtype Alternatively (f :: k -> Type) (a :: k) Source #

Derive Additive instances with deriving via

Constructors

Alternatively (f a) 

Instances

Instances details
Alternative f => Additive (Alternatively f a) Source # 
Instance details

Defined in Control.Additive