mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-13 07:58:40 +00:00
Add JSON serialisation of DUs (#144)
This commit is contained in:
Patrick Stevens
GitHub
325
WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs
Normal file
325
WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs
Normal file
@@ -0,0 +1,325 @@
|
||||
namespace WoofWare.Myriad.Plugins
|
||||
|
||||
open Fantomas.FCS.Syntax
|
||||
open Fantomas.FCS.SyntaxTrivia
|
||||
open Myriad.Core
|
||||
open Myriad.Core.Ast
|
||||
open Fantomas.FCS.Text.Range
|
||||
|
||||
type internal CompExprBinding =
|
||||
| LetBang of varName : string * rhs : SynExpr
|
||||
| Let of varName : string * rhs : SynExpr
|
||||
| Use of varName : string * rhs : SynExpr
|
||||
| Do of body : SynExpr
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal SynExpr =
|
||||
|
||||
/// {expr} |> {func}
|
||||
let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.CreateLongIdent (
|
||||
SynLongIdent.SynLongIdent (
|
||||
[ Ident.Create "op_PipeRight" ],
|
||||
[],
|
||||
[ Some (IdentTrivia.OriginalNotation "|>") ]
|
||||
)
|
||||
),
|
||||
expr
|
||||
),
|
||||
func
|
||||
)
|
||||
|
||||
/// if {cond} then {trueBranch} else {falseBranch}
|
||||
/// Note that this function puts the trueBranch last, for pipelining convenience:
|
||||
/// we assume that the `else` branch is more like an error case and is less interesting.
|
||||
let ifThenElse (cond : SynExpr) (falseBranch : SynExpr) (trueBranch : SynExpr) : SynExpr =
|
||||
SynExpr.IfThenElse (
|
||||
cond,
|
||||
trueBranch,
|
||||
Some falseBranch,
|
||||
DebugPointAtBinding.Yes range0,
|
||||
false,
|
||||
range0,
|
||||
{
|
||||
IfKeyword = range0
|
||||
IsElif = false
|
||||
ThenKeyword = range0
|
||||
ElseKeyword = Some range0
|
||||
IfToThenRange = range0
|
||||
}
|
||||
)
|
||||
|
||||
/// try {body} with | {exc} as exc -> {handler}
|
||||
let pipeThroughTryWith (exc : SynPat) (handler : SynExpr) (body : SynExpr) : SynExpr =
|
||||
let clause =
|
||||
SynMatchClause.Create (SynPat.As (exc, SynPat.CreateNamed (Ident.Create "exc"), range0), None, handler)
|
||||
|
||||
SynExpr.TryWith (
|
||||
body,
|
||||
[ clause ],
|
||||
range0,
|
||||
DebugPointAtTry.Yes range0,
|
||||
DebugPointAtWith.Yes range0,
|
||||
{
|
||||
TryKeyword = range0
|
||||
TryToWithRange = range0
|
||||
WithKeyword = range0
|
||||
WithToEndRange = range0
|
||||
}
|
||||
)
|
||||
|
||||
/// {a} = {b}
|
||||
let equals (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.CreateLongIdent (
|
||||
SynLongIdent.SynLongIdent (
|
||||
Ident.CreateLong "op_Equality",
|
||||
[],
|
||||
[ Some (IdentTrivia.OriginalNotation "=") ]
|
||||
)
|
||||
),
|
||||
a
|
||||
),
|
||||
b
|
||||
)
|
||||
|
||||
/// {a} + {b}
|
||||
let plus (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.CreateLongIdent (
|
||||
SynLongIdent.SynLongIdent (
|
||||
Ident.CreateLong "op_Addition",
|
||||
[],
|
||||
[ Some (IdentTrivia.OriginalNotation "+") ]
|
||||
)
|
||||
),
|
||||
a
|
||||
),
|
||||
b
|
||||
)
|
||||
|
||||
let rec stripOptionalParen (expr : SynExpr) : SynExpr =
|
||||
match expr with
|
||||
| SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr
|
||||
| expr -> expr
|
||||
|
||||
/// {obj}.{meth} {arg}
|
||||
let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.DotGet (
|
||||
obj,
|
||||
range0,
|
||||
SynLongIdent.SynLongIdent (id = [ Ident.Create meth ], dotRanges = [], trivia = [ None ]),
|
||||
range0
|
||||
),
|
||||
arg
|
||||
)
|
||||
|
||||
/// {obj}.{meth}()
|
||||
let callMethod (meth : string) (obj : SynExpr) : SynExpr =
|
||||
callMethodArg meth (SynExpr.CreateConst SynConst.Unit) obj
|
||||
|
||||
let callGenericMethod (meth : string) (ty : LongIdent) (obj : SynExpr) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.TypeApp (
|
||||
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
|
||||
range0,
|
||||
[ SynType.LongIdent (SynLongIdent.CreateFromLongIdent ty) ],
|
||||
[],
|
||||
Some range0,
|
||||
range0,
|
||||
range0
|
||||
),
|
||||
SynExpr.CreateConst SynConst.Unit
|
||||
)
|
||||
|
||||
/// {obj}.{meth}<ty>()
|
||||
let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.TypeApp (
|
||||
SynExpr.DotGet (obj, range0, SynLongIdent.Create [ meth ], range0),
|
||||
range0,
|
||||
[ SynType.CreateLongIdent ty ],
|
||||
[],
|
||||
Some range0,
|
||||
range0,
|
||||
range0
|
||||
),
|
||||
SynExpr.CreateConst SynConst.Unit
|
||||
)
|
||||
|
||||
let index (property : SynExpr) (obj : SynExpr) : SynExpr =
|
||||
SynExpr.DotIndexedGet (obj, property, range0, range0)
|
||||
|
||||
/// (fun {varName} -> {body})
|
||||
let createLambda (varName : string) (body : SynExpr) : SynExpr =
|
||||
let parsedDataPat = [ SynPat.CreateNamed (Ident.Create varName) ]
|
||||
|
||||
SynExpr.Lambda (
|
||||
false,
|
||||
false,
|
||||
SynSimplePats.Create [ SynSimplePat.CreateId (Ident.Create varName) ],
|
||||
body,
|
||||
Some (parsedDataPat, body),
|
||||
range0,
|
||||
{
|
||||
ArrowRange = Some range0
|
||||
}
|
||||
)
|
||||
|> SynExpr.CreateParen
|
||||
|
||||
let reraise : SynExpr =
|
||||
SynExpr.CreateApp (SynExpr.CreateIdent (Ident.Create "reraise"), SynExpr.CreateConst SynConst.Unit)
|
||||
|
||||
/// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct)
|
||||
let startAsTask (ct : SynLongIdent) (body : SynExpr) =
|
||||
let lambda =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "StartAsTask" ]),
|
||||
SynExpr.CreateParenedTuple
|
||||
[
|
||||
SynExpr.CreateLongIdent (SynLongIdent.CreateString "a")
|
||||
equals
|
||||
(SynExpr.LongIdent (true, SynLongIdent.CreateString "cancellationToken", None, range0))
|
||||
(SynExpr.CreateLongIdent ct)
|
||||
]
|
||||
)
|
||||
|> createLambda "a"
|
||||
|
||||
pipeThroughFunction lambda body
|
||||
|
||||
/// {compExpr} { {lets} ; return {ret} }
|
||||
let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr =
|
||||
let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0)
|
||||
|
||||
let contents : SynExpr =
|
||||
(retStatement, List.rev lets)
|
||||
||> List.fold (fun state binding ->
|
||||
match binding with
|
||||
| LetBang (lhs, rhs) ->
|
||||
SynExpr.LetOrUseBang (
|
||||
DebugPointAtBinding.Yes range0,
|
||||
false,
|
||||
true,
|
||||
SynPat.CreateNamed (Ident.Create lhs),
|
||||
rhs,
|
||||
[],
|
||||
state,
|
||||
range0,
|
||||
{
|
||||
EqualsRange = Some range0
|
||||
}
|
||||
)
|
||||
| Let (lhs, rhs) ->
|
||||
SynExpr.LetOrUse (
|
||||
false,
|
||||
false,
|
||||
[ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ],
|
||||
state,
|
||||
range0,
|
||||
{
|
||||
SynExprLetOrUseTrivia.InKeyword = None
|
||||
}
|
||||
)
|
||||
| Use (lhs, rhs) ->
|
||||
SynExpr.LetOrUse (
|
||||
false,
|
||||
true,
|
||||
[ SynBinding.Let (pattern = SynPat.CreateNamed (Ident.Create lhs), expr = rhs) ],
|
||||
state,
|
||||
range0,
|
||||
{
|
||||
SynExprLetOrUseTrivia.InKeyword = None
|
||||
}
|
||||
)
|
||||
| Do body -> SynExpr.CreateSequential [ SynExpr.Do (body, range0) ; state ]
|
||||
)
|
||||
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateIdent (Ident.Create compExpr),
|
||||
SynExpr.ComputationExpr (false, contents, range0)
|
||||
)
|
||||
|
||||
/// {expr} |> Async.AwaitTask
|
||||
let awaitTask (expr : SynExpr) : SynExpr =
|
||||
expr
|
||||
|> pipeThroughFunction (SynExpr.CreateLongIdent (SynLongIdent.Create [ "Async" ; "AwaitTask" ]))
|
||||
|
||||
/// {ident}.ToString ()
|
||||
/// with special casing for some types like DateTime
|
||||
let toString (ty : SynType) (ident : SynExpr) =
|
||||
match ty with
|
||||
| DateOnly -> ident |> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-dd")
|
||||
| DateTime ->
|
||||
ident
|
||||
|> callMethodArg "ToString" (SynExpr.CreateConstString "yyyy-MM-ddTHH:mm:ss")
|
||||
| _ -> callMethod "ToString" ident
|
||||
|
||||
let upcast' (ty : SynType) (e : SynExpr) = SynExpr.Upcast (e, ty, range0)
|
||||
|
||||
let synBindingTriviaZero (isMember : bool) =
|
||||
{
|
||||
SynBindingTrivia.EqualsRange = Some range0
|
||||
InlineKeyword = None
|
||||
LeadingKeyword =
|
||||
if isMember then
|
||||
SynLeadingKeyword.Member range0
|
||||
else
|
||||
SynLeadingKeyword.Let range0
|
||||
}
|
||||
|
||||
/// {ident} - {rhs}
|
||||
let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.CreateLongIdent (
|
||||
SynLongIdent.SynLongIdent (
|
||||
[ Ident.Create "op_Subtraction" ],
|
||||
[],
|
||||
[ Some (IdentTrivia.OriginalNotation "-") ]
|
||||
)
|
||||
),
|
||||
SynExpr.CreateLongIdent ident
|
||||
),
|
||||
rhs
|
||||
)
|
||||
|
||||
/// {ident} - {n}
|
||||
let minusN (ident : SynLongIdent) (n : int) : SynExpr =
|
||||
minus ident (SynExpr.CreateConst (SynConst.Int32 n))
|
||||
|
||||
/// {y} > {x}
|
||||
let greaterThan (x : SynExpr) (y : SynExpr) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.CreateLongIdent (
|
||||
SynLongIdent.SynLongIdent (
|
||||
[ Ident.Create "op_GreaterThan" ],
|
||||
[],
|
||||
[ Some (IdentTrivia.OriginalNotation ">") ]
|
||||
)
|
||||
),
|
||||
y
|
||||
),
|
||||
x
|
||||
)
|
||||
|
||||
/// {y} >= {x}
|
||||
let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr =
|
||||
SynExpr.CreateApp (
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.CreateLongIdent (
|
||||
SynLongIdent.SynLongIdent (
|
||||
[ Ident.Create "op_GreaterThanOrEqual" ],
|
||||
[],
|
||||
[ Some (IdentTrivia.OriginalNotation ">=") ]
|
||||
)
|
||||
),
|
||||
y
|
||||
),
|
||||
x
|
||||
)
|
||||
Reference in New Issue
Block a user