-- | 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 (LiftedButWhy a -> LiftedButWhy a -> Bool
(LiftedButWhy a -> LiftedButWhy a -> Bool)
-> (LiftedButWhy a -> LiftedButWhy a -> Bool)
-> Eq (LiftedButWhy a)
forall a. Eq a => LiftedButWhy a -> LiftedButWhy a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LiftedButWhy a -> LiftedButWhy a -> Bool
$c/= :: forall a. Eq a => LiftedButWhy a -> LiftedButWhy a -> Bool
== :: LiftedButWhy a -> LiftedButWhy a -> Bool
$c== :: forall a. Eq a => LiftedButWhy a -> LiftedButWhy a -> Bool
Eq, a -> LiftedButWhy b -> LiftedButWhy a
(a -> b) -> LiftedButWhy a -> LiftedButWhy b
(forall a b. (a -> b) -> LiftedButWhy a -> LiftedButWhy b)
-> (forall a b. a -> LiftedButWhy b -> LiftedButWhy a)
-> Functor LiftedButWhy
forall a b. a -> LiftedButWhy b -> LiftedButWhy a
forall a b. (a -> b) -> LiftedButWhy a -> LiftedButWhy b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LiftedButWhy b -> LiftedButWhy a
$c<$ :: forall a b. a -> LiftedButWhy b -> LiftedButWhy a
fmap :: (a -> b) -> LiftedButWhy a -> LiftedButWhy b
$cfmap :: forall a b. (a -> b) -> LiftedButWhy a -> LiftedButWhy b
Functor, Int -> LiftedButWhy a -> ShowS
[LiftedButWhy a] -> ShowS
LiftedButWhy a -> String
(Int -> LiftedButWhy a -> ShowS)
-> (LiftedButWhy a -> String)
-> ([LiftedButWhy a] -> ShowS)
-> Show (LiftedButWhy a)
forall a. Show a => Int -> LiftedButWhy a -> ShowS
forall a. Show a => [LiftedButWhy a] -> ShowS
forall a. Show a => LiftedButWhy a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiftedButWhy a] -> ShowS
$cshowList :: forall a. Show a => [LiftedButWhy a] -> ShowS
show :: LiftedButWhy a -> String
$cshow :: forall a. Show a => LiftedButWhy a -> String
showsPrec :: Int -> LiftedButWhy a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LiftedButWhy a -> ShowS
Show)

-- | > pure = LiftedButWhy
-- >
-- > LiftedButWhy f <*> LiftedButWhy a = LiftedButWhy (f a)

instance Applicative LiftedButWhy where

    pure :: a -> LiftedButWhy a
pure = a -> LiftedButWhy a
forall a. a -> LiftedButWhy a
LiftedButWhy

    LiftedButWhy a -> b
f <*> :: LiftedButWhy (a -> b) -> LiftedButWhy a -> LiftedButWhy b
<*> LiftedButWhy a
a = b -> LiftedButWhy b
forall a. a -> LiftedButWhy a
LiftedButWhy (a -> b
f a
a)

-- | > LiftedButWhy a >>= f = f a

instance Monad LiftedButWhy where

    LiftedButWhy a
a >>= :: LiftedButWhy a -> (a -> LiftedButWhy b) -> LiftedButWhy b
>>= a -> LiftedButWhy b
f = a -> LiftedButWhy b
f a
a

-- | > LiftedButWhy x <> LiftedButWhy y = LiftedButWhy (x <> y)

instance Semigroup a => Semigroup (LiftedButWhy a) where

    LiftedButWhy a
x <> :: LiftedButWhy a -> LiftedButWhy a -> LiftedButWhy a
<> LiftedButWhy a
y = a -> LiftedButWhy a
forall a. a -> LiftedButWhy a
LiftedButWhy (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y)

-- | > mempty = LiftedButWhy mempty

instance Monoid a => Monoid (LiftedButWhy a) where

    mempty :: LiftedButWhy a
mempty = a -> LiftedButWhy a
forall a. a -> LiftedButWhy a
LiftedButWhy a
forall a. Monoid a => a
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 (OrNot a -> OrNot a -> Bool
(OrNot a -> OrNot a -> Bool)
-> (OrNot a -> OrNot a -> Bool) -> Eq (OrNot a)
forall a. Eq a => OrNot a -> OrNot a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrNot a -> OrNot a -> Bool
$c/= :: forall a. Eq a => OrNot a -> OrNot a -> Bool
== :: OrNot a -> OrNot a -> Bool
$c== :: forall a. Eq a => OrNot a -> OrNot a -> Bool
Eq, a -> OrNot b -> OrNot a
(a -> b) -> OrNot a -> OrNot b
(forall a b. (a -> b) -> OrNot a -> OrNot b)
-> (forall a b. a -> OrNot b -> OrNot a) -> Functor OrNot
forall a b. a -> OrNot b -> OrNot a
forall a b. (a -> b) -> OrNot a -> OrNot b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OrNot b -> OrNot a
$c<$ :: forall a b. a -> OrNot b -> OrNot a
fmap :: (a -> b) -> OrNot a -> OrNot b
$cfmap :: forall a b. (a -> b) -> OrNot a -> OrNot b
Functor, Int -> OrNot a -> ShowS
[OrNot a] -> ShowS
OrNot a -> String
(Int -> OrNot a -> ShowS)
-> (OrNot a -> String) -> ([OrNot a] -> ShowS) -> Show (OrNot a)
forall a. Show a => Int -> OrNot a -> ShowS
forall a. Show a => [OrNot a] -> ShowS
forall a. Show a => OrNot a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrNot a] -> ShowS
$cshowList :: forall a. Show a => [OrNot a] -> ShowS
show :: OrNot a -> String
$cshow :: forall a. Show a => OrNot a -> String
showsPrec :: Int -> OrNot a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OrNot a -> ShowS
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 :: a -> OrNot a
pure = a -> OrNot a
forall a. a -> OrNot a
ActuallyYes

    ActuallyYes a -> b
