mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-13 07:58:40 +00:00
Use WoofWare.Whippet.Fantomas rather than Myriad.Core (#280)
This commit is contained in:
Patrick Stevens
GitHub
@@ -4,6 +4,7 @@ open System
|
|||||||
open System.Text
|
open System.Text
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.Text.Range
|
open Fantomas.FCS.Text.Range
|
||||||
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
type internal ArgParserOutputSpec =
|
type internal ArgParserOutputSpec =
|
||||||
{
|
{
|
||||||
|
|||||||
@@ -2,173 +2,7 @@ namespace WoofWare.Myriad.Plugins
|
|||||||
|
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.Text.Range
|
open Fantomas.FCS.Text.Range
|
||||||
open Fantomas.FCS.Xml
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
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
|
|
||||||
}
|
|
||||||
|
|
||||||
/// Anything that is part of an ADT.
|
/// Anything that is part of an ADT.
|
||||||
/// A record is a product of stuff; this type represents one of those stuffs.
|
/// A record is a product of stuff; this type represents one of those stuffs.
|
||||||
|
|||||||
@@ -3,11 +3,11 @@ namespace WoofWare.Myriad.Plugins
|
|||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.SyntaxTrivia
|
open Fantomas.FCS.SyntaxTrivia
|
||||||
open Fantomas.FCS.Xml
|
open Fantomas.FCS.Xml
|
||||||
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal CataGenerator =
|
module internal CataGenerator =
|
||||||
open Fantomas.FCS.Text.Range
|
open Fantomas.FCS.Text.Range
|
||||||
open Myriad.Core.Ast
|
|
||||||
|
|
||||||
/// The user-provided DU contains cases, each of which contains fields.
|
/// 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.
|
/// 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.applyFunction (SynExpr.createLongIdent [ "Seq" ; "exactlyOne" ])
|
||||||
|> SynExpr.createLet
|
|> SynExpr.createLet
|
||||||
[
|
[
|
||||||
SynBinding.Let (
|
SynBinding.basicTuple
|
||||||
valData = SynValData.SynValData (None, SynValInfo.empty, None),
|
(allArtificialTyparNames
|
||||||
pattern =
|
|> List.map (fun (t : Ident) ->
|
||||||
SynPat.tupleNoParen (
|
SynPat.namedI (Ident.create (t.idText + "Stack") |> Ident.lowerFirstLetter)
|
||||||
allArtificialTyparNames
|
))
|
||||||
|> List.map (fun (t : Ident) ->
|
(SynExpr.applyFunction
|
||||||
SynPat.namedI (Ident.create (t.idText + "Stack") |> Ident.lowerFirstLetter)
|
(SynExpr.applyFunction (SynExpr.createIdent "loop") (SynExpr.createIdent "cata"))
|
||||||
)
|
(SynExpr.createIdent "instructions"))
|
||||||
),
|
|
||||||
expr =
|
|
||||||
SynExpr.applyFunction
|
|
||||||
(SynExpr.applyFunction (SynExpr.createIdent "loop") (SynExpr.createIdent "cata"))
|
|
||||||
(SynExpr.createIdent "instructions")
|
|
||||||
)
|
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|> SynExpr.sequential
|
|> SynExpr.sequential
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ namespace WoofWare.Myriad.Plugins
|
|||||||
open System.IO
|
open System.IO
|
||||||
open System.Net.Http
|
open System.Net.Http
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
type internal HttpClientGeneratorOutputSpec =
|
type internal HttpClientGeneratorOutputSpec =
|
||||||
{
|
{
|
||||||
@@ -643,7 +644,7 @@ module internal HttpClientGenerator =
|
|||||||
yield jsonNode
|
yield jsonNode
|
||||||
| String -> yield responseString
|
| String -> yield responseString
|
||||||
| Stream -> yield responseStream
|
| Stream -> yield responseStream
|
||||||
| Unit ->
|
| UnitType ->
|
||||||
// What we're returning doesn't depend on the content, so don't bother!
|
// What we're returning doesn't depend on the content, so don't bother!
|
||||||
()
|
()
|
||||||
| _ ->
|
| _ ->
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ namespace WoofWare.Myriad.Plugins
|
|||||||
open System
|
open System
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.Xml
|
open Fantomas.FCS.Xml
|
||||||
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
type internal GenerateMockOutputSpec =
|
type internal GenerateMockOutputSpec =
|
||||||
{
|
{
|
||||||
|
|||||||
@@ -4,6 +4,7 @@ open System
|
|||||||
open System.Text
|
open System.Text
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.SyntaxTrivia
|
open Fantomas.FCS.SyntaxTrivia
|
||||||
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
type internal JsonParseOutputSpec =
|
type internal JsonParseOutputSpec =
|
||||||
{
|
{
|
||||||
@@ -280,7 +281,7 @@ module internal JsonParseGenerator =
|
|||||||
parseNumberType options propertyName node primType
|
parseNumberType options propertyName node primType
|
||||||
|> SynExpr.pipeThroughFunction (Measure.getLanguagePrimitivesMeasure primType)
|
|> SynExpr.pipeThroughFunction (Measure.getLanguagePrimitivesMeasure primType)
|
||||||
| JsonNode -> node
|
| JsonNode -> node
|
||||||
| Unit -> SynExpr.CreateConst ()
|
| UnitType -> SynExpr.CreateConst ()
|
||||||
| _ ->
|
| _ ->
|
||||||
// Let's just hope that we've also got our own type annotation!
|
// Let's just hope that we've also got our own type annotation!
|
||||||
let typeName =
|
let typeName =
|
||||||
|
|||||||
@@ -3,6 +3,7 @@ namespace WoofWare.Myriad.Plugins
|
|||||||
open System
|
open System
|
||||||
open System.Text
|
open System.Text
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
type internal JsonSerializeOutputSpec =
|
type internal JsonSerializeOutputSpec =
|
||||||
{
|
{
|
||||||
@@ -147,7 +148,7 @@ module internal JsonSerializeGenerator =
|
|||||||
|> SynExpr.createLambda "field"
|
|> SynExpr.createLambda "field"
|
||||||
|> fun e -> e, false
|
|> fun e -> e, false
|
||||||
| JsonNode -> SynExpr.createIdent "id", true
|
| JsonNode -> SynExpr.createIdent "id", true
|
||||||
| Unit ->
|
| UnitType ->
|
||||||
SynExpr.createLambda
|
SynExpr.createLambda
|
||||||
"value"
|
"value"
|
||||||
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
|
||||||
|
|||||||
@@ -1,6 +1,7 @@
|
|||||||
namespace WoofWare.Myriad.Plugins
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal Measure =
|
module internal Measure =
|
||||||
@@ -20,5 +21,4 @@ module internal Measure =
|
|||||||
| l ->
|
| l ->
|
||||||
let l = String.concat "." l
|
let l = String.concat "." l
|
||||||
failwith $"unrecognised type for measure: %s{l}"
|
failwith $"unrecognised type for measure: %s{l}"
|
||||||
|
|
||||||
|> SynExpr.createLongIdent
|
|> SynExpr.createLongIdent
|
||||||
|
|||||||
@@ -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))))
|
|
||||||
@@ -2,6 +2,7 @@ namespace WoofWare.Myriad.Plugins
|
|||||||
|
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.Xml
|
open Fantomas.FCS.Xml
|
||||||
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal RemoveOptionsGenerator =
|
module internal RemoveOptionsGenerator =
|
||||||
|
|||||||
@@ -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.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.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.Required [property]: [read-only] bool option
|
||||||
WoofWare.Myriad.Plugins.SwaggerParameter.Type [property]: [read-only] WoofWare.Myriad.Plugins.Definition
|
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
|
|
||||||
@@ -6,6 +6,7 @@ open System.Threading
|
|||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.Xml
|
open Fantomas.FCS.Xml
|
||||||
open Fantomas.FCS.Text.Range
|
open Fantomas.FCS.Text.Range
|
||||||
|
open WoofWare.Whippet.Fantomas
|
||||||
|
|
||||||
type internal SwaggerClientConfig =
|
type internal SwaggerClientConfig =
|
||||||
{
|
{
|
||||||
|
|||||||
@@ -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)
|
|
||||||
}
|
|
||||||
*)
|
|
||||||
@@ -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 ())
|
|
||||||
@@ -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)
|
|
||||||
@@ -1,7 +0,0 @@
|
|||||||
namespace WoofWare.Myriad.Plugins
|
|
||||||
|
|
||||||
open Fantomas.FCS.Syntax
|
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module internal SynArgInfo =
|
|
||||||
let empty = SynArgInfo.SynArgInfo ([], false, None)
|
|
||||||
@@ -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
|
|
||||||
@@ -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 ())
|
|
||||||
@@ -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
|
|
||||||
}
|
|
||||||
)
|
|
||||||
@@ -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)
|
|
||||||
@@ -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)
|
|
||||||
@@ -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)
|
|
||||||
@@ -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)
|
|
||||||
@@ -1,10 +0,0 @@
|
|||||||
namespace WoofWare.Myriad.Plugins
|
|
||||||
|
|
||||||
open Fantomas.FCS.SyntaxTrivia
|
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module internal SynExprLetOrUseTrivia =
|
|
||||||
let empty : SynExprLetOrUseTrivia =
|
|
||||||
{
|
|
||||||
InKeyword = None
|
|
||||||
}
|
|
||||||
@@ -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)
|
|
||||||
@@ -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)
|
|
||||||
@@ -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
|
|
||||||
@@ -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)
|
|
||||||
@@ -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)
|
|
||||||
@@ -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
|
|
||||||
}
|
|
||||||
)
|
|
||||||
@@ -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
|
|
||||||
}
|
|
||||||
)
|
|
||||||
@@ -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)
|
|
||||||
@@ -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)
|
|
||||||
@@ -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)
|
|
||||||
@@ -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
|
|
||||||
@@ -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
|
|
||||||
@@ -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
|
|
||||||
@@ -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
|
|
||||||
}
|
|
||||||
)
|
|
||||||
@@ -1,7 +0,0 @@
|
|||||||
namespace WoofWare.Myriad.Plugins
|
|
||||||
|
|
||||||
open Fantomas.FCS.Syntax
|
|
||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
|
||||||
module internal SynValInfo =
|
|
||||||
let empty = SynValInfo.SynValInfo ([], SynArgInfo.empty)
|
|
||||||
@@ -15,10 +15,12 @@
|
|||||||
<WarnOn>FS3559</WarnOn>
|
<WarnOn>FS3559</WarnOn>
|
||||||
<PackageId>WoofWare.Myriad.Plugins</PackageId>
|
<PackageId>WoofWare.Myriad.Plugins</PackageId>
|
||||||
<PackageIcon>logo.png</PackageIcon>
|
<PackageIcon>logo.png</PackageIcon>
|
||||||
|
<CopyLocalLockFileAssemblies>true</CopyLocalLockFileAssemblies>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="Myriad.Core" Version="0.8.3" />
|
<PackageReference Include="Myriad.Core" Version="0.8.3" />
|
||||||
|
<PackageReference Include="WoofWare.Whippet.Fantomas" Version="0.2.1" />
|
||||||
<!-- the lowest version allowed by Myriad.Core -->
|
<!-- the lowest version allowed by Myriad.Core -->
|
||||||
<PackageReference Update="FSharp.Core" Version="6.0.1" PrivateAssets="all"/>
|
<PackageReference Update="FSharp.Core" Version="6.0.1" PrivateAssets="all"/>
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
@@ -27,34 +29,6 @@
|
|||||||
<Compile Include="List.fs"/>
|
<Compile Include="List.fs"/>
|
||||||
<Compile Include="Text.fs" />
|
<Compile Include="Text.fs" />
|
||||||
<Compile Include="Teq.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="Measure.fs" />
|
||||||
<Compile Include="AstHelper.fs" />
|
<Compile Include="AstHelper.fs" />
|
||||||
<Compile Include="RemoveOptionsGenerator.fs"/>
|
<Compile Include="RemoveOptionsGenerator.fs"/>
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
{
|
{
|
||||||
"version": "3.1",
|
"version": "4.0",
|
||||||
"publicReleaseRefSpec": [
|
"publicReleaseRefSpec": [
|
||||||
"^refs/heads/main$"
|
"^refs/heads/main$"
|
||||||
],
|
],
|
||||||
|
|||||||
@@ -326,4 +326,9 @@
|
|||||||
version = "7.0.3";
|
version = "7.0.3";
|
||||||
hash = "sha256-aSJZ17MjqaZNQkprfxm/09LaCoFtpdWmqU9BTROzWX4=";
|
hash = "sha256-aSJZ17MjqaZNQkprfxm/09LaCoFtpdWmqU9BTROzWX4=";
|
||||||
})
|
})
|
||||||
|
(fetchNuGet {
|
||||||
|
pname = "WoofWare.Whippet.Fantomas";
|
||||||
|
version = "0.2.1";
|
||||||
|
hash = "sha256-38LPop5tQ14oqzi0dSzBp2m53fugIMyWed67xnZmJqk=";
|
||||||
|
})
|
||||||
]
|
]
|
||||||
|
|||||||
Reference in New Issue
Block a user