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

Add shortening function (#1)

Browse Source
This commit is contained in:
Patrick Stevens
2023-05-06 16:54:17 +01:00
committed by GitHub
parent 1dde7a65f7
commit d8d3f27948
5 changed files with 135 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

117
MyriadPlugin/RemoveOptionsGenerator.fs
View File

@@ -2,6 +2,7 @@ namespace MyriadPlugin
open System
open FSharp.Compiler.Syntax
open FSharp.Compiler.SyntaxTrivia
open FSharp.Compiler.Xml
open Myriad.Core
@@ -20,8 +21,10 @@ module internal Create =
// TODO: consider Microsoft.FSharp.Option or whatever it is
| _ -> false
let (|OptionIdent|_|) (ident : SynLongIdent) =
if isOptionIdent ident then Some () else None
let (|OptionType|_|) (fieldType : SynType) =
match fieldType with
| SynType.App (SynType.LongIdent ident, _, [ innerType ], _, _, _, _) when isOptionIdent ident -> Some innerType
| _ -> None
let private removeOption (s : SynField) : SynField =
let (SynField.SynField (synAttributeLists,
@@ -36,7 +39,7 @@ module internal Create =
let newType =
match fieldType with
| SynType.App (SynType.LongIdent OptionIdent, _, [ innerType ], _, _, _, _) -> innerType
| OptionType innerType -> innerType
| _ -> fieldType
SynField.SynField (
@@ -50,7 +53,8 @@ module internal Create =
range
)
let createCreate (xmlDoc : PreXmlDoc option) (fields : SynField list) =
// TODO: this option seems a bit odd
let createType (xmlDoc : PreXmlDoc option) (fields : SynField list) =
let fields : SynField list = fields |> List.map removeOption
let name = Ident.Create "Short"
@@ -61,6 +65,103 @@ module internal Create =
SynModuleDecl.Types ([ typeDecl ], range0)
let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynField list) =
let xmlDoc = PreXmlDoc.Create " Remove the optional members of the input."
let returnInfo =
SynBindingReturnInfo.Create (SynType.LongIdent (SynLongIdent.CreateFromLongIdent withOptionsType))
let inputArg = Ident.Create "input"
let functionName = Ident.Create "shorten"
let inputVal =
SynValData.SynValData (
None,
SynValInfo.SynValInfo ([ [ SynArgInfo.CreateId functionName ] ], SynArgInfo.Empty),
Some inputArg
)
let body =
fields
|> List.map (fun (SynField (_, _, id, fieldType, _, _, _, _)) ->
let id =
match id with
| None -> failwith "Expected record field to have an identifying name"
| Some id -> id
let accessor =
SynExpr.DotGet (
SynExpr.CreateIdent inputArg,
range0,
SynLongIdent.CreateFromLongIdent [ id ],
range0
)
let body =
match fieldType with
| OptionType _ ->
SynExpr.CreateApp (
SynExpr.CreateAppInfix (
SynExpr.LongIdent (
false,
SynLongIdent.SynLongIdent (
[ Ident.Create "op_PipeRight" ],
[],
[ Some (IdentTrivia.OriginalNotation "|>") ]
),
None,
range0
),
accessor
),
SynExpr.CreateApp (
SynExpr.CreateLongIdent (SynLongIdent.CreateString "Option.defaultValue"),
SynExpr.CreateParen (
SynExpr.CreateApp (
SynExpr.CreateLongIdent (
SynLongIdent.CreateFromLongIdent (
withoutOptionsType @ [ Ident.Create (sprintf "Default%s" id.idText) ]
)
),
SynExpr.CreateUnit
)
)
)
)
| _ -> accessor
(SynLongIdent.CreateFromLongIdent [ id ], true), Some body
)
|> SynExpr.CreateRecord
let pattern =
SynPat.LongIdent (
SynLongIdent.CreateFromLongIdent [ functionName ],
None,
None,
SynArgPats.Pats
[
SynPat.CreateTyped (
SynPat.CreateNamed inputArg,
SynType.LongIdent (SynLongIdent.CreateFromLongIdent withoutOptionsType)
)
|> SynPat.CreateParen
],
None,
range0
)
let binding =
SynBinding.Let (
xmldoc = xmlDoc,
returnInfo = returnInfo,
expr = body,
valData = inputVal,
pattern = pattern
)
SynModuleDecl.CreateLet [ binding ]
let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
typeDefn
@@ -71,9 +172,11 @@ module internal Create =
match synTypeDefnRepr with
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, recordFields, _recordRange), _) ->
let create = createCreate (Some doc) recordFields
let decls = [ yield create ]
let decls =
[
createType (Some doc) recordFields
createMaker [ Ident.Create "Short" ] recordId recordFields
]
let compilationRepresentation : SynAttribute =
{