41c3a70 · generic-lens

git.iko.soy/generic-lens

on master help sign in

Constrained traversal, README

41c3a70Csongor Kiss9 years ago

README.md+67−5

compare with master

unifiedsplit

@@ -40,6 +40,7 @@ Table of contents

40A typical module using `generic-lens` will usually have the following

41extensions turned on:

42```haskell

43+{-# LANGUAGE AllowAmbiguousTypes #-}

43{-# LANGUAGE DataKinds #-}

44{-# LANGUAGE DataKinds #-}

44{-# LANGUAGE DeriveGeneric #-}

45{-# LANGUAGE DeriveGeneric #-}

45{-# LANGUAGE DuplicateRecordFields #-}

46{-# LANGUAGE DuplicateRecordFields #-}

@@ -232,22 +233,83 @@ Human {name = "Tunyasz", age = 60, address = "London"}

232

233

233Traversals allow multiple values to be queried or updated at the same time.

234Traversals allow multiple values to be queried or updated at the same time.

234

235

236+As a running example, consider a data type of weighted trees. There are two

237+type parameters, which correspond to the type of elements and weights in the

238+tree:

239+```haskell

240+data WTree a w

241+ = Leaf a

242+ | Fork (WTree a w) (WTree a w)

243+ | WithWeight (WTree a w) w

244+ deriving (Generic, Show)

245+

246+mytree :: WTree Int Int

247+mytree = Fork (WithWeight (Leaf 42) 1)

248+ (WithWeight (Fork (Leaf 88) (Leaf 37)) 2)

249+```

250+

235### By type

251### By type

252+Focus on all values of a given type.

253+

236```haskell

254```haskell

237−types :: HasTypes s a => Traversal s s a a

255+types :: HasTypes s a => Traversal' s a

238```

256```

239−TODO.

257+

258+```haskell

259+>>> toListOf (types @Int) myTree

260+[42,1,88,37,2]

261+```

262+

263+Note that this traversal is `deep': the subtrees are recursively traversed.

240

264

241### By parameter

265### By parameter

242−TODO.

266+As the above example shows, the `types` traversal is limited in that it cannot

267+distinguish between the two types of `Int`s: the weights and the values.

268+

269+Instead, the `param` traversal allows specifying types that correspond to a

270+certain type parameter.

243```haskell

271```haskell

244param :: HasParam pos s t a b => Traversal s t a b

272param :: HasParam pos s t a b => Traversal s t a b

245```

273```

246

274

275+```haskell

276+>>> toListOf (param @1) myTree

277+[42,88,37]

278+```

279+

280+Here, the numbering starts from 0, with 0 being the rightmost parameter.

281+Because `param` is guaranteed to focus on parametric values, it allows the type

282+to be changed as well.

283+

284+For example, we can implement `Functor` for `WTree` as simply as:

285+

286+```haskell

287+instance Functor (WTree a) where

288+ fmap = over (param @0)

289+```

290+

247### By constraint

291### By constraint

248−TODO.

292+The most general type of traversal: we can apply a given function to every

293+value in a structure, by requiring that all values have an instance for some

294+type class.

295+

296+```haskell

297+constraints :: HasConstraints c s t => Applicative g => (forall a b . c a b => a -> g b) -> s -> g t

298+constraints' :: HasConstraints' c s => Applicative g => (forall a . c a => a -> g b) -> s -> g s

299+```

300+

301+Consider the `Numbers` type, which contains three different numeric types:

302+```haskell

303+data Numbers = Numbers Int Float Double

304+ deriving (Show, Generic)

305+

306+numbers = Numbers 10 20.0 30.0

307+```

308+

309+With `constraints'`, we can uniformly add 20 to each number in one go:

249```haskell

310```haskell

250−constraints :: HasConstraints c s t => Applicative g => (forall a b . c a b => a -> g b) -> s -> g t

311+>>> constraints' @Num (\x -> pure (x + 20)) numbers

312+Numbers 30 40.0 50.0

251```

313```

252

314

253## Prisms

315## Prisms

examples/Biscuits.hs+8

@@ -140,3 +140,11 @@ treeIncParam = over (param @0) (+ 1)

140

141instance Functor Invoice where

142 fmap = over (param @0)

143+

144+data Numbers = Numbers Int Float Double

145+ deriving (Show, Generic)

146+

147+-- |

148+-- >>> constraints' @Num (\x -> pure (x + 20)) numbers

149+-- Numbers 30 40.0 50.0

150+numbers = Numbers 10 20.0 30.0

src/Data/Generics/Internal/VL/Traversal.hs+10−5

