Compare commits

...

4 Commits

Author SHA1 Message Date
Patrick Stevens
5319a33b7b Move a useful function (#283) 2024-10-06 21:15:41 +00:00
Patrick Stevens
29b93b2f20 Pull in AST-manipulating function from Myriad (#281) 2024-10-06 21:08:32 +00:00
Patrick Stevens
40106d8aa3 Use WoofWare.Whippet.Fantomas rather than Myriad.Core (#280) 2024-10-06 20:22:06 +00:00
patrick-conscriptus[bot]
4d641b0662 Automated commit (#279)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2024-10-06 01:23:42 +00:00
47 changed files with 89 additions and 2317 deletions

View File

@@ -4,6 +4,8 @@ open System
open System.Text
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
open TypeEquality
open WoofWare.Whippet.Fantomas
type internal ArgParserOutputSpec =
{

View File

@@ -2,173 +2,7 @@ namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
open Fantomas.FCS.Xml
type internal ParameterInfo =
{
Attributes : SynAttribute list
IsOptional : bool
Id : Ident option
Type : SynType
}
type internal TupledArg =
{
HasParen : bool
Args : ParameterInfo list
}
type internal MemberInfo =
{
ReturnType : SynType
Accessibility : SynAccess option
/// Each element of this list is a list of args in a tuple, or just one arg if not a tuple.
Args : TupledArg list
Identifier : Ident
Attributes : SynAttribute list
XmlDoc : PreXmlDoc option
IsInline : bool
IsMutable : bool
}
[<RequireQualifiedAccess>]
type internal PropertyAccessors =
| Get
| Set
| GetSet
type internal PropertyInfo =
{
Type : SynType
Accessibility : SynAccess option
Attributes : SynAttribute list
XmlDoc : PreXmlDoc option
Accessors : PropertyAccessors
IsInline : bool
Identifier : Ident
}
type internal InterfaceType =
{
Attributes : SynAttribute list
Name : LongIdent
Inherits : SynType list
Members : MemberInfo list
Properties : PropertyInfo list
Generics : SynTyparDecls option
Accessibility : SynAccess option
}
type internal RecordType =
{
Name : Ident
Fields : SynField list
/// Any additional members which are not record fields.
Members : SynMemberDefns option
XmlDoc : PreXmlDoc option
Generics : SynTyparDecls option
TypeAccessibility : SynAccess option
ImplAccessibility : SynAccess option
Attributes : SynAttribute list
}
/// Parse from the AST.
static member OfRecord
(sci : SynComponentInfo)
(smd : SynMemberDefns)
(access : SynAccess option)
(recordFields : SynField list)
: RecordType
=
match sci with
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
{
Name = List.last longId
Fields = recordFields
Members = if smd.IsEmpty then None else Some smd
XmlDoc = if doc.IsEmpty then None else Some doc
Generics = typars
ImplAccessibility = implAccess
TypeAccessibility = access
Attributes = attrs |> List.collect (fun l -> l.Attributes)
}
/// Methods for manipulating UnionCase.
[<RequireQualifiedAccess>]
module UnionCase =
/// Construct our structured `UnionCase` from an FCS `SynUnionCase`: extract everything
/// we care about from the AST representation.
let ofSynUnionCase (case : SynUnionCase) : UnionCase<Ident option> =
match case with
| SynUnionCase.SynUnionCase (attributes, ident, caseType, xmlDoc, access, _, _) ->
let ident =
match ident with
| SynIdent.SynIdent (ident, _) -> ident
let fields =
match caseType with
| SynUnionCaseKind.Fields cases -> cases
| SynUnionCaseKind.FullType _ -> failwith "unexpected FullType union"
{
Name = ident
XmlDoc = if xmlDoc.IsEmpty then None else Some xmlDoc
Access = access
Attributes = attributes |> List.collect (fun t -> t.Attributes)
Fields = fields |> List.map SynField.extract
}
/// Functorial `map`.
let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
{
Attributes = unionCase.Attributes
Name = unionCase.Name
Access = unionCase.Access
XmlDoc = unionCase.XmlDoc
Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
}
/// Everything you need to know about a discriminated union definition.
type internal UnionType =
{
/// The name of the DU: for example, `type Foo = | Blah` has this being `Foo`.
Name : Ident
/// Any additional members which are not union cases.
Members : SynMemberDefns option
/// Any docstring associated with the DU itself (not its cases).
XmlDoc : PreXmlDoc option
/// Generic type parameters this DU takes: `type Foo<'a> = | ...`.
Generics : SynTyparDecls option
/// Attributes of the DU (not its cases): `[<Attr>] type Foo = | ...`
Attributes : SynAttribute list
/// Accessibility modifier of the DU: `type private Foo = ...`
TypeAccessibility : SynAccess option
/// Accessibility modifier of the DU's implementation: `type Foo = private | ...`
ImplAccessibility : SynAccess option
/// The actual DU cases themselves.
Cases : UnionCase<Ident option> list
}
static member OfUnion
(sci : SynComponentInfo)
(smd : SynMemberDefns)
(access : SynAccess option)
(cases : SynUnionCase list)
: UnionType
=
match sci with
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
{
Name = List.last longId
Members = if smd.IsEmpty then None else Some smd
XmlDoc = if doc.IsEmpty then None else Some doc
Generics = typars
Attributes = attrs |> List.collect (fun l -> l.Attributes)
TypeAccessibility = access
ImplAccessibility = implAccess
Cases = cases |> List.map UnionCase.ofSynUnionCase
}
open WoofWare.Whippet.Fantomas
/// Anything that is part of an ADT.
/// A record is a product of stuff; this type represents one of those stuffs.

View File

@@ -3,11 +3,11 @@ namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open WoofWare.Whippet.Fantomas
[<RequireQualifiedAccess>]
module internal CataGenerator =
open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
/// The user-provided DU contains cases, each of which contains fields.
/// We have a hard-coded set of things we know how to deal with as field contents.
@@ -174,20 +174,14 @@ module internal CataGenerator =
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "Seq" ; "exactlyOne" ])
|> SynExpr.createLet
[
SynBinding.Let (
valData = SynValData.SynValData (None, SynValInfo.empty, None),
pattern =
SynPat.tupleNoParen (
allArtificialTyparNames
|> List.map (fun (t : Ident) ->
SynPat.namedI (Ident.create (t.idText + "Stack") |> Ident.lowerFirstLetter)
)
),
expr =
SynExpr.applyFunction
(SynExpr.applyFunction (SynExpr.createIdent "loop") (SynExpr.createIdent "cata"))
(SynExpr.createIdent "instructions")
)
SynBinding.basicTuple
(allArtificialTyparNames
|> List.map (fun (t : Ident) ->
SynPat.namedI (Ident.create (t.idText + "Stack") |> Ident.lowerFirstLetter)
))
(SynExpr.applyFunction
(SynExpr.applyFunction (SynExpr.createIdent "loop") (SynExpr.createIdent "cata"))
(SynExpr.createIdent "instructions"))
]
]
|> SynExpr.sequential
@@ -1180,6 +1174,29 @@ module internal CataGenerator =
]
|> SynModuleOrNamespace.createNamespace ns
/// This function comes from Myriad, and is therefore derived from an Apache 2.0-licenced work.
/// https://github.com/MoiraeSoftware/myriad/blob/3c9818faabf9d508c10c28d5ecd26e66fafb48a1/src/Myriad.Core/Ast.fs#L160
/// A copy of the Apache 2.0 licence is at ApacheLicence.txt.
let groupedTypeDefns (ast : ParsedInput) : (LongIdent * SynTypeDefn list) list =
let rec extractTypes (moduleDecls : SynModuleDecl list) (ns : LongIdent) =
[
for moduleDecl in moduleDecls do
match moduleDecl with
| SynModuleDecl.Types (types, _) -> yield (ns, types)
| SynModuleDecl.NestedModule (SynComponentInfo (_, _, _, longId, _, _, _, _), _, decls, _, _, _) ->
let combined = longId |> List.append ns
yield! (extractTypes decls combined)
| _ -> ()
]
[
match ast with
| ParsedInput.ImplFile (ParsedImplFileInput (_, _, _, _, _, modules, _, _, _)) ->
for SynModuleOrNamespace (namespaceId, _, _, moduleDecls, _, _, _, _, _) in modules do
yield! extractTypes moduleDecls namespaceId
| _ -> ()
]
open Myriad.Core
/// Myriad generator that provides a catamorphism for an algebraic data type.
@@ -1193,7 +1210,7 @@ type CreateCatamorphismGenerator () =
let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
let types = Ast.extractTypeDefn ast
let types = CataGenerator.groupedTypeDefns ast
let opens = AstHelper.extractOpens ast

View File

@@ -3,6 +3,7 @@ namespace WoofWare.Myriad.Plugins
open System.IO
open System.Net.Http
open Fantomas.FCS.Syntax
open WoofWare.Whippet.Fantomas
type internal HttpClientGeneratorOutputSpec =
{
@@ -643,7 +644,7 @@ module internal HttpClientGenerator =
yield jsonNode
| String -> yield responseString
| Stream -> yield responseStream
| Unit ->
| UnitType ->
// What we're returning doesn't depend on the content, so don't bother!
()
| _ ->

View File

@@ -3,6 +3,7 @@ namespace WoofWare.Myriad.Plugins
open System
open Fantomas.FCS.Syntax
open Fantomas.FCS.Xml
open WoofWare.Whippet.Fantomas
type internal GenerateMockOutputSpec =
{

View File

@@ -4,6 +4,7 @@ open System
open System.Text
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open WoofWare.Whippet.Fantomas
type internal JsonParseOutputSpec =
{
@@ -280,7 +281,7 @@ module internal JsonParseGenerator =
parseNumberType options propertyName node primType
|> SynExpr.pipeThroughFunction (Measure.getLanguagePrimitivesMeasure primType)
| JsonNode -> node
| Unit -> SynExpr.CreateConst ()
| UnitType -> SynExpr.CreateConst ()
| _ ->
// Let's just hope that we've also got our own type annotation!
let typeName =

View File

@@ -3,6 +3,7 @@ namespace WoofWare.Myriad.Plugins
open System
open System.Text
open Fantomas.FCS.Syntax
open WoofWare.Whippet.Fantomas
type internal JsonSerializeOutputSpec =
{
@@ -147,7 +148,7 @@ module internal JsonSerializeGenerator =
|> SynExpr.createLambda "field"
|> fun e -> e, false
| JsonNode -> SynExpr.createIdent "id", true
| Unit ->
| UnitType ->
SynExpr.createLambda
"value"
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]

View File

@@ -1,6 +1,7 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open WoofWare.Whippet.Fantomas
[<RequireQualifiedAccess>]
module internal Measure =
@@ -20,5 +21,4 @@ module internal Measure =
| l ->
let l = String.concat "." l
failwith $"unrecognised type for measure: %s{l}"
|> SynExpr.createLongIdent

View File

@@ -2,28 +2,6 @@ namespace WoofWare.Myriad.Plugins
open System.Collections.Generic
type internal DesiredGenerator =
| InterfaceMock of isInternal : bool option
| JsonParse of extensionMethod : bool option
| JsonSerialize of extensionMethod : bool option
| HttpClient of extensionMethod : bool option
static member Parse (s : string) =
match s with
| "GenerateMock" -> DesiredGenerator.InterfaceMock None
| "GenerateMock(true)" -> DesiredGenerator.InterfaceMock (Some true)
| "GenerateMock(false)" -> DesiredGenerator.InterfaceMock (Some false)
| "JsonParse" -> DesiredGenerator.JsonParse None
| "JsonParse(true)" -> DesiredGenerator.JsonParse (Some true)
| "JsonParse(false)" -> DesiredGenerator.JsonParse (Some false)
| "JsonSerialize" -> DesiredGenerator.JsonSerialize None
| "JsonSerialize(true)" -> DesiredGenerator.JsonSerialize (Some true)
| "JsonSerialize(false)" -> DesiredGenerator.JsonSerialize (Some false)
| "HttpClient" -> DesiredGenerator.HttpClient None
| "HttpClient(true)" -> DesiredGenerator.HttpClient (Some true)
| "HttpClient(false)" -> DesiredGenerator.HttpClient (Some false)
| _ -> failwith $"Failed to parse as a generator specification: %s{s}"
[<RequireQualifiedAccess>]
module internal MyriadParamParser =
(*

View File

@@ -0,0 +1,23 @@
namespace WoofWare.Myriad.Plugins
type internal DesiredGenerator =
| InterfaceMock of isInternal : bool option
| JsonParse of extensionMethod : bool option
| JsonSerialize of extensionMethod : bool option
| HttpClient of extensionMethod : bool option
static member Parse (s : string) =
match s with
| "GenerateMock" -> DesiredGenerator.InterfaceMock None
| "GenerateMock(true)" -> DesiredGenerator.InterfaceMock (Some true)
| "GenerateMock(false)" -> DesiredGenerator.InterfaceMock (Some false)
| "JsonParse" -> DesiredGenerator.JsonParse None
| "JsonParse(true)" -> DesiredGenerator.JsonParse (Some true)
| "JsonParse(false)" -> DesiredGenerator.JsonParse (Some false)
| "JsonSerialize" -> DesiredGenerator.JsonSerialize None
| "JsonSerialize(true)" -> DesiredGenerator.JsonSerialize (Some true)
| "JsonSerialize(false)" -> DesiredGenerator.JsonSerialize (Some false)
| "HttpClient" -> DesiredGenerator.HttpClient None
| "HttpClient(true)" -> DesiredGenerator.HttpClient (Some true)
| "HttpClient(false)" -> DesiredGenerator.HttpClient (Some false)
| _ -> failwith $"Failed to parse as a generator specification: %s{s}"

View File

@@ -1,32 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal Primitives =
/// Given e.g. "byte", returns "System.Byte".
let qualifyType (typeName : string) : LongIdent option =
match typeName with
| "float32"
| "single" -> [ "System" ; "Single" ] |> Some
| "float"
| "double" -> [ "System" ; "Double" ] |> Some
| "byte"
| "uint8" -> [ "System" ; "Byte" ] |> Some
| "sbyte"
| "int8" -> [ "System" ; "SByte" ] |> Some
| "int16" -> [ "System" ; "Int16" ] |> Some
| "int"
| "int32" -> [ "System" ; "Int32" ] |> Some
| "int64" -> [ "System" ; "Int64" ] |> Some
| "uint16" -> [ "System" ; "UInt16" ] |> Some
| "uint"
| "uint32" -> [ "System" ; "UInt32" ] |> Some
| "uint64" -> [ "System" ; "UInt64" ] |> Some
| "char" -> [ "System" ; "Char" ] |> Some
| "decimal" -> [ "System" ; "Decimal" ] |> Some
| "string" -> [ "System" ; "String" ] |> Some
| "bool" -> [ "System" ; "Boolean" ] |> Some
| _ -> None
|> Option.map (List.map (fun i -> (Ident (i, range0))))

View File

@@ -2,6 +2,7 @@ namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Xml
open WoofWare.Whippet.Fantomas
[<RequireQualifiedAccess>]
module internal RemoveOptionsGenerator =

View File

@@ -292,27 +292,4 @@ WoofWare.Myriad.Plugins.SwaggerParameter.In [property]: [read-only] WoofWare.Myr
WoofWare.Myriad.Plugins.SwaggerParameter.Name [property]: [read-only] string
WoofWare.Myriad.Plugins.SwaggerParameter.Parse [static method]: System.Text.Json.Nodes.JsonObject -> WoofWare.Myriad.Plugins.SwaggerParameter
WoofWare.Myriad.Plugins.SwaggerParameter.Required [property]: [read-only] bool option
WoofWare.Myriad.Plugins.SwaggerParameter.Type [property]: [read-only] WoofWare.Myriad.Plugins.Definition
WoofWare.Myriad.Plugins.SynFieldData`1 inherit obj
WoofWare.Myriad.Plugins.SynFieldData`1..ctor [constructor]: (Fantomas.FCS.Syntax.SynAttribute list, 'Ident, Fantomas.FCS.Syntax.SynType)
WoofWare.Myriad.Plugins.SynFieldData`1.Attrs [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
WoofWare.Myriad.Plugins.SynFieldData`1.get_Attrs [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
WoofWare.Myriad.Plugins.SynFieldData`1.get_Ident [method]: unit -> 'Ident
WoofWare.Myriad.Plugins.SynFieldData`1.get_Type [method]: unit -> Fantomas.FCS.Syntax.SynType
WoofWare.Myriad.Plugins.SynFieldData`1.Ident [property]: [read-only] 'Ident
WoofWare.Myriad.Plugins.SynFieldData`1.Type [property]: [read-only] Fantomas.FCS.Syntax.SynType
WoofWare.Myriad.Plugins.UnionCase inherit obj
WoofWare.Myriad.Plugins.UnionCase.mapIdentFields [static method]: ('a -> 'b) -> 'a WoofWare.Myriad.Plugins.UnionCase -> 'b WoofWare.Myriad.Plugins.UnionCase
WoofWare.Myriad.Plugins.UnionCase.ofSynUnionCase [static method]: Fantomas.FCS.Syntax.SynUnionCase -> Fantomas.FCS.Syntax.Ident option WoofWare.Myriad.Plugins.UnionCase
WoofWare.Myriad.Plugins.UnionCase`1 inherit obj
WoofWare.Myriad.Plugins.UnionCase`1..ctor [constructor]: (Fantomas.FCS.Syntax.Ident, Fantomas.FCS.Xml.PreXmlDoc option, Fantomas.FCS.Syntax.SynAccess option, Fantomas.FCS.Syntax.SynAttribute list, 'ident WoofWare.Myriad.Plugins.SynFieldData list)
WoofWare.Myriad.Plugins.UnionCase`1.Access [property]: [read-only] Fantomas.FCS.Syntax.SynAccess option
WoofWare.Myriad.Plugins.UnionCase`1.Attributes [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
WoofWare.Myriad.Plugins.UnionCase`1.Fields [property]: [read-only] 'ident WoofWare.Myriad.Plugins.SynFieldData list
WoofWare.Myriad.Plugins.UnionCase`1.get_Access [method]: unit -> Fantomas.FCS.Syntax.SynAccess option
WoofWare.Myriad.Plugins.UnionCase`1.get_Attributes [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
WoofWare.Myriad.Plugins.UnionCase`1.get_Fields [method]: unit -> 'ident WoofWare.Myriad.Plugins.SynFieldData list
WoofWare.Myriad.Plugins.UnionCase`1.get_Name [method]: unit -> Fantomas.FCS.Syntax.Ident
WoofWare.Myriad.Plugins.UnionCase`1.get_XmlDoc [method]: unit -> Fantomas.FCS.Xml.PreXmlDoc option
WoofWare.Myriad.Plugins.UnionCase`1.Name [property]: [read-only] Fantomas.FCS.Syntax.Ident
WoofWare.Myriad.Plugins.UnionCase`1.XmlDoc [property]: [read-only] Fantomas.FCS.Xml.PreXmlDoc option
WoofWare.Myriad.Plugins.SwaggerParameter.Type [property]: [read-only] WoofWare.Myriad.Plugins.Definition

View File

@@ -6,6 +6,7 @@ open System.Threading
open Fantomas.FCS.Syntax
open Fantomas.FCS.Xml
open Fantomas.FCS.Text.Range
open WoofWare.Whippet.Fantomas
type internal SwaggerClientConfig =
{

View File

@@ -1,49 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
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
(*
Potential API!
type internal CompExprBindings =
private
{
/// These are stored in reverse.
Bindings : CompExprBinding list
CompExprName : string
}
[<RequireQualifiedAccess>]
module internal CompExprBindings =
let make (name : string) : CompExprBindings =
{
Bindings = []
CompExprName = name
}
let thenDo (body : SynExpr) (bindings : CompExprBindings) =
{ bindings with
Bindings = (Do body :: bindings.Bindings)
}
let thenLet (varName : string) (value : SynExpr) (bindings : CompExprBindings) =
{ bindings with
Bindings = (Let (varName, value) :: bindings.Bindings)
}
let thenLetBang (varName : string) (value : SynExpr) (bindings : CompExprBindings) =
{ bindings with
Bindings = (LetBang (varName, value) :: bindings.Bindings)
}
let thenUse (varName : string) (value : SynExpr) (bindings : CompExprBindings) =
{ bindings with
Bindings = (LetBang (varName, value) :: bindings.Bindings)
}
*)

View File

@@ -1,65 +0,0 @@
namespace WoofWare.Myriad.Plugins
open System
open System.Text
open System.Text.RegularExpressions
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal Ident =
let inline create (s : string) = Ident (s, range0)
/// Fantomas bug, perhaps? "type" is not rendered as ``type``, although the ASTs are identical
/// apart from the ranges?
/// Awful hack: here is a function that does this sort of thing.
let createSanitisedParamName (s : string) =
match s with
| "type" -> create "type'"
| "private" -> create "private'"
| _ ->
let result = StringBuilder ()
for i = 0 to s.Length - 1 do
if Char.IsLetter s.[i] then
result.Append s.[i] |> ignore<StringBuilder>
elif Char.IsNumber s.[i] then
if result.Length > 0 then
result.Append s.[i] |> ignore<StringBuilder>
elif s.[i] = '_' || s.[i] = '-' then
result.Append '_' |> ignore<StringBuilder>
else
failwith $"could not convert to ident: %s{s}"
create (result.ToString ())
let private alnum = Regex @"^[a-zA-Z][a-zA-Z0-9]*$"
let createSanitisedTypeName (s : string) =
let result = StringBuilder ()
let mutable capitalize = true
for i = 0 to s.Length - 1 do
if Char.IsLetter s.[i] then
if capitalize then
result.Append (Char.ToUpperInvariant s.[i]) |> ignore<StringBuilder>
capitalize <- false
else
result.Append s.[i] |> ignore<StringBuilder>
elif Char.IsNumber s.[i] then
if result.Length > 0 then
result.Append s.[i] |> ignore<StringBuilder>
elif s.[i] = '_' then
capitalize <- true
if result.Length = 0 then
failwith $"String %s{s} was not suitable as a type identifier"
Ident (result.ToString (), range0)
let lowerFirstLetter (x : Ident) : Ident =
let result = StringBuilder x.idText.Length
result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore
result.Append x.idText.[1..] |> ignore
create ((result : StringBuilder).ToString ())

View File

@@ -1,17 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Xml
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal PreXmlDoc =
let create (s : string) : PreXmlDoc =
let s = s.Split "\n"
for i = 0 to s.Length - 1 do
s.[i] <- " " + s.[i]
PreXmlDoc.Create (s, range0)
let create' (s : string seq) : PreXmlDoc =
PreXmlDoc.Create (Array.ofSeq s, range0)

View File

@@ -1,7 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
[<RequireQualifiedAccess>]
module internal SynArgInfo =
let empty = SynArgInfo.SynArgInfo ([], false, None)

View File

@@ -1,30 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynArgPats =
let createNamed (caseNames : string list) : SynArgPats =
match caseNames.Length with
| 0 -> SynArgPats.Pats []
| 1 ->
SynPat.Named (SynIdent.createS caseNames.[0], false, None, range0)
|> List.singleton
|> SynArgPats.Pats
| len ->
caseNames
|> List.map (fun name -> SynPat.Named (SynIdent.createS name, false, None, range0))
|> fun t -> SynPat.Tuple (false, t, List.replicate (len - 1) range0, range0)
|> fun t -> SynPat.Paren (t, range0)
|> List.singleton
|> SynArgPats.Pats
let create (pats : SynPat list) : SynArgPats =
match pats.Length with
| 0 -> SynArgPats.Pats []
| 1 -> [ pats.[0] ] |> SynArgPats.Pats
| len ->
SynPat.Paren (SynPat.Tuple (false, pats, List.replicate (len - 1) range0, range0), range0)
|> List.singleton
|> SynArgPats.Pats

View File

@@ -1,27 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynAttribute =
let inline create (typeName : SynLongIdent) (arg : SynExpr) : SynAttribute =
{
TypeName = typeName
ArgExpr = arg
Target = None
AppliesToGetterAndSetter = false
Range = range0
}
let internal compilationRepresentation : SynAttribute =
[ "CompilationRepresentationFlags" ; "ModuleSuffix" ]
|> SynExpr.createLongIdent
|> SynExpr.paren
|> create (SynLongIdent.createS "CompilationRepresentation")
let internal requireQualifiedAccess : SynAttribute =
create (SynLongIdent.createS "RequireQualifiedAccess") (SynExpr.CreateConst ())
let internal autoOpen : SynAttribute =
create (SynLongIdent.createS "AutoOpen") (SynExpr.CreateConst ())

View File

@@ -1,15 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynAttributes =
let ofAttrs (attrs : SynAttribute list) : SynAttributes =
attrs
|> List.map (fun a ->
{
Attributes = [ a ]
Range = range0
}
)

View File

@@ -1,233 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynBinding =
let rec private stripParen (pat : SynPat) =
match pat with
| SynPat.Paren (p, _) -> stripParen p
| _ -> pat
let rec private getName (pat : SynPat) : Ident option =
match stripParen pat with
| SynPat.Named (SynIdent.SynIdent (name, _), _, _, _) -> Some name
| SynPat.Typed (pat, _, _) -> getName pat
| SynPat.LongIdent (SynLongIdent.SynLongIdent (longIdent, _, _), _, _, _, _, _) ->
match longIdent with
| [ x ] -> Some x
| _ -> failwithf "got long ident %O ; can only get the name of a long ident with one component" longIdent
| _ -> None
let private getArgInfo (pat : SynPat) : SynArgInfo list =
// TODO: this only copes with one layer of tupling
match stripParen pat with
| SynPat.Tuple (_, pats, _, _) -> pats |> List.map (fun pat -> SynArgInfo.SynArgInfo ([], false, getName pat))
| pat -> [ SynArgInfo.SynArgInfo (SynAttributes.Empty, false, getName pat) ]
let triviaZero (isMember : bool) =
{
SynBindingTrivia.EqualsRange = Some range0
InlineKeyword = None
LeadingKeyword =
if isMember then
SynLeadingKeyword.Member range0
else
SynLeadingKeyword.Let range0
}
let basic (name : LongIdent) (args : SynPat list) (body : SynExpr) : SynBinding =
let valInfo : SynValInfo =
args
|> List.map getArgInfo
|> fun x -> SynValInfo.SynValInfo (x, SynArgInfo.SynArgInfo ([], false, None))
SynBinding.SynBinding (
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
SynValData.SynValData (None, valInfo, None),
SynPat.identWithArgs name (SynArgPats.Pats args),
None,
body,
range0,
DebugPointAtBinding.Yes range0,
triviaZero false
)
let withMutability (mut : bool) (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (pat, kind, inl, _, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) ->
SynBinding (pat, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia)
let withRecursion (isRec : bool) (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (pat, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) ->
let trivia =
{ trivia with
LeadingKeyword =
match trivia.LeadingKeyword with
| SynLeadingKeyword.Let _ ->
if isRec then
SynLeadingKeyword.LetRec (range0, range0)
else
trivia.LeadingKeyword
| SynLeadingKeyword.LetRec _ ->
if isRec then
trivia.LeadingKeyword
else
trivia.LeadingKeyword
| existing ->
failwith
$"WoofWare.Myriad doesn't yet let you adjust the recursion modifier on a binding with modifier %O{existing}"
}
SynBinding (pat, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia)
let withAccessibility (acc : SynAccess option) (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (_, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia) ->
let headPat =
match headPat with
| SynPat.LongIdent (ident, extra, options, argPats, _, range) ->
SynPat.LongIdent (ident, extra, options, argPats, acc, range)
| _ -> failwithf "unrecognised head pattern: %O" headPat
SynBinding (acc, kind, inl, mut, attrs, xml, valData, headPat, returnInfo, expr, range, debugPoint, trivia)
let withXmlDoc (doc : PreXmlDoc) (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (acc, kind, inl, mut, attrs, _, valData, headPat, returnInfo, expr, range, debugPoint, trivia) ->
SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, returnInfo, expr, range, debugPoint, trivia)
let withReturnAnnotation (ty : SynType) (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, _, expr, range, debugPoint, trivia) ->
let retInfo =
SynBindingReturnInfo.SynBindingReturnInfo (
ty,
range0,
[],
{
ColonRange = Some range0
}
)
SynBinding (
acc,
kind,
inl,
mut,
attrs,
doc,
valData,
headPat,
Some retInfo,
expr,
range,
debugPoint,
trivia
)
let inline makeInline (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (acc, kind, _, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) ->
SynBinding (
acc,
kind,
true,
mut,
attrs,
doc,
valData,
headPat,
ret,
expr,
range,
debugPoint,
{ trivia with
InlineKeyword = Some range0
}
)
let inline makeNotInline (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (acc, kind, _, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) ->
SynBinding (
acc,
kind,
false,
mut,
attrs,
doc,
valData,
headPat,
ret,
expr,
range,
debugPoint,
{ trivia with
InlineKeyword = None
}
)
let inline setInline (isInline : bool) (binding : SynBinding) : SynBinding =
if isInline then
makeInline binding
else
makeNotInline binding
let makeStaticMember (binding : SynBinding) : SynBinding =
let memberFlags =
{
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
match binding with
| SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) ->
let valData =
match valData with
| SynValData.SynValData (_, valInfo, _) -> SynValData.SynValData (Some memberFlags, valInfo, None)
let trivia =
{ trivia with
LeadingKeyword = SynLeadingKeyword.StaticMember (range0, range0)
}
SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia)
let makeInstanceMember (binding : SynBinding) : SynBinding =
let memberFlags =
{
SynMemberFlags.IsInstance = true
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = true
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
match binding with
| SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) ->
let valData =
match valData with
| SynValData.SynValData (_, valInfo, _) -> SynValData.SynValData (Some memberFlags, valInfo, None)
let trivia =
{ trivia with
LeadingKeyword = SynLeadingKeyword.Member range0
}
SynBinding (acc, kind, inl, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia)

View File

@@ -1,50 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Xml
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynComponentInfo =
let inline createLong (name : LongIdent) =
SynComponentInfo.SynComponentInfo ([], None, [], name, PreXmlDoc.Empty, false, None, range0)
let inline create (name : Ident) = createLong [ name ]
let inline withDocString (doc : PreXmlDoc) (i : SynComponentInfo) : SynComponentInfo =
match i with
| SynComponentInfo.SynComponentInfo (attrs, typars, constraints, name, _, postfix, access, range) ->
SynComponentInfo (attrs, typars, constraints, name, doc, postfix, access, range)
let inline setGenerics (typars : SynTyparDecls option) (i : SynComponentInfo) : SynComponentInfo =
match i with
| SynComponentInfo.SynComponentInfo (attrs, _, constraints, name, doc, postfix, access, range) ->
SynComponentInfo (attrs, typars, constraints, name, doc, postfix, access, range)
let inline withGenerics (typars : SynTyparDecl list) (i : SynComponentInfo) : SynComponentInfo =
let inner =
if typars.IsEmpty then
None
else
Some (SynTyparDecls.PostfixList (typars, [], range0))
setGenerics inner i
let inline setAccessibility (acc : SynAccess option) (i : SynComponentInfo) : SynComponentInfo =
match i with
| SynComponentInfo.SynComponentInfo (attrs, typars, constraints, name, doc, postfix, _, range) ->
SynComponentInfo.SynComponentInfo (attrs, typars, constraints, name, doc, postfix, acc, range)
let inline withAccessibility (acc : SynAccess) (i : SynComponentInfo) : SynComponentInfo =
setAccessibility (Some acc) i
let inline addAttributes (attrs : SynAttribute list) (i : SynComponentInfo) : SynComponentInfo =
match i with
| SynComponentInfo.SynComponentInfo (oldAttrs, typars, constraints, name, doc, postfix, acc, range) ->
let attrs =
{
SynAttributeList.Attributes = attrs
SynAttributeList.Range = range0
}
SynComponentInfo.SynComponentInfo ((attrs :: oldAttrs), typars, constraints, name, doc, postfix, acc, range)

View File

@@ -1,10 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<AutoOpen>]
module internal SynConstExt =
type SynConst with
static member Create (s : string) : SynConst =
SynConst.String (s, SynStringKind.Regular, range0)

View File

@@ -1,365 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Text.Range
[<AutoOpen>]
module internal SynExprExtensions =
type SynExpr with
static member CreateConst (s : string) : SynExpr =
SynExpr.Const (SynConst.Create s, range0)
static member CreateConst () : SynExpr = SynExpr.Const (SynConst.Unit, range0)
static member CreateConst (b : bool) : SynExpr = SynExpr.Const (SynConst.Bool b, range0)
static member CreateConst (c : char) : SynExpr =
// apparent Myriad bug: `IndexOf '?'` gets formatted as `IndexOf ?` which is clearly wrong
SynExpr.App (
ExprAtomicFlag.NonAtomic,
false,
SynExpr.Ident (Ident.create "char"),
SynExpr.CreateConst (int c),
range0
)
|> fun e -> SynExpr.Paren (e, range0, Some range0, range0)
static member CreateConst (i : int32) : SynExpr =
SynExpr.Const (SynConst.Int32 i, range0)
[<RequireQualifiedAccess>]
module internal SynExpr =
/// {f} {x}
let applyFunction (f : SynExpr) (x : SynExpr) : SynExpr =
SynExpr.App (ExprAtomicFlag.NonAtomic, false, f, x, range0)
/// {f} {x}
let inline applyTo (x : SynExpr) (f : SynExpr) : SynExpr = applyFunction f x
let inline private createAppInfix (f : SynExpr) (x : SynExpr) =
SynExpr.App (ExprAtomicFlag.NonAtomic, true, f, x, range0)
let inline createLongIdent'' (ident : SynLongIdent) : SynExpr =
SynExpr.LongIdent (false, ident, None, range0)
let inline createLongIdent' (ident : Ident list) : SynExpr =
createLongIdent'' (SynLongIdent.create ident)
let inline createLongIdent (ident : string list) : SynExpr =
createLongIdent' (ident |> List.map Ident.create)
/// {expr} |> {func}
let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr =
createAppInfix (createLongIdent'' SynLongIdent.pipe) expr |> applyTo 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.named "exc", range0)) 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) =
createAppInfix (createLongIdent'' SynLongIdent.eq) a |> applyTo b
/// {a} && {b}
let booleanAnd (a : SynExpr) (b : SynExpr) =
createAppInfix (createLongIdent'' SynLongIdent.booleanAnd) a |> applyTo b
/// {a} || {b}
let booleanOr (a : SynExpr) (b : SynExpr) =
createAppInfix (createLongIdent'' SynLongIdent.booleanOr) a |> applyTo b
/// {a} + {b}
let plus (a : SynExpr) (b : SynExpr) =
createAppInfix (createLongIdent'' SynLongIdent.plus) a |> applyTo b
/// {a} * {b}
let times (a : SynExpr) (b : SynExpr) =
createAppInfix (createLongIdent'' SynLongIdent.times) a |> applyTo b
let rec stripOptionalParen (expr : SynExpr) : SynExpr =
match expr with
| SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr
| expr -> expr
let dotGet (field : string) (obj : SynExpr) : SynExpr =
SynExpr.DotGet (
obj,
range0,
SynLongIdent.SynLongIdent (id = [ Ident.create field ], dotRanges = [], trivia = [ None ]),
range0
)
/// {obj}.{meth} {arg}
let callMethodArg (meth : string) (arg : SynExpr) (obj : SynExpr) : SynExpr = dotGet meth obj |> applyTo arg
/// {obj}.{meth}()
let callMethod (meth : string) (obj : SynExpr) : SynExpr =
callMethodArg meth (SynExpr.CreateConst ()) obj
let typeApp (types : SynType list) (operand : SynExpr) =
SynExpr.TypeApp (operand, range0, types, List.replicate (types.Length - 1) range0, Some range0, range0, range0)
/// {obj}.{meth}<types,...>()
let callGenericMethod (meth : SynLongIdent) (types : SynType list) (obj : SynExpr) : SynExpr =
SynExpr.DotGet (obj, range0, meth, range0)
|> typeApp types
|> applyTo (SynExpr.CreateConst ())
/// {obj}.{meth}<ty>()
let callGenericMethod' (meth : string) (ty : string) (obj : SynExpr) : SynExpr =
callGenericMethod (SynLongIdent.createS meth) [ SynType.createLongIdent' [ ty ] ] obj
let inline index (property : SynExpr) (obj : SynExpr) : SynExpr =
SynExpr.DotIndexedGet (obj, property, range0, range0)
let inline arrayIndexRange (start : SynExpr option) (endRange : SynExpr option) (arr : SynExpr) : SynExpr =
SynExpr.DotIndexedGet (
arr,
(SynExpr.IndexRange (start, range0, endRange, range0, range0, range0)),
range0,
range0
)
let inline paren (e : SynExpr) : SynExpr =
SynExpr.Paren (e, range0, Some range0, range0)
/// (fun {varName} -> {body})
let createLambda (varName : string) (body : SynExpr) : SynExpr =
let parsedDataPat = [ SynPat.named varName ]
SynExpr.Lambda (
false,
false,
SynSimplePats.create [ SynSimplePat.createId (Ident.create varName) ],
body,
Some (parsedDataPat, body),
range0,
{
ArrowRange = Some range0
}
)
|> paren
let createThunk (body : SynExpr) : SynExpr =
SynExpr.Lambda (
false,
false,
SynSimplePats.create [],
body,
Some ([ SynPat.unit ], body),
range0,
{
ArrowRange = Some range0
}
)
|> paren
let inline createIdent (s : string) : SynExpr = SynExpr.Ident (Ident (s, range0))
let inline createIdent' (i : Ident) : SynExpr = SynExpr.Ident i
let tupleNoParen (args : SynExpr list) : SynExpr =
SynExpr.Tuple (false, args, List.replicate (args.Length - 1) range0, range0)
let inline tuple (args : SynExpr list) = args |> tupleNoParen |> paren
/// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct)
let startAsTask (ct : Ident) (body : SynExpr) =
let lambda =
[
createIdent "a"
equals
(SynExpr.LongIdent (true, SynLongIdent.createS "cancellationToken", None, range0))
(createIdent' ct)
]
|> tuple
|> applyFunction (createLongIdent [ "Async" ; "StartAsTask" ])
|> createLambda "a"
pipeThroughFunction lambda body
let inline createForEach (pat : SynPat) (enumExpr : SynExpr) (body : SynExpr) : SynExpr =
SynExpr.ForEach (
DebugPointAtFor.No,
DebugPointAtInOrTo.No,
SeqExprOnly.SeqExprOnly false,
true,
pat,
enumExpr,
body,
range0
)
let inline createLet (bindings : SynBinding list) (body : SynExpr) : SynExpr =
SynExpr.LetOrUse (false, false, bindings, body, range0, SynExprLetOrUseTrivia.empty)
let inline createDo (body : SynExpr) : SynExpr = SynExpr.Do (body, range0)
let inline createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr =
SynExpr.Match (
DebugPointAtBinding.Yes range0,
matchOn,
cases,
range0,
{
MatchKeyword = range0
WithKeyword = range0
}
)
let typeAnnotate (ty : SynType) (expr : SynExpr) : SynExpr = SynExpr.Typed (expr, ty, range0)
let inline createNew (ty : SynType) (args : SynExpr) : SynExpr =
SynExpr.New (false, ty, paren args, range0)
let inline createWhile (cond : SynExpr) (body : SynExpr) : SynExpr =
SynExpr.While (DebugPointAtWhile.Yes range0, cond, body, range0)
let inline createNull () : SynExpr = SynExpr.Null range0
let reraise : SynExpr = createIdent "reraise" |> applyTo (SynExpr.CreateConst ())
let sequential (exprs : SynExpr list) : SynExpr =
exprs
|> List.reduce (fun a b -> SynExpr.Sequential (DebugPointAtSequential.SuppressNeither, false, a, b, range0))
let listLiteral (elts : SynExpr list) : SynExpr =
SynExpr.ArrayOrListComputed (false, sequential elts, range0)
let arrayLiteral (elts : SynExpr list) : SynExpr =
SynExpr.ArrayOrListComputed (true, sequential elts, range0)
/// {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.named lhs,
rhs,
[],
state,
range0,
{
EqualsRange = Some range0
}
)
| Let (lhs, rhs) -> createLet [ SynBinding.basic [ Ident.create lhs ] [] rhs ] state
| Use (lhs, rhs) ->
SynExpr.LetOrUse (
false,
true,
[ SynBinding.basic [ Ident.create lhs ] [] rhs ],
state,
range0,
{
SynExprLetOrUseTrivia.InKeyword = None
}
)
| Do body -> sequential [ SynExpr.Do (body, range0) ; state ]
)
applyFunction (createIdent compExpr) (SynExpr.ComputationExpr (false, contents, range0))
/// {expr} |> Async.AwaitTask
let awaitTask (expr : SynExpr) : SynExpr =
expr |> pipeThroughFunction (createLongIdent [ "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.CreateConst "yyyy-MM-dd")
| DateTime -> ident |> callMethodArg "ToString" (SynExpr.CreateConst "yyyy-MM-ddTHH:mm:ss")
| _ -> callMethod "ToString" ident
let upcast' (ty : SynType) (e : SynExpr) = SynExpr.Upcast (e, ty, range0)
/// {ident} - {rhs}
let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr =
createAppInfix (createLongIdent'' SynLongIdent.sub) (createLongIdent'' ident)
|> applyTo rhs
/// {ident} - {n}
let minusN (ident : SynLongIdent) (n : int) : SynExpr = minus ident (SynExpr.CreateConst n)
/// {y} > {x}
let greaterThan (x : SynExpr) (y : SynExpr) : SynExpr =
createAppInfix (createLongIdent'' SynLongIdent.gt) y |> applyTo x
/// {y} < {x}
let lessThan (x : SynExpr) (y : SynExpr) : SynExpr =
createAppInfix (createLongIdent'' SynLongIdent.lt) y |> applyTo x
/// {y} >= {x}
let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr =
createAppInfix (createLongIdent'' SynLongIdent.geq) y |> applyTo x
/// {y} <= {x}
let lessThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr =
createAppInfix (createLongIdent'' SynLongIdent.leq) y |> applyTo x
/// {x} :: {y}
let listCons (x : SynExpr) (y : SynExpr) : SynExpr =
createAppInfix
(SynExpr.LongIdent (
false,
SynLongIdent.SynLongIdent (
[ Ident.create "op_ColonColon" ],
[],
[ Some (IdentTrivia.OriginalNotation "::") ]
),
None,
range0
))
(tupleNoParen [ x ; y ])
|> paren
let assign (lhs : SynLongIdent) (rhs : SynExpr) : SynExpr = SynExpr.LongIdentSet (lhs, rhs, range0)
let assignIndex (lhs : SynExpr) (index : SynExpr) (rhs : SynExpr) : SynExpr =
SynExpr.DotIndexedSet (lhs, index, rhs, range0, range0, range0)

View File

@@ -1,10 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.SyntaxTrivia
[<RequireQualifiedAccess>]
module internal SynExprLetOrUseTrivia =
let empty : SynExprLetOrUseTrivia =
{
InKeyword = None
}

View File

@@ -1,76 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Text.Range
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
/// The data needed to reconstitute a single piece of data within a union field, or a single record field.
/// This is generic on whether the field is identified. For example, in `type Foo = Blah of int`, the `int`
/// field is not identified; whereas in `type Foo = Blah of baz : int`, it is identified.
type SynFieldData<'Ident> =
{
/// Attributes on this field. I think you can only get these if this is a *record* field.
Attrs : SynAttribute list
/// The identifier of this field (see docstring for SynFieldData).
Ident : 'Ident
/// The type of the data contained in this field. For example, `type Foo = { Blah : int }`
/// has this being `int`.
Type : SynType
}
[<RequireQualifiedAccess>]
module internal SynField =
/// Get the useful information out of a SynField.
let extract (SynField (attrs, _, id, fieldType, _, _, _, _, _)) : SynFieldData<Ident option> =
{
Attrs = attrs |> List.collect (fun l -> l.Attributes)
Ident = id
Type = fieldType
}
let mapIdent<'a, 'b> (f : 'a -> 'b) (x : SynFieldData<'a>) : SynFieldData<'b> =
let ident = f x.Ident
{
Attrs = x.Attrs
Ident = ident
Type = x.Type
}
/// Throws if the field has no identifier.
let extractWithIdent (f : SynField) : SynFieldData<Ident> =
f
|> extract
|> mapIdent (fun ident ->
match ident with
| None -> failwith "expected field identifier to have a value, but it did not"
| Some i -> i
)
let make (data : SynFieldData<Ident option>) : SynField =
let attrs : SynAttributeList list =
data.Attrs
|> List.map (fun l ->
{
Attributes = [ l ]
Range = range0
}
)
SynField.SynField (
attrs,
false,
data.Ident,
data.Type,
false,
PreXmlDoc.Empty,
None,
range0,
SynFieldTrivia.Zero
)
let withDocString (doc : PreXmlDoc) (f : SynField) : SynField =
match f with
| SynField (attributes, isStatic, idOpt, fieldType, isMutable, _, accessibility, range, trivia) ->
SynField (attributes, isStatic, idOpt, fieldType, isMutable, doc, accessibility, range, trivia)

View File

@@ -1,10 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
[<RequireQualifiedAccess>]
module internal SynIdent =
let inline createI (i : Ident) : SynIdent = SynIdent.SynIdent (i, None)
let inline createS (i : string) : SynIdent =
SynIdent.SynIdent (Ident.create i, None)

View File

@@ -1,140 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Text.Range
open Fantomas.FCS.Syntax
[<RequireQualifiedAccess>]
module internal SynLongIdent =
let geq =
SynLongIdent.SynLongIdent (
[ Ident.create "op_GreaterThanOrEqual" ],
[],
[ Some (IdentTrivia.OriginalNotation ">=") ]
)
let leq =
SynLongIdent.SynLongIdent (
[ Ident.create "op_LessThanOrEqual" ],
[],
[ Some (IdentTrivia.OriginalNotation "<=") ]
)
let gt =
SynLongIdent.SynLongIdent ([ Ident.create "op_GreaterThan" ], [], [ Some (IdentTrivia.OriginalNotation ">") ])
let lt =
SynLongIdent.SynLongIdent ([ Ident.create "op_LessThan" ], [], [ Some (IdentTrivia.OriginalNotation "<") ])
let sub =
SynLongIdent.SynLongIdent ([ Ident.create "op_Subtraction" ], [], [ Some (IdentTrivia.OriginalNotation "-") ])
let eq =
SynLongIdent.SynLongIdent ([ Ident.create "op_Equality" ], [], [ Some (IdentTrivia.OriginalNotation "=") ])
let booleanAnd =
SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanAnd" ], [], [ Some (IdentTrivia.OriginalNotation "&&") ])
let booleanOr =
SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanOr" ], [], [ Some (IdentTrivia.OriginalNotation "||") ])
let plus =
SynLongIdent.SynLongIdent ([ Ident.create "op_Addition" ], [], [ Some (IdentTrivia.OriginalNotation "+") ])
let times =
SynLongIdent.SynLongIdent ([ Ident.create "op_Multiply" ], [], [ Some (IdentTrivia.OriginalNotation "*") ])
let pipe =
SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ])
let toString (sli : SynLongIdent) : string =
sli.LongIdent |> List.map _.idText |> String.concat "."
let create (ident : LongIdent) : SynLongIdent =
let commas =
match ident with
| [] -> []
| _ :: commas -> commas |> List.map (fun _ -> range0)
SynLongIdent.SynLongIdent (ident, commas, List.replicate ident.Length None)
let inline createI (i : Ident) : SynLongIdent = create [ i ]
let inline createS (s : string) : SynLongIdent = createI (Ident (s, range0))
let inline createS' (s : string list) : SynLongIdent =
create (s |> List.map (fun i -> Ident (i, range0)))
let isUnit (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when System.String.Equals (i.idText, "unit", System.StringComparison.OrdinalIgnoreCase) -> true
| _ -> false
let isList (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when System.String.Equals (i.idText, "list", System.StringComparison.OrdinalIgnoreCase) -> true
// TODO: consider FSharpList or whatever it is
| _ -> false
let isArray (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when
System.String.Equals (i.idText, "array", System.StringComparison.OrdinalIgnoreCase)
|| System.String.Equals (i.idText, "[]", System.StringComparison.Ordinal)
->
true
| _ -> false
let isOption (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when System.String.Equals (i.idText, "option", System.StringComparison.OrdinalIgnoreCase) -> true
// TODO: consider Microsoft.FSharp.Option or whatever it is
| _ -> false
let isChoice (ident : SynLongIdent) : bool =
match ident.LongIdent with
| [ i ] when System.String.Equals (i.idText, "Choice", System.StringComparison.Ordinal) -> true
// TODO: consider Microsoft.FSharp.Choice or whatever it is
| _ -> false
let isNullable (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "System" ; "Nullable" ]
| [ "Nullable" ] -> true
| _ -> false
let isResponse (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "Response" ]
| [ "RestEase" ; "Response" ] -> true
| _ -> false
let isMap (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "Map" ] -> true
| _ -> false
let isReadOnlyDictionary (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "IReadOnlyDictionary" ]
| [ "Generic" ; "IReadOnlyDictionary" ]
| [ "Collections" ; "Generic" ; "IReadOnlyDictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "IReadOnlyDictionary" ] -> true
| _ -> false
let isDictionary (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "Dictionary" ]
| [ "Generic" ; "Dictionary" ]
| [ "Collections" ; "Generic" ; "Dictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "Dictionary" ] -> true
| _ -> false
let isIDictionary (ident : SynLongIdent) : bool =
match ident.LongIdent |> List.map _.idText with
| [ "IDictionary" ]
| [ "Generic" ; "IDictionary" ]
| [ "Collections" ; "Generic" ; "IDictionary" ]
| [ "System" ; "Collections" ; "Generic" ; "IDictionary" ] -> true
| _ -> false

View File

@@ -1,24 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynMatchClause =
let create (lhs : SynPat) (rhs : SynExpr) : SynMatchClause =
SynMatchClause.SynMatchClause (
lhs,
None,
rhs,
range0,
DebugPointAtTarget.Yes,
{
ArrowRange = Some range0
BarRange = Some range0
}
)
let withWhere (where : SynExpr) (m : SynMatchClause) : SynMatchClause =
match m with
| SynMatchClause (synPat, _, resultExpr, range, debugPointAtTarget, synMatchClauseTrivia) ->
SynMatchClause (synPat, Some where, resultExpr, range, debugPointAtTarget, synMatchClauseTrivia)

View File

@@ -1,71 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Text.Range
open Fantomas.FCS.Xml
[<RequireQualifiedAccess>]
module internal SynMemberDefn =
let private interfaceMemberSlotFlags =
{
SynMemberFlags.IsInstance = true
SynMemberFlags.IsDispatchSlot = true
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
let abstractMember
(attrs : SynAttribute list)
(ident : SynIdent)
(typars : SynTyparDecls option)
(arity : SynValInfo)
(xmlDoc : PreXmlDoc)
(returnType : SynType)
: SynMemberDefn
=
let slot =
SynValSig.SynValSig (
attrs
|> List.map (fun attr ->
{
Attributes = [ attr ]
Range = range0
}
),
ident,
SynValTyparDecls.SynValTyparDecls (typars, true),
returnType,
arity,
false,
false,
xmlDoc,
None,
None,
range0,
{
EqualsRange = None
WithKeyword = None
InlineKeyword = None
LeadingKeyword = SynLeadingKeyword.Abstract range0
}
)
SynMemberDefn.AbstractSlot (
slot,
interfaceMemberSlotFlags,
range0,
{
GetSetKeywords = None
}
)
let staticMember (binding : SynBinding) : SynMemberDefn =
let binding = SynBinding.makeStaticMember binding
SynMemberDefn.Member (binding, range0)
let memberImplementation (binding : SynBinding) : SynMemberDefn =
let binding = SynBinding.makeInstanceMember binding
SynMemberDefn.Member (binding, range0)

View File

@@ -1,30 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynModuleDecl =
let inline openAny (ident : SynOpenDeclTarget) : SynModuleDecl = SynModuleDecl.Open (ident, range0)
let inline createLets (bindings : SynBinding list) : SynModuleDecl =
SynModuleDecl.Let (false, bindings, range0)
let inline createLet (binding : SynBinding) : SynModuleDecl = createLets [ binding ]
let inline createTypes (tys : SynTypeDefn list) : SynModuleDecl = SynModuleDecl.Types (tys, range0)
let nestedModule (info : SynComponentInfo) (decls : SynModuleDecl list) : SynModuleDecl =
SynModuleDecl.NestedModule (
info,
false,
decls,
false,
range0,
{
ModuleKeyword = Some range0
EqualsRange = Some range0
}
)

View File

@@ -1,24 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynModuleOrNamespace =
let createNamespace (name : LongIdent) (decls : SynModuleDecl list) =
SynModuleOrNamespace.SynModuleOrNamespace (
name,
false,
SynModuleOrNamespaceKind.DeclaredNamespace,
decls,
PreXmlDoc.Empty,
[],
None,
range0,
{
LeadingKeyword = SynModuleOrNamespaceLeadingKeyword.Namespace range0
}
)

View File

@@ -1,54 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynPat =
let inline paren (pat : SynPat) : SynPat = SynPat.Paren (pat, range0)
let anon : SynPat = SynPat.Wild range0
let inline annotateTypeNoParen (ty : SynType) (pat : SynPat) = SynPat.Typed (pat, ty, range0)
let inline annotateType (ty : SynType) (pat : SynPat) = paren (annotateTypeNoParen ty pat)
let inline named (s : string) : SynPat =
SynPat.Named (SynIdent.SynIdent (Ident (s, range0), None), false, None, range0)
let inline namedI (i : Ident) : SynPat =
SynPat.Named (SynIdent.SynIdent (i, None), false, None, range0)
let inline identWithArgs (i : LongIdent) (args : SynArgPats) : SynPat =
SynPat.LongIdent (SynLongIdent.create i, None, None, args, None, range0)
let inline nameWithArgs (i : string) (args : SynPat list) : SynPat =
identWithArgs [ Ident.create i ] (SynArgPats.create args)
let inline tupleNoParen (elements : SynPat list) : SynPat =
match elements with
| [] -> failwith "Can't tuple no elements in a pattern"
| [ p ] -> p
| elements -> SynPat.Tuple (false, elements, List.replicate (elements.Length - 1) range0, range0)
let inline tuple (elements : SynPat list) : SynPat = tupleNoParen elements |> paren
let inline createConst (c : SynConst) = SynPat.Const (c, range0)
let unit = createConst SynConst.Unit
let createNull = SynPat.Null range0
let emptyList = SynPat.ArrayOrList (false, [], range0)
let listCons (lhs : SynPat) (rhs : SynPat) =
SynPat.ListCons (
lhs,
rhs,
range0,
{
ColonColonRange = range0
}
)
let emptyArray = SynPat.ArrayOrList (true, [], range0)

View File

@@ -1,10 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynSimplePat =
let createId (id : Ident) : SynSimplePat =
SynSimplePat.Id (id, None, false, false, false, range0)

View File

@@ -1,12 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynSimplePats =
let create (pats : SynSimplePat list) : SynSimplePats =
match pats with
| [] -> SynSimplePats.SimplePats ([], [], range0)
| pats -> SynSimplePats.SimplePats (pats, List.replicate (pats.Length - 1) range0, range0)

View File

@@ -1,539 +0,0 @@
namespace WoofWare.Myriad.Plugins
open System
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<AutoOpen>]
module internal SynTypePatterns =
let (|OptionType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isOption ident ->
Some innerType
| _ -> None
let (|ChoiceType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, inner, _, _, _, _) when SynLongIdent.isChoice ident -> Some inner
| _ -> None
let (|NullableType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isNullable ident ->
Some innerType
| _ -> None
let (|UnitType|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident when SynLongIdent.isUnit ident -> Some ()
| _ -> None
let (|ListType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isList ident ->
Some innerType
| _ -> None
let (|ArrayType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isArray ident ->
Some innerType
| SynType.Array (1, innerType, _) -> Some innerType
| _ -> None
let (|RestEaseResponseType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when SynLongIdent.isResponse ident ->
Some innerType
| _ -> None
let (|DictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when SynLongIdent.isDictionary ident ->
Some (key, value)
| _ -> None
let (|IDictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when SynLongIdent.isIDictionary ident ->
Some (key, value)
| _ -> None
let (|IReadOnlyDictionaryType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when
SynLongIdent.isReadOnlyDictionary ident
->
Some (key, value)
| _ -> None
let (|MapType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ key ; value ], _, _, _, _) when SynLongIdent.isMap ident ->
Some (key, value)
| _ -> None
let (|BigInt|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map _.idText with
| [ "bigint" ]
| [ "BigInteger" ]
| [ "Numerics" ; "BigInteger" ]
| [ "System" ; "Numerics" ; "BigInteger" ] -> Some ()
| _ -> None
| _ -> None
/// Returns the type, qualified as in e.g. `System.Boolean`.
let (|PrimitiveType|_|) (fieldType : SynType) : LongIdent option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] -> Primitives.qualifyType i.idText
| _ -> None
| _ -> None
let (|String|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] ->
[ "string" ]
|> List.tryFind (fun s -> s = i.idText)
|> Option.map ignore<string>
| _ -> None
| _ -> None
let (|Byte|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] -> [ "byte" ] |> List.tryFind (fun s -> s = i.idText) |> Option.map ignore<string>
| _ -> None
| _ -> None
let (|Guid|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map (fun i -> i.idText) with
| [ "System" ; "Guid" ]
| [ "Guid" ] -> Some ()
| _ -> None
| _ -> None
let (|HttpResponseMessage|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map (fun i -> i.idText) with
| [ "System" ; "Net" ; "Http" ; "HttpResponseMessage" ]
| [ "Net" ; "Http" ; "HttpResponseMessage" ]
| [ "Http" ; "HttpResponseMessage" ]
| [ "HttpResponseMessage" ] -> Some ()
| _ -> None
| _ -> None
let (|HttpContent|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map (fun i -> i.idText) with
| [ "System" ; "Net" ; "Http" ; "HttpContent" ]
| [ "Net" ; "Http" ; "HttpContent" ]
| [ "Http" ; "HttpContent" ]
| [ "HttpContent" ] -> Some ()
| _ -> None
| _ -> None
let (|Stream|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent |> List.map (fun i -> i.idText) with
| [ "System" ; "IO" ; "Stream" ]
| [ "IO" ; "Stream" ]
| [ "Stream" ] -> Some ()
| _ -> None
| _ -> None
let (|NumberType|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent ident ->
match ident.LongIdent with
| [ i ] ->
// We won't bother with the case that the user has done e.g. `Single` (relying on `System` being open).
match Primitives.qualifyType i.idText with
| Some qualified ->
match i.idText with
| "char"
| "string" -> None
| _ -> Some qualified
| None -> None
| _ -> None
| _ -> None
/// Returns the name of the measure, and the outer type.
let (|Measure|_|) (fieldType : SynType) : (Ident * LongIdent) option =
match fieldType with
| SynType.App (NumberType outer,
_,
[ SynType.LongIdent (SynLongIdent.SynLongIdent ([ ident ], _, _)) ],
_,
_,
_,
_) -> Some (ident, outer)
| _ -> None
let (|JsonNode|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
| [ "Text" ; "Json" ; "Nodes" ; "JsonNode" ]
| [ "Json" ; "Nodes" ; "JsonNode" ]
| [ "Nodes" ; "JsonNode" ]
| [ "JsonNode" ] -> Some ()
| _ -> None
| _ -> None
let (|Unit|_|) (fieldType : SynType) : unit option =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText.ToLowerInvariant ()) with
| [ "microsoft" ; "fsharp" ; "core" ; "unit" ]
| [ "fsharp" ; "core" ; "unit" ]
| [ "core" ; "unit" ]
| [ "unit" ] -> Some ()
| _ -> None
| _ -> None
let (|DateOnly|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "DateOnly" ]
| [ "DateOnly" ] -> Some ()
| _ -> None
| _ -> None
let (|DateTime|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "DateTime" ]
| [ "DateTime" ] -> Some ()
| _ -> None
| _ -> None
let (|DateTimeOffset|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "DateTimeOffset" ]
| [ "DateTimeOffset" ] -> Some ()
| _ -> None
| _ -> None
let (|Uri|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "Uri" ]
| [ "Uri" ] -> Some ()
| _ -> None
| _ -> None
let (|Task|_|) (fieldType : SynType) : SynType option =
match fieldType with
| SynType.App (SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)), _, args, _, _, _, _) ->
match ident |> List.map (fun i -> i.idText) with
| [ "Task" ]
| [ "Tasks" ; "Task" ]
| [ "Threading" ; "Tasks" ; "Task" ]
| [ "System" ; "Threading" ; "Tasks" ; "Task" ] ->
match args with
| [ arg ] -> Some arg
| _ -> failwithf "Expected Task to be applied to exactly one arg, but got: %+A" args
| _ -> None
| _ -> None
let (|DirectoryInfo|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "IO" ; "DirectoryInfo" ]
| [ "IO" ; "DirectoryInfo" ]
| [ "DirectoryInfo" ] -> Some ()
| _ -> None
| _ -> None
let (|FileInfo|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "IO" ; "FileInfo" ]
| [ "IO" ; "FileInfo" ]
| [ "FileInfo" ] -> Some ()
| _ -> None
| _ -> None
let (|TimeSpan|_|) (fieldType : SynType) =
match fieldType with
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->
match ident |> List.map (fun i -> i.idText) with
| [ "System" ; "TimeSpan" ]
| [ "TimeSpan" ] -> Some ()
| _ -> None
| _ -> None
[<RequireQualifiedAccess>]
module internal SynType =
let rec stripOptionalParen (ty : SynType) : SynType =
match ty with
| SynType.Paren (ty, _) -> stripOptionalParen ty
| ty -> ty
let inline paren (ty : SynType) : SynType = SynType.Paren (ty, range0)
let inline createLongIdent (ident : LongIdent) : SynType =
SynType.LongIdent (SynLongIdent.create ident)
let inline createLongIdent' (ident : string list) : SynType =
SynType.LongIdent (SynLongIdent.createS' ident)
let inline named (name : string) = createLongIdent' [ name ]
let inline app' (name : SynType) (args : SynType list) : SynType =
if args.IsEmpty then
failwith "Type cannot be applied to no arguments"
SynType.App (name, Some range0, args, List.replicate (args.Length - 1) range0, Some range0, false, range0)
let inline app (name : string) (args : SynType list) : SynType = app' (named name) args
/// Returns None if the input list was empty.
let inline tupleNoParen (ty : SynType list) : SynType option =
match List.rev ty with
| [] -> None
| [ t ] -> Some t
| t :: rest ->
([ SynTupleTypeSegment.Type t ], rest)
||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
|> fun segs -> SynType.Tuple (false, segs, range0)
|> Some
let inline appPostfix (name : string) (arg : SynType) : SynType =
SynType.App (named name, None, [ arg ], [], None, true, range0)
let inline appPostfix' (name : string list) (arg : SynType) : SynType =
SynType.App (createLongIdent' name, None, [ arg ], [], None, true, range0)
let inline funFromDomain (domain : SynType) (range : SynType) : SynType =
SynType.Fun (
domain,
range,
range0,
{
ArrowRange = range0
}
)
let inline signatureParamOfType
(attrs : SynAttribute list)
(ty : SynType)
(optional : bool)
(name : Ident option)
: SynType
=
SynType.SignatureParameter (
attrs
|> List.map (fun attr ->
{
Attributes = [ attr ]
Range = range0
}
),
optional,
name,
ty,
range0
)
let inline var (ty : SynTypar) : SynType = SynType.Var (ty, range0)
let unit : SynType = named "unit"
let obj : SynType = named "obj"
let bool : SynType = named "bool"
let int : SynType = named "int"
let array (elt : SynType) : SynType = SynType.Array (1, elt, range0)
let list (elt : SynType) : SynType =
SynType.App (named "list", None, [ elt ], [], None, true, range0)
let option (elt : SynType) : SynType =
SynType.App (named "option", None, [ elt ], [], None, true, range0)
let anon : SynType = SynType.Anon range0
let task (elt : SynType) : SynType =
SynType.App (
createLongIdent' [ "System" ; "Threading" ; "Tasks" ; "Task" ],
None,
[ elt ],
[],
None,
true,
range0
)
let string : SynType = named "string"
/// Given ['a1, 'a2] and 'ret, returns 'a1 -> 'a2 -> 'ret.
let toFun (inputs : SynType list) (ret : SynType) : SynType =
(ret, List.rev inputs) ||> List.fold (fun ty input -> funFromDomain input ty)
let primitiveToHumanReadableString (name : LongIdent) : string =
match name |> List.map _.idText with
| [ "System" ; "Single" ] -> "single"
| [ "System" ; "Double" ] -> "double"
| [ "System" ; "Byte" ] -> "byte"
| [ "System" ; "SByte" ] -> "signed byte"
| [ "System" ; "Int16" ] -> "int16"
| [ "System" ; "Int32" ] -> "int32"
| [ "System" ; "Int64" ] -> "int64"
| [ "System" ; "UInt16" ] -> "uint16"
| [ "System" ; "UInt32" ] -> "uint32"
| [ "System" ; "UInt64" ] -> "uint64"
| [ "System" ; "Char" ] -> "char"
| [ "System" ; "Decimal" ] -> "decimal"
| [ "System" ; "String" ] -> "string"
| [ "System" ; "Boolean" ] -> "bool"
| ty ->
ty
|> String.concat "."
|> failwithf "could not create human-readable string for primitive type %s"
let rec toHumanReadableString (ty : SynType) : string =
match ty with
| PrimitiveType t1 -> primitiveToHumanReadableString t1
| OptionType t1 -> toHumanReadableString t1 + " option"
| NullableType t1 -> toHumanReadableString t1 + " Nullable"
| ChoiceType ts ->
ts
|> List.map toHumanReadableString
|> String.concat ", "
|> sprintf "Choice<%s>"
| MapType (k, v)
| DictionaryType (k, v)
| IDictionaryType (k, v)
| IReadOnlyDictionaryType (k, v) -> sprintf "map<%s, %s>" (toHumanReadableString k) (toHumanReadableString v)
| ListType t1 -> toHumanReadableString t1 + " list"
| ArrayType t1 -> toHumanReadableString t1 + " array"
| Task t1 -> toHumanReadableString t1 + " Task"
| UnitType -> "unit"
| FileInfo -> "FileInfo"
| DirectoryInfo -> "DirectoryInfo"
| Uri -> "URI"
| Stream -> "Stream"
| Guid -> "GUID"
| BigInt -> "bigint"
| DateTimeOffset -> "DateTimeOffset"
| DateOnly -> "DateOnly"
| TimeSpan -> "TimeSpan"
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> ident |> List.map _.idText |> String.concat "."
| ty -> failwithf "could not compute human-readable string for type: %O" ty
/// Guess whether the types are equal. We err on the side of saying "no, they're different".
let rec provablyEqual (ty1 : SynType) (ty2 : SynType) : bool =
if Object.ReferenceEquals (ty1, ty2) then
true
else
match ty1 with
| PrimitiveType t1 ->
match ty2 with
| PrimitiveType t2 -> (t1 |> List.map _.idText) = (t2 |> List.map _.idText)
| _ -> false
| OptionType t1 ->
match ty2 with
| OptionType t2 -> provablyEqual t1 t2
| _ -> false
| NullableType t1 ->
match ty2 with
| NullableType t2 -> provablyEqual t1 t2
| _ -> false
| ChoiceType t1 ->
match ty2 with
| ChoiceType t2 ->
t1.Length = t2.Length
&& List.forall (fun (a, b) -> provablyEqual a b) (List.zip t1 t2)
| _ -> false
| DictionaryType (k1, v1) ->
match ty2 with
| DictionaryType (k2, v2) -> provablyEqual k1 k2 && provablyEqual v1 v2
| _ -> false
| IDictionaryType (k1, v1) ->
match ty2 with
| IDictionaryType (k2, v2) -> provablyEqual k1 k2 && provablyEqual v1 v2
| _ -> false
| IReadOnlyDictionaryType (k1, v1) ->
match ty2 with
| IReadOnlyDictionaryType (k2, v2) -> provablyEqual k1 k2 && provablyEqual v1 v2
| _ -> false
| MapType (k1, v1) ->
match ty2 with
| MapType (k2, v2) -> provablyEqual k1 k2 && provablyEqual v1 v2
| _ -> false
| ListType t1 ->
match ty2 with
| ListType t2 -> provablyEqual t1 t2
| _ -> false
| ArrayType t1 ->
match ty2 with
| ArrayType t2 -> provablyEqual t1 t2
| _ -> false
| Task t1 ->
match ty2 with
| Task t2 -> provablyEqual t1 t2
| _ -> false
| UnitType ->
match ty2 with
| UnitType -> true
| _ -> false
| FileInfo ->
match ty2 with
| FileInfo -> true
| _ -> false
| DirectoryInfo ->
match ty2 with
| DirectoryInfo -> true
| _ -> false
| Uri ->
match ty2 with
| Uri -> true
| _ -> false
| Stream ->
match ty2 with
| Stream -> true
| _ -> false
| Guid ->
match ty2 with
| Guid -> true
| _ -> false
| BigInt ->
match ty2 with
| BigInt -> true
| _ -> false
| DateTimeOffset ->
match ty2 with
| DateTimeOffset -> true
| _ -> false
| DateOnly ->
match ty2 with
| DateOnly -> true
| _ -> false
| _ ->
match ty1, ty2 with
| SynType.LongIdent (SynLongIdent (ident1, _, _)), SynType.LongIdent (SynLongIdent (ident2, _, _)) ->
let ident1 = ident1 |> List.map _.idText
let ident2 = ident2 |> List.map _.idText
ident1 = ident2
| _, _ -> false

View File

@@ -1,46 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynTypeDefn =
let inline create (componentInfo : SynComponentInfo) (repr : SynTypeDefnRepr) : SynTypeDefn =
SynTypeDefn.SynTypeDefn (
componentInfo,
repr,
[],
None,
range0,
{
LeadingKeyword = SynTypeDefnLeadingKeyword.Type range0
EqualsRange = Some range0
WithKeyword = None
}
)
let inline withMemberDefns (members : SynMemberDefn list) (r : SynTypeDefn) : SynTypeDefn =
match r with
| SynTypeDefn (typeInfo, typeRepr, _, ctor, range, trivia) ->
SynTypeDefn.SynTypeDefn (typeInfo, typeRepr, members, ctor, range, trivia)
let getName (defn : SynTypeDefn) : LongIdent =
match defn with
| SynTypeDefn (SynComponentInfo.SynComponentInfo (_, _, _, id, _, _, _, _), _, _, _, _, _) -> id
let getAttribute (attrName : string) (defn : SynTypeDefn) : SynAttribute option =
match defn with
| SynTypeDefn (SynComponentInfo.SynComponentInfo (attrs, _, _, _, _, _, _, _), _, _, _, _, _) ->
attrs
|> List.collect (fun a -> a.Attributes)
|> List.tryFind (fun i ->
match i.TypeName with
| SynLongIdent.SynLongIdent (id, _, _) ->
let name = List.last(id).idText
name = attrName || name + "Attribute" = attrName
)
let hasAttribute (attrName : string) (defn : SynTypeDefn) : bool =
getAttribute attrName defn |> Option.isSome

View File

@@ -1,24 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynTypeDefnRepr =
let inline interfaceType (mems : SynMemberDefns) : SynTypeDefnRepr =
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Unspecified, mems, range0)
/// Indicates the body of a `type Foo with {body}` extension type declaration.
let inline augmentation () : SynTypeDefnRepr =
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0)
let inline unionWithAccess (implAccess : SynAccess option) (cases : SynUnionCase list) : SynTypeDefnRepr =
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (implAccess, cases, range0), range0)
let inline union (cases : SynUnionCase list) : SynTypeDefnRepr = unionWithAccess None cases
let inline recordWithAccess (implAccess : SynAccess option) (fields : SynField list) : SynTypeDefnRepr =
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (implAccess, fields, range0), range0)
let inline record (fields : SynField list) : SynTypeDefnRepr = recordWithAccess None fields

View File

@@ -1,55 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
open Fantomas.FCS.Xml
open Fantomas.FCS.SyntaxTrivia
/// Represents everything you need to know about a union case.
/// This is generic on whether each field of this case must be named.
type UnionCase<'ident> =
{
/// The name of the case: e.g. `| Foo of blah` has this being `Foo`.
Name : Ident
/// Any docstring associated with this case.
XmlDoc : PreXmlDoc option
/// Any accessibility modifier: e.g. `type Foo = private | Blah`.
Access : SynAccess option
/// Attributes on the case: for example, `| [<Attr>] Foo of blah`.
Attributes : SynAttribute list
/// The data contained within the case: for example, `[blah]` in `| Foo of blah`.
Fields : SynFieldData<'ident> list
}
[<RequireQualifiedAccess>]
module internal SynUnionCase =
let create (case : UnionCase<Ident option>) : SynUnionCase =
let fields =
case.Fields
|> List.map (fun field ->
SynField.SynField (
SynAttributes.ofAttrs field.Attrs,
false,
field.Ident,
field.Type,
false,
PreXmlDoc.Empty,
None,
range0,
{
LeadingKeyword = None
}
)
)
SynUnionCase.SynUnionCase (
SynAttributes.ofAttrs case.Attributes,
SynIdent.createI case.Name,
SynUnionCaseKind.Fields fields,
case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
case.Access,
range0,
{
BarRange = Some range0
}
)

View File

@@ -1,7 +0,0 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
[<RequireQualifiedAccess>]
module internal SynValInfo =
let empty = SynValInfo.SynValInfo ([], SynArgInfo.empty)

View File

@@ -1,18 +0,0 @@
namespace WoofWare.Myriad.Plugins
// Extracted from https://github.com/G-Research/TypeEquality
// which is Apache-2.0 licenced. See `TeqLicence.txt`.
// We inline this code because Myriad doesn't seem to reliably load package references in the generator.
// I have reformatted a little, and stripped out all the code I don't use.
type internal Teq<'a, 'b> = private | Teq of ('a -> 'b) * ('b -> 'a)
[<RequireQualifiedAccess>]
module internal Teq =
let refl<'a> : Teq<'a, 'a> = Teq (id, id)
let cast (Teq (f, _)) a = f a
[<RequireQualifiedAccess>]
module Cong =
let believeMe<'a, 'b, 'a2, 'b2> (_ : Teq<'a, 'b>) : Teq<'a2, 'b2> = unbox <| (refl : Teq<'a2, 'a2>)

View File

@@ -15,10 +15,13 @@
<WarnOn>FS3559</WarnOn>
<PackageId>WoofWare.Myriad.Plugins</PackageId>
<PackageIcon>logo.png</PackageIcon>
<CopyLocalLockFileAssemblies>true</CopyLocalLockFileAssemblies>
</PropertyGroup>
<ItemGroup>
<PackageReference Include="Myriad.Core" Version="0.8.3" />
<PackageReference Include="TypeEquality" Version="0.3.0" />
<PackageReference Include="WoofWare.Whippet.Fantomas" Version="0.2.1" />
<!-- the lowest version allowed by Myriad.Core -->
<PackageReference Update="FSharp.Core" Version="6.0.1" PrivateAssets="all"/>
</ItemGroup>
@@ -26,37 +29,9 @@
<ItemGroup>
<Compile Include="List.fs"/>
<Compile Include="Text.fs" />
<Compile Include="Teq.fs" />
<Compile Include="Primitives.fs" />
<Compile Include="SynExpr\SynAttributes.fs" />
<Compile Include="SynExpr\SynConst.fs" />
<Compile Include="SynExpr\SynArgInfo.fs" />
<Compile Include="SynExpr\SynValInfo.fs" />
<Compile Include="SynExpr\PreXmlDoc.fs" />
<Compile Include="SynExpr\Ident.fs" />
<Compile Include="SynExpr\SynSimplePat.fs" />
<Compile Include="SynExpr\SynSimplePats.fs" />
<Compile Include="SynExpr\SynIdent.fs" />
<Compile Include="SynExpr\SynLongIdent.fs" />
<Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
<Compile Include="SynExpr\SynArgPats.fs" />
<Compile Include="SynExpr\SynPat.fs" />
<Compile Include="SynExpr\SynBinding.fs" />
<Compile Include="SynExpr\SynType.fs" />
<Compile Include="SynExpr\SynMatchClause.fs" />
<Compile Include="SynExpr\CompExpr.fs" />
<Compile Include="SynExpr\SynExpr.fs" />
<Compile Include="SynExpr\SynField.fs" />
<Compile Include="SynExpr\SynUnionCase.fs" />
<Compile Include="SynExpr\SynTypeDefnRepr.fs" />
<Compile Include="SynExpr\SynTypeDefn.fs" />
<Compile Include="SynExpr\SynComponentInfo.fs" />
<Compile Include="SynExpr\SynMemberDefn.fs" />
<Compile Include="SynExpr\SynAttribute.fs" />
<Compile Include="SynExpr\SynModuleDecl.fs" />
<Compile Include="SynExpr\SynModuleOrNamespace.fs" />
<Compile Include="Measure.fs" />
<Compile Include="AstHelper.fs" />
<Compile Include="Parameters.fs" />
<Compile Include="RemoveOptionsGenerator.fs"/>
<Compile Include="MyriadParamParser.fs" />
<Compile Include="InterfaceMockGenerator.fs"/>
@@ -67,7 +42,7 @@
<Compile Include="ArgParserGenerator.fs" />
<Compile Include="Swagger.fs" />
<Compile Include="SwaggerClientGenerator.fs" />
<None Include="TeqLicence.txt" />
<None Include="ApacheLicence.txt" />
<EmbeddedResource Include="version.json"/>
<EmbeddedResource Include="SurfaceBaseline.txt"/>
<None Include="..\README.md">

View File

@@ -1,5 +1,5 @@
{
"version": "3.1",
"version": "4.0",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],

6
flake.lock generated
View File

@@ -20,11 +20,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1727524699,
"narHash": "sha256-k6YxGj08voz9NvuKExojiGXAVd69M8COtqWSKr6sQS4=",
"lastModified": 1728093190,
"narHash": "sha256-CAZF2NRuHmqTtRTNAruWpHA43Gg2UvuCNEIzabP0l6M=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "b5b2fecd0cadd82ef107c9583018f381ae70f222",
"rev": "e2f08f4d8b3ecb5cf5c9fd9cb2d53bb3c71807da",
"type": "github"
},
"original": {

View File

@@ -326,4 +326,14 @@
version = "7.0.3";
hash = "sha256-aSJZ17MjqaZNQkprfxm/09LaCoFtpdWmqU9BTROzWX4=";
})
(fetchNuGet {
pname = "TypeEquality";
version = "0.3.0";
hash = "sha256-V50xAOzzyUJrY+MYPRxtnqW5MVeATXCes89wPprv1r4=";
})
(fetchNuGet {
pname = "WoofWare.Whippet.Fantomas";
version = "0.2.1";
hash = "sha256-38LPop5tQ14oqzi0dSzBp2m53fugIMyWed67xnZmJqk=";
})
]