Skip to content

Commit

Permalink
chore: drop deriving-aeson dependency
Browse files Browse the repository at this point in the history
deriving-aeson is hit by a regression in compile times when working
with Aeson 2.x:

fumieval/deriving-aeson#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
```
  • Loading branch information
vst committed Jun 16, 2022
1 parent d7b7cff commit 0d415ea
Show file tree
Hide file tree
Showing 8 changed files with 129 additions and 55 deletions.
4 changes: 1 addition & 3 deletions haspara.cabal
Original file line number Diff line number Diff line change
@@ -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

Expand Down Expand Up @@ -85,7 +85,6 @@ library
aeson
, base >=4.11 && <5
, containers
, deriving-aeson
, exceptions
, hashable
, megaparsec
Expand All @@ -110,7 +109,6 @@ test-suite haspara-doctest
aeson
, base >=4.11 && <5
, containers
, deriving-aeson
, doctest
, exceptions
, hashable
Expand Down
1 change: 0 additions & 1 deletion package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,6 @@ dependencies:
- base >= 4.11 && < 5
- aeson
- containers
- deriving-aeson
- exceptions
- hashable
- megaparsec
Expand Down
28 changes: 21 additions & 7 deletions src/Haspara/Accounting/Account.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"
39 changes: 30 additions & 9 deletions src/Haspara/Accounting/Ledger.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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.
Expand Down Expand Up @@ -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.
Expand Down
14 changes: 11 additions & 3 deletions src/Haspara/Currency.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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'.
Expand Down
35 changes: 22 additions & 13 deletions src/Haspara/FxQuote.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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'@
Expand Down
28 changes: 22 additions & 6 deletions src/Haspara/Internal/Aeson.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
}
35 changes: 22 additions & 13 deletions src/Haspara/Monetary.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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.
Expand Down

0 comments on commit 0d415ea

Please sign in to comment.