Skip to content

Instantly share code, notes, and snippets.

@dsyme
Created July 17, 2015 12:18
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dsyme/6623d02d1a6065a7f9e0 to your computer and use it in GitHub Desktop.
Save dsyme/6623d02d1a6065a7f9e0 to your computer and use it in GitHub Desktop.
type Domain = interface end
type Projection<'R> =
abstract member source : Table<'R>
and Table<'R> = inherit Projection<'R>
and Table<'R, 'K> =
inherit Table<('R * 'K)>
abstract member row : 'R
abstract member key : 'K
type proj<'R> = Projection<'R>
type table<'R> = Table<'R>
type Engine<'D> when 'D :> Domain =
abstract member from: 'R table * ('R proj -> 'U) -> 'U
abstract member where: ('R -> bool) * 'R proj -> 'R proj
abstract member any: ('R -> bool) * 'R proj -> bool
abstract member select: ('R -> 'S) * 'R proj -> 'S proj
type A = { ID : int; Name : string }
type B = { ID2 : int; Name2 : string }
type MyDomain =
inherit Domain
abstract member As : A table
abstract member Bs : B table
type CommandBuilder<'D> when 'D :> Domain () =
// [<CustomOperation("for")>] **no effect (?)**
member __.For ([<ProjectionParameter>] over : ('D -> 'R table), expr : ('R proj -> _)) = // [<ProjectionParameter>] is ignored
(fun (engine : Engine<'D>, domain : 'D) -> engine.from(over(domain), expr))
member __.Yield x = x
[<CustomOperation("select")>]
member __.Select (over : (Engine<'D> * 'D -> 'R proj), [<ProjectionParameter>] mapping : ('R -> _)) =
(fun (engine : Engine<'D>, domain : 'D) -> engine.select(mapping, over(engine, domain)))
[<CustomOperation("where", MaintainsVariableSpace = true)>]
member __.Where (over : (Engine<'D> * 'D -> 'R proj), [<ProjectionParameter>] byPredicate : ('R -> bool)) =
(fun (engine : Engine<'D>, domain : 'D) -> engine.where(byPredicate, over(engine, domain)))
[<CustomOperation("any", MaintainsVariableSpace = true)>]
member __.Any (over : (Engine<'D> * 'D -> 'R proj), [<ProjectionParameter>] byPredicate : ('R -> bool)) =
(fun (engine : Engine<'D>, domain : 'D) -> engine.any(byPredicate, over(engine, domain)))
member __.Quote() = ()
member __.Run(q) = q
let command = new CommandBuilder<MyDomain>()
let invariant1 =
command {
for a in (fun _d -> _d.As) do // should be `for a in d.As do`
any (a.Name = "disallowed value")
}
let invariant2 =
command {
for b in (fun _d -> _d.Bs) do // should be `for a in d.Bs do`
any (b.Name2 = "disallowed value")
}
let domainInvariants = [ invariant1; invariant2 ]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment