HList-0.5.0.0: Heterogeneous lists

Safe HaskellNone
LanguageHaskell2010

Data.HList.Dredge

Description

 

Synopsis

Documentation

toLabelx :: EnsureLabel x y => x -> y Source #

dredge :: (EnsureLabel x (Label k2 l), HSingleton ErrorMessage ErrorMessage [*] (NonUnique * * k2 r v l) (TypesDontMatch * [[*]] [*] * r ns1 vs1 v) ns2 xs, HGuardNonNull ErrorMessage [*] (NamesDontMatch * [[*]] k2 r ns l) ns1, FilterVEq1 [*] v vs1 ns1 ns2, FilterLastEq * * (Label k2 l) ns vs vs1, FilterLastEq * [*] (Label k2 l) ns ns ns1, MapFieldTreeVal r (TryCollectionListTF r) vs, MapFieldTree (TryCollectionListTF r) ns, LabelablePath xs (p v fb) (p r rft), SameLength' [*] * ns vs, SameLength' [*] * ns1 vs1, SameLength' * [*] vs ns, SameLength' * [*] vs1 ns1) => x -> p v fb -> p r rft Source #

Using HListPP syntax for short hand, dredge `foo expands out to something like `path . `to . `foo, with the restriction that there is only one possible `path . `to which leads to the label foo.

For example, if we have the following definitions,

type BVal a = Record '[Tagged "x" a, Tagged "a" Char]
type R a = Record  [Tagged "a" Int, Tagged "b" (BVal a)]
type V a = Variant [Tagged "a" Int, Tagged "b" (BVal a)]
lx = Label :: Label "x"

Then we have:

dredge `x :: Lens (R a) (R b) a b
dredge lx :: Lens (R a) (R b) a b
dredge `x :: Traversal (V a) (V b) a b -- there were only variants along the path we'd get a Prism
dredge lx :: Traversal (V a) (V b) a b
result-type directed operations are supported

There are two ways to access a field with tag a in the R type defined above, but they result in fields with different types being looked up:

