Support units of measure in JsonParse (#170)

CHANGELOG.md

@@ -1,5 +1,10 @@
 Notable changes are recorded here.
 
+# WoofWare.Myriad.Plugins 2.1.45, WoofWare.Myriad.Plugins.Attributes 3.1.7
+
+The NuGet packages are now attested to through [GitHub Attestations](https://github.blog/2024-05-02-introducing-artifact-attestations-now-in-public-beta/).
+You can run `gh attestation verify ~/.nuget/packages/woofware.myriad.plugins/2.1.45/woofware.myriad.plugins.2.1.45.nupkg -o Smaug123`, for example, to verify with GitHub that the GitHub Actions pipeline on this repository produced a nupkg file with the same hash as the one you were served from NuGet.
+
 # WoofWare.Myriad.Plugins 2.1.33
 
 `JsonParse` can now deserialize the discriminated unions which `JsonSerialize` wrote out.

ConsumePlugin/GeneratedPureGymDto.fs

@@ -148,6 +148,7 @@ module GymLocation =
                         reraise ()
                 else
                     reraise ()
+            |> LanguagePrimitives.FloatWithMeasure
 
         let arg_0 =
             try

ConsumePlugin/PureGymDto.fs

@@ -19,13 +19,16 @@ type GymAccessOptions =
         QrCodeAccess : bool
     }
 
+[<Measure>]
+type measure
+
 [<WoofWare.Myriad.Plugins.JsonParse>]
 type GymLocation =
     {
         [<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>]
         Longitude : float
         [<JsonNumberHandling(JsonNumberHandling.AllowReadingFromString)>]
-        Latitude : float
+        Latitude : float<measure>
     }
 
 [<WoofWare.Myriad.Plugins.JsonParse>]

WoofWare.Myriad.Plugins.Test/PureGymDtos.fs

@@ -58,7 +58,7 @@ module PureGymDtos =
         [
             """{"latitude": 1.0, "longitude": 3.0}""",
             {
-                GymLocation.Latitude = 1.0
+                GymLocation.Latitude = 1.0<measure>
                 Longitude = 3.0
             }
         ]
@@ -96,7 +96,7 @@ module PureGymDtos =
                 Location =
                     {
                         Longitude = -0.110252
-                        Latitude = 51.480401
+                        Latitude = 51.480401<measure>
                     }
                 TimeZone = "Europe/London"
                 ReopenDate = "2021-04-12T00:00:00+01 Europe/London"

WoofWare.Myriad.Plugins/JsonParseGenerator.fs

@@ -140,35 +140,12 @@ module internal JsonParseGenerator =
             failwithf
                 $"Unable to parse the key type %+A{desiredType} of a JSON object. Keys are strings, and this plugin does not know how to convert to that from a string."
 
-    /// Given `node.["town"]`, for example, choose how to obtain a JSON value from it.
-    /// The property name is used in error messages at runtime to show where a JSON
-    /// parse error occurred; supply `None` to indicate "don't validate".
-    let rec parseNode
-        (propertyName : SynExpr option)
+    let private parseNumberType
         (options : JsonParseOption)
-        (fieldType : SynType)
+        (propertyName : SynExpr option)
         (node : SynExpr)
-        : SynExpr
+        (typeName : string)
         =
-        // TODO: parsing format for DateTime etc
-        match fieldType with
-        | DateOnly ->
-            node
-            |> asValueGetValue propertyName "string"
-            |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateOnly" ; "Parse" ])
-        | Uri ->
-            node
-            |> asValueGetValue propertyName "string"
-            |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Uri" ])
-        | Guid ->
-            node
-            |> asValueGetValue propertyName "string"
-            |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Guid" ; "Parse" ])
-        | DateTime ->
-            node
-            |> asValueGetValue propertyName "string"
-            |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTime" ; "Parse" ])
-        | NumberType typeName ->
         let basic = asValueGetValue propertyName typeName node
 
         match options.JsonNumberHandlingArg with
@@ -203,6 +180,36 @@ module internal JsonParseGenerator =
                     range0
                 ))
                 handler
+
+    /// Given `node.["town"]`, for example, choose how to obtain a JSON value from it.
+    /// The property name is used in error messages at runtime to show where a JSON
+    /// parse error occurred; supply `None` to indicate "don't validate".
+    let rec parseNode
+        (propertyName : SynExpr option)
+        (options : JsonParseOption)
+        (fieldType : SynType)
+        (node : SynExpr)
+        : SynExpr
+        =
+        // TODO: parsing format for DateTime etc
+        match fieldType with
+        | DateOnly ->
+            node
+            |> asValueGetValue propertyName "string"
+            |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateOnly" ; "Parse" ])
+        | Uri ->
+            node
+            |> asValueGetValue propertyName "string"
+            |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Uri" ])
+        | Guid ->
+            node
+            |> asValueGetValue propertyName "string"
+            |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "Guid" ; "Parse" ])
+        | DateTime ->
+            node
+            |> asValueGetValue propertyName "string"
+            |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "System" ; "DateTime" ; "Parse" ])
+        | NumberType typeName -> parseNumberType options propertyName node typeName
         | PrimitiveType typeName -> asValueGetValueIdent propertyName typeName node
         | OptionType ty ->
             parseNode None options ty (SynExpr.createIdent "v")
