Copyright | (c) 2016 Stephen Diehl (c) 20016-2018 Serokell (c) 2018 Kowainik |
---|---|
License | MIT |
Maintainer | Kowainik <xrom.xkov@gmail.com> |
Safe Haskell | Safe |
Language | Haskell2010 |
Synopsis
- class Bifunctor (p :: Type -> Type -> Type) where
- class Functor (f :: Type -> Type) where
- void :: Functor f => f a -> f ()
- ($>) :: Functor f => f a -> b -> f b
- (<$>) :: Functor f => (a -> b) -> f a -> f b
- newtype Compose (f :: k -> Type) (g :: k1 -> k) (a :: k1) :: forall k k1. (k -> Type) -> (k1 -> k) -> k1 -> Type = Compose {
- getCompose :: f (g a)
- newtype Identity a = Identity {
- runIdentity :: a
- comparisonEquivalence :: Comparison a -> Equivalence a
- defaultEquivalence :: Eq a => Equivalence a
- defaultComparison :: Ord a => Comparison a
- (>$$<) :: Contravariant f => f b -> (a -> b) -> f a
- (>$<) :: Contravariant f => (a -> b) -> f b -> f a
- ($<) :: Contravariant f => f b -> b -> f a
- phantom :: (Functor f, Contravariant f) => f a -> f b
- class Contravariant (f :: Type -> Type) where
- newtype Predicate a = Predicate {
- getPredicate :: a -> Bool
- newtype Comparison a = Comparison {
- getComparison :: a -> a -> Ordering
- newtype Equivalence a = Equivalence {
- getEquivalence :: a -> a -> Bool
- newtype Op a b = Op {
- getOp :: b -> a
Documentation
class Bifunctor (p :: Type -> Type -> Type) where #
A bifunctor is a type constructor that takes
two type arguments and is a functor in both arguments. That
is, unlike with Functor
, a type constructor such as Either
does not need to be partially applied for a Bifunctor
instance, and the methods in this class permit mapping
functions over the Left
value or the Right
value,
or both at the same time.
Formally, the class Bifunctor
represents a bifunctor
from Hask
-> Hask
.
Intuitively it is a bifunctor where both the first and second arguments are covariant.
You can define a Bifunctor
by either defining bimap
or by
defining both first
and second
.
If you supply bimap
, you should ensure that:
bimap
id
id
≡id
If you supply first
and second
, ensure:
first
id
≡id
second
id
≡id
If you supply both, you should also ensure:
bimap
f g ≡first
f.
second
g
These ensure by parametricity:
bimap
(f.
g) (h.
i) ≡bimap
f h.
bimap
g ifirst
(f.
g) ≡first
f.
first
gsecond
(f.
g) ≡second
f.
second
g
Since: base-4.8.0.0
bimap :: (a -> b) -> (c -> d) -> p a c -> p b d #
Map over both arguments at the same time.
bimap
f g ≡first
f.
second
g
Examples
>>>
bimap toUpper (+1) ('j', 3)
('J',4)
>>>
bimap toUpper (+1) (Left 'j')
Left 'J'
>>>
bimap toUpper (+1) (Right 3)
Right 4
Instances
Bifunctor Either | Since: base-4.8.0.0 |
Bifunctor (,) | Since: base-4.8.0.0 |
Bifunctor Arg | Since: base-4.9.0.0 |
Bifunctor Validation Source # | |
Defined in Relude.Extra.Validation bimap :: (a -> b) -> (c -> d) -> Validation a c -> Validation b d # first :: (a -> b) -> Validation a c -> Validation b c # second :: (b -> c) -> Validation a b -> Validation a c # | |
Bifunctor ((,,) x1) | Since: base-4.8.0.0 |
Bifunctor (Const :: Type -> Type -> Type) | Since: base-4.8.0.0 |
Bifunctor (K1 i :: Type -> Type -> Type) | Since: base-4.9.0.0 |
Bifunctor ((,,,) x1 x2) | Since: base-4.8.0.0 |
Bifunctor ((,,,,) x1 x2 x3) | Since: base-4.8.0.0 |
Bifunctor ((,,,,,) x1 x2 x3 x4) | Since: base-4.8.0.0 |
Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) | Since: base-4.8.0.0 |
class Functor (f :: Type -> Type) where #
The Functor
class is used for types that can be mapped over.
Instances of Functor
should satisfy the following laws:
fmap id == id fmap (f . g) == fmap f . fmap g
The instances of Functor
for lists, Maybe
and IO
satisfy these laws.
Instances
Functor [] | Since: base-2.1 |
Functor Maybe | Since: base-2.1 |
Functor IO | Since: base-2.1 |
Functor Par1 | Since: base-4.9.0.0 |
Functor Complex | Since: base-4.9.0.0 |
Functor Min | Since: base-4.9.0.0 |
Functor Max | Since: base-4.9.0.0 |
Functor First | Since: base-4.9.0.0 |
Functor Last | Since: base-4.9.0.0 |
Functor Option | Since: base-4.9.0.0 |
Functor ZipList | Since: base-2.1 |
Functor Identity | Since: base-4.8.0.0 |
Functor Handler | Since: base-4.6.0.0 |
Functor STM | Since: base-4.3.0.0 |
Functor First | Since: base-4.8.0.0 |
Functor Last | Since: base-4.8.0.0 |
Functor Dual | Since: base-4.8.0.0 |
Functor Sum | Since: base-4.8.0.0 |
Functor Product | Since: base-4.8.0.0 |
Functor Down | Since: base-4.11.0.0 |
Functor ReadPrec | Since: base-2.1 |
Functor ReadP | Since: base-2.1 |
Functor NonEmpty | Since: base-4.9.0.0 |
Functor Put | |
Defined in Data.ByteString.Builder.Internal | |
Functor IntMap | |
Functor Tree | |
Functor Seq | |
Functor FingerTree | |
Defined in Data.Sequence.Internal fmap :: (a -> b) -> FingerTree a -> FingerTree b # (<$) :: a -> FingerTree b -> FingerTree a # | |
Functor Digit | |
Functor Node | |
Functor Elem | |
Functor ViewL | |
Functor ViewR | |
Functor P | Since: base-4.8.0.0 |
Defined in Text.ParserCombinators.ReadP | |
Functor (Either a) | Since: base-3.0 |
Functor (V1 :: Type -> Type) | Since: base-4.9.0.0 |
Functor (U1 :: Type -> Type) | Since: base-4.9.0.0 |
Functor ((,) a) | Since: base-2.1 |
Functor (Array i) | Since: base-2.1 |
Functor (Arg a) | Since: base-4.9.0.0 |
Monad m => Functor (WrappedMonad m) | Since: base-2.1 |
Defined in Control.Applicative fmap :: (a -> b) -> WrappedMonad m a -> WrappedMonad m b # (<$) :: a -> WrappedMonad m b -> WrappedMonad m a # | |
Arrow a => Functor (ArrowMonad a) | Since: base-4.6.0.0 |
Defined in Control.Arrow fmap :: (a0 -> b) -> ArrowMonad a a0 -> ArrowMonad a b # (<$) :: a0 -> ArrowMonad a b -> ArrowMonad a a0 # | |
Functor (Proxy :: Type -> Type) | Since: base-4.7.0.0 |
Functor (Map k) | |
Functor m => Functor (MaybeT m) | |
Functor (HashMap k) | |
Functor (Validation e) Source # | |
Defined in Relude.Extra.Validation fmap :: (a -> b) -> Validation e a -> Validation e b # (<$) :: a -> Validation e b -> Validation e a # | |
Functor f => Functor (Rec1 f) | Since: base-4.9.0.0 |
Functor (URec Char :: Type -> Type) | Since: base-4.9.0.0 |
Functor (URec Double :: Type -> Type) | Since: base-4.9.0.0 |
Functor (URec Float :: Type -> Type) | Since: base-4.9.0.0 |
Functor (URec Int :: Type -> Type) | Since: base-4.9.0.0 |
Functor (URec Word :: Type -> Type) | Since: base-4.9.0.0 |
Functor (URec (Ptr ()) :: Type -> Type) | Since: base-4.9.0.0 |
Arrow a => Functor (WrappedArrow a b) | Since: base-2.1 |
Defined in Control.Applicative fmap :: (a0 -> b0) -> WrappedArrow a b a0 -> WrappedArrow a b b0 # (<$) :: a0 -> WrappedArrow a b b0 -> WrappedArrow a b a0 # | |
Functor (Const m :: Type -> Type) | Since: base-2.1 |
Functor f => Functor (Ap f) | Since: base-4.12.0.0 |
Functor f => Functor (Alt f) | Since: base-4.8.0.0 |
(Applicative f, Monad f) => Functor (WhenMissing f x) | Since: containers-0.5.9 |
Defined in Data.IntMap.Internal fmap :: (a -> b) -> WhenMissing f x a -> WhenMissing f x b # (<$) :: a -> WhenMissing f x b -> WhenMissing f x a # | |
Functor m => Functor (IdentityT m) | |
Functor m => Functor (ErrorT e m) | |
Functor m => Functor (ExceptT e m) | |
Functor m => Functor (StateT s m) | |
Functor ((->) r :: Type -> Type) | Since: base-2.1 |
Functor (K1 i c :: Type -> Type) | Since: base-4.9.0.0 |
(Functor f, Functor g) => Functor (f :+: g) | Since: base-4.9.0.0 |
(Functor f, Functor g) => Functor (f :*: g) | Since: base-4.9.0.0 |
(Functor f, Functor g) => Functor (Product f g) | Since: base-4.9.0.0 |
(Functor f, Functor g) => Functor (Sum f g) | Since: base-4.9.0.0 |
Functor f => Functor (WhenMatched f x y) | Since: containers-0.5.9 |
Defined in Data.IntMap.Internal fmap :: (a -> b) -> WhenMatched f x y a -> WhenMatched f x y b # (<$) :: a -> WhenMatched f x y b -> WhenMatched f x y a # | |
(Applicative f, Monad f) => Functor (WhenMissing f k x) | Since: containers-0.5.9 |
Defined in Data.Map.Internal fmap :: (a -> b) -> WhenMissing f k x a -> WhenMissing f k x b # (<$) :: a -> WhenMissing f k x b -> WhenMissing f k x a # | |
Functor m => Functor (ReaderT r m) | |
Functor f => Functor (M1 i c f) | Since: base-4.9.0.0 |
(Functor f, Functor g) => Functor (f :.: g) | Since: base-4.9.0.0 |
(Functor f, Functor g) => Functor (Compose f g) | Since: base-4.9.0.0 |
Functor f => Functor (WhenMatched f k x y) | Since: containers-0.5.9 |
Defined in Data.Map.Internal fmap :: (a -> b) -> WhenMatched f k x y a -> WhenMatched f k x y b # (<$) :: a -> WhenMatched f k x y b -> WhenMatched f k x y a # |
void :: Functor f => f a -> f () #
discards or ignores the result of evaluation, such
as the return value of an void
valueIO
action.
Examples
Replace the contents of a
with unit:Maybe
Int
>>>
void Nothing
Nothing>>>
void (Just 3)
Just ()
Replace the contents of an
with unit,
resulting in an Either
Int
Int
:Either
Int
'()'
>>>
void (Left 8675309)
Left 8675309>>>
void (Right 8675309)
Right ()
Replace every element of a list with unit:
>>>
void [1,2,3]
[(),(),()]
Replace the second element of a pair with unit:
>>>
void (1,2)
(1,())
Discard the result of an IO
action:
>>>
mapM print [1,2]
1 2 [(),()]>>>
void $ mapM print [1,2]
1 2
($>) :: Functor f => f a -> b -> f b infixl 4 #
Flipped version of <$
.
Examples
Replace the contents of a
with a constant Maybe
Int
String
:
>>>
Nothing $> "foo"
Nothing>>>
Just 90210 $> "foo"
Just "foo"
Replace the contents of an
with a constant
Either
Int
Int
String
, resulting in an
:Either
Int
String
>>>
Left 8675309 $> "foo"
Left 8675309>>>
Right 8675309 $> "foo"
Right "foo"
Replace each element of a list with a constant String
:
>>>
[1,2,3] $> "foo"
["foo","foo","foo"]
Replace the second element of a pair with a constant String
:
>>>
(1,2) $> "foo"
(1,"foo")
Since: base-4.7.0.0
(<$>) :: Functor f => (a -> b) -> f a -> f b infixl 4 #
An infix synonym for fmap
.
The name of this operator is an allusion to $
.
Note the similarities between their types:
($) :: (a -> b) -> a -> b (<$>) :: Functor f => (a -> b) -> f a -> f b
Whereas $
is function application, <$>
is function
application lifted over a Functor
.
Examples
Convert from a
to a Maybe
Int
using Maybe
String
show
:
>>>
show <$> Nothing
Nothing>>>
show <$> Just 3
Just "3"
Convert from an
to an Either
Int
Int
Either
Int
String
using show
:
>>>
show <$> Left 17
Left 17>>>
show <$> Right 17
Right "17"
Double each element of a list:
>>>
(*2) <$> [1,2,3]
[2,4,6]
Apply even
to the second element of a pair:
>>>
even <$> (2,2)
(2,True)
newtype Compose (f :: k -> Type) (g :: k1 -> k) (a :: k1) :: forall k k1. (k -> Type) -> (k1 -> k) -> k1 -> Type infixr 9 #
Right-to-left composition of functors. The composition of applicative functors is always applicative, but the composition of monads is not always a monad.
Compose infixr 9 | |
|
Instances
Functor f => Generic1 (Compose f g :: k -> Type) | |
(Functor f, Functor g) => Functor (Compose f g) | Since: base-4.9.0.0 |
(Applicative f, Applicative g) => Applicative (Compose f g) | Since: base-4.9.0.0 |
Defined in Data.Functor.Compose | |
(Foldable f, Foldable g) => Foldable (Compose f g) | Since: base-4.9.0.0 |
Defined in Data.Functor.Compose fold :: Monoid m => Compose f g m -> m # foldMap :: Monoid m => (a -> m) -> Compose f g a -> m # foldr :: (a -> b -> b) -> b -> Compose f g a -> b # foldr' :: (a -> b -> b) -> b -> Compose f g a -> b # foldl :: (b -> a -> b) -> b -> Compose f g a -> b # foldl' :: (b -> a -> b) -> b -> Compose f g a -> b # foldr1 :: (a -> a -> a) -> Compose f g a -> a # foldl1 :: (a -> a -> a) -> Compose f g a -> a # toList :: Compose f g a -> [a] # null :: Compose f g a -> Bool # length :: Compose f g a -> Int # elem :: Eq a => a -> Compose f g a -> Bool # maximum :: Ord a => Compose f g a -> a # minimum :: Ord a => Compose f g a -> a # | |
(Traversable f, Traversable g) => Traversable (Compose f g) | Since: base-4.9.0.0 |
Defined in Data.Functor.Compose | |
(Functor f, Contravariant g) => Contravariant (Compose f g) | |
(Eq1 f, Eq1 g) => Eq1 (Compose f g) | Since: base-4.9.0.0 |
(Ord1 f, Ord1 g) => Ord1 (Compose f g) | Since: base-4.9.0.0 |
Defined in Data.Functor.Compose | |
(Read1 f, Read1 g) => Read1 (Compose f g) | Since: base-4.9.0.0 |
Defined in Data.Functor.Compose liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Compose f g a) # liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [Compose f g a] # liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Compose f g a) # liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [Compose f g a] # | |
(Show1 f, Show1 g) => Show1 (Compose f g) | Since: base-4.9.0.0 |
(Alternative f, Applicative g) => Alternative (Compose f g) | Since: base-4.9.0.0 |
(NFData1 f, NFData1 g) => NFData1 (Compose f g) | Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq | |
(Hashable1 f, Hashable1 g) => Hashable1 (Compose f g) | |
Defined in Data.Hashable.Class | |
(Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) Source # | |
Defined in Relude.Extra.Foldable1 | |
(Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) | Since: base-4.9.0.0 |
(Typeable a, Typeable f, Typeable g, Typeable k1, Typeable k2, Data (f (g a))) => Data (Compose f g a) | Since: base-4.9.0.0 |
Defined in Data.Functor.Compose gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g0. g0 -> c g0) -> Compose f g a -> c (Compose f g a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Compose f g a) # toConstr :: Compose f g a -> Constr # dataTypeOf :: Compose f g a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Compose f g a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Compose f g a)) # gmapT :: (forall b. Data b => b -> b) -> Compose f g a -> Compose f g a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Compose f g a -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Compose f g a -> r # gmapQ :: (forall d. Data d => d -> u) -> Compose f g a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Compose f g a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Compose f g a -> m (Compose f g a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Compose f g a -> m (Compose f g a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Compose f g a -> m (Compose f g a) # | |
(Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) | Since: base-4.9.0.0 |
Defined in Data.Functor.Compose compare :: Compose f g a -> Compose f g a -> Ordering # (<) :: Compose f g a -> Compose f g a -> Bool # (<=) :: Compose f g a -> Compose f g a -> Bool # (>) :: Compose f g a -> Compose f g a -> Bool # (>=) :: Compose f g a -> Compose f g a -> Bool # | |
(Read1 f, Read1 g, Read a) => Read (Compose f g a) | Since: base-4.9.0.0 |
(Show1 f, Show1 g, Show a) => Show (Compose f g a) | Since: base-4.9.0.0 |
Generic (Compose f g a) | |
(NFData1 f, NFData1 g, NFData a) => NFData (Compose f g a) | Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq | |
(Hashable1 f, Hashable1 g, Hashable a) => Hashable (Compose f g a) | In general, |
Defined in Data.Hashable.Class | |
type Rep1 (Compose f g :: k -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Compose | |
type Rep (Compose f g a) | Since: base-4.9.0.0 |
Defined in Data.Functor.Compose |
Identity functor and monad. (a non-strict monad)
Since: base-4.8.0.0
Identity | |
|
Instances
comparisonEquivalence :: Comparison a -> Equivalence a #
defaultEquivalence :: Eq a => Equivalence a #
defaultComparison :: Ord a => Comparison a #
Compare using compare
.
(>$$<) :: Contravariant f => f b -> (a -> b) -> f a infixl 4 #
This is an infix version of contramap
with the arguments flipped.
(>$<) :: Contravariant f => (a -> b) -> f b -> f a infixl 4 #
This is an infix alias for contramap
.
($<) :: Contravariant f => f b -> b -> f a infixl 4 #
This is >$
with its arguments flipped.
phantom :: (Functor f, Contravariant f) => f a -> f b #
If f
is both Functor
and Contravariant
then by the time you factor
in the laws of each of those classes, it can't actually use its argument in
any meaningful capacity.
This method is surprisingly useful. Where both instances exist and are lawful we have the following laws:
fmap
f ≡phantom
contramap
f ≡phantom
class Contravariant (f :: Type -> Type) where #
The class of contravariant functors.
Whereas in Haskell, one can think of a Functor
as containing or producing
values, a contravariant functor is a functor that can be thought of as
consuming values.
As an example, consider the type of predicate functions a -> Bool
. One
such predicate might be negative x = x < 0
, which
classifies integers as to whether they are negative. However, given this
predicate, we can re-use it in other situations, providing we have a way to
map values to integers. For instance, we can use the negative
predicate
on a person's bank balance to work out if they are currently overdrawn:
newtype Predicate a = Predicate { getPredicate :: a -> Bool } instance Contravariant Predicate where contramap f (Predicate p) = Predicate (p . f) | `- First, map the input... `----- then apply the predicate. overdrawn :: Predicate Person overdrawn = contramap personBankBalance negative
Any instance should be subject to the following laws:
contramap id = id contramap f . contramap g = contramap (g . f)
Note, that the second law follows from the free theorem of the type of
contramap
and the first law, so you need only check that the former
condition holds.
Instances
Predicate | |
|
Instances
Contravariant Predicate | A |
Semigroup (Predicate a) | |
Monoid (Predicate a) | |
newtype Comparison a #
Defines a total ordering on a type as per compare
.
This condition is not checked by the types. You must ensure that the supplied values are valid total orderings yourself.
Comparison | |
|
Instances
Contravariant Comparison | A |
Defined in Data.Functor.Contravariant contramap :: (a -> b) -> Comparison b -> Comparison a # (>$) :: b -> Comparison b -> Comparison a # | |
Semigroup (Comparison a) | |
Defined in Data.Functor.Contravariant (<>) :: Comparison a -> Comparison a -> Comparison a # sconcat :: NonEmpty (Comparison a) -> Comparison a # stimes :: Integral b => b -> Comparison a -> Comparison a # | |
Monoid (Comparison a) | |
Defined in Data.Functor.Contravariant mempty :: Comparison a # mappend :: Comparison a -> Comparison a -> Comparison a # mconcat :: [Comparison a] -> Comparison a # |
newtype Equivalence a #
This data type represents an equivalence relation.
Equivalence relations are expected to satisfy three laws:
Reflexivity:
getEquivalence
f a a = True
Symmetry:
getEquivalence
f a b =getEquivalence
f b a
Transitivity:
If
and getEquivalence
f a b
are both getEquivalence
f b cTrue
then so is
.getEquivalence
f a c
The types alone do not enforce these laws, so you'll have to check them yourself.
Equivalence | |
|
Instances
Contravariant Equivalence | Equivalence relations are |
Defined in Data.Functor.Contravariant contramap :: (a -> b) -> Equivalence b -> Equivalence a # (>$) :: b -> Equivalence b -> Equivalence a # | |
Semigroup (Equivalence a) | |
Defined in Data.Functor.Contravariant (<>) :: Equivalence a -> Equivalence a -> Equivalence a # sconcat :: NonEmpty (Equivalence a) -> Equivalence a # stimes :: Integral b => b -> Equivalence a -> Equivalence a # | |
Monoid (Equivalence a) | |
Defined in Data.Functor.Contravariant mempty :: Equivalence a # mappend :: Equivalence a -> Equivalence a -> Equivalence a # mconcat :: [Equivalence a] -> Equivalence a # |
Dual function arrows.
Instances
Contravariant (Op a) | |
Category Op | |
Floating a => Floating (Op a b) | |
Fractional a => Fractional (Op a b) | |
Num a => Num (Op a b) | |
Semigroup a => Semigroup (Op a b) | |
Monoid a => Monoid (Op a b) | |