Is it possible to make codecs to automatically handle units of measure?

Here are two types (X and Y) with units of measure.

get_Codec shows how I’m trying to handle UOM now, and get_Codec2 shows what would I would like to be able to write, if there was a way to handle UOM automatically.

Obviously it’s not too bad for X, but it’s pretty ugly (and inefficient) for things like Y.

Is there a way the codecs could handle UOM on numerics (and preferably string too preferably, as used in FSharp.UMX) or is it possible to write a Codec that handles the units and defers to the Codecs for the primitives?

#r "nuget:Fleece"
#r "nuget:FSharp.UMX"

open Fleece
open FSharp.UMX
open FSharpPlus.Operators

type [<Measure>] m
type [<Measure>] n

type X = { A : float<m> } with
    static member get_Codec () =
        (fun a -> { A = %a })
        <!> jreq "a" ((fun x -> x.A) >> UMX.untag >> Some)
        |> ofObjCodec

    //static member get_Codec2 () =
    //    (fun a -> { A = a })
    //    <!> jreq "a" ((fun x -> x.A) >> Some)
    //    |> ofObjCodec

type Y = { B : Map<int<n>, float<m>> } with
    static member get_Codec () =
        (fun b -> { B = (b |> Map.toSeq |> Seq.map (fun (k,v) -> (UMX.tag k, UMX.tag v)) |> Map.ofSeq) })
        <!> jreq "b" (fun x -> x.B |> Map.toSeq |> Seq.map (fun (k,v) -> (UMX.untag k, UMX.untag v)) |> Map.ofSeq |> Some)
        |> ofObjCodec

    //static member get_Codec2 () =
    //    (fun b -> { B = b })
    //    <!> jreq "b" ((fun x -> x.B) >> Some)
    //    |> ofObjCodec

Any advice would be greatly appreciated.

[marklam]

The definitions here might be kludgy because I don’t fully understand how all the codecs fit together, but I can add

type Codecs =

    static member inline floatUOMCodec () : Codec<_, _, float<'x>, float<'x>> =
        let floatUOMDecoder = (Codec.decode Codecs.float) >> (Result.map UMX.tag<'x>)
        let floatUOMEncoder = (UMX.untag<'x> : float<'x> -> float) >> (Codec.encode Codecs.float)
        floatUOMDecoder <-> floatUOMEncoder

Which allows me to express the codec for the simple record X as

    static member get_CodecA () =
        (fun a -> { A = a })
        <!> jreqWith (Codecs.floatUOMCodec()) "a" ((fun x -> x.A) >> Some)
        |> ofObjCodec

But presumably that doesn’t make the codec for { B : Map<int<n>, float<m>> } any easier?

[wallymathieu]

Based on what you have done above, I’ve started to try to decompose what is needed in order to define the different parts

#r "nuget:Fleece"
#r "nuget:FSharp.UMX"

open Fleece
open FSharp.UMX
open FSharpPlus.Operators

type [<Measure>] m

type [<Measure>] n


// From: https://github.com/fsprojects/Fleece/issues/142#issuecomment-1685899408
let inline floatUOMCodec () : Codec<_, _, float<'x>, float<'x>> =
        let floatUOMDecoder = (Codec.decode Codecs.float) >> (Result.map UMX.tag<'x>)
        let floatUOMEncoder = (UMX.untag<'x> : float<'x> -> float) >> (Codec.encode Codecs.float)
        floatUOMDecoder <-> floatUOMEncoder

// step 1: define a codec based on existing codec by breaking out general mechanics
let inline wrapUnWrap<'a,'b,'Encoding when 'Encoding :> IEncoding and 'Encoding : (new : unit -> 'Encoding)> 
    (baseCodec: Codec<'Encoding,'a>) (wrap:'a->'b,unwrap:'b->'a) =
    let decoded = (Codec.decode baseCodec) >> (Result.map wrap)
    let encoder = (unwrap) >> (Codec.encode baseCodec)
    decoded <-> encoder
// note that we can define floatUOMCodec in terms of wrapUnWrap, float codec and tag and untag pair
let inline floatUOMCodec2 () : Codec<_, _, float<'x>, float<'x>> =
    wrapUnWrap<float,float<'x>,_> Codecs.float (UMX.tag<'x>, UMX.untag<'x>)

// step 2: note that wrap and unwrap pair looks like a codec
let inline floatMeasureCodec<[<Measure>]'x> () : Codec<float,float<'x>> = (UMX.tag<'x> >> result) <-> UMX.untag<'x>

let inline floatUOMCodec3 () : Codec<_, _, float<'x>, float<'x>> = Codec.compose Codecs.float (floatMeasureCodec<'x>())

// step 3: if we then inline the definition of float measure codec we get
let inline floatUOMCodec4 () : Codec<_, _, float<'x>, float<'x>> = 
    // We compose the codec Codec<IEncoding,float> with the codec Codec<float,float<'x>>
    Codec.compose Codecs.float ((UMX.tag<'x> >> result) <-> UMX.untag<'x>)

type X = { A : float<m> } with
    static member get_Codec () =
        (fun a -> { A = %a })
        <!> jreq "a" ((fun x -> x.A) >> UMX.untag >> Some)
        |> ofObjCodec

    static member get_Codec2 () =
        (fun a -> { A = a })
        <!> jreqWith (floatUOMCodec4()) "a" ((fun x -> x.A) >> Some)
        |> ofObjCodec

this implies that if you could have a composed map codec you could do the same type of process.