content: -- | 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 )
  -- >  =  (    7  ~~   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       -- ^ Some 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 @otherThings@ that may subsequently pop up
  
  data (OrInsteadFirst otherThing) a =
        NotInsteadFirst a       -- ^ Some 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 a different semigroup and monoid.
  
  Two doesn't have an analogue in the standard library as far as I know.
  
  AnyNumberOf is ZipList.
  
  OneOrMore is NonEmpty.
  
  Also is (,), the 2-tuple.
  
  OrInstead is AccValidation from the 'validation' package.
  
  OrInsteadFirst is Either.
  
  DeterminedBy is (->) also known as a function, whose functor is also known as
  Reader.
  
  -}
  