mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-05 12:08:46 +00:00
Compare commits
2 Commits
WoofWare.M
...
WoofWare.M
Author | SHA1 | Date | |
---|---|---|---|
|
16e6b91548 | ||
|
8488883835 |
File diff suppressed because it is too large
Load Diff
@@ -31,7 +31,7 @@ module FileSystemItemCata =
|
||||
[<RequireQualifiedAccess>]
|
||||
type private Instruction =
|
||||
| Process__FileSystemItem of FileSystemItem
|
||||
| FileSystemItem_Directory of string * int * int
|
||||
| FileSystemItem_Directory of name : string * dirSize : int * contents : int
|
||||
|
||||
let private loop (cata : FileSystemCata<'FileSystemItem>) (instructions : ResizeArray<Instruction>) =
|
||||
let fileSystemItemStack = ResizeArray<'FileSystemItem> ()
|
||||
@@ -106,7 +106,7 @@ module GiftCata =
|
||||
| Process__Gift of Gift
|
||||
| Gift_Wrapped of WrappingPaperStyle
|
||||
| Gift_Boxed
|
||||
| Gift_WithACard of string
|
||||
| Gift_WithACard of message : string
|
||||
|
||||
let private loop (cata : GiftCata<'Gift>) (instructions : ResizeArray<Instruction>) =
|
||||
let giftStack = ResizeArray<'Gift> ()
|
||||
|
@@ -63,7 +63,7 @@ module PureGymApi =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"v1/gyms/{gym_id}/attendance"
|
||||
.Replace ("{gym_id}", gymId.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{gym_id}", gymId.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -97,7 +97,7 @@ module PureGymApi =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"v1/gyms/{gym_id}/attendance"
|
||||
.Replace ("{gym_id}", gymId.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{gym_id}", gymId.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -161,7 +161,7 @@ module PureGymApi =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"v1/gyms/{gym}"
|
||||
.Replace ("{gym}", gym.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{gym}", gym.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -326,9 +326,9 @@ module PureGymApi =
|
||||
else
|
||||
"?")
|
||||
+ "fromDate="
|
||||
+ ((fromDate.ToString "yyyy-MM-dd") |> System.Web.HttpUtility.UrlEncode)
|
||||
+ ((fromDate.ToString "yyyy-MM-dd") |> System.Uri.EscapeDataString)
|
||||
+ "&toDate="
|
||||
+ ((toDate.ToString "yyyy-MM-dd") |> System.Web.HttpUtility.UrlEncode)),
|
||||
+ ((toDate.ToString "yyyy-MM-dd") |> System.Uri.EscapeDataString)),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -367,9 +367,9 @@ module PureGymApi =
|
||||
else
|
||||
"?")
|
||||
+ "fromDate="
|
||||
+ ((fromDate.ToString "yyyy-MM-dd") |> System.Web.HttpUtility.UrlEncode)
|
||||
+ ((fromDate.ToString "yyyy-MM-dd") |> System.Uri.EscapeDataString)
|
||||
+ "&toDate="
|
||||
+ ((toDate.ToString "yyyy-MM-dd") |> System.Web.HttpUtility.UrlEncode)),
|
||||
+ ((toDate.ToString "yyyy-MM-dd") |> System.Uri.EscapeDataString)),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -663,7 +663,7 @@ module PureGymApi =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1076,7 +1076,7 @@ module internal ApiWithoutBaseAddress =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1130,7 +1130,7 @@ module ApiWithBasePath =
|
||||
),
|
||||
System.Uri (
|
||||
"endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1178,7 +1178,7 @@ module ApiWithBasePathAndAddress =
|
||||
),
|
||||
System.Uri (
|
||||
"endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1232,7 +1232,7 @@ module ApiWithAbsoluteBasePath =
|
||||
),
|
||||
System.Uri (
|
||||
"endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1280,7 +1280,7 @@ module ApiWithAbsoluteBasePathAndAddress =
|
||||
),
|
||||
System.Uri (
|
||||
"endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1334,7 +1334,7 @@ module ApiWithBasePathAndAbsoluteEndpoint =
|
||||
),
|
||||
System.Uri (
|
||||
"/endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1382,7 +1382,7 @@ module ApiWithBasePathAndAddressAndAbsoluteEndpoint =
|
||||
),
|
||||
System.Uri (
|
||||
"/endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1436,7 +1436,7 @@ module ApiWithAbsoluteBasePathAndAbsoluteEndpoint =
|
||||
),
|
||||
System.Uri (
|
||||
"/endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1484,7 +1484,7 @@ module ApiWithAbsoluteBasePathAndAddressAndAbsoluteEndpoint =
|
||||
),
|
||||
System.Uri (
|
||||
"/endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1543,7 +1543,7 @@ module ApiWithHeaders =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -1606,7 +1606,7 @@ module ApiWithHeaders2 =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"endpoint/{param}"
|
||||
.Replace ("{param}", parameter.ToString () |> System.Web.HttpUtility.UrlEncode),
|
||||
.Replace ("{param}", parameter.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
|
@@ -476,11 +476,8 @@ module VaultClient =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"v1/{mountPoint}/{path}"
|
||||
.Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode)
|
||||
.Replace (
|
||||
"{mountPoint}",
|
||||
mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode
|
||||
),
|
||||
.Replace("{path}", path.ToString () |> System.Uri.EscapeDataString)
|
||||
.Replace ("{mountPoint}", mountPoint.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -573,11 +570,8 @@ module VaultClientNonExtensionMethod =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"v1/{mountPoint}/{path}"
|
||||
.Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode)
|
||||
.Replace (
|
||||
"{mountPoint}",
|
||||
mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode
|
||||
),
|
||||
.Replace("{path}", path.ToString () |> System.Uri.EscapeDataString)
|
||||
.Replace ("{mountPoint}", mountPoint.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
@@ -673,11 +667,8 @@ module VaultClientExtensionMethodHttpClientExtension =
|
||||
| v -> v),
|
||||
System.Uri (
|
||||
"v1/{mountPoint}/{path}"
|
||||
.Replace("{path}", path.ToString () |> System.Web.HttpUtility.UrlEncode)
|
||||
.Replace (
|
||||
"{mountPoint}",
|
||||
mountPoint.ToString () |> System.Web.HttpUtility.UrlEncode
|
||||
),
|
||||
.Replace("{path}", path.ToString () |> System.Uri.EscapeDataString)
|
||||
.Replace ("{mountPoint}", mountPoint.ToString () |> System.Uri.EscapeDataString),
|
||||
System.UriKind.Relative
|
||||
)
|
||||
)
|
||||
|
@@ -31,7 +31,7 @@ module MyListCata =
|
||||
[<RequireQualifiedAccess>]
|
||||
type private Instruction<'a> =
|
||||
| Process__MyList of MyList<'a>
|
||||
| MyList_Cons of 'a
|
||||
| MyList_Cons of head : 'a
|
||||
|
||||
let private loop (cata : MyListCata<'a, 'MyList>) (instructions : ResizeArray<Instruction<'a>>) =
|
||||
let myListStack = ResizeArray<'MyList> ()
|
||||
|
@@ -33,4 +33,4 @@ module TestPathParam =
|
||||
let api = PureGymApi.make client
|
||||
|
||||
api.GetPathParam("hello/world?(hi)").Result
|
||||
|> shouldEqual "hello%2fworld%3f(hi)"
|
||||
|> shouldEqual "hello%2Fworld%3F%28hi%29"
|
||||
|
@@ -4,8 +4,6 @@ open System
|
||||
open System.Text
|
||||
open Fantomas.FCS.Syntax
|
||||
open Fantomas.FCS.Text.Range
|
||||
open Fantomas.FCS.Xml
|
||||
open Myriad.Core
|
||||
|
||||
type internal ArgParserOutputSpec =
|
||||
{
|
||||
@@ -1224,7 +1222,7 @@ module internal ArgParserGenerator =
|
||||
(SynExpr.CreateConst ()))
|
||||
])
|
||||
SynMatchClause.create
|
||||
(SynPat.listCons (SynPat.createConst (SynConst.CreateString "--")) (SynPat.named "rest"))
|
||||
(SynPat.listCons (SynPat.createConst (SynConst.Create "--")) (SynPat.named "rest"))
|
||||
(SynExpr.callMethodArg
|
||||
"AddRange"
|
||||
(SynExpr.paren (
|
||||
@@ -1643,7 +1641,7 @@ module internal ArgParserGenerator =
|
||||
let modInfo =
|
||||
SynComponentInfo.create modName
|
||||
|> SynComponentInfo.withDocString (
|
||||
PreXmlDoc.Create $" Methods to parse arguments for the type %s{taggedType.Name.idText}"
|
||||
PreXmlDoc.create $"Methods to parse arguments for the type %s{taggedType.Name.idText}"
|
||||
)
|
||||
|> SynComponentInfo.addAttributes modAttrs
|
||||
|
||||
@@ -1666,7 +1664,7 @@ module internal ArgParserGenerator =
|
||||
[
|
||||
{
|
||||
Attrs = []
|
||||
Ident = Ident.create "key"
|
||||
Ident = Some (Ident.create "key")
|
||||
Type = SynType.string
|
||||
}
|
||||
]
|
||||
@@ -1740,75 +1738,12 @@ module internal ArgParserGenerator =
|
||||
|
||||
[
|
||||
for openStatement in opens do
|
||||
yield SynModuleDecl.CreateOpen openStatement
|
||||
yield SynModuleDecl.openAny openStatement
|
||||
yield taggedMod
|
||||
]
|
||||
|> SynModuleOrNamespace.createNamespace ns
|
||||
|
||||
let generate (context : GeneratorContext) : Output =
|
||||
let ast, _ =
|
||||
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
|
||||
|
||||
let types =
|
||||
Ast.extractTypeDefn ast
|
||||
|> List.groupBy (fst >> List.map _.idText >> String.concat ".")
|
||||
|> List.map (fun (_, v) -> fst (List.head v), List.collect snd v)
|
||||
|
||||
let opens = AstHelper.extractOpens ast
|
||||
|
||||
let namespaceAndTypes =
|
||||
types
|
||||
|> List.collect (fun (ns, types) ->
|
||||
let typeWithAttr =
|
||||
types
|
||||
|> List.choose (fun ty ->
|
||||
match Ast.getAttribute<ArgParserAttribute> ty with
|
||||
| None -> None
|
||||
| Some attr ->
|
||||
let arg =
|
||||
match SynExpr.stripOptionalParen attr.ArgExpr with
|
||||
| SynExpr.Const (SynConst.Bool value, _) -> value
|
||||
| SynExpr.Const (SynConst.Unit, _) -> ArgParserAttribute.DefaultIsExtensionMethod
|
||||
| arg ->
|
||||
failwith
|
||||
$"Unrecognised argument %+A{arg} to [<%s{nameof ArgParserAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only."
|
||||
|
||||
let spec =
|
||||
{
|
||||
ExtensionMethods = arg
|
||||
}
|
||||
|
||||
Some (ty, spec)
|
||||
)
|
||||
|
||||
typeWithAttr
|
||||
|> List.map (fun taggedType ->
|
||||
let unions, records, others =
|
||||
(([], [], []), types)
|
||||
||> List.fold (fun
|
||||
(unions, records, others)
|
||||
(SynTypeDefn.SynTypeDefn (sci, repr, smd, _, _, _) as ty) ->
|
||||
match repr with
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (access, cases, _), _) ->
|
||||
UnionType.OfUnion sci smd access cases :: unions, records, others
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, fields, _), _) ->
|
||||
unions, RecordType.OfRecord sci smd access fields :: records, others
|
||||
| _ -> unions, records, ty :: others
|
||||
)
|
||||
|
||||
if not others.IsEmpty then
|
||||
failwith
|
||||
$"Error: all types recursively defined together with an ArgParserGenerator type must be discriminated unions or records. %+A{others}"
|
||||
|
||||
(ns, taggedType, unions, records)
|
||||
)
|
||||
)
|
||||
|
||||
let modules =
|
||||
namespaceAndTypes
|
||||
|> List.map (fun (ns, taggedType, unions, records) -> createModule opens ns taggedType unions records)
|
||||
|
||||
Output.Ast modules
|
||||
open Myriad.Core
|
||||
|
||||
/// Myriad generator that provides a catamorphism for an algebraic data type.
|
||||
[<MyriadGenerator("arg-parser")>]
|
||||
@@ -1817,4 +1752,69 @@ type ArgParserGenerator () =
|
||||
interface IMyriadGenerator with
|
||||
member _.ValidInputExtensions = [ ".fs" ]
|
||||
|
||||
member _.Generate (context : GeneratorContext) = ArgParserGenerator.generate context
|
||||
member _.Generate (context : GeneratorContext) =
|
||||
let ast, _ =
|
||||
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
|
||||
|
||||
let types =
|
||||
Ast.extractTypeDefn ast
|
||||
|> List.groupBy (fst >> List.map _.idText >> String.concat ".")
|
||||
|> List.map (fun (_, v) -> fst (List.head v), List.collect snd v)
|
||||
|
||||
let opens = AstHelper.extractOpens ast
|
||||
|
||||
let namespaceAndTypes =
|
||||
types
|
||||
|> List.collect (fun (ns, types) ->
|
||||
let typeWithAttr =
|
||||
types
|
||||
|> List.choose (fun ty ->
|
||||
match SynTypeDefn.getAttribute typeof<ArgParserAttribute>.Name ty with
|
||||
| None -> None
|
||||
| Some attr ->
|
||||
let arg =
|
||||
match SynExpr.stripOptionalParen attr.ArgExpr with
|
||||
| SynExpr.Const (SynConst.Bool value, _) -> value
|
||||
| SynExpr.Const (SynConst.Unit, _) -> ArgParserAttribute.DefaultIsExtensionMethod
|
||||
| arg ->
|
||||
failwith
|
||||
$"Unrecognised argument %+A{arg} to [<%s{nameof ArgParserAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only."
|
||||
|
||||
let spec =
|
||||
{
|
||||
ExtensionMethods = arg
|
||||
}
|
||||
|
||||
Some (ty, spec)
|
||||
)
|
||||
|
||||
typeWithAttr
|
||||
|> List.map (fun taggedType ->
|
||||
let unions, records, others =
|
||||
(([], [], []), types)
|
||||
||> List.fold (fun
|
||||
(unions, records, others)
|
||||
(SynTypeDefn.SynTypeDefn (sci, repr, smd, _, _, _) as ty) ->
|
||||
match repr with
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (access, cases, _), _) ->
|
||||
UnionType.OfUnion sci smd access cases :: unions, records, others
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, fields, _), _) ->
|
||||
unions, RecordType.OfRecord sci smd access fields :: records, others
|
||||
| _ -> unions, records, ty :: others
|
||||
)
|
||||
|
||||
if not others.IsEmpty then
|
||||
failwith
|
||||
$"Error: all types recursively defined together with an ArgParserGenerator type must be discriminated unions or records. %+A{others}"
|
||||
|
||||
(ns, taggedType, unions, records)
|
||||
)
|
||||
)
|
||||
|
||||
let modules =
|
||||
namespaceAndTypes
|
||||
|> List.map (fun (ns, taggedType, unions, records) ->
|
||||
ArgParserGenerator.createModule opens ns taggedType unions records
|
||||
)
|
||||
|
||||
Output.Ast modules
|
||||
|
@@ -3,7 +3,6 @@ namespace WoofWare.Myriad.Plugins
|
||||
open Fantomas.FCS.Syntax
|
||||
open Fantomas.FCS.SyntaxTrivia
|
||||
open Fantomas.FCS.Xml
|
||||
open Myriad.Core
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal CataGenerator =
|
||||
@@ -176,7 +175,7 @@ module internal CataGenerator =
|
||||
|> SynExpr.createLet
|
||||
[
|
||||
SynBinding.Let (
|
||||
valData = SynValData.SynValData (None, SynValInfo.Empty, None),
|
||||
valData = SynValData.SynValData (None, SynValInfo.empty, None),
|
||||
pattern =
|
||||
SynPat.tupleNoParen (
|
||||
allArtificialTyparNames
|
||||
@@ -463,18 +462,39 @@ module internal CataGenerator =
|
||||
{
|
||||
SynFieldData.Type = field.Type
|
||||
Attrs = []
|
||||
Ident = None
|
||||
Ident = field.Name
|
||||
}
|
||||
|> SynField.make
|
||||
)
|
||||
|
||||
SynUnionCase.Create (unionCase.Name, fields)
|
||||
{
|
||||
Name = unionCase.Name
|
||||
XmlDoc = None
|
||||
Access = None
|
||||
Attributes = []
|
||||
Fields = fields
|
||||
}
|
||||
|> SynUnionCase.create
|
||||
)
|
||||
|
||||
let casesFromCases =
|
||||
recursiveCases analysis
|
||||
|> List.map (fun case ->
|
||||
SynUnionCase.Create (case.Name, case.Fields |> List.map (fun field -> SynField.Create field.Type))
|
||||
{
|
||||
UnionCase.Name = case.Name
|
||||
XmlDoc = None
|
||||
Access = None
|
||||
Attributes = []
|
||||
Fields =
|
||||
case.Fields
|
||||
|> List.map (fun field ->
|
||||
{
|
||||
SynFieldData.Type = field.Type
|
||||
Attrs = []
|
||||
Ident = field.Name
|
||||
}
|
||||
)
|
||||
}
|
||||
|> SynUnionCase.create
|
||||
)
|
||||
|
||||
let cases = casesFromProcess @ casesFromCases
|
||||
@@ -539,8 +559,8 @@ module internal CataGenerator =
|
||||
|> List.map (fun case ->
|
||||
let arity =
|
||||
SynValInfo.SynValInfo (
|
||||
case.Fields |> List.map (fun field -> [ SynArgInfo.Empty ]),
|
||||
SynArgInfo.Empty
|
||||
case.Fields |> List.map (fun field -> [ SynArgInfo.empty ]),
|
||||
SynArgInfo.empty
|
||||
)
|
||||
|
||||
(SynType.var generics.[analysis.GenericName.idText], List.rev case.FlattenedFields)
|
||||
@@ -852,9 +872,7 @@ module internal CataGenerator =
|
||||
else
|
||||
[]
|
||||
|
||||
SynMatchClause.create
|
||||
(SynPat.CreateLongIdent (SynLongIdent.create unionCase.Match, matchLhs))
|
||||
matchBody
|
||||
SynMatchClause.create (SynPat.identWithArgs unionCase.Match (SynArgPats.create matchLhs)) matchBody
|
||||
)
|
||||
|
||||
SynExpr.createMatch (SynExpr.createIdent "x") matchCases
|
||||
@@ -1059,7 +1077,7 @@ module internal CataGenerator =
|
||||
(SynExpr.CreateConst 0)
|
||||
(SynExpr.createLongIdent [ "instructions" ; "Count" ]))
|
||||
body
|
||||
SynExpr.CreateTuple (
|
||||
SynExpr.tupleNoParen (
|
||||
analysis
|
||||
|> List.map (fun unionAnalysis -> [ unionAnalysis.StackName ] |> SynExpr.createLongIdent')
|
||||
)
|
||||
@@ -1103,7 +1121,7 @@ module internal CataGenerator =
|
||||
let modInfo =
|
||||
SynComponentInfo.create moduleName
|
||||
|> SynComponentInfo.withDocString (
|
||||
PreXmlDoc.Create $" Methods to perform a catamorphism over the type %s{parentName}"
|
||||
PreXmlDoc.create $"Methods to perform a catamorphism over the type %s{parentName}"
|
||||
)
|
||||
|> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
|
||||
|
||||
@@ -1150,7 +1168,7 @@ module internal CataGenerator =
|
||||
|
||||
[
|
||||
for openStatement in opens do
|
||||
yield SynModuleDecl.CreateOpen openStatement
|
||||
yield SynModuleDecl.openAny openStatement
|
||||
yield! cataStructures
|
||||
yield cataRecord
|
||||
yield
|
||||
@@ -1162,53 +1180,7 @@ module internal CataGenerator =
|
||||
]
|
||||
|> SynModuleOrNamespace.createNamespace ns
|
||||
|
||||
let generate (context : GeneratorContext) : Output =
|
||||
let ast, _ =
|
||||
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
|
||||
|
||||
let types = Ast.extractTypeDefn ast
|
||||
|
||||
let opens = AstHelper.extractOpens ast
|
||||
|
||||
let namespaceAndTypes =
|
||||
types
|
||||
|> List.choose (fun (ns, types) ->
|
||||
let typeWithAttr =
|
||||
types
|
||||
|> List.tryPick (fun ty ->
|
||||
match Ast.getAttribute<CreateCatamorphismAttribute> ty with
|
||||
| None -> None
|
||||
| Some attr -> Some (attr.ArgExpr, ty)
|
||||
)
|
||||
|
||||
match typeWithAttr with
|
||||
| Some taggedType ->
|
||||
let unions, records, others =
|
||||
(([], [], []), types)
|
||||
||> List.fold (fun
|
||||
(unions, records, others)
|
||||
(SynTypeDefn.SynTypeDefn (_, repr, _, _, _, _) as ty) ->
|
||||
match repr with
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union _, _) ->
|
||||
ty :: unions, records, others
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record _, _) ->
|
||||
unions, ty :: records, others
|
||||
| _ -> unions, records, ty :: others
|
||||
)
|
||||
|
||||
if not others.IsEmpty then
|
||||
failwith
|
||||
$"Error: all types recursively defined together with a CreateCatamorphism type must be discriminated unions or records. %+A{others}"
|
||||
|
||||
Some (ns, taggedType, unions, records)
|
||||
| _ -> None
|
||||
)
|
||||
|
||||
let modules =
|
||||
namespaceAndTypes
|
||||
|> List.map (fun (ns, taggedType, unions, records) -> createModule opens ns taggedType unions records)
|
||||
|
||||
Output.Ast modules
|
||||
open Myriad.Core
|
||||
|
||||
/// Myriad generator that provides a catamorphism for an algebraic data type.
|
||||
[<MyriadGenerator("create-catamorphism")>]
|
||||
@@ -1217,4 +1189,52 @@ type CreateCatamorphismGenerator () =
|
||||
interface IMyriadGenerator with
|
||||
member _.ValidInputExtensions = [ ".fs" ]
|
||||
|
||||
member _.Generate (context : GeneratorContext) = CataGenerator.generate context
|
||||
member _.Generate (context : GeneratorContext) =
|
||||
let ast, _ =
|
||||
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
|
||||
|
||||
let types = Ast.extractTypeDefn ast
|
||||
|
||||
let opens = AstHelper.extractOpens ast
|
||||
|
||||
let namespaceAndTypes =
|
||||
types
|
||||
|> List.choose (fun (ns, types) ->
|
||||
let typeWithAttr =
|
||||
types
|
||||
|> List.tryPick (fun ty ->
|
||||
match SynTypeDefn.getAttribute typeof<CreateCatamorphismAttribute>.Name ty with
|
||||
| None -> None
|
||||
| Some attr -> Some (attr.ArgExpr, ty)
|
||||
)
|
||||
|
||||
match typeWithAttr with
|
||||
| Some taggedType ->
|
||||
let unions, records, others =
|
||||
(([], [], []), types)
|
||||
||> List.fold (fun
|
||||
(unions, records, others)
|
||||
(SynTypeDefn.SynTypeDefn (_, repr, _, _, _, _) as ty) ->
|
||||
match repr with
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union _, _) ->
|
||||
ty :: unions, records, others
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record _, _) ->
|
||||
unions, ty :: records, others
|
||||
| _ -> unions, records, ty :: others
|
||||
)
|
||||
|
||||
if not others.IsEmpty then
|
||||
failwith
|
||||
$"Error: all types recursively defined together with a CreateCatamorphism type must be discriminated unions or records. %+A{others}"
|
||||
|
||||
Some (ns, taggedType, unions, records)
|
||||
| _ -> None
|
||||
)
|
||||
|
||||
let modules =
|
||||
namespaceAndTypes
|
||||
|> List.map (fun (ns, taggedType, unions, records) ->
|
||||
CataGenerator.createModule opens ns taggedType unions records
|
||||
)
|
||||
|
||||
Output.Ast modules
|
||||
|
@@ -234,7 +234,7 @@ module internal HttpClientGenerator =
|
||||
SynExpr.CreateConst ("{" + substituteId + "}")
|
||||
SynExpr.callMethod "ToString" (SynExpr.createIdent' varName)
|
||||
|> SynExpr.pipeThroughFunction (
|
||||
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
|
||||
SynExpr.createLongIdent [ "System" ; "Uri" ; "EscapeDataString" ]
|
||||
)
|
||||
])
|
||||
| _ -> template
|
||||
@@ -286,9 +286,7 @@ module internal HttpClientGenerator =
|
||||
SynExpr.createIdent' firstValueId
|
||||
|> SynExpr.toString firstValue.Type
|
||||
|> SynExpr.paren
|
||||
|> SynExpr.pipeThroughFunction (
|
||||
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
|
||||
)
|
||||
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Uri" ; "EscapeDataString" ])
|
||||
|> SynExpr.paren
|
||||
|> SynExpr.plus (SynExpr.plus urlSeparator (SynExpr.CreateConst (firstKey + "=")))
|
||||
|
||||
@@ -301,9 +299,7 @@ module internal HttpClientGenerator =
|
||||
|
||||
SynExpr.toString paramValue.Type (SynExpr.createIdent' paramValueId)
|
||||
|> SynExpr.paren
|
||||
|> SynExpr.pipeThroughFunction (
|
||||
SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ]
|
||||
)
|
||||
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Uri" ; "EscapeDataString" ])
|
||||
|> SynExpr.paren
|
||||
|> SynExpr.plus (SynExpr.plus uri (SynExpr.CreateConst ("&" + paramKey + "=")))
|
||||
)
|
||||
@@ -1008,7 +1004,7 @@ type HttpClientGenerator () =
|
||||
|> List.choose (fun (ns, types) ->
|
||||
types
|
||||
|> List.choose (fun typeDef ->
|
||||
match Ast.getAttribute<HttpClientAttribute> typeDef with
|
||||
match SynTypeDefn.getAttribute typeof<HttpClientAttribute>.Name typeDef with
|
||||
| None ->
|
||||
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
|
||||
|
||||
|
@@ -727,7 +727,7 @@ type JsonParseGenerator () =
|
||||
|> List.choose (fun (ns, types) ->
|
||||
types
|
||||
|> List.choose (fun typeDef ->
|
||||
match Ast.getAttribute<JsonParseAttribute> typeDef with
|
||||
match SynTypeDefn.getAttribute typeof<JsonParseAttribute>.Name typeDef with
|
||||
| None ->
|
||||
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
|
||||
|
||||
|
@@ -544,7 +544,7 @@ type JsonSerializeGenerator () =
|
||||
|> List.choose (fun (ns, types) ->
|
||||
types
|
||||
|> List.choose (fun typeDef ->
|
||||
match Ast.getAttribute<JsonSerializeAttribute> typeDef with
|
||||
match SynTypeDefn.getAttribute typeof<JsonSerializeAttribute>.Name typeDef with
|
||||
| None ->
|
||||
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
|
||||
|
||||
|
@@ -150,7 +150,10 @@ type RemoveOptionsGenerator () =
|
||||
let namespaceAndRecords =
|
||||
records
|
||||
|> List.choose (fun (ns, types) ->
|
||||
match types |> List.filter Ast.hasAttribute<RemoveOptionsAttribute> with
|
||||
match
|
||||
types
|
||||
|> List.filter (SynTypeDefn.hasAttribute typeof<RemoveOptionsAttribute>.Name)
|
||||
with
|
||||
| [] -> None
|
||||
| types ->
|
||||
let types =
|
||||
|
7
WoofWare.Myriad.Plugins/SynExpr/SynArgInfo.fs
Normal file
7
WoofWare.Myriad.Plugins/SynExpr/SynArgInfo.fs
Normal file
@@ -0,0 +1,7 @@
|
||||
namespace WoofWare.Myriad.Plugins
|
||||
|
||||
open Fantomas.FCS.Syntax
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal SynArgInfo =
|
||||
let empty = SynArgInfo.SynArgInfo ([], false, None)
|
10
WoofWare.Myriad.Plugins/SynExpr/SynConst.fs
Normal file
10
WoofWare.Myriad.Plugins/SynExpr/SynConst.fs
Normal file
@@ -0,0 +1,10 @@
|
||||
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)
|
@@ -2,14 +2,13 @@ namespace WoofWare.Myriad.Plugins
|
||||
|
||||
open Fantomas.FCS.Syntax
|
||||
open Fantomas.FCS.SyntaxTrivia
|
||||
open Myriad.Core
|
||||
open Fantomas.FCS.Text.Range
|
||||
|
||||
[<AutoOpen>]
|
||||
module internal SynExprExtensions =
|
||||
type SynExpr with
|
||||
static member CreateConst (s : string) : SynExpr =
|
||||
SynExpr.Const (SynConst.String (s, SynStringKind.Regular, range0), range0)
|
||||
SynExpr.Const (SynConst.Create s, range0)
|
||||
|
||||
static member CreateConst () : SynExpr = SynExpr.Const (SynConst.Unit, range0)
|
||||
|
||||
@@ -17,7 +16,13 @@ module internal SynExprExtensions =
|
||||
|
||||
static member CreateConst (c : char) : SynExpr =
|
||||
// apparent Myriad bug: `IndexOf '?'` gets formatted as `IndexOf ?` which is clearly wrong
|
||||
SynExpr.CreateApp (SynExpr.Ident (Ident.Create "char"), SynExpr.CreateConst (int c))
|
||||
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 =
|
||||
@@ -27,15 +32,27 @@ module internal SynExprExtensions =
|
||||
module internal SynExpr =
|
||||
|
||||
/// {f} {x}
|
||||
let applyFunction (f : SynExpr) (x : SynExpr) : SynExpr = SynExpr.CreateApp (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 =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.pipe, expr)
|
||||
|> applyTo func
|
||||
createAppInfix (createLongIdent'' SynLongIdent.pipe) expr |> applyTo func
|
||||
|
||||
/// if {cond} then {trueBranch} else {falseBranch}
|
||||
/// Note that this function puts the trueBranch last, for pipelining convenience:
|
||||
@@ -78,45 +95,23 @@ module internal SynExpr =
|
||||
|
||||
/// {a} = {b}
|
||||
let equals (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.eq, a) |> applyTo b
|
||||
createAppInfix (createLongIdent'' SynLongIdent.eq) a |> applyTo b
|
||||
|
||||
/// {a} && {b}
|
||||
let booleanAnd (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanAnd, a)
|
||||
|> applyTo b
|
||||
createAppInfix (createLongIdent'' SynLongIdent.booleanAnd) a |> applyTo b
|
||||
|
||||
/// {a} || {b}
|
||||
let booleanOr (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanOr, a)
|
||||
|> applyTo b
|
||||
createAppInfix (createLongIdent'' SynLongIdent.booleanOr) a |> applyTo b
|
||||
|
||||
/// {a} + {b}
|
||||
let plus (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.CreateLongIdent (
|
||||
SynLongIdent.SynLongIdent (
|
||||
Ident.CreateLong "op_Addition",
|
||||
[],
|
||||
[ Some (IdentTrivia.OriginalNotation "+") ]
|
||||
)
|
||||
),
|
||||
a
|
||||
)
|
||||
|> applyTo b
|
||||
createAppInfix (createLongIdent'' SynLongIdent.plus) a |> applyTo b
|
||||
|
||||
/// {a} * {b}
|
||||
let times (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.CreateLongIdent (
|
||||
SynLongIdent.SynLongIdent (
|
||||
Ident.CreateLong "op_Multiply",
|
||||
[],
|
||||
[ Some (IdentTrivia.OriginalNotation "*") ]
|
||||
)
|
||||
),
|
||||
a
|
||||
)
|
||||
|> applyTo b
|
||||
createAppInfix (createLongIdent'' SynLongIdent.times) a |> applyTo b
|
||||
|
||||
let rec stripOptionalParen (expr : SynExpr) : SynExpr =
|
||||
match expr with
|
||||
@@ -172,7 +167,7 @@ module internal SynExpr =
|
||||
SynExpr.Lambda (
|
||||
false,
|
||||
false,
|
||||
SynSimplePats.Create [ SynSimplePat.CreateId (Ident.Create varName) ],
|
||||
SynSimplePats.create [ SynSimplePat.createId (Ident.create varName) ],
|
||||
body,
|
||||
Some (parsedDataPat, body),
|
||||
range0,
|
||||
@@ -186,7 +181,7 @@ module internal SynExpr =
|
||||
SynExpr.Lambda (
|
||||
false,
|
||||
false,
|
||||
SynSimplePats.Create [],
|
||||
SynSimplePats.create [],
|
||||
body,
|
||||
Some ([ SynPat.unit ], body),
|
||||
range0,
|
||||
@@ -200,12 +195,6 @@ module internal SynExpr =
|
||||
|
||||
let inline createIdent' (i : Ident) : SynExpr = SynExpr.Ident i
|
||||
|
||||
let inline createLongIdent' (ident : Ident list) : SynExpr =
|
||||
SynExpr.LongIdent (false, SynLongIdent.create ident, None, range0)
|
||||
|
||||
let inline createLongIdent (ident : string list) : SynExpr =
|
||||
createLongIdent' (ident |> List.map Ident.create)
|
||||
|
||||
let tupleNoParen (args : SynExpr list) : SynExpr =
|
||||
SynExpr.Tuple (false, args, List.replicate (args.Length - 1) range0, range0)
|
||||
|
||||
@@ -332,7 +321,7 @@ module internal SynExpr =
|
||||
|
||||
/// {ident} - {rhs}
|
||||
let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.sub, SynExpr.CreateLongIdent ident)
|
||||
createAppInfix (createLongIdent'' SynLongIdent.sub) (createLongIdent'' ident)
|
||||
|> applyTo rhs
|
||||
|
||||
/// {ident} - {n}
|
||||
@@ -340,26 +329,24 @@ module internal SynExpr =
|
||||
|
||||
/// {y} > {x}
|
||||
let greaterThan (x : SynExpr) (y : SynExpr) : SynExpr =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.gt, y) |> applyTo x
|
||||
createAppInfix (createLongIdent'' SynLongIdent.gt) y |> applyTo x
|
||||
|
||||
/// {y} < {x}
|
||||
let lessThan (x : SynExpr) (y : SynExpr) : SynExpr =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.lt, y) |> applyTo x
|
||||
createAppInfix (createLongIdent'' SynLongIdent.lt) y |> applyTo x
|
||||
|
||||
/// {y} >= {x}
|
||||
let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.geq, y)
|
||||
|> applyTo x
|
||||
createAppInfix (createLongIdent'' SynLongIdent.geq) y |> applyTo x
|
||||
|
||||
/// {y} <= {x}
|
||||
let lessThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.leq, y)
|
||||
|> applyTo x
|
||||
createAppInfix (createLongIdent'' SynLongIdent.leq) y |> applyTo x
|
||||
|
||||
/// {x} :: {y}
|
||||
let listCons (x : SynExpr) (y : SynExpr) : SynExpr =
|
||||
SynExpr.CreateAppInfix (
|
||||
SynExpr.LongIdent (
|
||||
createAppInfix
|
||||
(SynExpr.LongIdent (
|
||||
false,
|
||||
SynLongIdent.SynLongIdent (
|
||||
[ Ident.create "op_ColonColon" ],
|
||||
@@ -368,9 +355,8 @@ module internal SynExpr =
|
||||
),
|
||||
None,
|
||||
range0
|
||||
),
|
||||
tupleNoParen [ x ; y ]
|
||||
)
|
||||
))
|
||||
(tupleNoParen [ x ; y ])
|
||||
|> paren
|
||||
|
||||
let assign (lhs : SynLongIdent) (rhs : SynExpr) : SynExpr = SynExpr.LongIdentSet (lhs, rhs, range0)
|
||||
|
@@ -39,6 +39,12 @@ module internal SynLongIdent =
|
||||
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 "|>") ])
|
||||
|
||||
|
10
WoofWare.Myriad.Plugins/SynExpr/SynSimplePat.fs
Normal file
10
WoofWare.Myriad.Plugins/SynExpr/SynSimplePat.fs
Normal file
@@ -0,0 +1,10 @@
|
||||
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)
|
12
WoofWare.Myriad.Plugins/SynExpr/SynSimplePats.fs
Normal file
12
WoofWare.Myriad.Plugins/SynExpr/SynSimplePats.fs
Normal file
@@ -0,0 +1,12 @@
|
||||
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)
|
@@ -29,3 +29,18 @@ module internal SynTypeDefn =
|
||||
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
|
||||
|
@@ -23,14 +23,14 @@ type UnionCase<'ident> =
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal SynUnionCase =
|
||||
let create (case : UnionCase<Ident>) : SynUnionCase =
|
||||
let create (case : UnionCase<Ident option>) : SynUnionCase =
|
||||
let fields =
|
||||
case.Fields
|
||||
|> List.map (fun field ->
|
||||
SynField.SynField (
|
||||
SynAttributes.ofAttrs field.Attrs,
|
||||
false,
|
||||
Some field.Ident,
|
||||
field.Ident,
|
||||
field.Type,
|
||||
false,
|
||||
PreXmlDoc.Empty,
|
||||
|
7
WoofWare.Myriad.Plugins/SynExpr/SynValInfo.fs
Normal file
7
WoofWare.Myriad.Plugins/SynExpr/SynValInfo.fs
Normal file
@@ -0,0 +1,7 @@
|
||||
namespace WoofWare.Myriad.Plugins
|
||||
|
||||
open Fantomas.FCS.Syntax
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal SynValInfo =
|
||||
let empty = SynValInfo.SynValInfo ([], SynArgInfo.empty)
|
@@ -29,8 +29,13 @@
|
||||
<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" />
|
||||
|
Reference in New Issue
Block a user