haspara 0.0.0.2 → 0.0.0.3

raw patch · 9 files changed

+360/−158 lines, 9 filesdep −deriving-aesondep ~aesondep ~containersdep ~doctestPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: deriving-aeson

Dependency ranges changed: aeson, containers, doctest, megaparsec, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−1
• README.md +2/−2
• haspara.cabal +113/−86
• src/Haspara/Accounting/Account.hs +21/−7
• src/Haspara/Accounting/Ledger.hs +30/−9
• src/Haspara/Currency.hs +11/−3
• src/Haspara/FxQuote.hs +120/−31
• src/Haspara/Internal/Aeson.hs +22/−6
• src/Haspara/Monetary.hs +22/−13

@@ -2,6 +2,22 @@ ## [Unreleased]  +<a name="0.0.0.3"></a>+## [0.0.0.3] - 2022-06-17+### Chore+- drop deriving-aeson dependency+- adopt Stack lts-19.11 (and GHC902), add Nix Shell+- bump development version to 0.0.0.3+- **build:** specify dependency version ranges++### Refactor+- revisit Haspara.FxQuote module, add new definitions++### Pull Requests+- Merge pull request [#6](https://github.com/telostat/haspara/issues/6) from telostat/chores-fixes-improvements+- Merge pull request [#7](https://github.com/telostat/haspara/issues/7) from telostat/vst/ghc902++ <a name="0.0.0.2"></a> ## [0.0.0.2] - 2022-03-03 ### Chore@@ -10,6 +26,7 @@ - **dev:** add HLint configuration - **dev:** produce .hie files during compilation - **docs:** update README.md, fix haddock warnings+- **release:** 0.0.0.2  ### Refactor - revisit Haspara.Accounting module and its submodules@@ -62,6 +79,7 @@ - Merge pull request [#1](https://github.com/telostat/haspara/issues/1) from telostat/init  -[Unreleased]: https://github.com/telostat/haspara/compare/0.0.0.2...HEAD+[Unreleased]: https://github.com/telostat/haspara/compare/0.0.0.3...HEAD+[0.0.0.3]: https://github.com/telostat/haspara/compare/0.0.0.2...0.0.0.3 [0.0.0.2]: https://github.com/telostat/haspara/compare/0.0.0.1...0.0.0.2 [0.0.0.1]: https://github.com/telostat/haspara/compare/0.0.0.0...0.0.0.1

@@ -92,13 +92,13 @@ 1. Release to Hackage as a candidate first and check the result:      ```sh-    stack upload --pvp-bounds both --candidate .+    stack upload --candidate .     ```  1. If the candidate package release works fine, release to Hackage:      ```sh-    stack upload --pvp-bounds both .+    stack upload .     ```  1. Checkout to `develop` and rebase onto `main`:

