packages feed

acme-functors (empty) → 0.1.0.0

raw patch · 5 files changed

+618/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Chris Martin (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ acme-functors.cabal view
@@ -0,0 +1,34 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           acme-functors+version:        0.1.0.0+synopsis:       The best applicative functors.+description:    Types are great. Lifting them into some sort of applicative functor makes them even better. This package is an homage to our favorite applicatives, and to the semigroups with which they are instrinsically connected.+category:       ACME+homepage:       https://github.com/chris-martin/acme-functors+bug-reports:    https://github.com/chris-martin/acme-functors/issues+author:         Chris Martin+maintainer:     ch.martin@gmail.com+copyright:      2017 Chris Martin+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/chris-martin/acme-functors++library+  hs-source-dirs:+      src+  build-depends:+      base >= 1 && < 5328762+  exposed-modules:+      Acme.Functors+      Acme.Functors.Classes+  other-modules:+      Paths_acme_functors+  default-language: Haskell2010
+ src/Acme/Functors.hs view
@@ -0,0 +1,530 @@+-- | 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.++-}
+ src/Acme/Functors/Classes.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Acme.Functors.Classes+    ( Applicative (..)+    , Monad       (..)+    , Eq          (..)+    , Functor     (..)+    , Monoid      (..)+    , Semigroup   (..)+    , Show        (..)+    ) where++import Control.Applicative ( Applicative (..) )+import Control.Monad       ( Monad       (..) )+import Data.Eq             ( Eq          (..) )+import Data.Functor        ( Functor     (..) )+import Data.Semigroup      ( Semigroup   (..) )+import Prelude             ( Show        (..) )++class Semigroup a => Monoid a where++    mempty :: a