Blog.RecursiveType.GenerateAbstractStructure.fs

open FsCheck

module Gen =
  // int -> int -> int -> int -> ('a list -> Gen<'a>) -> Gen<'a>
  let tree minDepth maxDepth minWidth maxWidth factory =
    Gen.sized <| fun s ->
      let rec recurse depth s =
        if s = 0 || depth >= maxDepth
        then factory []
        else gen {
          let! l = Gen.choose (minWidth, maxWidth)
          let! xs = recurse (depth + 1) (s / 2)
                    |> Gen.listOfLength l
          return! factory xs }
      recurse minDepth s

  module FolderDto =
    // Tree -> FolderDto list
    let private toDto =
      Tree.foldDepthParent 
        (fun _ parent ys x -> 
          { Id = x.Id; ParentId = parent |> Option.fold (fun _ p -> p.Id) null } :: ys) 
        (fun t -> t.Branches) []

    // Gen<FolderDto list>
    let tooWide =
      tree 0 maxDepth 10 10 (fun xs -> { Id = guid; Branches = xs })
      |> Gen.filter (fun t -> t.Branches <> [])
      |> Gen.map toDto

    // Gen<FolderDto list>
    let tooDeep =
      tree 5 10 1 maxWidth (fun xs -> { Id = guid; Branches = xs })
      |> Gen.scaleSize ((+) (maxDepth + 1))
      |> Gen.map toDto