From d7b7cff11e459626a2c9362c13587cad9f57c338 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Thu, 16 Jun 2022 12:39:40 +0800 Subject: [PATCH 1/2] chore: adopt Stack lts-19.11 (and GHC902), add Nix Shell --- shell.nix | 19 +++++++++++++++++++ stack-18.28.yaml | 14 ++++++++++++++ stack-18.28.yaml.lock | 12 ++++++++++++ stack.yaml | 11 ++++++++++- stack.yaml.lock | 8 ++++---- 5 files changed, 59 insertions(+), 5 deletions(-) create mode 100644 shell.nix create mode 100644 stack-18.28.yaml create mode 100644 stack-18.28.yaml.lock diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..10f0464 --- /dev/null +++ b/shell.nix @@ -0,0 +1,19 @@ +{ pkgs ? import (fetchTarball https://github.com/NixOS/nixpkgs/archive/22.05.tar.gz) { } +, ghcVersion ? "ghc902" +, ... +}: + +with pkgs; + +haskell.lib.buildStackProject rec { + name = "haspara-devshell"; + src = ./.; + ghc = haskell.packages.${ghcVersion}.ghc; + buildInputs = [ + haskell-language-server + haskellPackages.weeder + hlint + stack + stylish-haskell + ]; +} diff --git a/stack-18.28.yaml b/stack-18.28.yaml new file mode 100644 index 0000000..aa078ac --- /dev/null +++ b/stack-18.28.yaml @@ -0,0 +1,14 @@ +resolver: lts-18.28 + +packages: +- . + +ghc-options: + "$locals": -fwrite-ide-info + +nix: + enable: true + shell-file: shell.nix + nix-shell-options: + - "--arg" + - "ghcVersion=ghc8107" diff --git a/stack-18.28.yaml.lock b/stack-18.28.yaml.lock new file mode 100644 index 0000000..da10c3e --- /dev/null +++ b/stack-18.28.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68 + size: 590100 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml + original: lts-18.28 diff --git a/stack.yaml b/stack.yaml index 184432e..54c142d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,5 +1,14 @@ -resolver: lts-18.27 +resolver: lts-19.11 + packages: - . + ghc-options: "$locals": -fwrite-ide-info + +nix: + enable: true + shell-file: shell.nix + nix-shell-options: + - "--arg" + - "ghcVersion=ghc902" diff --git a/stack.yaml.lock b/stack.yaml.lock index e20c4bc..c1ebff2 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -6,7 +6,7 @@ packages: [] snapshots: - completed: - size: 590102 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/27.yaml - sha256: 79a786674930a89301b0e908fad2822a48882f3d01486117693c377b8edffdbe - original: lts-18.27 + sha256: 692668712aa3a6638401ce921cd043f5f9a8b018af9ba13ae350871196b047d6 + size: 619152 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/11.yaml + original: lts-19.11 From 0d415ea2840f62f71cd3b871e37ef1e9fb3dc1e5 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Thu, 16 Jun 2022 13:44:35 +0800 Subject: [PATCH 2/2] chore: drop deriving-aeson dependency deriving-aeson is hit by a regression in compile times when working with Aeson 2.x: https://github.com/fumieval/deriving-aeson/issues/16 PS: On an unrelated note, doctests are failing with: ``` stack test ``` ... but, at least, working with: ``` stack --stack-yaml stack-18.28.yaml test ``` --- haspara.cabal | 4 +--- package.yaml | 1 - src/Haspara/Accounting/Account.hs | 28 ++++++++++++++++------ src/Haspara/Accounting/Ledger.hs | 39 ++++++++++++++++++++++++------- src/Haspara/Currency.hs | 14 ++++++++--- src/Haspara/FxQuote.hs | 35 ++++++++++++++++----------- src/Haspara/Internal/Aeson.hs | 28 +++++++++++++++++----- src/Haspara/Monetary.hs | 35 ++++++++++++++++----------- 8 files changed, 129 insertions(+), 55 deletions(-) diff --git a/haspara.cabal b/haspara.cabal index ba6b3f7..e460b2a 100644 --- a/haspara.cabal +++ b/haspara.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack @@ -85,7 +85,6 @@ library aeson , base >=4.11 && <5 , containers - , deriving-aeson , exceptions , hashable , megaparsec @@ -110,7 +109,6 @@ test-suite haspara-doctest aeson , base >=4.11 && <5 , containers - , deriving-aeson , doctest , exceptions , hashable diff --git a/package.yaml b/package.yaml index f747a96..057e424 100644 --- a/package.yaml +++ b/package.yaml @@ -18,7 +18,6 @@ dependencies: - base >= 4.11 && < 5 - aeson - containers -- deriving-aeson - exceptions - hashable - megaparsec diff --git a/src/Haspara/Accounting/Account.hs b/src/Haspara/Accounting/Account.hs index c773425..75cd7a6 100644 --- a/src/Haspara/Accounting/Account.hs +++ b/src/Haspara/Accounting/Account.hs @@ -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 @@ data AccountKind = | 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 @@ data Account o = Account { 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" diff --git a/src/Haspara/Accounting/Ledger.hs b/src/Haspara/Accounting/Ledger.hs index 316fbae..6228b3b 100644 --- a/src/Haspara/Accounting/Ledger.hs +++ b/src/Haspara/Accounting/Ledger.hs @@ -11,11 +11,11 @@ import qualified Data.Char as C 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,17 +26,32 @@ data Ledger a o (s :: Nat) = Ledger , 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. @@ -74,8 +89,14 @@ addEntry l@(Ledger _ _ c r) e = l { ledgerClosing = balance, ledgerRunning = r < -- 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. diff --git a/src/Haspara/Currency.hs b/src/Haspara/Currency.hs index db3e8fe..a6a1413 100644 --- a/src/Haspara/Currency.hs +++ b/src/Haspara/Currency.hs @@ -11,7 +11,8 @@ import Data.Hashable (Hashable) 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 @@ data CurrencyPair = CurrencyPair { 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'. diff --git a/src/Haspara/FxQuote.hs b/src/Haspara/FxQuote.hs index b5c40f1..f4e0c1e 100644 --- a/src/Haspara/FxQuote.hs +++ b/src/Haspara/FxQuote.hs @@ -6,17 +6,19 @@ module Haspara.FxQuote where -import Control.Monad.Except (MonadError(throwError)) -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 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 @@ -35,8 +37,15 @@ data FxQuote (s :: Nat) = MkFxQuote , 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'@ diff --git a/src/Haspara/Internal/Aeson.hs b/src/Haspara/Internal/Aeson.hs index 46ddc54..3fa7624 100644 --- a/src/Haspara/Internal/Aeson.hs +++ b/src/Haspara/Internal/Aeson.hs @@ -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 + } diff --git a/src/Haspara/Monetary.hs b/src/Haspara/Monetary.hs index e9b96fa..b52f001 100644 --- a/src/Haspara/Monetary.hs +++ b/src/Haspara/Monetary.hs @@ -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 @@ data Money (s :: Nat) = Money , 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.