module Persimmon.FsCheck

open Persimmon
open FsCheck
open System.Diagnostics

exception private FsCheckFailException of string

let private runner =
  { new IRunner with
      member __.OnStartFixture(_) = ()
      member __.OnArguments(_, _, _) = ()
      member __.OnShrink(_, _) = ()
      member __.OnFinished(name, result) =
        match result with
        | TestResult.True _ -> ()
        | _ -> raise (FsCheckFailException(Runner.onFinishedToString name result))
  }

type PropertyBuilder(name: string option) =
  new() = PropertyBuilder(None)
  new(name: string) = PropertyBuilder(Some name)

  member __.Yield(()) =
    let config = { Config.Default with Runner = runner }
    let runCheck (_: Config) = []
    config, runCheck

  [<CustomOperation("maxTest")>]
  member __.MaxTest((config: Config, f), maxTest) = { config with MaxTest = maxTest }, f

  [<CustomOperation("maxFail")>]
  member __.MaxFail((config: Config, f), maxFail) = { config with MaxFail = maxFail }, f

  [<CustomOperation("replay")>]
  member __.Replay((config: Config, f), replay) = { config with Replay = replay }, f

  [<CustomOperation("startSize")>]
  member __.StartSize((config: Config, f), startSize) = { config with StartSize = startSize }, f

  [<CustomOperation("endSize")>]
  member __.EndSize((config: Config, f), endSize) = { config with EndSize = endSize }, f

  [<CustomOperation("quietOnSuccess")>]
  member __.QuietOnSuccess((config: Config, f), quietOnSuccess) = { config with QuietOnSuccess = quietOnSuccess }, f

  [<CustomOperation("every")>]
  member __.Every((config: Config, f), every) = { config with Every = every }, f

  [<CustomOperation("everyShrink")>]
  member __.EveryShrink((config: Config, f), everyShrink) = { config with EveryShrink = everyShrink }, f

  [<CustomOperation("arbitrary")>]
  member __.Arbitrary((config: Config, f), arbitrary) = { config with Arbitrary = arbitrary }, f

  [<CustomOperation("apply")>]
  member __.Apply((config: Config, runPrevChecks: Config -> AssertionResult<unit> list), testable: 'testable) =
    let run config  =
      let prevResults = runPrevChecks config
      let result =
        try
          Check.One(config, testable)
          Passed()
        with
          | FsCheckFailException e -> NotPassed (None, NotPassedCause.Violated e)
          | _ -> reraise()
      result:: prevResults
    config, run

  member __.Delay(f: unit -> _) = f

  member __.Run(f: unit -> Config * (Config -> AssertionResult<unit> list)) : TestCase<unit> =
    let body (tc: TestCase) = async {
      let watch = Stopwatch.StartNew()
      try
        let config, runCheck = f()
        let config = { config with Name = Option.defaultValue config.Name tc.Name }
        let results =
          match runCheck config with
          | [] -> NonEmptyList.singleton (Passed ())
          | xs -> NonEmptyList.ofSeq (List.rev xs)
        do watch.Stop()
        return Done(tc, results, watch.Elapsed)
      with
        | e ->
          do watch.Stop()
          return Error (tc, [| ExceptionWrapper(e) |], [], watch.Elapsed)
    }
    TestCase.init name [] [] body

[<AutoOpen>]
module Syntax =

  let property (name: string) = PropertyBuilder(name)

  module UseTestNameByReflection =
    let property = PropertyBuilder()

module private Test =
  open Syntax.UseTestNameByReflection

  let t: TestCase<unit> = property {
    apply (Prop.forAll Arb.from<int> (fun _ -> false))
    apply (Prop.forAll Arb.from<string> (fun _ -> true))
    apply (Prop.forAll Arb.from<int list> (fun _ -> false))
  }