Compare commits

...

2 Commits

Author SHA1 Message Date
Patrick Stevens
16e6b91548 Use EscapeDataString instead of UrlEncode (#278) 2024-10-03 15:10:39 +00:00
Patrick Stevens
8488883835 Remove more of Myriad.Core (#276) 2024-10-02 20:38:00 +00:00
22 changed files with 1180 additions and 1132 deletions

File diff suppressed because it is too large Load Diff

View File

@@ -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> ()

View File

@@ -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
)
)

View File

@@ -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
)
)

View File

@@ -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> ()

View File

@@ -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"

View File

@@ -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

View File

@@ -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

View File

@@ -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 "."

View File

@@ -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 "."

View File

@@ -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 "."

View File

@@ -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 =

View File

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

View 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)

View File

@@ -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)

View File

@@ -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 "|>") ])

View 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)

View 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)

View File

@@ -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

View File

@@ -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,

View File

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

View File

@@ -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" />