src/amount.ml

@@ -16,14 +16,12 @@ type t = {
   fraction: Int32.t;
 }
 
-let maximum_currency_length = 11
+let currency_length_limit = 12
-let value_upper_bound = Int64.of_float @@ Float.pow 2. 52.
+let value_limit = Int64.add 1_L (Int64.of_float (Float.pow 2. 52.))
-let fraction_max_number_of_digits = 8
+let fraction_nb_digits = 8
 
-(* TODO choose to either include or exclude upper limit for all bounds
+let fraction_limit =
-   need a -1 here *)
+  Int32.of_float (Float.pow 10. (Int.to_float fraction_nb_digits))
-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
@@ -34,20 +32,17 @@ let check_currency s =
   else
     let len = String.length s in
     if len = 0 then Error "currency is empty string"
-    else if len > maximum_currency_length then
+    else if len < currency_length_limit then Ok ()
-      Fmt.error "currency is more than %d characters long"
+    else
-        maximum_currency_length
+      Fmt.error "currency is more than %d characters long" currency_length_limit
-    else Ok ()
 
 let check_value v =
-  if Int64.unsigned_compare v value_upper_bound > 0 then
+  if Int64.unsigned_compare v value_limit < 0 then Ok ()
-    Error "value is greater than 2^52"
+  else Error "value is greater than 2^52"
-  else Ok ()
 
 let check_fraction v =
-  if Int32.unsigned_compare v fraction_upper_bound > 0 then
+  if Int32.unsigned_compare v fraction_limit < 0 then Ok ()
-    Fmt.error "fraction has more than %d digits" fraction_max_number_of_digits
+  else Fmt.error "fraction has more than %d digits" fraction_nb_digits
-  else Ok ()
 
 let make ~sign ~currency ~value ~fraction =
   let* () = check_currency currency in
@@ -56,18 +51,7 @@ let make ~sign ~currency ~value ~fraction =
   let currency = String.uppercase_ascii currency in
   Ok { sign; currency; value; fraction }
 
-(*
+module Parser = struct
-let config_currency =
-  match check_currency Config.currency with
-  | Error e -> Fmt.failwith "Invalid currency name configuration: %s@." e
-  | Ok () -> String.uppercase_ascii Config.currency
-
-let make_config_currency ~value ~fraction =
-  let* () = check_value value in
-  let* () = check_fraction fraction in
-  Ok { sign= None; currency= config_currency; value; fraction }
-  *)
-
   open Angstrom
 
   let letters = take_while1 is_letter
@@ -90,17 +74,15 @@ let value =
   let fraction =
     digits >>= fun s ->
     let len = String.length s in
-  match len <= fraction_max_number_of_digits with
+    match len <= fraction_nb_digits with
     | false ->
-      fail
+        fail (Fmt.str "fraction has more than %d digits" fraction_nb_digits)
-        (Fmt.str "fraction has more than %d digits"
-           fraction_max_number_of_digits)
     | true -> (
         match Int32.of_string_opt s with
         | None -> fail "not a valid int32"
         | Some n ->
             let magnitude =
-            let exp = Int.to_float (fraction_max_number_of_digits - len) in
+              let exp = Int.to_float (fraction_nb_digits - len) in
               Int32.of_float @@ Float.pow 10. exp
             in
             let n = Int32.mul n magnitude in
@@ -108,41 +90,60 @@ let fraction =
 
   let amount =
     lift4
-    (fun sign currency value fraction -> make ~sign ~currency ~value ~fraction)
+      (fun sign currency value fraction ->
+        make ~sign ~currency ~value ~fraction)
       sign letters
       (char ':' *> value)
       (option 0_l (char '.' *> fraction))
     <* end_of_input
 
-let of_string s = parse_string ~consume:Consume.All amount s |> Result.join
+  let parse s =
+    Angstrom.parse_string ~consume:Consume.All amount s |> Result.join
+end
 
+let of_string = Parser.parse
+
+(* TODO have pretty print without trailing zeros *)
 let pp =
   let open Fmt in
-  let pp_sign ppf = function
+  let pp_sign =
+    let pp ppf = function
       | Sign_plus -> char ppf '+'
       | Sign_minus -> char ppf '-'
     in
+    Fmt.option pp
+  in
+  let rec rm_trailing_zero count x =
+    if x <> 0_l && Int32.rem x 10_l = 0_l then
+      rm_trailing_zero (succ count) (Int32.div x 10_l)
+    else (count, x)
+  in
+  let pp_fraction ppf fraction =
+    match fraction = 0_l with
+    | true -> Fmt.nop ppf ()
+    | false ->
+        let count, x = rm_trailing_zero 0 fraction in
+        pf ppf ".%0*lu" (fraction_nb_digits - count) x
+  in
   fun ppf { sign; currency; value; fraction } ->
-    (* TODO
+    pf ppf "%a%s:%Lu%a" pp_sign sign currency value pp_fraction fraction
-       depends on the currency's number of fraction digits *)
-    pf ppf "%a%s:%Lu.%0*lu" (Fmt.option pp_sign) sign currency value
-      fraction_max_number_of_digits fraction
 
 let to_string = Fmt.str "%a" pp
 
 (* - *)
 
 let jsont = Jsont.of_of_string ~kind:"Amount" of_string ~enc:to_string
-let currency_length = 12
 
 let pad_currency_string s =
   let len = String.length s in
-  assert (len < currency_length);
+  match len < currency_length_limit with
-  let b = Bytes.make currency_length '\x00' in
+  | false -> Fmt.failwith "amount with invalid currency"
+  | true ->
+      let b = Bytes.make currency_length_limit '\x00' in
       Bytes.blit_string s 0 b 0 len;
-  Bytes.to_string b
+      Bytes.unsafe_to_string b
 
-(* binary decoding unused? *)
+(* binary decoding never unused *)
 let make_exn value fraction currency =
   match make ~sign:None ~currency ~value ~fraction with
   | Error _ -> Fmt.failwith "Amount of binary data failure"
@@ -152,6 +153,7 @@ let bin =
   let open Bin in
   record make_exn
   |+ field beint64 (fun t -> t.value)
-  |+ field beint32 (fun t -> Int32.mul t.fraction 1_000_000_l)
+  |+ field beint32 (fun t -> t.fraction)
-  |+ field (bytes currency_length) (fun t -> pad_currency_string t.currency)
+  |+ field (bytes currency_length_limit) (fun t ->
+      pad_currency_string t.currency)
   |> sealr

src/amount.mli

@@ -16,11 +16,6 @@ val make :
   fraction:Int32.t ->
   (t, string) result
 
-(* dependency cycle with config.ml ...
-val make_config_currency :
-  value:Int64.t -> fraction:Int32.t -> (t, string) result
-  *)
-
 val pp : Format.formatter -> t -> unit
 val to_string : t -> string
 val of_string : string -> (t, string) result