extensible-0.3.5: Extensible, efficient, lens-friendly data types

Copyright(c) Fumiaki Kinoshita 2015
LicenseBSD3
MaintainerFumiaki Kinoshita <fumiexcel@gmail.com>
Stabilityexperimental
Portabilitynon-portable
Safe HaskellTrustworthy
LanguageHaskell2010

Data.Extensible.Product

Contents

Description

 

Synopsis

Basic operations

data h :* s where Source

The type of extensible products.

(:*) :: (k -> *) -> [k] -> *

Constructors

Nil :: h :* [] 
Tree :: !(h x) -> (h :* Half xs) -> (h :* Half (Tail xs)) -> h :* (x : xs) 

Instances

Functor f => Extensible k f (->) ((:*) k) 
Typeable ((k -> *) -> [k] -> *) ((:*) k) 
WrapForall k * Eq h xs => Eq ((:*) k h xs) 
(Eq ((:*) k h xs), WrapForall k * Ord h xs) => Ord ((:*) k h xs) 
WrapForall k * Show h xs => Show ((:*) k h xs) 
WrapForall k * Monoid h xs => Monoid ((:*) k h xs) 

(<:) :: h x -> (h :* xs) -> h :* (x : xs) infixr 0 Source

O(log n) Add an element to a product.

(<:*) :: forall h x xs. h x -> (h :* xs) -> h :* (x : xs) infixr 0 Source

An alias for (<:).

(*++*) :: (h :* xs) -> (h :* ys) -> h :* (xs ++ ys) infixr 0 Source

Combine products.

hhead :: (h :* (x : xs)) -> h x Source

O(1) Extract the head element.

htail :: (h :* (x : xs)) -> h :* xs Source

O(log n) Extract the tail of the product.

huncons :: forall h x xs. (h :* (x : xs)) -> (h x, h :* xs) Source

Split a product to the head and the tail.

hmap :: (forall x. g x -> h x) -> (g :* xs) -> h :* xs Source

Transform every elements in a product, preserving the order.

hmap idid
hmap (f . g) ≡ hmap f . hmap g

hmapWithIndex :: forall g h xs. (forall x. Membership xs x -> g x -> h x) -> (g :* xs) -> h :* xs Source

htrans :: (forall x. g x -> h (t x)) -> (g :* xs) -> h :* Map t xs Source

Transform every elements in a product, preserving the order.

hzipWith :: (forall x. f x -> g x -> h x) -> (f :* xs) -> (g :* xs) -> h :* xs Source

zipWith for heterogeneous product

hzipWith3 :: (forall x. f x -> g x -> h x -> i x) -> (f :* xs) -> (g :* xs) -> (h :* xs) -> i :* xs Source

zipWith3 for heterogeneous product

hfoldMap :: Monoid a => (forall x. h x -> a) -> (h :* xs) -> a Source

Map elements to a monoid and combine the results.

hfoldMap f . hmap g ≡ hfoldMap (f . g)

htraverse :: Applicative f => (forall x. g x -> f (h x)) -> (g :* xs) -> f (h :* xs) Source

Traverse all elements and combine the result sequentially. htraverse (fmap f . g) ≡ fmap (hmap f) . htraverse g htraverse pure ≡ pure htraverse (Comp . fmap g . f) ≡ Comp . fmap (htraverse g) . htraverse f

htraverseWithIndex :: forall f g h xs. Applicative f => (forall x. Membership xs x -> g x -> f (h x)) -> (g :* xs) -> f (h :* xs) Source

hsequence :: Applicative f => (Comp f h :* xs) -> f (h :* xs) Source

sequence analog for extensible products

hcollect :: (Functor f, Generate xs) => (a -> h :* xs) -> f a -> Comp f h :* xs Source

The dual of htraverse

hdistribute :: (Functor f, Generate xs) => f (h :* xs) -> Comp f h :* xs Source

The dual of hsequence

Lookup

hlookup :: Membership xs x -> (h :* xs) -> h x Source

O(log n) Pick up an elemtnt.

hindex :: (h :* xs) -> Membership xs x -> h x Source

Flipped hlookup

sectorAt :: Functor f => Membership xs x -> (h x -> f (h x)) -> (h :* xs) -> f (h :* xs) Source

Deprecated: Use pieceAt

The legacy name for pieceAt

sector :: (Functor f, x xs) => (h x -> f (h x)) -> (h :* xs) -> f (h :* xs) Source

Deprecated: Use piece

The legacy name for piece

Generation

class Generate xs where Source

Given a function that maps types to values, we can "collect" entities all you want.

Methods

hgenerate :: Applicative f => (forall x. Membership xs x -> f (h x)) -> f (h :* xs) Source

O(n) Generate a product with the given function.

Instances

Generate k ([] k) 
(Generate k (Half k xs), Generate k (Half k (Tail k xs))) => Generate k ((:) k x xs) 

htabulate :: Generate xs => (forall x. Membership xs x -> h x) -> h :* xs Source

Pure version of hgenerate.

hmap f (htabulate g) ≡ htabulate (f . g)
htabulate (hindex m) ≡ m
hindex (htabulate k) ≡ k

class Forall c xs where Source

Guarantees the all elements satisfies the predicate.

Methods

hgenerateFor :: Applicative f => proxy c -> (forall x. c x => Membership xs x -> f (h x)) -> f (h :* xs) Source

O(n) Analogous to hgenerate, but it also supplies a context c x for every elements in xs.

Instances

Forall k c ([] k) 
(c x, Forall k c (Half k xs), Forall k c (Half k (Tail k xs))) => Forall k c ((:) k x xs) 

htabulateFor :: Forall c xs => proxy c -> (forall x. c x => Membership xs x -> h x) -> h :* xs Source

Pure version of hgenerateFor.