-- | Types are great. Lifting them into some sort of applicative functor makes
-- them even better. This module is an homage to our favorite applicatives, and
-- to the semigroups with which they are instrinsically connected.
{-# LANGUAGE NoImplicitPrelude #-} -- Prelude is bad
{-# LANGUAGE DeriveFunctor #-} -- Writing Functor instances is boring
module Acme.Functors
(
-- * Lifted-but-why
LiftedButWhy (..)
-- * Or-not
, OrNot (..)
-- * Two
, Two (..)
-- * Any-number-of
, AnyNumberOf (..), (~~)
-- * One-or-more
, OneOrMore (..)
-- * Also-extra-thing
, Also (..)
-- * Or-instead-other-thing
, OrInstead (..)
-- * Or-instead-other-thing ("first" variant)
, OrInsteadFirst (..)
-- * Determined-by-parameter
, DeterminedBy (..)
) where
import Acme.Functors.Classes
--------------------------------------------------------------------------------
-- Lifted-but-why
--------------------------------------------------------------------------------
-- | __@LiftedButWhy@__ is a boring functor that just has one value and no other
-- structure or interesting properties.
data LiftedButWhy a =
LiftedButWhy a
-- ^ A value that has been lifted for some damned reason.
--
-- ... Okay, to be honest, this one is /nobody's/ favorite, but it is
-- included here for completeness.
deriving (Eq, Functor, Show)
-- | > pure = LiftedButWhy
-- >
-- > LiftedButWhy f <*> LiftedButWhy a = LiftedButWhy (f a)
instance Applicative LiftedButWhy where
pure = LiftedButWhy
LiftedButWhy f <*> LiftedButWhy a = LiftedButWhy (f a)
-- | > LiftedButWhy a >>= f = f a
instance Monad LiftedButWhy where
LiftedButWhy a >>= f = f a
-- | > LiftedButWhy x <> LiftedButWhy y = LiftedButWhy (x <> y)
instance Semigroup a => Semigroup (LiftedButWhy a) where
LiftedButWhy x <> LiftedButWhy y = LiftedButWhy (x <> y)
-- | > mempty = LiftedButWhy mempty
instance Monoid a => Monoid (LiftedButWhy a) where
mempty = LiftedButWhy mempty
--------------------------------------------------------------------------------
-- Or-not
--------------------------------------------------------------------------------
-- | __@OrNot@__ is somehow slightly more interesting than @LiftedButWhy@, even
-- though it may actually contain /less/. Instead of a value, there might /not/
-- be a value.
--
-- When you combine stuff with @(\<*\>)@ or @(\<\>)@, all of the values need to
-- be present. If any of them are absent, the whole expression evaluates to
-- @Nope@.
data OrNot a = ActuallyYes a -- ^ Some normal value.
| Nope -- ^ Chuck Testa.
deriving (Eq, Functor, Show)
-- | If you have a function @f@ that might not actually be there, and a value
-- @a@ that might not actually be there, lifted application @(\<*\>)@ gives you
-- @f a@ only if both of them are actually there.
--
-- > pure = ActuallyYes
-- >
-- > ActuallyYes f <*> ActuallyYes a = ActuallyYes (f a)
-- > _ <*> _ = Nope
instance Applicative OrNot where
pure = ActuallyYes
ActuallyYes f <*> ActuallyYes a = ActuallyYes (f a)
_ <*> _ = Nope
instance Monad OrNot where
ActuallyYes a >>= f = f a
Nope >>= _ = Nope
-- | If you have value @a@ that may not actually be there, and another value
-- @a'@ that might not actually be there, the lifted semigroup operation
-- @(\<\>)@ gives you @a \<\> a'@ only if both of them are actually there.
--
-- > ActuallyYes a <> ActuallyYes a' = ActuallyYes (a <> a')
-- > _ <> _ = Nope
instance Semigroup a => Semigroup (OrNot a) where
ActuallyYes a <> ActuallyYes a' = ActuallyYes (a <> a')
_ <> _ = Nope
-- | > mempty = ActuallyYes mempty
instance Monoid a => Monoid (OrNot a) where
mempty = ActuallyYes mempty
--------------------------------------------------------------------------------
-- Two
--------------------------------------------------------------------------------
-- | __@Two@__ is /two/ values. Yep. Just two values.
data Two a = Two { firstOfTwo :: a -- ^ One value.
, secondOfTwo :: a -- ^ Another value.
}
deriving (Eq, Functor, Show)
-- | If you have two functions @f@ and @g@ and two values @a@ and @a'@, then you
-- can apply them with @(\<*\>)@ to get two results @f a@ and @g a'@.
--
-- > pure a = Two a a
-- >
-- > Two f g <*> Two a a' = Two (f a) (g a')
instance Applicative Two where
pure a = Two a a
Two f g <*> Two a a' = Two (f a) (g a')
-- | > Two x y <> Two x' y' = Two (x <> x') (y <> y')
instance Semigroup a => Semigroup (Two a) where
Two x y <> Two x' y' = Two (x <> x') (y <> y')
-- | > mempty = Two mempty mempty
instance Monoid a => Monoid (Two a) where
mempty = Two mempty mempty
--------------------------------------------------------------------------------
-- Any-number-of
--------------------------------------------------------------------------------
-- | __@AnyNumberOf@__ starts to get exciting. Any number of values you want.
-- Zero ... one ... two ... three ... four ... five ... The possibilities are
-- /truly/ endless.
data AnyNumberOf a =
OneAndMaybeMore a (AnyNumberOf a)
-- ^ One value, and maybe even more after that!
| ActuallyNone -- ^ Oh. Well this is less fun.
deriving (Eq, Functor, Show)
-- | Alias for 'OneAndMaybeMore' which provides some brevity.
(~~) :: a -> AnyNumberOf a -> AnyNumberOf a
(~~) = OneAndMaybeMore
infixr 5 ~~
-- | You can use this to apply any number of functions to any number of
-- arguments.
--
-- > pure a = OneAndMaybeMore a ActuallyNone
-- >
-- > OneAndMaybeMore f fs <*> OneAndMaybeMore x xs =
-- > OneAndMaybeMore (f x) (fs <*> xs)
-- > _ <*> _ = ActuallyNone
--
-- Example:
--
-- > ( (+ 1) ~~ (* 2) ~~ (+ 5) ~~ ActuallyNone )
-- > <*> ( 1 ~~ 6 ~~ 4 ~~ 37 ~~ ActuallyNone )
-- > = ( 2 ~~ 12 ~~ 9 ~~ ActuallyNone )
--
-- This example demonstrates how when there are more arguments than functions,
-- any excess arguments (in this case, the @37@) are ignored.
instance Applicative AnyNumberOf where
pure a = OneAndMaybeMore a ActuallyNone
OneAndMaybeMore f fs <*> OneAndMaybeMore x xs =
OneAndMaybeMore (f x) (fs <*> xs)
_ <*> _ = ActuallyNone
-- | The operation of combining some number of @a@ with some other number of @a@
-- is sometimes referred to as /zipping/.
--
-- > OneAndMaybeMore x xs <> OneAndMaybeMore y ys =
-- > OneAndMaybeMore (x <> y) (xs <> ys)
-- > _ <> _ = ActuallyNone
instance Semigroup a => Semigroup (AnyNumberOf a) where
OneAndMaybeMore x xs <> OneAndMaybeMore y ys =
OneAndMaybeMore (x <> y) (xs <> ys)
_ <> _ = ActuallyNone
-- | > mempty = mempty ~~ mempty
instance Monoid a => Monoid (AnyNumberOf a) where
mempty = mempty ~~ mempty
--------------------------------------------------------------------------------
-- One-or-more
--------------------------------------------------------------------------------
-- | __@OneOrMore@__ is more restrictive than @AnyNumberOf@, yet somehow
-- actually /more/ interesting, because it excludes that dull situation where
-- there aren't any values at all.
data OneOrMore a = OneOrMore
{ theFirstOfMany :: a -- ^ Definitely at least this one.
, possiblyMore :: AnyNumberOf a -- ^ And perhaps others.
} deriving (Eq, Functor, Show)
-- | > pure a = OneOrMore a ActuallyNone
-- >
-- > OneOrMore f fs <*> OneOrMore x xs = OneOrMore (f x) (fs <*> xs)
instance Applicative OneOrMore where
pure a = OneOrMore a ActuallyNone
OneOrMore f fs <*> OneOrMore x xs = OneOrMore (f x) (fs <*> xs)
-- |
-- > OneOrMore a more <> OneOrMore a' more' =
-- > OneOrMore a (more <> OneAndMaybeMore a' more')
instance Semigroup a => Semigroup (OneOrMore a) where
OneOrMore a more <> OneOrMore a' more' =
OneOrMore a (more <> OneAndMaybeMore a' more')
-- | > mempty = OneOrMore mempty ActuallyNone
instance Monoid a => Monoid (OneOrMore a) where
mempty = OneOrMore mempty ActuallyNone
--------------------------------------------------------------------------------
-- Also-extra-thing
--------------------------------------------------------------------------------
-- | __@Also extraThing@__ is a functor in which each value has an @extraThing@
-- of some other type that tags along with it.
data (Also extraThing) a = Also
{ withoutExtraThing :: a -- ^ A value.
, theExtraThing :: extraThing -- ^ An additional thing that tags along.
}
deriving (Eq, Functor, Show)
-- | Dragging the @extraThing@ along can be a bit of a burden. It prevents @Also
-- extraThing@ from being an applicative functor — unless the @extraThing@ can
-- pull its weight by bringing a monoid to the table.
--
-- > pure = (`Also` mempty)
-- >
-- > (f `Also` extra1) <*> (a `Also` extra2) = f a
-- > `Also` (extra1 <> extra2)
instance Monoid extraThing => Applicative (Also extraThing) where
pure = (`Also` mempty)
(f `Also` extra1) <*> (a `Also` extra2) = f a
`Also` (extra1 <> extra2)
-- |
-- > (a `Also` extra1) <> (a' `Also` extra2) = (a <> a')
-- > `Also` (extra1 <> extra2)
instance (Semigroup extraThing, Semigroup a) => Semigroup ((Also extraThing) a)
where
(a `Also` extra1) <> (a' `Also` extra2) = (a <> a')
`Also` (extra1 <> extra2)
-- | > mempty = Also mempty mempty
instance (Monoid extraThing, Monoid a) => Monoid ((Also extraThing) a)
where
mempty = Also mempty mempty
--------------------------------------------------------------------------------
-- Or-instead-other-thing
--------------------------------------------------------------------------------
-- | __@OrInstead otherThing@__ is a functor in which, instead of having a
-- value, can actually just have some totally unrelated @otherThing@ instead.
--
-- When you combine stuff with @(\<*\>)@ or @(\<\>)@, all of the values need to
-- be present. If any of them are the @otherThing@ instead, then the whole
-- expression evaluates to the combination of the @otherThing@s.
data (OrInstead otherThing) a =
NotInstead a -- ^ A normal value.
| Instead otherThing -- ^ Some totally unrelated other thing.
deriving (Eq, Functor, Show)
-- | The possibility of having an @otherThing@ obstructs this functor's ability
-- to be applicative, much like the extra thing in @Also extraThing@ does. In
-- this case, since we do not need an empty value for the @otherThing@, it needs
-- only a semigroup to be in compliance.
--
-- > pure = NotInstead
-- >
-- > NotInstead f <*> NotInstead a = NotInstead (f a)
-- > Instead other1 <*> Instead other2 = Instead (other1 <> other2)
-- > Instead other <*> _ = Instead other
-- > _ <*> Instead other = Instead other
instance Semigroup otherThing => Applicative (OrInstead otherThing) where
pure = NotInstead
NotInstead f <*> NotInstead a = NotInstead (f a)
Instead other1 <*> Instead other2 = Instead (other1 <> other2)
Instead other <*> _ = Instead other
_ <*> Instead other = Instead other
-- |
-- > NotInstead a <> NotInstead a' = NotInstead (a <> a')
-- > Instead other1 <> Instead other2 = Instead (other1 <> other2)
-- > Instead other <> _ = Instead other
-- > _ <> Instead other = Instead other
instance (Semigroup otherThing, Semigroup a) =>
Semigroup ((OrInstead otherThing) a) where
NotInstead a <> NotInstead a' = NotInstead (a <> a')
Instead other1 <> Instead other2 = Instead (other1 <> other2)
Instead other <> _ = Instead other
_ <> Instead other = Instead other
-- > mempty = NotInstead mempty
instance (Semigroup otherThing, Monoid a) => Monoid ((OrInstead otherThing) a)
where
mempty = NotInstead mempty
--------------------------------------------------------------------------------
-- Or-instead-first-thing
--------------------------------------------------------------------------------
-- | __@OrInsteadFirst otherThing@__ looks a lot like @OrInstead otherThing@,
-- but it manages to always be an applicative functor — and even a monad too —
-- by handling the @otherThing@s a bit more hamfistedly.
--
-- When you combine stuff with @(\<*\>)@ or @(\<\>)@, all of the values need to
-- be present. If any of them are the @otherThing@ instead, then the whole
-- expression evaluates to the /first/ @otherThing@ encountered, ignoring any
-- additional @otherThing@s that may subsequently pop up.
data (OrInsteadFirst otherThing) a =
NotInsteadFirst a -- ^ A normal value.
| InsteadFirst otherThing -- ^ Some totally unrelated other thing.
deriving (Eq, Functor, Show)
-- |
-- > pure = NotInsteadFirst
-- >
-- > NotInsteadFirst f <*> NotInsteadFirst a = NotInsteadFirst (f a)
-- > InsteadFirst other <*> _ = InsteadFirst other
-- > _ <*> InsteadFirst other = InsteadFirst other
instance Applicative (OrInsteadFirst otherThing) where
pure = NotInsteadFirst
NotInsteadFirst f <*> NotInsteadFirst a = NotInsteadFirst (f a)
InsteadFirst other <*> _ = InsteadFirst other
_ <*> InsteadFirst other = InsteadFirst other
-- |
-- > InsteadFirst other >>= _ = InsteadFirst other
-- > NotInsteadFirst a >>= f = f a
instance Monad (OrInsteadFirst otherThing) where
InsteadFirst other >>= _ = InsteadFirst other
NotInsteadFirst a >>= f = f a
-- |
-- > NotInsteadFirst a <> NotInsteadFirst a' = NotInsteadFirst (a <> a')
-- > InsteadFirst other <> _ = InsteadFirst other
-- > _ <> InsteadFirst other = InsteadFirst other
instance (Semigroup otherThing, Semigroup a) =>
Semigroup ((OrInsteadFirst otherThing) a) where
NotInsteadFirst a <> NotInsteadFirst a' = NotInsteadFirst (a <> a')
InsteadFirst other <> _ = InsteadFirst other
_ <> InsteadFirst other = InsteadFirst other
-- | > mempty = NotInsteadFirst mempty
instance (Semigroup otherThing, Monoid a) =>
Monoid ((OrInsteadFirst otherThing) a) where
mempty = NotInsteadFirst mempty
--------------------------------------------------------------------------------
-- Determined-by-parameter
--------------------------------------------------------------------------------
-- | __@DeterminedBy parameter@__ is a value that... well, we're not really sure
-- what it is. We'll find out once a @parameter@ is provided.
--
-- The mechanism for deciding /how/ the value is determined from the
-- @parameter@ is opaque; all you can do is test it with different parameters
-- and see what results. There aren't even @Eq@ or @Show@ instances, which is
-- annoying.
data DeterminedBy parameter a = Determination ((->) parameter a)
deriving Functor
-- |
-- > pure a = Determination (\_ -> a)
-- >
-- > Determination f <*> Determination a = Determination (\x -> f x (a x))
instance Applicative (DeterminedBy parameter) where
pure a = Determination (\_ -> a)
Determination f <*> Determination a = Determination (\x -> f x (a x))
-- |
-- > Determination fa >>= ff =
-- > Determination (\x -> let Determination f = ff (fa x) in f x)
instance Monad (DeterminedBy parameter) where
Determination fa >>= ff =
Determination (\x -> let Determination f = ff (fa x) in f x)
-- | > Determination f <> Determination g = Determination (\x -> f x <> g x)
instance Semigroup a => Semigroup ((DeterminedBy parameter) a) where
Determination f <> Determination g = Determination (\x -> f x <> g x)
-- | > mempty = Determination (\_ -> mempty)
instance Monoid a => Monoid ((DeterminedBy parameter) a) where
mempty = Determination (\_ -> mempty)
{-
--------------------------------------------------------------------------------
-- Notes
--------------------------------------------------------------------------------
LiftedButWhy is Identity.
OrNot is Maybe, but with the monoid that is appropriate for its applicative.
Two doesn't have an analogue in any standard library as far as I know.
AnyNumberOf is ZipList, with the appropriate monoid added.
OneOrMore is like NonEmpty, but with instances that match ZipList.
Also is (,) — also known as the 2-tuple.
OrInstead is AccValidation from the 'validation' package.
OrInsteadFirst is Either.
DeterminedBy is (->), also known as a function, whose monad is also known as
Reader.
-}