@@ -261,6 +268,14 @@ module internal JsonParseGenerator =
             |> SynExpr.callMethod "ToJsonString"
             |> SynExpr.paren
             |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Numerics" ; "BigInteger" ; "Parse" ])
+        | Measure (_measure, primType) ->
+            let qualified =
+                match Primitives.qualifyType primType with
+                | None -> failwith $"did not recognise type %s{primType} to assign measure"
+                | Some t -> t
+
+            parseNumberType options propertyName node primType
+            |> SynExpr.pipeThroughFunction (Measure.getLanguagePrimitivesMeasure qualified)
         | _ ->
             // Let's just hope that we've also got our own type annotation!
             let typeName =

WoofWare.Myriad.Plugins/Measure.fs

@@ -0,0 +1,24 @@
+namespace WoofWare.Myriad.Plugins
+
+open Fantomas.FCS.Syntax
+
+[<RequireQualifiedAccess>]
+module internal Measure =
+
+    let getLanguagePrimitivesMeasure (typeName : LongIdent) : SynExpr =
+        match typeName |> List.map _.idText with
+        | [ "System" ; "Single" ] -> [ "LanguagePrimitives" ; "Float32WithMeasure" ]
+        | [ "System" ; "Double" ] -> [ "LanguagePrimitives" ; "FloatWithMeasure" ]
+        | [ "System" ; "Byte" ] -> [ "LanguagePrimitives" ; "ByteWithMeasure" ]
+        | [ "System" ; "SByte" ] -> [ "LanguagePrimitives" ; "SByteWithMeasure" ]
+        | [ "System" ; "Int16" ] -> [ "LanguagePrimitives" ; "Int16WithMeasure" ]
+        | [ "System" ; "Int32" ] -> [ "LanguagePrimitives" ; "Int32WithMeasure" ]
+        | [ "System" ; "Int64" ] -> [ "LanguagePrimitives" ; "Int64WithMeasure" ]
+        | [ "System" ; "UInt16" ] -> [ "LanguagePrimitives" ; "UInt16WithMeasure" ]
+        | [ "System" ; "UInt32" ] -> [ "LanguagePrimitives" ; "UInt32WithMeasure" ]
+        | [ "System" ; "UInt64" ] -> [ "LanguagePrimitives" ; "UInt64WithMeasure" ]
+        | l ->
+            let l = String.concat "." l
+            failwith $"unrecognised type for measure: %s{l}"
+
+        |> SynExpr.createLongIdent

WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs

@@ -87,6 +87,20 @@ module internal SynExpr =
         )
         |> applyTo b
 
+    /// {a} * {b}
+    let times (a : SynExpr) (b : SynExpr) =
+        SynExpr.CreateAppInfix (
+            SynExpr.CreateLongIdent (
+                SynLongIdent.SynLongIdent (
+                    Ident.CreateLong "op_Multiply",
+                    [],
+                    [ Some (IdentTrivia.OriginalNotation "*") ]
+                )
+            ),
+            a
+        )
+        |> applyTo b
+
     let rec stripOptionalParen (expr : SynExpr) : SynExpr =
         match expr with
         | SynExpr.Paren (expr, _, _, _) -> stripOptionalParen expr

WoofWare.Myriad.Plugins/SynExpr/SynType.fs

@@ -197,6 +197,17 @@ module internal SynTypePatterns =
             | _ -> None
         | _ -> None
 
+    let (|Measure|_|) (fieldType : SynType) : (Ident * string) option =
+        match fieldType with
+        | SynType.App (NumberType outer,
+                       _,
+                       [ SynType.LongIdent (SynLongIdent.SynLongIdent ([ ident ], _, _)) ],
+                       _,
+                       _,
+                       _,
+                       _) -> Some (ident, outer)
+        | _ -> None
+
     let (|DateOnly|_|) (fieldType : SynType) =
         match fieldType with
         | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) ->

WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj

@@ -46,6 +46,7 @@
     <Compile Include="SynExpr\SynAttribute.fs" />
     <Compile Include="SynExpr\SynModuleDecl.fs" />
     <Compile Include="SynExpr\SynModuleOrNamespace.fs" />
+    <Compile Include="Measure.fs" />
     <Compile Include="AstHelper.fs" />
     <Compile Include="RemoveOptionsGenerator.fs"/>
     <Compile Include="InterfaceMockGenerator.fs"/>