@@ -1,97 +1,124 @@-cabal-version:      1.12-name:               haspara-version:            0.0.0.2-license:            MIT-license-file:       LICENSE-copyright:          Copyright (c) 2021-2022 Telostat Pte Ltd-maintainer:         vst@vsthost.com-author:             Vehbi Sinan Tunalioglu-homepage:           https://github.com/telostat/haspara#readme-bug-reports:        https://github.com/telostat/haspara/issues-synopsis:-    A library providing definitions to work with monetary values.+cabal-version: 1.12 -description:-    Please see the README on GitHub at <https://github.com/telostat/haspara#readme>+-- This file has been generated from package.yaml by hpack version 0.34.7.+--+-- see: https://github.com/sol/hpack -category:           Finance-build-type:         Simple+name:           haspara+version:        0.0.0.3+synopsis:       A library providing definitions to work with monetary values.+description:    Please see the README on GitHub at <https://github.com/telostat/haspara#readme>+category:       Finance+homepage:       https://github.com/telostat/haspara#readme+bug-reports:    https://github.com/telostat/haspara/issues+author:         Vehbi Sinan Tunalioglu+maintainer:     vst@vsthost.com+copyright:      Copyright (c) 2021-2022 Telostat Pte Ltd+license:        MIT+license-file:   LICENSE+build-type:     Simple extra-source-files:     README.md     CHANGELOG.md  source-repository head-    type:     git-    location: https://github.com/telostat/haspara+  type: git+  location: https://github.com/telostat/haspara  library-    exposed-modules:-        Haspara-        Haspara.Accounting-        Haspara.Accounting.Account-        Haspara.Accounting.Event-        Haspara.Accounting.Ledger-        Haspara.Currency-        Haspara.FxQuote-        Haspara.Internal.Aeson-        Haspara.Monetary-        Haspara.Quantity-        Haspara.TH--    hs-source-dirs:     src-    other-modules:      Paths_haspara-    default-language:   Haskell2010-    default-extensions:-        BangPatterns BinaryLiterals ConstrainedClassMethods ConstraintKinds-        DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric-        DeriveLift DeriveTraversable EmptyCase EmptyDataDeriving-        ExistentialQuantification ExplicitForAll FlexibleContexts-        FlexibleInstances GADTSyntax GeneralisedNewtypeDeriving-        HexFloatLiterals ImportQualifiedPost InstanceSigs KindSignatures-        MultiParamTypeClasses NamedFieldPuns NamedWildCards-        NumericUnderscores PolyKinds PostfixOperators RankNTypes-        ScopedTypeVariables StandaloneDeriving StandaloneKindSignatures-        TupleSections TypeApplications TypeOperators TypeSynonymInstances-        OverloadedStrings--    ghc-options:        -Wall -Wunused-packages-    build-depends:-        aeson >=1.5.6.0 && <1.6,-        base >=4.11 && <5,-        containers >=0.6.5.1 && <0.7,-        deriving-aeson >=0.2.8 && <0.3,-        exceptions >=0.10.4 && <0.11,-        hashable >=1.3.0.0 && <1.4,-        megaparsec >=9.0.1 && <9.1,-        mtl >=2.2.2 && <2.3,-        refined >=0.6.3 && <0.7,-        safe-decimal >=0.2.1.0 && <0.3,-        scientific >=0.3.7.0 && <0.4,-        template-haskell >=2.16.0.0 && <2.17,-        text >=1.2.4.1 && <1.3,-        time >=1.9.3 && <1.10+  exposed-modules:+      Haspara+      Haspara.Accounting+      Haspara.Accounting.Account+      Haspara.Accounting.Event+      Haspara.Accounting.Ledger+      Haspara.Currency+      Haspara.FxQuote+      Haspara.Internal.Aeson+      Haspara.Monetary+      Haspara.Quantity+      Haspara.TH+  other-modules:+      Paths_haspara+  hs-source-dirs:+      src+  default-extensions:+      BangPatterns+      BinaryLiterals+      ConstrainedClassMethods+      ConstraintKinds+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      EmptyCase+      EmptyDataDeriving+      ExistentialQuantification+      ExplicitForAll+      FlexibleContexts+      FlexibleInstances+      GADTSyntax+      GeneralisedNewtypeDeriving+      HexFloatLiterals+      ImportQualifiedPost+      InstanceSigs+      KindSignatures+      MultiParamTypeClasses+      NamedFieldPuns+      NamedWildCards+      NumericUnderscores+      PolyKinds+      PostfixOperators+      RankNTypes+      ScopedTypeVariables+      StandaloneDeriving+      StandaloneKindSignatures+      TupleSections+      TypeApplications+      TypeOperators+      TypeSynonymInstances+      OverloadedStrings+  ghc-options: -Wall -Wunused-packages+  build-depends:+      aeson >=1.5.6.0 && <2.1+    , base >=4.11 && <5+    , containers >=0.6.4.1 && <0.7+    , exceptions >=0.10.4 && <0.11+    , hashable >=1.3.0.0 && <1.4+    , megaparsec >=9.0.1 && <9.3+    , mtl >=2.2.2 && <2.3+    , refined >=0.6.3 && <0.7+    , safe-decimal >=0.2.1.0 && <0.3+    , scientific >=0.3.7.0 && <0.4+    , template-haskell >=2.16.0.0 && <2.18+    , text >=1.2.4.1 && <1.3+    , time >=1.9.3 && <1.10+  default-language: Haskell2010  test-suite haspara-doctest-    type:             exitcode-stdio-1.0-    main-is:          doctest.hs-    hs-source-dirs:   test-    other-modules:    Paths_haspara-    default-language: Haskell2010-    ghc-options:      -threaded-    build-depends:-        aeson >=1.5.6.0 && <1.6,-        base >=4.11 && <5,-        containers >=0.6.5.1 && <0.7,-        deriving-aeson >=0.2.8 && <0.3,-        doctest ==0.17.*,-        exceptions >=0.10.4 && <0.11,-        hashable >=1.3.0.0 && <1.4,-        haspara -any,-        megaparsec >=9.0.1 && <9.1,-        mtl >=2.2.2 && <2.3,-        refined >=0.6.3 && <0.7,-        safe-decimal >=0.2.1.0 && <0.3,-        scientific >=0.3.7.0 && <0.4,-        template-haskell >=2.16.0.0 && <2.17,-        text >=1.2.4.1 && <1.3,-        time >=1.9.3 && <1.10+  type: exitcode-stdio-1.0+  main-is: doctest.hs+  other-modules:+      Paths_haspara+  hs-source-dirs:+      test+  ghc-options: -threaded+  build-depends:+      aeson >=1.5.6.0 && <2.1+    , base >=4.11 && <5+    , containers >=0.6.4.1 && <0.7+    , doctest+    , exceptions >=0.10.4 && <0.11+    , hashable >=1.3.0.0 && <1.4+    , haspara+    , megaparsec >=9.0.1 && <9.3+    , mtl >=2.2.2 && <2.3+    , refined >=0.6.3 && <0.7+    , safe-decimal >=0.2.1.0 && <0.3+    , scientific >=0.3.7.0 && <0.4+    , template-haskell >=2.16.0.0 && <2.18+    , text >=1.2.4.1 && <1.3+    , time >=1.9.3 && <1.10+  default-language: Haskell2010

