src/amount.ml

@@ -1,7 +1,8 @@
 (* TODO
      have safe amount arithmetic
      make type private
-     use config currency option *)
+     use config currency option:
+       -> functorize or dune virtual-module *)
 (* Amounts of currency, serialized as `<Currency>:<IntegerPart>.<FractionalPart>`
      Fixed-precision numbers with 8 decimal places.
      - <Currency> must be at most 11 characters long
@@ -15,17 +16,17 @@ type t = {
   sign: [ `Plus | `Minus ] option;
   currency: [ `Eur ];
   value: Int64.t;
-  fraction: Int64.t;
+  fraction: Int32.t;
 }
 
 let ( let* ) o f = match o with Ok v -> f v | Error _ as e -> e
 let check_not msg = function false -> Ok () | true -> Error msg
 let value_upper_bound = Z.(pow (of_int 2) 52) |> Z.to_int64
-let fraction_upper_bound = Int64.of_int 100_000_000
+let fraction_upper_bound = Int32.of_int 100_000_000
 
 let make ~sign ~currency ~value ~fraction =
   let* () = check_not "value is negative" (value < Int64.zero) in
-  let* () = check_not "fraction is negative" (fraction < Int64.zero) in
+  let* () = check_not "fraction is negative" (fraction < Int32.zero) in
   let* () =
     check_not "value is greater than 2^52" (value > value_upper_bound)
   in
@@ -44,7 +45,7 @@ let to_string =
     in
     let pp_currency ppf = function `Eur -> string ppf "EUR" in
     fun ppf { sign; currency; value; fraction } ->
-      pf ppf "%a%a:%Ld.%02Ld" (Fmt.option pp_sign) sign pp_currency currency
+      pf ppf "%a%a:%Ld.%02ld" (Fmt.option pp_sign) sign pp_currency currency
         value fraction
   in
   Fmt.str "%a" pp
@@ -59,19 +60,26 @@ let of_string =
       ]
   in
   let parse_currency = string "EUR" *> return `Eur in
-  let parse_int =
+  let parse_int64 =
     take_while1 (function '0' .. '9' -> true | _ -> false)
     >>| Int64.of_string_opt
     >>= function
     | None -> fail "invalid integer"
     | Some n -> return n
   in
+  let parse_int32 =
+    take_while1 (function '0' .. '9' -> true | _ -> false)
+    >>| Int32.of_string_opt
+    >>= function
+    | None -> fail "invalid integer"
+    | Some n -> return n
+  in
   let parse_t =
     lift4
       (fun sign currency value fraction ->
         make ~sign ~currency ~value ~fraction)
       parse_sign parse_currency
-      (char ':' *> parse_int)
+      (char ':' *> parse_int64)
-      (char '.' *> parse_int)
+      (char '.' *> parse_int32)
   in
   fun s -> parse_string ~consume:Consume.All parse_t s |> Result.join

src/pg.ml

@@ -14,11 +14,9 @@ end
 
 let pg_amount : Amount.t Caqti_type.t =
   let open Amount in
-  (* TODO bad int32 conversion *)
   Caqti_type.custom
-    ~encode:(fun amount -> Ok (amount.value, Int64.to_int32 amount.fraction))
+    ~encode:(fun amount -> Ok (amount.value, amount.fraction))
     ~decode:(fun (value, fraction) ->
-      let fraction = Int64.of_int32 fraction in
       Ok { sign= None; currency= `Eur; value; fraction })
     Caqti_type.(t2 int64 int32)
 

test/test.ml

@@ -34,7 +34,7 @@ let () =
       sign= Some `Plus;
       currency= `Eur;
       value= Int64.of_int 25;
-      fraction= Int64.of_int 678;
+      fraction= Int32.of_int 678;
     }
   in
   let s = to_string v in