Skip to content

Commit

Permalink
Extract some utilities from http-client branch (#260)
Browse files Browse the repository at this point in the history
  • Loading branch information
Smaug123 authored Sep 14, 2024
1 parent 693b951 commit 09b7109
Show file tree
Hide file tree
Showing 11 changed files with 147 additions and 37 deletions.
3 changes: 2 additions & 1 deletion WoofWare.Myriad.Plugins/CataGenerator.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
13 changes: 5 additions & 8 deletions WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
48 changes: 48 additions & 0 deletions WoofWare.Myriad.Plugins/SynExpr/Ident.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2,13 +2,61 @@ 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'"
| _ ->

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
Expand Down
7 changes: 6 additions & 1 deletion WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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 changes: 2 additions & 2 deletions WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
31 changes: 11 additions & 20 deletions WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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 changes: 10 additions & 0 deletions WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs
Original file line number Diff line number Diff line change
@@ -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 changes: 8 additions & 2 deletions WoofWare.Myriad.Plugins/SynExpr/SynMemberDefn.fs
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,8 @@ module internal SynMemberDefn =
SynMemberFlags.MemberKind = SynMemberKind.Member
}


let abstractMember
(attrs : SynAttribute list)
(ident : SynIdent)
(typars : SynTyparDecls option)
(arity : SynValInfo)
Expand All @@ -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,
Expand Down
55 changes: 53 additions & 2 deletions WoofWare.Myriad.Plugins/SynExpr/SynType.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

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

Expand All @@ -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.
Expand Down
2 changes: 1 addition & 1 deletion WoofWare.Myriad.Plugins/SynExpr/SynUnionCase.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
1 change: 1 addition & 0 deletions WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -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" />
Expand Down

0 comments on commit 09b7109

Please sign in to comment.