File: units.ml

package info (click to toggle)
misery 0.2-1.1
  • links: PTS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 380 kB
  • ctags: 298
  • sloc: ml: 1,295; xml: 180; makefile: 94
file content (105 lines) | stat: -rw-r--r-- 4,277 bytes parent folder | download | duplicates (2)
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
module UnitsMap = Map.Make (struct type t = string let compare = compare end)

let units_map = ref UnitsMap.empty
let default_unit = ref ""

let amount_regexp = Str.regexp "^\\(-\\)?\\([a-zA-Z]\\)?\\([0-9]+\\)\\.\\([0-9][0-9]\\)$"

let initialize () =
  Misc.verbose "Loading units configuration file.";
  let channel = Misc.open_config_file "units" in
  let rexp = Str.regexp
               "^\\([a-zA-Z]\\),\\([ a-zA-Z0-9]+\\),\\([0-9]+\\.[0-9]*\\)\\(,.\\)?$"
  in
  try
  begin
    default_unit := input_line channel;
    Misc.verbose ("The default units are: " ^ !default_unit);
    while true do
      let line = input_line channel in
        if Str.string_match rexp line 0 then
          let unit_char = Str.matched_group 1 line in
          let name = Str.matched_group 2 line in
          let factor = Str.matched_group 3 line in
          let factor2 =
            begin try
              let in_terms_of = String.sub (Str.matched_group 4 line) 1 1 in
              begin try
                fst (UnitsMap.find in_terms_of !units_map)
              with Not_found ->
                Misc.fail ("Unknown units `" ^ in_terms_of ^
                           "' used in line: " ^ line ^ " in units.csv")
              end
            with Not_found -> 1.0
            end
          in
          let final_factor = (float_of_string factor) *. factor2 in
          begin
            Misc.verbose ("Unit char `" ^ unit_char ^ "' is called `" ^
                          name ^ "' and is worth " ^
                          (string_of_float final_factor) ^
                          " of a default unit.");
            units_map := UnitsMap.add unit_char (final_factor, name) !units_map
          end
        else
          Misc.fail ("Malformed units definition: `" ^ line ^ "'\n" ^
	             "Check the config/units file.  The format of each " ^
		     "line is either:\nunit-char,name,factor\n\nor:\n" ^
		     "unit-char,name,factor,in-terms-of\n\nwhere:\n" ^
		     "  unit-char is a single character identifying the unit" ^
		     " being defined\n" ^
		     "  name is a textual name for the unit\n" ^
		     "  factor is a decimal number saying how many default\n" ^
		     "    units there are in the new unit being defined\n" ^
		     "  in-terms-of is a single unit character (say X) defined earlier\n" ^
		     "    in the file.  If this is specified, factor specifies\n" ^
		     "    how many X units there are in the new unit being defined.")
    done
  end
  with Sys_error s -> Misc.fail ("Error whilst reading units file: " ^ s)
     | End_of_file ->
         if !default_unit = "" then
           Misc.fail "End-of-file whilst reading default unit"
         else
           close_in channel

let convert amount context =
  if Str.string_match amount_regexp amount 0 then
    let negative =
    begin try
      let _ = Str.matched_group 1 amount
      in true
      with Not_found -> false
    end in
    let (factor, name), default =
    begin try
      let units_str = Str.matched_group 2 amount in
      begin try
        (UnitsMap.find units_str !units_map), false
        with Not_found ->
	  let names = UnitsMap.fold (fun chr -> fun (_, str) -> fun acc ->
	  			       acc ^ "\n  " ^ chr ^ " (" ^ str ^ ")")
				    !units_map ""
	  in
            Misc.fail ("Unknown units `" ^ units_str ^ "' used in `" ^
                       amount ^ "'\n" ^ context ^ ".\n\nKnown units are:" ^
		       names ^ "\n\nIf you want to use `" ^
		       units_str ^ "' units, edit the " ^
  		       "config/units file.")
      end
      with Not_found -> (1.0, ""), true
    end in
    let sum_1 = int_of_string (Str.matched_group 3 amount) in
    let sum_2 = int_of_string (Str.matched_group 4 amount) in
    let sum = (sum_1*100 + sum_2) * (if negative then -1 else 1) in
    let str = (Misc.format_money sum) ^ " " ^ name in
      if factor = 1.0 then
        Sumofmoney.create sum (if default then "" else str)
      else
        let amount = truncate (factor *. (float sum)) in
          Sumofmoney.create amount (if default then "" else str)
  else
    Misc.fail ("Malformed sum of money `" ^ amount ^ "'\n" ^ context ^ ".\n" ^
               "Examples of well-formed sums of money:\n  " ^
	       "3.40  E2.34  -E34.63  (where E is a unit character).")