n-ary-functor-0.1.0.0: An n-ary version of Functor

Safe HaskellSafe
LanguageHaskell2010

NAryFunctor

Contents

Synopsis

Documentation

class NFunctor (f :: k) where Source #

A generalization of Functor, Bifunctor, Trifunctor, etc.

Example usage:

>>> nmap <#> (+1) $ Identity (0::Int)
Identity 1
>>> nmap <#> (+1) <#> (+2) $ (0::Int, 0::Int)
(1,2)
>>> nmap <#> (+1) <#> (+2) <#> (+3) $ (0::Int, 0::Int, 0::Int)
(1,2,3)

Laws:

nmap <#> id <#> ... <#> id = id
(nmap <#> f1 <#> ... <#> fN) . (nmap <#> g1 <#> ... <#> gN) = nmap <#> (f1 . g1) <#> ... <#> (fN . gN)

Example instance:

instance NFunctor (,,) where
  nmap = NMap1 $ \f1
      -> NMap1 $ \f2
      -> NMap1 $ \f3
      -> \(x1,x2,x3)
      -> (f1 x1, f2 x2, f3 x3)

Minimal complete definition

nmap

Methods

nmap :: NMap k f f Source #

Instances

NFunctor * () Source #

For kind *, nmap must be the identity function. If Bifunctor and Functor correspond to binary and unary functors, this corresponds to a "nullary" functor.

>>> nmap ()
()

Methods

nmap :: NMap () f f Source #

NFunctor (* -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *) (,,,,,,,,,,,,,,) Source # 
NFunctor (* -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *) (,,,,,,,,,,,,,) Source # 
NFunctor (* -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *) (,,,,,,,,,,,,) Source # 
NFunctor (* -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *) (,,,,,,,,,,,) Source # 
NFunctor (* -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *) (,,,,,,,,,,) Source # 

Methods

nmap :: NMap (,,,,,,,,,,) f f Source #

NFunctor (* -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *) (,,,,,,,,,) Source # 

Methods

nmap :: NMap (,,,,,,,,,) f f Source #

NFunctor (* -> * -> * -> * -> * -> * -> * -> * -> * -> *) (,,,,,,,,) Source # 

Methods

nmap :: NMap (,,,,,,,,) f f Source #

NFunctor (* -> * -> * -> * -> * -> * -> * -> * -> *) (,,,,,,,) Source # 

Methods

nmap :: NMap (,,,,,,,) f f Source #

NFunctor (* -> * -> * -> * -> * -> * -> * -> *) (,,,,,,) Source # 

Methods

nmap :: NMap (,,,,,,) f f Source #

NFunctor (* -> * -> * -> * -> * -> * -> *) (,,,,,) Source # 

Methods

nmap :: NMap (,,,,,) f f Source #

NFunctor (* -> * -> * -> * -> * -> *) (,,,,) Source # 

Methods

nmap :: NMap (,,,,) f f Source #

NFunctor (* -> * -> * -> * -> *) (,,,) Source # 

Methods

nmap :: NMap (,,,) f f Source #

NFunctor (* -> * -> * -> *) (,,) Source # 

Methods

nmap :: NMap (,,) f f Source #

NFunctor (* -> * -> *) Either Source #

For kind * -> * -> * (Bifunctor), nmap must be NMap1 $ f1 -> NMap1 $ f2 -> bimap f1 f2.

>>> nmap <#> (+1) <#> (+2) $ Left (0::Int)
Left 1

Methods

nmap :: NMap Either f f Source #

NFunctor (* -> * -> *) (,) Source # 

Methods

nmap :: NMap (,) f f Source #

NFunctor (* -> *) Identity Source # 

Methods

nmap :: NMap Identity f f Source #

NFunctor (* -> *) (Either a) Source #

For kind * -> * (Functor), nmap must be NMap1 fmap.

>>> nmap <#> (+1) $ Right (0::Int)
Right 1

Methods

nmap :: NMap (Either a) f f Source #

Internals

newtype NMap1 k (f :: Type -> k) (f' :: Type -> k) Source #

Types like Either which have both a Functor and a Bifunctor instance can have more than one NFunctor instance. Those instances all define the same method, nmap, but they return a value of a different type, which is how the correct NFunctor instance is picked:

nmap :: NMap1 Type (Either a) (Either a)    -- Functor
nmap :: NMap1 (Type -> Type) Either Either  -- Bifunctor

This NMap1 is unwrapped by using <#> to pass in the next input function. In the case of NMap1 (Type -> Type), the result after passing this input function is another NMap1, which needs to be unwrapped using a second <#>. The end result is that the Functor behaviour is obtained by using a single <#>, and the Bifunctor behaviour is obtained by using two.

>>> nmap <#> (+1) $ Right (0::Int)
Right 1
>>> nmap <#> (+1) <#> (+2) $ Left (0::Int)
Left 1

Constructors

NMap1 

Fields

  • (<#>) :: forall a b. (a -> b) -> NMap k (f a) (f' b)
     

type family NMap k = (r :: k -> k -> Type) | r -> k where ... Source #

Equations

NMap Type = (->) 
NMap (Type -> k) = NMap1 k