<commit_before>﻿namespace Persimmon.Dried

open System

type PropArg<'T> = {
  Label: string
  Arg: 'T
  Shrinks: int
  OrigArg: 'T
  PrettyArg: Pretty
  PrettyOrigArg: Pretty
}
with
  member this.BoxedTypeParam() = {
    Label = this.Label
    Arg = box this.Arg
    Shrinks = this.Shrinks
    OrigArg = box this.OrigArg
    PrettyArg = this.PrettyArg
    PrettyOrigArg = this.PrettyOrigArg
  }

module PropArg =

  open Pretty
  open Helper

  let pretty args = Pretty(fun prms ->
    if Seq.isEmpty args then ""
    else
      seq {
        for (a, i) in args |> Seq.mapi (fun i a -> (a, i)) ->
          let l = "> "+ (if a.Label = "" then "ARG_" + string i else a.Label)
          let s =
            if a.Shrinks = 0 then ""
            else newLine + l + "_ORIGINAL: " + a.PrettyOrigArg.Apply(prms)
          l + ": " + a.PrettyArg.Apply(prms) + "" + s
      }
      |> String.concat newLine)

[<CustomEquality;NoComparison>]
type PropStatus =
  | Proof
  | True
  | False
  | Undecided
  | Exception of exn
with
  override this.Equals(other: obj) =
    match other with
    | :? PropStatus as other ->
      match this, other with
      | Proof, Proof
      | True, True
      | False, False
      | Undecided, Undecided
      | Exception _, Exception _ -> true
      | _ -> false
    | _ -> false
  override this.GetHashCode() =
    match this with
    | Proof -> 0
    | True -> 1
    | False -> 2
    | Undecided -> 3
    | Exception _ -> 4

