├── tests ├── .gitignore ├── src │ ├── cashe_money_tests.ads │ ├── cashe_currency_tests.ads │ ├── cashe_exchange_tests.ads │ ├── tests.adb │ ├── cashe_currency_tests.adb │ ├── cashe_exchange_tests.adb │ └── cashe_money_tests.adb ├── alire.toml └── tests.gpr ├── docs ├── cashe-exchange_ads.html ├── robodoc.js ├── sources.html ├── robo_records.html ├── robo_constants.html ├── robo_exceptions.html ├── robo_classes.html ├── robo_packages.html ├── robo_types.html ├── robo_subprograms.html ├── robo_Methods.html ├── robodoc.css ├── toc_index.html ├── index.html └── cashe_ads.html ├── .gitignore ├── alire.toml ├── cashe.gpr ├── LICENSE ├── src ├── cashe-currency_handling.adb ├── cashe.ads ├── cashe-currency_handling.ads ├── cashe.adb ├── cashe-money_handling.adb ├── cashe-exchange.adb └── cashe-exchange.ads └── readme.md /tests/.gitignore: -------------------------------------------------------------------------------- 1 | /obj/ 2 | /bin/ 3 | /alire/ 4 | /config/ 5 | -------------------------------------------------------------------------------- /docs/cashe-exchange_ads.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AJ-Ianozi/Cashe/HEAD/docs/cashe-exchange_ads.html -------------------------------------------------------------------------------- /tests/src/cashe_money_tests.ads: -------------------------------------------------------------------------------- 1 | package Cashe_Money_Tests is 2 | procedure Run_Tests; 3 | end Cashe_Money_Tests; -------------------------------------------------------------------------------- /tests/src/cashe_currency_tests.ads: -------------------------------------------------------------------------------- 1 | package Cashe_Currency_Tests is 2 | procedure Run_Tests; 3 | end Cashe_Currency_Tests; -------------------------------------------------------------------------------- /tests/src/cashe_exchange_tests.ads: -------------------------------------------------------------------------------- 1 | package Cashe_Exchange_Tests is 2 | procedure Run_Tests; 3 | end Cashe_Exchange_Tests; -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /obj/ 2 | /lib/ 3 | /alire/ 4 | /config/ 5 | .DS_Store 6 | Thumbs.db 7 | *~ 8 | .fuse_hidden* 9 | .directory 10 | .Trash-* 11 | .nfs* 12 | *.cab 13 | *.msi 14 | *.msix 15 | *.msm 16 | *.msp -------------------------------------------------------------------------------- /tests/src/tests.adb: -------------------------------------------------------------------------------- 1 | with Cashe_Currency_Tests; 2 | with Cashe_Money_Tests; 3 | with Cashe_Exchange_Tests; 4 | procedure Tests is 5 | begin 6 | Cashe_Currency_Tests.Run_Tests; 7 | Cashe_Money_Tests.Run_Tests; 8 | Cashe_Exchange_Tests.Run_Tests; 9 | end Tests; -------------------------------------------------------------------------------- /docs/robodoc.js: -------------------------------------------------------------------------------- 1 | /****h* ROBODoc/ROBODoc Javascript support 2 | * FUNCTION 3 | * This is the default Javascript library for documentation 4 | * generated with ROBODoc. 5 | * You can edit this file to your own liking and then use 6 | * it with the option 7 | * --js 8 | ****** 9 | * $Id: html_generator.c,v 1.95 2019/01/04 23:58:00 cashy Exp $ 10 | */ 11 | -------------------------------------------------------------------------------- /tests/alire.toml: -------------------------------------------------------------------------------- 1 | name = "tests" 2 | description = "Shiny new project" 3 | version = "0.1.0-dev" 4 | 5 | authors = ["AJ Ianozi"] 6 | maintainers = ["AJ Ianozi "] 7 | maintainers-logins = ["AJ-Ianozi"] 8 | 9 | executables = ["tests"] 10 | 11 | [[depends-on]] 12 | cashe = "*" 13 | 14 | [[pins]] 15 | cashe = { path = "../" } 16 | 17 | [[depends-on]] 18 | iso = "^2.0.0" 19 | gnat = ">=12 & <2000" 20 | -------------------------------------------------------------------------------- /alire.toml: -------------------------------------------------------------------------------- 1 | name = "cashe" 2 | description = "A fixed-point decimal money library written in Ada." 3 | version = "1.0.0" 4 | licenses = "MIT" 5 | 6 | website = "https://github.com/AJ-Ianozi/Cashe/" 7 | tags = [ "currency", "money", "decimal", "finance" ] 8 | 9 | authors = ["AJ Ianozi"] 10 | maintainers = ["AJ Ianozi "] 11 | maintainers-logins = ["AJ-Ianozi"] 12 | 13 | [[depends-on]] 14 | iso = "^2.0.0" 15 | gnat = ">=12 & <2000" 16 | -------------------------------------------------------------------------------- /tests/tests.gpr: -------------------------------------------------------------------------------- 1 | with "config/tests_config.gpr"; 2 | project Tests is 3 | 4 | for Source_Dirs use ("src/", "config/"); 5 | for Object_Dir use "obj/" & Tests_Config.Build_Profile; 6 | for Create_Missing_Dirs use "True"; 7 | for Exec_Dir use "bin"; 8 | for Main use ("tests.adb"); 9 | 10 | package Compiler is 11 | for Default_Switches ("Ada") use Tests_Config.Ada_Compiler_Switches; 12 | end Compiler; 13 | 14 | package Binder is 15 | for Switches ("Ada") use ("-Es"); -- Symbolic traceback 16 | end Binder; 17 | 18 | package Install is 19 | for Artifacts (".") use ("share"); 20 | end Install; 21 | 22 | end Tests; 23 | -------------------------------------------------------------------------------- /cashe.gpr: -------------------------------------------------------------------------------- 1 | with "config/cashe_config.gpr"; 2 | project Cashe is 3 | 4 | for Library_Name use "Cashe"; 5 | for Library_Version use Project'Library_Name & ".so." & Cashe_Config.Crate_Version; 6 | 7 | for Source_Dirs use ("src/", "config/"); 8 | for Object_Dir use "obj/" & Cashe_Config.Build_Profile; 9 | for Create_Missing_Dirs use "True"; 10 | for Library_Dir use "lib"; 11 | 12 | type Library_Type_Type is ("relocatable", "static", "static-pic"); 13 | Library_Type : Library_Type_Type := 14 | external ("CASHE_LIBRARY_TYPE", external ("LIBRARY_TYPE", "static")); 15 | for Library_Kind use Library_Type; 16 | 17 | package Compiler is 18 | for Default_Switches ("Ada") use Cashe_Config.Ada_Compiler_Switches; 19 | end Compiler; 20 | 21 | package Binder is 22 | for Switches ("Ada") use ("-Es"); -- Symbolic traceback 23 | end Binder; 24 | 25 | package Install is 26 | for Artifacts (".") use ("share"); 27 | end Install; 28 | 29 | end Cashe; 30 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 AJ Ianozi 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /tests/src/cashe_currency_tests.adb: -------------------------------------------------------------------------------- 1 | with Ada.Assertions; use Ada.Assertions; 2 | with Cashe; use Cashe; 3 | with Cashe.Currency_Handling; use Cashe.Currency_Handling; 4 | package body Cashe_Currency_Tests is 5 | 6 | procedure Run_Tests is 7 | 8 | -- Create some currency for simple testing. 9 | King_Currency : constant Custom_Currency := 10 | Create (Code => "AJ", Minor_Unit => 2, 11 | Name => "AJ Currency", Symbol => "👑"); 12 | Bitcoin : constant Custom_Currency := 13 | Create (Code => "BTC", Minor_Unit => 8, 14 | Name => "Bitcoin", Symbol => "฿"); 15 | Ethereum : constant Custom_Currency := 16 | Create (Code => "ETH", Minor_Unit => 18, 17 | Name => "Ether", Symbol => "Ξ"); 18 | Cardano : constant Custom_Currency := 19 | Create (Code => "ADA", Minor_Unit => 15, 20 | Name => "Cardano", Symbol => "₳"); 21 | RadCur : constant Custom_Currency := 22 | Create (Code => "RAD", Minor_Unit => 0, 23 | Name => "Rad Currency", Symbol => "☢"); 24 | 25 | begin 26 | -- Create a currency of every precision. 27 | for I in 0 .. Cashe.Max_Precision loop 28 | declare 29 | One : constant Custom_Currency := 30 | Create (I'Wide_Wide_Image, I, 31 | "Currency " & I'Wide_Wide_Image, I'Wide_Wide_Image); 32 | Two : Custom_Currency; 33 | begin 34 | Two.Set_Code (One.Code); 35 | Two.Set_Name (One.Name); 36 | Two.Set_Symbol (One.Symbol); 37 | Two.Set_Unit (One.Unit); 38 | Assert (Two.Code = I'Wide_Wide_Image); 39 | Assert (Two.Name = "Currency " & I'Wide_Wide_Image); 40 | Assert (Two.Symbol = I'Wide_Wide_Image); 41 | Assert (Two.Unit = I); 42 | end; 43 | end loop; 44 | 45 | end Run_Tests; 46 | end Cashe_Currency_Tests; -------------------------------------------------------------------------------- /src/cashe-currency_handling.adb: -------------------------------------------------------------------------------- 1 | package body Cashe.Currency_Handling is 2 | procedure Set_Code (This : in out Custom_Currency; Item : Wide_Wide_String) 3 | is 4 | use Ada.Strings.Wide_Wide_Unbounded; 5 | begin 6 | This.Custom_Code := To_Unbounded_Wide_Wide_String (Item); 7 | end Set_Code; 8 | procedure Set_Name (This : in out Custom_Currency; Item : Wide_Wide_String) 9 | is 10 | use Ada.Strings.Wide_Wide_Unbounded; 11 | begin 12 | This.Custom_Name := To_Unbounded_Wide_Wide_String (Item); 13 | end Set_Name; 14 | procedure Set_Symbol 15 | (This : in out Custom_Currency; Item : Wide_Wide_String) 16 | is 17 | use Ada.Strings.Wide_Wide_Unbounded; 18 | begin 19 | This.Custom_Symbol := To_Unbounded_Wide_Wide_String (Item); 20 | end Set_Symbol; 21 | procedure Set_Unit (This : in out Custom_Currency; Item : Natural) is 22 | begin 23 | This.Custom_Minor_Unit := Item; 24 | end Set_Unit; 25 | function Code (This : Custom_Currency) return Wide_Wide_String is 26 | use Ada.Strings.Wide_Wide_Unbounded; 27 | begin 28 | return To_Wide_Wide_String (This.Custom_Code); 29 | end Code; 30 | function Name (This : Custom_Currency) return Wide_Wide_String is 31 | use Ada.Strings.Wide_Wide_Unbounded; 32 | begin 33 | return To_Wide_Wide_String (This.Custom_Name); 34 | end Name; 35 | function Symbol (This : Custom_Currency) return Wide_Wide_String is 36 | use Ada.Strings.Wide_Wide_Unbounded; 37 | begin 38 | return To_Wide_Wide_String (This.Custom_Symbol); 39 | end Symbol; 40 | function Unit (This : Custom_Currency) return Natural is 41 | (This.Custom_Minor_Unit); 42 | 43 | function Create 44 | (Code : Wide_Wide_String; 45 | Minor_Unit : Natural := 0; 46 | Name : Wide_Wide_String := ""; 47 | Symbol : Wide_Wide_String := "") 48 | return Custom_Currency is 49 | use Ada.Strings.Wide_Wide_Unbounded; 50 | begin 51 | return (Custom_Code => To_Unbounded_Wide_Wide_String (Code), 52 | Custom_Symbol => To_Unbounded_Wide_Wide_String (Symbol), 53 | Custom_Name => To_Unbounded_Wide_Wide_String (Name), 54 | Custom_Minor_Unit => Minor_Unit); 55 | end Create; 56 | 57 | end Cashe.Currency_Handling; -------------------------------------------------------------------------------- /docs/sources.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Source files 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 | 52 |
53 | 56 | 57 | 58 | -------------------------------------------------------------------------------- /docs/robo_records.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Records 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

Records

35 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

36 |

C

Currency_Handling.Currency_Data 37 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

38 |
39 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /docs/robo_constants.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Constants 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

Constants

35 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

36 |

C

Cashe.Max_Integer_Len 37 | Cashe.Max_Precision 38 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

39 |
40 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /docs/robo_exceptions.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Exceptions 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

Exceptions

35 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

36 |

C

Cashe.Minor_Unit_Too_Large 37 |

M

Money_Handling.Currency_Mismatch 38 | Money_Handling.Division_By_Zero 39 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

40 |
41 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /docs/robo_classes.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Classes 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

Classes

35 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

36 |

C

Currency_Handling.Custom_Currency 37 |

E

Exchange.Currency_Exchange 38 |

M

Money_Handling.Money 39 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

40 |
41 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /docs/robo_packages.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Packages 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

Packages

35 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

36 |

C

Cashe 37 | Currency_Handling 38 |

E

Exchange 39 |

M

Money_Handling 40 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

41 |
42 | 45 | 46 | 47 | -------------------------------------------------------------------------------- /docs/robo_types.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Types 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

Types

35 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

36 |

C

Cashe.Decimal 37 | Cashe.Decimal_Major 38 | Cashe.Decimal_Minor 39 | Cashe.Round_Method 40 | Currency_Handling.Currency_Type 41 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

42 |
43 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /tests/src/cashe_exchange_tests.adb: -------------------------------------------------------------------------------- 1 | with Ada.Assertions; use Ada.Assertions; 2 | with Cashe; use Cashe; 3 | with ISO.Currencies; use ISO.Currencies; 4 | with Cashe.Money_Handling; use Cashe.Money_Handling; 5 | with Cashe.Currency_Handling; use Cashe.Currency_Handling; 6 | with Cashe.Exchange; use Cashe.Exchange; 7 | package body Cashe_Exchange_Tests is 8 | procedure Run_Tests is 9 | -- Create some currencies to test 10 | Bitcoin : constant Custom_Currency := 11 | Create (Code => "BTC", Minor_Unit => 8, 12 | Name => "Bitcoin", Symbol => "฿"); 13 | USD : constant Currency := (Key => C_USD); 14 | JPY : constant Currency := (Key => C_JPY); 15 | EUR : constant Currency := (Key => C_EUR); 16 | -- based on the Jul. 9, 2023 exchange rate 17 | -- from openexchangerates.org. 18 | BTC_to_USD : constant Decimal := 30196.620159; 19 | USD_to_BTC : constant Decimal := 0.0000331163; 20 | 21 | USD_to_JPY : constant Decimal := 142.17488666; 22 | JPY_to_USD : constant Decimal := 0.007033591; 23 | 24 | USD_to_EUR : constant Decimal := 0.911922; 25 | EUR_to_USD : constant Decimal := 1.0965850149; 26 | 27 | -- Create an exchange. 28 | USD_Ex : Currency_Exchange; 29 | EUR_Ex : Currency_Exchange; 30 | BTC_Ex : Currency_Exchange; 31 | No_Base : Currency_Exchange; 32 | 33 | begin 34 | 35 | -- Set the base 36 | Assert (not USD_Ex.Base_Is_Set); 37 | USD_Ex.Set_Base ("USD"); 38 | EUR_Ex.Set_Base (From_Code ("EUR")); 39 | BTC_Ex.Set_Base (Bitcoin); 40 | Assert (USD_Ex.Base_Is_Set); 41 | Assert (EUR_Ex.Base_Is_Set); 42 | Assert (BTC_Ex.Base_Is_Set); 43 | -- Set some exchange rates. 44 | -- Bitcoin-USD 45 | BTC_Ex.Set_Rate ("USD", BTC_to_USD); 46 | BTC_Ex.Set_Rate ("USD", Bitcoin, USD_to_BTC); 47 | No_Base.Set_Rate ("USD", Bitcoin, USD_to_BTC); 48 | -- USD-JPY 49 | USD_Ex.Set_Rate (From_Code ("JPY"), USD_to_JPY); 50 | USD_Ex.Set_Rate ("JPY", USD, JPY_to_USD); 51 | No_Base.Set_Rate (From_Code ("JPY"), "USD", JPY_to_USD); 52 | -- EUR-USD 53 | EUR_Ex.Set_Rate ("USD", EUR_to_USD); 54 | EUR_Ex.Set_Rate ("USD", EUR, USD_to_EUR); 55 | No_Base.Set_Rate ("USD", From_Code ("EUR"), USD_to_EUR); 56 | -- Test btc-usd 57 | Assert (BTC_Ex.Rate ("USD") = BTC_to_USD); 58 | Assert (No_Base.Rate ("USD", Bitcoin) = USD_to_BTC); 59 | Assert 60 | (BTC_Ex.Convert (From_Major (123.45, USD), Bitcoin) 61 | = 62 | From_Major (0.0040882059, Bitcoin)); 63 | Assert 64 | (BTC_Ex.Convert (From_Major (123.45678912, Bitcoin), USD) 65 | = 66 | From_Major (3727977.7671, USD)); 67 | Assert 68 | (BTC_Ex.Convert (From_Major (123.45, USD), Bitcoin) 69 | = 70 | No_Base.Convert (From_Major (123.45, USD), Bitcoin)); 71 | -- Test jpy-usd 72 | Assert (USD_Ex.Rate (From_Code ("JPY")) = USD_to_JPY); 73 | Assert (No_Base.Rate (From_Code ("JPY"), "USD") = JPY_to_USD); 74 | Assert 75 | (USD_Ex.Convert (From_Major (123.45, USD), JPY) 76 | = 77 | From_Major (17551, JPY)); 78 | Assert 79 | (USD_Ex.Convert (From_Major (12345, JPY), USD) 80 | = 81 | From_Major (86.829680614, USD)); 82 | Assert 83 | (USD_Ex.Convert (From_Major (12345, JPY), USD) 84 | = 85 | No_Base.Convert (From_Major (12345, JPY), USD)); 86 | -- Test eur-usd 87 | Assert (EUR_Ex.Rate ("USD") = EUR_to_USD); 88 | Assert (No_Base.Rate ("USD", "EUR") = USD_to_EUR); 89 | Assert 90 | (EUR_Ex.Convert (From_Major (123.45, USD), EUR) 91 | = 92 | From_Major (112.5767709, EUR)); 93 | Assert 94 | (EUR_Ex.Convert (From_Major (123.45, EUR), USD) 95 | = 96 | From_Major (135.3734201, USD)); 97 | Assert 98 | (EUR_Ex.Convert (From_Major (123.45, EUR), USD) 99 | = 100 | No_Base.Convert (From_Major (123.45, EUR), USD)); 101 | end Run_Tests; 102 | end Cashe_Exchange_Tests; -------------------------------------------------------------------------------- /docs/robo_subprograms.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Subprograms 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

Subprograms

35 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

36 |

C

Cashe.Round 37 | Cashe.To_Decimal 38 | Currency_Handling.Create 39 |

M

Money_Handling.abs 40 | Money_Handling.Addition 41 | Money_Handling.Division 42 | Money_Handling.Equal_To 43 | Money_Handling.From_Major 44 | Money_Handling.From_Minor 45 | Money_Handling.Greater_Than 46 | Money_Handling.Greater_Than_Equal_To 47 | Money_Handling.Less_Than 48 | Money_Handling.Less_Than_Equal_To 49 | Money_Handling.Multiplication 50 | Money_Handling.Print_Money 51 | Money_Handling.Subtraction 52 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

53 |
54 | 57 | 58 | 59 | -------------------------------------------------------------------------------- /docs/robo_Methods.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Methods 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

Methods

35 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

36 |

A

As_Major 37 | As_Minor 38 |

B

Base_Is_Set 39 |

C

Code 40 | Contains 41 | Convert 42 | Currency_Code 43 | Currency_Name 44 | Currency_Symbol 45 | Currency_Unit 46 |

F

Full_Precision 47 |

G

Get_Currency 48 |

I

Is_Custom_Currency 49 | Is_Negative 50 | Is_Positive 51 | Is_Zero 52 |

N

Name 53 |

R

Rate 54 | Round 55 |

S

Same_Currency 56 | Set_Base 57 | Set_Code 58 | Set_Name 59 | Set_Rate 60 | Set_Symbol 61 | Set_Unit 62 | Symbol 63 |

U

Unit 64 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

65 |
66 | 69 | 70 | 71 | -------------------------------------------------------------------------------- /src/cashe.ads: -------------------------------------------------------------------------------- 1 | pragma Ada_2022; 2 | -- ****h* Cashe/Cashe 3 | -- SOURCE 4 | package Cashe is 5 | -- DESCRIPTION 6 | -- This package provides datatypes and functions utilized by other packages. 7 | -- **** 8 | Version : constant String := "1.0.0"; 9 | -- ****t* Cashe/Cashe.Decimal 10 | -- SOURCE 11 | type Decimal is delta 1.0E-20 digits 38; 12 | -- DESCRIPTION 13 | -- 128-bit decimal number, ranging from: 14 | -- -999_999_999_999_999_999.99999999999999999999 to 15 | -- 999_999_999_999_999_999.99999999999999999999 16 | -- Used for storing the currency. 17 | -- EXAMPLE 18 | -- My_Dec : Decimal := 1.12345678909876543210; 19 | -- **** 20 | 21 | -- ****d* Cashe/Cashe.Max_Precision 22 | -- SOURCE 23 | Max_Precision : constant := 20; 24 | -- DESCRIPTION 25 | -- The maximum precision that this decimal type has. 26 | -- **** 27 | 28 | -- ****t* Cashe/Cashe.Decimal_Major 29 | -- SOURCE 30 | subtype Decimal_Major is Long_Long_Integer 31 | range -(1E+18 - 1) .. +(1E+18 - 1); 32 | -- DESCRIPTION 33 | -- Integer number, ranging from: 34 | -- -999_999_999_999_999_999 to 999_999_999_999_999_999 35 | -- Used for setting major units without precision. 36 | -- DERIVED FROM 37 | -- Long_Long_Integer 38 | -- **** 39 | 40 | -- ****d* Cashe/Cashe.Max_Integer_Len 41 | -- SOURCE 42 | Max_Integer_Len : constant := 18; 43 | -- DESCRIPTION 44 | -- The maximum number of decimal numbers that a major unit can be. 45 | -- **** 46 | 47 | -- ****t* Cashe/Cashe.Decimal_Minor 48 | -- SOURCE 49 | subtype Decimal_Minor is Long_Long_Long_Integer 50 | range -(1E+38 - 1) .. +(1E+38 - 1); 51 | -- DESCRIPTION 52 | -- 128-bit integer number, ranging from: 53 | -- -99_999_999_999_999_999_999_999_999_999_999_999_999 to 54 | -- 99_999_999_999_999_999_999_999_999_999_999_999_999 55 | -- Used for setting / accessing minor units 56 | -- DERIVED FROM 57 | -- Long_Long_Long_Integer 58 | -- **** 59 | 60 | -- ****e* Cashe/Cashe.Minor_Unit_Too_Large 61 | -- SOURCE 62 | Minor_Unit_Too_Large : exception; 63 | -- DESCRIPTION 64 | -- Raised if the minor unit will not "fit" into the major unit. 65 | -- **** 66 | 67 | -- ****t* Cashe/Cashe.Round_Method 68 | -- SOURCE 69 | type Round_Method is ( 70 | Half_Even, 71 | -- Default rounding method, also known as "Banker's Rounding" 72 | Half_Up 73 | -- Standard-behavior rounding, the kind taught in highschool. 74 | ); 75 | -- DESCRIPTION 76 | -- Rounding methods. 77 | -- **** 78 | 79 | -- ****f* Cashe/Cashe.To_Decimal 80 | -- SOURCE 81 | function To_Decimal 82 | (Item : Float; 83 | -- Floating point to be converted to a decimal. 84 | Precision : Natural := 20 85 | -- Precision to round to. Default is 20. 86 | ) return Decimal; 87 | function To_Decimal 88 | (Item : Long_Float; 89 | -- Floating point to be converted to a decimal. 90 | Precision : Natural := 20 91 | -- Precision to round to. Default is 20. 92 | ) return Decimal; 93 | function To_Decimal 94 | (Item : Long_Long_Float; 95 | -- Floating point to be converted to a decimal. 96 | Precision : Natural := 20 97 | -- Precision to round to. Default is 20. 98 | ) return Decimal; 99 | function To_Decimal 100 | (Value : Decimal_Minor; 101 | -- The whole number which to convert into a decimal 102 | Precision : Natural := 20 103 | -- The maount of decimal places out 104 | ) 105 | return Decimal with 106 | pre => Precision <= Max_Precision; 107 | -- FUNCTION 108 | -- Convert a floating point number or minor unit to a Decimal based on 109 | -- precision. Highly recommended to use this function with 110 | -- Long_Long_Float for highest precision. 111 | -- PARAMETERS 112 | -- Item - Floating point to be converted. 113 | -- Precision - Precision to round to. Default is 20. 114 | -- RETURN VALUE 115 | -- Cashe.Decimal - Decimal value of float to Precision. 116 | -- ERRORS 117 | -- * Cashe/Cashe.Minor_Unit_Too_Large in case of converting Minor Unit 118 | -- EXAMPLE 119 | -- with Cashe; use Cashe; 120 | -- D : Decimal_Minor := 1411900 121 | -- F : Long_Long_Float := 14.1190004014938372284932918; 122 | -- A : Decimal := To_Decimal (F); -- 14.11900040149383722880 123 | -- B : Decimal := To_Decimal (F, 3); -- 14.11900000000000000000 124 | -- C : Decimal := To_Decimal (F, 2); -- 14.12000000000000000000 125 | -- E : Decimal := To_Decimal (D, 5); -- 14.11900 126 | -- **** 127 | 128 | -- ****f* Cashe/Cashe.Round 129 | -- SOURCE 130 | function Round 131 | (Item : Decimal; 132 | -- The decimal to round 133 | By : Natural; 134 | -- The precision which to round to. 135 | Method : Round_Method := Half_Even 136 | -- The method of rounding. Default is Half_Even aka Banker's Rounding. 137 | ) 138 | return Decimal with pre => By <= Max_Precision; 139 | -- FUNCTION 140 | -- Round the value of a money object to a given precision 141 | -- PARAMETERS 142 | -- Item - Decimal to be rounded 143 | -- By - Precision to round to. 144 | -- RETURN VALUE 145 | -- Cashe.Decimal - Decimal value rounded to Precision. 146 | -- EXAMPLE 147 | -- T : Decimal := -2000.005; 148 | -- A : Decimal := Round (T, 2); -- -2000.00 149 | -- B : Decimal := Round (T, 2, Half_Up); -- -2000.01 150 | -- **** 151 | 152 | private 153 | -- Helper function for decimal math. 154 | function Pow (Base : Decimal; Exponent : Integer) return Decimal; 155 | type Shift_Direction is (Shift_Left, Shift_Right); 156 | function Shift_Decimal 157 | (Item : Decimal; By : Natural; Direction : Shift_Direction) 158 | return Decimal; 159 | function Shift_Float 160 | (Item : Long_Long_Float; By : Natural; Direction : Shift_Direction) 161 | return Long_Long_Float; 162 | -- Calculates the length of the integer. So 123 returns 3. 163 | function Integer_Width (Item : Long_Long_Long_Integer) return Natural; 164 | -- Calculates the low and high of an integer 165 | function Low (Number : Long_Long_Long_Integer; N : Natural) 166 | return Long_Long_Long_Integer; 167 | function High (Number : Long_Long_Long_Integer; N : Natural) 168 | return Long_Long_Long_Integer; 169 | end Cashe; 170 | -------------------------------------------------------------------------------- /docs/robodoc.css: -------------------------------------------------------------------------------- 1 | /****h* ROBODoc/ROBODoc Cascading Style Sheet 2 | * FUNCTION 3 | * This is the default cascading style sheet for documentation 4 | * generated with ROBODoc. 5 | * You can edit this file to your own liking and then use 6 | * it with the option 7 | * --css 8 | * 9 | * This style-sheet defines the following layout 10 | * +----------------------------------------+ 11 | * | logo | 12 | * +----------------------------------------+ 13 | * | extra | 14 | * +----------------------------------------+ 15 | * | | navi- | 16 | * | | gation | 17 | * | content | | 18 | * | | | 19 | * +----------------------------------------+ 20 | * | footer | 21 | * +----------------------------------------+ 22 | * 23 | * This style-sheet is based on a style-sheet that was automatically 24 | * generated with the Strange Banana stylesheet generator. 25 | * See http://www.strangebanana.com/generator.aspx 26 | * 27 | ****** 28 | * $Id: html_generator.c,v 1.94 2008/06/17 11:49:27 gumpu Exp $ 29 | */ 30 | 31 | body 32 | { 33 | background-color: rgb(255,255,255); 34 | color: rgb(98,84,55); 35 | font-family: Arial, serif; 36 | border-color: rgb(226,199,143); 37 | } 38 | 39 | pre 40 | { 41 | font-family: monospace; 42 | margin: 15px; 43 | padding: 5px; 44 | white-space: pre; 45 | color: #000; 46 | } 47 | 48 | pre.source 49 | { 50 | background-color: #ffe; 51 | border: dashed #aa9 1px; 52 | } 53 | 54 | p 55 | { 56 | margin:15px; 57 | } 58 | 59 | p.item_name 60 | { 61 | font-weight: bolder; 62 | margin:5px; 63 | font-size: 120%; 64 | } 65 | 66 | #content 67 | { 68 | font-size: 100%; 69 | color: rgb(0,0,0); 70 | background-color: rgb(255,255,255); 71 | border-left-width: 0px; 72 | border-right-width: 0px; 73 | border-top-width: 0px; 74 | border-bottom-width: 0px; 75 | border-left-style: none; 76 | border-right-style: none; 77 | border-top-style: none; 78 | border-bottom-style: none; 79 | padding: 40px 31px 14px 17px; 80 | border-color: rgb(0,0,0); 81 | text-align: justify; 82 | } 83 | 84 | #navigation 85 | { 86 | background-color: rgb(98,84,55); 87 | color: rgb(230,221,202); 88 | font-family: "Times New Roman", serif; 89 | font-style: normal; 90 | border-color: rgb(0,0,0); 91 | } 92 | 93 | a.menuitem 94 | { 95 | font-size: 120%; 96 | background-color: rgb(0,0,0); 97 | color: rgb(195,165,100); 98 | font-variant: normal; 99 | text-transform: none; 100 | font-weight: normal; 101 | padding: 1px 8px 3px 1px; 102 | margin-left: 5px; 103 | margin-right: 5px; 104 | margin-top: 5px; 105 | margin-bottom: 5px; 106 | border-color: rgb(159,126,57); 107 | text-align: right; 108 | } 109 | 110 | #logo, #logo a 111 | { 112 | font-size: 130%; 113 | background-color: rgb(198,178,135); 114 | color: rgb(98,84,55); 115 | font-family: Georgia, serif; 116 | font-style: normal; 117 | font-variant: normal; 118 | text-transform: none; 119 | font-weight: bold; 120 | padding: 20px 18px 20px 18px; 121 | border-color: rgb(255,255,255); 122 | text-align: right; 123 | } 124 | 125 | #extra, #extra a 126 | { 127 | font-size: 128%; 128 | background-color: rgb(0,0,0); 129 | color: rgb(230,221,202); 130 | font-style: normal; 131 | font-variant: normal; 132 | text-transform: none; 133 | font-weight: normal; 134 | border-left-width: 0px; 135 | border-right-width: 0px; 136 | border-top-width: 0px; 137 | border-bottom-width: 0px; 138 | border-left-style: none; 139 | border-right-style: none; 140 | border-top-style: none; 141 | border-bottom-style: none; 142 | padding: 12px 12px 12px 12px; 143 | border-color: rgb(195,165,100); 144 | text-align: center; 145 | } 146 | 147 | #content a 148 | { 149 | color: rgb(159,126,57); 150 | text-decoration: none; 151 | } 152 | 153 | #content a:hover, #content a:active 154 | { 155 | color: rgb(255,255,255); 156 | background-color: rgb(159,126,57); 157 | } 158 | 159 | a.indexitem 160 | { 161 | display: block; 162 | } 163 | 164 | h1, h2, h3, h4, h5, h6 165 | { 166 | background-color: rgb(221,221,221); 167 | font-family: Arial, serif; 168 | font-style: normal; 169 | font-variant: normal; 170 | text-transform: none; 171 | font-weight: normal; 172 | } 173 | 174 | h1 175 | { 176 | font-size: 151%; 177 | } 178 | 179 | h2 180 | { 181 | font-size: 142%; 182 | } 183 | 184 | h3 185 | { 186 | font-size: 133%; 187 | } 188 | 189 | h4 190 | { 191 | font-size: 124%; 192 | } 193 | 194 | h5 195 | { 196 | font-size: 115%; 197 | } 198 | 199 | h6 200 | { 201 | font-size: 106%; 202 | } 203 | 204 | #navigation a 205 | { 206 | text-decoration: none; 207 | } 208 | 209 | .menuitem:hover 210 | { 211 | background-color: rgb(195,165,100); 212 | color: rgb(0,0,0); 213 | } 214 | 215 | #extra a 216 | { 217 | text-decoration: none; 218 | } 219 | 220 | #logo a 221 | { 222 | text-decoration: none; 223 | } 224 | 225 | #extra a:hover 226 | { 227 | } 228 | 229 | /* layout */ 230 | #navigation 231 | { 232 | width: 22%; 233 | position: relative; 234 | top: 0; 235 | right: 0; 236 | float: right; 237 | text-align: center; 238 | margin-left: 10px; 239 | } 240 | 241 | .menuitem {width: auto;} 242 | #content {width: auto;} 243 | .menuitem {display: block;} 244 | 245 | 246 | div#footer 247 | { 248 | background-color: rgb(198,178,135); 249 | color: rgb(98,84,55); 250 | clear: left; 251 | width: 100%; 252 | font-size: 71%; 253 | } 254 | 255 | div#footer a 256 | { 257 | background-color: rgb(198,178,135); 258 | color: rgb(98,84,55); 259 | } 260 | 261 | div#footer p 262 | { 263 | margin:0; 264 | padding:5px 10px 265 | } 266 | 267 | span.keyword 268 | { 269 | color: #00F; 270 | } 271 | 272 | span.comment 273 | { 274 | color: #080; 275 | } 276 | 277 | span.quote 278 | { 279 | color: #F00; 280 | } 281 | 282 | span.squote 283 | { 284 | color: #F0F; 285 | } 286 | 287 | span.sign 288 | { 289 | color: #008B8B; 290 | } 291 | 292 | span.line_number 293 | { 294 | color: #808080; 295 | } 296 | 297 | @media print 298 | { 299 | #navigation {display: none;} 300 | #content {padding: 0px;} 301 | #content a {text-decoration: underline;} 302 | } 303 | -------------------------------------------------------------------------------- /docs/toc_index.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Table of Contents 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

TABLE OF CONTENTS

35 | 113 |
114 | 117 | 118 | 119 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | Index 11 | 12 | 13 | 14 | 15 | 18 |
19 |
20 | 33 |
34 |

Index

35 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

36 |

A

As_Major 37 | As_Minor 38 |

B

Base_Is_Set 39 |

C

Cashe 40 | cashe-currency_handling.ads 41 | cashe-exchange.ads 42 | cashe-money_handling.ads 43 | cashe.ads 44 | Cashe.Decimal 45 | Cashe.Decimal_Major 46 | Cashe.Decimal_Minor 47 | Cashe.Max_Integer_Len 48 | Cashe.Max_Precision 49 | Cashe.Minor_Unit_Too_Large 50 | Cashe.Round 51 | Cashe.Round_Method 52 | Cashe.To_Decimal 53 | Code 54 | Contains 55 | Convert 56 | Currency_Code 57 | Currency_Handling 58 | Currency_Handling.Create 59 | Currency_Handling.Currency_Data 60 | Currency_Handling.Currency_Type 61 | Currency_Handling.Custom_Currency 62 | Currency_Name 63 | Currency_Symbol 64 | Currency_Unit 65 |

E

Exchange 66 | Exchange.Currency_Exchange 67 |

F

Full_Precision 68 |

G

Get_Currency 69 |

I

Is_Custom_Currency 70 | Is_Negative 71 | Is_Positive 72 | Is_Zero 73 |

M

Money_Handling 74 | Money_Handling.abs 75 | Money_Handling.Addition 76 | Money_Handling.Currency_Mismatch 77 | Money_Handling.Division 78 | Money_Handling.Division_By_Zero 79 | Money_Handling.Equal_To 80 | Money_Handling.From_Major 81 | Money_Handling.From_Minor 82 | Money_Handling.Greater_Than 83 | Money_Handling.Greater_Than_Equal_To 84 | Money_Handling.Less_Than 85 | Money_Handling.Less_Than_Equal_To 86 | Money_Handling.Money 87 | Money_Handling.Multiplication 88 | Money_Handling.Print_Money 89 | Money_Handling.Subtraction 90 |

N

Name 91 |

R

Rate 92 | Round 93 |

S

Same_Currency 94 | Set_Base 95 | Set_Code 96 | Set_Name 97 | Set_Rate 98 | Set_Symbol 99 | Set_Unit 100 | Symbol 101 |

U

Unit 102 |

A - B - C - D - E - F - G - H - I - J - K - L - M - N - O - P - Q - R - S - T - U - V - W - X - Y - Z - 0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9

103 |
104 | 107 | 108 | 109 | -------------------------------------------------------------------------------- /src/cashe-currency_handling.ads: -------------------------------------------------------------------------------- 1 | pragma Assertion_Policy (Check); 2 | with ISO.Currencies; 3 | with Ada.Strings.Wide_Wide_Unbounded; 4 | -- ****h* Cashe/Currency_Handling 5 | -- SOURCE 6 | package Cashe.Currency_Handling is 7 | -- DESCRIPTION 8 | -- This package provides methods of defining custom currency and storing 9 | -- currencies. 10 | -- **** 11 | 12 | -- ****c* Currency_Handling/Currency_Handling.Custom_Currency 13 | -- SOURCE 14 | type Custom_Currency is tagged private; 15 | -- DESCRIPTION 16 | -- Allows for defining and storing a custom currency. Member functions 17 | -- can be used to retrieve information such as its code, minor units, 18 | -- and symbols. Can be initialized with the Create function. 19 | -- USAGE 20 | -- with Cashe.Currency_Handling; use Cashe.Currency_Handling; 21 | -- King : Custom_Currency := Create (Code => "KNG", 22 | -- Minor_Unit => 2, 23 | -- Name => "King Currency", 24 | -- Symbol => "K"); 25 | -- METHODS 26 | -- * Currency_Handling.Custom_Currency/Set_Code 27 | -- * Currency_Handling.Custom_Currency/Set_Name 28 | -- * Currency_Handling.Custom_Currency/Set_Symbol 29 | -- * Currency_Handling.Custom_Currency/Set_Unit 30 | -- * Currency_Handling.Custom_Currency/Code 31 | -- * Currency_Handling.Custom_Currency/Name 32 | -- * Currency_Handling.Custom_Currency/Symbol 33 | -- * Currency_Handling.Custom_Currency/Unit 34 | -- **** 35 | 36 | -- ****m* Currency_Handling.Custom_Currency/Set_Code 37 | -- SOURCE 38 | procedure Set_Code 39 | (This : in out Custom_Currency; 40 | -- The custom currency 41 | Item : Wide_Wide_String 42 | -- New code for the custom currency 43 | ); 44 | -- FUNCTION 45 | -- [Re]define the code associated with the currency. 46 | -- PARAMETERS 47 | -- Item - New code for the custom currency as wide_wide_string 48 | -- EXAMPLE 49 | -- with Cashe.Currency_Handling; use Cashe.Currency_Handling; 50 | -- declare 51 | -- My_Cur : Custom_Currency; 52 | -- begin 53 | -- My_Cur.Set_Code ("CUR"); 54 | -- end; 55 | -- **** 56 | 57 | -- ****m* Currency_Handling.Custom_Currency/Set_Name 58 | -- SOURCE 59 | procedure Set_Name 60 | (This : in out Custom_Currency; 61 | -- The custom currency. 62 | Item : Wide_Wide_String 63 | -- New name 64 | ); 65 | -- FUNCTION 66 | -- [Re]define the name of the custom currency. 67 | -- PARAMETERS 68 | -- Item - New name as wide_wide_string 69 | -- EXAMPLE 70 | -- with Cashe.Currency_Handling; use Cashe.Currency_Handling; 71 | -- declare 72 | -- My_Cur : Custom_Currency; 73 | -- begin 74 | -- My_Cur.Set_Name ("Custom Currency"); 75 | -- end; 76 | -- **** 77 | 78 | -- ****m* Currency_Handling.Custom_Currency/Set_Symbol 79 | -- SOURCE 80 | procedure Set_Symbol 81 | (This : in out Custom_Currency; 82 | -- The custom currency. 83 | Item : Wide_Wide_String 84 | -- New symbol 85 | ); 86 | -- FUNCTION 87 | -- [Re]define the symbol of the custom currency. 88 | -- PARAMETERS 89 | -- Item - New symbol as wide_wide_string 90 | -- EXAMPLE 91 | -- with Cashe.Currency_Handling; use Cashe.Currency_Handling; 92 | -- declare 93 | -- My_Cur : Custom_Currency; 94 | -- begin 95 | -- My_Cur.Set_Symbol ("$"); 96 | -- end; 97 | -- **** 98 | 99 | -- ****m* Currency_Handling.Custom_Currency/Set_Unit 100 | -- SOURCE 101 | procedure Set_Unit 102 | (This : in out Custom_Currency; 103 | -- The custom currency. 104 | Item : Natural 105 | -- New minor 106 | ); 107 | -- FUNCTION 108 | -- [Re]define the minor unit of the custom currency. 109 | -- PARAMETERS 110 | -- Item - New symbol unit as Natural 111 | -- EXAMPLE 112 | -- with Cashe.Currency_Handling; use Cashe.Currency_Handling; 113 | -- declare 114 | -- My_Cur : Custom_Currency; 115 | -- begin 116 | -- My_Cur.Set_Unit (2); 117 | -- end; 118 | -- **** 119 | 120 | -- ****m* Currency_Handling.Custom_Currency/Code 121 | -- SOURCE 122 | function Code (This : Custom_Currency) return Wide_Wide_String; 123 | -- FUNCTION 124 | -- Retrieves the code of the custom currency. 125 | -- RETURN VALUE 126 | -- Wide_Wide_String - Code belonging to currency. 127 | -- EXAMPLE 128 | -- Ada.Text_Wide_Wide_IO.Put_Line (My_Currency.Code); 129 | -- **** 130 | 131 | -- ****m* Currency_Handling.Custom_Currency/Name 132 | -- SOURCE 133 | function Name (This : Custom_Currency) return Wide_Wide_String; 134 | -- FUNCTION 135 | -- Retrieves the name of the custom currency. 136 | -- RETURN VALUE 137 | -- Wide_Wide_String - name belonging to currency. 138 | -- EXAMPLE 139 | -- Ada.Text_Wide_Wide_IO.Put_Line (My_Currency.Name); 140 | -- **** 141 | 142 | -- ****m* Currency_Handling.Custom_Currency/Symbol 143 | -- SOURCE 144 | function Symbol (This : Custom_Currency) return Wide_Wide_String; 145 | -- FUNCTION 146 | -- Retrieves the symbol of the custom currency. 147 | -- RETURN VALUE 148 | -- Wide_Wide_String - symbol belonging to currency. 149 | -- EXAMPLE 150 | -- Ada.Text_Wide_Wide_IO.Put_Line (My_Currency.Symbol); 151 | -- **** 152 | 153 | -- ****m* Currency_Handling.Custom_Currency/Unit 154 | -- SOURCE 155 | function Unit (This : Custom_Currency) return Natural; 156 | -- FUNCTION 157 | -- Retrieves the code of the custom currency. 158 | -- RETURN VALUE 159 | -- Natural - Minor Unit belonging to currency. 160 | -- EXAMPLE 161 | -- My_Unit : Natural := My_Currency.Unit; 162 | -- **** 163 | 164 | -- ****f* Currency_Handling/Currency_Handling.Create 165 | -- SOURCE 166 | function Create 167 | (Code : Wide_Wide_String; 168 | -- Currency's code 169 | Minor_Unit : Natural := 0; 170 | -- Currency's minor unit. Optional. 171 | Name : Wide_Wide_String := ""; 172 | -- Currency's name. Optional. 173 | Symbol : Wide_Wide_String := "" 174 | -- Currency's symbol. Optional. 175 | ) 176 | return Custom_Currency with pre => Minor_Unit <= Max_Precision; 177 | -- FUNCTION 178 | -- Create a custom currency according to parameters. Minor unit may not 179 | -- be greater than maximum precision supported by library. 180 | -- PARAMETERS 181 | -- Code - A code as a string, such as "EUR" or "USD". 182 | -- Minor_Unit - Currency's minor unit. Optional. 183 | -- Name - Currency's name. Optional. 184 | -- Symbol - Currency's symbol. Optional. 185 | -- RETURN VALUE 186 | -- Currency_Handling/Currency_Handling.Custom_Currency 187 | -- EXAMPLE 188 | -- King : Custom_Currency := Create (Code => "KNG", 189 | -- Minor_Unit => 2, 190 | -- Name => "King Currency", 191 | -- Symbol => "K"); 192 | -- **** 193 | 194 | -- ****t* Currency_Handling/Currency_Handling.Currency_Type 195 | -- SOURCE 196 | type Currency_Type is (Type_Custom_Currency, Type_ISO_Currency); 197 | -- DESCRIPTION 198 | -- For Currency_Data variant record. 199 | -- SEE ALSO 200 | -- Currency_Handling/Currency_Handling.Currency_Data 201 | -- **** 202 | 203 | -- ****s* Currency_Handling/Currency_Handling.Currency_Data 204 | -- SOURCE 205 | type Currency_Data 206 | (Which_Currency_Type : Currency_Type := Type_ISO_Currency) 207 | is record 208 | case Which_Currency_Type is 209 | when Type_Custom_Currency => 210 | -- The custom currency that will be stored in money/exchange. 211 | Custom_Code : Custom_Currency; 212 | when Type_ISO_Currency => 213 | -- The ISO currency that will be stored in the money/exchange. 214 | ISO_Code : ISO.Currencies.Currency; 215 | end case; 216 | end record; 217 | -- DESCRIPTION 218 | -- A "holder" for both custom or non-custom currency, if needed. 219 | -- Which kind of currency can be verified by accessing the object's 220 | -- "Which_Currency_Data" later on. 221 | -- PARAMETERS 222 | -- Which_Currency_Type: Which kind of currency? 223 | -- EXAMPLE 224 | -- declare 225 | -- My_Holder : Currency_Data := 226 | -- (Which_Currency_Type => Type_ISO_Currency, 227 | -- ISO_Code => ISO.Currencies.From_Code ("USD")); 228 | -- begin 229 | -- case My_Holder.Which_Currency_Type is 230 | -- when Type_Custom_Currency => 231 | -- Put_Line ("Currency is " & My_Holder.Custom_Code.Name); 232 | -- when Type_ISO_Currency => 233 | -- Put_Line ("Currency is " & My_Holder.ISO_Code.Name); 234 | -- Put_Line ("And Numeric is " & My_Holder.ISO_Code.Numeric); 235 | -- end case; 236 | -- end; 237 | -- SEE ALSO 238 | -- Currency_Handling/Currency_Handling.Currency_Type 239 | -- **** 240 | 241 | private 242 | 243 | type Custom_Currency is tagged record 244 | Custom_Code : 245 | Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String; 246 | Custom_Symbol : 247 | Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String; 248 | Custom_Name : 249 | Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String; 250 | Custom_Minor_Unit : Natural := 0; 251 | end record; 252 | 253 | end Cashe.Currency_Handling; 254 | -------------------------------------------------------------------------------- /src/cashe.adb: -------------------------------------------------------------------------------- 1 | package body Cashe is 2 | 3 | -- Helper functions 4 | function Integer_Width (Item : Long_Long_Long_Integer) return Natural 5 | is (Item'Image'Length - 1); 6 | function Shift_Decimal 7 | (Item : Decimal; By : Natural; Direction : Shift_Direction) 8 | return Decimal is 9 | Result : Decimal := Item; 10 | Multiplier : constant Decimal := 11 | (case Direction is when Shift_Left => 10.0, when Shift_Right => 0.1); 12 | begin 13 | for I in 1 .. By loop 14 | Result := Result * Multiplier; 15 | end loop; 16 | return Result; 17 | end Shift_Decimal; 18 | function Shift_Float 19 | (Item : Long_Long_Float; By : Natural; Direction : Shift_Direction) 20 | return Long_Long_Float is 21 | Result : Long_Long_Float := Item; 22 | Multiplier : constant Long_Long_Float := 23 | (case Direction is when Shift_Left => 10.0, when Shift_Right => 0.1); 24 | begin 25 | for I in 1 .. By loop 26 | Result := Result * Multiplier; 27 | end loop; 28 | return Result; 29 | end Shift_Float; 30 | function Pow 31 | (Base : Decimal; Exponent : Integer) return Decimal 32 | is 33 | True_Base : constant Decimal := 34 | (if Exponent >= 0 then Base else 1.0 / Base); 35 | Result : Decimal := (if Exponent = 0 then 1.0 else True_Base); 36 | begin 37 | for I in 2 .. abs Exponent loop 38 | Result := Result * True_Base; 39 | end loop; 40 | return Result; 41 | end Pow; 42 | function Low (Number : Long_Long_Long_Integer; N : Natural) 43 | return Long_Long_Long_Integer is 44 | Modder : constant Long_Long_Long_Integer := 10 ** N; 45 | begin 46 | return Number mod Modder; 47 | end Low; 48 | function High (Number : Long_Long_Long_Integer; N : Natural) 49 | return Long_Long_Long_Integer is 50 | Divisor : constant Long_Long_Long_Integer := 10 ** N; 51 | Result : Long_Long_Long_Integer := Number; 52 | begin 53 | while Result / Divisor > 0 loop 54 | Result := Result / 10; 55 | end loop; 56 | return Result; 57 | end High; 58 | function To_Decimal 59 | (Value : Decimal_Minor; Precision : Natural := 20) 60 | return Decimal 61 | is 62 | Width : constant Natural := Integer_Width (Value); 63 | begin 64 | if Width <= Max_Integer_Len then 65 | return Shift_Decimal (Decimal (Value), Precision, Shift_Right); 66 | elsif Precision <= Max_Precision then 67 | declare 68 | Dec_Low : constant Decimal_Minor := 69 | Low (Value, Precision); 70 | Dec_High : constant Decimal := 71 | Decimal (High (Value, Width - Precision)); 72 | begin 73 | if Precision < Max_Integer_Len then 74 | return Dec_High + 75 | Shift_Decimal 76 | (Decimal (Dec_Low), Precision, Shift_Right); 77 | else 78 | -- I need to do this because there's only 18 decimal places 79 | -- on the left, and 20 on the right. If we get >128bit fixed 80 | -- decimals this won't be an issue. 81 | declare 82 | Low_High_Len : constant Natural := 83 | Precision - Max_Integer_Len; 84 | Dec_Low_Low : constant Decimal := 85 | Shift_Decimal 86 | (Decimal (Low (Dec_Low, Max_Integer_Len)), 87 | Max_Integer_Len + Low_High_Len, Shift_Right); 88 | Dec_Low_High : constant Decimal := 89 | Shift_Decimal 90 | (Decimal (High (Dec_Low, Low_High_Len)), 91 | Low_High_Len, Shift_Right); 92 | begin 93 | return Dec_High + Dec_Low_High + Dec_Low_Low; 94 | end; 95 | end if; 96 | end; 97 | else 98 | raise Minor_Unit_Too_Large; 99 | end if; 100 | end To_Decimal; 101 | 102 | function To_Decimal 103 | (Item : Long_Long_Float; Precision : Natural := 20) 104 | return Decimal is 105 | begin 106 | -- I'm sure there's a better way of doing this 107 | -- But this gives me precision up to 20. 108 | case Precision is 109 | when 0 => 110 | declare 111 | type Delta1 is delta 1.0E-1 digits 38; 112 | Tmp : constant Decimal_Major := 113 | Decimal_Major (Delta1'Round (Item)); 114 | begin 115 | return Decimal (Tmp); 116 | end; 117 | when 1 => 118 | declare 119 | type Delta1 is delta 1.0E-1 digits 38; 120 | Tmp : constant Delta1 := Delta1'Round (Item); 121 | begin 122 | return Decimal (Tmp); 123 | end; 124 | when 2 => 125 | declare 126 | type Delta2 is delta 1.0E-2 digits 38; 127 | Tmp : constant Delta2 := Delta2'Round (Item); 128 | begin 129 | return Decimal (Tmp); 130 | end; 131 | when 3 => 132 | declare 133 | type Delta3 is delta 1.0E-3 digits 38; 134 | Tmp : constant Delta3 := Delta3'Round (Item); 135 | begin 136 | return Decimal (Tmp); 137 | end; 138 | when 4 => 139 | declare 140 | type Delta4 is delta 1.0E-4 digits 38; 141 | Tmp : constant Delta4 := Delta4'Round (Item); 142 | begin 143 | return Decimal (Tmp); 144 | end; 145 | when 5 => 146 | declare 147 | type Delta5 is delta 1.0E-5 digits 38; 148 | Tmp : constant Delta5 := Delta5'Round (Item); 149 | begin 150 | return Decimal (Tmp); 151 | end; 152 | when 6 => 153 | declare 154 | type Delta6 is delta 1.0E-6 digits 38; 155 | Tmp : constant Delta6 := Delta6'Round (Item); 156 | begin 157 | return Decimal (Tmp); 158 | end; 159 | when 7 => 160 | declare 161 | type Delta7 is delta 1.0E-7 digits 38; 162 | Tmp : constant Delta7 := Delta7'Round (Item); 163 | begin 164 | return Decimal (Tmp); 165 | end; 166 | when 8 => 167 | declare 168 | type Delta8 is delta 1.0E-8 digits 38; 169 | Tmp : constant Delta8 := Delta8'Round (Item); 170 | begin 171 | return Decimal (Tmp); 172 | end; 173 | when 9 => 174 | declare 175 | type Delta9 is delta 1.0E-9 digits 38; 176 | Tmp : constant Delta9 := Delta9'Round (Item); 177 | begin 178 | return Decimal (Tmp); 179 | end; 180 | when 10 => 181 | declare 182 | type Delta10 is delta 1.0E-10 digits 38; 183 | Tmp : constant Delta10 := Delta10'Round (Item); 184 | begin 185 | return Decimal (Tmp); 186 | end; 187 | when 11 => 188 | declare 189 | type Delta11 is delta 1.0E-11 digits 38; 190 | Tmp : constant Delta11 := Delta11'Round (Item); 191 | begin 192 | return Decimal (Tmp); 193 | end; 194 | when 12 => 195 | declare 196 | type Delta12 is delta 1.0E-12 digits 38; 197 | Tmp : constant Delta12 := Delta12'Round (Item); 198 | begin 199 | return Decimal (Tmp); 200 | end; 201 | when 13 => 202 | declare 203 | type Delta13 is delta 1.0E-13 digits 38; 204 | Tmp : constant Delta13 := Delta13'Round (Item); 205 | begin 206 | return Decimal (Tmp); 207 | end; 208 | when 14 => 209 | declare 210 | type Delta14 is delta 1.0E-14 digits 38; 211 | Tmp : constant Delta14 := Delta14'Round (Item); 212 | begin 213 | return Decimal (Tmp); 214 | end; 215 | when 15 => 216 | declare 217 | type Delta15 is delta 1.0E-15 digits 38; 218 | Tmp : constant Delta15 := Delta15'Round (Item); 219 | begin 220 | return Decimal (Tmp); 221 | end; 222 | when 16 => 223 | declare 224 | type Delta16 is delta 1.0E-16 digits 38; 225 | Tmp : constant Delta16 := Delta16'Round (Item); 226 | begin 227 | return Decimal (Tmp); 228 | end; 229 | when 17 => 230 | declare 231 | type Delta17 is delta 1.0E-17 digits 38; 232 | Tmp : constant Delta17 := Delta17'Round (Item); 233 | begin 234 | return Decimal (Tmp); 235 | end; 236 | when 18 => 237 | declare 238 | type Delta18 is delta 1.0E-18 digits 38; 239 | Tmp : constant Delta18 := Delta18'Round (Item); 240 | begin 241 | return Decimal (Tmp); 242 | end; 243 | when 19 => 244 | declare 245 | type Delta19 is delta 1.0E-19 digits 38; 246 | Tmp : constant Delta19 := Delta19'Round (Item); 247 | begin 248 | return Decimal (Tmp); 249 | end; 250 | when others => 251 | declare 252 | Tmp : constant Decimal := Decimal'Round (Item); 253 | begin 254 | return Tmp; 255 | end; 256 | end case; 257 | end To_Decimal; 258 | 259 | function To_Decimal 260 | (Item : Long_Float; Precision : Natural := 20) 261 | return Decimal is 262 | (To_Decimal (Long_Long_Float (Item), Precision)); 263 | function To_Decimal 264 | (Item : Float; Precision : Natural := 20) 265 | return Decimal is 266 | (To_Decimal (Long_Long_Float (Item), Precision)); 267 | 268 | function Round 269 | (Item : Decimal; 270 | By : Natural; 271 | Method : Round_Method := Half_Even) 272 | return Decimal 273 | is 274 | Init : constant Long_Long_Float := 275 | (Shift_Float 276 | (Long_Long_Float (Item), By, Shift_Left)); 277 | Rounded : constant Long_Long_Float := 278 | (case Method is 279 | when Half_Up => 280 | Long_Long_Float'Rounding (Init), 281 | when Half_Even => 282 | Long_Long_Float'Unbiased_Rounding (Init)); 283 | begin 284 | 285 | if By >= 20 then 286 | return Item; 287 | else 288 | return To_Decimal (Shift_Float (Rounded, By, Shift_Right), By); 289 | end if; 290 | 291 | end Round; 292 | 293 | end Cashe; -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Cashe: A Money library for Ada 2 | 3 | **NOTE: This is still in prerelease and may have some changes before its final version!** 4 | 5 | This is a library that treats Money like a first class citizen, taking advantage of Ada's fixed point capabilities to store monetary values as a decimal with up to 20 places of precision, and then utilizes [Banker's Rounding](https://www.sqlservercentral.com/articles/bankers-rounding-what-is-it-good-for) to display or measure the values on-demand based on the Currency's minor unit. Don't worry, if you want the full precision, there's ways to do that too. 6 | 7 | ```Ada 8 | with Cashe; use Cashe; 9 | with ISO.Currencies; use ISO.Currencies; 10 | with Ada.Text_IO; use Ada.Text_IO; 11 | with Cashe.Money_Handling; use Cashe.Money_Handling; 12 | with Cashe.Currency_Handling; use Cashe.Currency_Handling; 13 | procedure Example is 14 | Radio : constant Custom_Currency := 15 | Create (Code => "RAD", Minor_Unit => 0, 16 | Name => "Rad Currency", Symbol => "☢"); 17 | Cardano : constant Custom_Currency := 18 | Create (Code => "ADA", Minor_Unit => 15, 19 | Name => "Cardano", Symbol => "₳"); 20 | USD : constant ISO.Currencies.Currency := ISO.Currencies.From_Code ("USD"); 21 | 22 | US_Dollars : Money := From_Major ("-123.45", USD); 23 | Ada_Dollars : Money := From_Major (173.398847322218938, Cardano); 24 | Rad_Dollars : Money := From_Major (1750, Radio); 25 | 26 | begin 27 | Put_Line (US_Dollars'Image); -- "$-123.45" 28 | Put_Line (Ada_Dollars'Image); -- "₳ 173.398847322218938" 29 | Put_Line (Rad_Dollars'Image); -- "☢ 1750" 30 | end Example; 31 | ``` 32 | 33 | Cashe is already fully featured, supporting: 34 | 35 | - `Decimal`, `Decimal_Major`, and `Decimal_Minor` datatypes utilizing supported ranges 36 | - ISO 4217 (Currency Codes) thanks to [Ada ISO](https://github.com/ada-iso/ada_iso/) 37 | - Custom Currencies (see below) 38 | - A currency exchange (with support for an online exchange planned) 39 | - Fully overloaded functions for `+`, `-`, `/`, `*`, `<`, `>`, `>=`, `<=`, `=`, `mod`, and `abs` 40 | - Various overloaded combinations for all functions 41 | 42 | ## Installation 43 | 44 | ### With [Alire](https://alire.ada.dev/) 45 | 46 | Be sure that you're using the latest community index: 47 | ```sh 48 | alr index --update-all 49 | ``` 50 | 51 | To download and build: 52 | ```sh 53 | alr get --build cashe 54 | ``` 55 | 56 | To include it as a dependency in your Alire project: 57 | ```sh 58 | alr with cashe 59 | ``` 60 | 61 | ### Without Alire 62 | If you don't use Alire, you can just download the `ads` and `adb` files under `/src` and include them in your project. 63 | 64 | ## Usage 65 | 66 | You can also read the [full API documentation](https://aj-ianozi.github.io/Cashe/toc_index.html) which has been generated with [ROBODoc](https://github.com/gumpu/ROBODoc). 67 | 68 | ### Primitive datatypes 69 | 70 | There are several datatypes available in the `Cashe` package, used internally and accessible. 71 | 72 | ```Ada 73 | type Decimal is delta 1.0E-20 digits 38; 74 | ``` 75 | 76 | The `Decimal` data type is a fixed point decimal ranging from `-999_999_999_999_999_999.99999999999999999999` to `999_999_999_999_999_999.99999999999999999999`. You can use it in any place where a fixed point number is needed, and you can convert it with accurate precision from a floating point by doing: 77 | 78 | ```Ada 79 | with Cashe; use Cashe; 80 | -- Long_Long_Float is recommended but this supports Float and Long_Float too 81 | My_Float : constant Long_Long_Float := 14.1190004014938372284932918; 82 | Dec_Full : constant Decimal := To_Decimal (My_Float); -- 14.11900040149383722880 83 | Dec3 : constant Decimal := To_Decimal (My_Float, 3); -- 14.11900000000000000000 84 | Dec2 : constant Decimal := To_Decimal (My_Float, 2); -- 14.12000000000000000000 85 | ``` 86 | 87 | The `Decimal_Major` and `Decimal_Minor` datatypes are simply subtypes of `Long_Long_Integer` and `Long_Long_Long_Integer` respectively to restrict values being handled and major and minor units. 88 | 89 | ```Ada 90 | -- integer number, ranging from: 91 | -- -999_999_999_999_999_999 to 92 | -- 999_999_999_999_999_999 93 | -- Used for setting major units without precision. 94 | subtype Decimal_Major is Long_Long_Integer 95 | range -(1E+18 - 1) .. +(1E+18 - 1); 96 | -- 128-bit integer number, ranging from: 97 | -- -99_999_999_999_999_999_999_999_999_999_999_999_999 to 98 | -- 99_999_999_999_999_999_999_999_999_999_999_999_999 99 | -- Used for setting / accessing minor units 100 | subtype Decimal_Minor is Long_Long_Long_Integer 101 | range -(1E+38 - 1) .. +(1E+38 - 1); 102 | ``` 103 | 104 | ### Currency 105 | 106 | You can utilize not only Ada ISO currencies, but you can also utilize custom currencies in package `Cashe.Currency_Handling`, defining symbols, codes, and minor units (precision) using `Create`. Everything is stored as a wide_wide_string for friendly compatibility with VSS. 107 | 108 | ```Ada 109 | with ISO.Currencies; 110 | with Cashe; use Cashe; 111 | with Cashe.Currency_Handling; use Cashe.Currency_Handling; 112 | -- Create some custom currencies. 113 | King_Currency : constant Custom_Currency := 114 | Create (Code => "AJ", Minor_Unit => 2, 115 | Name => "AJ Currency", Symbol => "👑"); 116 | Bitcoin : constant Custom_Currency := 117 | Create (Code => "BTC", Minor_Unit => 8, 118 | Name => "Bitcoin", Symbol => "฿"); 119 | Ethereum : constant Custom_Currency := 120 | Create (Code => "ETH", Minor_Unit => 18, 121 | Name => "Ether", Symbol => "Ξ"); 122 | Cardano : constant Custom_Currency := 123 | Create (Code => "ADA", Minor_Unit => 15, 124 | Name => "Cardano", Symbol => "₳"); 125 | RadCur : constant Custom_Currency := 126 | Create (Code => "RAD", Minor_Unit => 0, 127 | Name => "Rad Currency", Symbol => "☢"); 128 | USD : constant ISO.Currencies.Currency := 129 | ISO.Currencies.From_Code ("USD"); 130 | ``` 131 | 132 | ### Money 133 | 134 | Money is an immutable datatype found in the package `Cashe.Money_Handling` that can be created and stored (or just created on the spot) using various combinations of `From_Major` and `From_Minor`: 135 | 136 | ```Ada 137 | A_Float : Long_Long_Float := 14.1190004014938372284932918; 138 | Test_US0 : Money := From_Major ("-2000.005", "USD"); 139 | Test_US1 : Money := From_Major (875.00, "USD"); 140 | Test_US2 : Money := From_Minor (87500, "USD"); 141 | Test_US3 : Money := From_Major (0.0, "USD"); 142 | Test_YEN : Money := From_Major ("12345", "JPY"); 143 | Test_EU1 : Money := From_Major (2489.00, "EUR"); 144 | Test_EU2 : Money := From_Minor (248500, "EUR"); 145 | Test_AUD : Money := From_Major (-50, "AUD"); 146 | Test_OMR : Money := From_Minor (9383314, "OMR"); 147 | Test_BTC : Money := From_Minor (5000000000, Bitcoin); 148 | Test_Wei : Money := From_Minor (1000000000000000000, Ethereum); 149 | Test_We2 : Money := Test_Wei.Round; 150 | Test_RAD : Money := From_Major (1234, Radio); 151 | Test_ADA : Money := From_Major (45678.123456789098765, Cardano); 152 | -- Be aware that there's no From_Major for floats. You choose your precision! 153 | Test_US4 : Money := From_Major (To_Decimal (A_Float, 2), "USD"); 154 | ``` 155 | 156 | There's several functions that you can utilize to get data about the money after it's been created, such as: 157 | 158 | ```Ada 159 | function Same_Currency (This : Money; Item : Money) return Boolean; 160 | function Is_Custom_Currency (This : Money) return Boolean; 161 | function Get_Currency (This : Money) return Currency_Handling.Currency_Data; 162 | function Currency_Name (This : Money) return Wide_Wide_String; 163 | function Currency_Code (This : Money) return Wide_Wide_String; 164 | function Currency_Symbol (This : Money) return Wide_Wide_String; 165 | function Currency_Unit (This : Money) return Natural; 166 | function Is_Zero (This : Money) return Boolean; 167 | function Is_Positive (This : Money) return Boolean; 168 | function Is_Negative (This : Money) return Boolean; 169 | function Round (This : Money; By : Natural; Method : Round_Method := Half_Even) return Money; 170 | function Full_Precision (This : Money) return Decimal; 171 | function As_Major (This : Money) return Decimal; 172 | function As_Minor (This : Money) return Decimal_Minor; 173 | ``` 174 | 175 | As shown previously, you can print the money in its standard precision using the `'Image`: 176 | 177 | ```Ada 178 | Put_Line (Test_US0'Image); -- "$-2000.00" 179 | ``` 180 | 181 | If the symbol is not available, it will default to a universal currency symbol. 182 | 183 | You can compare money using all of the standard comparison operators, which also support Money to Money, Money to Decimal, or Money to Integer, so checking if a value is greater than or equal to $10.00 is as easy as `if My_Money >= 10 then`. 184 | 185 | When comparing Money, the operators will round via Banker's Rounding to the exact unit type the money is defined on, so you must call `.Full_Precision` to retrieve the complete precision. 186 | 187 | ```Ada 188 | -- Test fuzzy equality 189 | declare 190 | USD : Money := From_Major (7.22, "USD"); 191 | USD2 : Money := From_Minor (777, "USD"); 192 | begin 193 | USD := USD + 0.55; 194 | Assert (USD = 7.77); 195 | USD := USD - 0.0001; 196 | Assert (USD = 7.77); 197 | Assert (USD = USD2); 198 | USD := USD - 0.004; 199 | Assert (USD = 7.77); 200 | USD := USD - 0.001; 201 | Assert (USD = 7.76); 202 | USD := USD * 77.555321; 203 | Assert (USD = 602.21); 204 | Assert (USD.Full_Precision = 602.2093120329); 205 | end; 206 | ``` 207 | 208 | ### Currency Exchange 209 | 210 | *Coming soon: Online exchange support!* 211 | 212 | The `Currency_Exchange` type found in package `Cashe.Exchange` is a table where you can set and later retrieve exchange rates. For example, assuming the exchange rate between USD and EUR was 0.5: 213 | 214 | ```Ada 215 | declare 216 | My_Exchange : Currency_Exchange; 217 | begin 218 | My_Exchange.Set_Rate ("USD", "GBP", 0.5); 219 | end; 220 | ``` 221 | 222 | You can now convert between USD and GBP by doing: 223 | 224 | ```Ada 225 | -- Creates £ 50.00 from $100.00 USD. 226 | New_Money : Money := My_Exchange.Convert (From_Minor (100_00, "USD"), "GBP"); 227 | ``` 228 | 229 | By default, the exchange rate will allow calculating the reverse of the exchange rate; however, if you provide an explicit rate, that will override it: 230 | 231 | ```Ada 232 | -- Prints "$ 200.00", extraploating from the previous assignment 233 | Put_Line (My_Exchange.Convert (From_Minor (100_00, "GBP"), "USD")'Image); 234 | My_Exchange.Set_Rate ("GBP", "USD", 0.77); 235 | -- Prints "$ 77.00" 236 | Put_Line (My_Exchange.Convert (From_Minor (100_00, "GBP"), "USD")'Image); 237 | -- This does not overrwrite the explicitaly set "other way around" 238 | -- This still prints "£ 50.00": 239 | Put_Line (My_Exchange.Convert (From_Minor (100_00, "USD"), "GBP")'Image); 240 | ``` 241 | 242 | You can also set a "base currency" for your currency exchange if you're always going to be falling back to a base unit. 243 | 244 | ```Ada 245 | declare 246 | US_Exchange : Currency_Exchange; 247 | begin 248 | US_Exchange.Set_Base ("USD"); 249 | US_Exchange.Set_Rate ("GBP", 0.5); 250 | US_Exchange.Set_Rate (Bitcoin, 0.0000331163); 251 | end; 252 | ``` 253 | 254 | You also have functions like `In_Exchange` to verify if some set of currencies are in the exchange, `Rate` to retrieve the actual exchange rate and `Base_Is_Set` to find out if you have set a base on that exchange. 255 | 256 | I'll work writing the full documentation for the API next, but I hope that gives you an example of what this has to offer! 257 | 258 | ## Contribute 259 | 260 | Feel free to open an issue if you find any bugs or comment if you have any comments or enhancements. I tried to catch everything with my unit tests, but I may have missed something. 261 | -------------------------------------------------------------------------------- /src/cashe-money_handling.adb: -------------------------------------------------------------------------------- 1 | with Ada.Characters.Conversions; 2 | with Ada.Strings.Wide_Wide_Fixed; 3 | package body Cashe.Money_Handling is 4 | 5 | function Same_Currency 6 | (This : Money; Item : Money) 7 | return Boolean is 8 | use Currency_Handling; 9 | begin 10 | return This.Cur = Item.Cur; 11 | end Same_Currency; 12 | function Is_Custom_Currency (This : Money) return Boolean is 13 | use Currency_Handling; 14 | begin 15 | return This.Cur.Which_Currency_Type = Type_Custom_Currency; 16 | end Is_Custom_Currency; 17 | function Get_Currency 18 | (This : Money) return Currency_Handling.Currency_Data is 19 | (This.Cur); 20 | function Currency_Name (This : Money) return Wide_Wide_String is 21 | use Currency_Handling; 22 | use Ada.Characters.Conversions; 23 | begin 24 | case This.Cur.Which_Currency_Type is 25 | when Type_Custom_Currency => 26 | return This.Cur.Custom_Code.Name; 27 | when Type_ISO_Currency => 28 | return To_Wide_Wide_String (This.Cur.ISO_Code.Name); 29 | end case; 30 | end Currency_Name; 31 | function Currency_Code (This : Money) return Wide_Wide_String is 32 | use Currency_Handling; 33 | use Ada.Characters.Conversions; 34 | begin 35 | case This.Cur.Which_Currency_Type is 36 | when Type_Custom_Currency => 37 | return This.Cur.Custom_Code.Code; 38 | when Type_ISO_Currency => 39 | return To_Wide_Wide_String (This.Cur.ISO_Code.Code); 40 | end case; 41 | end Currency_Code; 42 | function Currency_Symbol (This : Money) return Wide_Wide_String is 43 | use Currency_Handling; 44 | begin 45 | case This.Cur.Which_Currency_Type is 46 | when Type_Custom_Currency => return This.Cur.Custom_Code.Symbol; 47 | when Type_ISO_Currency => return This.Cur.ISO_Code.Symbol; 48 | end case; 49 | end Currency_Symbol; 50 | function Currency_Unit (This : Money) return Natural is 51 | use Currency_Handling; 52 | begin 53 | case This.Cur.Which_Currency_Type is 54 | when Type_Custom_Currency => return This.Cur.Custom_Code.Unit; 55 | when Type_ISO_Currency => return This.Cur.ISO_Code.Unit; 56 | end case; 57 | end Currency_Unit; 58 | function Is_Zero (This : Money) return Boolean is (This.Amount = 0.0); 59 | function Is_Positive (This : Money) return Boolean is (This.Amount > 0.0); 60 | function Is_Negative (This : Money) return Boolean is (This.Amount < 0.0); 61 | function Round 62 | (This : Money; 63 | By : Natural; 64 | Method : Round_Method := Half_Even) 65 | return Money 66 | is ((Amount => Round (This.Amount, By, Method), Cur => This.Cur)); 67 | function Round (This : Money; Method : Round_Method := Half_Even) 68 | return Money is 69 | (This.Round (By => This.Currency_Unit, Method => Method)); 70 | function Full_Precision (This : Money) return Decimal is (This.Amount); 71 | function As_Major (This : Money) return Decimal is (This.Round.Amount); 72 | function As_Minor (This : Money) return Decimal_Minor 73 | is 74 | use Currency_Handling; 75 | Multiplier : constant Long_Long_Float := 10.0 ** 76 | (case This.Cur.Which_Currency_Type is 77 | when Type_Custom_Currency => This.Cur.Custom_Code.Unit, 78 | when Type_ISO_Currency => This.Cur.ISO_Code.Unit); 79 | begin 80 | return Decimal_Minor 81 | (Decimal'Round 82 | (Long_Long_Float (This.Round.Amount) * Multiplier)); 83 | end As_Minor; 84 | 85 | -- Operator overloading 86 | function "+" (Left, Right : Money) return Money is 87 | (if Left.Same_Currency (Right) then 88 | (Amount => Left.Amount + Right.Amount, Cur => Left.Cur) 89 | else raise Currency_Mismatch); 90 | function "+" (Left : Money; Right : Decimal) return Money is 91 | ((Amount => Left.Amount + Right, Cur => Left.Cur)); 92 | function "+" (Left : Money; Right : Decimal_Minor) return Money is 93 | (Left + Decimal (Right)); 94 | 95 | function "-" (Left : Money) return Money is 96 | ((Amount => -(Left.Amount), Cur => Left.Cur)); 97 | function "-" (Left, Right : Money) return Money is 98 | (if Left.Same_Currency (Right) then 99 | (Amount => Left.Amount - Right.Amount, Cur => Left.Cur) 100 | else raise Currency_Mismatch); 101 | function "-" (Left : Money; Right : Decimal) return Money is 102 | ((Amount => Left.Amount - Right, Cur => Left.Cur)); 103 | function "-" (Left : Money; Right : Decimal_Minor) return Money is 104 | (Left - Decimal (Right)); 105 | 106 | function "*" (Left, Right : Money) return Money is 107 | (if Left.Same_Currency (Right) then 108 | (Amount => Left.Amount * Right.Amount, Cur => Left.Cur) 109 | else raise Currency_Mismatch); 110 | function "*" (Left : Money; Right : Decimal) return Money is 111 | ((Amount => Left.Amount * Right, Cur => Left.Cur)); 112 | function "*" (Left : Money; Right : Decimal_Minor) return Money is 113 | (Left * Decimal (Right)); 114 | 115 | function "/" (Left, Right : Money) return Money is 116 | (if Left.Same_Currency (Right) then 117 | (if not Right.Is_Zero then 118 | (Amount => Left.Amount / Right.Amount, Cur => Left.Cur) 119 | else raise Division_By_Zero) 120 | else raise Currency_Mismatch); 121 | function "/" (Left : Money; Right : Decimal) return Money is 122 | ((Amount => Left.Amount / Right, Cur => Left.Cur)); 123 | function "/" (Left : Money; Right : Decimal_Minor) return Money is 124 | (Left / Decimal (Right)); 125 | 126 | function "abs" (Left : Money) return Money is 127 | ((Amount => abs Left.Amount, Cur => Left.Cur)); 128 | 129 | -- Logical stuff. 130 | function "<" (Left, Right : Money) return Boolean is 131 | (if Left.Same_Currency (Right) then 132 | (Left.Amount < Right.Amount) or else 133 | raise Currency_Mismatch); 134 | function ">" (Left, Right : Money) return Boolean is 135 | (if Left.Same_Currency (Right) then 136 | (Left.Amount > Right.Amount) or else 137 | raise Currency_Mismatch); 138 | function "<=" (Left, Right : Money) return Boolean is 139 | (if Left.Same_Currency (Right) then 140 | (Left.Amount <= Right.Amount) or else 141 | raise Currency_Mismatch); 142 | function ">=" (Left, Right : Money) return Boolean is 143 | (if Left.Same_Currency (Right) then 144 | (Left.Amount >= Right.Amount) or else 145 | raise Currency_Mismatch); 146 | overriding function "=" (Left : Money; Right : Money) return Boolean is 147 | begin 148 | return Left.Same_Currency (Right) and then 149 | Left.Round.Amount = Right.Round.Amount; 150 | end "="; 151 | 152 | function "<" (Left : Money; Right : Decimal) return Boolean is 153 | (Left.Amount < Right); 154 | function ">" (Left : Money; Right : Decimal) return Boolean is 155 | (Left.Amount > Right); 156 | function "<=" (Left : Money; Right : Decimal) return Boolean is 157 | (Left.Amount <= Right); 158 | function ">=" (Left : Money; Right : Decimal) return Boolean is 159 | (Left.Amount >= Right); 160 | function "=" (Left : Money; Right : Decimal) return Boolean is 161 | (Left.Round.Amount = Right); 162 | 163 | function "<" (Left : Money; Right : Decimal_Major) return Boolean is 164 | (Left.Amount < Decimal (Right)); 165 | function ">" (Left : Money; Right : Decimal_Major) return Boolean is 166 | (Left.Amount > Decimal (Right)); 167 | function "<=" (Left : Money; Right : Decimal_Major) return Boolean is 168 | (Left.Amount <= Decimal (Right)); 169 | function ">=" (Left : Money; Right : Decimal_Major) return Boolean is 170 | (Left.Amount >= Decimal (Right)); 171 | function "=" (Left : Money; Right : Decimal_Major) return Boolean is 172 | (Left.Round.Amount = Decimal (Right)); 173 | -- Creation functions 174 | -- Major Decimals 175 | function From_Major 176 | (Amount : Decimal; 177 | Currency_Used : Currency_Handling.Currency_Data) 178 | return Money is 179 | (((Amount => Amount, 180 | Cur => Currency_Used))); 181 | function From_Major 182 | (Amount : Decimal; 183 | Currency_Used : Currency_Handling.Custom_Currency) 184 | return Money is 185 | use Currency_Handling; 186 | CC : constant Currency_Data := (Type_Custom_Currency, Currency_Used); 187 | begin 188 | return From_Major (Amount, CC); 189 | end From_Major; 190 | function From_Major 191 | (Amount : Decimal; 192 | Currency_Used : ISO.Currencies.Currency) 193 | return Money is 194 | use Currency_Handling; 195 | CC : constant Currency_Data := (Type_ISO_Currency, Currency_Used); 196 | begin 197 | return From_Major (Amount, CC); 198 | end From_Major; 199 | function From_Major 200 | (Amount : Decimal; 201 | Currency_Used : ISO.Currencies.Alphabetic_Code) 202 | return Money is 203 | (From_Major (Amount, ISO.Currencies.From_Code (Currency_Used))); 204 | -- Major Long_Long_Ints 205 | function From_Major 206 | (Amount : Decimal_Major; 207 | Currency_Used : Currency_Handling.Currency_Data) 208 | return Money is (From_Major (Decimal (Amount), Currency_Used)); 209 | function From_Major 210 | (Amount : Decimal_Major; 211 | Currency_Used : Currency_Handling.Custom_Currency) 212 | return Money is (From_Major (Decimal (Amount), Currency_Used)); 213 | function From_Major 214 | (Amount : Decimal_Major; 215 | Currency_Used : ISO.Currencies.Currency) 216 | return Money is (From_Major (Decimal (Amount), Currency_Used)); 217 | function From_Major 218 | (Amount : Decimal_Major; 219 | Currency_Used : ISO.Currencies.Alphabetic_Code) 220 | return Money is (From_Major (Decimal (Amount), Currency_Used)); 221 | -- Major - Strings 222 | function From_Major 223 | (Amount : String; 224 | Currency_Used : Currency_Handling.Currency_Data) 225 | return Money is (From_Major (Decimal'Value (Amount), Currency_Used)); 226 | function From_Major 227 | (Amount : String; 228 | Currency_Used : Currency_Handling.Custom_Currency) 229 | return Money is (From_Major (Decimal'Value (Amount), Currency_Used)); 230 | function From_Major 231 | (Amount : String; 232 | Currency_Used : ISO.Currencies.Currency) 233 | return Money is (From_Major (Decimal'Value (Amount), Currency_Used)); 234 | function From_Major 235 | (Amount : String; 236 | Currency_Used : ISO.Currencies.Alphabetic_Code) 237 | return Money is (From_Major (Decimal'Value (Amount), Currency_Used)); 238 | -- Minor - Decimals 239 | function From_Minor 240 | (Amount : Decimal_Minor; 241 | Currency_Used : Currency_Handling.Currency_Data) 242 | return Money 243 | is 244 | use Currency_Handling; 245 | Unit : constant Natural := 246 | (case Currency_Used.Which_Currency_Type is 247 | when Type_Custom_Currency => 248 | Currency_Used.Custom_Code.Unit, 249 | when Type_ISO_Currency => 250 | Currency_Used.ISO_Code.Unit); 251 | Amount_Width : constant Natural := Integer_Width (Amount); 252 | True_Amount : constant Decimal := 253 | (if Amount_Width - Max_Integer_Len <= Unit then 254 | To_Decimal (Amount, Unit) 255 | else raise Minor_Unit_Too_Large); 256 | begin 257 | return From_Major (True_Amount, Currency_Used); 258 | end From_Minor; 259 | function From_Minor 260 | (Amount : Decimal_Minor; 261 | Currency_Used : Currency_Handling.Custom_Currency) 262 | return Money 263 | is 264 | use Currency_Handling; 265 | CC : constant Currency_Data := (Type_Custom_Currency, Currency_Used); 266 | begin 267 | return From_Minor (Amount, CC); 268 | end From_Minor; 269 | function From_Minor 270 | (Amount : Decimal_Minor; 271 | Currency_Used : ISO.Currencies.Currency) 272 | return Money 273 | is 274 | use Currency_Handling; 275 | CC : constant Currency_Data := (Type_ISO_Currency, Currency_Used); 276 | begin 277 | return From_Minor (Amount, CC); 278 | end From_Minor; 279 | function From_Minor 280 | (Amount : Decimal_Minor; 281 | Currency_Used : ISO.Currencies.Alphabetic_Code) 282 | return Money is 283 | (From_Minor (Amount, ISO.Currencies.From_Code (Currency_Used))); 284 | -- Minor - String 285 | function From_Minor 286 | (Amount : String; 287 | Currency_Used : Currency_Handling.Currency_Data) 288 | return Money is (From_Minor (Decimal_Minor'Value (Amount), Currency_Used)); 289 | function From_Minor 290 | (Amount : String; 291 | Currency_Used : Currency_Handling.Custom_Currency) 292 | return Money is (From_Minor (Decimal_Minor'Value (Amount), Currency_Used)); 293 | function From_Minor 294 | (Amount : String; 295 | Currency_Used : ISO.Currencies.Currency) 296 | return Money is (From_Minor (Decimal_Minor'Value (Amount), Currency_Used)); 297 | function From_Minor 298 | (Amount : String; 299 | Currency_Used : ISO.Currencies.Alphabetic_Code) 300 | return Money is (From_Minor (Decimal_Minor'Value (Amount), Currency_Used)); 301 | 302 | procedure Print_Money 303 | (Buffer : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; 304 | Value : Money) 305 | is 306 | use ISO.Currencies; 307 | use Currency_Handling; 308 | use Ada.Strings.Wide_Wide_Fixed; 309 | Unit : constant Natural := 310 | (case Value.Cur.Which_Currency_Type is 311 | when Type_Custom_Currency => Value.Cur.Custom_Code.Unit, 312 | when Type_ISO_Currency => Value.Cur.ISO_Code.Unit); 313 | Amt : constant Wide_Wide_String := 314 | Value.Round.Amount'Wide_Wide_Image; 315 | Point : constant Natural := Index (Amt, "."); 316 | begin 317 | Buffer.Wide_Wide_Put 318 | (Value.Currency_Symbol & Amt (Amt'First .. Point - 1)); 319 | if Unit > 0 then 320 | Buffer.Wide_Wide_Put (Amt (Point .. Point + Unit)); 321 | end if; 322 | end Print_Money; 323 | 324 | end Cashe.Money_Handling; -------------------------------------------------------------------------------- /tests/src/cashe_money_tests.adb: -------------------------------------------------------------------------------- 1 | pragma Ada_2022; 2 | with Ada.Text_IO; use Ada.Text_IO; 3 | with Ada.Assertions; use Ada.Assertions; 4 | with Cashe; use Cashe; 5 | with ISO.Currencies; use ISO.Currencies; 6 | with Cashe.Money_Handling; use Cashe.Money_Handling; 7 | with Cashe.Currency_Handling; use Cashe.Currency_Handling; 8 | with Ada.Containers.Vectors; 9 | with Ada.Characters.Conversions; use Ada.Characters.Conversions; 10 | package body Cashe_Money_Tests is 11 | -- Create a list of money. 12 | package Money_List is new 13 | Ada.Containers.Vectors 14 | (Index_Type => Natural, 15 | Element_Type => Money); 16 | use Money_List; 17 | procedure Run_Tests is 18 | 19 | -- Create some custom currencies. 20 | King_Currency : constant Custom_Currency := 21 | Create (Code => "AJ", Minor_Unit => 2, 22 | Name => "AJ Currency", Symbol => "👑"); 23 | Bitcoin : constant Custom_Currency := 24 | Create (Code => "BTC", Minor_Unit => 8, 25 | Name => "Bitcoin", Symbol => "฿"); 26 | Ethereum : constant Custom_Currency := 27 | Create (Code => "ETH", Minor_Unit => 18, 28 | Name => "Ether", Symbol => "Ξ"); 29 | Cardano : constant Custom_Currency := 30 | Create (Code => "ADA", Minor_Unit => 15, 31 | Name => "Cardano", Symbol => "₳"); 32 | RadCur : constant Custom_Currency := 33 | Create (Code => "RAD", Minor_Unit => 0, 34 | Name => "Rad Currency", Symbol => "☢"); 35 | USD : constant ISO.Currencies.Currency := 36 | ISO.Currencies.From_Code ("USD"); 37 | 38 | 39 | 40 | -- Create some money. 41 | Test_KN1 : Money := From_Major (9001.99, King_Currency); 42 | Test_KN2 : constant Money := From_Minor (900999, King_Currency); 43 | Test_US0 : constant Money := From_Major ("-2000.005", "USD"); 44 | Test_US1 : constant Money := From_Major (875.00, "USD"); 45 | Test_US2 : constant Money := From_Minor (87500, "USD"); 46 | Test_US3 : constant Money := From_Major (0.0, USD); 47 | Test_US4 : constant Money := From_Minor (0, USD); 48 | Test_YEN : constant Money := From_Major ("12345", "JPY"); 49 | Test_EU1 : constant Money := From_Major (2489.00, "EUR"); 50 | Test_EU2 : constant Money := From_Minor (248500, "EUR"); 51 | Test_AUD : constant Money := From_Major (-50, "AUD"); 52 | Test_OMR : constant Money := From_Minor (9383314, "OMR"); 53 | Test_BTC : constant Money := From_Minor (5000000000, Bitcoin); 54 | Test_Wei : constant Money := From_Minor (1000000000000000000, Ethereum); 55 | Test_We2 : constant Money := Test_Wei.Round; 56 | Test_RAD : constant Money := From_Major (1234, RadCur); 57 | Test_ADA : constant Money := From_Major (45678.123456789098765, Cardano); 58 | 59 | Every_ISO : constant ISO.Currencies.All_Currencies := 60 | ISO.Currencies.Init_Currencies; 61 | 62 | -- Test Items 63 | Item_Dec : constant Decimal := 123456789.0; 64 | Item_Int : constant Decimal_Major := 123456789; 65 | Item_Big : constant Decimal_Minor := 123456789; 66 | Item_Str : constant String := "123456789.0"; 67 | Item_IStr : constant String := "123456789"; 68 | 69 | begin 70 | -- Verify overloaded operations. 71 | Assert (Test_US1 = Test_US2); 72 | Assert (Test_US1 <= Test_US2); 73 | Assert (Test_US1 >= Test_US2); 74 | Assert (Test_US3 = Test_US4); 75 | Assert (Test_US0 < Test_US1); 76 | Assert (Test_US0 < Test_US1); 77 | Assert (Test_US0 < From_Major ("-2000.00", USD)); 78 | Assert (Test_US0 <= Test_US1); 79 | Assert (Test_US1 > Test_US0); 80 | Assert (Test_US1 >= Test_US0); 81 | 82 | Assert (Test_US1 = 875); 83 | Assert (not (Test_US1 > 900)); 84 | Assert (Test_US1 >= 875); 85 | Assert (Test_US0 < 900); 86 | Assert (Test_US4 <= 0); 87 | 88 | Assert (Test_YEN = From_Major (12345, "JPY")); 89 | Assert (Test_YEN = From_Minor (12345, "JPY")); 90 | 91 | Assert (Test_US1 = 875.00); 92 | Assert (not (Test_US1 > 900.00)); 93 | Assert (Test_US1 >= 875.00); 94 | Assert (Test_US0 < 900.00); 95 | Assert (Test_US4 <= 0.0); 96 | 97 | Assert (abs Test_AUD = 50); 98 | Assert (abs Test_US4.As_Minor = 0); 99 | 100 | Assert ((Test_US1 + Test_US2) = 1750); 101 | Assert ((Test_US1 + 875) = 1750); 102 | Assert ((Test_US1 + 875.00) = 1750); 103 | 104 | Assert ((Test_US1 + Test_US2) = 1750.00); 105 | Assert ((Test_US1 + 875) = 1750.00); 106 | Assert ((Test_US1 + 875.00) = 1750.00); 107 | Assert ((From_Major (875.00, "USD") + 0.001) = 875.00); 108 | 109 | Assert ((Test_KN2 - Test_KN1) = 8); 110 | 111 | Assert ((Test_KN2 - 9001.99) = 8); 112 | Assert ((Test_KN2 - 9001) = 8.99); 113 | 114 | -- Test values 115 | Assert (Test_KN1'Image = "👑 9001.99"); 116 | Assert (Test_US1'Image = "$ 875.00"); 117 | Assert (Test_AUD'Image = "$-50.00"); 118 | 119 | Assert (Test_US0.Full_Precision = -2000.005); 120 | Assert (Test_US1.As_Major = 875.00); 121 | Assert (Test_US1.As_Minor = 87500); 122 | Assert (Test_KN1.As_Minor = 900199); 123 | Assert (Test_KN2.As_Major = 9009.99); 124 | 125 | -- Test Postiive and 126 | Assert (Test_US1.Same_Currency (Test_US2)); 127 | Assert (Test_KN2.Same_Currency (Test_KN1)); 128 | Assert (not Test_US1.Same_Currency (Test_KN1)); 129 | Assert (not Test_US1.Same_Currency (Test_YEN)); 130 | -- Custom currency 131 | Assert (not Test_US1.Is_Custom_Currency); 132 | Assert (Test_KN1.Is_Custom_Currency); 133 | -- Get currency data. 134 | declare 135 | My_Currency_Data1 : constant Currency_Data := 136 | Test_US1.Get_Currency; 137 | My_Currency_Data2 : constant Currency_Data := 138 | Test_KN1.Get_Currency; 139 | begin 140 | Assert 141 | (My_Currency_Data1.ISO_Code = USD); 142 | Assert (My_Currency_Data2.Custom_Code = King_Currency); 143 | end; 144 | -- Assert name and code. 145 | 146 | -- Rounding 147 | Assert (Test_US0.Round (2) = From_Major (-2000.00, USD)); 148 | Assert (Test_US0.Round (2, Half_Up) = From_Major (-2000.01, USD)); 149 | Assert (Test_US0.As_Major = -2000.00); 150 | Assert (Test_US0.As_Minor = -200000); 151 | 152 | -- Testing max minor unit values 153 | declare 154 | C : constant Custom_Currency := Create ("IDK", 20); 155 | CD : constant Currency_Data := (Type_Custom_Currency, C); 156 | C_1 : constant Money := From_Minor (Decimal_Minor'Last, C); 157 | C_2 : constant Money := From_Minor (Decimal_Minor'Last'Image, CD); 158 | begin 159 | Assert (C_1 = C_2); 160 | Assert (C_1.Full_Precision = 999999999999999999.99999999999999999999); 161 | end; 162 | 163 | -- Test fuzzy equality 164 | declare 165 | Mut : Money := From_Major (7.22, "USD"); 166 | Mut2 : Money := From_Minor (777, "USD"); 167 | begin 168 | Mut := Mut + 0.55; 169 | Assert (Mut = 7.77); 170 | Mut := Mut - 0.0001; 171 | Assert (Mut = 7.77); 172 | Mut := Mut - 0.004; 173 | Assert (Mut = 7.77); 174 | Assert (Mut = Mut2); 175 | Mut := Mut - 0.001; 176 | Assert (Mut = 7.76); 177 | Mut := Mut * 77.555321; 178 | Assert (Mut = 602.21); 179 | Assert (Mut.Full_Precision = 602.2093120329); 180 | end; 181 | -- Create ISO currency of every currence. 182 | for C of Every_ISO loop 183 | declare 184 | CD : constant Currency_Data := (Type_ISO_Currency, C); 185 | Major_List : Money_List.Vector; 186 | Minor_List : Money_List.Vector; 187 | 188 | Ref : constant Money := From_Major (Item_Dec, C); 189 | begin 190 | -- Quick tests 191 | declare 192 | C_0 : constant Money := From_Major (0.0, C); 193 | C_1 : constant Money := From_Major (Decimal_Major'Last, C); 194 | C_2 : constant Money := From_Minor (1234567890, C); 195 | C_3 : constant Money := From_Major (1234567890, C.Code); 196 | C_4 : constant Money := From_Minor ("1234567890", C.Code); 197 | C_5 : constant Money := From_Major (1234567890, CD); 198 | C_6 : constant Money := From_Minor ("1234567890", CD); 199 | begin 200 | Assert (C_0.Is_Zero); 201 | end; 202 | 203 | -- From_Major - decimal 204 | Major_List.Append (From_Major (Item_Dec, C)); 205 | Major_List.Append (From_Major (Item_Dec, CD)); 206 | Major_List.Append (From_Major (Item_Dec, C.Code)); 207 | -- From_Major - Decimal_Minor 208 | Major_List.Append (From_Major (Item_Int, C)); 209 | Major_List.Append (From_Major (Item_Int, CD)); 210 | Major_List.Append (From_Major (Item_Int, C.Code)); 211 | -- From_Major - string 212 | Major_List.Append (From_Major (Item_Str, C)); 213 | Major_List.Append (From_Major (Item_Str, CD)); 214 | Major_List.Append (From_Major (Item_Str, C.Code)); 215 | -- From_Minor - Decimal_Minor 216 | Minor_List.Append (From_Minor (Item_Big, C)); 217 | Minor_List.Append (From_Minor (Item_Big, CD)); 218 | Minor_List.Append (From_Minor (Item_Big, C.Code)); 219 | -- From_Minor - string 220 | Minor_List.Append (From_Minor (Item_IStr, C)); 221 | Minor_List.Append (From_Minor (Item_IStr, CD)); 222 | Minor_List.Append (From_Minor (Item_IStr, C.Code)); 223 | 224 | Assert (for all M of Major_List => M.Is_Positive); 225 | Assert (for all M of Major_List => not M.Is_Negative); 226 | Assert (for all M of Major_List => not M.Is_Custom_Currency); 227 | Assert (for all M of Major_List => not M.Is_Zero); 228 | Assert (for all M of Major_List => M.Same_Currency (Ref)); 229 | Assert (for all M of Major_List => 230 | M.Currency_Name = To_Wide_Wide_String (C.Name)); 231 | Assert (for all M of Major_List => 232 | M.Currency_Code = To_Wide_Wide_String (C.Code)); 233 | Assert (for all M of Major_List => M.Currency_Symbol = C.Symbol); 234 | Assert (for all M of Major_List => M.Currency_Unit = C.Unit); 235 | 236 | Assert (for all M of Minor_List => M.Is_Positive); 237 | Assert (for all M of Minor_List => not M.Is_Negative); 238 | Assert (for all M of Minor_List => not M.Is_Custom_Currency); 239 | Assert (for all M of Minor_List => not M.Is_Zero); 240 | Assert (for all M of Minor_List => M.Same_Currency (Ref)); 241 | Assert (for all M of Minor_List => 242 | M.Currency_Name = To_Wide_Wide_String (C.Name)); 243 | Assert (for all M of Minor_List => 244 | M.Currency_Code = To_Wide_Wide_String (C.Code)); 245 | Assert (for all M of Minor_List => M.Currency_Symbol = C.Symbol); 246 | Assert (for all M of Minor_List => M.Currency_Unit = C.Unit); 247 | 248 | end; 249 | end loop; 250 | -- Create custom currency and money of every precision. 251 | for I in 0 .. Cashe.Max_Precision loop 252 | declare 253 | -- Custom currency of this minor unit. 254 | C : constant Custom_Currency := 255 | Create (I'Wide_Wide_Image, I, 256 | "Currency " & I'Wide_Wide_Image, "$"); 257 | CD : constant Currency_Data := (Type_Custom_Currency, C); 258 | Major_List : Money_List.Vector; 259 | Minor_List : Money_List.Vector; 260 | 261 | Ref : constant Money := From_Major (Item_Dec, C); 262 | begin 263 | -- Quick tests 264 | declare 265 | Last_Long : constant Decimal_Major := Decimal_Major'Last; 266 | C_0 : constant Money := From_Major (0.0, C); 267 | C_1 : constant Money := From_Major (Last_Long, C); 268 | C_2 : constant Money := From_Minor (1234567890, C); 269 | C_5 : constant Money := From_Major (Last_Long, CD); 270 | C_6 : constant Money := From_Minor ("1234567890", CD); 271 | begin 272 | Assert (C_0.Is_Zero); 273 | end; 274 | 275 | -- From_Major - decimal 276 | Major_List.Append (From_Major (Item_Dec, C)); 277 | Major_List.Append (From_Major (Item_Dec, CD)); 278 | -- From_Major - Decimal_Minor 279 | Major_List.Append (From_Major (Item_Int, C)); 280 | Major_List.Append (From_Major (Item_Int, CD)); 281 | -- From_Major - string 282 | Major_List.Append (From_Major (Item_Str, C)); 283 | Major_List.Append (From_Major (Item_Str, CD)); 284 | -- From_Minor - Decimal_Minor 285 | Minor_List.Append (From_Minor (Item_Big, C)); 286 | Minor_List.Append (From_Minor (Item_Big, CD)); 287 | -- From_Minor - string 288 | Minor_List.Append (From_Minor (Item_IStr, C)); 289 | Minor_List.Append (From_Minor (Item_IStr, CD)); 290 | 291 | Assert (for all M of Major_List => M.Is_Positive); 292 | Assert (for all M of Major_List => not M.Is_Negative); 293 | Assert (for all M of Major_List => M.Is_Custom_Currency); 294 | Assert (for all M of Major_List => not M.Is_Zero); 295 | Assert (for all M of Major_List => M.Same_Currency (Ref)); 296 | Assert (for all M of Major_List => M.Currency_Name = C.Name); 297 | Assert (for all M of Major_List => M.Currency_Code = C.Code); 298 | Assert (for all M of Major_List => M.Currency_Symbol = C.Symbol); 299 | Assert (for all M of Major_List => M.Currency_Unit = C.Unit); 300 | 301 | Assert (for all M of Minor_List => M.Is_Positive); 302 | Assert (for all M of Minor_List => not M.Is_Negative); 303 | Assert (for all M of Minor_List => M.Is_Custom_Currency); 304 | Assert (for all M of Minor_List => not M.Is_Zero); 305 | Assert (for all M of Minor_List => M.Same_Currency (Ref)); 306 | Assert (for all M of Minor_List => M.Currency_Name = C.Name); 307 | Assert (for all M of Minor_List => M.Currency_Code = C.Code); 308 | Assert (for all M of Minor_List => M.Currency_Symbol = C.Symbol); 309 | Assert (for all M of Minor_List => M.Currency_Unit = C.Unit); 310 | end; 311 | end loop; 312 | 313 | end Run_Tests; 314 | end Cashe_Money_Tests; -------------------------------------------------------------------------------- /src/cashe-exchange.adb: -------------------------------------------------------------------------------- 1 | pragma Ada_2022; 2 | with Ada.Strings.Wide_Wide_Hash; 3 | package body Cashe.Exchange is 4 | 5 | -- TODO: looks promising: https://github.com/fawazahmed0/currency-api and 6 | -- https://openexchangerates.org/ 7 | -- It will likely be moved into its own library like Cashe.Online_Exchange 8 | -- For creating exchange rates. 9 | -- Easiest just to do this. 10 | function Create 11 | (From : Currency_Handling.Currency_Data; 12 | To : ISO.Currencies.Currency; 13 | Rate : Decimal) 14 | return Exchange_Rate is 15 | ((From => From, 16 | To => (Currency_Handling.Type_ISO_Currency, To), 17 | ExRate => Rate)); 18 | function Create 19 | (From : Currency_Handling.Currency_Data; 20 | To : ISO.Currencies.Alphabetic_Code; 21 | Rate : Decimal) 22 | return Exchange_Rate is 23 | ((From => From, 24 | To => (Currency_Handling.Type_ISO_Currency, 25 | ISO.Currencies.From_Code (To)), 26 | ExRate => Rate)); 27 | function Create 28 | (From : Currency_Handling.Currency_Data; 29 | To : Currency_Handling.Custom_Currency; 30 | Rate : Decimal) 31 | return Exchange_Rate is 32 | ((From => From, 33 | To => (Currency_Handling.Type_Custom_Currency, To), 34 | ExRate => Rate)); 35 | function Create 36 | (From : ISO.Currencies.Currency; 37 | To : ISO.Currencies.Currency; 38 | Rate : Decimal) 39 | return Exchange_Rate is 40 | ((From => (Currency_Handling.Type_ISO_Currency, From), 41 | To => (Currency_Handling.Type_ISO_Currency, To), 42 | ExRate => Rate)); 43 | function Create 44 | (From : ISO.Currencies.Currency; 45 | To : Currency_Handling.Custom_Currency; 46 | Rate : Decimal) 47 | return Exchange_Rate is 48 | ((From => (Currency_Handling.Type_ISO_Currency, From), 49 | To => (Currency_Handling.Type_Custom_Currency, To), 50 | ExRate => Rate)); 51 | function Create 52 | (From : ISO.Currencies.Currency; 53 | To : ISO.Currencies.Alphabetic_Code; 54 | Rate : Decimal) 55 | return Exchange_Rate is 56 | ((From => (Currency_Handling.Type_ISO_Currency, From), 57 | To => (Currency_Handling.Type_ISO_Currency, 58 | ISO.Currencies.From_Code (To)), 59 | ExRate => Rate)); 60 | function Create 61 | (From : ISO.Currencies.Alphabetic_Code; 62 | To : ISO.Currencies.Alphabetic_Code; 63 | Rate : Decimal) 64 | return Exchange_Rate is 65 | ((From => (Currency_Handling.Type_ISO_Currency, 66 | ISO.Currencies.From_Code (From)), 67 | To => (Currency_Handling.Type_ISO_Currency, 68 | ISO.Currencies.From_Code (To)), 69 | ExRate => Rate)); 70 | function Create 71 | (From : ISO.Currencies.Alphabetic_Code; 72 | To : ISO.Currencies.Currency; 73 | Rate : Decimal) 74 | return Exchange_Rate is 75 | ((From => (Currency_Handling.Type_ISO_Currency, 76 | ISO.Currencies.From_Code (From)), 77 | To => (Currency_Handling.Type_ISO_Currency, To), 78 | ExRate => Rate)); 79 | function Create 80 | (From : ISO.Currencies.Alphabetic_Code; 81 | To : Currency_Handling.Custom_Currency; 82 | Rate : Decimal) 83 | return Exchange_Rate is 84 | ((From => (Currency_Handling.Type_ISO_Currency, 85 | ISO.Currencies.From_Code (From)), 86 | To => (Currency_Handling.Type_Custom_Currency, To), 87 | ExRate => Rate)); 88 | function Create 89 | (From : Currency_Handling.Custom_Currency; 90 | To : Currency_Handling.Custom_Currency; 91 | Rate : Decimal) 92 | return Exchange_Rate is 93 | ((From => (Currency_Handling.Type_Custom_Currency, From), 94 | To => (Currency_Handling.Type_Custom_Currency, To), 95 | ExRate => Rate)); 96 | function Create 97 | (From : Currency_Handling.Custom_Currency; 98 | To : ISO.Currencies.Currency; 99 | Rate : Decimal) 100 | return Exchange_Rate is 101 | ((From => (Currency_Handling.Type_Custom_Currency, From), 102 | To => (Currency_Handling.Type_ISO_Currency, To), 103 | ExRate => Rate)); 104 | function Create 105 | (From : Currency_Handling.Custom_Currency; 106 | To : ISO.Currencies.Alphabetic_Code; 107 | Rate : Decimal) 108 | return Exchange_Rate is 109 | ((From => (Currency_Handling.Type_Custom_Currency, From), 110 | To => (Currency_Handling.Type_ISO_Currency, 111 | ISO.Currencies.From_Code (To)), 112 | ExRate => Rate)); 113 | 114 | -- Intemediate conversion function 115 | -- Internal conversion function on exchange rate. 116 | function Internal_Convert 117 | (This : Exchange_Rate; 118 | From : Money_Handling.Money) 119 | return Money_Handling.Money is 120 | use Money_Handling; 121 | use Currency_Handling; 122 | begin 123 | -- If from is the same currency we need, return the inverse. 124 | -- This shouldn't really happen, but it MIGHT. 125 | if From.Get_Currency = This.From then 126 | return From_Major (From.As_Major * This.ExRate, This.To); 127 | elsif From.Get_Currency = This.To then 128 | return From_Major 129 | (From.As_Major * Decimal (1.0 / This.ExRate), This.From); 130 | else 131 | return From_Major (0.0, This.To); 132 | end if; 133 | end Internal_Convert; 134 | 135 | -- Internal function 136 | procedure Internal_Set_Base 137 | (This : in out Currency_Exchange; 138 | Base : Currency_Handling.Currency_Data) is 139 | begin 140 | This.Base := Base; 141 | This.Base_Set := True; 142 | end Internal_Set_Base; 143 | 144 | procedure Set_Base 145 | (This : in out Currency_Exchange; 146 | Base : ISO.Currencies.Currency) 147 | is 148 | use Currency_Handling; 149 | Setter : constant Currency_Data := (Type_ISO_Currency, Base); 150 | begin 151 | Internal_Set_Base (This, Setter); 152 | end Set_Base; 153 | procedure Set_Base 154 | (This : in out Currency_Exchange; 155 | Base : ISO.Currencies.Alphabetic_Code) is 156 | use Currency_Handling; 157 | use ISO.Currencies; 158 | Setter : constant Currency_Data := (Type_ISO_Currency, From_Code (Base)); 159 | begin 160 | Internal_Set_Base (This, Setter); 161 | end Set_Base; 162 | procedure Set_Base 163 | (This : in out Currency_Exchange; 164 | Base : Currency_Handling.Custom_Currency) 165 | is 166 | use Currency_Handling; 167 | Setter : constant Currency_Data := (Type_Custom_Currency, Base); 168 | begin 169 | Internal_Set_Base (This, Setter); 170 | end Set_Base; 171 | function Base_Is_Set (This : Currency_Exchange) return Boolean is 172 | (This.Base_Set); 173 | -- Internal version 174 | procedure Internal_Set_Rate 175 | (This : in out Currency_Exchange; 176 | Item : Exchange_Rate) 177 | is 178 | Inverse : constant Exchange_Rate := 179 | (From => Item.To, 180 | To => Item.From, 181 | ExRate => Decimal (1.0 / (if Item.ExRate /= 0.0 then 182 | Item.ExRate else 1.0))); 183 | begin 184 | -- Insert the current item 185 | if This.Exchange.Contains (Item.From) then 186 | This.Exchange (Item.From).Include (Item.To, Item); 187 | else 188 | declare 189 | Initial_Map : To_Map.Map; 190 | begin 191 | Initial_Map.Include (Item.To, Item); 192 | This.Exchange.Include (Item.From, Initial_Map); 193 | end; 194 | end if; 195 | -- Insert the inverse if a record does not already exist 196 | if This.Exchange.Contains (Inverse.From) then 197 | if not This.Exchange (Inverse.From).Contains (Inverse.To) then 198 | This.Exchange (Inverse.From).Include (Inverse.To, Inverse); 199 | end if; 200 | else 201 | declare 202 | Initial_Map : To_Map.Map; 203 | begin 204 | Initial_Map.Include (Inverse.To, Inverse); 205 | This.Exchange.Include (Inverse.From, Initial_Map); 206 | end; 207 | end if; 208 | end Internal_Set_Rate; 209 | 210 | procedure Set_Rate 211 | (This : in out Currency_Exchange; 212 | From : ISO.Currencies.Currency; 213 | To : Currency_Handling.Custom_Currency; 214 | Rate : Decimal) 215 | is 216 | Setter : constant Exchange_Rate := Create (From, To, Rate); 217 | begin 218 | Internal_Set_Rate (This, Setter); 219 | end Set_Rate; 220 | procedure Set_Rate 221 | (This : in out Currency_Exchange; 222 | From : ISO.Currencies.Currency; 223 | To : ISO.Currencies.Currency; 224 | Rate : Decimal) 225 | is 226 | Setter : constant Exchange_Rate := Create (From, To, Rate); 227 | begin 228 | Internal_Set_Rate (This, Setter); 229 | end Set_Rate; 230 | procedure Set_Rate 231 | (This : in out Currency_Exchange; 232 | From : ISO.Currencies.Currency; 233 | To : ISO.Currencies.Alphabetic_Code; 234 | Rate : Decimal) 235 | is 236 | Setter : constant Exchange_Rate := Create (From, To, Rate); 237 | begin 238 | Internal_Set_Rate (This, Setter); 239 | end Set_Rate; 240 | procedure Set_Rate 241 | (This : in out Currency_Exchange; 242 | From : ISO.Currencies.Alphabetic_Code; 243 | To : ISO.Currencies.Alphabetic_Code; 244 | Rate : Decimal) 245 | is 246 | Setter : constant Exchange_Rate := Create (From, To, Rate); 247 | begin 248 | Internal_Set_Rate (This, Setter); 249 | end Set_Rate; 250 | procedure Set_Rate 251 | (This : in out Currency_Exchange; 252 | From : ISO.Currencies.Alphabetic_Code; 253 | To : ISO.Currencies.Currency; 254 | Rate : Decimal) 255 | is 256 | Setter : constant Exchange_Rate := Create (From, To, Rate); 257 | begin 258 | Internal_Set_Rate (This, Setter); 259 | end Set_Rate; 260 | procedure Set_Rate 261 | (This : in out Currency_Exchange; 262 | From : ISO.Currencies.Alphabetic_Code; 263 | To : Currency_Handling.Custom_Currency; 264 | Rate : Decimal) 265 | is 266 | Setter : constant Exchange_Rate := Create (From, To, Rate); 267 | begin 268 | Internal_Set_Rate (This, Setter); 269 | end Set_Rate; 270 | procedure Set_Rate 271 | (This : in out Currency_Exchange; 272 | From : Currency_Handling.Custom_Currency; 273 | To : Currency_Handling.Custom_Currency; 274 | Rate : Decimal) 275 | is 276 | Setter : constant Exchange_Rate := Create (From, To, Rate); 277 | begin 278 | Internal_Set_Rate (This, Setter); 279 | end Set_Rate; 280 | procedure Set_Rate 281 | (This : in out Currency_Exchange; 282 | From : Currency_Handling.Custom_Currency; 283 | To : ISO.Currencies.Currency; 284 | Rate : Decimal) 285 | is 286 | Setter : constant Exchange_Rate := Create (From, To, Rate); 287 | begin 288 | Internal_Set_Rate (This, Setter); 289 | end Set_Rate; 290 | procedure Set_Rate 291 | (This : in out Currency_Exchange; 292 | From : Currency_Handling.Custom_Currency; 293 | To : ISO.Currencies.Alphabetic_Code; 294 | Rate : Decimal) 295 | is 296 | Setter : constant Exchange_Rate := Create (From, To, Rate); 297 | begin 298 | Internal_Set_Rate (This, Setter); 299 | end Set_Rate; 300 | 301 | -- These can be used if the base is enabled. 302 | procedure Set_Rate 303 | (This : in out Currency_Exchange; 304 | To : Currency_Handling.Custom_Currency; 305 | Rate : Decimal) 306 | is 307 | use Currency_Handling; 308 | begin 309 | case This.Base.Which_Currency_Type is 310 | when Type_Custom_Currency => 311 | Internal_Set_Rate (This, Create (This.Base.Custom_Code, To, Rate)); 312 | when Type_ISO_Currency => 313 | Internal_Set_Rate (This, Create (This.Base.ISO_Code, To, Rate)); 314 | end case; 315 | end Set_Rate; 316 | procedure Set_Rate 317 | (This : in out Currency_Exchange; 318 | To : ISO.Currencies.Currency; 319 | Rate : Decimal) 320 | is 321 | use Currency_Handling; 322 | begin 323 | case This.Base.Which_Currency_Type is 324 | when Type_Custom_Currency => 325 | Internal_Set_Rate (This, Create (This.Base.Custom_Code, To, Rate)); 326 | when Type_ISO_Currency => 327 | Internal_Set_Rate (This, Create (This.Base.ISO_Code, To, Rate)); 328 | end case; 329 | end Set_Rate; 330 | procedure Set_Rate 331 | (This : in out Currency_Exchange; 332 | To : ISO.Currencies.Alphabetic_Code; 333 | Rate : Decimal) 334 | is 335 | use Currency_Handling; 336 | begin 337 | case This.Base.Which_Currency_Type is 338 | when Type_Custom_Currency => 339 | Internal_Set_Rate (This, Create (This.Base.Custom_Code, To, Rate)); 340 | when Type_ISO_Currency => 341 | Internal_Set_Rate (This, Create (This.Base.ISO_Code, To, Rate)); 342 | end case; 343 | end Set_Rate; 344 | 345 | function Internal_Search_Rate 346 | (This : Currency_Exchange; 347 | Search : Exchange_Rate) 348 | return Exchange_Rate is begin 349 | if This.Exchange.Contains (Search.From) and then 350 | This.Exchange (Search.From).Contains (Search.To) 351 | then 352 | -- Return the found exchange rate. 353 | return This.Exchange (Search.From).Element (Search.To); 354 | else 355 | -- Return an empty exchange rate. 356 | return (Search.From, Search.To, 0.0); 357 | end if; 358 | end Internal_Search_Rate; 359 | 360 | function Rate 361 | (This : Currency_Exchange; 362 | From : ISO.Currencies.Currency; 363 | To : ISO.Currencies.Currency) 364 | return Decimal is 365 | Search : constant Exchange_Rate := Create (From, To, 0.0); 366 | begin 367 | return Internal_Search_Rate (This, Search).ExRate; 368 | end Rate; 369 | function Rate 370 | (This : Currency_Exchange; 371 | From : ISO.Currencies.Currency; 372 | To : Currency_Handling.Custom_Currency) 373 | return Decimal is 374 | Search : constant Exchange_Rate := Create (From, To, 0.0); 375 | begin 376 | return Internal_Search_Rate (This, Search).ExRate; 377 | end Rate; 378 | function Rate 379 | (This : Currency_Exchange; 380 | From : ISO.Currencies.Currency; 381 | To : ISO.Currencies.Alphabetic_Code) 382 | return Decimal is 383 | Search : constant Exchange_Rate := Create (From, To, 0.0); 384 | begin 385 | return Internal_Search_Rate (This, Search).ExRate; 386 | end Rate; 387 | function Rate 388 | (This : Currency_Exchange; 389 | From : ISO.Currencies.Alphabetic_Code; 390 | To : ISO.Currencies.Alphabetic_Code) 391 | return Decimal is 392 | Search : constant Exchange_Rate := Create (From, To, 0.0); 393 | begin 394 | return Internal_Search_Rate (This, Search).ExRate; 395 | end Rate; 396 | function Rate 397 | (This : Currency_Exchange; 398 | From : ISO.Currencies.Alphabetic_Code; 399 | To : ISO.Currencies.Currency) 400 | return Decimal is 401 | Search : constant Exchange_Rate := Create (From, To, 0.0); 402 | begin 403 | return Internal_Search_Rate (This, Search).ExRate; 404 | end Rate; 405 | function Rate 406 | (This : Currency_Exchange; 407 | From : ISO.Currencies.Alphabetic_Code; 408 | To : Currency_Handling.Custom_Currency) 409 | return Decimal is 410 | Search : constant Exchange_Rate := Create (From, To, 0.0); 411 | begin 412 | return Internal_Search_Rate (This, Search).ExRate; 413 | end Rate; 414 | function Rate 415 | (This : Currency_Exchange; 416 | From : Currency_Handling.Custom_Currency; 417 | To : Currency_Handling.Custom_Currency) 418 | return Decimal is 419 | Search : constant Exchange_Rate := Create (From, To, 0.0); 420 | begin 421 | return Internal_Search_Rate (This, Search).ExRate; 422 | end Rate; 423 | function Rate 424 | (This : Currency_Exchange; 425 | From : Currency_Handling.Custom_Currency; 426 | To : ISO.Currencies.Currency) 427 | return Decimal is 428 | Search : constant Exchange_Rate := Create (From, To, 0.0); 429 | begin 430 | return Internal_Search_Rate (This, Search).ExRate; 431 | end Rate; 432 | function Rate 433 | (This : Currency_Exchange; 434 | From : Currency_Handling.Custom_Currency; 435 | To : ISO.Currencies.Alphabetic_Code) 436 | return Decimal is 437 | Search : constant Exchange_Rate := Create (From, To, 0.0); 438 | begin 439 | return Internal_Search_Rate (This, Search).ExRate; 440 | end Rate; 441 | function Rate 442 | (This : Currency_Exchange; 443 | To : Currency_Handling.Custom_Currency) 444 | return Decimal is 445 | Search : constant Exchange_Rate := Create (This.Base, To, 0.0); 446 | begin 447 | return Internal_Search_Rate (This, Search).ExRate; 448 | end Rate; 449 | function Rate 450 | (This : Currency_Exchange; 451 | To : ISO.Currencies.Currency) 452 | return Decimal is 453 | Search : constant Exchange_Rate := Create (This.Base, To, 0.0); 454 | begin 455 | return Internal_Search_Rate (This, Search).ExRate; 456 | end Rate; 457 | function Rate 458 | (This : Currency_Exchange; 459 | To : ISO.Currencies.Alphabetic_Code) 460 | return Decimal is 461 | Search : constant Exchange_Rate := Create (This.Base, To, 0.0); 462 | begin 463 | return Internal_Search_Rate (This, Search).ExRate; 464 | end Rate; 465 | 466 | -- Validate if a conversion is in the exchange 467 | function Contains 468 | (This : Currency_Exchange; 469 | From : ISO.Currencies.Currency; 470 | To : ISO.Currencies.Currency) 471 | return Boolean is (This.Rate (From, To) > 0.0); 472 | function Contains 473 | (This : Currency_Exchange; 474 | From : ISO.Currencies.Currency; 475 | To : Currency_Handling.Custom_Currency) 476 | return Boolean is (This.Rate (From, To) > 0.0); 477 | function Contains 478 | (This : Currency_Exchange; 479 | From : ISO.Currencies.Currency; 480 | To : ISO.Currencies.Alphabetic_Code) 481 | return Boolean is (This.Rate (From, To) > 0.0); 482 | function Contains 483 | (This : Currency_Exchange; 484 | From : ISO.Currencies.Alphabetic_Code; 485 | To : ISO.Currencies.Alphabetic_Code) 486 | return Boolean is (This.Rate (From, To) > 0.0); 487 | function Contains 488 | (This : Currency_Exchange; 489 | From : ISO.Currencies.Alphabetic_Code; 490 | To : ISO.Currencies.Currency) 491 | return Boolean is (This.Rate (From, To) > 0.0); 492 | function Contains 493 | (This : Currency_Exchange; 494 | From : ISO.Currencies.Alphabetic_Code; 495 | To : Currency_Handling.Custom_Currency) 496 | return Boolean is (This.Rate (From, To) > 0.0); 497 | function Contains 498 | (This : Currency_Exchange; 499 | From : Currency_Handling.Custom_Currency; 500 | To : Currency_Handling.Custom_Currency) 501 | return Boolean is (This.Rate (From, To) > 0.0); 502 | function Contains 503 | (This : Currency_Exchange; 504 | From : Currency_Handling.Custom_Currency; 505 | To : ISO.Currencies.Currency) 506 | return Boolean is (This.Rate (From, To) > 0.0); 507 | function Contains 508 | (This : Currency_Exchange; 509 | From : Currency_Handling.Custom_Currency; 510 | To : ISO.Currencies.Alphabetic_Code) 511 | return Boolean is (This.Rate (From, To) > 0.0); 512 | 513 | function Convert 514 | (This : Currency_Exchange; 515 | From : Money_Handling.Money; 516 | To : ISO.Currencies.Currency) 517 | return Money_Handling.Money 518 | is 519 | use Currency_Handling; 520 | ExRate : constant Exchange_Rate := 521 | (case From.Get_Currency.Which_Currency_Type is 522 | when Type_Custom_Currency => 523 | Internal_Search_Rate 524 | (This, Create (From.Get_Currency.Custom_Code, 525 | To, 0.0)), 526 | 527 | when Type_ISO_Currency => 528 | Internal_Search_Rate 529 | (This, Create (From.Get_Currency.ISO_Code, 530 | To, 0.0))); 531 | 532 | begin 533 | return Internal_Convert (ExRate, From); 534 | end Convert; 535 | function Convert 536 | (This : Currency_Exchange; 537 | From : Money_Handling.Money; 538 | To : ISO.Currencies.Alphabetic_Code) 539 | return Money_Handling.Money 540 | is 541 | use Currency_Handling; 542 | ExRate : constant Exchange_Rate := 543 | (case From.Get_Currency.Which_Currency_Type is 544 | when Type_Custom_Currency => 545 | Internal_Search_Rate 546 | (This, Create (From.Get_Currency.Custom_Code, 547 | To, 0.0)), 548 | 549 | when Type_ISO_Currency => 550 | Internal_Search_Rate 551 | (This, Create (From.Get_Currency.ISO_Code, 552 | To, 0.0))); 553 | 554 | begin 555 | return Internal_Convert (ExRate, From); 556 | end Convert; 557 | function Convert 558 | (This : Currency_Exchange; 559 | From : Money_Handling.Money; 560 | To : Currency_Handling.Custom_Currency) 561 | return Money_Handling.Money 562 | is 563 | use Currency_Handling; 564 | ExRate : constant Exchange_Rate := 565 | (case From.Get_Currency.Which_Currency_Type is 566 | when Type_Custom_Currency => 567 | Internal_Search_Rate 568 | (This, Create (From.Get_Currency.Custom_Code, 569 | To, 0.0)), 570 | 571 | when Type_ISO_Currency => 572 | Internal_Search_Rate 573 | (This, Create (From.Get_Currency.ISO_Code, 574 | To, 0.0))); 575 | 576 | begin 577 | return Internal_Convert (ExRate, From); 578 | end Convert; 579 | 580 | function Exchange_Hashed (Item : Currency_Handling.Currency_Data) 581 | return Ada.Containers.Hash_Type 582 | is 583 | use Currency_Handling; 584 | use Ada.Containers; 585 | use ISO.Currencies; 586 | begin 587 | case Item.Which_Currency_Type is 588 | when Type_ISO_Currency => 589 | return Hash_Type (Currency_Key'Pos (Item.ISO_Code.Key)); 590 | when Type_Custom_Currency => 591 | return Ada.Strings.Wide_Wide_Hash 592 | (Item.Custom_Code.Code & 593 | Item.Custom_Code.Name & 594 | Item.Custom_Code.Symbol & 595 | Item.Custom_Code.Unit'Wide_Wide_Image); 596 | end case; 597 | end Exchange_Hashed; 598 | 599 | end Cashe.Exchange; -------------------------------------------------------------------------------- /src/cashe-exchange.ads: -------------------------------------------------------------------------------- 1 | pragma Ada_2022; 2 | pragma Assertion_Policy (Check); 3 | with ISO.Currencies; 4 | with Cashe.Currency_Handling; 5 | with Cashe.Money_Handling; 6 | with Ada.Containers.Hashed_Maps; 7 | -- ****h* Cashe/Exchange 8 | -- SOURCE 9 | package Cashe.Exchange is 10 | -- DESCRIPTION 11 | -- This package provides the ability to utilize a currency exchange. 12 | -- **** 13 | 14 | -- ****c* Exchange/Exchange.Currency_Exchange 15 | -- SOURCE 16 | type Currency_Exchange is tagged private; 17 | -- DESCRIPTION 18 | -- An exchange containing various currencies and their conversions. 19 | -- USAGE 20 | -- declare 21 | -- My_Exchange : Currency_Exchange; 22 | -- begin 23 | -- My_Exchange.Set_Rate ("USD", "GBP", 0.5); 24 | -- -- Print £ 50.00 from a provided $ 100.00 25 | -- Put_Line 26 | -- (My_Exchange.Convert 27 | -- (From => From_Minor (100_00, "GBP"), 28 | -- To => "USD")'Image 29 | -- ); 30 | -- end; 31 | -- METHODS 32 | -- * Exchange.Currency_Exchange/Set_Base 33 | -- * Exchange.Currency_Exchange/Base_Is_Set 34 | -- * Exchange.Currency_Exchange/Set_Rate 35 | -- * Exchange.Currency_Exchange/Convert 36 | -- * Exchange.Currency_Exchange/Contains 37 | -- * Exchange.Currency_Exchange/Rate 38 | -- **** 39 | 40 | -- ****m* Exchange.Currency_Exchange/Set_Base 41 | -- SOURCE 42 | procedure Set_Base 43 | (This : in out Currency_Exchange; 44 | -- The currency exchange to set the base for 45 | Base : ISO.Currencies.Currency 46 | -- The base currency to set the exchange to 47 | ); 48 | procedure Set_Base 49 | (This : in out Currency_Exchange; 50 | -- The currency exchange to set the base for 51 | Base : ISO.Currencies.Alphabetic_Code 52 | -- The base currency to set the exchange to 53 | ); 54 | procedure Set_Base 55 | (This : in out Currency_Exchange; 56 | -- The currency exchange to set the base for 57 | Base : Currency_Handling.Custom_Currency 58 | -- The base currency to set the exchange to 59 | ); 60 | -- FUNCTION 61 | -- Set the default base for the currency exchange. Once this is called, 62 | -- "from" will no longer have to be passed when setting the rate. 63 | -- PARAMETERS 64 | -- Base - The currency to set the exchange to. Either custom or ISO 65 | -- EXAMPLE 66 | -- declare 67 | -- US_Exchange : Currency_Exchange; 68 | -- begin 69 | -- US_Exchange.Set_Base ("USD"); 70 | -- -- Set USD:GBP to 1:0.5 71 | -- US_Exchange.Set_Rate ("GBP", 0.5); 72 | -- -- Set USD:BTC to 1:0.0000331163 73 | -- US_Exchange.Set_Rate (Bitcoin, 0.0000331163); 74 | -- end; 75 | -- SEE ALSO 76 | -- * Exchange.Currency_Exchange/Base_Is_Set 77 | -- * Exchange.Currency_Exchange/Set_Rate 78 | -- **** 79 | 80 | -- ****m* Exchange.Currency_Exchange/Base_Is_Set 81 | -- SOURCE 82 | function Base_Is_Set (This : Currency_Exchange) return Boolean; 83 | -- FUNCTION 84 | -- Quries if a base is set or not. 85 | -- RETURN VALUE 86 | -- Boolean: 87 | -- * True if a base has been set 88 | -- * False if a base has not been set 89 | -- EXAMPLE 90 | -- if not US_Exchange.Base_Is_Set then 91 | -- US_Exchange.Set_Base ("USD"); 92 | -- end if; 93 | -- **** 94 | 95 | -- ****m* Exchange.Currency_Exchange/Set_Rate 96 | -- SOURCE 97 | procedure Set_Rate 98 | (This : in out Currency_Exchange; 99 | -- The currency exchange to set the rate in 100 | From : ISO.Currencies.Currency; 101 | -- The currency to convert from 102 | To : ISO.Currencies.Currency; 103 | -- The currency to convert to 104 | Rate : Decimal 105 | -- The exchange rate, in decimal format. 106 | ); 107 | procedure Set_Rate 108 | (This : in out Currency_Exchange; 109 | -- The currency exchange to set the rate in 110 | From : ISO.Currencies.Currency; 111 | -- The currency to convert from 112 | To : ISO.Currencies.Alphabetic_Code; 113 | -- The currency to convert to 114 | Rate : Decimal 115 | -- The exchange rate, in decimal format. 116 | ); 117 | procedure Set_Rate 118 | (This : in out Currency_Exchange; 119 | -- The currency exchange to set the rate in 120 | From : ISO.Currencies.Currency; 121 | -- The currency to convert from 122 | To : Currency_Handling.Custom_Currency; 123 | -- The currency to convert to 124 | Rate : Decimal 125 | -- The exchange rate, in decimal format. 126 | ); 127 | procedure Set_Rate 128 | (This : in out Currency_Exchange; 129 | -- The currency exchange to set the rate in 130 | From : ISO.Currencies.Alphabetic_Code; 131 | -- The currency to convert from 132 | To : ISO.Currencies.Alphabetic_Code; 133 | -- The currency to convert to 134 | Rate : Decimal 135 | -- The exchange rate, in decimal format. 136 | ); 137 | procedure Set_Rate 138 | (This : in out Currency_Exchange; 139 | -- The currency exchange to set the rate in 140 | From : ISO.Currencies.Alphabetic_Code; 141 | -- The currency to convert from 142 | To : ISO.Currencies.Currency; 143 | -- The currency to convert to 144 | Rate : Decimal 145 | -- The exchange rate, in decimal format. 146 | ); 147 | procedure Set_Rate 148 | (This : in out Currency_Exchange; 149 | -- The currency exchange to set the rate in 150 | From : ISO.Currencies.Alphabetic_Code; 151 | -- The currency to convert from 152 | To : Currency_Handling.Custom_Currency; 153 | -- The currency to convert to 154 | Rate : Decimal 155 | -- The exchange rate, in decimal format. 156 | ); 157 | procedure Set_Rate 158 | (This : in out Currency_Exchange; 159 | -- The currency exchange to set the rate in 160 | From : Currency_Handling.Custom_Currency; 161 | -- The currency to convert from 162 | To : Currency_Handling.Custom_Currency; 163 | -- The currency to convert to 164 | Rate : Decimal 165 | -- The exchange rate, in decimal format. 166 | ); 167 | procedure Set_Rate 168 | (This : in out Currency_Exchange; 169 | -- The currency exchange to set the rate in 170 | From : Currency_Handling.Custom_Currency; 171 | -- The currency to convert from 172 | To : ISO.Currencies.Currency; 173 | -- The currency to convert to 174 | Rate : Decimal 175 | -- The exchange rate, in decimal format. 176 | ); 177 | procedure Set_Rate 178 | (This : in out Currency_Exchange; 179 | -- The currency exchange to set the rate in 180 | From : Currency_Handling.Custom_Currency; 181 | -- The currency to convert from 182 | To : ISO.Currencies.Alphabetic_Code; 183 | -- The currency to convert to 184 | Rate : Decimal 185 | -- The exchange rate, in decimal format. 186 | ); 187 | -- These can be used if the base is enabled. 188 | procedure Set_Rate 189 | (This : in out Currency_Exchange; 190 | -- The currency exchange to set the rate in 191 | To : Currency_Handling.Custom_Currency; 192 | -- The currency to convert to 193 | Rate : Decimal 194 | -- The exchange rate, in decimal format. 195 | ) with pre => This.Base_Is_Set; 196 | procedure Set_Rate 197 | (This : in out Currency_Exchange; 198 | -- The currency exchange to set the rate in 199 | To : ISO.Currencies.Currency; 200 | -- The currency to convert to 201 | Rate : Decimal 202 | -- The exchange rate, in decimal format. 203 | ) with pre => This.Base_Is_Set; 204 | procedure Set_Rate 205 | (This : in out Currency_Exchange; 206 | -- The currency exchange to set the rate in 207 | To : ISO.Currencies.Alphabetic_Code; 208 | -- The currency to convert to 209 | Rate : Decimal 210 | -- The exchange rate, in decimal format. 211 | ) with pre => This.Base_Is_Set; 212 | -- FUNCTION 213 | -- Add or update a new exchange rate into the current exchange. 214 | -- PARAMETERS 215 | -- From - The currency exchange to set the rate in 216 | -- To - The currency to convert to 217 | -- Rate - The exchange rate, in decimal format. 218 | -- NOTES 219 | -- As a courtesy, the inverse of the exchange rate is also added to the 220 | -- exchange so both USD:GBP and GBP:USD will be accessible. I recommend 221 | -- adding the inverse explicitly if it's different than 1.0 / Rate. 222 | -- EXAMPLE 223 | -- declare 224 | -- -- Create some currencies to test 225 | -- Bitcoin : Custom_Currency := 226 | -- Create (Code => "BTC", Minor_Unit => 8, 227 | -- Name => "Bitcoin", Symbol => "฿"); 228 | -- -- based on the Jul. 9, 2023 exchange rate 229 | -- -- from openexchangerates.org. 230 | -- BTC_to_USD : constant Decimal := 30196.620159; 231 | -- USD_to_BTC : constant Decimal := 0.0000331163; 232 | -- USD_to_JPY : constant Decimal := 142.17488666; 233 | -- JPY_to_USD : constant Decimal := 0.007033591; 234 | -- -- Create the exchanges 235 | -- Test_Ex : Currency_Exchange; 236 | -- BTC_Ex : Currency_Exchange; 237 | -- begin 238 | -- -- If you use USD -> GBP as 0.40 then it will automatically create 239 | -- -- GBP -> USD as 2.50 240 | -- Test_Ex.Set_Rate ("USD", "GBP", 0.40); 241 | -- -- You can also use the inverse. 242 | -- Test_Ex.Set_Rate ("USD", "JPY", USD_to_BTC); 243 | -- Test_Ex.Set_Rate ("JPY", "USD", USD_to_JPY); 244 | -- -- You can also set the base. 245 | -- BTC_Ex.Set_Base (Bitcoin); 246 | -- BTC_Ex.Set_Rate ("USD", BTC_to_USD); 247 | -- -- You can still set other values if the base is set. 248 | -- BTC_Ex.Set_Rate ("USD", Bitcoin, USD_to_BTC); 249 | -- SEE ALSO 250 | -- * Exchange.Currency_Exchange/Set_Base 251 | -- * Exchange.Currency_Exchange/Base_Is_Set 252 | -- **** 253 | 254 | -- ****m* Exchange.Currency_Exchange/Convert 255 | -- SOURCE 256 | function Convert 257 | (This : Currency_Exchange; 258 | From : Money_Handling.Money; 259 | -- The money with the currency to convert from 260 | To : ISO.Currencies.Currency 261 | -- The currency to convert to 262 | ) 263 | return Money_Handling.Money; 264 | function Convert 265 | (This : Currency_Exchange; 266 | From : Money_Handling.Money; 267 | -- The money with the currency to convert from 268 | To : ISO.Currencies.Alphabetic_Code 269 | -- The currency to convert to 270 | ) 271 | return Money_Handling.Money; 272 | function Convert 273 | (This : Currency_Exchange; 274 | From : Money_Handling.Money; 275 | -- The money with the currency to convert from 276 | To : Currency_Handling.Custom_Currency 277 | -- The currency to convert to 278 | ) 279 | return Money_Handling.Money; 280 | -- FUNCTION 281 | -- Converts money of one currency to another 282 | -- PARAMETERS 283 | -- From - The money with the currency to convert from 284 | -- To - The currency to convert to 285 | -- RETURN VALUE 286 | -- A new money object with the new currency and value when converted or 287 | -- a money value of 0 if not found in the exchange. 288 | -- EXAMPLE 289 | -- declare 290 | -- My_Exchange : Currency_Exchange; 291 | -- begin 292 | -- My_Exchange.Set_Rate ("USD", "GBP", 0.5); 293 | -- -- Print £ 50.00 from a provided $ 100.00 294 | -- if My_Exchange.Contains ("USD", "GBP) then 295 | -- Put_Line 296 | -- (My_Exchange.Convert 297 | -- (From => From_Minor (100_00, "GBP"), 298 | -- To => "USD")'Image 299 | -- ); 300 | -- else 301 | -- Put_Line ("Not in exchange"); 302 | -- end if; 303 | -- end; 304 | -- SEE ALSO 305 | -- * Exchange.Currency_Exchange/Set_Rate 306 | -- * Exchange.Currency_Exchange/Contains 307 | -- **** 308 | 309 | -- ****m* Exchange.Currency_Exchange/Contains 310 | -- SOURCE 311 | function Contains 312 | (This : Currency_Exchange; 313 | From : ISO.Currencies.Currency; 314 | -- The currency to convert from 315 | To : ISO.Currencies.Currency 316 | -- The currency to convert to 317 | ) 318 | return Boolean; 319 | function Contains 320 | (This : Currency_Exchange; 321 | From : ISO.Currencies.Currency; 322 | -- The currency to convert from 323 | To : Currency_Handling.Custom_Currency 324 | -- The currency to convert to 325 | ) 326 | return Boolean; 327 | function Contains 328 | (This : Currency_Exchange; 329 | From : ISO.Currencies.Currency; 330 | -- The currency to convert from 331 | To : ISO.Currencies.Alphabetic_Code 332 | -- The currency to convert to 333 | ) 334 | return Boolean; 335 | function Contains 336 | (This : Currency_Exchange; 337 | From : ISO.Currencies.Alphabetic_Code; 338 | -- The currency to convert from 339 | To : ISO.Currencies.Alphabetic_Code 340 | -- The currency to convert to 341 | ) 342 | return Boolean; 343 | function Contains 344 | (This : Currency_Exchange; 345 | From : ISO.Currencies.Alphabetic_Code; 346 | -- The currency to convert from 347 | To : ISO.Currencies.Currency 348 | -- The currency to convert to 349 | ) 350 | return Boolean; 351 | function Contains 352 | (This : Currency_Exchange; 353 | From : ISO.Currencies.Alphabetic_Code; 354 | -- The currency to convert from 355 | To : Currency_Handling.Custom_Currency 356 | -- The currency to convert to 357 | ) 358 | return Boolean; 359 | function Contains 360 | (This : Currency_Exchange; 361 | From : Currency_Handling.Custom_Currency; 362 | -- The currency to convert from 363 | To : Currency_Handling.Custom_Currency 364 | -- The currency to convert to 365 | ) 366 | return Boolean; 367 | function Contains 368 | (This : Currency_Exchange; 369 | From : Currency_Handling.Custom_Currency; 370 | -- The currency to convert from 371 | To : ISO.Currencies.Currency 372 | -- The currency to convert to 373 | ) 374 | return Boolean; 375 | function Contains 376 | (This : Currency_Exchange; 377 | From : Currency_Handling.Custom_Currency; 378 | -- The currency to convert from 379 | To : ISO.Currencies.Alphabetic_Code 380 | -- The currency to convert to 381 | ) 382 | return Boolean; 383 | -- FUNCTION 384 | -- Validate if a conversion is in the exchange. 385 | -- PARAMETERS 386 | -- From - The currency to convert from 387 | -- To - The currency to convert to 388 | -- RETURN VALUE 389 | -- Boolean: 390 | -- * True if there is a match of From -> To 391 | -- * False if From -> To not exist in the Exchange 392 | -- EXAMPLE 393 | -- if My_Exchange.Contains ("USD", "GBP) then 394 | -- Put_Line 395 | -- (My_Exchange.Convert 396 | -- (From => From_Minor (100_00, "GBP"), 397 | -- To => "USD")'Image 398 | -- ); 399 | -- else 400 | -- Put_Line ("Not in exchange"); 401 | -- end if; 402 | -- SEE ALSO 403 | -- * Exchange.Currency_Exchange/Set_Rate 404 | -- * Exchange.Currency_Exchange/Convert 405 | -- **** 406 | 407 | -- Get the rate for a specific currency 408 | -- ****m* Exchange.Currency_Exchange/Rate 409 | -- SOURCE 410 | function Rate 411 | (This : Currency_Exchange; 412 | From : ISO.Currencies.Currency; 413 | -- The currency to convert from 414 | To : ISO.Currencies.Currency) 415 | -- The currency to convert to 416 | return Decimal; 417 | function Rate 418 | (This : Currency_Exchange; 419 | From : ISO.Currencies.Currency; 420 | -- The currency to convert from 421 | To : Currency_Handling.Custom_Currency 422 | -- The currency to convert to 423 | ) 424 | return Decimal; 425 | function Rate 426 | (This : Currency_Exchange; 427 | From : ISO.Currencies.Currency; 428 | -- The currency to convert from 429 | To : ISO.Currencies.Alphabetic_Code 430 | -- The currency to convert to 431 | ) 432 | return Decimal; 433 | function Rate 434 | (This : Currency_Exchange; 435 | From : ISO.Currencies.Alphabetic_Code; 436 | -- The currency to convert from 437 | To : ISO.Currencies.Alphabetic_Code 438 | -- The currency to convert to 439 | ) 440 | return Decimal; 441 | function Rate 442 | (This : Currency_Exchange; 443 | From : ISO.Currencies.Alphabetic_Code; 444 | -- The currency to convert from 445 | To : ISO.Currencies.Currency 446 | -- The currency to convert to 447 | ) 448 | return Decimal; 449 | function Rate 450 | (This : Currency_Exchange; 451 | From : ISO.Currencies.Alphabetic_Code; 452 | -- The currency to convert from 453 | To : Currency_Handling.Custom_Currency 454 | -- The currency to convert to 455 | ) 456 | return Decimal; 457 | function Rate 458 | (This : Currency_Exchange; 459 | From : Currency_Handling.Custom_Currency; 460 | -- The currency to convert from 461 | To : Currency_Handling.Custom_Currency 462 | -- The currency to convert to 463 | ) 464 | return Decimal; 465 | function Rate 466 | (This : Currency_Exchange; 467 | From : Currency_Handling.Custom_Currency; 468 | -- The currency to convert from 469 | To : ISO.Currencies.Currency 470 | -- The currency to convert to 471 | ) 472 | return Decimal; 473 | function Rate 474 | (This : Currency_Exchange; 475 | From : Currency_Handling.Custom_Currency; 476 | -- The currency to convert from 477 | To : ISO.Currencies.Alphabetic_Code 478 | -- The currency to convert to 479 | ) 480 | return Decimal; 481 | -- These can be used if base rate is enabled 482 | function Rate 483 | (This : Currency_Exchange; 484 | To : Currency_Handling.Custom_Currency 485 | -- The currency to convert to 486 | ) 487 | return Decimal with pre => This.Base_Is_Set; 488 | function Rate 489 | (This : Currency_Exchange; 490 | To : ISO.Currencies.Currency 491 | -- The currency to convert to 492 | ) 493 | return Decimal with pre => This.Base_Is_Set; 494 | function Rate 495 | (This : Currency_Exchange; 496 | To : ISO.Currencies.Alphabetic_Code 497 | -- The currency to convert to 498 | ) 499 | return Decimal with pre => This.Base_Is_Set; 500 | -- FUNCTION 501 | -- Converts money of one currency to another 502 | -- PARAMETERS 503 | -- From - The currency to convert from 504 | -- To - The currency to convert to 505 | -- RETURN VALUE 506 | -- The exchangce rate corresponding to From:To in Decimal form 507 | -- EXAMPLE 508 | -- declare 509 | -- My_Exchange : Currency_Exchange; 510 | -- begin 511 | -- My_Exchange.Set_Rate ("USD", "GBP", 0.5); 512 | -- -- Print the GBP exchange rate 513 | -- Put_Line ("Rate is " & My_Exchange.Rate ("USD", "GBP")'Image); 514 | -- end; 515 | -- SEE ALSO 516 | -- * Exchange.Currency_Exchange/Set_Rate 517 | -- * Exchange.Currency_Exchange/Contains 518 | -- **** 519 | 520 | private 521 | -- This checks if the exchange is enabled or not. 522 | Exchange_Is_Enabled : Boolean := False; 523 | type Exchange_Rate is record 524 | From : Currency_Handling.Currency_Data; 525 | To : Currency_Handling.Currency_Data; 526 | ExRate : Decimal := 0.0; 527 | end record; 528 | 529 | function Exchange_Hashed (Item : Currency_Handling.Currency_Data) 530 | return Ada.Containers.Hash_Type; 531 | 532 | package To_Map is new Ada.Containers.Hashed_Maps 533 | (Key_Type => Currency_Handling.Currency_Data, 534 | Element_Type => Exchange_Rate, 535 | Hash => Exchange_Hashed, 536 | Equivalent_Keys => Currency_Handling."="); 537 | -- To prevent any recursion 538 | function "=" (Left, Right : To_Map.Map) return Boolean is 539 | (To_Map."=" (Left, Right)); 540 | 541 | package From_Map is new Ada.Containers.Hashed_Maps 542 | (Key_Type => Currency_Handling.Currency_Data, 543 | Element_Type => To_Map.Map, 544 | Hash => Exchange_Hashed, 545 | Equivalent_Keys => Currency_Handling."="); 546 | 547 | type Currency_Exchange is tagged record 548 | Exchange : From_Map.Map; 549 | Base_Set : Boolean := False; 550 | Base : Currency_Handling.Currency_Data := 551 | (Currency_Handling.Type_ISO_Currency, 552 | (Key => ISO.Currencies.C_ZZZ)); 553 | end record; 554 | -- The true implimentations. 555 | procedure Internal_Set_Base 556 | (This : in out Currency_Exchange; 557 | Base : Currency_Handling.Currency_Data); 558 | procedure Internal_Set_Rate 559 | (This : in out Currency_Exchange; 560 | Item : Exchange_Rate); 561 | function Internal_Search_Rate 562 | (This : Currency_Exchange; 563 | Search : Exchange_Rate) 564 | return Exchange_Rate; 565 | function Internal_Convert 566 | (This : Exchange_Rate; 567 | From : Money_Handling.Money) 568 | return Money_Handling.Money; 569 | 570 | -- Intermediate create functions 571 | function Create 572 | (From : Currency_Handling.Currency_Data; 573 | To : ISO.Currencies.Currency; 574 | Rate : Decimal) 575 | return Exchange_Rate; 576 | function Create 577 | (From : Currency_Handling.Currency_Data; 578 | To : ISO.Currencies.Alphabetic_Code; 579 | Rate : Decimal) 580 | return Exchange_Rate; 581 | function Create 582 | (From : Currency_Handling.Currency_Data; 583 | To : Currency_Handling.Custom_Currency; 584 | Rate : Decimal) 585 | return Exchange_Rate; 586 | function Create 587 | (From : ISO.Currencies.Currency; 588 | To : ISO.Currencies.Currency; 589 | Rate : Decimal) 590 | return Exchange_Rate; 591 | function Create 592 | (From : ISO.Currencies.Currency; 593 | To : Currency_Handling.Custom_Currency; 594 | Rate : Decimal) 595 | return Exchange_Rate; 596 | function Create 597 | (From : ISO.Currencies.Currency; 598 | To : ISO.Currencies.Alphabetic_Code; 599 | Rate : Decimal) 600 | return Exchange_Rate; 601 | function Create 602 | (From : ISO.Currencies.Alphabetic_Code; 603 | To : ISO.Currencies.Alphabetic_Code; 604 | Rate : Decimal) 605 | return Exchange_Rate; 606 | function Create 607 | (From : ISO.Currencies.Alphabetic_Code; 608 | To : ISO.Currencies.Currency; 609 | Rate : Decimal) 610 | return Exchange_Rate; 611 | function Create 612 | (From : ISO.Currencies.Alphabetic_Code; 613 | To : Currency_Handling.Custom_Currency; 614 | Rate : Decimal) 615 | return Exchange_Rate; 616 | function Create 617 | (From : Currency_Handling.Custom_Currency; 618 | To : Currency_Handling.Custom_Currency; 619 | Rate : Decimal) 620 | return Exchange_Rate; 621 | function Create 622 | (From : Currency_Handling.Custom_Currency; 623 | To : ISO.Currencies.Currency; 624 | Rate : Decimal) 625 | return Exchange_Rate; 626 | function Create 627 | (From : Currency_Handling.Custom_Currency; 628 | To : ISO.Currencies.Alphabetic_Code; 629 | Rate : Decimal) 630 | return Exchange_Rate; 631 | 632 | end Cashe.Exchange; 633 | -------------------------------------------------------------------------------- /docs/cashe_ads.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | cashe.ads 11 | 12 | 13 | 14 | 15 | 18 | 31 |
32 |

TABLE OF CONTENTS

33 | 111 |
112 | 113 |

Cashe/Cashe [ Packages ]

114 | 115 |

[ Top ] [ Packages ]

116 |

DESCRIPTION

117 | 
    This package provides datatypes and functions utilized by other packages.
118 |
119 |

SOURCE

120 | 
package Cashe is
121 |
122 | 123 |
124 | 125 |

Cashe/Cashe.Decimal [ Types ]

126 | 127 |

[ Top ] [ Cashe ] [ Types ]

128 |

DESCRIPTION

129 | 
    128-bit decimal number, ranging from:
130 |     -999_999_999_999_999_999.99999999999999999999 to
131 |     999_999_999_999_999_999.99999999999999999999
132 |     Used for storing the currency.
133 |
134 |

SOURCE

135 | 
   type Decimal is delta 1.0E-20 digits 38;
136 |
137 |

EXAMPLE

138 | 
   --    My_Dec : Decimal := 1.12345678909876543210;
139 |
140 | 141 |
142 | 143 |

Cashe/Cashe.Decimal_Major [ Types ]

144 | 145 |

[ Top ] [ Cashe ] [ Types ]

146 |

DESCRIPTION

147 | 
    Integer number, ranging from:
148 |     -999_999_999_999_999_999 to 999_999_999_999_999_999
149 |     Used for setting major units without precision.
150 |
151 |

SOURCE

152 | 
   subtype Decimal_Major is Long_Long_Integer
153 |       range -(1E+18 - 1) .. +(1E+18 - 1);
154 |
155 |

DERIVED FROM

156 | 
    Long_Long_Integer
157 |
158 | 159 |
160 | 161 |

Cashe/Cashe.Decimal_Minor [ Types ]

162 | 163 |

[ Top ] [ Cashe ] [ Types ]

164 |

DESCRIPTION

165 | 
    128-bit integer number, ranging from:
166 |     -99_999_999_999_999_999_999_999_999_999_999_999_999 to
167 |     99_999_999_999_999_999_999_999_999_999_999_999_999
168 |     Used for setting / accessing minor units
169 |
170 |

SOURCE

171 | 
   subtype Decimal_Minor is Long_Long_Long_Integer
172 |       range -(1E+38 - 1) .. +(1E+38 - 1);
173 |
174 |

DERIVED FROM

175 | 
    Long_Long_Long_Integer
176 |
177 | 178 |
179 | 180 |

Cashe/Cashe.Round_Method [ Types ]

181 | 182 |

[ Top ] [ Cashe ] [ Types ]

183 |

DESCRIPTION

184 | 
    Rounding methods.
185 |
186 |

SOURCE

187 | 
   type Round_Method is (
188 |       Half_Even,
189 |       --  Default rounding method, also known as "Banker's Rounding"
190 |       Half_Up
191 |       --  Standard-behavior rounding, the kind taught in highschool.
192 |       );
193 |
194 | 195 |
196 | 197 |

Cashe/Cashe.Max_Integer_Len [ Constants ]

198 | 199 |

[ Top ] [ Cashe ] [ Constants ]

200 |

DESCRIPTION

201 | 
    The maximum number of decimal numbers that a major unit can be.
202 |
203 |

SOURCE

204 | 
   Max_Integer_Len : constant := 18;
205 |
206 | 207 |
208 | 209 |

Cashe/Cashe.Max_Precision [ Constants ]

210 | 211 |

[ Top ] [ Cashe ] [ Constants ]

212 |

DESCRIPTION

213 | 
    The maximum precision that this decimal type has.
214 |
215 |

SOURCE

216 | 
   Max_Precision   : constant := 20;
217 |
218 | 219 |
220 | 221 |

Cashe/Cashe.Minor_Unit_Too_Large [ Exceptions ]

222 | 223 |

[ Top ] [ Cashe ] [ Exceptions ]

224 |

DESCRIPTION

225 | 
    Raised if the minor unit will not "fit" into the major unit.
226 |
227 |

SOURCE

228 | 
   Minor_Unit_Too_Large : exception;
229 |
230 | 231 |
232 | 233 |

Cashe/Cashe.Round [ Subprograms ]

234 | 235 |

[ Top ] [ Cashe ] [ Subprograms ]

236 |

SOURCE

237 | 
   function Round
238 |       (Item : Decimal;
239 |        --  The decimal to round
240 |        By : Natural;
241 |        --  The precision which to round to.
242 |        Method : Round_Method := Half_Even
243 |        --  The method of rounding.  Default is Half_Even aka Banker's Rounding.
244 |       )
245 |    return Decimal with pre => By <= Max_Precision;
246 |
247 |

PARAMETERS

248 | 
    Item - Decimal to be rounded
249 |     By - Precision to round to.
250 |
251 |

EXAMPLE

252 | 
   --    T : Decimal := -2000.005;
253 |    --    A : Decimal := Round (T, 2);          --  -2000.00
254 |    --    B : Decimal := Round (T, 2, Half_Up); --  -2000.01
255 |
256 |

FUNCTION

257 | 
    Round the value of a money object to a given precision
258 |
259 |

RETURN VALUE

260 | 
    Cashe.Decimal - Decimal value rounded to Precision.
261 |
262 | 263 |
264 | 265 |

Cashe/Cashe.To_Decimal [ Subprograms ]

266 | 267 |

[ Top ] [ Cashe ] [ Subprograms ]

268 |

ERRORS

269 | 
    * Cashe/Cashe.Minor_Unit_Too_Large in case of converting Minor Unit
270 |
271 |

SOURCE

272 | 
   function To_Decimal
273 |       (Item : Float;
274 |        --  Floating point to be converted to a decimal.
275 |        Precision : Natural := 20
276 |        --  Precision to round to. Default is 20.
277 |       ) return Decimal;
278 |    function To_Decimal
279 |       (Item : Long_Float;
280 |        --  Floating point to be converted to a decimal.
281 |        Precision : Natural := 20
282 |        --  Precision to round to. Default is 20.
283 |       ) return Decimal;
284 |    function To_Decimal
285 |       (Item : Long_Long_Float;
286 |        --  Floating point to be converted to a decimal.
287 |        Precision : Natural := 20
288 |        --  Precision to round to. Default is 20.
289 |        ) return Decimal;
290 |    function To_Decimal
291 |       (Value : Decimal_Minor;
292 |        --  The whole number which to convert into a decimal
293 |        Precision : Natural := 20
294 |        --  The maount of decimal places out
295 |       )
296 |    return Decimal with
297 |       pre => Precision <= Max_Precision;
298 |
299 |

PARAMETERS

300 | 
    Item - Floating point to be converted.
301 |     Precision - Precision to round to. Default is 20.
302 |
303 |

EXAMPLE

304 | 
   --    with Cashe; use Cashe;
305 |    --    D : Decimal_Minor   :=                1411900
306 |    --    F : Long_Long_Float :=                14.1190004014938372284932918;
307 |    --    A : Decimal := To_Decimal (F);    --  14.11900040149383722880
308 |    --    B : Decimal := To_Decimal (F, 3); --  14.11900000000000000000
309 |    --    C : Decimal := To_Decimal (F, 2); --  14.12000000000000000000
310 |    --    E : Decimal := To_Decimal (D, 5); --  14.11900
311 |
312 |

FUNCTION

313 | 
    Convert a floating point number or minor unit to a Decimal based on
314 |     precision.  Highly recommended to use this function with 
315 |     Long_Long_Float for highest precision.
316 |
317 |

RETURN VALUE

318 | 
    Cashe.Decimal - Decimal value of float to Precision.
319 |
320 | 321 |
322 | 325 | 326 | 327 | --------------------------------------------------------------------------------