| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Data.Diverse.Lens.Many
Contents
Synopsis
- _Many :: IsMany t xs a => Iso' (Many xs) (t xs a)
- _Many' :: IsMany Tagged xs a => Iso' (Many xs) a
- class Has a t where
- hasTag :: forall l a s. Has (Tagged l a) s => Lens' s a
- hadTag :: forall l a b s. Had (Tagged l a) s => Lens s (Replaced (Tagged l a) (Tagged l b) s) a b
- class (Has a s, Replaced a a s ~ s) => Had a s where
- type Replaced a b s
- class HasL (l :: k) a s | s l -> a where
- class (HasL (l :: k) a s, ReplacedL l a a s ~ s) => HadL (l :: k) a s | s l -> a where
- type ReplacedL l a b s
- class HasN (n :: Nat) a s | s n -> a where
- class (HasN (n :: Nat) a s, ReplacedN n a a s ~ s) => HadN (n :: Nat) a s | s n -> a where
- type ReplacedN n a b s
- type Project (smaller :: [Type]) (smaller' :: [Type]) (larger :: [Type]) (larger' :: [Type]) = (Select smaller larger, Amend smaller smaller' larger, larger' ~ Replaces smaller smaller' larger)
- project :: forall smaller smaller' larger larger'. Project smaller smaller' larger larger' => Lens (Many larger) (Many larger') (Many smaller) (Many smaller')
- type Project' (smaller :: [Type]) (larger :: [Type]) = (Select smaller larger, Amend' smaller larger)
- project' :: forall smaller larger. Project' smaller larger => Lens' (Many larger) (Many smaller)
- type ProjectL (ls :: [k]) (smaller :: [Type]) (smaller' :: [Type]) (larger :: [Type]) (larger' :: [Type]) = (Select smaller larger, Amend smaller smaller' larger, smaller ~ KindsAtLabels ls larger, IsDistinct ls, UniqueLabels ls larger, larger' ~ Replaces smaller smaller' larger)
- projectL :: forall ls smaller smaller' larger larger'. ProjectL ls smaller smaller' larger larger' => Lens (Many larger) (Many larger') (Many smaller) (Many smaller')
- type ProjectL' (ls :: [k]) (smaller :: [Type]) (larger :: [Type]) = (Select smaller larger, Amend' smaller larger, smaller ~ KindsAtLabels ls larger, IsDistinct ls, UniqueLabels ls larger)
- projectL' :: forall ls smaller larger. ProjectL' ls smaller larger => Lens' (Many larger) (Many smaller)
- type ProjectN (ns :: [Nat]) (smaller :: [Type]) (smaller' :: [Type]) (larger :: [Type]) (larger' :: [Type]) = (SelectN ns smaller larger, AmendN ns smaller smaller' larger, larger' ~ ReplacesIndex ns smaller' larger)
- projectN :: forall ns smaller smaller' larger larger'. ProjectN ns smaller smaller' larger larger' => Lens (Many larger) (Many larger') (Many smaller) (Many smaller')
- type ProjectN' (ns :: [Nat]) (smaller :: [Type]) (larger :: [Type]) = (SelectN ns smaller larger, AmendN' ns smaller larger)
- projectN' :: forall ns smaller larger. ProjectN' ns smaller larger => Lens' (Many larger) (Many smaller)
Isomorphism
Single field
Lens for a single field
A type class for extensible product.
We provide instances for tuples up to 12 elements by default.
You can define your own instance of Has, but most of the time tuples will do fine.
Instances
| Has a a | |
| UniqueMember x xs => Has x (Many xs) # | |
| Has b (a, b) | |
| Has a (a, b) | |
| Has c (a, b, c) | |
| Has b (a, b, c) | |
| Has a (a, b, c) | |
| Has d (a, b, c, d) | |
| Has c (a, b, c, d) | |
| Has b (a, b, c, d) | |
| Has a (a, b, c, d) | |
| Has e (a, b, c, d, e) | |
| Has d (a, b, c, d, e) | |
| Has c (a, b, c, d, e) | |
| Has b (a, b, c, d, e) | |
| Has a (a, b, c, d, e) | |
| Has f (a, b, c, d, e, f) | |
| Has e (a, b, c, d, e, f) | |
| Has d (a, b, c, d, e, f) | |
| Has c (a, b, c, d, e, f) | |
| Has b (a, b, c, d, e, f) | |
| Has a (a, b, c, d, e, f) | |
| Has g (a, b, c, d, e, f, g) | |
| Has f (a, b, c, d, e, f, g) | |
| Has e (a, b, c, d, e, f, g) | |
| Has d (a, b, c, d, e, f, g) | |
| Has c (a, b, c, d, e, f, g) | |
| Has b (a, b, c, d, e, f, g) | |
| Has a (a, b, c, d, e, f, g) | |
| Has h (a, b, c, d, e, f, g, h) | |
| Has g (a, b, c, d, e, f, g, h) | |
| Has f (a, b, c, d, e, f, g, h) | |
| Has e (a, b, c, d, e, f, g, h) | |
| Has d (a, b, c, d, e, f, g, h) | |
| Has c (a, b, c, d, e, f, g, h) | |
| Has b (a, b, c, d, e, f, g, h) | |
| Has a (a, b, c, d, e, f, g, h) | |
| Has i (a, b, c, d, e, f, g, h, i) | |
| Has h (a, b, c, d, e, f, g, h, i) | |
| Has g (a, b, c, d, e, f, g, h, i) | |
| Has f (a, b, c, d, e, f, g, h, i) | |
| Has e (a, b, c, d, e, f, g, h, i) | |
| Has d (a, b, c, d, e, f, g, h, i) | |
| Has c (a, b, c, d, e, f, g, h, i) | |
| Has b (a, b, c, d, e, f, g, h, i) | |
| Has a (a, b, c, d, e, f, g, h, i) | |
| Has j (a, b, c, d, e, f, g, h, i, j) | |
| Has i (a, b, c, d, e, f, g, h, i, j) | |
| Has h (a, b, c, d, e, f, g, h, i, j) | |
| Has g (a, b, c, d, e, f, g, h, i, j) | |
| Has f (a, b, c, d, e, f, g, h, i, j) | |
| Has e (a, b, c, d, e, f, g, h, i, j) | |
| Has d (a, b, c, d, e, f, g, h, i, j) | |
| Has c (a, b, c, d, e, f, g, h, i, j) | |
| Has b (a, b, c, d, e, f, g, h, i, j) | |
| Has a (a, b, c, d, e, f, g, h, i, j) | |
| Has k (a, b, c, d, e, f, g, h, i, j, k) | |
| Has j (a, b, c, d, e, f, g, h, i, j, k) | |
| Has i (a, b, c, d, e, f, g, h, i, j, k) | |
| Has h (a, b, c, d, e, f, g, h, i, j, k) | |
| Has g (a, b, c, d, e, f, g, h, i, j, k) | |
| Has f (a, b, c, d, e, f, g, h, i, j, k) | |
| Has e (a, b, c, d, e, f, g, h, i, j, k) | |
| Has d (a, b, c, d, e, f, g, h, i, j, k) | |
| Has c (a, b, c, d, e, f, g, h, i, j, k) | |
| Has b (a, b, c, d, e, f, g, h, i, j, k) | |
| Has a (a, b, c, d, e, f, g, h, i, j, k) | |
| Has l (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has k (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has j (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has i (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has h (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has g (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has f (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has e (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has d (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has c (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has b (a, b, c, d, e, f, g, h, i, j, k, l) | |
| Has a (a, b, c, d, e, f, g, h, i, j, k, l) | |
hadTag :: forall l a b s. Had (Tagged l a) s => Lens s (Replaced (Tagged l a) (Tagged l b) s) a b Source #
class (Has a s, Replaced a a s ~ s) => Had a s where Source #
Polymorphic version of has'
Minimal complete definition
class HasL (l :: k) a s | s l -> a where Source #
grabL (view hasL) and replaceL (set hasL) in Lens' form.
let x = (5 :: Int)./Tagged @Foo False./Tagged @Bar 'X'./nilx^.hasL'@Foo `shouldBe` Tagged @Foo False (x&hasL'@Foo.~Tagged @Foo True) `shouldBe` (5 :: Int)./Tagged @Foo True./Tagged @Bar 'X'./nil
A default implementation using generics is not provided as it make GHC think that l must be type Symbol
when l can actually be any kind.
Create instances of HasL using Data.Generics.Product.Fields as follows:
instance HasField' l Foo a => hasL' l a Foo where
hasL' = field l
default hasL' :: forall (l :: Symbol) a s. (HasField' l s a) => Lens' s a
hasL' = field @l
Minimal complete definition
Instances
| (UniqueLabelMember l xs, x ~ KindAtLabel l xs) => HasL (l :: k) x (Many xs) Source # | |
class (HasL (l :: k) a s, ReplacedL l a a s ~ s) => HadL (l :: k) a s | s l -> a where Source #
Polymorphic version of hasL'
let x = (5 :: Int)./Tagged @Foo False./Tagged @Bar 'X'./nil(x&hasL@Foo.~"foo") `shouldBe` (5 :: Int)./"foo"./Tagged @Bar 'X'./nil
Minimal complete definition
class HasN (n :: Nat) a s | s n -> a where Source #
grabN (view has) and replaceN' (set has') in Lens' form.
let x = (5 :: Int)./False./'X'./Just 'O'./(6 :: Int)./Just 'A' ./ nil x^.hasN'@0 `shouldBe` 5 (x&hasN'@0.~6) `shouldBe` (6 :: Int)./False./'X'./Just 'O'./(6 :: Int)./Just 'A'./nil
Minimal complete definition
class (HasN (n :: Nat) a s, ReplacedN n a a s ~ s) => HadN (n :: Nat) a s | s n -> a where Source #
Polymorphic version of hasN'
Minimal complete definition
Multiple fields
Lens for multiple fields
type Project (smaller :: [Type]) (smaller' :: [Type]) (larger :: [Type]) (larger' :: [Type]) = (Select smaller larger, Amend smaller smaller' larger, larger' ~ Replaces smaller smaller' larger) Source #
A friendlier constraint synonym for project.
project :: forall smaller smaller' larger larger'. Project smaller smaller' larger larger' => Lens (Many larger) (Many larger') (Many smaller) (Many smaller') Source #
Polymorphic version of project'
type Project' (smaller :: [Type]) (larger :: [Type]) = (Select smaller larger, Amend' smaller larger) Source #
A friendlier constraint synonym for project'.
project' :: forall smaller larger. Project' smaller larger => Lens' (Many larger) (Many smaller) Source #
select (view project) and amend (set project) in Lens' form.
project=lensselectamend
let x = (5 :: Int)./False./'X'./Just 'O'./nilx^.(project'@_ @'[Int, Maybe Char]) `shouldBe` (5 :: Int)./Just 'O'./nil(x&(project'@_ @'[Int, Maybe Char]).~((6 :: Int)./JustP./nil)) `shouldBe` (6 :: Int)./False./'X'./Just 'P'./nil
type ProjectL (ls :: [k]) (smaller :: [Type]) (smaller' :: [Type]) (larger :: [Type]) (larger' :: [Type]) = (Select smaller larger, Amend smaller smaller' larger, smaller ~ KindsAtLabels ls larger, IsDistinct ls, UniqueLabels ls larger, larger' ~ Replaces smaller smaller' larger) Source #
A friendlier constraint synonym for projectL.
projectL :: forall ls smaller smaller' larger larger'. ProjectL ls smaller smaller' larger larger' => Lens (Many larger) (Many larger') (Many smaller) (Many smaller') Source #
Polymorphic version of projectL'
let x = False./Tagged @"Hi" (5 :: Int)./Tagged @Foo False./Tagged @Bar 'X'./Tagged @"Bye" 'O'./nil(x&(projectL@'["Hi", "Bye"].~(True./Tagged @"Changed" False./nil)) `shouldBe` False./True./Tagged @Foo False./Tagged @Bar 'X'./Tagged @"Changed" False./nil
type ProjectL' (ls :: [k]) (smaller :: [Type]) (larger :: [Type]) = (Select smaller larger, Amend' smaller larger, smaller ~ KindsAtLabels ls larger, IsDistinct ls, UniqueLabels ls larger) Source #
A friendlier constraint synonym for projectL'.
projectL' :: forall ls smaller larger. ProjectL' ls smaller larger => Lens' (Many larger) (Many smaller) Source #
selectL (view projectL) and amendL (set projectL) in Lens' form.
let x = False./Tagged @"Hi" (5 :: Int)./Tagged @Foo False./Tagged @Bar 'X'./Tagged @"Bye" 'O'./nilx^.(projectL'@'[Foo, Bar] `shouldBe` Tagged @Foo False./Tagged @Bar 'X'./nil (x&(projectL'@'["Hi", "Bye"].~(Tagged @"Hi" (6 :: Int)./Tagged @"Bye" 'P'./nil)) 'shouldBeFalse./Tagged @"Hi" (6 :: Int)./Tagged @Foo False./Tagged @Bar 'X'./Tagged @"Bye" 'P'./nil
type ProjectN (ns :: [Nat]) (smaller :: [Type]) (smaller' :: [Type]) (larger :: [Type]) (larger' :: [Type]) = (SelectN ns smaller larger, AmendN ns smaller smaller' larger, larger' ~ ReplacesIndex ns smaller' larger) Source #
A friendlier constraint synonym for projectN.
projectN :: forall ns smaller smaller' larger larger'. ProjectN ns smaller smaller' larger larger' => Lens (Many larger) (Many larger') (Many smaller) (Many smaller') Source #
Polymorphic version of projectN'
type ProjectN' (ns :: [Nat]) (smaller :: [Type]) (larger :: [Type]) = (SelectN ns smaller larger, AmendN' ns smaller larger) Source #
A friendlier constraint synonym for projectN'.
projectN' :: forall ns smaller larger. ProjectN' ns smaller larger => Lens' (Many larger) (Many smaller) Source #
selectN (view projectN) and amendN (set projectN) in Lens' form.
projectN=lensselectNamendN
let x = (5 :: Int)./False./'X'./Just 'O'./(6 :: Int)./Just 'A'./nilx^.projectN@_ @'[5, 4, 0] `shouldBe` Just 'A'./(6 :: Int)./(5 ::Int)./nil(x&projectN@_ @'[5, 4, 0].~(Just 'B'./(8 :: Int)./(4 ::Int)./nil)) `shouldBe` (4 :: Int)./False./'X'./Just 'O'./(8 :: Int)./Just 'B'./nil