generics-sop-0.3.1.0: Generic Programming using True Sums of Products

Safe HaskellNone
LanguageHaskell2010

Generics.SOP

Contents

Description

Main module of generics-sop

In most cases, you will probably want to import just this module, and possibly Generics.SOP.TH if you want to use Template Haskell to generate Generic instances for you.

Generic programming with sums of products

You need this library if you want to define your own generic functions in the sum-of-products SOP style. Generic programming in the SOP style follows the following idea:

  1. A large class of datatypes can be viewed in a uniform, structured way: the choice between constructors is represented using an n-ary sum (called NS), and the arguments of each constructor are represented using an n-ary product (called NP).
  2. The library captures the notion of a datatype being representable in the following way. There is a class Generic, which for a given datatype A, associates the isomorphic SOP representation with the original type under the name Rep A. The class also provides functions from and to that convert between A and Rep A and witness the isomorphism.
  3. Since all Rep types are sums of products, you can define functions over them by performing induction on the structure, of by using predefined combinators that the library provides. Such functions then work for all Rep types.
  4. By combining the conversion functions from and to with the function that works on Rep types, we obtain a function that works on all types that are in the Generic class.
  5. Most types can very easily be made an instance of Generic. For example, if the datatype can be represented using GHC's built-in approach to generic programming and has an instance for the Generic class from module GHC.Generics, then an instance of the SOP Generic can automatically be derived. There is also Template Haskell code in Generics.SOP.TH that allows to auto-generate an instance of Generic for most types.

Example

Instantiating a datatype for use with SOP generics

Let's assume we have the datatypes:

data A   = C Bool | D A Int | E (B ())
data B a = F | G a Char Bool

To create Generic instances for A and B via GHC.Generics, we say

{-# LANGUAGE DeriveGeneric #-}

import qualified GHC.Generics as GHC
import Generics.SOP

data A   = C Bool | D A Int | E (B ())
  deriving (Show, GHC.Generic)
data B a = F | G a Char Bool
  deriving (Show, GHC.Generic)

instance Generic A     -- empty
instance Generic (B a) -- empty

Now we can convert between A and Rep A (and between B and Rep B). For example,

>>> from (D (C True) 3) :: Rep A
SOP (S (Z (I (C True) :* I 3 :* Nil)))
>>> to it :: A
D (C True) 3

Note that the transformation is shallow: In D (C True) 3, the inner value C True of type A is not affected by the transformation.

For more details about Rep A, have a look at the Generics.SOP.Universe module.

Defining a generic function

As an example of a generic function, let us define a generic version of rnf from the deepseq package.

The type of rnf is

NFData a => a -> ()

and the idea is that for a term x of type a in the NFData class, rnf x forces complete evaluation of x (i.e., evaluation to normal form), and returns ().

We call the generic version of this function grnf. A direct definition in SOP style, making use of structural recursion on the sums and products, looks as follows:

grnf :: (Generic a, All2 NFData (Code a)) => a -> ()
grnf x = grnfS (from x)

grnfS :: (All2 NFData xss) => SOP I xss -> ()
grnfS (SOP (Z xs))  = grnfP xs
grnfS (SOP (S xss)) = grnfS (SOP xss)

grnfP :: (All NFData xs) => NP I xs -> ()
grnfP Nil         = ()
grnfP (I x :* xs) = x `deepseq` (grnfP xs)

The grnf function performs the conversion between a and Rep a by applying from and then applies grnfS. The type of grnf indicates that a must be in the Generic class so that we can apply from, and that all the components of a (i.e., all the types that occur as constructor arguments) must be in the NFData class (All2).

The function grnfS traverses the outer sum structure of the sum of products (note that Rep a = SOP I (Code a)). It encodes which constructor was used to construct the original argument of type a. Once we've found the constructor in question (Z), we traverse the arguments of that constructor using grnfP.

The function grnfP traverses the product structure of the constructor arguments. Each argument is evaluated using the deepseq function from the NFData class. This requires that all components of the product must be in the NFData class (All) and triggers the corresponding constraints on the other functions. Once the end of the product is reached (Nil), we return ().

Defining a generic function using combinators

In many cases, generic functions can be written in a much more concise way by avoiding the explicit structural recursion and resorting to the powerful combinators provided by this library instead.

For example, the grnf function can also be defined as a one-liner as follows:

grnf :: (Generic a, All2 NFData (Code a)) => a -> ()
grnf = rnf . hcollapse . hcliftA (Proxy :: Proxy NFData) (\ (I x) -> K (rnf x)) . from

The following interaction should provide an idea of the individual transformation steps:

>>> let x = G 2.5 'A' False :: B Double
>>> from x
SOP (S (Z (I 2.5 :* I 'A' :* I False :* Nil)))
>>> hcliftA (Proxy :: Proxy NFData) (\ (I x) -> K (rnf x)) it
SOP (S (Z (K () :* K () :* K () :* Nil)))
>>> hcollapse it
[(),(),()]
>>> rnf it
()

The from call converts into the structural representation. Via hcliftA, we apply rnf to all the components. The result is a sum of products of the same shape, but the components are no longer heterogeneous (I), but homogeneous (K ()). A homogeneous structure can be collapsed (hcollapse) into a normal Haskell list. Finally, rnf actually forces evaluation of this list (and thereby actually drives the evaluation of all the previous steps) and produces the final result.

Using a generic function

We can directly invoke grnf on any type that is an instance of class Generic.

>>> grnf (G 2.5 'A' False)
()
>>> grnf (G 2.5 undefined False)
*** Exception: Prelude.undefined

Note that the type of grnf requires that all components of the type are in the NFData class. For a recursive datatype such as B, this means that we have to make A (and in this case, also B) an instance of NFData in order to be able to use the grnf function. But we can use grnf to supply the instance definitions:

instance NFData A where rnf = grnf
instance NFData a => NFData (B a) where rnf = grnf

More examples

The best way to learn about how to define generic functions in the SOP style is to look at a few simple examples. Examples are provided by the following packages:

The generic functions in these packages use a wide variety of the combinators that are offered by the library.

Paper

A detailed description of the ideas behind this library is provided by the paper:

Synopsis

Codes and interpretations

class All SListI (Code a) => Generic a where Source #

The class of representable datatypes.

The SOP approach to generic programming is based on viewing datatypes as a representation (Rep) built from the sum of products of its components. The components of are datatype are specified using the Code type family.

The isomorphism between the original Haskell datatype and its representation is witnessed by the methods of this class, from and to. So for instances of this class, the following laws should (in general) hold:

to . from === id :: a -> a
from . to === id :: Rep a -> Rep a

You typically don't define instances of this class by hand, but rather derive the class instance automatically.

Option 1: Derive via the built-in GHC-generics. For this, you need to use the DeriveGeneric extension to first derive an instance of the Generic class from module GHC.Generics. With this, you can then give an empty instance for Generic, and the default definitions will just work. The pattern looks as follows:

import qualified GHC.Generics as GHC
import Generics.SOP

...

data T = ... deriving (GHC.Generic, ...)

instance Generic T -- empty
instance HasDatatypeInfo T -- empty, if you want/need metadata

Option 2: Derive via Template Haskell. For this, you need to enable the TemplateHaskell extension. You can then use deriveGeneric from module Generics.SOP.TH to have the instance generated for you. The pattern looks as follows:

import Generics.SOP
import Generics.SOP.TH

...

data T = ...

deriveGeneric ''T -- derives HasDatatypeInfo as well

Tradeoffs: Whether to use Option 1 or 2 is mainly a matter of personal taste. The version based on Template Haskell probably has less run-time overhead.

Non-standard instances: It is possible to give Generic instances manually that deviate from the standard scheme, as long as at least

to . from === id :: a -> a

still holds.

Associated Types

type Code a :: [[*]] Source #

The code of a datatype.

This is a list of lists of its components. The outer list contains one element per constructor. The inner list contains one element per constructor argument (field).

Example: The datatype

data Tree = Leaf Int | Node Tree Tree

is supposed to have the following code:

type instance Code (Tree a) =
  '[ '[ Int ]
   , '[ Tree, Tree ]
   ]

Methods

from :: a -> Rep a Source #

Converts from a value to its structural representation.

from :: (GFrom a, Generic a, Rep a ~ SOP I (GCode a)) => a -> Rep a Source #

Converts from a value to its structural representation.

to :: Rep a -> a Source #

Converts from a structural representation back to the original value.

to :: (GTo a, Generic a, Rep a ~ SOP I (GCode a)) => Rep a -> a Source #

Converts from a structural representation back to the original value.

type Rep a = SOP I (Code a) Source #

The (generic) representation of a datatype.

A datatype is isomorphic to the sum-of-products of its code. The isomorphism is witnessed by from and to from the Generic class.

