Add shortening function (#1)

MyriadPlugin/RemoveOptionsGenerator.fs

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

UsePlugin/Generated.fs

@@ -18,3 +18,11 @@ module RecordType =
             /// Yet another thing!
             C : float list
         }
+
+    /// Remove the optional members of the input.
+    let shorten (input : RecordType) : Short =
+        {
+            A = input.A |> Option.defaultValue (RecordType.DefaultA ())
+            B = input.B
+            C = input.C
+        }

UsePlugin/Program.fs

@@ -3,17 +3,24 @@
 module Program =
     let f : RecordType =
         {
-            A = Some 3
+            A = Some 300
             B = "hello"
             C = [ 0.3 ]
         }
 
-    let g : RecordType.Short =
-        {
-            A = 3
-            B = "hello"
-            C = [ 0.3 ]
-        }
+    let g = RecordType.shorten f
 
     [<EntryPoint>]
-    let main _ = 0
+    let main _ =
+        if not (f.B = g.B && f.C = g.C) then
+            failwith "Non-optional fields differed"
+
+        match f.A with
+        | None ->
+            if g.A <> RecordType.DefaultA () then
+                failwith "Couldn't acquire default"
+        | Some a ->
+            if a <> g.A then
+                failwith "Didn't match existing f.A"
+
+        0

UsePlugin/RecordFile.fs

@@ -11,3 +11,5 @@ type RecordType =
         /// Yet another thing!
         C : float list
     }
+
+    static member DefaultA () : int = 3