4 people like it.

Generalized Units of Measure Revisited (using SRTPs)

An approach to using annotated types in F# using SRTPs.

"Core Definition"

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 

#nowarn "42"

open System

[<MeasureAnnotatedAbbreviation>] type bool<[<Measure>] 'm> = bool
[<MeasureAnnotatedAbbreviation>] type uint64<[<Measure>] 'm> = uint64
[<MeasureAnnotatedAbbreviation>] type Guid<[<Measure>] 'm> = Guid
[<MeasureAnnotatedAbbreviation>] type string<[<Measure>] 'm> = string
[<MeasureAnnotatedAbbreviation>] type TimeSpan<[<Measure>] 'm> = TimeSpan
[<MeasureAnnotatedAbbreviation>] type DateTime<[<Measure>] 'm> = DateTime
[<MeasureAnnotatedAbbreviation>] type DateTimeOffset<[<Measure>] 'm> = DateTimeOffset

type UnitOfMeasureTC =
    // Method signatures declare a type relationship between
    // units of measure of the same underlying type
    // NB underlying types in UoM arguments should always match
    static member IsUnitOfMeasure(_ : bool<'a>, _ : bool<'b>) = ()
    static member IsUnitOfMeasure(_ : int<'a>, _ : int<'b>) = ()
    static member IsUnitOfMeasure(_ : int64<'a>, _ : int64<'b>) = ()
    static member IsUnitOfMeasure(_ : uint64<'a>, _ : uint64<'b>) = ()
    static member IsUnitOfMeasure(_ : float<'a>, _ : float<'b>) = ()
    static member IsUnitOfMeasure(_ : decimal<'a>, _ : decimal<'b>) = ()
    static member IsUnitOfMeasure(_ : Guid<'a>, _ : Guid<'b>) = ()
    static member IsUnitOfMeasure(_ : string<'a>, _ : string<'b>) = ()
    static member IsUnitOfMeasure(_ : TimeSpan<'a>, _ : TimeSpan<'b>) = ()
    static member IsUnitOfMeasure(_ : DateTime<'a>, _ : DateTime<'b>) = ()
    static member IsUnitOfMeasure(_ : DateTimeOffset<'a>, _ : DateTimeOffset<'b>) = ()

