
  0 | module Deriving.DepTyCheck.Gen.Labels
  1 | 
  2 | import public Language.Reflection.Expr
  3 | import public Language.Reflection.Syntax
  4 | import public Language.Reflection.Syntax.Ops
  5 | 
  6 | %default total
  7 | 
  8 | public export
  9 | data CTLabel = MkCTLabel TTImp
 10 | 
 11 | public export
 12 | FromString CTLabel where
 13 |   fromString = MkCTLabel . primVal . Str
 14 | 
 15 | public export
 16 | Semigroup CTLabel where
 17 |   MkCTLabel l <+> MkCTLabel r = MkCTLabel `(~l ++ ~r)
 18 | 
 19 | public export
 20 | Monoid CTLabel where
 21 |   neutral = ""
 22 | 
 23 | namespace FromString
 24 |   public export %inline
 25 |   (.label) : String -> CTLabel
 26 |   (.label) = fromString
 27 | 
 28 | namespace FromTTImp
 29 |   public export %inline
 30 |   (.label) : TTImp -> CTLabel
 31 |   (.label) = MkCTLabel
 32 | 
 33 | export
 34 | labelGen : (desc : CTLabel) -> TTImp -> TTImp
 35 | labelGen (MkCTLabel desc) expr = `(Test.DepTyCheck.Gen.label (fromString ~desc) ~expr)
 36 | 
 37 | export
 38 | callOneOf : (desc : CTLabel) -> List TTImp -> TTImp
 39 | callOneOf desc [v]      = labelGen desc v
 40 | callOneOf desc variants = labelGen desc $ `(Test.DepTyCheck.Gen.oneOf {em=MaybeEmpty}) .$ liftList variants
 41 | 
 42 | -- List of weights and subgenerators
 43 | export
 44 | callFrequency : (desc : CTLabel) -> List (TTImp, TTImp) -> TTImp
 45 | callFrequency _    [(_, v)] = v
 46 | callFrequency desc variants = labelGen desc $ var `{Test.DepTyCheck.Gen.frequency} .$
 47 |                                 liftList (variants <&> \(freq, subgen) => var `{Builtin.MkPair} .$ freq .$ subgen)
 48 |