`a        :: Lens' (R a) Char
`b . `a   :: Lens' (R a) Int

so provided that the result type is disambiguated by the context, the following two types can happen

dredge `a :: Lens' (R a) Char
dredge `a :: Lens' (R a) Int
TIP & TIC

type indexed collections are allowed along those paths, but as explained in the Labelable instances, only simple optics (Lens' Prism' Traversal' ) are produced. dredgeTI' works better if the target is a TIP or TIC

getSAfromOutputOptic :: (p a fb -> p rs rft) ~ stab => (Proxy (rs :: *) -> Proxy (a :: *) -> stab) -> stab Source #

dredge' :: (SameLength' * [*] vs1 ns1, SameLength' * [*] vs ns, SameLength' [*] * ns1 vs1, SameLength' [*] * ns vs, LabelablePath xs (p a (f a)) (p s (f s)), MapFieldTree (TryCollectionListTF s) ns, MapFieldTreeVal s (TryCollectionListTF s) vs, FilterLastEq * [*] (Label k l) ns ns ns1, FilterLastEq * * (Label k l) ns vs vs1, FilterVEq1 [*] a vs1 ns1 ns2, HGuardNonNull ErrorMessage [*] (NamesDontMatch * [[*]] k s ns l) ns1, HSingleton ErrorMessage ErrorMessage [*] (NonUnique * * k s a l) (TypesDontMatch * [[*]] [*] * s ns1 vs1 a) ns2 xs, EnsureLabel x (Label k l)) => x -> p a (f a) -> p s (f s) Source #

dredge except a simple (s ~ t, a ~ b) optic is produced

dredgeND :: (EnsureLabel x (Label k2 l), HSingleton ErrorMessage ErrorMessage [*] (NonUnique' * k2 r l) (NamesDontMatch * [[*]] k2 r ns l) ns' xs, FilterLastEq * [*] (Label k2 l) ns ns ns', MapFieldTree (TryCollectionListTF r) ns, LabelablePath xs (p a fb) (p r rft)) => x -> p a fb -> p r rft Source #

dredgeND (named directed only) is the same as dredge, except the result type (a) is not used when the label would otherwise be ambiguous. dredgeND might give better type errors, but otherwise there should be no reason to pick it over dredge

dredgeND' :: (LabelablePath xs (p a (f a)) (p s (f s)), MapFieldTree (TryCollectionListTF s) ns, FilterLastEq * [*] (Label k l) ns ns ns', HSingleton ErrorMessage ErrorMessage [*] (NonUnique' * k s l) (NamesDontMatch * [[*]] k s ns l) ns' xs, EnsureLabel x (Label k l)) => x -> p a (f a) -> p s (f s) Source #

dredgeND except a simple (s ~ t, a ~ b) optic is produced

dredgeTI' :: (HSingleton ErrorMessage ErrorMessage [*] (NonUnique' * * s a) (NamesDontMatch * [[*]] * s ns a) ns' xs, FilterLastEq * [*] (Label * a) ns ns ns', MapFieldTree (TryCollectionListTF s) ns, LabelablePath xs (p a (f a)) (p s (f s))) => q a -> p a (f a) -> p s (f s) Source #

The same as dredgeND', except intended for TIP/TICs because the assumption is made that l ~ v for the Tagged l v elements. In other words, ticPrism' and tipyLens' could usually be replaced by

dredgeTI' :: _ => Label a -> Lens'  (TIP s) a
dredgeTI' :: _ => Label a -> Prism' (TIC s) a

where we might have s ~ '[Tagged a a, Tagged b b]

class HSingleton (msgAmb :: m) (msgEmpty :: m2) (ns :: [k]) (p :: k) | ns -> p Source #

HSingleton msg xs x is like '[x] ~ xs if that constraint can hold, otherwise it is Fail msg. See comments on Fail about how its kind varies with ghc version.

Instances

(Fail m1 m3, (~) k (Any k) a) => HSingleton m m1 k m4 m3 ([] k) a Source # 
(Fail m m3, (~) k (Any k) a) => HSingleton m m1 k m3 m4 ((:) k n1 ((:) k n2 n3)) a Source # 
HSingleton m m1 k m3 m4 ((:) k n ([] k)) n Source # 

class HGuardNonNull emptymsg (xs :: [k]) Source #

HGuardNonNull msg xs is like when (null xs) (fail msg)

Instances

Fail k2 msg => HGuardNonNull k2 k1 msg ([] k1) Source # 
HGuardNonNull k2 k1 msg ((:) k1 x xs) Source # 

class ConsTrue (b :: Bool) (x :: k) (xs :: [k]) (r :: [k]) | b x xs -> r, r b -> xs, x xs r -> b Source #

ConsTrue b x xs r is like r = if b then x:xs else xs

Instances

ConsTrue k False x xs xs Source # 
ConsTrue a True x xs ((:) a x xs) Source # 

class FilterLastEq (x :: k) (xs :: [[k]]) (ys :: [m]) (ys' :: [m]) | x xs ys -> ys' Source #

FilterLastEq x xs ys ys' determines ys' such that it contains all of the ys !! i such that last (xs !! i) == x. In other words it is like

ys' = [ y |  (xsElt, y) <- zip xs ys, last xsElt == x ]

Instances

FilterLastEq k m y ([] [k]) ([] m) ([] m) Source # 
(HReverse path ((:) * y' rest), HEq * y y' b, ConsTrue m b z r1 r, FilterLastEq * m y xs zs r1) => FilterLastEq * m y ((:) [*] path xs) ((:) m z zs) r Source # 

class FilterVEq (v :: *) (vs :: [*]) (ns :: [k]) (ns' :: [k]) | v vs ns -> ns' Source #

The same as FilterLastEq except id is used instead of last

Instances

FilterVEq k v ([] *) ([] k) ([] k) Source # 
(HEq * v v' b, ConsTrue k b n ns1 ns2, FilterVEq k v vs ns ns1) => FilterVEq k v ((:) * v' vs) ((:) k n ns) ns2 Source # 

class FilterVEq1 (v :: *) (vs :: [*]) (ns :: [k]) (ns' :: [k]) | v vs ns -> ns' Source #

like FilterVEq, except if there is

Instances

FilterVEq1 k v ([] *) ([] k) ([] k) Source # 
FilterVEq k v ((:) * a ((:) * b c)) ns ns' => FilterVEq1 k v ((:) * a ((:) * b c)) ns ns' Source # 
(~) * v v' => FilterVEq1 k v ((:) * v' ([] *)) ns ns Source # 

class LabelPathEndingWith (r :: *) (l :: k) (path :: [*]) | r l -> path where Source #

LabelPathEndingWith r l path

determines a unique path suitable for hLookupByLabelPath (calling Fail otherwise) through the nested records/variants in r ending with l

Methods

labelPathEndingWith :: proxy r -> Label l -> Label path Source #

Instances

(FieldTree r ns, FilterLastEq * [*] (Label k l) ns ns ns', HSingleton ErrorMessage ErrorMessage [*] (NonUnique' * k r l) (NamesDontMatch * [[*]] k r ns l) ns' path) => LabelPathEndingWith k r l path Source # 

Methods

labelPathEndingWith :: proxy l -> Label r path -> Label [*] path Source #

labelPathEndingWithTD :: forall r l v path vs vs1 ns ns1 ns2. (SameLength ns vs, SameLength ns1 vs1, FieldTree r ns, FieldTreeVal r vs, FilterLastEq (Label l) ns ns ns1, FilterLastEq (Label l) ns vs vs1, FilterVEq1 v vs1 ns1 ns2, HGuardNonNull (NamesDontMatch r ns l) ns1, HSingleton (NonUnique r v l) (TypesDontMatch r ns1 vs1 v) ns2 path) => Proxy r -> Label l -> Proxy v -> Label path Source #

type NamesDontMatch r ns l = (ErrShowType r :$$: (ErrText "has paths" :<>: ErrShowType ns)) :$$: (ErrText "but none which end in the desired label" :<>: ErrShowType l) Source #

type NonUnique' r l = (ErrText "Path ending in label " :<>: ErrShowType l) :$$: (ErrText "is not unique in " :<>: ErrShowType r) Source #

type NonUnique r v l = NonUnique' r l :$$: (ErrText "also considering the v type " :<>: ErrShowType v) Source #

type TypesDontMatch r ns1 vs1 v = ((ErrShowType r :$$: (ErrText "has potential paths with the right labels" :<>: ErrShowType ns1)) :$$: ((ErrText "which point at types" :<>: ErrShowType vs1) :<>: ErrText "respectively")) :$$: (ErrText "but none of these match the desired type" :<>: ErrShowType v) Source #

XXX

let x = 'x'; y = [pun| x |]; z = [pun| y |]
z & dredge (Label :: Label "x") %~ (succ :: Int -> Int)

Should reference this type error, but for whatever reason it doesn't

hLookupByLabelDredge :: (HSingleton ErrorMessage ErrorMessage [*] (NonUnique' * k r2 l) (NamesDontMatch * [[*]] k r2 ns l) ns' ls, FilterLastEq * [*] (Label k l) ns ns ns', MapFieldTree (TryCollectionListTF r2) ns, HasFieldPath False ls (r1 r2) v) => Label k l -> r1 r2 -> v Source #

hLookupByLabelPath :: HasFieldPath False ls r v => Label ls -> r -> v Source #

lookup along a path

>>> let v = mkVariant1 Label (mkVariant1 Label 'r') :: Variant '[Tagged "x" (Variant '[Tagged "y" Char])]
>>> let r = hBuild (hBuild 'r') :: Record '[Tagged "x" (Record '[Tagged "y" Char])]
>>> let p = Label :: Label [Label "x", Label "y"]
>>> let lx = Label :: Label "y"
>>> hLookupByLabelPath p v
Just 'r'
>>> hLookupByLabelPath p r
'r'
>>> hLookupByLabelDredge lx v
Just 'r'
>>> hLookupByLabelDredge lx r
'r'

class LabelablePath (xs :: [*]) apb spt | spt xs -> apb where Source #

hLens'Path labc == hLens' la . hLens' lb . hLens' lc
 where
      la :: Label "a"
      lb :: Label "b"
      lc :: Label "c"
      labc :: Label '["a", "b", "c"]

Minimal complete definition

hLens'Path

Methods

hLens'Path :: Label xs -> apb -> spt Source #

Instances

(~) * x x' => LabelablePath ([] *) x x' Source # 

Methods

hLens'Path :: Label [*] [*] -> x -> x' Source #

(Labelable k1 x r s t a b, (~) * j (p a (f b)), (~) * k2 (p (r s) (f (r t))), (~) LabeledOpticType ty (LabelableTy r), LabeledOpticP ty p, LabeledOpticF ty f, LabeledOpticTo k1 ty x ((->) LiftedRep LiftedRep), LabelablePath xs i j) => LabelablePath ((:) * (Label k1 x) xs) i k2 Source # 

Methods

hLens'Path :: Label [*] ((* ': Label k1 x) xs) -> i -> k2 Source #

class HasFieldPath (needJust :: Bool) (ls :: [*]) r v | needJust ls r -> v where Source #

Minimal complete definition

hLookupByLabelPath1

Methods

hLookupByLabelPath1 :: Proxy needJust -> Label ls -> r -> v Source #

use hLookupByLabelPath instead

Instances

HasFieldPath False ([] *) v v Source # 

Methods

hLookupByLabelPath1 :: Proxy Bool False -> Label [*] [*] -> v -> v Source #

HasFieldPath True ([] *) v (Maybe v) Source # 

Methods

hLookupByLabelPath1 :: Proxy Bool True -> Label [*] [*] -> v -> Maybe v Source #

(HasField k l (Record r) u, HasFieldPath needJust ls u v) => HasFieldPath needJust ((:) * (Label k l) ls) (Record r) v Source # 

Methods

hLookupByLabelPath1 :: Proxy Bool needJust -> Label [*] ((* ': Label k l) ls) -> Record r -> v Source #

(HasField k l (Variant r) (Maybe u), HasFieldPath True ls u (Maybe v)) => HasFieldPath needJust ((:) * (Label k l) ls) (Variant r) (Maybe v) Source # 

Methods

hLookupByLabelPath1 :: Proxy Bool needJust -> Label [*] ((* ': Label k l) ls) -> Variant r -> Maybe v Source #

class FieldTreeVal (r :: *) (v :: [*]) | r -> v Source #

(FieldTree r ns, FieldTreeVal r vs)

defines ns and vs such that looking up path (ns !! i) in r gives the type (vs !! i). This is almost HasFieldPath False (ns !! i) (vs !! i), except there is no additional Maybe when a Variant is encountered along the path (and we don't have a type level !!)

Instances

class MapFieldTreeVal (r :: *) (ns :: Maybe [*]) (vs :: [*]) | r ns -> vs Source #

Instances

MapFieldTreeVal r (Nothing [*]) ([] *) Source # 
(MapFieldTreeVal r (Just [*] xs) out2, FieldTreeVal v out1, (~) [*] ((:) * v (HAppendListR * out1 out2)) out) => MapFieldTreeVal r (Just [*] ((:) * (Tagged k n v) xs)) out Source # 
MapFieldTreeVal r (Just [*] ([] *)) ([] *) Source # 

class FieldTree (r :: *) (v :: [[*]]) | r -> v Source #

list all paths through nested records or variants. An example instance would be

FieldTree r v

where

v ~ [[ Label "x",  Label Dat ], '[Label "y"], '[Label "x"] ]
r ~ Record [ Tagged "x" x, Tagged "y" String ]

x ~ Variant '[ Tagged Dat Char ]

Instances

(TryCollectionList r ns, MapFieldTree ns vs) => FieldTree r vs Source #

the only instance

class MapFieldTree (ns :: Maybe [*]) (vs :: [[*]]) | ns -> vs Source #

Instances

MapFieldTree (Nothing [*]) ([] [*]) Source # 
(MapFieldTree (Just [*] xs) vs3, FieldTree v vs1, MapCons * (Label k n) ((:) [*] ([] *) vs1) vs2, (~) [[*]] (HAppendListR [*] vs2 vs3) vs) => MapFieldTree (Just [*] ((:) * (Tagged k n v) xs)) vs Source #

recursive case

MapFieldTree (Just [*] ([] *)) ([] [*]) Source # 

class MapCons (x :: k) (xs :: [[k]]) (xxs :: [[k]]) | x xs -> xxs Source #

MapCons x xs xxs is like xxs = map (x : ) xs

Instances

MapCons k x ([] [k]) ([] [k]) Source # 
MapCons a1 x b r => MapCons a1 x ((:) [a1] a2 b) ((:) [a1] ((:) a1 x a2) r) Source #