Skip to content

Commit 1b2fa87

Browse files
alfonsogarciacaroalfonsogarciacaro
authored
Merge pull request #2 from eiriktsarpalis/new-impl
Replace implementation, add examples
2 parents ed93ba3 + fb0f92b commit 1b2fa87

2 files changed

Lines changed: 84 additions & 43 deletions

File tree

‎README.md‎

Lines changed: 30 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -15,21 +15,36 @@ Run `npm i && npm run build publish`.
1515
```fsharp
1616
open UnitsOfMeasure.Extra
1717
18-
[<Measure>] type dir
19-
[<Measure>] type file
20-
21-
let inline mkDir x: string<dir> = %% x
22-
let inline mkFile x: string<file> = %% x
23-
24-
let test (dirPath: string<dir>) (fileName: string<file>): unit =
25-
printfn "FULL PATH: %s/%s" %%dirPath %%fileName
26-
27-
let myDir = mkDir "/my/path"
28-
let myFile = mkFile "file.txt"
29-
// let myDir = mkDir 5 // This doesn't compile
30-
31-
test myDir myFile
32-
// test myFile myDir // This doesn't compile
18+
[<Measure>] type customerId
19+
[<Measure>] type orderId
20+
[<Measure>] type kg
21+
22+
type Order =
23+
{
24+
id : string<orderId>
25+
customer : string<customerId>
26+
quantity : int<kg>
27+
}
28+
29+
let order =
30+
{
31+
id = % "orderId"
32+
customer = % "customerId"
33+
quantity = % 42
34+
}
35+
36+
let printOrder (order : Order) =
37+
printfn "orderId=%s customerId=%s quantity=%d" %order.id %order.customer %order.quantity
38+
39+
let lookupById (orders : Order list) (id : string<orderId>) = orders |> List.tryFind (fun o -> o.id = id)
40+
41+
lookupById [] order.id // compiles
42+
lookupById [] order.customer // compiler error
43+
// stdin(94,15): error FS0001: Type mismatch. Expecting a
44+
// 'string<orderId>'
45+
// but given a
46+
// 'string<customerId>'
47+
// The unit of measure 'orderId' does not match the unit of measure 'customerId'
3348
```
3449

