Skip to content
Browse files

Add KeyValuePair lenses.

Tests fail at the moment, some problem with FsCheck
  • Loading branch information...
1 parent cbc2979 commit ad5adde2ee736129cad58f1c832b2a92a7343323 @mausch committed
Showing with 46 additions and 0 deletions.
  1. +12 −0 src/FSharpx.Core/Lens.fs
  2. +34 −0 tests/FSharpx.Tests/LensTests.fs
View
12 src/FSharpx.Core/Lens.fs
@@ -8,6 +8,8 @@ type Lens<'a,'b> = {
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Lens =
+ open System.Collections.Generic
+
let inline get a (l: Lens<_,_>) = l.Get a
let inline set v a (l: Lens<_,_>) = l.Set v a
let inline update f (l: Lens<_,_>) = l.Update f
@@ -74,6 +76,16 @@ module Lens =
{ Get = Operators.snd
Set = fun v a -> Operators.fst a, v }
+ [<CompiledName("KeyValuePairKey")>]
+ let keyValuePairKey =
+ { Get = fun (x: KeyValuePair<_,_>) -> x.Key
+ Set = fun v a -> KeyValuePair(v, a.Value) }
+
+ [<CompiledName("KeyValuePairValue")>]
+ let keyValuePairValue =
+ { Get = fun (x: KeyValuePair<_,_>) -> x.Value
+ Set = fun v a -> KeyValuePair(a.Key, v) }
+
/// Identity lens
let id =
{ Get = Operators.id
View
34 tests/FSharpx.Tests/LensTests.fs
@@ -1,6 +1,7 @@
module FSharpx.LensTests
open System
+open System.Collections.Generic
open NUnit.Framework
open FsCheck
open FsCheck.NUnit
@@ -169,6 +170,39 @@ let LensSnd() = checkLens "snd" Lens.snd
[<Test>]
let LensFstSnd() = checkLens "fst composed with snd" (Lens.fst >>| Lens.snd)
+let keyValuePairGen<'a,'b> : Gen<KeyValuePair<'a, 'b>> =
+ gen.Return (fun k v -> KeyValuePair(k,v))
+ |> Gen.ap Arb.generate
+ |> Gen.ap Arb.generate
+
+let keyValuePairArb<'a,'b> : Arbitrary<KeyValuePair<'a, 'b>> =
+ Arb.fromGen keyValuePairGen // TODO shrinking
+
+let keyValuePair2Arb<'a,'b,'c> : Arbitrary<KeyValuePair<'a, 'b> * 'c> =
+ gen.Return tuple2
+ |> Gen.ap keyValuePairGen
+ |> Gen.ap Arb.generate
+ |> Arb.fromGen
+
+let keyValuePair3Arb<'a,'b,'c,'d> : Arbitrary<KeyValuePair<'a, 'b> * 'c * 'd> =
+ gen.Return tuple3
+ |> Gen.ap keyValuePairGen
+ |> Gen.ap Arb.generate
+ |> Gen.ap Arb.generate
+ |> Arb.fromGen
+
+let checkLensKV name lens =
+ let tname = sprintf "%s: %s" name
+ fsCheck (tname "GetSet") (Prop.forAll keyValuePairArb <| LensProperties.GetSet lens)
+ fsCheck (tname "SetGet") (Prop.forAll keyValuePair2Arb <| fun (kv,a) -> LensProperties.SetGet lens kv a)
+ fsCheck (tname "SetSet") (Prop.forAll keyValuePair3Arb <| fun (kv,a,b) -> LensProperties.SetSet lens a b kv)
+
+//[<Test>]
+//let LensKeyValuePairKey() = checkLensKV "kvkey" Lens.keyValuePairKey
+//
+//[<Test>]
+//let LensKeyValuePairValue() = checkLensKV "kvkey" Lens.keyValuePairValue
+
[<Test>]
let LensIgnore() = checkLens "ignore" Lens.ignore

0 comments on commit ad5adde

Please sign in to comment.
Something went wrong with that request. Please try again.