1 files changed, 151 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/world/finance/money.lux b/stdlib/source/library/lux/world/finance/money.lux
new file mode 100644
index 000000000..cd0724459
--- /dev/null
+++ b/stdlib/source/library/lux/world/finance/money.lux
@@ -0,0 +1,151 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [equivalence (.only Equivalence)]
+    ["[0]" order (.only Order)]]
+   [data
+    ["[0]" product]
+    ["[0]" text (.only)
+     ["%" \\format]]]
+   [math
+    [number
+     ["n" nat]]]
+   [meta
+    ["[0]" static]
+    [type
+     ["[0]" nominal]]]]]
+ [/
+  ["/" currency]])
+
+(nominal.def .public (Money currency)
+  (Record
+   [#currency (/.Currency currency)
+    #amount Nat])
+
+  (def .public (money currency amount)
+    (All (_ currency)
+      (-> (/.Currency currency) Nat
+          (Money currency)))
+    (nominal.abstraction
+     [#currency currency
+      #amount amount]))
+
+  (def .public (of_units currency it)
+    (All (_ currency)
+      (-> (/.Currency currency) Nat
+          (Money currency)))
+    (money currency
+           (n.* (/.sub_divisions currency)
+                it)))
+
+  (def .public of_sub_units money)
+
+  (with_template [<name> <slot> <type>]
+    [(def .public <name>
+       (All (_ currency)
+         (-> (Money currency)
+             <type>))
+       (|>> nominal.representation
+            (the <slot>)))]
+
+    [currency #currency (/.Currency currency)]
+    [amount #amount Nat]
+    )
+
+  (def .public order
+    (All (_ currency)
+      (Order (Money currency)))
+    (of order.functor each
+        ..amount
+        n.order))
+
+  (def .public <
+    (All (_ currency)
+      (-> (Money currency) (Money currency)
+          Bit))
+    (of ..order <))
+
+  (with_template [<name> <order>]
+    [(def .public <name>
+       (All (_ currency)
+         (-> (Money currency) (Money currency)
+             Bit))
+       (<order> order))]
+
+    [<= order.<=]
+    [> order.>]
+    [>= order.>=]
+    )
+
+  (def .public equivalence
+    (All (_ currency)
+      (Equivalence (Money currency)))
+    (of ..order equivalence))
+
+  (def .public =
+    (All (_ currency)
+      (-> (Money currency) (Money currency)
+          Bit))
+    (of ..equivalence =))
+
+  (def .public (+ parameter subject)
+    (All (_ currency)
+      (-> (Money currency) (Money currency)
+          (Money currency)))
+    (|> subject
+        nominal.representation
+        (revised #amount (n.+ (|> parameter nominal.representation (the #amount))))
+        nominal.abstraction))
+
+  (def .public (- parameter subject)
+    (All (_ currency)
+      (-> (Money currency) (Money currency)
+          (Maybe (Money currency))))
+    (let [parameter (nominal.representation parameter)
+          subject (nominal.representation subject)]
+      (if (n.< (the #amount parameter)
+               (the #amount subject))
+        {.#None}
+        {.#Some (nominal.abstraction
+                 [#currency (the #currency subject)
+                  #amount (n.- (the #amount parameter)
+                               (the #amount subject))])})))
+
+  (def .public (format it)
+    (All (_ currency)
+      (%.Format (Money currency)))
+    (let [[currency amount] (nominal.representation it)
+          [macro micro] (n./% (/.sub_divisions currency) amount)]
+      (%.format (%.nat macro)
+                (when micro
+                  0 ""
+                  _ (%.format "." (%.nat micro)))
+                " " (/.alphabetic_code currency))))
+  )
+
+(with_template [<order> <name>]
+  [(def .public (<name> left right)
+     (All (_ currency)
+       (-> (Money currency) (Money currency)
+           (Money currency)))
+     (if (<order> (..amount left)
+                  (..amount right))
+       right
+       left))]
+
+  [n.< min]
+  [n.> max]
+  )
+
+(with_template [<*> <name>]
+  [(def .public (<name> it)
+     (All (_ currency)
+       (-> (Money currency)
+           Nat))
+     (<*> (/.sub_divisions (..currency it))
+          (..amount it)))]
+
+  [n./ units]
+  [n.% sub_units]
+  )