aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/world/finance/money.lux
blob: cd072445961e7b9d90193ba51a2a348ab0085789 (plain)
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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
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]
  )