@@ -22,25 +22,30 @@

22-----------------------------------------------------------------------------

23module Data.Generics.Internal.VL.Traversal where

25+import Data.Kind (Constraint)

26+

25-- | Type alias for traversal

27-- | Type alias for traversal

26type Traversal' s a

28type Traversal' s a

27 = forall f. Applicative f => (a -> f a) -> s -> f s

29 = forall f. Applicative f => (a -> f a) -> s -> f s

29−type TraversalC' s c

31+type TraversalC (c :: * -> * -> Constraint) s t

30− = forall f. Applicative f => LensLikeC f s c

32+ = forall f. Applicative f => (forall a b. c a b => a -> f b) -> s -> f t

32−type LensLikeC f s c

34+type TraversalC' (c :: * -> Constraint) s

33− = (forall a. c a => a -> f a) -> s -> f s

35+ = forall f. Applicative f => (forall a. c a => a -> f a) -> s -> f s

35type Traversal s t a b

37type Traversal s t a b

36 = forall f. Applicative f => (a -> f b) -> s -> f t

38 = forall f. Applicative f => (a -> f b) -> s -> f t

40+type LensLikeC c f s

41+ = (forall a. c a => a -> f a) -> s -> f s

42+

38confusing :: Applicative f => Traversal s t a b -> (a -> f b) -> s -> f t

43confusing :: Applicative f => Traversal s t a b -> (a -> f b) -> s -> f t

39confusing t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f)

44confusing t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f)

40{-# INLINE confusing #-}

45{-# INLINE confusing #-}

42-- fuse constrained traversals

47-- fuse constrained traversals

43−confusingC :: forall c f s. Applicative f => TraversalC' s c -> LensLikeC f s c

48+confusingC :: forall c f s. Applicative f => TraversalC' c s -> LensLikeC c f s

44confusingC t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f)

49confusingC t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f)

45{-# INLINE confusingC #-}

50{-# INLINE confusingC #-}

src/Data/Generics/Product.hs+2

@@ -26,6 +26,7 @@ module Data.Generics.Product

26 -- *Traversals

27 , module Data.Generics.Product.Types

28 , module Data.Generics.Product.Param

29+ , module Data.Generics.Product.Constraints

29 ) where

30 ) where

31import Data.Generics.Product.Any

32import Data.Generics.Product.Any

@@ -34,5 +35,6 @@ import Data.Generics.Product.Positions

34import Data.Generics.Product.Subtype

35import Data.Generics.Product.Subtype

35import Data.Generics.Product.Typed

36import Data.Generics.Product.Typed

36import Data.Generics.Product.Types

37import Data.Generics.Product.Types

38+import Data.Generics.Product.Constraints

37import Data.Generics.Product.Param

39import Data.Generics.Product.Param

38import Data.Generics.Product.List

40import Data.Generics.Product.List

src/Data/Generics/Product/Constraints.hs+17−5

@@ -26,6 +26,7 @@ module Data.Generics.Product.Constraints

26 --

27 -- $example

28 HasConstraints (..)

29+ , HasConstraints' (..)

29 ) where

30 ) where

31import Data.Generics.Product.Internal.Constraints

32import Data.Generics.Product.Internal.Constraints

@@ -34,12 +35,23 @@ import Data.Kind (Constraint)

34import GHC.Generics (Generic (Rep), from, to)

35import GHC.Generics (Generic (Rep), from, to)

35import Data.Generics.Internal.VL.Traversal

36import Data.Generics.Internal.VL.Traversal

37−class HasConstraints (c :: * -> Constraint) s where

38+class HasConstraints' (c :: * -> Constraint) s where

38− constraints :: Applicative g => (forall a. c a => a -> g a) -> s -> g s

39+ constraints' :: TraversalC' c s

40instance

41instance

41 ( Generic s

42 ( Generic s

42− , GHasConstraints c (Rep s)

43+ , GHasConstraints' c (Rep s)

43− ) => HasConstraints c s where

44+ ) => HasConstraints' c s where

44− constraints = confusingC @c (\f s -> to <$> gconstraints @c f (from s))

45+ constraints' = confusingC @c (\f s -> to <$> gconstraints' @c f (from s))