type IsProductType a xs = (Generic a, Code a ~ '[xs]) Source #

Constraint that captures that a datatype is a product type, i.e., a type with a single constructor.

It also gives access to the code for the arguments of that constructor.

Since: 0.3.1.0

type IsEnumType a = (Generic a, All ((~) '[]) (Code a)) Source #

Constraint that captures that a datatype is an enumeration type, i.e., none of the constructors have any arguments.

Since: 0.3.1.0

type IsWrappedType a x = (Generic a, Code a ~ '['[x]]) Source #

Constraint that captures that a datatype is a single-constructor, single-field datatype. This always holds for newtype-defined types, but it can also be true for data-defined types.

The constraint also gives access to the type that is wrapped.

Since: 0.3.1.0

type IsNewtype a x = (IsWrappedType a x, Coercible a x) Source #

Constraint that captures that a datatype is a newtype. This makes use of the fact that newtypes are always coercible to the type they wrap, whereas datatypes are not.

Since: 0.3.1.0

n-ary datatypes

data NP :: (k -> *) -> [k] -> * where Source #

An n-ary product.

The product is parameterized by a type constructor f and indexed by a type-level list xs. The length of the list determines the number of elements in the product, and if the i-th element of the list is of type x, then the i-th element of the product is of type f x.

The constructor names are chosen to resemble the names of the list constructors.

Two common instantiations of f are the identity functor I and the constant functor K. For I, the product becomes a heterogeneous list, where the type-level list describes the types of its components. For K a, the product becomes a homogeneous list, where the contents of the type-level list are ignored, but its length still specifies the number of elements.

In the context of the SOP approach to generic programming, an n-ary product describes the structure of the arguments of a single data constructor.

Examples:

I 'x'    :* I True  :* Nil  ::  NP I       '[ Char, Bool ]
K 0      :* K 1     :* Nil  ::  NP (K Int) '[ Char, Bool ]
Just 'x' :* Nothing :* Nil  ::  NP Maybe   '[ Char, Bool ]

Constructors

Nil :: NP f '[] 
(:*) :: f x -> NP f xs -> NP f (x ': xs) infixr 5 

Instances

HSequence [k] k (NP k) Source # 

Methods

hsequence' :: (SListIN (NP k) k h xs, Applicative f) => h ((k :.: *) f g) xs -> f (h g xs) Source #

HCollapse [k] k (NP k) Source # 

Methods

hcollapse :: SListIN (NP k) k h xs => h (K k a) xs -> CollapseTo (NP k) k h a Source #

HAp [k] k (NP k) Source # 

Methods

hap :: Prod (NP k) k h ((k -.-> f) g) xs -> h f xs -> h g xs Source #

HPure [k] k (NP k) Source # 

Methods

hpure :: SListIN (NP k) k h xs => (forall a. f a) -> h f xs Source #

hcpure :: AllN (NP k) k h c xs => proxy c -> (forall a. c a => f a) -> h f xs Source #

HTrans [k2] k2 [k1] k1 (NP k1) (NP k2) Source # 

Methods

htrans :: AllZipN (NP k1) l1 (NP k2) k1 l1 k1 (Prod l1 k1 h1) c xs ys => proxy c -> (forall x y. c x y => f x -> g y) -> h1 f xs -> h2 g ys Source #

hcoerce :: (AllZipN (NP k1) l1 (NP k2) k1 l1 k1 (Prod l1 k1 h1) (LiftedCoercible (NP k2) * k1 f g) xs ys, HTrans (NP k1) (NP k2) l1 k1 h1 h2) => h1 f xs -> h2 g ys Source #

All k (Compose k * Eq f) xs => Eq (NP k f xs) Source # 

Methods

(==) :: NP k f xs -> NP k f xs -> Bool #

(/=) :: NP k f xs -> NP k f xs -> Bool #

(All k (Compose k * Eq f) xs, All k (Compose k * Ord f) xs) => Ord (NP k f xs) Source # 

Methods

compare :: NP k f xs -> NP k f xs -> Ordering #

(<) :: NP k f xs -> NP k f xs -> Bool #

(<=) :: NP k f xs -> NP k f xs -> Bool #

(>) :: NP k f xs -> NP k f xs -> Bool #

(>=) :: NP k f xs -> NP k f xs -> Bool #

max :: NP k f xs -> NP k f xs -> NP k f xs #

min :: NP k f xs -> NP k f xs -> NP k f xs #

All k (Compose k * Show f) xs => Show (NP k f xs) Source # 

Methods

showsPrec :: Int -> NP k f xs -> ShowS #

show :: NP k f xs -> String #

showList :: [NP k f xs] -> ShowS #

All k (Compose k * NFData f) xs => NFData (NP k f xs) Source #

Since: 0.2.5.0

Methods

rnf :: NP k f xs -> () #

type SListIN [k] k (NP k) Source # 
type SListIN [k] k (NP k) = SListI k
type UnProd [k] k (NP k) Source # 
type UnProd [k] k (NP k) = NS k
type Prod [k] k (NP k) Source # 
type Prod [k] k (NP k) = NP k
type AllN [k] k (NP k) c Source # 
type AllN [k] k (NP k) c = All k c
type CollapseTo [k] k (NP k) a Source # 
type CollapseTo [k] k (NP k) a = [a]
type Same [k2] k2 [k1] k1 (NP k1) Source # 
type Same [k2] k2 [k1] k1 (NP k1) = NP k2
type AllZipN [b] [a] b a [k] k (NP k) c Source # 
type AllZipN [b] [a] b a [k] k (NP k) c = AllZip b a c

data NS :: (k -> *) -> [k] -> * where Source #

An n-ary sum.

The sum is parameterized by a type constructor f and indexed by a type-level list xs. The length of the list determines the number of choices in the sum and if the i-th element of the list is of type x, then the i-th choice of the sum is of type f x.

The constructor names are chosen to resemble Peano-style natural numbers, i.e., Z is for "zero", and S is for "successor". Chaining S and Z chooses the corresponding component of the sum.

Examples:

Z         :: f x -> NS f (x ': xs)
S . Z     :: f y -> NS f (x ': y ': xs)
S . S . Z :: f z -> NS f (x ': y ': z ': xs)
...

Note that empty sums (indexed by an empty list) have no non-bottom elements.

Two common instantiations of f are the identity functor I and the constant functor K. For I, the sum becomes a direct generalization of the Either type to arbitrarily many choices. For K a, the result is a homogeneous choice type, where the contents of the type-level list are ignored, but its length specifies the number of options.

In the context of the SOP approach to generic programming, an n-ary sum describes the top-level structure of a datatype, which is a choice between all of its constructors.

Examples:

Z (I 'x')      :: NS I       '[ Char, Bool ]
S (Z (I True)) :: NS I       '[ Char, Bool ]
S (Z (K 1))    :: NS (K Int) '[ Char, Bool ]

Constructors

Z :: f x -> NS f (x ': xs) 
S :: NS f xs -> NS f (x ': xs) 

Instances

HExpand [k] k (NS k) Source # 

Methods

hexpand :: SListIN (NS k) k (Prod (NS k) k h) xs => (forall x. f x) -> h f xs -> Prod (NS k) k h f xs Source #

hcexpand :: AllN (NS k) k (Prod (NS k) k h) c xs => proxy c -> (forall x. c x => f x) -> h f xs -> Prod (NS k) k h f xs Source #

HApInjs [k] k (NS k) Source # 

Methods

hapInjs :: SListIN (NS k) k h xs => Prod (NS k) k h f xs -> [h f xs] Source #

HIndex [k] k (NS k) Source # 

Methods

hindex :: h f xs -> Int Source #

HSequence [k] k (NS k) Source # 

Methods

hsequence' :: (SListIN (NS k) k h xs, Applicative f) => h ((k :.: *) f g) xs -> f (h g xs) Source #

HCollapse [k] k (NS k) Source # 

Methods

hcollapse :: SListIN (NS k) k h xs => h (K k a) xs -> CollapseTo (NS k) k h a Source #

HAp [k] k (NS k) Source # 

Methods

hap :: Prod (NS k) k h ((k -.-> f) g) xs -> h f xs -> h g xs Source #

HTrans [k2] k2 [k1] k1 (NS k1) (NS k2) Source # 

Methods

htrans :: AllZipN (NS k1) l1 (NS k2) k1 l1 k1 (Prod l1 k1 h1) c xs ys => proxy c -> (forall x y. c x y => f x -> g y) -> h1 f xs -> h2 g ys Source #

hcoerce :: (AllZipN (NS k1) l1 (NS k2) k1 l1 k1 (Prod l1 k1 h1) (LiftedCoercible (NS k2) * k1 f g) xs ys, HTrans (NS k1) (NS k2) l1 k1 h1 h2) => h1 f xs -> h2 g ys Source #

All k (Compose k * Eq f) xs => Eq (NS k f xs) Source # 

Methods

(==) :: NS k f xs -> NS k f xs -> Bool #

(/=) :: NS k f xs -> NS k f xs -> Bool #

(All k (Compose k * Eq f) xs, All k (Compose k * Ord f) xs) => Ord (NS k f xs) Source # 

Methods

compare :: NS k f xs -> NS k f xs -> Ordering #

(<) :: NS k f xs -> NS k f xs -> Bool #

(<=) :: NS k f xs -> NS k f xs -> Bool #

(>) :: NS k f xs -> NS k f xs -> Bool #

(>=) :: NS k f xs -> NS k f xs -> Bool #

max :: NS k f xs -> NS k f xs -> NS k f xs #

min :: NS k f xs -> NS k f xs -> NS k f xs #

All k (Compose k * Show f) xs => Show (NS k f xs) Source # 

Methods

showsPrec :: Int -> NS k f xs -> ShowS #

show :: NS k f xs -> String #

showList :: [NS k f xs] -> ShowS #

All k (Compose k * NFData f) xs => NFData (NS k f xs) Source #

Since: 0.2.5.0

Methods

rnf :: NS k f xs -> () #

type SListIN [k] k (NS k) Source # 
type SListIN [k] k (NS k) = SListI k
type Prod [k] k (NS k) Source # 
type Prod [k] k (NS k) = NP k
type CollapseTo [k] k (NS k) a Source # 
type CollapseTo [k] k (NS k) a = a
type Same [k2] k2 [k1] k1 (NS k1) Source # 
type Same [k2] k2 [k1] k1 (NS k1) = NS k2

newtype SOP f xss Source #

A sum of products.

This is a 'newtype' for an NS of an NP. The elements of the (inner) products are applications of the parameter f. The type SOP is indexed by the list of lists that determines the sizes of both the (outer) sum and all the (inner) products, as well as the types of all the elements of the inner products.

An SOP I reflects the structure of a normal Haskell datatype. The sum structure represents the choice between the different constructors, the product structure represents the arguments of each constructor.

Constructors

SOP (NS (NP f) xss) 

Instances

HExpand [[k]] k (SOP k) Source # 

Methods

hexpand :: SListIN (SOP k) k (Prod (SOP k) k h) xs => (forall x. f x) -> h f xs -> Prod (SOP k) k h f xs Source #

hcexpand :: AllN (SOP k) k (Prod (SOP k) k h) c xs => proxy c -> (forall x. c x => f x) -> h f xs -> Prod (SOP k) k h f xs Source #

HApInjs [[k]] k (SOP k) Source # 

Methods

hapInjs :: SListIN (SOP k) k h xs => Prod (SOP k) k h f xs -> [h f xs] Source #

HIndex [[k]] k (SOP k) Source # 

Methods

hindex :: h f xs -> Int Source #

HSequence [[k]] k (SOP k) Source # 

Methods

hsequence' :: (SListIN (SOP k) k h xs, Applicative f) => h ((k :.: *) f g) xs -> f (h g xs) Source #

HCollapse [[k]] k (SOP k) Source # 

Methods

hcollapse :: SListIN (SOP k) k h xs => h (K k a) xs -> CollapseTo (SOP k) k h a Source #

HAp [[k]] k (SOP k) Source # 

Methods

hap :: Prod (SOP k) k h ((k -.-> f) g) xs -> h f xs -> h g xs Source #

HTrans [[k2]] k2 [[k1]] k1 (SOP k1) (SOP k2) Source # 

Methods

htrans :: AllZipN (SOP k1) l1 (SOP k2) k1 l1 k1 (Prod l1 k1 h1) c xs ys => proxy c -> (forall x y. c x y => f x -> g y) -> h1 f xs -> h2 g ys Source #

hcoerce :: (AllZipN (SOP k1) l1 (SOP k2) k1 l1 k1 (Prod l1 k1 h1) (LiftedCoercible (SOP k2) * k1 f g) xs ys, HTrans (SOP k1) (SOP k2) l1 k1 h1 h2) => h1 f xs -> h2 g ys Source #

Eq (NS [k] (NP k f) xss) => Eq (SOP k f xss) Source # 

Methods

(==) :: SOP k f xss -> SOP k f xss -> Bool #

(/=) :: SOP k f xss -> SOP k f xss -> Bool #

Ord (NS [k] (NP k f) xss) => Ord (SOP k f xss) Source # 

Methods

compare :: SOP k f xss -> SOP k f xss -> Ordering #

(<) :: SOP k f xss -> SOP k f xss -> Bool #

(<=) :: SOP k f xss -> SOP k f xss -> Bool #

(>) :: SOP k f xss -> SOP k f xss -> Bool #

(>=) :: SOP k f xss -> SOP k f xss -> Bool #

max :: SOP k f xss -> SOP k f xss -> SOP k f xss #

min :: SOP k f xss -> SOP k f xss -> SOP k f xss #

Show (NS [k] (NP k f) xss) => Show (SOP k f xss) Source # 

Methods

showsPrec :: Int -> SOP k f xss -> ShowS #

show :: SOP k f xss -> String #

showList :: [SOP k f xss] -> ShowS #

NFData (NS [k] (NP k f) xss) => NFData (SOP k f xss) Source #

Since: 0.2.5.0

Methods

rnf :: SOP k f xss -> () #

type SListIN [[k]] k (SOP k) Source # 
type SListIN [[k]] k (SOP k) = SListI2 k
type Prod [[k]] k (SOP k) Source # 
type Prod [[k]] k (SOP k) = POP k
type CollapseTo [[k]] k (SOP k) a Source # 
type CollapseTo [[k]] k (SOP k) a = [a]
type Same [[k2]] k2 [[k1]] k1 (SOP k1) Source # 
type Same [[k2]] k2 [[k1]] k1 (SOP k1) = SOP k2

unSOP :: SOP f xss -> NS (NP f) xss Source #

Unwrap a sum of products.

newtype POP f xss Source #

A product of products.

This is a 'newtype' for an NP of an NP. The elements of the inner products are applications of the parameter f. The type POP is indexed by the list of lists that determines the lengths of both the outer and all the inner products, as well as the types of all the elements of the inner products.

A POP is reminiscent of a two-dimensional table (but the inner lists can all be of different length). In the context of the SOP approach to generic programming, a POP is useful to represent information that is available for all arguments of all constructors of a datatype.

Constructors

POP (NP (NP f) xss) 

Instances

HSequence [[k]] k (POP k) Source # 

Methods

hsequence' :: (SListIN (POP k) k h xs, Applicative f) => h ((k :.: *) f g) xs -> f (h g xs) Source #

HCollapse [[k]] k (POP k) Source # 

Methods

hcollapse :: SListIN (POP k) k h xs => h (K k a) xs -> CollapseTo (POP k) k h a Source #

HAp [[k]] k (POP k) Source # 

Methods

hap :: Prod (POP k) k h ((k -.-> f) g) xs -> h f xs -> h g xs Source #

HPure [[k]] k (POP k) Source # 

Methods

hpure :: SListIN (POP k) k h xs => (forall a. f a) -> h f xs Source #

hcpure :: AllN (POP k) k h c xs => proxy c -> (forall a. c a => f a) -> h f xs Source #

HTrans [[k2]] k2 [[k1]] k1 (POP k1) (POP k2) Source # 

Methods

htrans :: AllZipN (POP k1) l1 (POP k2) k1 l1 k1 (Prod l1 k1 h1) c xs ys => proxy c -> (forall x y. c x y => f x -> g y) -> h1 f xs -> h2 g ys Source #

hcoerce :: (AllZipN (POP k1) l1 (POP k2) k1 l1 k1 (Prod l1 k1 h1) (LiftedCoercible (POP k2) * k1 f g) xs ys, HTrans (POP k1) (POP k2) l1 k1 h1 h2) => h1 f xs -> h2 g ys Source #

Eq (NP [k] (NP k f) xss) => Eq (POP k f xss) Source # 

Methods

(==) :: POP k f xss -> POP k f xss -> Bool #

(/=) :: POP k f xss -> POP k f xss -> Bool #

Ord (NP [k] (NP k f) xss) => Ord (POP k f xss) Source # 

Methods

compare :: POP k f xss -> POP k f xss -> Ordering #

(<) :: POP k f xss -> POP k f xss -> Bool #

(<=) :: POP k f xss -> POP k f xss -> Bool #

(>) :: POP k f xss -> POP k f xss -> Bool #

(>=) :: POP k f xss -> POP k f xss -> Bool #

max :: POP k f xss -> POP k f xss -> POP k f xss #

min :: POP k f xss -> POP k f xss -> POP k f xss #

Show (NP [k] (NP k f) xss) => Show (POP k f xss) Source # 

Methods

showsPrec :: Int -> POP k f xss -> ShowS #

show :: POP k f xss -> String #

showList :: [POP k f xss] -> ShowS #

NFData (NP [k] (NP k f) xss) => NFData (POP k f xss) Source #

Since: 0.2.5.0

Methods

rnf :: POP k f xss -> () #

type SListIN [[k]] k (POP k) Source # 
type SListIN [[k]] k (POP k) = SListI2 k
type UnProd [[k]] k (POP k) Source # 
type UnProd [[k]] k (POP k) = SOP k
type Prod [[k]] k (POP k) Source # 
type Prod [[k]] k (POP k) = POP k
type AllN [[k]] k (POP k) c Source # 
type AllN [[k]] k (POP k) c = All2 k c
type CollapseTo [[k]] k (POP k) a Source # 
type CollapseTo [[k]] k (POP k) a = [[a]]
type Same [[k2]] k2 [[k1]] k1 (POP k1) Source # 
type Same [[k2]] k2 [[k1]] k1 (POP k1) = POP k2
type AllZipN [[b]] [[a]] b a [[k]] k (POP k) c Source # 
type AllZipN [[b]] [[a]] b a [[k]] k (POP k) c = AllZip2 b a c

unPOP :: POP f xss -> NP (NP f) xss Source #

Unwrap a product of products.

Metadata

data DatatypeInfo :: [[*]] -> * where Source #

Metadata for a datatype.

A value of type DatatypeInfo c contains the information about a datatype that is not contained in Code c. This information consists primarily of the names of the datatype, its constructors, and possibly its record selectors.

The constructor indicates whether the datatype has been declared using newtype or not.

moduleName :: DatatypeInfo xss -> ModuleName Source #

The module name where a datatype is defined.

Since: 0.2.3.0

datatypeName :: DatatypeInfo xss -> DatatypeName Source #

The name of a datatype (or newtype).

Since: 0.2.3.0

constructorInfo :: DatatypeInfo xss -> NP ConstructorInfo xss Source #

The constructor info for a datatype (or newtype).

Since: 0.2.3.0

data ConstructorInfo :: [*] -> * where Source #

Metadata for a single constructors.

This is indexed by the product structure of the constructor components.

constructorName :: ConstructorInfo xs -> ConstructorName Source #

The name of a constructor.

Since: 0.2.3.0

data FieldInfo :: * -> * where Source #

For records, this functor maps the component to its selector name.

Constructors

FieldInfo :: FieldName -> FieldInfo a 

Instances

Functor FieldInfo Source # 

Methods

fmap :: (a -> b) -> FieldInfo a -> FieldInfo b #

(<$) :: a -> FieldInfo b -> FieldInfo a #

Eq (FieldInfo a) Source # 

Methods

(==) :: FieldInfo a -> FieldInfo a -> Bool #

(/=) :: FieldInfo a -> FieldInfo a -> Bool #

Ord (FieldInfo a) Source # 
Show (FieldInfo a) Source # 

fieldName :: FieldInfo a -> FieldName Source #

The name of a field.

Since: 0.2.3.0

class HasDatatypeInfo a where Source #

A class of datatypes that have associated metadata.

It is possible to use the sum-of-products approach to generic programming without metadata. If you need metadata in a function, an additional constraint on this class is in order.

You typically don't define instances of this class by hand, but rather derive the class instance automatically. See the documentation of Generic for the options.

Associated Types

type DatatypeInfoOf a :: DatatypeInfo Source #

Type-level datatype info

Methods

datatypeInfo :: proxy a -> DatatypeInfo (Code a) Source #

Term-level datatype info; by default, the term-level datatype info is produced from the type-level info.

datatypeInfo :: (GDatatypeInfo a, GCode a ~ Code a) => proxy a -> DatatypeInfo (Code a) Source #

Term-level datatype info; by default, the term-level datatype info is produced from the type-level info.

type DatatypeName = String Source #

The name of a datatype.

type ModuleName = String Source #

The name of a module.

type ConstructorName = String Source #

The name of a data constructor.

type FieldName = String Source #

The name of a field / record selector.

data Associativity :: * #

Datatype to represent the associativity of a constructor

Instances

Bounded Associativity 
Enum Associativity 
Eq Associativity 
Data Associativity 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Associativity -> c Associativity #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Associativity #

toConstr :: Associativity -> Constr #

dataTypeOf :: Associativity -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Associativity) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Associativity) #

gmapT :: (forall b. Data b => b -> b) -> Associativity -> Associativity #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Associativity -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Associativity -> r #

gmapQ :: (forall d. Data d => d -> u) -> Associativity -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Associativity -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Associativity -> m Associativity #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Associativity -> m Associativity #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Associativity -> m Associativity #

Ord Associativity 
Read Associativity 
Show Associativity 
Ix Associativity 
Generic Associativity 

Associated Types

type Rep Associativity :: * -> * #

SingI Associativity LeftAssociative 

Methods

sing :: Sing LeftAssociative a

SingI Associativity RightAssociative 

Methods

sing :: Sing RightAssociative a

SingI Associativity NotAssociative 

Methods

sing :: Sing NotAssociative a

SingKind Associativity (KProxy Associativity) 

Associated Types

type DemoteRep (KProxy Associativity) (kparam :: KProxy (KProxy Associativity)) :: *

Methods

fromSing :: Sing (KProxy Associativity) a -> DemoteRep (KProxy Associativity) kparam

type Rep Associativity 
type Rep Associativity = D1 (MetaData "Associativity" "GHC.Generics" "base" False) ((:+:) (C1 (MetaCons "LeftAssociative" PrefixI False) U1) ((:+:) (C1 (MetaCons "RightAssociative" PrefixI False) U1) (C1 (MetaCons "NotAssociative" PrefixI False) U1)))
data Sing Associativity 
type DemoteRep Associativity (KProxy Associativity) 

type Fixity = Int Source #

The fixity of an infix constructor.

Combinators

Constructing products

class HPure h where Source #

A generalization of pure or return to higher kinds.

Minimal complete definition

hpure, hcpure

Methods

hpure :: SListIN h xs => (forall a. f a) -> h f xs Source #

Corresponds to pure directly.

Instances:

hpure, pure_NP  :: SListI  xs  => (forall a. f a) -> NP  f xs
hpure, pure_POP :: SListI2 xss => (forall a. f a) -> POP f xss

hcpure :: AllN h c xs => proxy c -> (forall a. c a => f a) -> h f xs Source #

A variant of hpure that allows passing in a constrained argument.

Calling hcpure f s where s :: h f xs causes f to be applied at all the types that are contained in xs. Therefore, the constraint c has to be satisfied for all elements of xs, which is what AllMap h c xs states.

Morally, hpure is a special case of hcpure where the constraint is empty. However, it is in the nature of how AllMap is defined as well as current GHC limitations that it is tricky to prove to GHC in general that AllMap h c NoConstraint xs is always satisfied. Therefore, we typically define hpure separately and directly, and make it a member of the class.

Instances:

hcpure, cpure_NP  :: (All  c xs ) => proxy c -> (forall a. c a => f a) -> NP  f xs
hcpure, cpure_POP :: (All2 c xss) => proxy c -> (forall a. c a => f a) -> POP f xss

Instances

HPure [[k]] k (POP k) Source # 

Methods

hpure :: SListIN (POP k) k h xs => (forall a. f a) -> h f xs Source #

hcpure :: AllN (POP k) k h c xs => proxy c -> (forall a. c a => f a) -> h f xs Source #

HPure [k] k (NP k) Source # 

Methods

hpure :: SListIN (NP k) k h xs => (forall a. f a) -> h f xs Source #

hcpure :: AllN (NP k) k h c xs => proxy c -> (forall a. c a => f a) -> h f xs Source #

Destructing products

hd :: NP f (x ': xs) -> f x Source #

Obtain the head of an n-ary product.

Since: 0.2.1.0

tl :: NP f (x ': xs) -> NP f xs Source #

Obtain the tail of an n-ary product.

Since: 0.2.1.0

type Projection f xs = K (NP f xs) -.-> f Source #

The type of projections from an n-ary product.

projections :: forall xs f. SListI xs => NP (Projection f xs) xs Source #

Compute all projections from an n-ary product.

Each element of the resulting product contains one of the projections.

shiftProjection :: Projection f xs a -> Projection f (x ': xs) a Source #

Application

newtype (f -.-> g) a infixr 1 Source #

Lifted functions.

Constructors

Fn 

Fields

  • apFn :: f a -> g a
     

fn :: (f a -> f' a) -> (f -.-> f') a Source #

Construct a lifted function.

Same as Fn. Only available for uniformity with the higher-arity versions.

fn_2 :: (f a -> f' a -> f'' a) -> (f -.-> (f' -.-> f'')) a Source #

Construct a binary lifted function.

fn_3 :: (f a -> f' a -> f'' a -> f''' a) -> (f -.-> (f' -.-> (f'' -.-> f'''))) a Source #

Construct a ternary lifted function.

fn_4 :: (f a -> f' a -> f'' a -> f''' a -> f'''' a) -> (f -.-> (f' -.-> (f'' -.-> (f''' -.-> f'''')))) a Source #

Construct a quarternary lifted function.

type family Prod (h :: (k -> *) -> l -> *) :: (k -> *) -> l -> * Source #

Maps a structure containing sums to the corresponding product structure.

Instances

type Prod [[k]] k (POP k) Source # 
type Prod [[k]] k (POP k) = POP k
type Prod [[k]] k (SOP k) Source # 
type Prod [[k]] k (SOP k) = POP k
type Prod [k] k (NP k) Source # 
type Prod [k] k (NP k) = NP k
type Prod [k] k (NS k) Source # 
type Prod [k] k (NS k) = NP k

class (Prod (Prod h) ~ Prod h, HPure (Prod h)) => HAp h where Source #

A generalization of <*>.

Minimal complete definition

hap

Methods

hap :: Prod h (f -.-> g) xs -> h f xs -> h g xs Source #

Corresponds to <*>.

For products (NP) as well as products of products (POP), the correspondence is rather direct. We combine a structure containing (lifted) functions and a compatible structure containing corresponding arguments into a compatible structure containing results.

The same combinator can also be used to combine a product structure of functions with a sum structure of arguments, which then results in another sum structure of results. The sum structure determines which part of the product structure will be used.

Instances:

hap, ap_NP  :: NP  (f -.-> g) xs  -> NP  f xs  -> NP  g xs
hap, ap_NS  :: NP  (f -.-> g) xs  -> NS  f xs  -> NS  g xs
hap, ap_POP :: POP (f -.-> g) xss -> POP f xss -> POP g xss
hap, ap_SOP :: POP (f -.-> g) xss -> SOP f xss -> SOP g xss

Instances

HAp [[k]] k (POP k) Source # 

Methods

hap :: Prod (POP k) k h ((k -.-> f) g) xs -> h f xs -> h g xs Source #

HAp [[k]] k (SOP k) Source # 

Methods

hap :: Prod (SOP k) k h ((k -.-> f) g) xs -> h f xs -> h g xs Source #

HAp [k] k (NP k) Source # 

Methods

hap :: Prod (NP k) k h ((k -.-> f) g) xs -> h f xs -> h g xs Source #

HAp [k] k (NS k) Source # 

Methods

hap :: Prod (NS k) k h ((k -.-> f) g) xs -> h f xs -> h g xs Source #

Lifting / mapping

hliftA :: (SListIN (Prod h) xs, HAp h) => (forall a. f a -> f' a) -> h f xs -> h f' xs Source #

A generalized form of liftA, which in turn is a generalized map.

Takes a lifted function and applies it to every element of a structure while preserving its shape.

Specification:

hliftA f xs = hpure (fn f) ` hap ` xs

Instances:

hliftA, liftA_NP  :: SListI  xs  => (forall a. f a -> f' a) -> NP  f xs  -> NP  f' xs
hliftA, liftA_NS  :: SListI  xs  => (forall a. f a -> f' a) -> NS  f xs  -> NS  f' xs
hliftA, liftA_POP :: SListI2 xss => (forall a. f a -> f' a) -> POP f xss -> POP f' xss
hliftA, liftA_SOP :: SListI2 xss => (forall a. f a -> f' a) -> SOP f xss -> SOP f' xss

hliftA2 :: (SListIN (Prod h) xs, HAp h, HAp (Prod h)) => (forall a. f a -> f' a -> f'' a) -> Prod h f xs -> h f' xs -> h f'' xs Source #

A generalized form of liftA2, which in turn is a generalized zipWith.

Takes a lifted binary function and uses it to combine two structures of equal shape into a single structure.

It either takes two product structures to a product structure, or one product and one sum structure to a sum structure.

Specification:

hliftA2 f xs ys = hpure (fn_2 f) ` hap ` xs ` hap ` ys

Instances:

hliftA2, liftA2_NP  :: SListI  xs  => (forall a. f a -> f' a -> f'' a) -> NP  f xs  -> NP  f' xs  -> NP  f'' xs
hliftA2, liftA2_NS  :: SListI  xs  => (forall a. f a -> f' a -> f'' a) -> NP  f xs  -> NS  f' xs  -> NS  f'' xs
hliftA2, liftA2_POP :: SListI2 xss => (forall a. f a -> f' a -> f'' a) -> POP f xss -> POP f' xss -> POP f'' xss
hliftA2, liftA2_SOP :: SListI2 xss => (forall a. f a -> f' a -> f'' a) -> POP f xss -> SOP f' xss -> SOP f'' xss

hliftA3 :: (SListIN (Prod h) xs, HAp h, HAp (Prod h)) => (forall a. f a -> f' a -> f'' a -> f''' a) -> Prod h f xs -> Prod h f' xs -> h f'' xs -> h f''' xs Source #

A generalized form of liftA3, which in turn is a generalized zipWith3.

Takes a lifted ternary function and uses it to combine three structures of equal shape into a single structure.

It either takes three product structures to a product structure, or two product structures and one sum structure to a sum structure.

Specification:

hliftA3 f xs ys zs = hpure (fn_3 f) ` hap ` xs ` hap ` ys ` hap ` zs

Instances:

hliftA3, liftA3_NP  :: SListI  xs  => (forall a. f a -> f' a -> f'' a -> f''' a) -> NP  f xs  -> NP  f' xs  -> NP  f'' xs  -> NP  f''' xs
hliftA3, liftA3_NS  :: SListI  xs  => (forall a. f a -> f' a -> f'' a -> f''' a) -> NP  f xs  -> NP  f' xs  -> NS  f'' xs  -> NS  f''' xs
hliftA3, liftA3_POP :: SListI2 xss => (forall a. f a -> f' a -> f'' a -> f''' a) -> POP f xss -> POP f' xss -> POP f'' xss -> POP f''' xs
hliftA3, liftA3_SOP :: SListI2 xss => (forall a. f a -> f' a -> f'' a -> f''' a) -> POP f xss -> POP f' xss -> SOP f'' xss -> SOP f''' xs

hcliftA :: (AllN (Prod h) c xs, HAp h) => proxy c -> (forall a. c a => f a -> f' a) -> h f xs -> h f' xs Source #

Variant of hliftA that takes a constrained function.

Specification:

hcliftA p f xs = hcpure p (fn f) ` hap ` xs

hcliftA2 :: (AllN (Prod h) c xs, HAp h, HAp (Prod h)) => proxy c -> (forall a. c a => f a -> f' a -> f'' a) -> Prod h f xs -> h f' xs -> h f'' xs Source #

Variant of hcliftA2 that takes a constrained function.

Specification:

hcliftA2 p f xs ys = hcpure p (fn_2 f) ` hap ` xs ` hap ` ys

hcliftA3 :: (AllN (Prod h) c xs, HAp h, HAp (Prod h)) => proxy c -> (forall a. c a => f a -> f' a -> f'' a -> f''' a) -> Prod h f xs -> Prod h f' xs -> h f'' xs -> h f''' xs Source #

Variant of hcliftA3 that takes a constrained function.

Specification:

hcliftA3 p f xs ys zs = hcpure p (fn_3 f) ` hap ` xs ` hap ` ys ` hap ` zs

hmap :: (SListIN (Prod h) xs, HAp h) => (forall a. f a -> f' a) -> h f xs -> h f' xs Source #

Another name for hliftA.

Since: 0.2

hzipWith :: (SListIN (Prod h) xs, HAp h, HAp (Prod h)) => (forall a. f a -> f' a -> f'' a) -> Prod h f xs -> h f' xs -> h f'' xs Source #

Another name for hliftA2.

Since: 0.2

hzipWith3 :: (SListIN (Prod h) xs, HAp h, HAp (Prod h)) => (forall a. f a -> f' a -> f'' a -> f''' a) -> Prod h f xs -> Prod h f' xs -> h f'' xs -> h f''' xs Source #

Another name for hliftA3.

Since: 0.2

hcmap :: (AllN (Prod h) c xs, HAp h) => proxy c -> (forall a. c a => f a -> f' a) -> h f xs -> h f' xs Source #

Another name for hcliftA.

Since: 0.2

hczipWith :: (AllN (Prod h) c xs, HAp h, HAp (Prod h)) => proxy c -> (forall a. c a => f a -> f' a -> f'' a) -> Prod h f xs -> h f' xs -> h f'' xs Source #

Another name for hcliftA2.

Since: 0.2

hczipWith3 :: (AllN (Prod h) c xs, HAp h, HAp (Prod h)) => proxy c -> (forall a. c a => f a -> f' a -> f'' a -> f''' a) -> Prod h f xs -> Prod h f' xs -> h f'' xs -> h f''' xs Source #

Another name for hcliftA3.

Since: 0.2

Constructing sums

type Injection f xs = f -.-> K (NS f xs) Source #

The type of injections into an n-ary sum.

If you expand the type synonyms and newtypes involved, you get

Injection f xs a = (f -.-> K (NS f xs)) a ~= f a -> K (NS f xs) a ~= f a -> NS f xs

If we pick a to be an element of xs, this indeed corresponds to an injection into the sum.

injections :: forall xs f. SListI xs => NP (Injection f xs) xs Source #

Compute all injections into an n-ary sum.

Each element of the resulting product contains one of the injections.

shift :: Injection f xs a -> Injection f (x ': xs) a Source #

Deprecated: Use shiftInjection instead.

Shift an injection.

Given an injection, return an injection into a sum that is one component larger.

shiftInjection :: Injection f xs a -> Injection f (x ': xs) a Source #

Shift an injection.

Given an injection, return an injection into a sum that is one component larger.

type family UnProd (h :: (k -> *) -> l -> *) :: (k -> *) -> l -> * Source #

Maps a structure containing products to the corresponding sum structure.

Since: 0.2.4.0

Instances

type UnProd [[k]] k (POP k) Source # 
type UnProd [[k]] k (POP k) = SOP k
type UnProd [k] k (NP k) Source # 
type UnProd [k] k (NP k) = NS k

class UnProd (Prod h) ~ h => HApInjs h where Source #

A class for applying all injections corresponding to a sum-like structure to a table containing suitable arguments.

Minimal complete definition

hapInjs

Methods

hapInjs :: SListIN h xs => Prod h f xs -> [h f xs] Source #

For a given table (product-like structure), produce a list where each element corresponds to the application of an injection function into the corresponding sum-like structure.

Instances:

hapInjs, apInjs_NP  :: SListI  xs  => NP  f xs -> [NS  f xs ]
hapInjs, apInjs_SOP :: SListI2 xss => POP f xs -> [SOP f xss]

Examples:

>>> hapInjs (I 'x' :* I True :* I 2 :* Nil)
[Z (I 'x'), S (Z (I True)), S (S (Z (I 2)))]
>>> hapInjs (POP ((I 'x' :* Nil) :* (I True :* I 2 :* Nil) :* Nil)
[SOP (Z (I 'x' :* Nil)), SOP (S (Z (I True :* (I 2 :* Nil))))]

Since: 0.2.4.0

Instances

HApInjs [[k]] k (SOP k) Source # 

Methods

hapInjs :: SListIN (SOP k) k h xs => Prod (SOP k) k h f xs -> [h f xs] Source #

HApInjs [k] k (NS k) Source # 

Methods

hapInjs :: SListIN (NS k) k h xs => Prod (NS k) k h f xs -> [h f xs] Source #

apInjs_NP :: SListI xs => NP f xs -> [NS f xs] Source #

Apply injections to a product.

Given a product containing all possible choices, produce a list of sums by applying each injection to the appropriate element.

Example:

>>> apInjs_NP (I 'x' :* I True :* I 2 :* Nil)
[Z (I 'x'), S (Z (I True)), S (S (Z (I 2)))]

apInjs_POP :: SListI xss => POP f xss -> [SOP f xss] Source #

Apply injections to a product of product.

This operates on the outer product only. Given a product containing all possible choices (that are products), produce a list of sums (of products) by applying each injection to the appropriate element.

Example:

>>> apInjs_POP (POP ((I 'x' :* Nil) :* (I True :* I 2 :* Nil) :* Nil))
[SOP (Z (I 'x' :* Nil)),SOP (S (Z (I True :* (I 2 :* Nil))))]

Destructing sums

unZ :: NS f '[x] -> f x Source #

Extract the payload from a unary sum.

For larger sums, this function would be partial, so it is only provided with a rather restrictive type.

Example:

>>> unZ (Z (I 'x'))
I 'x'

Since: 0.2.2.0

class HIndex h where Source #

A class for determining which choice in a sum-like structure a value represents.

Minimal complete definition

hindex

Methods

hindex :: h f xs -> Int Source #

If h is a sum-like structure representing a choice between n different options, and x is a value of type h f xs, then hindex x returns a number between 0 and n - 1 representing the index of the choice made by x.

Instances:

hindex, index_NS  :: NS  f xs -> Int
hindex, index_SOP :: SOP f xs -> Int

Examples:

>>> hindex (S (S (Z (I False))))
2
>>> hindex (Z (K ()))
0
>>> hindex (SOP (S (Z (I True :* I 'x' :* Nil))))
1

Since: 0.2.4.0

Instances

HIndex [[k]] k (SOP k) Source # 

Methods

hindex :: h f xs -> Int Source #

HIndex [k] k (NS k) Source # 

Methods

hindex :: h f xs -> Int Source #

Dealing with All c

hcliftA' :: (All2 c xss, Prod h ~ NP, HAp h) => proxy c -> (forall xs. All c xs => f xs -> f' xs) -> h f xss -> h f' xss Source #

Deprecated: Use hcliftA or hcmap instead.

Lift a constrained function operating on a list-indexed structure to a function on a list-of-list-indexed structure.

This is a variant of hcliftA.

Specification:

hcliftA' p f xs = hpure (fn_2 $ \ AllDictC -> f) ` hap ` allDict_NP p ` hap ` xs

Instances:

hcliftA' :: All2 c xss => proxy c -> (forall xs. All c xs => f xs -> f' xs) -> NP f xss -> NP f' xss
hcliftA' :: All2 c xss => proxy c -> (forall xs. All c xs => f xs -> f' xs) -> NS f xss -> NS f' xss

hcliftA2' :: (All2 c xss, Prod h ~ NP, HAp h) => proxy c -> (forall xs. All c xs => f xs -> f' xs -> f'' xs) -> Prod h f xss -> h f' xss -> h f'' xss Source #

Deprecated: Use hcliftA2 or hczipWith instead.

Like hcliftA', but for binary functions.

hcliftA3' :: (All2 c xss, Prod h ~ NP, HAp h) => proxy c -> (forall xs. All c xs => f xs -> f' xs -> f'' xs -> f''' xs) -> Prod h f xss -> Prod h f' xss -> h f'' xss -> h f''' xss Source #

Deprecated: Use hcliftA3 or hczipWith3 instead.

Like hcliftA', but for ternay functions.

Collapsing

type family CollapseTo (h :: (k -> *) -> l -> *) (x :: *) :: * Source #

Maps products to lists, and sums to identities.

Instances

type CollapseTo [[k]] k (POP k) a Source # 
type CollapseTo [[k]] k (POP k) a = [[a]]
type CollapseTo [[k]] k (SOP k) a Source # 
type CollapseTo [[k]] k (SOP k) a = [a]
type CollapseTo [k] k (NP k) a Source # 
type CollapseTo [k] k (NP k) a = [a]
type CollapseTo [k] k (NS k) a Source # 
type CollapseTo [k] k (NS k) a = a

class HCollapse h where Source #

A class for collapsing a heterogeneous structure into a homogeneous one.

Minimal complete definition

hcollapse

Methods

hcollapse :: SListIN h xs => h (K a) xs -> CollapseTo h a Source #

Collapse a heterogeneous structure with homogeneous elements into a homogeneous structure.

If a heterogeneous structure is instantiated to the constant functor K, then it is in fact homogeneous. This function maps such a value to a simpler Haskell datatype reflecting that. An NS (K a) contains a single a, and an NP (K a) contains a list of as.

Instances:

hcollapse, collapse_NP  :: NP  (K a) xs  ->  [a]
hcollapse, collapse_NS  :: NS  (K a) xs  ->   a
hcollapse, collapse_POP :: POP (K a) xss -> [[a]]
hcollapse, collapse_SOP :: SOP (K a) xss ->  [a]

Instances

HCollapse [[k]] k (POP k) Source # 

Methods

hcollapse :: SListIN (POP k) k h xs => h (K k a) xs -> CollapseTo (POP k) k h a Source #

HCollapse [[k]] k (SOP k) Source # 

Methods

hcollapse :: SListIN (SOP k) k h xs => h (K k a) xs -> CollapseTo (SOP k) k h a Source #

HCollapse [k] k (NP k) Source # 

Methods

hcollapse :: SListIN (NP k) k h xs => h (K k a) xs -> CollapseTo (NP k) k h a Source #

HCollapse [k] k (NS k) Source # 

Methods

hcollapse :: SListIN (NS k) k h xs => h (K k a) xs -> CollapseTo (NS k) k h a Source #

Sequencing

class HAp h => HSequence h where Source #

A generalization of sequenceA.

Minimal complete definition

hsequence'

Methods

hsequence' :: (SListIN h xs, Applicative f) => h (f :.: g) xs -> f (h g xs) Source #

Corresponds to sequenceA.

Lifts an applicative functor out of a structure.

Instances:

hsequence', sequence'_NP  :: (SListI  xs , Applicative f) => NP  (f :.: g) xs  -> f (NP  g xs )
hsequence', sequence'_NS  :: (SListI  xs , Applicative f) => NS  (f :.: g) xs  -> f (NS  g xs )
hsequence', sequence'_POP :: (SListI2 xss, Applicative f) => POP (f :.: g) xss -> f (POP g xss)
hsequence', sequence'_SOP :: (SListI2 xss, Applicative f) => SOP (f :.: g) xss -> f (SOP g xss)

Instances

HSequence [[k]] k (POP k) Source # 

Methods

hsequence' :: (SListIN (POP k) k h xs, Applicative f) => h ((k :.: *) f g) xs -> f (h g xs) Source #

HSequence [[k]] k (SOP k) Source # 

Methods

hsequence' :: (SListIN (SOP k) k h xs, Applicative f) => h ((k :.: *) f g) xs -> f (h g xs) Source #

HSequence [k] k (NP k) Source # 

Methods

hsequence' :: (SListIN (NP k) k h xs, Applicative f) => h ((k :.: *) f g) xs -> f (h g xs) Source #

HSequence [k] k (NS k) Source # 

Methods

hsequence' :: (SListIN (NS k) k h xs, Applicative f) => h ((k :.: *) f g) xs -> f (h g xs) Source #

hsequence :: (SListIN h xs, SListIN (Prod h) xs, HSequence h) => Applicative f => h f xs -> f (h I xs) Source #

Special case of hsequence' where g = I.

hsequenceK :: (SListIN h xs, SListIN (Prod h) xs, Applicative f, HSequence h) => h (K (f a)) xs -> f (h (K a) xs) Source #

Special case of hsequence' where g = K a.

Expanding sums to products

class HExpand h where Source #

A class for expanding sum structures into corresponding product structures, filling in the slots not targeted by the sum with default values.

Since: 0.2.5.0

Minimal complete definition

hexpand, hcexpand

Methods

hexpand :: SListIN (Prod h) xs => (forall x. f x) -> h f xs -> Prod h f xs Source #

Expand a given sum structure into a corresponding product structure by placing the value contained in the sum into the corresponding position in the product, and using the given default value for all other positions.

Instances:

hexpand, expand_NS  :: SListI xs  => (forall x . f x) -> NS  f xs  -> NP  f xs
hexpand, expand_SOP :: SListI2 xss => (forall x . f x) -> SOP f xss -> POP f xss

Examples:

>>> hexpand Nothing (S (Z (Just 3))) :: NP Maybe '[Char, Int, Bool]
Nothing :* Just 3 :* Nothing :* Nil
>>> hexpand [] (SOP (S (Z ([1,2] :* "xyz" :* Nil)))) :: POP [] '[ '[Bool], '[Int, Char] ]
POP (([] :* Nil) :* ([1,2] :* "xyz" :* Nil) :* Nil)

Since: 0.2.5.0

hcexpand :: AllN (Prod h) c xs => proxy c -> (forall x. c x => f x) -> h f xs -> Prod h f xs Source #

Variant of hexpand that allows passing a constrained default.

Instances:

hcexpand, cexpand_NS  :: All  c xs  => proxy c -> (forall x . c x => f x) -> NS  f xs  -> NP  f xs
hcexpand, cexpand_SOP :: All2 c xss => proxy c -> (forall x . c x => f x) -> SOP f xss -> POP f xss

Examples:

>>> hcexpand (Proxy :: Proxy Bounded) (I minBound) (S (Z (I 20))) :: NP I '[Bool, Int, Ordering]
I False :* I 20 :* I LT :* Nil
>>> hcexpand (Proxy :: Proxy Num) (I 0) (SOP (S (Z (I 1 :* I 2 :* Nil)))) :: POP I '[ '[Double], '[Int, Int] ]
POP ((I 0.0 :* Nil) :* (I 1 :* I 2 :* Nil) :* Nil)

Since: 0.2.5.0

Instances

HExpand [[k]] k (SOP k) Source # 

Methods

hexpand :: SListIN (SOP k) k (Prod (SOP k) k h) xs => (forall x. f x) -> h f xs -> Prod (SOP k) k h f xs Source #

hcexpand :: AllN (SOP k) k (Prod (SOP k) k h) c xs => proxy c -> (forall x. c x => f x) -> h f xs -> Prod (SOP k) k h f xs Source #

HExpand [k] k (NS k) Source # 

Methods

hexpand :: SListIN (NS k) k (Prod (NS k) k h) xs => (forall x. f x) -> h f xs -> Prod (NS k) k h f xs Source #

hcexpand :: AllN (NS k) k (Prod (NS k) k h) c xs => proxy c -> (forall x. c x => f x) -> h f xs -> Prod (NS k) k h f xs Source #

Transformation of index lists and coercions

class (Same h1 ~ h2, Same h2 ~ h1) => HTrans h1 h2 where Source #

A class for transforming structures into related structures with a different index list, as long as the index lists have the same shape and the elements and interpretation functions are suitably related.

Since: 0.3.1.0

Minimal complete definition

htrans, hcoerce

Methods

htrans :: AllZipN (Prod h1) c xs ys => proxy c -> (forall x y. c x y => f x -> g y) -> h1 f xs -> h2 g ys Source #

Transform a structure into a related structure given a conversion function for the elements.

Since: 0.3.1.0

hcoerce :: (AllZipN (Prod h1) (LiftedCoercible f g) xs ys, HTrans h1 h2) => h1 f xs -> h2 g ys Source #

Coerce a structure into a representationally equal structure.

Examples:

>>> hcoerce (I (Just LT) :* I (Just 'x') :* I (Just True) :* Nil) :: NP Maybe '[Ordering, Char, Bool]
Just LT :* (Just 'x' :* (Just True :* Nil))
>>> hcoerce (SOP (Z (K True :* K False :* Nil))) :: SOP I '[ '[Bool, Bool], '[Bool] ]
SOP (Z (I True :* (I False :* Nil)))

Since: 0.3.1.0

Instances

HTrans [[k2]] k2 [[k1]] k1 (POP k1) (POP k2) Source # 

Methods

htrans :: AllZipN (POP k1) l1 (POP k2) k1 l1 k1 (Prod l1 k1 h1) c xs ys => proxy c -> (forall x y. c x y => f x -> g y) -> h1 f xs -> h2 g ys Source #

hcoerce :: (AllZipN (POP k1) l1 (POP k2) k1 l1 k1 (Prod l1 k1 h1) (LiftedCoercible (POP k2) * k1 f g) xs ys, HTrans (POP k1) (POP k2) l1 k1 h1 h2) => h1 f xs -> h2 g ys Source #

HTrans [[k2]] k2 [[k1]] k1 (SOP k1) (SOP k2) Source # 

Methods

htrans :: AllZipN (SOP k1) l1 (SOP k2) k1 l1 k1 (Prod l1 k1 h1) c xs ys => proxy c -> (forall x y. c x y => f x -> g y) -> h1 f xs -> h2 g ys Source #

hcoerce :: (AllZipN (SOP k1) l1 (SOP k2) k1 l1 k1 (Prod l1 k1 h1) (LiftedCoercible (SOP k2) * k1 f g) xs ys, HTrans (SOP k1) (SOP k2) l1 k1 h1 h2) => h1 f xs -> h2 g ys Source #

HTrans [k2] k2 [k1] k1 (NP k1) (NP k2) Source # 

Methods

htrans :: AllZipN (NP k1) l1 (NP k2) k1 l1 k1 (Prod l1 k1 h1) c xs ys => proxy c -> (forall x y. c x y => f x -> g y) -> h1 f xs -> h2 g ys Source #

hcoerce :: (AllZipN (NP k1) l1 (NP k2) k1 l1 k1 (Prod l1 k1 h1) (LiftedCoercible (NP k2) * k1 f g) xs ys, HTrans (NP k1) (NP k2) l1 k1 h1 h2) => h1 f xs -> h2 g ys Source #

HTrans [k2] k2 [k1] k1 (NS k1) (NS k2) Source # 

Methods

htrans :: AllZipN (NS k1) l1 (NS k2) k1 l1 k1 (Prod l1 k1 h1) c xs ys => proxy c -> (forall x y. c x y => f x -> g y) -> h1 f xs -> h2 g ys Source #

hcoerce :: (AllZipN (NS k1) l1 (NS k2) k1 l1 k1 (Prod l1 k1 h1) (LiftedCoercible (NS k2) * k1 f g) xs ys, HTrans (NS k1) (NS k2) l1 k1 h1 h2) => h1 f xs -> h2 g ys Source #

hfromI :: (AllZipN (Prod h1) (LiftedCoercible I f) xs ys, HTrans h1 h2) => h1 I xs -> h2 f ys Source #

Specialization of hcoerce.

Since: 0.3.1.0

htoI :: (AllZipN (Prod h1) (LiftedCoercible f I) xs ys, HTrans h1 h2) => h1 f xs -> h2 I ys Source #

Specialization of hcoerce.

Since: 0.3.1.0

Partial operations

fromList :: SListI xs => [a] -> Maybe (NP (K a) xs) Source #

Construct a homogeneous n-ary product from a normal Haskell list.

Returns Nothing if the length of the list does not exactly match the expected size of the product.

Utilities

Basic functors

newtype K a b Source #

The constant type functor.

Like Constant, but kind-polymorphic in its second argument and with a shorter name.

Constructors

K a 

Instances

Eq2 (K *) Source #

Since: 0.2.4.0

Methods

liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> K * a c -> K * b d -> Bool #

Ord2 (K *) Source #

Since: 0.2.4.0

Methods

liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) -> K * a c -> K * b d -> Ordering #

Read2 (K *) Source #

Since: 0.2.4.0

Methods

liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (K * a b) #

liftReadList2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [K * a b] #

Show2 (K *) Source #

Since: 0.2.4.0

Methods

liftShowsPrec2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> K * a b -> ShowS #

liftShowList2 :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> (Int -> b -> ShowS) -> ([b] -> ShowS) -> [K * a b] -> ShowS #

Functor (K * a) Source # 

Methods

fmap :: (a -> b) -> K * a a -> K * a b #

(<$) :: a -> K * a b -> K * a a #

Monoid a => Applicative (K * a) Source # 

Methods

pure :: a -> K * a a #

(<*>) :: K * a (a -> b) -> K * a a -> K * a b #

(*>) :: K * a a -> K * a b -> K * a b #

(<*) :: K * a a -> K * a b -> K * a a #

Foldable (K * a) Source # 

Methods

fold :: Monoid m => K * a m -> m #

foldMap :: Monoid m => (a -> m) -> K * a a -> m #

foldr :: (a -> b -> b) -> b -> K * a a -> b #

foldr' :: (a -> b -> b) -> b -> K * a a -> b #

foldl :: (b -> a -> b) -> b -> K * a a -> b #

foldl' :: (b -> a -> b) -> b -> K * a a -> b #

foldr1 :: (a -> a -> a) -> K * a a -> a #

foldl1 :: (a -> a -> a) -> K * a a -> a #

toList :: K * a a -> [a] #

null :: K * a a -> Bool #

length :: K * a a -> Int #

elem :: Eq a => a -> K * a a -> Bool #

maximum :: Ord a => K * a a -> a #

minimum :: Ord a => K * a a -> a #

sum :: Num a => K * a a -> a #

product :: Num a => K * a a -> a #

Traversable (K * a) Source # 

Methods

traverse :: Applicative f => (a -> f b) -> K * a a -> f (K * a b) #

sequenceA :: Applicative f => K * a (f a) -> f (K * a a) #

mapM :: Monad m => (a -> m b) -> K * a a -> m (K * a b) #

sequence :: Monad m => K * a (m a) -> m (K * a a) #

Eq a => Eq1 (K * a) Source #

Since: 0.2.4.0

Methods

liftEq :: (a -> b -> Bool) -> K * a a -> K * a b -> Bool #

Ord a => Ord1 (K * a) Source #

Since: 0.2.4.0

Methods

liftCompare :: (a -> b -> Ordering) -> K * a a -> K * a b -> Ordering #

Read a => Read1 (K * a) Source #

Since: 0.2.4.0

Methods

liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (K * a a) #

liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [K * a a] #

Show a => Show1 (K * a) Source #

Since: 0.2.4.0

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> K * a a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [K * a a] -> ShowS #

Eq a => Eq (K k a b) Source # 

Methods

(==) :: K k a b -> K k a b -> Bool #

(/=) :: K k a b -> K k a b -> Bool #

Ord a => Ord (K k a b) Source # 

Methods

compare :: K k a b -> K k a b -> Ordering #

(<) :: K k a b -> K k a b -> Bool #

(<=) :: K k a b -> K k a b -> Bool #

(>) :: K k a b -> K k a b -> Bool #

(>=) :: K k a b -> K k a b -> Bool #

max :: K k a b -> K k a b -> K k a b #

min :: K k a b -> K k a b -> K k a b #

Read a => Read (K k a b) Source # 

Methods

readsPrec :: Int -> ReadS (K k a b) #

readList :: ReadS [K k a b] #

readPrec :: ReadPrec (K k a b) #

readListPrec :: ReadPrec [K k a b] #

Show a => Show (K k a b) Source # 

Methods

showsPrec :: Int -> K k a b -> ShowS #

show :: K k a b -> String #

showList :: [K k a b] -> ShowS #

Generic (K k a b) Source # 

Associated Types

type Rep (K k a b) :: * -> * #

Methods

from :: K k a b -> Rep (K k a b) x #

to :: Rep (K k a b) x -> K k a b #

NFData a => NFData (K k a b) Source #

Since: 0.2.5.0

Methods

rnf :: K k a b -> () #

type Rep (K k a b) Source # 
type Rep (K k a b) = D1 (MetaData "K" "Generics.SOP.BasicFunctors" "generics-sop-0.3.1.0-EVU7jhdnxwRF3s3P6mpp3P" True) (C1 (MetaCons "K" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)))
type DatatypeInfoOf (K * a0 b0) Source # 
type DatatypeInfoOf (K * a0 b0) = Newtype "Generics.SOP.BasicFunctors" "K" (Constructor "K")
type Code (K * a0 b0) Source # 
type Code (K * a0 b0) = (:) [*] ((:) * a0 ([] *)) ([] [*])

unK :: K a b -> a Source #

Extract the contents of a K value.

newtype I a Source #

The identity type functor.

Like Identity, but with a shorter name.

Constructors

I a 

Instances

Monad I Source # 

Methods

(>>=) :: I a -> (a -> I b) -> I b #

(>>) :: I a -> I b -> I b #

return :: a -> I a #

fail :: String -> I a #

Functor I Source # 

Methods

fmap :: (a -> b) -> I a -> I b #

(<$) :: a -> I b -> I a #

Applicative I Source # 

Methods

pure :: a -> I a #

(<*>) :: I (a -> b) -> I a -> I b #

(*>) :: I a -> I b -> I b #

(<*) :: I a -> I b -> I a #

Foldable I Source # 

Methods

fold :: Monoid m => I m -> m #

foldMap :: Monoid m => (a -> m) -> I a -> m #

foldr :: (a -> b -> b) -> b -> I a -> b #

foldr' :: (a -> b -> b) -> b -> I a -> b #

foldl :: (b -> a -> b) -> b -> I a -> b #

foldl' :: (b -> a -> b) -> b -> I a -> b #

foldr1 :: (a -> a -> a) -> I a -> a #

foldl1 :: (a -> a -> a) -> I a -> a #

toList :: I a -> [a] #

null :: I a -> Bool #

length :: I a -> Int #

elem :: Eq a => a -> I a -> Bool #

maximum :: Ord a => I a -> a #

minimum :: Ord a => I a -> a #

sum :: Num a => I a -> a #

product :: Num a => I a -> a #

Traversable I Source # 

Methods

traverse :: Applicative f => (a -> f b) -> I a -> f (I b) #

sequenceA :: Applicative f => I (f a) -> f (I a) #

mapM :: Monad m => (a -> m b) -> I a -> m (I b) #

sequence :: Monad m => I (m a) -> m (I a) #

Eq1 I Source #

Since: 0.2.4.0

Methods

liftEq :: (a -> b -> Bool) -> I a -> I b -> Bool #

Ord1 I Source #

Since: 0.2.4.0

Methods

liftCompare :: (a -> b -> Ordering) -> I a -> I b -> Ordering #

Read1 I Source #

Since: 0.2.4.0

Methods

liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (I a) #

liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [I a] #

Show1 I Source #

Since: 0.2.4.0

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> I a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [I a] -> ShowS #

Eq a => Eq (I a) Source # 

Methods

(==) :: I a -> I a -> Bool #

(/=) :: I a -> I a -> Bool #

Ord a => Ord (I a) Source # 

Methods

compare :: I a -> I a -> Ordering #

(<) :: I a -> I a -> Bool #

(<=) :: I a -> I a -> Bool #

(>) :: I a -> I a -> Bool #

(>=) :: I a -> I a -> Bool #

max :: I a -> I a -> I a #

min :: I a -> I a -> I a #

Read a => Read (I a) Source # 

Methods

readsPrec :: Int -> ReadS (I a) #

readList :: ReadS [I a] #

readPrec :: ReadPrec (I a) #

readListPrec :: ReadPrec [I a] #

Show a => Show (I a) Source # 

Methods

showsPrec :: Int -> I a -> ShowS #

show :: I a -> String #

showList :: [I a] -> ShowS #

Generic (I a) Source # 

Associated Types

type Rep (I a) :: * -> * #

Methods

from :: I a -> Rep (I a) x #

to :: Rep (I a) x -> I a #

NFData a => NFData (I a) Source #

Since: 0.2.5.0

Methods

rnf :: I a -> () #

type Rep (I a) Source # 
type Rep (I a) = D1 (MetaData "I" "Generics.SOP.BasicFunctors" "generics-sop-0.3.1.0-EVU7jhdnxwRF3s3P6mpp3P" True) (C1 (MetaCons "I" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)))
type DatatypeInfoOf (I a0) Source # 
type DatatypeInfoOf (I a0) = Newtype "Generics.SOP.BasicFunctors" "I" (Constructor "I")
type Code (I a0) Source # 
type Code (I a0) = (:) [*] ((:) * a0 ([] *)) ([] [*])

unI :: I a -> a Source #

Extract the contents of an I value.

newtype (f :.: g) p infixr 7 Source #

Composition of functors.

Like Compose, but kind-polymorphic and with a shorter name.

Constructors

Comp (f (g p)) 

Instances

(Functor f, Functor g) => Functor ((:.:) * * f g) Source # 

Methods

fmap :: (a -> b) -> (* :.: *) f g a -> (* :.: *) f g b #

(<$) :: a -> (* :.: *) f g b -> (* :.: *) f g a #

(Applicative f, Applicative g) => Applicative ((:.:) * * f g) Source #

Since: 0.2.5.0

Methods

pure :: a -> (* :.: *) f g a #

(<*>) :: (* :.: *) f g (a -> b) -> (* :.: *) f g a -> (* :.: *) f g b #

(*>) :: (* :.: *) f g a -> (* :.: *) f g b -> (* :.: *) f g b #

(<*) :: (* :.: *) f g a -> (* :.: *) f g b -> (* :.: *) f g a #

(Foldable f, Foldable g) => Foldable ((:.:) * * f g) Source #

Since: 0.2.5.0

Methods

fold :: Monoid m => (* :.: *) f g m -> m #

foldMap :: Monoid m => (a -> m) -> (* :.: *) f g a -> m #

foldr :: (a -> b -> b) -> b -> (* :.: *) f g a -> b #

foldr' :: (a -> b -> b) -> b -> (* :.: *) f g a -> b #

foldl :: (b -> a -> b) -> b -> (* :.: *) f g a -> b #

foldl' :: (b -> a -> b) -> b -> (* :.: *) f g a -> b #

foldr1 :: (a -> a -> a) -> (* :.: *) f g a -> a #

foldl1 :: (a -> a -> a) -> (* :.: *) f g a -> a #

toList :: (* :.: *) f g a -> [a] #

null :: (* :.: *) f g a -> Bool #

length :: (* :.: *) f g a -> Int #

elem :: Eq a => a -> (* :.: *) f g a -> Bool #

maximum :: Ord a => (* :.: *) f g a -> a #

minimum :: Ord a => (* :.: *) f g a -> a #

sum :: Num a => (* :.: *) f g a -> a #

product :: Num a => (* :.: *) f g a -> a #

(Traversable f, Traversable g) => Traversable ((:.:) * * f g) Source #

Since: 0.2.5.0

Methods

traverse :: Applicative f => (a -> f b) -> (* :.: *) f g a -> f ((* :.: *) f g b) #

sequenceA :: Applicative f => (* :.: *) f g (f a) -> f ((* :.: *) f g a) #

mapM :: Monad m => (a -> m b) -> (* :.: *) f g a -> m ((* :.: *) f g b) #

sequence :: Monad m => (* :.: *) f g (m a) -> m ((* :.: *) f g a) #

(Eq1 f, Eq1 g) => Eq1 ((:.:) * * f g) Source #

Since: 0.2.4.0

Methods

liftEq :: (a -> b -> Bool) -> (* :.: *) f g a -> (* :.: *) f g b -> Bool #

(Ord1 f, Ord1 g) => Ord1 ((:.:) * * f g) Source #

Since: 0.2.4.0

Methods

liftCompare :: (a -> b -> Ordering) -> (* :.: *) f g a -> (* :.: *) f g b -> Ordering #

(Read1 f, Read1 g) => Read1 ((:.:) * * f g) Source #

Since: 0.2.4.0

Methods

liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS ((* :.: *) f g a) #

liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [(* :.: *) f g a] #

(Show1 f, Show1 g) => Show1 ((:.:) * * f g) Source #

Since: 0.2.4.0

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> (* :.: *) f g a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [(* :.: *) f g a] -> ShowS #

(Eq1 f, Eq1 g, Eq a) => Eq ((:.:) * * f g a) Source # 

Methods

(==) :: (* :.: *) f g a -> (* :.: *) f g a -> Bool #

(/=) :: (* :.: *) f g a -> (* :.: *) f g a -> Bool #

(Ord1 f, Ord1 g, Ord a) => Ord ((:.:) * * f g a) Source # 

Methods

compare :: (* :.: *) f g a -> (* :.: *) f g a -> Ordering #

(<) :: (* :.: *) f g a -> (* :.: *) f g a -> Bool #

(<=) :: (* :.: *) f g a -> (* :.: *) f g a -> Bool #

(>) :: (* :.: *) f g a -> (* :.: *) f g a -> Bool #

(>=) :: (* :.: *) f g a -> (* :.: *) f g a -> Bool #

max :: (* :.: *) f g a -> (* :.: *) f g a -> (* :.: *) f g a #

min :: (* :.: *) f g a -> (* :.: *) f g a -> (* :.: *) f g a #

(Read1 f, Read1 g, Read a) => Read ((:.:) * * f g a) Source # 

Methods

readsPrec :: Int -> ReadS ((* :.: *) f g a) #

readList :: ReadS [(* :.: *) f g a] #

readPrec :: ReadPrec ((* :.: *) f g a) #

readListPrec :: ReadPrec [(* :.: *) f g a] #

(Show1 f, Show1 g, Show a) => Show ((:.:) * * f g a) Source # 

Methods

showsPrec :: Int -> (* :.: *) f g a -> ShowS #

show :: (* :.: *) f g a -> String #

showList :: [(* :.: *) f g a] -> ShowS #

Generic ((:.:) k l f g p) Source # 

Associated Types

type Rep ((:.:) k l f g p) :: * -> * #

Methods

from :: (k :.: l) f g p -> Rep ((k :.: l) f g p) x #

to :: Rep ((k :.: l) f g p) x -> (k :.: l) f g p #

NFData (f (g a)) => NFData ((:.:) k l f g a) Source #

Since: 0.2.5.0

Methods

rnf :: (k :.: l) f g a -> () #

type Rep ((:.:) k l f g p) Source # 
type Rep ((:.:) k l f g p) = D1 (MetaData ":.:" "Generics.SOP.BasicFunctors" "generics-sop-0.3.1.0-EVU7jhdnxwRF3s3P6mpp3P" True) (C1 (MetaCons "Comp" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (f (g p)))))
type DatatypeInfoOf ((:.:) * * f0 g0 p0) Source # 
type DatatypeInfoOf ((:.:) * * f0 g0 p0) = Newtype "Generics.SOP.BasicFunctors" ":.:" (Constructor "Comp")
type Code ((:.:) * * f0 g0 p0) Source # 
type Code ((:.:) * * f0 g0 p0) = (:) [*] ((:) * (f0 (g0 p0)) ([] *)) ([] [*])

unComp :: (f :.: g) p -> f (g p) Source #

Extract the contents of a Comp value.

Mapping functions

mapII :: (a -> b) -> I a -> I b Source #

Lift the given function.

Since: 0.2.5.0

mapIK :: (a -> b) -> I a -> K b c Source #

Lift the given function.

Since: 0.2.5.0

mapKI :: (a -> b) -> K a c -> I b Source #

Lift the given function.

Since: 0.2.5.0

mapKK :: (a -> b) -> K a c -> K b d Source #

Lift the given function.

Since: 0.2.5.0

mapIII :: (a -> b -> c) -> I a -> I b -> I c Source #

Lift the given function.

Since: 0.2.5.0

mapIIK :: (a -> b -> c) -> I a -> I b -> K c d Source #

Lift the given function.

Since: 0.2.5.0

mapIKI :: (a -> b -> c) -> I a -> K b d -> I c Source #

Lift the given function.

Since: 0.2.5.0

mapIKK :: (a -> b -> c) -> I a -> K b d -> K c e Source #

Lift the given function.

Since: 0.2.5.0

mapKII :: (a -> b -> c) -> K a d -> I b -> I c Source #

Lift the given function.

Since: 0.2.5.0

mapKIK :: (a -> b -> c) -> K a d -> I b -> K c e Source #

Lift the given function.

Since: 0.2.5.0

mapKKI :: (a -> b -> c) -> K a d -> K b e -> I c Source #

Lift the given function.

Since: 0.2.5.0

mapKKK :: (a -> b -> c) -> K a d -> K b e -> K c f Source #

Lift the given function.

Since: 0.2.5.0

Mapping constraints

class (AllF f xs, SListI xs) => All f xs Source #

Require a constraint for every element of a list.

If you have a datatype that is indexed over a type-level list, then you can use All to indicate that all elements of that type-level list must satisfy a given constraint.

Example: The constraint

All Eq '[ Int, Bool, Char ]

is equivalent to the constraint

(Eq Int, Eq Bool, Eq Char)

Example: A type signature such as

f :: All Eq xs => NP I xs -> ...

means that f can assume that all elements of the n-ary product satisfy Eq.

Instances

(AllF k f xs, SListI k xs) => All k f xs Source # 

class (AllF (All f) xss, SListI xss) => All2 f xss Source #

Require a constraint for every element of a list of lists.

If you have a datatype that is indexed over a type-level list of lists, then you can use All2 to indicate that all elements of the innert lists must satisfy a given constraint.

Example: The constraint

All2 Eq '[ '[ Int ], '[ Bool, Char ] ]

is equivalent to the constraint

(Eq Int, Eq Bool, Eq Char)

Example: A type signature such as

f :: All2 Eq xss => SOP I xs -> ...

means that f can assume that all elements of the sum of product satisfy Eq.

Instances

(AllF [k] (All k f) xss, SListI [k] xss) => All2 k f xss Source # 

class (SListI xs, SListI ys, SameShapeAs xs ys, SameShapeAs ys xs, AllZipF c xs ys) => AllZip c xs ys Source #

Require a constraint for pointwise for every pair of elements from two lists.

Example: The constraint

All (~) '[ Int, Bool, Char ] '[ a, b, c ]

is equivalent to the constraint

(Int ~ a, Bool ~ b, Char ~ c)

Since: 0.3.1.0

Instances

(SListI a xs, SListI b ys, SameShapeAs b a xs ys, SameShapeAs a b ys xs, AllZipF b a c xs ys) => AllZip b a c xs ys Source # 

class (AllZipF (AllZip f) xss yss, SListI xss, SListI yss, SameShapeAs xss yss, SameShapeAs yss xss) => AllZip2 f xss yss Source #

Require a constraint for pointwise for every pair of elements from two lists of lists.

Instances

(AllZipF [b] [a] (AllZip b a f) xss yss, SListI [a] xss, SListI [b] yss, SameShapeAs [b] [a] xss yss, SameShapeAs [a] [b] yss xss) => AllZip2 b a f xss yss Source # 

type family AllN (h :: (k -> *) -> l -> *) (c :: k -> Constraint) :: l -> Constraint Source #

A generalization of All and All2.

The family AllN expands to All or All2 depending on whether the argument is indexed by a list or a list of lists.

Instances

type AllN [[k]] k (POP k) c Source # 
type AllN [[k]] k (POP k) c = All2 k c
type AllN [k] k (NP k) c Source # 
type AllN [k] k (NP k) c = All k c

type family AllZipN (h :: (k -> *) -> l -> *) (c :: k1 -> k2 -> Constraint) :: l1 -> l2 -> Constraint Source #

A generalization of AllZip and AllZip2.

The family AllZipN expands to AllZip or AllZip2 depending on whther the argument is indexed by a list or a list of lists.

Instances

type AllZipN [[b]] [[a]] b a [[k]] k (POP k) c Source # 
type AllZipN [[b]] [[a]] b a [[k]] k (POP k) c = AllZip2 b a c
type AllZipN [b] [a] b a [k] k (NP k) c Source # 
type AllZipN [b] [a] b a [k] k (NP k) c = AllZip b a c

Other constraints

class f (g x) => Compose f g x infixr 9 Source #

Composition of constraints.

Note that the result of the composition must be a constraint, and therefore, in f :. g, the kind of f is k -> Constraint. The kind of g, however, is l -> k and can thus be an normal type constructor.

A typical use case is in connection with All on an NP or an NS. For example, in order to denote that all elements on an NP f xs satisfy Show, we can say All (Show :. f) xs.

Since: 0.2

Instances

f (g x) => Compose k k1 f g x Source # 

class (f x, g x) => And f g x infixl 7 Source #

Pairing of constraints.

Since: 0.2

Instances

(f x, g x) => And k f g x Source # 

class Top x Source #

A constraint that can always be satisfied.

Since: 0.2

Instances

Top k x Source # 

class Coercible (f x) (g y) => LiftedCoercible f g x y Source #

The constraint LiftedCoercible f g x y is equivalent to Coercible (f x) (g y).

Since: 0.3.1.0

Instances

Coercible k1 (f x) (g y) => LiftedCoercible k k1 k2 f g x y Source # 

type family SameShapeAs (xs :: [a]) (ys :: [b]) :: Constraint where ... Source #

Type family that forces a type-level list to be of the same shape as the given type-level list.

The main use of this constraint is to help type inference to learn something about otherwise unknown type-level lists.

Since: 0.3.1.0

Equations

SameShapeAs '[] ys = ys ~ '[] 
SameShapeAs (x ': xs) ys = (ys ~ (Head ys ': Tail ys), SameShapeAs xs (Tail ys)) 

Singletons

data SList :: [k] -> * where Source #

Explicit singleton list.

A singleton list can be used to reveal the structure of a type-level list argument that the function is quantified over. For every type-level list xs, there is one non-bottom value of type SList xs.

Note that these singleton lists are polymorphic in the list elements; we do not require a singleton representation for them.

Since: 0.2

Constructors

SNil :: SList '[] 
SCons :: SListI xs => SList (x ': xs) 

Instances

Eq (SList k xs) Source # 

Methods

(==) :: SList k xs -> SList k xs -> Bool #

(/=) :: SList k xs -> SList k xs -> Bool #

Ord (SList k xs) Source # 

Methods

compare :: SList k xs -> SList k xs -> Ordering #

(<) :: SList k xs -> SList k xs -> Bool #

(<=) :: SList k xs -> SList k xs -> Bool #

(>) :: SList k xs -> SList k xs -> Bool #

(>=) :: SList k xs -> SList k xs -> Bool #

max :: SList k xs -> SList k xs -> SList k xs #

min :: SList k xs -> SList k xs -> SList k xs #

Show (SList k xs) Source # 

Methods

showsPrec :: Int -> SList k xs -> ShowS #

show :: SList k xs -> String #

showList :: [SList k xs] -> ShowS #

class SListI xs where Source #

Implicit singleton list.

A singleton list can be used to reveal the structure of a type-level list argument that the function is quantified over.

The class SListI should have instances that match the constructors of SList.

Since: 0.2

Minimal complete definition

sList

Methods

sList :: SList xs Source #

Get hold of the explicit singleton (that one can then pattern match on).

Instances

SListI k ([] k) Source # 

Methods

sList :: SList [k] xs Source #

SListI k xs => SListI k ((:) k x xs) Source # 

Methods

sList :: SList ((k ': x) xs) xs Source #

type SListI2 = All SListI Source #

Require a singleton for every inner list in a list of lists.

type Sing = SList Source #

Deprecated: Use SList instead.

Explicit singleton type.

Just provided for limited backward compatibility.

class SListI xs => SingI xs where Source #

Deprecated: Use SListI instead.

General class for implicit singletons.

Just provided for limited backward compatibility.

Minimal complete definition

sing

Methods

sing :: Sing xs Source #

Deprecated: Use sList instead.

Shape of type-level lists

data Shape :: [k] -> * where Source #

Occassionally it is useful to have an explicit, term-level, representation of type-level lists (esp because of https://ghc.haskell.org/trac/ghc/ticket/9108)

Constructors

ShapeNil :: Shape '[] 
ShapeCons :: SListI xs => Shape xs -> Shape (x ': xs) 

Instances

Eq (Shape k xs) Source # 

Methods

(==) :: Shape k xs -> Shape k xs -> Bool #

(/=) :: Shape k xs -> Shape k xs -> Bool #

Ord (Shape k xs) Source # 

Methods

compare :: Shape k xs -> Shape k xs -> Ordering #

(<) :: Shape k xs -> Shape k xs -> Bool #

(<=) :: Shape k xs -> Shape k xs -> Bool #

(>) :: Shape k xs -> Shape k xs -> Bool #

(>=) :: Shape k xs -> Shape k xs -> Bool #

max :: Shape k xs -> Shape k xs -> Shape k xs #

min :: Shape k xs -> Shape k xs -> Shape k xs #

Show (Shape k xs) Source # 

Methods

showsPrec :: Int -> Shape k xs -> ShowS #

show :: Shape k xs -> String #

showList :: [Shape k xs] -> ShowS #

shape :: forall xs. SListI xs => Shape xs Source #

The shape of a type-level list.

lengthSList :: forall xs proxy. SListI xs => proxy xs -> Int Source #

The length of a type-level list.

Since: 0.2

lengthSing :: SListI xs => proxy xs -> Int Source #

Deprecated: Use lengthSList instead.

Old name for lengthSList.

Re-exports

data Proxy k t :: forall k. k -> * #

A concrete, poly-kinded proxy type

Constructors

Proxy 

Instances

Monad (Proxy *) 

Methods

(>>=) :: Proxy * a -> (a -> Proxy * b) -> Proxy * b #

(>>) :: Proxy * a -> Proxy * b -> Proxy * b #

return :: a -> Proxy * a #

fail :: String -> Proxy * a #

Functor (Proxy *) 

Methods

fmap :: (a -> b) -> Proxy * a -> Proxy * b #

(<$) :: a -> Proxy * b -> Proxy * a #

Applicative (Proxy *) 

Methods

pure :: a -> Proxy * a #

(<*>) :: Proxy * (a -> b) -> Proxy * a -> Proxy * b #

(*>) :: Proxy * a -> Proxy * b -> Proxy * b #

(<*) :: Proxy * a -> Proxy * b -> Proxy * a #

Foldable (Proxy *) 

Methods

fold :: Monoid m => Proxy * m -> m #

foldMap :: Monoid m => (a -> m) -> Proxy * a -> m #

foldr :: (a -> b -> b) -> b -> Proxy * a -> b #

foldr' :: (a -> b -> b) -> b -> Proxy * a -> b #

foldl :: (b -> a -> b) -> b -> Proxy * a -> b #

foldl' :: (b -> a -> b) -> b -> Proxy * a -> b #

foldr1 :: (a -> a -> a) -> Proxy * a -> a #

foldl1 :: (a -> a -> a) -> Proxy * a -> a #

toList :: Proxy * a -> [a] #

null :: Proxy * a -> Bool #

length :: Proxy * a -> Int #

elem :: Eq a => a -> Proxy * a -> Bool #

maximum :: Ord a => Proxy * a -> a #

minimum :: Ord a => Proxy * a -> a #

sum :: Num a => Proxy * a -> a #

product :: Num a => Proxy * a -> a #

Traversable (Proxy *) 

Methods

traverse :: Applicative f => (a -> f b) -> Proxy * a -> f (Proxy * b) #

sequenceA :: Applicative f => Proxy * (f a) -> f (Proxy * a) #

mapM :: Monad m => (a -> m b) -> Proxy * a -> m (Proxy * b) #

sequence :: Monad m => Proxy * (m a) -> m (Proxy * a) #

Generic1 (Proxy *) 

Associated Types

type Rep1 (Proxy * :: * -> *) :: * -> * #

Methods

from1 :: Proxy * a -> Rep1 (Proxy *) a #

to1 :: Rep1 (Proxy *) a -> Proxy * a #

Eq1 (Proxy *)

Since: 4.9.0.0

Methods

liftEq :: (a -> b -> Bool) -> Proxy * a -> Proxy * b -> Bool #

Ord1 (Proxy *)

Since: 4.9.0.0

Methods

liftCompare :: (a -> b -> Ordering) -> Proxy * a -> Proxy * b -> Ordering #

Read1 (Proxy *)

Since: 4.9.0.0

Methods

liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Proxy * a) #

liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [Proxy * a] #

Show1 (Proxy *)

Since: 4.9.0.0

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Proxy * a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Proxy * a] -> ShowS #

Alternative (Proxy *) 

Methods

empty :: Proxy * a #

(<|>) :: Proxy * a -> Proxy * a -> Proxy * a #

some :: Proxy * a -> Proxy * [a] #

many :: Proxy * a -> Proxy * [a] #

MonadPlus (Proxy *) 

Methods

mzero :: Proxy * a #

mplus :: Proxy * a -> Proxy * a -> Proxy * a #

Bounded (Proxy k s) 

Methods

minBound :: Proxy k s #

maxBound :: Proxy k s #

Enum (Proxy k s) 

Methods

succ :: Proxy k s -> Proxy k s #

pred :: Proxy k s -> Proxy k s #

toEnum :: Int -> Proxy k s #

fromEnum :: Proxy k s -> Int #

enumFrom :: Proxy k s -> [Proxy k s] #

enumFromThen :: Proxy k s -> Proxy k s -> [Proxy k s] #

enumFromTo :: Proxy k s -> Proxy k s -> [Proxy k s] #

enumFromThenTo :: Proxy k s -> Proxy k s -> Proxy k s -> [Proxy k s] #

Eq (Proxy k s) 

Methods

(==) :: Proxy k s -> Proxy k s -> Bool #

(/=) :: Proxy k s -> Proxy k s -> Bool #

Data t => Data (Proxy * t) 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Proxy * t -> c (Proxy * t) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Proxy * t) #

toConstr :: Proxy * t -> Constr #

dataTypeOf :: Proxy * t -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Proxy * t)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Proxy * t)) #

gmapT :: (forall b. Data b => b -> b) -> Proxy * t -> Proxy * t #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Proxy * t -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Proxy * t -> r #

gmapQ :: (forall d. Data d => d -> u) -> Proxy * t -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Proxy * t -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Proxy * t -> m (Proxy * t) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Proxy * t -> m (Proxy * t) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Proxy * t -> m (Proxy * t) #

Ord (Proxy k s) 

Methods

compare :: Proxy k s -> Proxy k s -> Ordering #

(<) :: Proxy k s -> Proxy k s -> Bool #

(<=) :: Proxy k s -> Proxy k s -> Bool #

(>) :: Proxy k s -> Proxy k s -> Bool #

(>=) :: Proxy k s -> Proxy k s -> Bool #

max :: Proxy k s -> Proxy k s -> Proxy k s #

min :: Proxy k s -> Proxy k s -> Proxy k s #

Read (Proxy k s) 
Show (Proxy k s) 

Methods

showsPrec :: Int -> Proxy k s -> ShowS #

show :: Proxy k s -> String #

showList :: [Proxy k s] -> ShowS #

Ix (Proxy k s) 

Methods

range :: (Proxy k s, Proxy k s) -> [Proxy k s] #

index :: (Proxy k s, Proxy k s) -> Proxy k s -> Int #

unsafeIndex :: (Proxy k s, Proxy k s) -> Proxy k s -> Int

inRange :: (Proxy k s, Proxy k s) -> Proxy k s -> Bool #

rangeSize :: (Proxy k s, Proxy k s) -> Int #

unsafeRangeSize :: (Proxy k s, Proxy k s) -> Int

Generic (Proxy k t) 

Associated Types

type Rep (Proxy k t) :: * -> * #

Methods

from :: Proxy k t -> Rep (Proxy k t) x #

to :: Rep (Proxy k t) x -> Proxy k t #

Semigroup (Proxy k s) 

Methods

(<>) :: Proxy k s -> Proxy k s -> Proxy k s #

sconcat :: NonEmpty (Proxy k s) -> Proxy k s #

stimes :: Integral b => b -> Proxy k s -> Proxy k s #

Monoid (Proxy k s) 

Methods

mempty :: Proxy k s #

mappend :: Proxy k s -> Proxy k s -> Proxy k s #

mconcat :: [Proxy k s] -> Proxy k s #

NFData (Proxy k a)

Since: 1.4.0.0

Methods

rnf :: Proxy k a -> () #

type Rep1 (Proxy *) 
type Rep1 (Proxy *) = D1 (MetaData "Proxy" "Data.Proxy" "base" False) (C1 (MetaCons "Proxy" PrefixI False) U1)
type Rep (Proxy k t) 
type Rep (Proxy k t) = D1 (MetaData "Proxy" "Data.Proxy" "base" False) (C1 (MetaCons "Proxy" PrefixI False) U1)
type DatatypeInfoOf (Proxy * t0) Source # 
type DatatypeInfoOf (Proxy * t0) = ADT "Data.Proxy" "Proxy" ((:) ConstructorInfo (Constructor "Proxy") ([] ConstructorInfo))
type Code (Proxy * t0) Source # 
type Code (Proxy * t0) = (:) [*] ([] *) ([] [*])