svenvanheugten/night-light
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Implement shrinking in the arbitrary

Browse source
This commit is contained in:
Sven van Heugten 2026-01-18 06:40:53 +01:00
parent 1265289866
commit da5f7ea4df
1 changed files with 20 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

25
NightLight.Core.Tests/InteractionListGenerators.fs
View file

@ -2,7 +2,6 @@ module NightLight.Core.Tests.InteractionListGenerators
open System open System
open NightLight.Core.Models open NightLight.Core.Models
open FsCheck
open FsCheck.FSharp open FsCheck.FSharp
let private genTimeChanged = let private genTimeChanged =
@ -20,15 +19,25 @@ let private genRemoteInteraction =
let private genInteraction = let private genInteraction =
Gen.oneof [ genTimeChanged; genHumanInteraction; genRemoteInteraction ] Gen.oneof [ genTimeChanged; genHumanInteraction; genRemoteInteraction ]
let private genInteractions = genInteraction |> Gen.listOf type ArbitraryInteractions() =
static member Interactions() =
let private ensureStartsWithTimeChanged (genInteractions: Gen<Interaction list>) = let gen =
genInteractions genInteraction
|> Gen.listOf
|> Gen.bind (fun interactions -> |> Gen.bind (fun interactions ->
match interactions with match interactions with
| Interaction.TimeChanged _ :: _ -> Gen.constant interactions | Interaction.TimeChanged _ :: _ -> Gen.constant interactions
| _ -> genTimeChanged |> Gen.map (fun tc -> tc :: interactions)) | _ -> genTimeChanged |> Gen.map (fun tc -> tc :: interactions))
type ArbitraryInteractions() = let removeFromFrontAfterFirst (lst: 'a list) : seq<'a list> =
static member Interactions() = Seq.unfold
genInteractions |> ensureStartsWithTimeChanged |> Arb.fromGen (fun current ->
match current with
| [] -> None
| [ _ ] -> None
| first :: _ :: rest ->
let next = first :: rest
Some(next, next))
lst
Arb.fromGenShrink (gen, removeFromFrontAfterFirst)