3550
[Example in Fable REPL](https://fable.io/repl/#?code=PTAEFUDsEsBcGdQHsBmoCyBTAhvArgE6agpIGiRKQC0keAtpgdAMaiwCeADpogEYdQAUWjMA1qAAq8bAS7YANtHgAoEKADKmYgAtYsLvABcIWAHc4sJgDoWSesABi2PgswBhe12huCweLDYsHjwwACMAAwA7ABMAByRAGxhAJwxUQkRMQCs8SoqSDyQmhwBmPT5ANoAPFi4hJgAgpCUgVYAJo18fEQAbtBB0FQAfAC67NzEfEhICtU1dfhEY6AA5PTDoAC8oNOzKgs4S00tSG2Ynd19A7BDkCucPKB40JCwiQAs87VHDSvrmx2LzenwOP3qRGarSCFy6PUw-UGI3Gj2IAHEXu1vos-uMAdtQBjoO0wTjIadzpd4YjbsiJk8AsxIABzbG-ZZ4jYExmvZmk9knaEdOHXJH3FGTKTQRgaeSQNkQzD-Lk7STSzCy7CQfmKqFnGFU0W08X04gAERhasYCuOysBoAtVitmB1xz1lJFCJudweksdmGdAHkUCh4JhYDbcWsVQ7Lerg6Hw-lURAYLBg2SA+5tipQHnQOosLAdEh2qB4NBmZAgg1EO1MCwFLJiNhTaAiE3jfAdNAuLtw2ZtNr8wWwHg04hUKBGIrkGhi8QZIxnpB6wQFBxeabc-n1AA5ABCK7XG63qMQrwgSHQoFkzIYmDeiG7SDwCjLijM2FK06CLB0O55gEgxsIw9B8EwoAAJLwFAcAZgKAAUAD6oBGLsMxzKs2DDAANKAqHoXsWF8MMACUBKIWRgHlm0rDTuUEHkDBcHpigmYoWhoCvBG2F4QRXE8dUqykRROxUTRwG3KBjGQSxaYIYqnHoTxnzCTh+GEdxIJfCJ5GUdRI5SfRYFMdBsEKexSFacC7y6RpAnobZal6WJoASUZdEyeBckWfBVlKVpKAKEgQTqfxQUhWFrkGZJXkMT5zF+WxHFafWLDSoo4WaVx6WZSR+niYZ+bGd5Znyf5qVcUSWJ8Tl6E1cJomxZ5IEJeVyWKccym0UyrJ1Y5vW8k1hXucVQHxaZvmsV1DQ9c6mrygNWkLXKI1uR5JWTbJSUzQF3Vaf6zrZYNR3qutLVbW1U27ZZVXoWdjAJmGvEOYdcZPSGL0XUV+QAMSUF+BDFAARB8MQg1U1QAEqYAAji8RAAIp4Io0AoNAsIsCwvDwGMKj0KWb7EHtmY5jRbiwNpSiQMQXDML0MIESwuARqAAB6kjuPh7PYDzfCgGYOiPu5nPZmQHOthL7N8BR6GIaV7XTXdApcbzoAAFQcwL1CbOOcBkZsiFU+hvNiTRf3o6AACEjiNAeAAyQjIe4gboAAClBTvQyONF5ohf2gCDIPsGrAt-eNoB-ZgChhn7K7TAAHtU2ugJssAW4+7To-kI4gGAzKPkw9H61TU4zscoAswEJDjiwxoU+G1OvMQ1dU4hidq9gcupzsyFt9UpMClzuG86PpGgIn+SE+0xNSLwVNbLnoCHIqvpPNnBA7qvtoSk8GNuMvlPN7T05iGaoiT+hPIstUm-2kPiq2Kzk87sfrw08Q9BiI4PjEIn19YB9WqAfJUBJH7HGfjXKeb8m5WBrohTe7sgg6EAcA++FFEKgL3NgRgaDhqgPIk5NMOYRz0x4igUGjhwAOwdqAd2jRJAAAl0IAFJAzAHYSHJBKCSB-xwYwI+Td6AcAvuQHY38xFB2ACI4A8hiyQzzMfERv83AEm-qo4gINQHWFgInWAijRygGUaIy+Ejz6X2yEYyQPY6xIF4JAVYVM7D0G8IfHc8CqYiKkSov+O51CeOnBwTRQSpHqBscoUA7R7HwEcc4rwfiVBAA&html=DwQgJg9gxgLgngBwKYAIAWMC2AbAfAKGAxwOAHpi98g&css=Q)

‎src/UnitsOfMeasure.Extra.fs‎

Lines changed: 54 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,10 @@
11
namespace UnitsOfMeasure.Extra
22

3+
// Units of Measure extensions
4+
// Provides a mechanism for extending units of measure to non-numeric primitives
5+
6+
#nowarn "42"
7+
38
open System
49

510
[<MeasureAnnotatedAbbreviation>] type bool<[<Measure>] 'm> = bool
@@ -10,38 +15,59 @@ open System
1015
[<MeasureAnnotatedAbbreviation>] type DateTime<[<Measure>] 'm> = DateTime
1116
[<MeasureAnnotatedAbbreviation>] type DateTimeOffset<[<Measure>] 'm> = DateTimeOffset
1217

13-
type UnitOfMeasureTC =
14-
// Method signatures declare a type relationship between
15-
// units of measure of the same underlying type
16-
// NB underlying types in UoM arguments should always match
17-
static member IsUnitOfMeasure(_ : bool<'a>, _ : bool<'b>) = ()
18-
static member IsUnitOfMeasure(_ : int<'a>, _ : int<'b>) = ()
19-
static member IsUnitOfMeasure(_ : int64<'a>, _ : int64<'b>) = ()
20-
static member IsUnitOfMeasure(_ : uint64<'a>, _ : uint64<'b>) = ()
21-
static member IsUnitOfMeasure(_ : float<'a>, _ : float<'b>) = ()
22-
static member IsUnitOfMeasure(_ : decimal<'a>, _ : decimal<'b>) = ()
23-
static member IsUnitOfMeasure(_ : Guid<'a>, _ : Guid<'b>) = ()
24-
static member IsUnitOfMeasure(_ : string<'a>, _ : string<'b>) = ()
25-
static member IsUnitOfMeasure(_ : TimeSpan<'a>, _ : TimeSpan<'b>) = ()
26-
static member IsUnitOfMeasure(_ : DateTime<'a>, _ : DateTime<'b>) = ()
27-
static member IsUnitOfMeasure(_ : DateTimeOffset<'a>, _ : DateTimeOffset<'b>) = ()
18+
module private Unsafe =
19+
let inline cast<'a, 'b> (a : 'a) : 'b =
20+
#if !FABLE_COMPILER
21+
(# "" a : 'b #)
22+
#else
23+
unbox<'a, 'b> a
24+
#endif
2825

29-
#nowarn "42"
26+
type UoM =
3027

31-
[<RequireQualifiedAccess>]
32-
module UoC =
33-
let inline private _cast< ^TC, ^a, ^b when (^TC or ^a or ^b) : (static member IsUnitOfMeasure : ^a * ^b -> unit)> (t : ^a) =
34-
#if !FABLE_COMPILER
35-
(# "" t : ^b #)
36-
#else
37-
unbox< ^b > t
38-
#endif
28+
static member inline tag<[<Measure>]'m> (x : bool) : bool<'m> = Unsafe.cast x
29+
static member inline tag<[<Measure>]'m> (x : int) : int<'m> = Unsafe.cast x
30+
static member inline tag<[<Measure>]'m> (x : int64) : int64<'m> = Unsafe.cast x
31+
static member inline tag<[<Measure>]'m> (x : uint64) : uint64<'m> = Unsafe.cast x
32+
static member inline tag<[<Measure>]'m> (x : float) : float<'m> = Unsafe.cast x
33+
static member inline tag<[<Measure>]'m> (x : decimal) : decimal<'m> = Unsafe.cast x
34+
static member inline tag<[<Measure>]'m> (x : Guid) : Guid<'m> = Unsafe.cast x
35+
static member inline tag<[<Measure>]'m> (x : string) : string<'m> = Unsafe.cast x
36+
static member inline tag<[<Measure>]'m> (x : TimeSpan) : TimeSpan<'m> = Unsafe.cast x
37+
static member inline tag<[<Measure>]'m> (x : DateTime) : DateTime<'m> = Unsafe.cast x
38+
static member inline tag<[<Measure>]'m> (x : DateTimeOffset) : DateTimeOffset<'m> = Unsafe.cast x
39+
40+
static member inline untag<[<Measure>]'m> (x : bool<'m>) : bool = Unsafe.cast x
41+
static member inline untag<[<Measure>]'m> (x : int<'m>) : int = Unsafe.cast x
42+
static member inline untag<[<Measure>]'m> (x : int64<'m>) : int64 = Unsafe.cast x
43+
static member inline untag<[<Measure>]'m> (x : uint64<'m>) : uint64 = Unsafe.cast x
44+
static member inline untag<[<Measure>]'m> (x : float<'m>) : float = Unsafe.cast x
45+
static member inline untag<[<Measure>]'m> (x : decimal<'m>) : decimal = Unsafe.cast x
46+
static member inline untag<[<Measure>]'m> (x : Guid<'m>) : Guid = Unsafe.cast x
47+
static member inline untag<[<Measure>]'m> (x : string<'m>) : string = Unsafe.cast x
48+
static member inline untag<[<Measure>]'m> (x : TimeSpan<'m>) : TimeSpan = Unsafe.cast x
49+
static member inline untag<[<Measure>]'m> (x : DateTime<'m>) : DateTime = Unsafe.cast x
50+
static member inline untag<[<Measure>]'m> (x : DateTimeOffset<'m>) : DateTimeOffset = Unsafe.cast x
51+
52+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : bool<'m1>) : bool<'m2> = Unsafe.cast x
53+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : int<'m1>) : int<'m2> = Unsafe.cast x
54+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : int64<'m1>) : int64<'m2> = Unsafe.cast x
55+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : uint64<'m1>) : uint64<'m2> = Unsafe.cast x
56+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : float<'m1>) : float<'m2> = Unsafe.cast x
57+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : decimal<'m1>) : decimal<'m2> = Unsafe.cast x
58+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : Guid<'m1>) : Guid<'m2> = Unsafe.cast x
59+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : string<'m1>) : string<'m2> = Unsafe.cast x
60+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : TimeSpan<'m1>) : TimeSpan<'m2> = Unsafe.cast x
61+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : DateTime<'m1>) : DateTime<'m2> = Unsafe.cast x
62+
static member inline cast<[<Measure>]'m1, [<Measure>]'m2> (x : DateTimeOffset<'m1>) : DateTimeOffset<'m2> = Unsafe.cast x
3963

40-
/// Generic unit of measure cast function
41-
let inline cast (x : ^a) : ^b = _cast<UnitOfMeasureTC,^a,^b> x
4264

4365
[<AutoOpen>]
4466
module Operators =
4567

46-
/// Generic unit of measure cast operator
47-
let inline (~%%) x = UoC.cast x
68+
let inline private _cast< ^TC, ^xm, ^xn when (^TC or ^xm or ^xn) : (static member cast : ^xm -> ^xn)> (x : ^xm) =
69+
((^TC or ^xm or ^xn) : (static member cast : ^xm -> ^xn) x)
70+
71+
// NB the particular infix operator shadows the rarely used quotation splicing operator
72+
/// Infix operator used for tagging, untagging, or casting units of measure
73+
let inline (~%) (x : ^xm) : ^xn = _cast<UoM, ^xm, ^xn> x

0 commit comments

Comments
 (0)