46+ {-# INLINE constraints' #-}

47+

48+class HasConstraints (c :: * -> * -> Constraint) s t where

49+ constraints :: TraversalC c s t

50+

51+instance

52+ ( Generic s

53+ , Generic t

54+ , GHasConstraints c (Rep s) (Rep t)

55+ ) => HasConstraints c s t where

56+ constraints f s = to <$> gconstraints @c f (from s)

45 {-# INLINE constraints #-}

57 {-# INLINE constraints #-}

src/Data/Generics/Product/Internal/Constraints.hs+52−10

@@ -30,34 +30,76 @@

30module Data.Generics.Product.Internal.Constraints

31 (

32 GHasConstraints (..)

33+ , GHasConstraints' (..)

33 , HList (..)

34 , HList (..)

34 ) where

35 ) where

36import Data.Kind (Type, Constraint)

37import Data.Kind (Type, Constraint)

37import GHC.Generics

38import GHC.Generics

38import Data.Generics.Internal.VL.Iso

39import Data.Generics.Internal.VL.Iso

40+import Data.Generics.Internal.VL.Traversal

40-- | Constrained traversal.

42-- | Constrained traversal.

41−class GHasConstraints (c :: * -> Constraint) (f :: * -> *) where

43+class GHasConstraints' (c :: * -> Constraint) (f :: * -> *) where

42− gconstraints :: forall g x.

44+ gconstraints' :: forall g x.

43 Applicative g => (forall a. c a => a -> g a) -> f x -> g (f x)

45 Applicative g => (forall a. c a => a -> g a) -> f x -> g (f x)

47+instance

48+ ( GHasConstraints' c l

49+ , GHasConstraints' c r

45−instance (GHasConstraints c l, GHasConstraints c r) => GHasConstraints c (l :*: r) where

50+ ) => GHasConstraints' c (l :*: r) where

51+ gconstraints' f (l :*: r)

46− gconstraints f (l :*: r) = (:*:) <$> gconstraints @c f l <*> gconstraints @c f r

52+ = (:*:) <$> gconstraints' @c f l <*> gconstraints' @c f r

54+instance

55+ ( GHasConstraints' c l

56+ , GHasConstraints' c r

57+ ) => GHasConstraints' c (l :+: r) where

58+ gconstraints' f (L1 l) = L1 <$> gconstraints' @c f l

59+ gconstraints' f (R1 r) = R1 <$> gconstraints' @c f r

60+

61+instance c a => GHasConstraints' c (Rec0 a) where

62+ gconstraints' = kIso

63+

64+instance GHasConstraints' c f

65+ => GHasConstraints' c (M1 m meta f) where

66+ gconstraints' f (M1 x) = M1 <$> gconstraints' @c f x

67+

68+instance GHasConstraints' c U1 where

69+ gconstraints' _ _ = pure U1

70+

71+--------------------------------------------------------------------------------

72+

73+class GHasConstraints (c :: * -> * -> Constraint) s t where

74+ gconstraints :: TraversalC c (s x) (t x)

75+

76+instance

77+ ( GHasConstraints c l l'

78+ , GHasConstraints c r r'

79+ ) => GHasConstraints c (l :*: r) (l' :*: r') where

80+ gconstraints f (l :*: r)

81+ = (:*:) <$> gconstraints @c f l <*> gconstraints @c f r

82+

83+instance

84+ ( GHasConstraints c l l'

85+ , GHasConstraints c r r'

48−instance (GHasConstraints c l, GHasConstraints c r) => GHasConstraints c (l :+: r) where

86+ ) => GHasConstraints c (l :+: r) (l' :+: r') where

49 gconstraints f (L1 l) = L1 <$> gconstraints @c f l

87 gconstraints f (L1 l) = L1 <$> gconstraints @c f l

50 gconstraints f (R1 r) = R1 <$> gconstraints @c f r

88 gconstraints f (R1 r) = R1 <$> gconstraints @c f r

52−instance c a => GHasConstraints c (K1 R a) where

90+instance GHasConstraints c s t

53− gconstraints = kIso

54−

55−instance GHasConstraints c f => GHasConstraints c (M1 m meta f) where

91+ => GHasConstraints c (M1 i m s) (M1 i m t) where

56 gconstraints f (M1 x) = M1 <$> gconstraints @c f x

92 gconstraints f (M1 x) = M1 <$> gconstraints @c f x

58−instance GHasConstraints c U1 where

94+instance GHasConstraints c U1 U1 where

59 gconstraints _ _ = pure U1

95 gconstraints _ _ = pure U1

97+instance GHasConstraints c V1 V1 where

98+ gconstraints _ = pure

99+

100+instance c a b => GHasConstraints c (Rec0 a) (Rec0 b) where

101+ gconstraints = kIso

102+

61--------------------------------------------------------------------------------

103--------------------------------------------------------------------------------

104

63-- | Multi-traversal

105-- | Multi-traversal