f <*> :: OrNot (a -> b) -> OrNot a -> OrNot b
<*> ActuallyYes a
a = b -> OrNot b
forall a. a -> OrNot a
ActuallyYes (a -> b
f a
a)
    OrNot (a -> b)
_             <*> OrNot a
_             = OrNot b
forall a. OrNot a
Nope

instance Monad OrNot where

    ActuallyYes a
a  >>= :: OrNot a -> (a -> OrNot b) -> OrNot b
>>= a -> OrNot b
f = a -> OrNot b
f a
a
    OrNot a
Nope           >>= a -> OrNot b
_ = OrNot b
forall a. OrNot a
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
a <> :: OrNot a -> OrNot a -> OrNot a
<> ActuallyYes a
a' = a -> OrNot a
forall a. a -> OrNot a
ActuallyYes (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a')
    OrNot a
_             <> OrNot a
_              = OrNot a
forall a. OrNot a
Nope

-- | > mempty = ActuallyYes mempty

instance Monoid a => Monoid (OrNot a) where

    mempty :: OrNot a
mempty = a -> OrNot a
forall a. a -> OrNot a
ActuallyYes a
forall a. Monoid a => a
mempty


--------------------------------------------------------------------------------
--  Two
--------------------------------------------------------------------------------

-- | __@Two@__ is /two/ values. Yep. Just two values.

data Two a = Two { Two a -> a
firstOfTwo  :: a -- ^ One value.
                 , Two a -> a
secondOfTwo :: a -- ^ Another value.
                 }
    deriving (Two a -> Two a -> Bool
(Two a -> Two a -> Bool) -> (Two a -> Two a -> Bool) -> Eq (Two a)
forall a. Eq a => Two a -> Two a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Two a -> Two a -> Bool
$c/= :: forall a. Eq a => Two a -> Two a -> Bool
== :: Two a -> Two a -> Bool
$c== :: forall a. Eq a => Two a -> Two a -> Bool
Eq, a -> Two b -> Two a
(a -> b) -> Two a -> Two b
(forall a b. (a -> b) -> Two a -> Two b)
-> (forall a b. a -> Two b -> Two a) -> Functor Two
forall a b. a -> Two b -> Two a
forall a b. (a -> b) -> Two a -> Two b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Two b -> Two a
$c<$ :: forall a b. a -> Two b -> Two a
fmap :: (a -> b) -> Two a -> Two b
$cfmap :: forall a b. (a -> b) -> Two a -> Two b
Functor, Int -> Two a -> ShowS
[Two a] -> ShowS
Two a -> String
(Int -> Two a -> ShowS)
-> (Two a -> String) -> ([Two a] -> ShowS) -> Show (Two a)
forall a. Show a => Int -> Two a -> ShowS
forall a. Show a => [Two a] -> ShowS
forall a. Show a => Two a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Two a] -> ShowS
$cshowList :: forall a. Show a => [Two a] -> ShowS
show :: Two a -> String
$cshow :: forall a. Show a => Two a -> String
showsPrec :: Int -> Two a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Two a -> ShowS
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
pure a
a = a -> a -> Two a
forall a. a -> a -> Two a
Two a
a a
a

    Two a -> b
f a -> b
g <*> :: Two (a -> b) -> Two a -> Two b
<*> Two a
a a
a' = b -> b -> Two b
forall a. a -> a -> Two a
Two (a -> b
f a
a) (a -> b
g a
a')

-- | > Two x y <> Two x' y' = Two (x <> x') (y <> y')

instance Semigroup a => Semigroup (Two a) where

    Two a
x a
y <> :: Two a -> Two a -> Two a
<> Two a
x' a
y' = a -> a -> Two a
forall a. a -> a -> Two a
Two (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x') (a
y a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y')

-- | > mempty = Two mempty mempty

instance Monoid a => Monoid (Two a) where

    mempty :: Two a
mempty = a -> a -> Two a
forall a. a -> a -> Two a
Two a
forall a. Monoid a => a
mempty a
forall a. Monoid a => a
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 (AnyNumberOf a -> AnyNumberOf a -> Bool
(AnyNumberOf a -> AnyNumberOf a -> Bool)
-> (AnyNumberOf a -> AnyNumberOf a -> Bool) -> Eq (AnyNumberOf a)
forall a. Eq a => AnyNumberOf a -> AnyNumberOf a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyNumberOf a -> AnyNumberOf a -> Bool
$c/= :: forall a. Eq a => AnyNumberOf a -> AnyNumberOf a -> Bool
== :: AnyNumberOf a -> AnyNumberOf a -> Bool
$c== :: forall a. Eq a => AnyNumberOf a -> AnyNumberOf a -> Bool
Eq, a -> AnyNumberOf b -> AnyNumberOf a
(a -> b) -> AnyNumberOf a -> AnyNumberOf b
(forall a b. (a -> b) -> AnyNumberOf a -> AnyNumberOf b)
-> (forall a b. a -> AnyNumberOf b -> AnyNumberOf a)
-> Functor AnyNumberOf
forall a b. a -> AnyNumberOf b -> AnyNumberOf a
forall a b. (a -> b) -> AnyNumberOf a -> AnyNumberOf b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AnyNumberOf b -> AnyNumberOf a
$c<$ :: forall a b. a -> AnyNumberOf b -> AnyNumberOf a
fmap :: (a -> b) -> AnyNumberOf a -> AnyNumberOf b
$cfmap :: forall a b. (a -> b) -> AnyNumberOf a -> AnyNumberOf b
Functor, Int -> AnyNumberOf a -> ShowS
[AnyNumberOf a] -> ShowS
AnyNumberOf a -> String
(Int -> AnyNumberOf a -> ShowS)
-> (AnyNumberOf a -> String)
-> ([AnyNumberOf a] -> ShowS)
-> Show (AnyNumberOf a)
forall a. Show a => Int -> AnyNumberOf a -> ShowS
forall a. Show a => [AnyNumberOf a] -> ShowS
forall a. Show a => AnyNumberOf a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyNumberOf a] -> ShowS
$cshowList :: forall a. Show a => [AnyNumberOf a] -> ShowS
show :: AnyNumberOf a -> String
$cshow :: forall a. Show a => AnyNumberOf a -> String
showsPrec :: Int -> AnyNumberOf a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AnyNumberOf a -> ShowS
Show)

-- | Alias for 'OneAndMaybeMore' which provides some brevity.

(~~) :: a -> AnyNumberOf a -> AnyNumberOf a
~~ :: a -> AnyNumberOf a -> AnyNumberOf a
(~~) = a -> AnyNumberOf a -> AnyNumberOf a
forall a. 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 -> AnyNumberOf a
pure a
a = a -> AnyNumberOf a -> AnyNumberOf a
forall a. a -> AnyNumberOf a -> AnyNumberOf a
OneAndMaybeMore a
a AnyNumberOf a
forall a. AnyNumberOf a
ActuallyNone

    OneAndMaybeMore a -> b
f AnyNumberOf (a -> b)
fs <*> :: AnyNumberOf (a -> b) -> AnyNumberOf a -> AnyNumberOf b
<*> OneAndMaybeMore a
x AnyNumberOf a
xs =
        b -> AnyNumberOf b -> AnyNumberOf b
forall a. a -> AnyNumberOf a -> AnyNumberOf a
OneAndMaybeMore (a -> b
f a
x) (AnyNumberOf (a -> b)
fs AnyNumberOf (a -> b) -> AnyNumberOf a -> AnyNumberOf b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AnyNumberOf a
xs)
    AnyNumberOf (a -> b)
_ <*> AnyNumberOf a
_ = AnyNumberOf b
forall a. AnyNumberOf a
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 a
x AnyNumberOf a
xs <> :: AnyNumberOf a -> AnyNumberOf a -> AnyNumberOf a
<> OneAndMaybeMore a
y AnyNumberOf a
ys =
        a -> AnyNumberOf a -> AnyNumberOf a
forall a. a -> AnyNumberOf a -> AnyNumberOf a
OneAndMaybeMore (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y) (AnyNumberOf a
xs AnyNumberOf a -> AnyNumberOf a -> AnyNumberOf a
forall a. Semigroup a => a -> a -> a
<> AnyNumberOf a
ys)
    AnyNumberOf a
_ <> AnyNumberOf a
_ = AnyNumberOf a
forall a. AnyNumberOf a
ActuallyNone

-- | > mempty = mempty ~~ mempty

instance Monoid a => Monoid (AnyNumberOf a) where

    mempty :: AnyNumberOf a
mempty = a
forall a. Monoid a => a
mempty a -> AnyNumberOf a -> AnyNumberOf a
forall a. a -> AnyNumberOf a -> AnyNumberOf a
~~ AnyNumberOf a
forall a. Monoid a => a
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
    { OneOrMore a -> a
theFirstOfMany :: a -- ^ Definitely at least this one.
    , OneOrMore a -> AnyNumberOf a
possiblyMore :: AnyNumberOf a -- ^ And perhaps others.
    } deriving (OneOrMore a -> OneOrMore a -> Bool
(OneOrMore a -> OneOrMore a -> Bool)
-> (OneOrMore a -> OneOrMore a -> Bool) -> Eq (OneOrMore a)
forall a. Eq a => OneOrMore a -> OneOrMore a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OneOrMore a -> OneOrMore a -> Bool
$c/= :: forall a. Eq a => OneOrMore a -> OneOrMore a -> Bool
== :: OneOrMore a -> OneOrMore a -> Bool
$c== :: forall a. Eq a => OneOrMore a -> OneOrMore a -> Bool
Eq, a -> OneOrMore b -> OneOrMore a
(a -> b) -> OneOrMore a -> OneOrMore b
(forall a b. (a -> b) -> OneOrMore a -> OneOrMore b)
-> (forall a b. a -> OneOrMore b -> OneOrMore a)
-> Functor OneOrMore
forall a b. a -> OneOrMore b -> OneOrMore a
forall a b. (a -> b) -> OneOrMore a -> OneOrMore b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OneOrMore b -> OneOrMore a
$c<$ :: forall a b. a -> OneOrMore b -> OneOrMore a
fmap :: (a -> b) -> OneOrMore a -> OneOrMore b
$cfmap :: forall a b. (a -> b) -> OneOrMore a -> OneOrMore b
Functor, Int -> OneOrMore a -> ShowS
[OneOrMore a] -> ShowS
OneOrMore a -> String
(Int -> OneOrMore a -> ShowS)
-> (OneOrMore a -> String)
-> ([OneOrMore a] -> ShowS)
-> Show (OneOrMore a)
forall a. Show a => Int -> OneOrMore a -> ShowS
forall a. Show a => [OneOrMore a] -> ShowS
forall a. Show a => OneOrMore a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OneOrMore a] -> ShowS
$cshowList :: forall a. Show a => [OneOrMore a] -> ShowS
show :: OneOrMore a -> String
$cshow :: forall a. Show a => OneOrMore a -> String
showsPrec :: Int -> OneOrMore a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OneOrMore a -> ShowS
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
pure a
a = a -> AnyNumberOf a -> OneOrMore a
forall a. a -> AnyNumberOf a -> OneOrMore a
OneOrMore a
a AnyNumberOf a
forall a. AnyNumberOf a
ActuallyNone

    OneOrMore a -> b
f AnyNumberOf (a -> b)
fs <*> :: OneOrMore (a -> b) -> OneOrMore a -> OneOrMore b
<*> OneOrMore a
x AnyNumberOf a
xs = b -> AnyNumberOf b -> OneOrMore b
forall a. a -> AnyNumberOf a -> OneOrMore a
OneOrMore (a -> b
f a
x) (AnyNumberOf (a -> b)
fs AnyNumberOf (a -> b) -> AnyNumberOf a -> AnyNumberOf b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AnyNumberOf a
xs)

-- |
-- > OneOrMore a more <> OneOrMore a' more' =
-- >     OneOrMore a (more <> OneAndMaybeMore a' more')

instance Semigroup a => Semigroup (OneOrMore a) where

    OneOrMore a
a AnyNumberOf a
more <> :: OneOrMore a -> OneOrMore a -> OneOrMore a
<> OneOrMore a
a' AnyNumberOf a
more' =
        a -> AnyNumberOf a -> OneOrMore a
forall a. a -> AnyNumberOf a -> OneOrMore a
OneOrMore a
a (AnyNumberOf a
more AnyNumberOf a -> AnyNumberOf a -> AnyNumberOf a
forall a. Semigroup a => a -> a -> a
<> a -> AnyNumberOf a -> AnyNumberOf a
forall a. a -> AnyNumberOf a -> AnyNumberOf a
OneAndMaybeMore a
a' AnyNumberOf a
more')

-- | > mempty = OneOrMore mempty ActuallyNone

instance Monoid a => Monoid (OneOrMore a) where

    mempty :: OneOrMore a
mempty = a -> AnyNumberOf a -> OneOrMore a
forall a. a -> AnyNumberOf a -> OneOrMore a
OneOrMore a
forall a. Monoid a => a
mempty AnyNumberOf a
forall a. AnyNumberOf a
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
    { Also extraThing a -> a
withoutExtraThing :: a          -- ^ A value.
    , Also extraThing a -> extraThing
theExtraThing     :: extraThing -- ^ An additional thing that tags along.
    }
    deriving (Also extraThing a -> Also extraThing a -> Bool
(Also extraThing a -> Also extraThing a -> Bool)
-> (Also extraThing a -> Also extraThing a -> Bool)
-> Eq (Also extraThing a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall extraThing a.
(Eq a, Eq extraThing) =>
Also extraThing a -> Also extraThing a -> Bool
/= :: Also extraThing a -> Also extraThing a -> Bool
$c/= :: forall extraThing a.
(Eq a, Eq extraThing) =>
Also extraThing a -> Also extraThing a -> Bool
== :: Also extraThing a -> Also extraThing a -> Bool
$c== :: forall extraThing a.
(Eq a, Eq extraThing) =>
Also extraThing a -> Also extraThing a -> Bool
Eq, a -> Also extraThing b -> Also extraThing a
(a -> b) -> Also extraThing a -> Also extraThing b
(forall a b. (a -> b) -> Also extraThing a -> Also extraThing b)
-> (forall a b. a -> Also extraThing b -> Also extraThing a)
-> Functor (Also extraThing)
forall a b. a -> Also extraThing b -> Also extraThing a
forall a b. (a -> b) -> Also extraThing a -> Also extraThing b
forall extraThing a b. a -> Also extraThing b -> Also extraThing a
forall extraThing a b.
(a -> b) -> Also extraThing a -> Also extraThing b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Also extraThing b -> Also extraThing a
$c<$ :: forall extraThing a b. a -> Also extraThing b -> Also extraThing a
fmap :: (a -> b) -> Also extraThing a -> Also extraThing b
$cfmap :: forall extraThing a b.
(a -> b) -> Also extraThing a -> Also extraThing b
Functor, Int -> Also extraThing a -> ShowS
[Also extraThing a] -> ShowS
Also extraThing a -> String
(Int -> Also extraThing a -> ShowS)
-> (Also extraThing a -> String)
-> ([Also extraThing a] -> ShowS)
-> Show (Also extraThing a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall extraThing a.
(Show a, Show extraThing) =>
Int -> Also extraThing a -> ShowS
forall extraThing a.
(Show a, Show extraThing) =>
[Also extraThing a] -> ShowS
forall extraThing a.
(Show a, Show extraThing) =>
Also extraThing a -> String
showList :: [Also extraThing a] -> ShowS
$cshowList :: forall extraThing a.
(Show a, Show extraThing) =>
[Also extraThing a] -> ShowS
show :: Also extraThing a -> String
$cshow :: forall extraThing a.
(Show a, Show extraThing) =>
Also extraThing a -> String
showsPrec :: Int -> Also extraThing a -> ShowS
$cshowsPrec :: forall extraThing a.
(Show a, Show extraThing) =>
Int -> Also extraThing a -> ShowS
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 :: a -> Also extraThing a
pure = (a -> extraThing -> Also extraThing a
forall extraThing a. a -> extraThing -> Also extraThing a
`Also` extraThing
forall a. Monoid a => a
mempty)

    (a -> b
f `Also` extraThing
extra1) <*> :: Also extraThing (a -> b) -> Also extraThing a -> Also extraThing b
<*> (a
a `Also` extraThing
extra2) = a -> b
f a
a
                                              b -> extraThing -> Also extraThing b
forall extraThing a. a -> extraThing -> Also extraThing a
`Also` (extraThing
extra1 extraThing -> extraThing -> extraThing
forall a. Semigroup a => a -> a -> a
<> extraThing
extra2)

-- |
-- > (a `Also` extra1) <> (a' `Also` extra2) = (a <> a')
-- >                                           `Also` (extra1 <> extra2)

instance (Semigroup extraThing, Semigroup a) => Semigroup ((Also extraThing) a)
  where

    (a
a `Also` extraThing
extra1) <> :: Also extraThing a -> Also extraThing a -> Also extraThing a
<> (a
a' `Also` extraThing
extra2) = (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a')
                                              a -> extraThing -> Also extraThing a
forall extraThing a. a -> extraThing -> Also extraThing a
`Also` (extraThing
extra1 extraThing -> extraThing -> extraThing
forall a. Semigroup a => a -> a -> a
<> extraThing
extra2)

-- | > mempty = Also mempty mempty

instance (Monoid extraThing, Monoid a) => Monoid ((Also extraThing) a)
  where

    mempty :: Also extraThing a
mempty = a -> extraThing -> Also extraThing a
forall extraThing a. a -> extraThing -> Also extraThing a
Also a
forall a. Monoid a => a
mempty extraThing
forall a. Monoid a => a
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 (OrInstead otherThing a -> OrInstead otherThing a -> Bool
(OrInstead otherThing a -> OrInstead otherThing a -> Bool)
-> (OrInstead otherThing a -> OrInstead otherThing a -> Bool)
-> Eq (OrInstead otherThing a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall otherThing a.
(Eq a, Eq otherThing) =>
OrInstead otherThing a -> OrInstead otherThing a -> Bool
/= :: OrInstead otherThing a -> OrInstead otherThing a -> Bool
$c/= :: forall otherThing a.
(Eq a, Eq otherThing) =>
OrInstead otherThing a -> OrInstead otherThing a -> Bool
== :: OrInstead otherThing a -> OrInstead otherThing a -> Bool
$c== :: forall otherThing a.
(Eq a, Eq otherThing) =>
OrInstead otherThing a -> OrInstead otherThing a -> Bool
Eq, a -> OrInstead otherThing b -> OrInstead otherThing a
(a -> b) -> OrInstead otherThing a -> OrInstead otherThing b
(forall a b.
 (a -> b) -> OrInstead otherThing a -> OrInstead otherThing b)
-> (forall a b.
    a -> OrInstead otherThing b -> OrInstead otherThing a)
-> Functor (OrInstead otherThing)
forall a b. a -> OrInstead otherThing b -> OrInstead otherThing a
forall a b.
(a -> b) -> OrInstead otherThing a -> OrInstead otherThing b
forall otherThing a b.
a -> OrInstead otherThing b -> OrInstead otherThing a
forall otherThing a b.
(a -> b) -> OrInstead otherThing a -> OrInstead otherThing b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OrInstead otherThing b -> OrInstead otherThing a
$c<$ :: forall otherThing a b.
a -> OrInstead otherThing b -> OrInstead otherThing a
fmap :: (a -> b) -> OrInstead otherThing a -> OrInstead otherThing b
$cfmap :: forall otherThing a b.
(a -> b) -> OrInstead otherThing a -> OrInstead otherThing b
Functor, Int -> OrInstead otherThing a -> ShowS
[OrInstead otherThing a] -> ShowS
OrInstead otherThing a -> String
(Int -> OrInstead otherThing a -> ShowS)
-> (OrInstead otherThing a -> String)
-> ([OrInstead otherThing a] -> ShowS)
-> Show (OrInstead otherThing a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall otherThing a.
(Show a, Show otherThing) =>
Int -> OrInstead otherThing a -> ShowS
forall otherThing a.
(Show a, Show otherThing) =>
[OrInstead otherThing a] -> ShowS
forall otherThing a.
(Show a, Show otherThing) =>
OrInstead otherThing a -> String
showList :: [OrInstead otherThing a] -> ShowS
$cshowList :: forall otherThing a.
(Show a, Show otherThing) =>
[OrInstead otherThing a] -> ShowS
show :: OrInstead otherThing a -> String
$cshow :: forall otherThing a.
(Show a, Show otherThing) =>
OrInstead otherThing a -> String
showsPrec :: Int -> OrInstead otherThing a -> ShowS
$cshowsPrec :: forall otherThing a.
(Show a, Show otherThing) =>
Int -> OrInstead otherThing a -> ShowS
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 :: a -> OrInstead otherThing a
pure = a -> OrInstead otherThing a
forall otherThing a. a -> OrInstead otherThing a
NotInstead

    NotInstead a -> b
f   <*> :: OrInstead otherThing (a -> b)
-> OrInstead otherThing a -> OrInstead otherThing b
<*> NotInstead a
a   = b -> OrInstead otherThing b
forall otherThing a. a -> OrInstead otherThing a
NotInstead (a -> b
f a
a)
    Instead otherThing
other1 <*> Instead otherThing
other2 = otherThing -> OrInstead otherThing b
forall otherThing a. otherThing -> OrInstead otherThing a
Instead (otherThing
other1 otherThing -> otherThing -> otherThing
forall a. Semigroup a => a -> a -> a
<> otherThing
other2)
    Instead otherThing
other  <*> OrInstead otherThing a
_              = otherThing -> OrInstead otherThing b
forall otherThing a. otherThing -> OrInstead otherThing a
Instead otherThing
other
    OrInstead otherThing (a -> b)
_              <*> Instead otherThing
other  = otherThing -> OrInstead otherThing b
forall otherThing a. otherThing -> OrInstead otherThing a
Instead otherThing
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
a   <> :: OrInstead otherThing a
-> OrInstead otherThing a -> OrInstead otherThing a
<> NotInstead a
a'  = a -> OrInstead otherThing a
forall otherThing a. a -> OrInstead otherThing a
NotInstead (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a')
    Instead otherThing
other1 <> Instead otherThing
other2 = otherThing -> OrInstead otherThing a
forall otherThing a. otherThing -> OrInstead otherThing a
Instead (otherThing
other1 otherThing -> otherThing -> otherThing
forall a. Semigroup a => a -> a -> a
<> otherThing
other2)
    Instead otherThing
other  <> OrInstead otherThing a
_              = otherThing -> OrInstead otherThing a
forall otherThing a. otherThing -> OrInstead otherThing a
Instead otherThing
other
    OrInstead otherThing a
_              <> Instead otherThing
other  = otherThing -> OrInstead otherThing a
forall otherThing a. otherThing -> OrInstead otherThing a
Instead otherThing
other

-- > mempty = NotInstead mempty

instance (Semigroup otherThing, Monoid a) => Monoid ((OrInstead otherThing) a)
  where

    mempty :: OrInstead otherThing a
mempty = a -> OrInstead otherThing a
forall otherThing a. a -> OrInstead otherThing a
NotInstead a
forall a. Monoid a => a
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 (OrInsteadFirst otherThing a -> OrInsteadFirst otherThing a -> Bool
(OrInsteadFirst otherThing a
 -> OrInsteadFirst otherThing a -> Bool)
-> (OrInsteadFirst otherThing a
    -> OrInsteadFirst otherThing a -> Bool)
-> Eq (OrInsteadFirst otherThing a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall otherThing a.
(Eq a, Eq otherThing) =>
OrInsteadFirst otherThing a -> OrInsteadFirst otherThing a -> Bool
/= :: OrInsteadFirst otherThing a -> OrInsteadFirst otherThing a -> Bool
$c/= :: forall otherThing a.
(Eq a, Eq otherThing) =>
OrInsteadFirst otherThing a -> OrInsteadFirst otherThing a -> Bool
== :: OrInsteadFirst otherThing a -> OrInsteadFirst otherThing a -> Bool
$c== :: forall otherThing a.
(Eq a, Eq otherThing) =>
OrInsteadFirst otherThing a -> OrInsteadFirst otherThing a -> Bool
Eq, a -> OrInsteadFirst otherThing b -> OrInsteadFirst otherThing a
(a -> b)
-> OrInsteadFirst otherThing a -> OrInsteadFirst otherThing b
(forall a b.
 (a -> b)
 -> OrInsteadFirst otherThing a -> OrInsteadFirst otherThing b)
-> (forall a b.
    a -> OrInsteadFirst otherThing b -> OrInsteadFirst otherThing a)
-> Functor (OrInsteadFirst otherThing)
forall a b.
a -> OrInsteadFirst otherThing b -> OrInsteadFirst otherThing a
forall a b.
(a -> b)
-> OrInsteadFirst otherThing a -> OrInsteadFirst otherThing b
forall otherThing a b.
a -> OrInsteadFirst otherThing b -> OrInsteadFirst otherThing a
forall otherThing a b.
(a -> b)
-> OrInsteadFirst otherThing a -> OrInsteadFirst otherThing b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OrInsteadFirst otherThing b -> OrInsteadFirst otherThing a
$c<$ :: forall otherThing a b.
a -> OrInsteadFirst otherThing b -> OrInsteadFirst otherThing a
fmap :: (a -> b)
-> OrInsteadFirst otherThing a -> OrInsteadFirst otherThing b
$cfmap :: forall otherThing a b.
(a -> b)
-> OrInsteadFirst otherThing a -> OrInsteadFirst otherThing b
Functor, Int -> OrInsteadFirst otherThing a -> ShowS
[OrInsteadFirst otherThing a] -> ShowS
OrInsteadFirst otherThing a -> String
(Int -> OrInsteadFirst otherThing a -> ShowS)
-> (OrInsteadFirst otherThing a -> String)
-> ([OrInsteadFirst otherThing a] -> ShowS)
-> Show (OrInsteadFirst otherThing a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall otherThing a.
(Show a, Show otherThing) =>
Int -> OrInsteadFirst otherThing a -> ShowS
forall otherThing a.
(Show a, Show otherThing) =>
[OrInsteadFirst otherThing a] -> ShowS
forall otherThing a.
(Show a, Show otherThing) =>
OrInsteadFirst otherThing a -> String
showList :: [OrInsteadFirst otherThing a] -> ShowS
$cshowList :: forall otherThing a.
(Show a, Show otherThing) =>
[OrInsteadFirst otherThing a] -> ShowS
show :: OrInsteadFirst otherThing a -> String
$cshow :: forall otherThing a.
(Show a, Show otherThing) =>
OrInsteadFirst otherThing a -> String
showsPrec :: Int -> OrInsteadFirst otherThing a -> ShowS
$cshowsPrec :: forall otherThing a.
(Show a, Show otherThing) =>
Int -> OrInsteadFirst otherThing a -> ShowS
Show)

-- |
-- > pure = NotInsteadFirst
-- >
-- > NotInsteadFirst f  <*> NotInsteadFirst a  = NotInsteadFirst (f a)
-- > InsteadFirst other <*> _                  = InsteadFirst other
-- > _                  <*> InsteadFirst other = InsteadFirst other

instance Applicative (OrInsteadFirst otherThing) where

    pure :: a -> OrInsteadFirst otherThing a
pure = a -> OrInsteadFirst otherThing a
forall otherThing a. a -> OrInsteadFirst otherThing a
NotInsteadFirst

    NotInsteadFirst a -> b
f  <*> :: OrInsteadFirst otherThing (a -> b)
-> OrInsteadFirst otherThing a -> OrInsteadFirst otherThing b
<*> NotInsteadFirst a
a  = b -> OrInsteadFirst otherThing b
forall otherThing a. a -> OrInsteadFirst otherThing a
NotInsteadFirst (a -> b
f a
a)
    InsteadFirst otherThing
other <*> OrInsteadFirst otherThing a
_                  = otherThing -> OrInsteadFirst otherThing b
forall otherThing a. otherThing -> OrInsteadFirst otherThing a
InsteadFirst otherThing
other
    OrInsteadFirst otherThing (a -> b)
_                  <*> InsteadFirst otherThing
other = otherThing -> OrInsteadFirst otherThing b
forall otherThing a. otherThing -> OrInsteadFirst otherThing a
InsteadFirst otherThing
other

-- |
-- > InsteadFirst other >>= _ = InsteadFirst other
-- > NotInsteadFirst a  >>= f = f a

instance Monad (OrInsteadFirst otherThing) where

    InsteadFirst otherThing
other >>= :: OrInsteadFirst otherThing a
-> (a -> OrInsteadFirst otherThing b)
-> OrInsteadFirst otherThing b
>>= a -> OrInsteadFirst otherThing b
_ = otherThing -> OrInsteadFirst otherThing b
forall otherThing a. otherThing -> OrInsteadFirst otherThing a
InsteadFirst otherThing
other
    NotInsteadFirst a
a  >>= a -> OrInsteadFirst otherThing b
f = a -> OrInsteadFirst otherThing b
f a
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
a  <> :: OrInsteadFirst otherThing a
-> OrInsteadFirst otherThing a -> OrInsteadFirst otherThing a
<> NotInsteadFirst a
a' = a -> OrInsteadFirst otherThing a
forall otherThing a. a -> OrInsteadFirst otherThing a
NotInsteadFirst (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a')
    InsteadFirst otherThing
other <> OrInsteadFirst otherThing a
_                  = otherThing -> OrInsteadFirst otherThing a
forall otherThing a. otherThing -> OrInsteadFirst otherThing a
InsteadFirst otherThing
other
    OrInsteadFirst otherThing a
_                  <> InsteadFirst otherThing
other = otherThing -> OrInsteadFirst otherThing a
forall otherThing a. otherThing -> OrInsteadFirst otherThing a
InsteadFirst otherThing
other

-- | > mempty = NotInsteadFirst mempty

instance (Semigroup otherThing, Monoid a) =>
  Monoid ((OrInsteadFirst otherThing) a) where

    mempty :: OrInsteadFirst otherThing a
mempty = a -> OrInsteadFirst otherThing a
forall otherThing a. a -> OrInsteadFirst otherThing a
NotInsteadFirst a
forall a. Monoid a => a
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 a -> DeterminedBy parameter b -> DeterminedBy parameter a
(a -> b) -> DeterminedBy parameter a -> DeterminedBy parameter b
(forall a b.
 (a -> b) -> DeterminedBy parameter a -> DeterminedBy parameter b)
-> (forall a b.
    a -> DeterminedBy parameter b -> DeterminedBy parameter a)
-> Functor (DeterminedBy parameter)
forall a b.
a -> DeterminedBy parameter b -> DeterminedBy parameter a
forall a b.
(a -> b) -> DeterminedBy parameter a -> DeterminedBy parameter b
forall parameter a b.
a -> DeterminedBy parameter b -> DeterminedBy parameter a
forall parameter a b.
(a -> b) -> DeterminedBy parameter a -> DeterminedBy parameter b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> DeterminedBy parameter b -> DeterminedBy parameter a
$c<$ :: forall parameter a b.
a -> DeterminedBy parameter b -> DeterminedBy parameter a
fmap :: (a -> b) -> DeterminedBy parameter a -> DeterminedBy parameter b
$cfmap :: forall parameter a b.
(a -> b) -> DeterminedBy parameter a -> DeterminedBy parameter b
Functor

-- |
-- > pure a = Determination (\_ -> a)
-- >
-- > Determination f <*> Determination a = Determination (\x -> f x (a x))

instance Applicative (DeterminedBy parameter) where

    pure :: a -> DeterminedBy parameter a
pure a
a = (parameter -> a) -> DeterminedBy parameter a
forall parameter a. (parameter -> a) -> DeterminedBy parameter a
Determination (\parameter
_ -> a
a)

    Determination parameter -> a -> b
f <*> :: DeterminedBy parameter (a -> b)
-> DeterminedBy parameter a -> DeterminedBy parameter b
<*> Determination parameter -> a
a = (parameter -> b) -> DeterminedBy parameter b
forall parameter a. (parameter -> a) -> DeterminedBy parameter a
Determination (\parameter
x -> parameter -> a -> b
f parameter
x (parameter -> a
a parameter
x))

-- |
-- > Determination fa >>= ff =
-- >     Determination (\x -> let Determination f = ff (fa x) in f x)

instance Monad (DeterminedBy parameter) where

    Determination parameter -> a
fa >>= :: DeterminedBy parameter a
-> (a -> DeterminedBy parameter b) -> DeterminedBy parameter b
>>= a -> DeterminedBy parameter b
ff =
        (parameter -> b) -> DeterminedBy parameter b
forall parameter a. (parameter -> a) -> DeterminedBy parameter a
Determination (\parameter
x -> let Determination parameter -> b
f = a -> DeterminedBy parameter b
ff (parameter -> a
fa parameter
x) in parameter -> b
f parameter
x)

-- | > Determination f <> Determination g = Determination (\x -> f x <> g x)

instance Semigroup a => Semigroup ((DeterminedBy parameter) a) where

    Determination parameter -> a
f <> :: DeterminedBy parameter a
-> DeterminedBy parameter a -> DeterminedBy parameter a
<> Determination parameter -> a
g = (parameter -> a) -> DeterminedBy parameter a
forall parameter a. (parameter -> a) -> DeterminedBy parameter a
Determination (\parameter
x -> parameter -> a
f parameter
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> parameter -> a
g parameter
x)

-- | > mempty = Determination (\_ -> mempty)

instance Monoid a => Monoid ((DeterminedBy parameter) a) where

    mempty :: DeterminedBy parameter a
mempty = (parameter -> a) -> DeterminedBy parameter a
forall parameter a. (parameter -> a) -> DeterminedBy parameter a
Determination (\parameter
_ -> a
forall a. Monoid a => a
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.

-}