src/amount.ml

@@ -3,6 +3,8 @@
    and specialize amount.ml to Config.currency??
 
    have safe amount arithmetic *)
+open Syntax
+
 type sign =
   | Sign_plus
   | Sign_minus
@@ -23,6 +25,9 @@ let fraction_max_number_of_digits = 8
 let fraction_upper_bound =
   Int32.of_float @@ Float.pow 10. (Int.to_float fraction_max_number_of_digits)
 
+let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
+let is_digit = function '0' .. '9' -> true | _ -> false
+
 let check_currency s =
   if not @@ String.for_all is_letter s then
     Error "currency contains forbidden character"
@@ -37,20 +42,22 @@ let check_currency s =
 let check_value v =
   if Int64.unsigned_compare v value_upper_bound > 0 then
     Error "value is greater than 2^52"
-  else Ok v
+  else Ok ()
 
 let check_fraction v =
   if Int32.unsigned_compare v fraction_upper_bound > 0 then
     Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits
-  else Ok v
+  else Ok ()
 
 let make ~sign ~currency ~value ~fraction =
+  let* () = check_currency currency in
+  let* () = check_value value in
+  let* () = check_fraction fraction in
+  let currency = String.uppercase_ascii currency in
   Ok { sign; currency; value; fraction }
 
 open Angstrom
 
-let is_letter = function 'a' .. 'z' | 'A' .. 'Z' -> true | _ -> false
-let is_digit = function '0' .. '9' -> true | _ -> false
 let letters = take_while1 is_letter
 let digits = take_while1 is_digit
 
@@ -62,45 +69,37 @@ let sign =
       return None;
     ]
 
-let currency_of_string s =
-  if not @@ String.for_all is_letter s then
-    Error "currency contains forbidden character"
-  else if String.length s > maximum_currency_length then
-    Fmt.error "currency is more than %d characters long" maximum_currency_length
-  else Ok (String.uppercase_ascii s)
-
-let value_of_string s =
-  if not @@ String.for_all is_digit s then
-    Error "value contains forbidden character"
-  else
+let value =
+  digits >>= fun s ->
   match Int64.of_string_opt s with
-    | None -> Error "value is not a valid integer"
-    | Some v ->
-        if v > value_upper_bound then Error "value is greater than 2^52"
-        else if v < Int64.zero then Error "value is negative"
-        else Ok v
+  | None -> fail "not a valid int64"
+  | Some n -> return n
 
-let fraction_of_string s =
-  if not @@ String.for_all is_digit s then
-    Error "fraction contains forbidden character"
-  else if String.length s > fraction_max_number_of_digits then
-    Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits
-  else
+let fraction =
+  digits >>= fun s ->
+  let len = String.length s in
+  match len <= fraction_max_number_of_digits with
+  | false ->
+      fail
+        (Fmt.str "fraction has more than %d digits"
+           fraction_max_number_of_digits)
+  | true -> (
       match Int32.of_string_opt s with
-    | None -> Error "fraction is not a valid integer"
-    | Some v -> if v < Int32.zero then Error "fraction is negative" else Ok v
+      | None -> fail "not a valid int32"
+      | Some n ->
+          let magnitude =
+            let exp = Int.to_float (fraction_max_number_of_digits - len) in
+            Int32.of_float @@ Float.pow 10. exp
+          in
+          let n = Int32.mul n magnitude in
+          return n)
 
 let amount =
   lift4
-    (fun sign currency value fraction ->
-      let open Syntax in
-      let* currency = currency_of_string currency in
-      let* value = value_of_string value in
-      let* fraction = fraction_of_string fraction in
-      Ok { sign; currency; value; fraction })
+    (fun sign currency value fraction -> make ~sign ~currency ~value ~fraction)
     sign letters
-    (char ':' *> digits)
-    (option "" (char '.' *> digits))
+    (char ':' *> value)
+    (option 0_l (char '.' *> fraction))
   <* end_of_input
 
 let of_string s = parse_string ~consume:Consume.All amount s |> Result.join
@@ -125,8 +124,8 @@ let currency_length = 12
 
 let pad_currency_string s =
   let len = String.length s in
-  assert (len < currency_len);
-  let b = Bytes.make 12 '\x00' in
+  assert (len < currency_length);
+  let b = Bytes.make currency_length '\x00' in
   Bytes.blit_string s 0 b 0 len;
   Bytes.to_string b
 
@@ -141,5 +140,5 @@ let bin =
   record make_exn
   |+ field beint64 (fun t -> t.value)
   |+ field beint32 (fun t -> Int32.mul t.fraction 1_000_000_l)
-  |+ field (bytes currency_len) (fun t -> pad_currency_string t.currency)
+  |+ field (bytes currency_length) (fun t -> pad_currency_string t.currency)
   |> sealr