Compare commits

...

6 Commits

Author SHA1 Message Date
Patrick Stevens
8488883835 Remove more of Myriad.Core (#276) 2024-10-02 20:38:00 +00:00
Patrick Stevens
0652744c57 Allow using fsproj annotations instead of attributes (#275) 2024-10-02 19:30:21 +00:00
dependabot[bot]
9252979673 Bump cachix/install-nix-action from V28 to 29 (#273) 2024-09-30 13:53:25 +01:00
patrick-conscriptus[bot]
1120a3752d Automated commit (#272)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2024-09-29 01:26:14 +00:00
patrick-conscriptus[bot]
7ca6b0c0eb Automated commit (#271)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2024-09-22 01:25:31 +00:00
Patrick Stevens
50efb8d9bc Bump flake (#270) 2024-09-20 19:44:24 +01:00
31 changed files with 796 additions and 242 deletions

View File

@@ -29,7 +29,7 @@ jobs:
with: with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -50,7 +50,7 @@ jobs:
with: with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -67,7 +67,7 @@ jobs:
- name: Checkout - name: Checkout
uses: actions/checkout@v4 uses: actions/checkout@v4
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -82,7 +82,7 @@ jobs:
- name: Checkout - name: Checkout
uses: actions/checkout@v4 uses: actions/checkout@v4
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -97,7 +97,7 @@ jobs:
with: with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -116,7 +116,7 @@ jobs:
- name: Checkout - name: Checkout
uses: actions/checkout@v4 uses: actions/checkout@v4
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -129,7 +129,7 @@ jobs:
steps: steps:
- uses: actions/checkout@master - uses: actions/checkout@master
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -142,7 +142,7 @@ jobs:
steps: steps:
- uses: actions/checkout@master - uses: actions/checkout@master
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -156,7 +156,7 @@ jobs:
with: with:
fetch-depth: 0 # so that NerdBank.GitVersioning has access to history fetch-depth: 0 # so that NerdBank.GitVersioning has access to history
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -276,7 +276,7 @@ jobs:
steps: steps:
- uses: actions/checkout@v4 - uses: actions/checkout@v4
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
@@ -309,7 +309,7 @@ jobs:
steps: steps:
- uses: actions/checkout@v4 - uses: actions/checkout@v4
- name: Install Nix - name: Install Nix
uses: cachix/install-nix-action@V28 uses: cachix/install-nix-action@v29
with: with:
extra_nix_config: | extra_nix_config: |
access-tokens = github.com=${{ secrets.GITHUB_TOKEN }} access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}

View File

@@ -27,8 +27,7 @@ jobs:
- name: Run passthru - name: Run passthru
run: | run: |
set -o pipefail set -o pipefail
./result | tee /tmp/passthru.txt ./result nix/deps.nix
cp /"$(cat /tmp/passthru.txt | grep " wrote lockfile to " | cut -d / -f 2-)" nix/deps.nix
- name: Format - name: Format
run: 'nix develop --command alejandra .' run: 'nix develop --command alejandra .'

View File

@@ -32,6 +32,20 @@
<Compile Include="GeneratedMock.fs"> <Compile Include="GeneratedMock.fs">
<MyriadFile>MockExample.fs</MyriadFile> <MyriadFile>MockExample.fs</MyriadFile>
</Compile> </Compile>
<Compile Include="MockExampleNoAttributes.fs" />
<Compile Include="GeneratedMockNoAttributes.fs">
<MyriadFile>MockExampleNoAttributes.fs</MyriadFile>
<MyriadParams>
<IPublicTypeNoAttr>GenerateMock</IPublicTypeNoAttr>
<IPublicTypeInternalFalseNoAttr>GenerateMock(false)</IPublicTypeInternalFalseNoAttr>
<InternalTypeNoAttr>GenerateMock</InternalTypeNoAttr>
<PrivateTypeNoAttr>GenerateMock</PrivateTypeNoAttr>
<PrivateTypeInternalFalseNoAttr>GenerateMock(false)</PrivateTypeInternalFalseNoAttr>
<VeryPublicTypeNoAttr>GenerateMock</VeryPublicTypeNoAttr>
<CurriedNoAttr>GenerateMock</CurriedNoAttr>
<TypeWithInterfaceNoAttr>GenerateMock</TypeWithInterfaceNoAttr>
</MyriadParams>
</Compile>
<Compile Include="Vault.fs" /> <Compile Include="Vault.fs" />
<Compile Include="GeneratedVault.fs"> <Compile Include="GeneratedVault.fs">
<MyriadFile>Vault.fs</MyriadFile> <MyriadFile>Vault.fs</MyriadFile>

View File

@@ -31,7 +31,7 @@ module FileSystemItemCata =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
type private Instruction = type private Instruction =
| Process__FileSystemItem of FileSystemItem | 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 private loop (cata : FileSystemCata<'FileSystemItem>) (instructions : ResizeArray<Instruction>) =
let fileSystemItemStack = ResizeArray<'FileSystemItem> () let fileSystemItemStack = ResizeArray<'FileSystemItem> ()
@@ -106,7 +106,7 @@ module GiftCata =
| Process__Gift of Gift | Process__Gift of Gift
| Gift_Wrapped of WrappingPaperStyle | Gift_Wrapped of WrappingPaperStyle
| Gift_Boxed | Gift_Boxed
| Gift_WithACard of string | Gift_WithACard of message : string
let private loop (cata : GiftCata<'Gift>) (instructions : ResizeArray<Instruction>) = let private loop (cata : GiftCata<'Gift>) (instructions : ResizeArray<Instruction>) =
let giftStack = ResizeArray<'Gift> () let giftStack = ResizeArray<'Gift> ()

View File

@@ -0,0 +1,200 @@
//------------------------------------------------------------------------------
// This code was generated by myriad.
// Changes to this file will be lost when the code is regenerated.
//------------------------------------------------------------------------------
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal PublicTypeNoAttrMock =
{
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
/// An implementation where every method throws.
static member Empty : PublicTypeNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
}
interface IPublicTypeNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
member this.Mem3 (arg_0_0, arg_0_1) = this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace
open System
/// Mock record type for an interface
type public PublicTypeInternalFalseNoAttrMock =
{
Mem1 : string * int -> string list
Mem2 : string -> int
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
/// An implementation where every method throws.
static member Empty : PublicTypeInternalFalseNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
}
interface IPublicTypeInternalFalseNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
member this.Mem3 (arg_0_0, arg_0_1) = this.Mem3 (arg_0_0, arg_0_1)
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal InternalTypeNoAttrMock =
{
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every method throws.
static member Empty : InternalTypeNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface InternalTypeNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
namespace SomeNamespace
open System
/// Mock record type for an interface
type private PrivateTypeNoAttrMock =
{
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every method throws.
static member Empty : PrivateTypeNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface PrivateTypeNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
namespace SomeNamespace
open System
/// Mock record type for an interface
type private PrivateTypeInternalFalseNoAttrMock =
{
Mem1 : string * int -> unit
Mem2 : string -> int
}
/// An implementation where every method throws.
static member Empty : PrivateTypeInternalFalseNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface PrivateTypeInternalFalseNoAttr with
member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1)
member this.Mem2 arg_0_0 = this.Mem2 (arg_0_0)
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal VeryPublicTypeNoAttrMock<'a, 'b> =
{
Mem1 : 'a -> 'b
}
/// An implementation where every method throws.
static member Empty () : VeryPublicTypeNoAttrMock<'a, 'b> =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
}
interface VeryPublicTypeNoAttr<'a, 'b> with
member this.Mem1 arg_0_0 = this.Mem1 (arg_0_0)
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal CurriedNoAttrMock<'a> =
{
Mem1 : int -> 'a -> string
Mem2 : int * string -> 'a -> string
Mem3 : (int * string) -> 'a -> string
Mem4 : (int * string) -> ('a * int) -> string
Mem5 : int * string -> ('a * int) -> string
Mem6 : int * string -> 'a * int -> string
}
/// An implementation where every method throws.
static member Empty () : CurriedNoAttrMock<'a> =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
Mem3 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem3"))
Mem4 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem4"))
Mem5 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem5"))
Mem6 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem6"))
}
interface CurriedNoAttr<'a> with
member this.Mem1 arg_0_0 arg_1_0 = this.Mem1 (arg_0_0) (arg_1_0)
member this.Mem2 (arg_0_0, arg_0_1) arg_1_0 = this.Mem2 (arg_0_0, arg_0_1) (arg_1_0)
member this.Mem3 ((arg_0_0, arg_0_1)) arg_1_0 = this.Mem3 (arg_0_0, arg_0_1) (arg_1_0)
member this.Mem4 ((arg_0_0, arg_0_1)) ((arg_1_0, arg_1_1)) =
this.Mem4 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem5 (arg_0_0, arg_0_1) ((arg_1_0, arg_1_1)) =
this.Mem5 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
member this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) =
this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1)
namespace SomeNamespace
open System
/// Mock record type for an interface
type internal TypeWithInterfaceNoAttrMock =
{
/// Implementation of IDisposable.Dispose
Dispose : unit -> unit
Mem1 : string option -> string[] Async
Mem2 : unit -> string[] Async
}
/// An implementation where every method throws.
static member Empty : TypeWithInterfaceNoAttrMock =
{
Dispose = (fun () -> ())
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface TypeWithInterfaceNoAttr with
member this.Mem1 arg_0_0 = this.Mem1 (arg_0_0)
member this.Mem2 () = this.Mem2 (())
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()

View File

@@ -31,7 +31,7 @@ module MyListCata =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
type private Instruction<'a> = type private Instruction<'a> =
| Process__MyList of MyList<'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 private loop (cata : MyListCata<'a, 'MyList>) (instructions : ResizeArray<Instruction<'a>>) =
let myListStack = ResizeArray<'MyList> () let myListStack = ResizeArray<'MyList> ()

View File

@@ -0,0 +1,41 @@
namespace SomeNamespace
open System
type IPublicTypeNoAttr =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
type IPublicTypeInternalFalseNoAttr =
abstract Mem1 : string * int -> string list
abstract Mem2 : string -> int
abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string
type internal InternalTypeNoAttr =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
type private PrivateTypeNoAttr =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
type private PrivateTypeInternalFalseNoAttr =
abstract Mem1 : string * int -> unit
abstract Mem2 : string -> int
type VeryPublicTypeNoAttr<'a, 'b> =
abstract Mem1 : 'a -> 'b
type CurriedNoAttr<'a> =
abstract Mem1 : int -> 'a -> string
abstract Mem2 : int * string -> 'a -> string
abstract Mem3 : (int * string) -> 'a -> string
abstract Mem4 : (int * string) -> ('a * int) -> string
abstract Mem5 : x : int * string -> ('a * int) -> string
abstract Mem6 : int * string -> y : 'a * int -> string
type TypeWithInterfaceNoAttr =
inherit IDisposable
abstract Mem1 : string option -> string[] Async
abstract Mem2 : unit -> string[] Async

View File

@@ -604,6 +604,36 @@ For example, this specifies that Myriad is to use the contents of `Client.fs` to
</ItemGroup> </ItemGroup>
``` ```
## Alternative use without the attributes
You can avoid taking a reference on the `WoofWare.Myriad.Plugins.Attributes` assembly, instead putting all the configuration into the project file.
This is implemented for everything except the SwaggerClientGenerator.
```xml
<Project>
<ItemGroup>
<Compile Include="Client.fs" />
<Compile Include="GeneratedClient.fs">
<MyriadFile>Client.fs</MyriadFile>
<MyriadParams>
<MyTypeName1>GenerateMock(false)!JsonParse</MyTypeName1>
<SomeOtherTypeName>GenerateMock</SomeOtherTypeName>
</MyriadParams>
</Compile>
</ItemGroup>
<ItemGroup>
<PackageReference Include="WoofWare.Myriad.Plugins" Version="$(WoofWareMyriadPluginVersion)" PrivateAssets="all" />
<PackageReference Include="Myriad.Sdk" Version="0.8.3" PrivateAssets="all" />
</ItemGroup>
</Project>
```
That is, you specify a `!`-delimited list of the attributes you *would* apply to the type.
Supply "arguments" to the attribute name in the project file as you would to the attribute itself.
(Yes, this is indeed incredibly cumbersome, and you're not interested in the reasons it's all so mad!
I'm hopefully going to get round to writing a more powerful source generation system which won't have these limitations.)
### Myriad Gotchas ### Myriad Gotchas
* MsBuild doesn't always realise that it needs to invoke Myriad during rebuild. * MsBuild doesn't always realise that it needs to invoke Myriad during rebuild.

View File

@@ -0,0 +1,36 @@
namespace WoofWare.Myriad.Plugins.Test
open System
open SomeNamespace
open NUnit.Framework
open FsUnitTyped
[<TestFixture>]
module TestMockGeneratorNoAttr =
[<Test>]
let ``Example of use: IPublicType`` () =
let mock : IPublicTypeNoAttr =
{ PublicTypeNoAttrMock.Empty with
Mem1 = fun (s, count) -> List.replicate count s
}
:> _
let _ =
Assert.Throws<NotImplementedException> (fun () -> mock.Mem2 "hi" |> ignore<int>)
mock.Mem1 ("hi", 3) |> shouldEqual [ "hi" ; "hi" ; "hi" ]
[<Test>]
let ``Example of use: curried args`` () =
let mock : CurriedNoAttr<_> =
{ CurriedNoAttrMock.Empty () with
Mem1 = fun i c -> Array.replicate i c |> String
Mem2 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s)
Mem3 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s)
}
:> _
mock.Mem1 3 'a' |> shouldEqual "aaa"
mock.Mem2 (3, "hi") 'a' |> shouldEqual "hiahiahi"
mock.Mem3 (3, "hi") 'a' |> shouldEqual "hiahiahi"

View File

@@ -26,6 +26,7 @@
<Compile Include="TestHttpClient\TestVaultClient.fs" /> <Compile Include="TestHttpClient\TestVaultClient.fs" />
<Compile Include="TestHttpClient\TestVariableHeader.fs" /> <Compile Include="TestHttpClient\TestVariableHeader.fs" />
<Compile Include="TestMockGenerator\TestMockGenerator.fs" /> <Compile Include="TestMockGenerator\TestMockGenerator.fs" />
<Compile Include="TestMockGenerator\TestMockGeneratorNoAttr.fs" />
<Compile Include="TestJsonSerialize\TestJsonSerde.fs" /> <Compile Include="TestJsonSerialize\TestJsonSerde.fs" />
<Compile Include="TestCataGenerator\TestCataGenerator.fs" /> <Compile Include="TestCataGenerator\TestCataGenerator.fs" />
<Compile Include="TestCataGenerator\TestDirectory.fs" /> <Compile Include="TestCataGenerator\TestDirectory.fs" />

View File

@@ -4,8 +4,6 @@ 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 Fantomas.FCS.Xml
open Myriad.Core
type internal ArgParserOutputSpec = type internal ArgParserOutputSpec =
{ {
@@ -1224,7 +1222,7 @@ module internal ArgParserGenerator =
(SynExpr.CreateConst ())) (SynExpr.CreateConst ()))
]) ])
SynMatchClause.create SynMatchClause.create
(SynPat.listCons (SynPat.createConst (SynConst.CreateString "--")) (SynPat.named "rest")) (SynPat.listCons (SynPat.createConst (SynConst.Create "--")) (SynPat.named "rest"))
(SynExpr.callMethodArg (SynExpr.callMethodArg
"AddRange" "AddRange"
(SynExpr.paren ( (SynExpr.paren (
@@ -1643,7 +1641,7 @@ module internal ArgParserGenerator =
let modInfo = let modInfo =
SynComponentInfo.create modName SynComponentInfo.create modName
|> SynComponentInfo.withDocString ( |> 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 |> SynComponentInfo.addAttributes modAttrs
@@ -1666,7 +1664,7 @@ module internal ArgParserGenerator =
[ [
{ {
Attrs = [] Attrs = []
Ident = Ident.create "key" Ident = Some (Ident.create "key")
Type = SynType.string Type = SynType.string
} }
] ]
@@ -1740,12 +1738,21 @@ module internal ArgParserGenerator =
[ [
for openStatement in opens do for openStatement in opens do
yield SynModuleDecl.CreateOpen openStatement yield SynModuleDecl.openAny openStatement
yield taggedMod yield taggedMod
] ]
|> SynModuleOrNamespace.createNamespace ns |> SynModuleOrNamespace.createNamespace ns
let generate (context : GeneratorContext) : Output = open Myriad.Core
/// Myriad generator that provides a catamorphism for an algebraic data type.
[<MyriadGenerator("arg-parser")>]
type ArgParserGenerator () =
interface IMyriadGenerator with
member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) =
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
@@ -1762,7 +1769,7 @@ module internal ArgParserGenerator =
let typeWithAttr = let typeWithAttr =
types types
|> List.choose (fun ty -> |> List.choose (fun ty ->
match Ast.getAttribute<ArgParserAttribute> ty with match SynTypeDefn.getAttribute typeof<ArgParserAttribute>.Name ty with
| None -> None | None -> None
| Some attr -> | Some attr ->
let arg = let arg =
@@ -1806,15 +1813,8 @@ module internal ArgParserGenerator =
let modules = let modules =
namespaceAndTypes namespaceAndTypes
|> List.map (fun (ns, taggedType, unions, records) -> createModule opens ns taggedType unions records) |> List.map (fun (ns, taggedType, unions, records) ->
ArgParserGenerator.createModule opens ns taggedType unions records
)
Output.Ast modules Output.Ast modules
/// Myriad generator that provides a catamorphism for an algebraic data type.
[<MyriadGenerator("arg-parser")>]
type ArgParserGenerator () =
interface IMyriadGenerator with
member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) = ArgParserGenerator.generate context

View File

@@ -3,7 +3,6 @@ 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 Myriad.Core
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal CataGenerator = module internal CataGenerator =
@@ -176,7 +175,7 @@ module internal CataGenerator =
|> SynExpr.createLet |> SynExpr.createLet
[ [
SynBinding.Let ( SynBinding.Let (
valData = SynValData.SynValData (None, SynValInfo.Empty, None), valData = SynValData.SynValData (None, SynValInfo.empty, None),
pattern = pattern =
SynPat.tupleNoParen ( SynPat.tupleNoParen (
allArtificialTyparNames allArtificialTyparNames
@@ -463,18 +462,39 @@ module internal CataGenerator =
{ {
SynFieldData.Type = field.Type SynFieldData.Type = field.Type
Attrs = [] 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 = let casesFromCases =
recursiveCases analysis recursiveCases analysis
|> List.map (fun case -> |> 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 let cases = casesFromProcess @ casesFromCases
@@ -539,8 +559,8 @@ module internal CataGenerator =
|> List.map (fun case -> |> List.map (fun case ->
let arity = let arity =
SynValInfo.SynValInfo ( SynValInfo.SynValInfo (
case.Fields |> List.map (fun field -> [ SynArgInfo.Empty ]), case.Fields |> List.map (fun field -> [ SynArgInfo.empty ]),
SynArgInfo.Empty SynArgInfo.empty
) )
(SynType.var generics.[analysis.GenericName.idText], List.rev case.FlattenedFields) (SynType.var generics.[analysis.GenericName.idText], List.rev case.FlattenedFields)
@@ -852,9 +872,7 @@ module internal CataGenerator =
else else
[] []
SynMatchClause.create SynMatchClause.create (SynPat.identWithArgs unionCase.Match (SynArgPats.create matchLhs)) matchBody
(SynPat.CreateLongIdent (SynLongIdent.create unionCase.Match, matchLhs))
matchBody
) )
SynExpr.createMatch (SynExpr.createIdent "x") matchCases SynExpr.createMatch (SynExpr.createIdent "x") matchCases
@@ -1059,7 +1077,7 @@ module internal CataGenerator =
(SynExpr.CreateConst 0) (SynExpr.CreateConst 0)
(SynExpr.createLongIdent [ "instructions" ; "Count" ])) (SynExpr.createLongIdent [ "instructions" ; "Count" ]))
body body
SynExpr.CreateTuple ( SynExpr.tupleNoParen (
analysis analysis
|> List.map (fun unionAnalysis -> [ unionAnalysis.StackName ] |> SynExpr.createLongIdent') |> List.map (fun unionAnalysis -> [ unionAnalysis.StackName ] |> SynExpr.createLongIdent')
) )
@@ -1103,7 +1121,7 @@ module internal CataGenerator =
let modInfo = let modInfo =
SynComponentInfo.create moduleName SynComponentInfo.create moduleName
|> SynComponentInfo.withDocString ( |> 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 ] |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
@@ -1150,7 +1168,7 @@ module internal CataGenerator =
[ [
for openStatement in opens do for openStatement in opens do
yield SynModuleDecl.CreateOpen openStatement yield SynModuleDecl.openAny openStatement
yield! cataStructures yield! cataStructures
yield cataRecord yield cataRecord
yield yield
@@ -1162,7 +1180,16 @@ module internal CataGenerator =
] ]
|> SynModuleOrNamespace.createNamespace ns |> SynModuleOrNamespace.createNamespace ns
let generate (context : GeneratorContext) : Output = open Myriad.Core
/// Myriad generator that provides a catamorphism for an algebraic data type.
[<MyriadGenerator("create-catamorphism")>]
type CreateCatamorphismGenerator () =
interface IMyriadGenerator with
member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) =
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
@@ -1176,7 +1203,7 @@ module internal CataGenerator =
let typeWithAttr = let typeWithAttr =
types types
|> List.tryPick (fun ty -> |> List.tryPick (fun ty ->
match Ast.getAttribute<CreateCatamorphismAttribute> ty with match SynTypeDefn.getAttribute typeof<CreateCatamorphismAttribute>.Name ty with
| None -> None | None -> None
| Some attr -> Some (attr.ArgExpr, ty) | Some attr -> Some (attr.ArgExpr, ty)
) )
@@ -1206,15 +1233,8 @@ module internal CataGenerator =
let modules = let modules =
namespaceAndTypes namespaceAndTypes
|> List.map (fun (ns, taggedType, unions, records) -> createModule opens ns taggedType unions records) |> List.map (fun (ns, taggedType, unions, records) ->
CataGenerator.createModule opens ns taggedType unions records
)
Output.Ast modules Output.Ast modules
/// Myriad generator that provides a catamorphism for an algebraic data type.
[<MyriadGenerator("create-catamorphism")>]
type CreateCatamorphismGenerator () =
interface IMyriadGenerator with
member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) = CataGenerator.generate context

View File

@@ -992,6 +992,10 @@ type HttpClientGenerator () =
member _.ValidInputExtensions = [ ".fs" ] member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) = member _.Generate (context : GeneratorContext) =
let targetedTypes =
MyriadParamParser.render context.AdditionalParameters
|> Map.map (fun _ v -> v.Split '!' |> Array.toList |> List.map DesiredGenerator.Parse)
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
@@ -1004,13 +1008,33 @@ type HttpClientGenerator () =
|> List.choose (fun (ns, types) -> |> List.choose (fun (ns, types) ->
types types
|> List.choose (fun typeDef -> |> List.choose (fun typeDef ->
match Ast.getAttribute<HttpClientAttribute> typeDef with match SynTypeDefn.getAttribute typeof<HttpClientAttribute>.Name typeDef with
| None -> None | None ->
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
match Map.tryFind name targetedTypes with
| Some desired ->
desired
|> List.tryPick (fun generator ->
match generator with
| DesiredGenerator.HttpClient arg ->
let spec =
{
ExtensionMethods =
arg
|> Option.defaultValue
HttpClientAttribute.DefaultIsExtensionMethod
}
Some (typeDef, spec)
| _ -> None
)
| _ -> None
| Some attr -> | Some attr ->
let arg = let arg =
match SynExpr.stripOptionalParen attr.ArgExpr with match SynExpr.stripOptionalParen attr.ArgExpr with
| SynExpr.Const (SynConst.Bool value, _) -> value | SynExpr.Const (SynConst.Bool value, _) -> value
| SynExpr.Const (SynConst.Unit, _) -> JsonParseAttribute.DefaultIsExtensionMethod | SynExpr.Const (SynConst.Unit, _) -> HttpClientAttribute.DefaultIsExtensionMethod
| arg -> | arg ->
failwith failwith
$"Unrecognised argument %+A{arg} to [<%s{nameof HttpClientAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only." $"Unrecognised argument %+A{arg} to [<%s{nameof HttpClientAttribute}>]. Literals are not supported. Use `true` or `false` (or unit) only."

View File

@@ -283,6 +283,10 @@ type InterfaceMockGenerator () =
member _.ValidInputExtensions = [ ".fs" ] member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) = member _.Generate (context : GeneratorContext) =
let targetedTypes =
MyriadParamParser.render context.AdditionalParameters
|> Map.map (fun _ v -> v.Split '!' |> Array.toList |> List.map DesiredGenerator.Parse)
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
@@ -294,7 +298,27 @@ type InterfaceMockGenerator () =
types types
|> List.choose (fun typeDef -> |> List.choose (fun typeDef ->
match Ast.getAttribute<GenerateMockAttribute> typeDef with match Ast.getAttribute<GenerateMockAttribute> typeDef with
| None -> None | None ->
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
match Map.tryFind name targetedTypes with
| Some desired ->
desired
|> List.tryPick (fun generator ->
match generator with
| DesiredGenerator.InterfaceMock arg ->
let spec =
{
IsInternal =
arg
|> Option.defaultValue GenerateMockAttribute.DefaultIsInternal
}
Some (typeDef, spec)
| _ -> None
)
| _ -> None
| Some attr -> | Some attr ->
let arg = let arg =
match SynExpr.stripOptionalParen attr.ArgExpr with match SynExpr.stripOptionalParen attr.ArgExpr with

View File

@@ -702,6 +702,10 @@ type JsonParseGenerator () =
member _.ValidInputExtensions = [ ".fs" ] member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) = member _.Generate (context : GeneratorContext) =
let targetedTypes =
MyriadParamParser.render context.AdditionalParameters
|> Map.map (fun _ v -> v.Split '!' |> Array.toList |> List.map DesiredGenerator.Parse)
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
@@ -723,8 +727,29 @@ type JsonParseGenerator () =
|> List.choose (fun (ns, types) -> |> List.choose (fun (ns, types) ->
types types
|> List.choose (fun typeDef -> |> List.choose (fun typeDef ->
match Ast.getAttribute<JsonParseAttribute> typeDef with match SynTypeDefn.getAttribute typeof<JsonParseAttribute>.Name typeDef with
| None -> None | None ->
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
match Map.tryFind name targetedTypes with
| Some desired ->
desired
|> List.tryPick (fun generator ->
match generator with
| DesiredGenerator.JsonParse arg ->
let spec =
{
ExtensionMethods =
arg
|> Option.defaultValue
JsonParseAttribute.DefaultIsExtensionMethod
}
Some (typeDef, spec)
| _ -> None
)
| _ -> None
| Some attr -> | Some attr ->
let arg = let arg =
match SynExpr.stripOptionalParen attr.ArgExpr with match SynExpr.stripOptionalParen attr.ArgExpr with

View File

@@ -519,6 +519,10 @@ type JsonSerializeGenerator () =
member _.ValidInputExtensions = [ ".fs" ] member _.ValidInputExtensions = [ ".fs" ]
member _.Generate (context : GeneratorContext) = member _.Generate (context : GeneratorContext) =
let targetedTypes =
MyriadParamParser.render context.AdditionalParameters
|> Map.map (fun _ v -> v.Split '!' |> Array.toList |> List.map DesiredGenerator.Parse)
let ast, _ = let ast, _ =
Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head Ast.fromFilename context.InputFilename |> Async.RunSynchronously |> Array.head
@@ -540,8 +544,29 @@ type JsonSerializeGenerator () =
|> List.choose (fun (ns, types) -> |> List.choose (fun (ns, types) ->
types types
|> List.choose (fun typeDef -> |> List.choose (fun typeDef ->
match Ast.getAttribute<JsonSerializeAttribute> typeDef with match SynTypeDefn.getAttribute typeof<JsonSerializeAttribute>.Name typeDef with
| None -> None | None ->
let name = SynTypeDefn.getName typeDef |> List.map _.idText |> String.concat "."
match Map.tryFind name targetedTypes with
| Some desired ->
desired
|> List.tryPick (fun generator ->
match generator with
| DesiredGenerator.JsonSerialize arg ->
let spec =
{
ExtensionMethods =
arg
|> Option.defaultValue
JsonSerializeAttribute.DefaultIsExtensionMethod
}
Some (typeDef, spec)
| _ -> None
)
| _ -> None
| Some attr -> | Some attr ->
let arg = let arg =
match SynExpr.stripOptionalParen attr.ArgExpr with match SynExpr.stripOptionalParen attr.ArgExpr with

View File

@@ -0,0 +1,64 @@
namespace WoofWare.Myriad.Plugins
open System.Collections.Generic
type internal DesiredGenerator =
| InterfaceMock of isInternal : bool option
| JsonParse of extensionMethod : bool option
| JsonSerialize of extensionMethod : bool option
| HttpClient of extensionMethod : bool option
static member Parse (s : string) =
match s with
| "GenerateMock" -> DesiredGenerator.InterfaceMock None
| "GenerateMock(true)" -> DesiredGenerator.InterfaceMock (Some true)
| "GenerateMock(false)" -> DesiredGenerator.InterfaceMock (Some false)
| "JsonParse" -> DesiredGenerator.JsonParse None
| "JsonParse(true)" -> DesiredGenerator.JsonParse (Some true)
| "JsonParse(false)" -> DesiredGenerator.JsonParse (Some false)
| "JsonSerialize" -> DesiredGenerator.JsonSerialize None
| "JsonSerialize(true)" -> DesiredGenerator.JsonSerialize (Some true)
| "JsonSerialize(false)" -> DesiredGenerator.JsonSerialize (Some false)
| "HttpClient" -> DesiredGenerator.HttpClient None
| "HttpClient(true)" -> DesiredGenerator.HttpClient (Some true)
| "HttpClient(false)" -> DesiredGenerator.HttpClient (Some false)
| _ -> failwith $"Failed to parse as a generator specification: %s{s}"
[<RequireQualifiedAccess>]
module internal MyriadParamParser =
(*
An apparent bug in Myriad's argument parsing means that this:
<MyriadParams>
<Foo>bar</Foo>
<Baz>quux</Baz>
</MyriadParams>
leads to this:
Foo = "bar;Baz=quux"
I'm not going to put effort into fixing Myriad, though, because I want
to build something much more powerful instead.
*)
/// Call this with `context.AdditionalParameters`.
let render (pars : IDictionary<string, string>) : Map<string, string> =
match pars.Count with
| 0 -> Map.empty
| 1 ->
let (KeyValue (key, value)) = pars |> Seq.exactlyOne
match value.Split ';' |> Seq.toList with
| [] -> failwith "LOGIC ERROR"
| value :: rest ->
rest
|> Seq.map (fun v ->
let split = v.Split '='
split.[0], String.concat "=" split.[1..]
)
|> Seq.append (Seq.singleton (key, value))
|> Map.ofSeq
| _ ->
// assume the Myriad bug is fixed!
pars |> Seq.map (fun (KeyValue (k, v)) -> k, v) |> Map.ofSeq

View File

@@ -150,7 +150,10 @@ type RemoveOptionsGenerator () =
let namespaceAndRecords = let namespaceAndRecords =
records records
|> List.choose (fun (ns, types) -> |> List.choose (fun (ns, types) ->
match types |> List.filter Ast.hasAttribute<RemoveOptionsAttribute> with match
types
|> List.filter (SynTypeDefn.hasAttribute typeof<RemoveOptionsAttribute>.Name)
with
| [] -> None | [] -> None
| types -> | types ->
let types = let types =

View File

@@ -672,31 +672,16 @@ type SwaggerClientGenerator () =
|> Seq.toList |> Seq.toList
let config = let config =
// Bug in Myriad, their arg parsing is borked. let pars = MyriadParamParser.render context.AdditionalParameters
let pars =
context.AdditionalParameters
|> Seq.map (fun (KeyValue (k, v)) -> k, v)
|> Seq.toList
let pars = let pars =
match pars with pars
| [] -> |> Map.toSeq
|> Seq.map (fun (k, v) -> k.ToUpperInvariant (), v)
|> Map.ofSeq
if pars.IsEmpty then
failwith "No parameters given. You must supply the <ClassName /> parameter in <MyriadParams />." failwith "No parameters given. You must supply the <ClassName /> parameter in <MyriadParams />."
| [ key, value ] ->
let semicolon = value.IndexOf ';'
if semicolon >= 0 then
let equals = value.IndexOf ('=', semicolon)
[
key, value.Substring (0, semicolon)
value.Substring (semicolon + 1, equals - semicolon - 1), value.Substring (equals + 1)
]
else
[ key, value ]
| rest -> rest
|> List.map (fun (key, value) -> key.ToUpperInvariant (), value)
|> Map.ofList
let createMock = let createMock =
match Map.tryFind "GENERATEMOCKVISIBILITY" pars with match Map.tryFind "GENERATEMOCKVISIBILITY" pars with

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.Syntax
open Fantomas.FCS.SyntaxTrivia open Fantomas.FCS.SyntaxTrivia
open Myriad.Core
open Fantomas.FCS.Text.Range open Fantomas.FCS.Text.Range
[<AutoOpen>] [<AutoOpen>]
module internal SynExprExtensions = module internal SynExprExtensions =
type SynExpr with type SynExpr with
static member CreateConst (s : string) : SynExpr = 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) static member CreateConst () : SynExpr = SynExpr.Const (SynConst.Unit, range0)
@@ -17,7 +16,13 @@ module internal SynExprExtensions =
static member CreateConst (c : char) : SynExpr = static member CreateConst (c : char) : SynExpr =
// apparent Myriad bug: `IndexOf '?'` gets formatted as `IndexOf ?` which is clearly wrong // 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) |> fun e -> SynExpr.Paren (e, range0, Some range0, range0)
static member CreateConst (i : int32) : SynExpr = static member CreateConst (i : int32) : SynExpr =
@@ -27,15 +32,27 @@ module internal SynExprExtensions =
module internal SynExpr = module internal SynExpr =
/// {f} {x} /// {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} /// {f} {x}
let inline applyTo (x : SynExpr) (f : SynExpr) : SynExpr = applyFunction 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} /// {expr} |> {func}
let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr = let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr =
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.pipe, expr) createAppInfix (createLongIdent'' SynLongIdent.pipe) expr |> applyTo func
|> applyTo func
/// if {cond} then {trueBranch} else {falseBranch} /// if {cond} then {trueBranch} else {falseBranch}
/// Note that this function puts the trueBranch last, for pipelining convenience: /// Note that this function puts the trueBranch last, for pipelining convenience:
@@ -78,45 +95,23 @@ module internal SynExpr =
/// {a} = {b} /// {a} = {b}
let equals (a : SynExpr) (b : SynExpr) = let equals (a : SynExpr) (b : SynExpr) =
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.eq, a) |> applyTo b createAppInfix (createLongIdent'' SynLongIdent.eq) a |> applyTo b
/// {a} && {b} /// {a} && {b}
let booleanAnd (a : SynExpr) (b : SynExpr) = let booleanAnd (a : SynExpr) (b : SynExpr) =
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanAnd, a) createAppInfix (createLongIdent'' SynLongIdent.booleanAnd) a |> applyTo b
|> applyTo b
/// {a} || {b} /// {a} || {b}
let booleanOr (a : SynExpr) (b : SynExpr) = let booleanOr (a : SynExpr) (b : SynExpr) =
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanOr, a) createAppInfix (createLongIdent'' SynLongIdent.booleanOr) a |> applyTo b
|> applyTo b
/// {a} + {b} /// {a} + {b}
let plus (a : SynExpr) (b : SynExpr) = let plus (a : SynExpr) (b : SynExpr) =
SynExpr.CreateAppInfix ( createAppInfix (createLongIdent'' SynLongIdent.plus) a |> applyTo b
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
Ident.CreateLong "op_Addition",
[],
[ Some (IdentTrivia.OriginalNotation "+") ]
)
),
a
)
|> applyTo b
/// {a} * {b} /// {a} * {b}
let times (a : SynExpr) (b : SynExpr) = let times (a : SynExpr) (b : SynExpr) =
SynExpr.CreateAppInfix ( createAppInfix (createLongIdent'' SynLongIdent.times) a |> applyTo b
SynExpr.CreateLongIdent (
SynLongIdent.SynLongIdent (
Ident.CreateLong "op_Multiply",
[],
[ Some (IdentTrivia.OriginalNotation "*") ]
)
),
a
)
|> applyTo b
let rec stripOptionalParen (expr : SynExpr) : SynExpr = let rec stripOptionalParen (expr : SynExpr) : SynExpr =
match expr with match expr with
@@ -172,7 +167,7 @@ module internal SynExpr =
SynExpr.Lambda ( SynExpr.Lambda (
false, false,
false, false,
SynSimplePats.Create [ SynSimplePat.CreateId (Ident.Create varName) ], SynSimplePats.create [ SynSimplePat.createId (Ident.create varName) ],
body, body,
Some (parsedDataPat, body), Some (parsedDataPat, body),
range0, range0,
@@ -186,7 +181,7 @@ module internal SynExpr =
SynExpr.Lambda ( SynExpr.Lambda (
false, false,
false, false,
SynSimplePats.Create [], SynSimplePats.create [],
body, body,
Some ([ SynPat.unit ], body), Some ([ SynPat.unit ], body),
range0, range0,
@@ -200,12 +195,6 @@ module internal SynExpr =
let inline createIdent' (i : Ident) : SynExpr = SynExpr.Ident i 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 = let tupleNoParen (args : SynExpr list) : SynExpr =
SynExpr.Tuple (false, args, List.replicate (args.Length - 1) range0, range0) SynExpr.Tuple (false, args, List.replicate (args.Length - 1) range0, range0)
@@ -332,7 +321,7 @@ module internal SynExpr =
/// {ident} - {rhs} /// {ident} - {rhs}
let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr = let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr =
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.sub, SynExpr.CreateLongIdent ident) createAppInfix (createLongIdent'' SynLongIdent.sub) (createLongIdent'' ident)
|> applyTo rhs |> applyTo rhs
/// {ident} - {n} /// {ident} - {n}
@@ -340,26 +329,24 @@ module internal SynExpr =
/// {y} > {x} /// {y} > {x}
let greaterThan (x : SynExpr) (y : SynExpr) : SynExpr = 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} /// {y} < {x}
let lessThan (x : SynExpr) (y : SynExpr) : SynExpr = 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} /// {y} >= {x}
let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr = let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr =
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.geq, y) createAppInfix (createLongIdent'' SynLongIdent.geq) y |> applyTo x
|> applyTo x
/// {y} <= {x} /// {y} <= {x}
let lessThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr = let lessThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr =
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.leq, y) createAppInfix (createLongIdent'' SynLongIdent.leq) y |> applyTo x
|> applyTo x
/// {x} :: {y} /// {x} :: {y}
let listCons (x : SynExpr) (y : SynExpr) : SynExpr = let listCons (x : SynExpr) (y : SynExpr) : SynExpr =
SynExpr.CreateAppInfix ( createAppInfix
SynExpr.LongIdent ( (SynExpr.LongIdent (
false, false,
SynLongIdent.SynLongIdent ( SynLongIdent.SynLongIdent (
[ Ident.create "op_ColonColon" ], [ Ident.create "op_ColonColon" ],
@@ -368,9 +355,8 @@ module internal SynExpr =
), ),
None, None,
range0 range0
), ))
tupleNoParen [ x ; y ] (tupleNoParen [ x ; y ])
)
|> paren |> paren
let assign (lhs : SynLongIdent) (rhs : SynExpr) : SynExpr = SynExpr.LongIdentSet (lhs, rhs, range0) let assign (lhs : SynLongIdent) (rhs : SynExpr) : SynExpr = SynExpr.LongIdentSet (lhs, rhs, range0)

View File

@@ -39,6 +39,12 @@ module internal SynLongIdent =
let booleanOr = let booleanOr =
SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanOr" ], [], [ Some (IdentTrivia.OriginalNotation "||") ]) 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 = let pipe =
SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ]) 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

@@ -25,3 +25,22 @@ module internal SynTypeDefn =
match r with match r with
| SynTypeDefn (typeInfo, typeRepr, _, ctor, range, trivia) -> | SynTypeDefn (typeInfo, typeRepr, _, ctor, range, trivia) ->
SynTypeDefn.SynTypeDefn (typeInfo, typeRepr, members, 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

View File

@@ -23,14 +23,14 @@ type UnionCase<'ident> =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal SynUnionCase = module internal SynUnionCase =
let create (case : UnionCase<Ident>) : SynUnionCase = let create (case : UnionCase<Ident option>) : SynUnionCase =
let fields = let fields =
case.Fields case.Fields
|> List.map (fun field -> |> List.map (fun field ->
SynField.SynField ( SynField.SynField (
SynAttributes.ofAttrs field.Attrs, SynAttributes.ofAttrs field.Attrs,
false, false,
Some field.Ident, field.Ident,
field.Type, field.Type,
false, false,
PreXmlDoc.Empty, 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="Teq.fs" />
<Compile Include="Primitives.fs" /> <Compile Include="Primitives.fs" />
<Compile Include="SynExpr\SynAttributes.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\PreXmlDoc.fs" />
<Compile Include="SynExpr\Ident.fs" /> <Compile Include="SynExpr\Ident.fs" />
<Compile Include="SynExpr\SynSimplePat.fs" />
<Compile Include="SynExpr\SynSimplePats.fs" />
<Compile Include="SynExpr\SynIdent.fs" /> <Compile Include="SynExpr\SynIdent.fs" />
<Compile Include="SynExpr\SynLongIdent.fs" /> <Compile Include="SynExpr\SynLongIdent.fs" />
<Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" /> <Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
@@ -53,6 +58,7 @@
<Compile Include="Measure.fs" /> <Compile Include="Measure.fs" />
<Compile Include="AstHelper.fs" /> <Compile Include="AstHelper.fs" />
<Compile Include="RemoveOptionsGenerator.fs"/> <Compile Include="RemoveOptionsGenerator.fs"/>
<Compile Include="MyriadParamParser.fs" />
<Compile Include="InterfaceMockGenerator.fs"/> <Compile Include="InterfaceMockGenerator.fs"/>
<Compile Include="JsonSerializeGenerator.fs"/> <Compile Include="JsonSerializeGenerator.fs"/>
<Compile Include="JsonParseGenerator.fs"/> <Compile Include="JsonParseGenerator.fs"/>

12
flake.lock generated
View File

@@ -5,11 +5,11 @@
"systems": "systems" "systems": "systems"
}, },
"locked": { "locked": {
"lastModified": 1710146030, "lastModified": 1726560853,
"narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=", "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=",
"owner": "numtide", "owner": "numtide",
"repo": "flake-utils", "repo": "flake-utils",
"rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a", "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a",
"type": "github" "type": "github"
}, },
"original": { "original": {
@@ -20,11 +20,11 @@
}, },
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1725534445, "lastModified": 1727524699,
"narHash": "sha256-Yd0FK9SkWy+ZPuNqUgmVPXokxDgMJoGuNpMEtkfcf84=", "narHash": "sha256-k6YxGj08voz9NvuKExojiGXAVd69M8COtqWSKr6sQS4=",
"owner": "NixOS", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "9bb1e7571aadf31ddb4af77fc64b2d59580f9a39", "rev": "b5b2fecd0cadd82ef107c9583018f381ae70f222",
"type": "github" "type": "github"
}, },
"original": { "original": {

View File

@@ -52,7 +52,7 @@
projectFile = "./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj"; projectFile = "./WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj";
testProjectFile = "./WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj"; testProjectFile = "./WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj";
disabledTests = ["WoofWare.Myriad.Plugins.Test.TestSurface.CheckVersionAgainstRemote"]; disabledTests = ["WoofWare.Myriad.Plugins.Test.TestSurface.CheckVersionAgainstRemote"];
nugetDeps = ./nix/deps.nix; # `nix build .#default.passthru.fetch-deps && ./result` and put the result here nugetDeps = ./nix/deps.nix; # `nix build .#default.passthru.fetch-deps && ./result nix/deps.nix`
doCheck = true; doCheck = true;
}; };
}; };