@@ -6,11 +6,11 @@  module Haspara.Accounting.Account where +import qualified Data.Aeson             as Aeson import           Data.Hashable          (Hashable) import qualified Data.Text              as T-import qualified Deriving.Aeson         as DA-import qualified Deriving.Aeson.Stock   as DAS-import           Haspara.Internal.Aeson (UpperCase)+import           GHC.Generics           (Generic)+import           Haspara.Internal.Aeson (aesonOptionsForSingleTag, commonAesonOptions)   -- * Account Kind@@ -57,13 +57,20 @@   | AccountKindEquity   | AccountKindRevenue   | AccountKindExpense-  deriving (Enum, Eq, DA.Generic, Ord, Show)-  deriving (DA.FromJSON, DA.ToJSON) via DA.CustomJSON '[DA.ConstructorTagModifier (DA.StripPrefix "AccountKind", UpperCase)] AccountKind+  deriving (Enum, Eq, Generic, Ord, Show)   instance Hashable AccountKind  +instance Aeson.FromJSON AccountKind where+  parseJSON = Aeson.genericParseJSON $ aesonOptionsForSingleTag "AccountKind"+++instance Aeson.ToJSON AccountKind where+  toJSON = Aeson.genericToJSON $ aesonOptionsForSingleTag "AccountKind"++ -- | Provides textual representation of a given 'AccountKind'. -- -- >>> accountKindText AccountKindAsset@@ -106,8 +113,15 @@   { accountKind   :: !AccountKind   , accountObject :: !o   }-  deriving (Eq, DAS.Generic, Ord, Show)-  deriving (DAS.FromJSON, DAS.ToJSON) via DAS.PrefixedSnake "account" (Account o)+  deriving (Eq, Generic, Ord, Show)   instance Hashable o => Hashable (Account o)+++instance Aeson.FromJSON o => Aeson.FromJSON (Account o) where+  parseJSON = Aeson.genericParseJSON $ commonAesonOptions "account"+++instance Aeson.ToJSON o => Aeson.ToJSON (Account o) where+  toJSON = Aeson.genericToJSON $ commonAesonOptions "account"

