Safe Haskell | None |
---|---|
Language | Haskell2010 |
Conventions:
* fooCell: a function that applies to Cell
s directly
* fooCell': a function, very similar to fooCell but
that applies to a type which wraps a Cell
using
an instance of HasCell
* fooCell1: a function that applies to Cell1
* fooCell1': a function that a applies to a wrapped Cell1
(depends on HasCell
)
- type Cell = Cell1 Identity
- data Cell1 f constr = forall a . (constr a, Typeable a) => Cell (f a)
- class HasCell a b | a -> b where
- makeCell :: (HasCell a (Cell constr), constr b, Typeable b) => b -> a
- makeCell1 :: (HasCell a (Cell1 f constr), constr b, Typeable b) => f b -> a
- _Cell :: (constr b, Typeable b, Typeable a) => Prism (Cell constr) (Cell constr) a b
- _Cell' :: (constr a, Typeable a, HasCell c (Cell constr)) => Prism c c a a
- _Cell1 :: (constr b, Typeable b, Typeable a, Typeable f) => Prism (Cell1 f constr) (Cell1 f constr) (f a) (f b)
- _Cell1' :: (constr a, Typeable a, Typeable f, HasCell c (Cell1 f constr)) => Prism c c (f a) (f a)
- asCell :: (constr a, Typeable a) => Prism (Cell constr) (Cell constr) a a
- asCell1 :: (constr a, Typeable a, Typeable f) => Prism (Cell1 f constr) (Cell1 f constr) (f a) (f a)
- traverseCell :: Functor f => (forall a. (constr a, Typeable a) => a -> f a) -> Cell constr -> f (Cell constr)
- traverseCell' :: (Functor f, HasCell c (Cell constr)) => (forall a. (constr a, Typeable a) => a -> f a) -> c -> f c
- traverseCell1 :: Functor f => (forall a. (constr a, Typeable a) => g a -> f (h a)) -> Cell1 g constr -> f (Cell1 h constr)
- traverseCell1' :: (Functor f, HasCell c (Cell1 g constr)) => (forall a. (constr a, Typeable a) => g a -> f (g a)) -> c -> f c
- mapCell :: (forall a. (constr a, Typeable a) => a -> a) -> Cell constr -> Cell constr
- mapCell' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> a) -> c -> c
- readCell1 :: (forall a. (constr a, Typeable a) => f a -> r) -> Cell1 f constr -> r
- readCell1' :: HasCell c (Cell1 f constr) => (forall a. (constr a, Typeable a) => f a -> r) -> c -> r
- readCell :: (forall a. (constr a, Typeable a) => a -> r) -> Cell constr -> r
- readCell' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> r) -> c -> r
- apply2Cells :: Functor f => (forall a. (constr a, Typeable a) => a -> a -> f a) -> f (Cell constr) -> Cell constr -> Cell constr -> f (Cell constr)
- apply2Cells' :: (Functor f, HasCell c (Cell constr)) => (forall a. (constr a, Typeable a) => a -> a -> f a) -> f c -> c -> c -> f c
- apply2Cells1 :: (Functor f, Typeable g) => (forall a. (constr a, Typeable a) => g a -> g a -> f (g a)) -> f (Cell1 g constr) -> Cell1 g constr -> Cell1 g constr -> f (Cell1 g constr)
- apply2Cells1' :: (Functor f, Typeable g, HasCell c (Cell1 g constr)) => (forall a. (constr a, Typeable a) => g a -> g a -> f (g a)) -> f c -> c -> c -> f c
- map2Cells :: (forall a. (constr a, Typeable a) => a -> a -> a) -> Cell constr -> Cell constr -> Cell constr -> Cell constr
- map2Cells' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> a -> a) -> c -> c -> c -> c
- map2Cells1 :: (forall a. (constr a, Typeable a) => a -> a -> a) -> Cell constr -> Cell constr -> Cell constr -> Cell constr
- map2Cells1' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> a -> a) -> c -> c -> c -> c
- read2CellsWith :: (forall a. (constr a, Typeable a) => a -> a -> r) -> r -> Cell constr -> Cell constr -> r
- read2CellsWith' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> a -> r) -> r -> c -> c -> r
- read2Cells1With :: Typeable f => (forall a. (constr a, Typeable a) => f a -> f a -> r) -> r -> Cell1 f constr -> Cell1 f constr -> r
- read2Cells1With' :: (HasCell c (Cell1 f constr), Typeable f) => (forall a. (constr a, Typeable a) => f a -> f a -> r) -> r -> c -> c -> r
- read2CellsH :: (forall a b. (constr a, Typeable a, constr b, Typeable b) => a -> b -> r) -> Cell constr -> Cell constr -> r
- read2CellsH' :: HasCell c (Cell constr) => (forall a b. (constr a, Typeable a, constr b, Typeable b) => a -> b -> r) -> c -> c -> r
- read2Cells1H :: (forall a b. (constr a, Typeable a, constr b, Typeable b) => f a -> f b -> r) -> Cell1 f constr -> Cell1 f constr -> r
- read2Cells1H' :: (forall a b. (constr a, Typeable a, constr b, Typeable b) => f a -> f b -> r) -> Cell1 f constr -> Cell1 f constr -> r
- cell1Equal :: Typeable f => (forall a. constr a => f a -> f a -> Bool) -> Cell1 f constr -> Cell1 f constr -> Bool
- cell1Equal' :: (HasCell c (Cell1 f constr), Typeable f) => (forall a. constr a => f a -> f a -> Bool) -> c -> c -> Bool
- cellEqual :: (forall a. constr a => a -> a -> Bool) -> Cell constr -> Cell constr -> Bool
- cellEqual' :: HasCell c (Cell constr) => (forall a. constr a => a -> a -> Bool) -> c -> c -> Bool
- cellCompare :: (forall a. constr a => a -> a -> Ordering) -> Cell constr -> Cell constr -> Ordering
- cellCompare' :: HasCell c (Cell constr) => (forall a. constr a => a -> a -> Ordering) -> c -> c -> Ordering
- cell1Compare :: Typeable f => (forall a. constr a => f a -> f a -> Ordering) -> Cell1 f constr -> Cell1 f constr -> Ordering
- cell1Compare' :: (HasCell c (Cell1 f constr), Typeable f) => (forall a. constr a => f a -> f a -> Ordering) -> c -> c -> Ordering
- cellLens :: Functor f => (forall a. constr a => LensLike' f a b) -> LensLike' f (Cell constr) b
- cellLens' :: (HasCell c (Cell constr), Functor f) => (forall a. constr a => LensLike' f a b) -> LensLike' f c b
- cell1Lens :: Functor f => (forall a. constr a => LensLike' f (g a) b) -> LensLike' f (Cell1 g constr) b
- cell1Lens' :: (HasCell c (Cell1 g constr), Functor f) => (forall a. constr a => LensLike' f (g a) b) -> LensLike' f c b
- arbitraryCell :: Name -> ExpQ
- arbitraryCell' :: Name -> [TypeQ] -> ExpQ
- arbitraryInstanceOf :: Name -> Name -> ExpQ
- arbitraryInstanceOf' :: Name -> Name -> [TypeQ] -> ExpQ
- onIdentity :: (a -> b -> c) -> Identity a -> Identity b -> c
- prop_consistent_equal :: (Eq a, Typeable a) => a -> a -> Property
- prop_consistent_compare :: (Ord a, Typeable a) => a -> a -> Property
- run_tests :: IO Bool
Documentation
Generilization of Cell
. 'Cell1 MyFunctor MyClass' takes values
^ of type 'MyFunctor a' with '(MyClass a,Typeable a)'.
_Cell :: (constr b, Typeable b, Typeable a) => Prism (Cell constr) (Cell constr) a b Source
Prisms
Treats a Cell
as an unbounded sum type: 'c^?_Cell :: Maybe a' has the
^ value 'Just x' if x is of type a
and c
contains value x
. If cell c
^ has a value of any other type then a
, 'c^?_Cell == Nothing'.
_Cell' :: (constr a, Typeable a, HasCell c (Cell constr)) => Prism c c a a Source
Similar to _Cell
but operates on types that wrap a cell instead of
^ on the cell itself.
_Cell1 :: (constr b, Typeable b, Typeable a, Typeable f) => Prism (Cell1 f constr) (Cell1 f constr) (f a) (f b) Source
Similar to _Cell
but values are wrapped in type f
inside the cell.
_Cell1' :: (constr a, Typeable a, Typeable f, HasCell c (Cell1 f constr)) => Prism c c (f a) (f a) Source
asCell :: (constr a, Typeable a) => Prism (Cell constr) (Cell constr) a a Source
Like _Cell
but disallows changing the type of the content of the cell.
^ facilitates type checking when the prism is not used for modification.
asCell1 :: (constr a, Typeable a, Typeable f) => Prism (Cell1 f constr) (Cell1 f constr) (f a) (f a) Source
traverseCell :: Functor f => (forall a. (constr a, Typeable a) => a -> f a) -> Cell constr -> f (Cell constr) Source
Traversals
traverseCell' :: (Functor f, HasCell c (Cell constr)) => (forall a. (constr a, Typeable a) => a -> f a) -> c -> f c Source
traverseCell1 :: Functor f => (forall a. (constr a, Typeable a) => g a -> f (h a)) -> Cell1 g constr -> f (Cell1 h constr) Source
traverseCell1' :: (Functor f, HasCell c (Cell1 g constr)) => (forall a. (constr a, Typeable a) => g a -> f (g a)) -> c -> f c Source
mapCell' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> a) -> c -> c Source
readCell1' :: HasCell c (Cell1 f constr) => (forall a. (constr a, Typeable a) => f a -> r) -> c -> r Source
readCell' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> r) -> c -> r Source
apply2Cells :: Functor f => (forall a. (constr a, Typeable a) => a -> a -> f a) -> f (Cell constr) -> Cell constr -> Cell constr -> f (Cell constr) Source
Combinators =
apply2Cells' :: (Functor f, HasCell c (Cell constr)) => (forall a. (constr a, Typeable a) => a -> a -> f a) -> f c -> c -> c -> f c Source
apply2Cells1 :: (Functor f, Typeable g) => (forall a. (constr a, Typeable a) => g a -> g a -> f (g a)) -> f (Cell1 g constr) -> Cell1 g constr -> Cell1 g constr -> f (Cell1 g constr) Source
apply2Cells1' :: (Functor f, Typeable g, HasCell c (Cell1 g constr)) => (forall a. (constr a, Typeable a) => g a -> g a -> f (g a)) -> f c -> c -> c -> f c Source
map2Cells :: (forall a. (constr a, Typeable a) => a -> a -> a) -> Cell constr -> Cell constr -> Cell constr -> Cell constr Source
map2Cells' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> a -> a) -> c -> c -> c -> c Source
map2Cells1 :: (forall a. (constr a, Typeable a) => a -> a -> a) -> Cell constr -> Cell constr -> Cell constr -> Cell constr Source
map2Cells1' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> a -> a) -> c -> c -> c -> c Source
read2CellsWith :: (forall a. (constr a, Typeable a) => a -> a -> r) -> r -> Cell constr -> Cell constr -> r Source
read2CellsWith' :: HasCell c (Cell constr) => (forall a. (constr a, Typeable a) => a -> a -> r) -> r -> c -> c -> r Source
read2Cells1With :: Typeable f => (forall a. (constr a, Typeable a) => f a -> f a -> r) -> r -> Cell1 f constr -> Cell1 f constr -> r Source
read2Cells1With' :: (HasCell c (Cell1 f constr), Typeable f) => (forall a. (constr a, Typeable a) => f a -> f a -> r) -> r -> c -> c -> r Source
read2CellsH :: (forall a b. (constr a, Typeable a, constr b, Typeable b) => a -> b -> r) -> Cell constr -> Cell constr -> r Source
Heterogenous Combinators
read2CellsH' :: HasCell c (Cell constr) => (forall a b. (constr a, Typeable a, constr b, Typeable b) => a -> b -> r) -> c -> c -> r Source
read2Cells1H :: (forall a b. (constr a, Typeable a, constr b, Typeable b) => f a -> f b -> r) -> Cell1 f constr -> Cell1 f constr -> r Source
read2Cells1H' :: (forall a b. (constr a, Typeable a, constr b, Typeable b) => f a -> f b -> r) -> Cell1 f constr -> Cell1 f constr -> r Source
cell1Equal :: Typeable f => (forall a. constr a => f a -> f a -> Bool) -> Cell1 f constr -> Cell1 f constr -> Bool Source
Comparing the content of cells
cell1Equal' :: (HasCell c (Cell1 f constr), Typeable f) => (forall a. constr a => f a -> f a -> Bool) -> c -> c -> Bool Source
cellEqual' :: HasCell c (Cell constr) => (forall a. constr a => a -> a -> Bool) -> c -> c -> Bool Source
cellCompare :: (forall a. constr a => a -> a -> Ordering) -> Cell constr -> Cell constr -> Ordering Source
cellCompare' :: HasCell c (Cell constr) => (forall a. constr a => a -> a -> Ordering) -> c -> c -> Ordering Source
cell1Compare :: Typeable f => (forall a. constr a => f a -> f a -> Ordering) -> Cell1 f constr -> Cell1 f constr -> Ordering Source
cell1Compare' :: (HasCell c (Cell1 f constr), Typeable f) => (forall a. constr a => f a -> f a -> Ordering) -> c -> c -> Ordering Source
cellLens :: Functor f => (forall a. constr a => LensLike' f a b) -> LensLike' f (Cell constr) b Source
Creating Lenses
cellLens' :: (HasCell c (Cell constr), Functor f) => (forall a. constr a => LensLike' f a b) -> LensLike' f c b Source
cell1Lens :: Functor f => (forall a. constr a => LensLike' f (g a) b) -> LensLike' f (Cell1 g constr) b Source
cell1Lens' :: (HasCell c (Cell1 g constr), Functor f) => (forall a. constr a => LensLike' f (g a) b) -> LensLike' f c b Source
arbitraryCell :: Name -> ExpQ Source
QuickCheck Helpers
arbitraryCell' :: Name -> [TypeQ] -> ExpQ Source
arbitraryInstanceOf :: Name -> Name -> ExpQ Source
onIdentity :: (a -> b -> c) -> Identity a -> Identity b -> c Source
prop_consistent_equal :: (Eq a, Typeable a) => a -> a -> Property Source
Properties
Wrapping two values in cells does not change their equality
prop_consistent_compare :: (Ord a, Typeable a) => a -> a -> Property Source
Wrapping two values in cells does not change their relative order