type PropResult = {
  Status: PropStatus
  Args: PropArg<obj> list
  Labels: Set<string>
  Collected: obj list
}

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module PropResult =

  let isSuccess r =
    match r.Status with
    | Proof | True -> true
    | _ -> false

  let isFailure r =
    match r.Status with
    | False | Exception _ -> true
    | _ -> false

  let isProved r = r.Status = Proof

  let addArg (a: PropArg<'T>) r = { r with Args = a.BoxedTypeParam() :: r.Args }
  let collect (a: 'T) r = { r with Collected = box a :: r.Collected }

  let merge x y st = {
    Status = st
    Args = List.append x.Args y.Args
    Labels = x.Labels + y.Labels
    Collected = List.append x.Collected y.Collected
  }

  let (&&&) (l: PropResult) (r: PropResult) =
    match l.Status, r.Status with
    | (Exception _,_) -> l
    | (_, Exception _) -> r
    | (False, _) -> l
    | (_, False) -> r
    | (Undecided, _) -> l
    | (_, Undecided) -> r
    | (_, Proof) -> merge l r l.Status
    | (Proof, _) -> merge l r r.Status
    | (True, True) -> merge l r True

  let (|||) (l: PropResult) (r: PropResult) =
    match l.Status, r.Status with
    | (Exception _, _) -> l
    | (_, Exception _) -> r
    | (False, False) -> merge l r False
    | (False, _) -> r
    | (_, False) -> l
    | (Proof, _) -> l
    | (_, Proof) -> r
    | (True, _) -> l
    | (_, True) -> r
    | (Undecided, Undecided) -> merge l r Undecided

  let (++) (l: PropResult) (r: PropResult) =
    match l.Status, r.Status with
    | (Exception _, _) -> l
    | (_, Exception _) -> r
    | (_, Undecided) -> l
    | (Undecided, _) -> r
    | (_, Proof) -> l
    | (Proof, _) -> r
    | (_, True) -> l
    | (True, _) -> r
    | (False, _) -> l

  let (==>) (l: PropResult) (r: PropResult) =
    match l.Status, r.Status with
    | (Exception _,_) -> l
    | (_, Exception _) -> r
    | (False, _) -> merge l r Undecided
    | (Undecided, _) -> l
    | (Proof, _) -> merge l r r.Status
    | (True, _) -> merge l r r.Status

[<AbstractClass>]
type Prop internal () =

  abstract member Apply: GenParameters -> PropResult

  override __.ToString() = "Prop"

module internal PropImpl =

  open PropResult

  let map f (p: Prop) = { new Prop() with
    member __.Apply(prms) = p.Apply(prms) |> f }

  let bind (f: _ -> Prop) (p: Prop) = { new Prop() with
    member __.Apply(prms) = (p.Apply(prms) |> f).Apply(prms) }

  let combine f p1 p2 =
    p1 |> bind (fun r1 ->
    p2 |> bind (fun r2 ->
      { new Prop() with member __.Apply(prms) = f r1 r2 }))

  let apply f = { new Prop() with
    member __.Apply(prms) =
      try
        f prms
      with e ->
        { Status = Exception e; Args = []; Labels = Set.empty; Collected = [] }
  }

  let applyResult r = { new Prop() with
    member __.Apply(prms) = r }

  let provedToTrue r =
    match r.Status with
    | Proof -> { r with Status = True }
    | _ -> r

  let undecided = lazy applyResult { Status = Undecided; Args = []; Labels = Set.empty; Collected = [] }
  let falsified = lazy applyResult { Status = False; Args = []; Labels = Set.empty; Collected = [] }
  let proved = lazy applyResult { Status = Proof; Args = []; Labels = Set.empty; Collected = [] }
  let passed = lazy applyResult { Status = True; Args = []; Labels = Set.empty; Collected = [] }
  let exn(e: exn) = applyResult { Status = Exception e; Args = []; Labels = Set.empty; Collected = [] }

  let applyBool b = if b then proved.Value else falsified.Value

  let sizedProp (f: int -> Prop) =
    apply (fun prms -> provedToTrue ((f prms.Size).Apply(prms)))

  let all (ps: Prop seq) =
    if Seq.isEmpty ps then proved.Value
    else
      apply (fun prms ->
        ps
        |> Seq.map (fun p -> p.Apply(prms))
        |> Seq.reduce (&&&))<commit_msg>fix use apply<commit_after>﻿namespace Persimmon.Dried

open System

type PropArg<'T> = {
  Label: string
  Arg: 'T
  Shrinks: int
  OrigArg: 'T
  PrettyArg: Pretty
  PrettyOrigArg: Pretty
}
with
  member this.BoxedTypeParam() = {
    Label = this.Label
    Arg = box this.Arg
    Shrinks = this.Shrinks
    OrigArg = box this.OrigArg
    PrettyArg = this.PrettyArg
    PrettyOrigArg = this.PrettyOrigArg
  }

module PropArg =

  open Pretty
  open Helper

  let pretty args = Pretty(fun prms ->
    if Seq.isEmpty args then ""
    else
      seq {
        for (a, i) in args |> Seq.mapi (fun i a -> (a, i)) ->
          let l = "> "+ (if a.Label = "" then "ARG_" + string i else a.Label)
          let s =
            if a.Shrinks = 0 then ""
            else newLine + l + "_ORIGINAL: " + a.PrettyOrigArg.Apply(prms)
          l + ": " + a.PrettyArg.Apply(prms) + "" + s
      }
      |> String.concat newLine)

[<CustomEquality;NoComparison>]
type PropStatus =
  | Proof
  | True
  | False
  | Undecided
  | Exception of exn
with
  override this.Equals(other: obj) =
    match other with
    | :? PropStatus as other ->
      match this, other with
      | Proof, Proof
      | True, True
      | False, False
      | Undecided, Undecided
      | Exception _, Exception _ -> true
      | _ -> false
    | _ -> false
  override this.GetHashCode() =
    match this with
    | Proof -> 0
    | True -> 1
    | False -> 2
    | Undecided -> 3
    | Exception _ -> 4

type PropResult = {
  Status: PropStatus
  Args: PropArg<obj> list
  Labels: Set<string>
  Collected: obj list
}

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module PropResult =

  let isSuccess r =
    match r.Status with
    | Proof | True -> true
    | _ -> false

  let isFailure r =
    match r.Status with
    | False | Exception _ -> true
    | _ -> false

  let isProved r = r.Status = Proof

  let addArg (a: PropArg<'T>) r = { r with Args = a.BoxedTypeParam() :: r.Args }
  let collect (a: 'T) r = { r with Collected = box a :: r.Collected }

  let merge x y st = {
    Status = st
    Args = List.append x.Args y.Args
    Labels = x.Labels + y.Labels
    Collected = List.append x.Collected y.Collected
  }

  let (&&&) (l: PropResult) (r: PropResult) =
    match l.Status, r.Status with
    | (Exception _,_) -> l
    | (_, Exception _) -> r
    | (False, _) -> l
    | (_, False) -> r
    | (Undecided, _) -> l
    | (_, Undecided) -> r
    | (_, Proof) -> merge l r l.Status
    | (Proof, _) -> merge l r r.Status
    | (True, True) -> merge l r True

  let (|||) (l: PropResult) (r: PropResult) =
    match l.Status, r.Status with
    | (Exception _, _) -> l
    | (_, Exception _) -> r
    | (False, False) -> merge l r False
    | (False, _) -> r
    | (_, False) -> l
    | (Proof, _) -> l
    | (_, Proof) -> r
    | (True, _) -> l
    | (_, True) -> r
    | (Undecided, Undecided) -> merge l r Undecided

  let (++) (l: PropResult) (r: PropResult) =
    match l.Status, r.Status with
    | (Exception _, _) -> l
    | (_, Exception _) -> r
    | (_, Undecided) -> l
    | (Undecided, _) -> r
    | (_, Proof) -> l
    | (Proof, _) -> r
    | (_, True) -> l
    | (True, _) -> r
    | (False, _) -> l

  let (==>) (l: PropResult) (r: PropResult) =
    match l.Status, r.Status with
    | (Exception _,_) -> l
    | (_, Exception _) -> r
    | (False, _) -> merge l r Undecided
    | (Undecided, _) -> l
    | (Proof, _) -> merge l r r.Status
    | (True, _) -> merge l r r.Status

[<AbstractClass>]
type Prop internal () =

  abstract member Apply: GenParameters -> PropResult

  override __.ToString() = "Prop"

module internal PropImpl =

  open PropResult

  let apply f = { new Prop() with
    member __.Apply(prms) =
      try
        f prms
      with e ->
        { Status = Exception e; Args = []; Labels = Set.empty; Collected = [] }
  }

  let map f (p: Prop) = apply (p.Apply >> f)

  let bind (f: _ -> Prop) (p: Prop) = apply (fun prms -> (p.Apply(prms) |> f).Apply(prms))

  let combine f p1 p2 =
    p1 |> bind (fun r1 ->
    p2 |> bind (fun r2 ->
      { new Prop() with member __.Apply(prms) = f r1 r2 }))

  let applyResult r = apply (fun _ -> r)

  let provedToTrue r =
    match r.Status with
    | Proof -> { r with Status = True }
    | _ -> r

  let undecided = lazy applyResult { Status = Undecided; Args = []; Labels = Set.empty; Collected = [] }
  let falsified = lazy applyResult { Status = False; Args = []; Labels = Set.empty; Collected = [] }
  let proved = lazy applyResult { Status = Proof; Args = []; Labels = Set.empty; Collected = [] }
  let passed = lazy applyResult { Status = True; Args = []; Labels = Set.empty; Collected = [] }
  let exn(e: exn) = applyResult { Status = Exception e; Args = []; Labels = Set.empty; Collected = [] }

  let applyBool b = if b then proved.Value else falsified.Value

  let sizedProp (f: int -> Prop) =
    apply (fun prms -> provedToTrue ((f prms.Size).Apply(prms)))

  let all (ps: Prop seq) =
    if Seq.isEmpty ps then proved.Value
    else
      apply (fun prms ->
        ps
        |> Seq.map (fun p -> p.Apply(prms))
        |> Seq.reduce (&&&))
{'fraction_non_alphanumeric': 0.1472203487811928, 'fraction_numerical': 0.0026977550823778784, 'mean_word_length': 2.185026081620129, 'pattern_counts': {'":': 2, '<': 17, '<?xml version=': 0, '>': 162, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5257792', 'n_tokens_mistral': 3736, 'n_tokens_neox': 3611, 'n_words': 1085}