@@ -11,11 +11,11 @@ import qualified Data.List.NonEmpty         as NE import qualified Data.Text                  as T import           Data.Time                  (Day)-import           Deriving.Aeson             (CustomJSON(CustomJSON), FromJSON, Generic, ToJSON)-import           Deriving.Aeson.Stock       (PrefixedSnake, Vanilla)+import           GHC.Generics               (Generic) import           GHC.TypeLits               (KnownNat, Nat) import           Haspara.Accounting.Account (Account(accountKind), AccountKind(..)) import           Haspara.Accounting.Event   (Event(..), eventObject)+import           Haspara.Internal.Aeson     (commonAesonOptions) import           Haspara.Quantity           (Quantity, UnsignedQuantity) import           Refined                    (unrefine) @@ -26,19 +26,34 @@   , ledgerOpening :: !(Quantity s)   , ledgerClosing :: !(Quantity s)   , ledgerRunning :: ![LedgerItem o s]-  } deriving (Eq, Generic, Ord, Show)-  deriving (FromJSON, ToJSON) via PrefixedSnake "ledger" (Ledger a o s)+  }+  deriving (Eq, Generic, Ord, Show)  +instance (Aeson.FromJSON a, Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (Ledger a o s) where+  parseJSON = Aeson.genericParseJSON $ commonAesonOptions "ledger"+++instance (Aeson.ToJSON a, Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (Ledger a o s) where+  toJSON = Aeson.genericToJSON $ commonAesonOptions "ledger"++ -- | Type encoding of a ledger item. data LedgerItem o (s :: Nat) = LedgerItem   { ledgerItemEntry   :: !(Entry o s)   , ledgerItemBalance :: !(Quantity s)-  } deriving (Eq, Generic, Ord, Show)-  deriving (FromJSON, ToJSON)-  via PrefixedSnake "ledgerItem" (LedgerItem o s)+  }+  deriving (Eq, Generic, Ord, Show)  +instance (Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (LedgerItem o s) where+  parseJSON = Aeson.genericParseJSON $ commonAesonOptions "ledgerItem"+++instance (Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (LedgerItem o s) where+  toJSON = Aeson.genericToJSON $ commonAesonOptions "ledgerItem"++ -- | Creates a ledger from a given list of 'Entry' values. mkLedger :: KnownNat s => Account a -> Quantity s -> [Entry o s] -> Ledger a o s mkLedger a o = foldl addEntry (Ledger a o o [])@@ -74,8 +89,14 @@ -- True newtype Posting a o (s :: Nat) = Posting (NE.NonEmpty (Event o s, Account a))   deriving (Eq, Generic, Ord, Show)-  deriving (FromJSON, ToJSON)-  via Vanilla (Posting a o s)+++instance (Aeson.FromJSON a, Aeson.FromJSON o, KnownNat s) => Aeson.FromJSON (Posting a o s) where+  parseJSON = Aeson.genericParseJSON Aeson.defaultOptions+++instance (Aeson.ToJSON a, Aeson.ToJSON o, KnownNat s) => Aeson.ToJSON (Posting a o s) where+  toJSON = Aeson.genericToJSON Aeson.defaultOptions   -- | Returns the list of posting event sources.

@@ -11,7 +11,8 @@ import           Data.String                (IsString(..)) import qualified Data.Text                  as T import           Data.Void                  (Void)-import qualified Deriving.Aeson.Stock       as DAS+import           GHC.Generics               (Generic)+import           Haspara.Internal.Aeson     (commonAesonOptions) import qualified Language.Haskell.TH.Syntax as TH import qualified Text.Megaparsec            as MP @@ -162,8 +163,15 @@   { currencyPairBase  :: !Currency  -- ^ /Base currency/ of the currency pair. Also referred to as /counter currency/.   , currencyPairQuote :: !Currency  -- ^ /Quote currency/ of the currency pair. Also referred to as /transaction currency/.   }-  deriving (Eq, DAS.Generic, Ord, TH.Lift)-  deriving (DAS.FromJSON, DAS.ToJSON) via DAS.PrefixedSnake "currencyPair" CurrencyPair+  deriving (Eq, Generic, Ord, TH.Lift)+++instance Aeson.FromJSON CurrencyPair where+  parseJSON = Aeson.genericParseJSON $ commonAesonOptions "currencyPair"+++instance Aeson.ToJSON CurrencyPair where+  toJSON = Aeson.genericToJSON $ commonAesonOptions "currencyPair"   -- | 'Show' instance for 'CurrencyPair'.

@@ -6,16 +6,19 @@  module Haspara.FxQuote where -import           Control.Monad.Except (MonadError(throwError))-import qualified Data.Map.Strict      as SM-import           Data.Scientific      (Scientific)-import qualified Data.Text            as T-import           Data.Time            (Day, addDays)-import qualified Deriving.Aeson.Stock as DAS-import           GHC.TypeLits         (KnownNat, Nat)-import           Haspara.Currency     (Currency, CurrencyPair(CurrencyPair))-import           Haspara.Quantity     (Quantity(..), mkQuantity)-import           Refined              (Positive, Refined, refineError)+import           Control.Monad.Except   (MonadError(throwError))+import qualified Data.Aeson             as Aeson+import           Data.Foldable          (foldl')+import qualified Data.Map.Strict        as SM+import           Data.Scientific        (Scientific)+import qualified Data.Text              as T+import           Data.Time              (Day, addDays)+import           GHC.Generics           (Generic)+import           GHC.TypeLits           (KnownNat, Nat)+import           Haspara.Currency       (Currency, CurrencyPair(CurrencyPair))+import           Haspara.Internal.Aeson (commonAesonOptions)+import           Haspara.Quantity       (Quantity(..), mkQuantity)+import           Refined                (Positive, Refined, refineError)   -- * FX Rate Quotation@@ -29,36 +32,41 @@ -- 1. a currency pair the rate is quoted for, and -- 2. a date that the quotation is effective as of, -- 3. a (positive) rate as the value of the quotation.------ >>> data FxQuote (s :: Nat) = MkFxQuote   { fxQuotePair :: !CurrencyPair  -- ^ Currency pair of the FX rate.   , fxQuoteDate :: !Day  -- ^ Actual date of the FX rate.   , fxQuoteRate :: !(Refined Positive (Quantity s))  -- ^ (Positive) rate value of the FX rate.   }-  deriving (Eq, DAS.Generic, Ord, Show)-  deriving (DAS.FromJSON, DAS.ToJSON) via DAS.PrefixedSnake "fxQuote" (FxQuote s)+  deriving (Eq, Generic, Ord, Show)  +instance KnownNat s => Aeson.FromJSON (FxQuote s) where+  parseJSON = Aeson.genericParseJSON $ commonAesonOptions "fxQuote"+++instance KnownNat s => Aeson.ToJSON (FxQuote s) where+  toJSON = Aeson.genericToJSON $ commonAesonOptions "fxQuote"++ -- | Smart constructor for 'FxQuote' values within @'MonadError' 'T.Text'@ -- context. -- -- The rate is expected to be a positive value. If it is not, the function will -- throw an error. ----- >>> mkFxQuoteError @(Either _) @2 (read "2021-12-31") "EUR" "USD" 1.16+-- >>> mkFxQuoteError @(Either _) @2 "EUR" "USD" (read "2021-12-31") 1.16 -- Right (MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16})--- >>> mkFxQuoteError @(Either _) @2 (read "2021-12-31") "EUR" "USD" (-1.16)+-- >>> mkFxQuoteError @(Either _) @2 "EUR" "USD" (read "2021-12-31") (-1.16) -- Left "Can not create FX Rate. Error was:   The predicate (GreaterThan 0) failed with the message: Value is not greater than 0\n" mkFxQuoteError   :: MonadError T.Text m   => KnownNat s-  => Day         -- ^ Date of the FX quotation.-  -> Currency    -- ^ Base currency (from) of the FX quotation.+  => Currency    -- ^ Base currency (from) of the FX quotation.   -> Currency    -- ^ Quote currency (to) of the FX quotation.+  -> Day         -- ^ Date of the FX quotation.   -> Scientific  -- ^ FX quotation rate, expected to be positive.   -> m (FxQuote s)-mkFxQuoteError date ccy1 ccy2 rate =+mkFxQuoteError ccy1 ccy2 date rate =   either (throwError . (<>) "Can not create FX Rate. Error was: ") pure $ do     pval <- either (Left . T.pack . show) pure $ refineError (mkQuantity rate)     pure $ MkFxQuote (CurrencyPair ccy1 ccy2) date pval@@ -68,43 +76,53 @@ -- -- The rate is expected to be a positive value. If it is not, the function will -- fail.--- >>> mkFxQuoteFail @Maybe @2 (read "2021-12-31") "EUR" "USD" 1.16+-- >>> mkFxQuoteFail @Maybe @2 "EUR" "USD" (read "2021-12-31") 1.16 -- Just (MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16})--- >>> mkFxQuoteFail @Maybe @2 (read "2021-12-31") "EUR" "USD" (-1.16)+-- >>> mkFxQuoteFail @Maybe @2 "EUR" "USD" (read "2021-12-31") (-1.16) -- Nothing mkFxQuoteFail   :: MonadFail m   => KnownNat s-  => Day         -- ^ Date of the FX quotation.-  -> Currency    -- ^ Base currency (from) of the FX quotation.+  => Currency    -- ^ Base currency (from) of the FX quotation.   -> Currency    -- ^ Quote currency (to) of the FX quotation.+  -> Day         -- ^ Date of the FX quotation.   -> Scientific  -- ^ FX quotation rate, expected to be positive.   -> m (FxQuote s)-mkFxQuoteFail date ccy1 ccy2 =-  either (fail . T.unpack) pure . mkFxQuoteError date ccy1 ccy2+mkFxQuoteFail ccy1 ccy2 date =+  either (fail . T.unpack) pure . mkFxQuoteError ccy1 ccy2 date   -- | Unsafe 'FxQuote' constructor that 'error's if it fails. ----- >>> mkFxQuoteUnsafe @2 (read "2021-12-31") "EUR" "USD" 1.16+-- >>> mkFxQuoteUnsafe @2 "EUR" "USD" (read "2021-12-31") 1.16 -- MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.16}--- >>> mkFxQuoteUnsafe @2 (read "2021-12-31") "EUR" "USD" (-1.16)+-- >>> mkFxQuoteUnsafe @2 "EUR" "USD" (read "2021-12-31") (-1.16) -- ... -- ...Can not create FX Rate. Error was:   The predicate (GreaterThan 0) failed with the message: Value is not greater than 0 -- ... mkFxQuoteUnsafe   :: KnownNat s-  => Day         -- ^ Date of the FX quotation.-  -> Currency    -- ^ Base currency (from) of the FX quotation.+  => Currency    -- ^ Base currency (from) of the FX quotation.   -> Currency    -- ^ Quote currency (to) of the FX quotation.+  -> Day         -- ^ Date of the FX quotation.   -> Scientific  -- ^ FX quotation rate, expected to be positive.   -> FxQuote s-mkFxQuoteUnsafe date ccy1 ccy2 =-  either (error . T.unpack) id . mkFxQuoteError date ccy1 ccy2+mkFxQuoteUnsafe ccy1 ccy2 date =+  either (error . T.unpack) id . mkFxQuoteError ccy1 ccy2 date   -- * FX Rate Quotation Database -- $fxRateQuotationDatabase+--+-- >>> let database = addFxQuotes [mkFxQuoteUnsafe @8 "EUR" "USD" (read "2021-12-31") 1.13, mkFxQuoteUnsafe @8 "EUR" "TRY" (read "2021-12-31") 15.14] emptyFxQuoteDatabase+-- >>> findFxQuote database (CurrencyPair "EUR" "USD") (read "2021-12-31")+-- Just (MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 1.13000000})+-- >>> findFxQuote database (CurrencyPair "EUR" "TRY") (read "2021-12-31")+-- Just (MkFxQuote {fxQuotePair = EUR/TRY, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 15.14000000})+-- >>> findFxQuote database (CurrencyPair "EUR" "TRY") (read "2021-12-30")+-- Nothing+-- >>> findFxQuote database (CurrencyPair "EUR" "TRY") (read "2022-01-01")+-- Just (MkFxQuote {fxQuotePair = EUR/TRY, fxQuoteDate = 2021-12-31, fxQuoteRate = Refined 15.14000000})   -- | Type encoding for a dictionary-based FX rate quotation database for various@@ -119,6 +137,7 @@   , fxQuotePairDatabaseSince :: !Day   , fxQuotePairDatabaseUntil :: !Day   }+  deriving Show   -- | Attempts to find and return the FX quotation for a given 'CurrencyPair' as@@ -140,3 +159,73 @@   | otherwise = case SM.lookup date (fxQuotePairDatabaseTable db) of       Nothing -> findFxQuoteAux (addDays (-1) date) db       Just fx -> Just fx+++-- | Returns empty FX rate quotation database.+--+-- >>> emptyFxQuoteDatabase @8+-- fromList []+emptyFxQuoteDatabase+  :: KnownNat n+  => FxQuoteDatabase n+emptyFxQuoteDatabase = SM.empty+++-- | Adds a list of FX rate quotations to the given database.+--+-- >>> let database = emptyFxQuoteDatabase @8+-- >>> addFxQuotes [] database+-- fromList []+-- >>> addFxQuotes [mkFxQuoteUnsafe @8 "EUR" "USD" (read "2021-01-31") 1.13] database+-- fromList [(EUR/USD,FxQuotePairDatabase {fxQuotePairDatabasePair = EUR/USD, fxQuotePairDatabaseTable = fromList [(2021-01-31,MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-01-31, fxQuoteRate = Refined 1.13000000})], fxQuotePairDatabaseSince = 2021-01-31, fxQuotePairDatabaseUntil = 2021-01-31})]+-- >>> addFxQuotes [mkFxQuoteUnsafe @8 "EUR" "USD" (read "2021-01-31") 1.13, mkFxQuoteUnsafe @8 "USD" "EUR" (read "2021-01-31") 0.884956] database+-- fromList [(EUR/USD,FxQuotePairDatabase {fxQuotePairDatabasePair = EUR/USD, fxQuotePairDatabaseTable = fromList [(2021-01-31,MkFxQuote {fxQuotePair = EUR/USD, fxQuoteDate = 2021-01-31, fxQuoteRate = Refined 1.13000000})], fxQuotePairDatabaseSince = 2021-01-31, fxQuotePairDatabaseUntil = 2021-01-31}),(USD/EUR,FxQuotePairDatabase {fxQuotePairDatabasePair = USD/EUR, fxQuotePairDatabaseTable = fromList [(2021-01-31,MkFxQuote {fxQuotePair = USD/EUR, fxQuoteDate = 2021-01-31, fxQuoteRate = Refined 0.88495600})], fxQuotePairDatabaseSince = 2021-01-31, fxQuotePairDatabaseUntil = 2021-01-31})]+addFxQuotes+  :: KnownNat n+  => [FxQuote n]+  -> FxQuoteDatabase n+  -> FxQuoteDatabase n+addFxQuotes quotes database = foldl' (flip addFxQuote) database quotes+++-- | Adds an FX rate quotation to the given database.+addFxQuote+  :: KnownNat n+  => FxQuote n+  -> FxQuoteDatabase n+  -> FxQuoteDatabase n+addFxQuote quote@(MkFxQuote pair _ _) database = case SM.lookup pair database of+  Nothing  -> SM.insert pair (initFxQuotePairDatabase quote) database+  Just fpd -> SM.insert pair (updateFxQuotePairDatabase quote fpd) database+++-- * Internal+-- $internal+++-- | Initializes FX quote pair database with the given FX quote.+initFxQuotePairDatabase+  :: KnownNat n+  => FxQuote n+  -> FxQuotePairDatabase n+initFxQuotePairDatabase quote@(MkFxQuote pair date _) =+  FxQuotePairDatabase+    { fxQuotePairDatabasePair  = pair+    , fxQuotePairDatabaseTable = SM.singleton date quote+    , fxQuotePairDatabaseSince = date+    , fxQuotePairDatabaseUntil = date+    }+++-- | Updates an existing FX quote pair database with the given FX quote.+updateFxQuotePairDatabase+  :: KnownNat n+  => FxQuote n+  -> FxQuotePairDatabase n+  -> FxQuotePairDatabase n+updateFxQuotePairDatabase quote@(MkFxQuote _ date _) before =+  before+    { fxQuotePairDatabaseTable = SM.insert date quote (fxQuotePairDatabaseTable before)+    , fxQuotePairDatabaseSince = min (fxQuotePairDatabaseSince before) date+    , fxQuotePairDatabaseUntil = max (fxQuotePairDatabaseUntil before) date+    }

@@ -2,13 +2,29 @@  module Haspara.Internal.Aeson where -import qualified Data.Char      as C-import qualified Deriving.Aeson as DA+import qualified Data.Aeson as Aeson+import qualified Data.Char  as C+import           Data.List  (stripPrefix)+import           Data.Maybe (fromMaybe)  --- | Type definition for string modifiers that uppercase a given symbol.-data UpperCase+-- | Common Aeson encoding/decoding options.+commonAesonOptions :: String -> Aeson.Options+commonAesonOptions prefix =+  Aeson.defaultOptions+    { Aeson.omitNothingFields = True+    , Aeson.fieldLabelModifier = \l -> Aeson.camelTo2 '_' . fromMaybe l $ stripPrefix prefix l+    , Aeson.constructorTagModifier = \l -> Aeson.camelTo2 '_' . fromMaybe l $ stripPrefix prefix l+    , Aeson.sumEncoding = Aeson.TaggedObject+        { Aeson.tagFieldName = "type"+        , Aeson.contentsFieldName = "value"+        }+    }  -instance DA.StringModifier UpperCase where-  getStringModifier = fmap C.toUpper+-- | Aeson encoding/decoding options for uppercase constructor tag modifiers+aesonOptionsForSingleTag :: String -> Aeson.Options+aesonOptionsForSingleTag prefix =+  Aeson.defaultOptions+    { Aeson.constructorTagModifier = \l -> fmap C.toUpper . Aeson.camelTo2 '_' . fromMaybe l $ stripPrefix prefix l+    }

@@ -6,17 +6,19 @@  module Haspara.Monetary where -import           Control.Exception    (Exception)-import           Control.Monad        (when)-import           Control.Monad.Catch  (MonadThrow(throwM))-import           Data.Time            (Day)-import qualified Deriving.Aeson.Stock as DAS-import           GHC.Stack            (HasCallStack)-import           GHC.TypeLits         (KnownNat, Nat)-import           Haspara.Currency     (Currency, CurrencyPair(..))-import           Haspara.FxQuote      (FxQuote(..))-import           Haspara.Quantity     (Quantity, times)-import           Refined              (unrefine)+import           Control.Exception      (Exception)+import           Control.Monad          (when)+import           Control.Monad.Catch    (MonadThrow(throwM))+import qualified Data.Aeson             as Aeson+import           Data.Time              (Day)+import           GHC.Generics           (Generic)+import           GHC.Stack              (HasCallStack)+import           GHC.TypeLits           (KnownNat, Nat)+import           Haspara.Currency       (Currency, CurrencyPair(..))+import           Haspara.FxQuote        (FxQuote(..))+import           Haspara.Internal.Aeson (commonAesonOptions)+import           Haspara.Quantity       (Quantity, times)+import           Refined                (unrefine)   -- | Type encoding for dated monetary values.@@ -31,8 +33,15 @@   , moneyCurrency :: !Currency   , moneyQuantity :: !(Quantity s)   }-  deriving (Eq, DAS.Generic, Ord, Show)-  deriving (DAS.FromJSON, DAS.ToJSON) via DAS.PrefixedSnake "money" (Money s)+  deriving (Eq, Generic, Ord, Show)+++instance KnownNat s => Aeson.FromJSON (Money s) where+  parseJSON = Aeson.genericParseJSON $ commonAesonOptions "money"+++instance KnownNat s => Aeson.ToJSON (Money s) where+  toJSON = Aeson.genericToJSON $ commonAesonOptions "money"   -- | Type encoding of a monetary context.