patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-08 05:28:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

Extract some utilities from http-client branch (#260)

Browse Source
This commit is contained in:
Patrick Stevens
2024-09-14 23:02:32 +01:00
committed by GitHub
parent 693b95106a
commit 09b7109c84
11 changed files with 147 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
WoofWare.Myriad.Plugins/CataGenerator.fs
View File

@@ -564,11 +564,12 @@ module internal CataGenerator =
let domain =
field.FieldName
|> Option.map Ident.lowerFirstLetter
|> SynType.signatureParamOfType place
|> SynType.signatureParamOfType [] place false
acc |> SynType.funFromDomain domain
)
|> SynMemberDefn.abstractMember
[]
case.CataMethodIdent
None
arity

13
WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs
View File

@@ -228,14 +228,11 @@ module internal InterfaceMockGenerator =
x.Type
let private constructMemberSinglePlace (tuple : TupledArg) : SynType =
match tuple.Args |> List.rev |> List.map buildType with
| [] -> failwith "no-arg functions not supported yet"
| [ x ] -> x
| last :: rest ->
([ SynTupleTypeSegment.Type last ], rest)
||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
|> fun segs -> SynType.Tuple (false, segs, range0)
|> fun ty -> if tuple.HasParen then SynType.Paren (ty, range0) else ty
tuple.Args
|> List.map buildType
|> SynType.tupleNoParen
|> Option.defaultWith (fun () -> failwith "no-arg functions not supported yet")
|> if tuple.HasParen then SynType.paren else id
let constructMember (mem : MemberInfo) : SynField =
let inputType = mem.Args |> List.map constructMemberSinglePlace

48
WoofWare.Myriad.Plugins/SynExpr/Ident.fs
View File

@@ -2,6 +2,7 @@ namespace WoofWare.Myriad.Plugins
open System
open System.Text
open System.Text.RegularExpressions
open Fantomas.FCS.Syntax
open Fantomas.FCS.Text.Range
@@ -9,6 +10,53 @@ open Fantomas.FCS.Text.Range
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'"
| _ ->
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

7
WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs
View File

@@ -6,7 +6,12 @@ open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal PreXmlDoc =
let create (s : string) : PreXmlDoc =
PreXmlDoc.Create ([| " " + s |], range0)
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)

4
WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs
View File

@@ -9,12 +9,12 @@ module internal SynArgPats =
match caseNames.Length with
| 0 -> SynArgPats.Pats []
| 1 ->
SynPat.Named (SynIdent.SynIdent (Ident.create caseNames.[0], None), false, None, range0)
SynPat.Named (SynIdent.createS caseNames.[0], false, None, range0)
|> List.singleton
|> SynArgPats.Pats
| len ->
caseNames
|> List.map (fun name -> SynPat.Named (SynIdent.SynIdent (Ident.create name, None), false, None, range0))
|> 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

31
WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs
View File

@@ -5,32 +5,23 @@ open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynAttribute =
let internal compilationRepresentation : SynAttribute =
let inline create (typeName : SynLongIdent) (arg : SynExpr) : SynAttribute =
{
TypeName = SynLongIdent.createS "CompilationRepresentation"
ArgExpr =
[ "CompilationRepresentationFlags" ; "ModuleSuffix" ]
|> SynExpr.createLongIdent
|> SynExpr.paren
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 =
{
TypeName = SynLongIdent.createS "RequireQualifiedAccess"
ArgExpr = SynExpr.CreateConst ()
Target = None
AppliesToGetterAndSetter = false
Range = range0
}
create (SynLongIdent.createS "RequireQualifiedAccess") (SynExpr.CreateConst ())
let internal autoOpen : SynAttribute =
{
TypeName = SynLongIdent.createS "AutoOpen"
ArgExpr = SynExpr.CreateConst ()
Target = None
AppliesToGetterAndSetter = false
Range = range0
}
create (SynLongIdent.createS "AutoOpen") (SynExpr.CreateConst ())

10
WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs Normal file
View File

@@ -0,0 +1,10 @@
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)

10
WoofWare.Myriad.Plugins/SynExpr/SynMemberDefn.fs
View File

@@ -17,8 +17,8 @@ module internal SynMemberDefn =
SynMemberFlags.MemberKind = SynMemberKind.Member
}
let abstractMember
(attrs : SynAttribute list)
(ident : SynIdent)
(typars : SynTyparDecls option)
(arity : SynValInfo)
@@ -28,7 +28,13 @@ module internal SynMemberDefn =
=
let slot =
SynValSig.SynValSig (
[],
attrs
|> List.map (fun attr ->
{
Attributes = [ attr ]
Range = range0
}
),
ident,
SynValTyparDecls.SynValTyparDecls (typars, true),
returnType,

55
WoofWare.Myriad.Plugins/SynExpr/SynType.fs
View File

@@ -267,6 +267,8 @@ module internal SynType =
| 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)
@@ -283,6 +285,17 @@ module internal SynType =
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)
@@ -299,16 +312,54 @@ module internal SynType =
}
)
let inline signatureParamOfType (ty : SynType) (name : Ident option) : SynType =
SynType.SignatureParameter ([], false, name, ty, 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.

2
WoofWare.Myriad.Plugins/SynExpr/SynUnionCase.fs
View File

@@ -44,7 +44,7 @@ module internal SynUnionCase =
SynUnionCase.SynUnionCase (
SynAttributes.ofAttrs case.Attributes,
SynIdent.SynIdent (case.Name, None),
SynIdent.createI case.Name,
SynUnionCaseKind.Fields fields,
case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
case.Access,

1
WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
View File

@@ -30,6 +30,7 @@
<Compile Include="SynExpr\SynAttributes.fs" />
<Compile Include="SynExpr\PreXmlDoc.fs" />
<Compile Include="SynExpr\Ident.fs" />
<Compile Include="SynExpr\SynIdent.fs" />
<Compile Include="SynExpr\SynLongIdent.fs" />
<Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
<Compile Include="SynExpr\SynArgPats.fs" />