[<RequireQualifiedAccess>]
module UnitOfMeasure =

    let inline private _cast< ^TC, ^a, ^b when (^TC or ^a or ^b) : (static member IsUnitOfMeasure : ^a * ^b -> unit)> (t : ^a) = (# "" t : ^b #)

    /// generic unit of measure cast function
    let inline cast (x : 'a) : 'b = _cast<UnitOfMeasureTC,'a,'b> x

"Examples"

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 

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

let x : string<m> = UnitOfMeasure.cast "string"
let y : string<n> = UnitOfMeasure.cast x
let z : string = UnitOfMeasure.cast y

[<MeasureAnnotatedAbbreviation>] type Foo<[<Measure>] 'm> = Foo
and Foo = Foo
with
    static member IsUnitOfMeasure(x : Foo<'m>, y : Foo<'n>) = ()

let foo : Foo<m> = UnitOfMeasure.cast Foo
namespace System
Multiple items
type MeasureAnnotatedAbbreviationAttribute =
  inherit Attribute
  new : unit -> MeasureAnnotatedAbbreviationAttribute

Full name: Microsoft.FSharp.Core.MeasureAnnotatedAbbreviationAttribute

--------------------
new : unit -> MeasureAnnotatedAbbreviationAttribute
Multiple items
type bool = Boolean

Full name: Microsoft.FSharp.Core.bool

--------------------
type bool<'m> = bool

Full name: Script.bool<_>
Multiple items
type MeasureAttribute =
  inherit Attribute
  new : unit -> MeasureAttribute

Full name: Microsoft.FSharp.Core.MeasureAttribute

--------------------
new : unit -> MeasureAttribute
Multiple items
val uint64 : value:'T -> uint64 (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.uint64

--------------------
type uint64 = UInt64

Full name: Microsoft.FSharp.Core.uint64

--------------------
type uint64<'m> = uint64

Full name: Script.uint64<_>
Multiple items
type Guid =
  struct
    new : b:byte[] -> Guid + 4 overloads
    member CompareTo : value:obj -> int + 1 overload
    member Equals : o:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member ToByteArray : unit -> byte[]
    member ToString : unit -> string + 2 overloads
    static val Empty : Guid
    static member NewGuid : unit -> Guid
    static member Parse : input:string -> Guid
    static member ParseExact : input:string * format:string -> Guid
    ...
  end

Full name: System.Guid

--------------------
type Guid<'m> = Guid

Full name: Script.Guid<_>

--------------------
Guid()
Guid(b: byte []) : unit
Guid(g: string) : unit
Guid(a: int, b: int16, c: int16, d: byte []) : unit
Guid(a: uint32, b: uint16, c: uint16, d: byte, e: byte, f: byte, g: byte, h: byte, i: byte, j: byte, k: byte) : unit
Guid(a: int, b: int16, c: int16, d: byte, e: byte, f: byte, g: byte, h: byte, i: byte, j: byte, k: byte) : unit
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string

--------------------
type string<'m> = string

Full name: Script.string<_>
Multiple items
type TimeSpan =
  struct
    new : ticks:int64 -> TimeSpan + 3 overloads
    member Add : ts:TimeSpan -> TimeSpan
    member CompareTo : value:obj -> int + 1 overload
    member Days : int
    member Duration : unit -> TimeSpan
    member Equals : value:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member Hours : int
    member Milliseconds : int
    member Minutes : int
    ...
  end

Full name: System.TimeSpan

--------------------
type TimeSpan<'m> = TimeSpan

Full name: Script.TimeSpan<_>

--------------------
TimeSpan()
TimeSpan(ticks: int64) : unit
TimeSpan(hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int, milliseconds: int) : unit
Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

Full name: System.DateTime

--------------------
type DateTime<'m> = DateTime

Full name: Script.DateTime<_>

--------------------
DateTime()
   (+0 other overloads)
DateTime(ticks: int64) : unit
   (+0 other overloads)
DateTime(ticks: int64, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: DateTimeKind) : unit
   (+0 other overloads)
Multiple items
type DateTimeOffset =
  struct
    new : dateTime:DateTime -> DateTimeOffset + 5 overloads
    member Add : timeSpan:TimeSpan -> DateTimeOffset
    member AddDays : days:float -> DateTimeOffset
    member AddHours : hours:float -> DateTimeOffset
    member AddMilliseconds : milliseconds:float -> DateTimeOffset
    member AddMinutes : minutes:float -> DateTimeOffset
    member AddMonths : months:int -> DateTimeOffset
    member AddSeconds : seconds:float -> DateTimeOffset
    member AddTicks : ticks:int64 -> DateTimeOffset
    member AddYears : years:int -> DateTimeOffset
    ...
  end

Full name: System.DateTimeOffset

--------------------
type DateTimeOffset<'m> = DateTimeOffset

Full name: Script.DateTimeOffset<_>

--------------------
DateTimeOffset()
DateTimeOffset(dateTime: DateTime) : unit
DateTimeOffset(ticks: int64, offset: TimeSpan) : unit
DateTimeOffset(dateTime: DateTime, offset: TimeSpan) : unit
DateTimeOffset(year: int, month: int, day: int, hour: int, minute: int, second: int, offset: TimeSpan) : unit
DateTimeOffset(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, offset: TimeSpan) : unit
DateTimeOffset(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, calendar: Globalization.Calendar, offset: TimeSpan) : unit
type UnitOfMeasureTC =
  static member IsUnitOfMeasure : bool<'a> * bool<'b> -> unit
  static member IsUnitOfMeasure : int<'a> * int<'b> -> unit
  static member IsUnitOfMeasure : int64<'a> * int64<'b> -> unit
  static member IsUnitOfMeasure : uint64<'a> * uint64<'b> -> unit
  static member IsUnitOfMeasure : float<'a> * float<'b> -> unit
  static member IsUnitOfMeasure : decimal<'a> * decimal<'b> -> unit
  static member IsUnitOfMeasure : Guid<'a> * Guid<'b> -> unit
  static member IsUnitOfMeasure : string<'a> * string<'b> -> unit
  static member IsUnitOfMeasure : TimeSpan<'a> * TimeSpan<'b> -> unit
  static member IsUnitOfMeasure : DateTime<'a> * DateTime<'b> -> unit
  ...

Full name: Script.UnitOfMeasureTC
static member UnitOfMeasureTC.IsUnitOfMeasure : bool<'a> * bool<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
static member UnitOfMeasureTC.IsUnitOfMeasure : int<'a> * int<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
static member UnitOfMeasureTC.IsUnitOfMeasure : int64<'a> * int64<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
Multiple items
val int64 : value:'T -> int64 (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int64

--------------------
type int64 = Int64

Full name: Microsoft.FSharp.Core.int64

--------------------
type int64<'Measure> = int64

Full name: Microsoft.FSharp.Core.int64<_>
static member UnitOfMeasureTC.IsUnitOfMeasure : uint64<'a> * uint64<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
static member UnitOfMeasureTC.IsUnitOfMeasure : float<'a> * float<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
static member UnitOfMeasureTC.IsUnitOfMeasure : decimal<'a> * decimal<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
Multiple items
val decimal : value:'T -> decimal (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.decimal

--------------------
type decimal = Decimal

Full name: Microsoft.FSharp.Core.decimal

--------------------
type decimal<'Measure> = decimal

Full name: Microsoft.FSharp.Core.decimal<_>
static member UnitOfMeasureTC.IsUnitOfMeasure : Guid<'a> * Guid<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
static member UnitOfMeasureTC.IsUnitOfMeasure : string<'a> * string<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
static member UnitOfMeasureTC.IsUnitOfMeasure : TimeSpan<'a> * TimeSpan<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
static member UnitOfMeasureTC.IsUnitOfMeasure : DateTime<'a> * DateTime<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
static member UnitOfMeasureTC.IsUnitOfMeasure : DateTimeOffset<'a> * DateTimeOffset<'b> -> unit

Full name: Script.UnitOfMeasureTC.IsUnitOfMeasure
Multiple items
type RequireQualifiedAccessAttribute =
  inherit Attribute
  new : unit -> RequireQualifiedAccessAttribute

Full name: Microsoft.FSharp.Core.RequireQualifiedAccessAttribute

--------------------
new : unit -> RequireQualifiedAccessAttribute
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
val t : 'a (requires member IsUnitOfMeasure)
val cast : x:'a -> 'b (requires member IsUnitOfMeasure)

Full name: Script.UnitOfMeasure.cast


 generic unit of measure cast function
val x : 'a (requires member IsUnitOfMeasure)
val private _cast : t:'a -> 'b (requires member IsUnitOfMeasure)

Full name: Script.UnitOfMeasure._cast
[<Measure>]
type m

Full name: Script.m
[<Measure>]
type n

Full name: Script.n
val x : string<m>

Full name: Script.x
module UnitOfMeasure

from Script
val y : string<n>

Full name: Script.y
val z : string

Full name: Script.z
Multiple items
union case Foo.Foo: Foo

--------------------
type Foo =
  | Foo
  static member IsUnitOfMeasure : x:Foo<'m> * y:Foo<'n> -> unit

Full name: Script.Foo

--------------------
type Foo<'m> = Foo

Full name: Script.Foo<_>
static member Foo.IsUnitOfMeasure : x:Foo<'m> * y:Foo<'n> -> unit

Full name: Script.Foo.IsUnitOfMeasure
val x : Foo<'m>
val y : Foo<'n>
val foo : Foo<m>

Full name: Script.foo
Raw view Test code New version

More information

Link:http://fssnip.net/7UG
Posted:6 years ago
Author:Eirik Tsarpalis
Tags: units of measure

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.