mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-14 02:14:14 +03:00
a33a9d61c2
Amounts in JSON are now rendered as simple Numbers with up to 10 decimal places, instead of Decimal objects which would in some cases have 255 digits, too many for most JSON parsers to handle. A provisional fix, see the comment in Json.hs for more detail.
213 lines
8.2 KiB
Haskell
213 lines
8.2 KiB
Haskell
{-
|
||
JSON instances. Should they be in Types.hs ?
|
||
-}
|
||
|
||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||
|
||
--{-# LANGUAGE CPP #-}
|
||
--{-# LANGUAGE DataKinds #-}
|
||
--{-# LANGUAGE DeriveAnyClass #-}
|
||
{-# LANGUAGE DeriveGeneric #-}
|
||
--{-# LANGUAGE FlexibleContexts #-}
|
||
{-# LANGUAGE FlexibleInstances #-}
|
||
--{-# LANGUAGE NamedFieldPuns #-}
|
||
--{-# LANGUAGE OverloadedStrings #-}
|
||
{-# LANGUAGE OverloadedStrings #-}
|
||
--{-# LANGUAGE PolyKinds #-}
|
||
--{-# LANGUAGE QuasiQuotes #-}
|
||
--{-# LANGUAGE QuasiQuotes #-}
|
||
--{-# LANGUAGE Rank2Types #-}
|
||
--{-# LANGUAGE RankNTypes #-}
|
||
{-# LANGUAGE RecordWildCards #-}
|
||
--{-# LANGUAGE ScopedTypeVariables #-}
|
||
{-# LANGUAGE StandaloneDeriving #-}
|
||
--{-# LANGUAGE TemplateHaskell #-}
|
||
--{-# LANGUAGE TypeFamilies #-}
|
||
--{-# LANGUAGE TypeOperators #-}
|
||
|
||
module Hledger.Data.Json (
|
||
-- * Instances
|
||
-- * Utilities
|
||
readJsonFile
|
||
,writeJsonFile
|
||
) where
|
||
|
||
import Data.Aeson
|
||
--import Data.Aeson.TH
|
||
import qualified Data.ByteString.Lazy as BL
|
||
import Data.Decimal
|
||
import Data.Maybe
|
||
import GHC.Generics (Generic)
|
||
import System.Time (ClockTime)
|
||
|
||
import Hledger.Data.Types
|
||
|
||
-- To JSON
|
||
|
||
instance ToJSON Status
|
||
instance ToJSON GenericSourcePos
|
||
|
||
-- https://github.com/simonmichael/hledger/issues/1195
|
||
-- The default JSON output for Decimal is not very practical for JSON consumers.
|
||
-- With repeating decimals, which can occur with implicit transaction prices,
|
||
-- decimalMantissa will use Decimal's maximum allowance of 255 digits.
|
||
-- (And secondly, it sometimes uses scientific notation, and that sometimes
|
||
-- looks wrong, eg e254 instead of e-1 ?)
|
||
-- JSON output is intended to be consumed by diverse apps and
|
||
-- programming languages, which can't necessarily handle numbers with
|
||
-- more than 15 or so significant digits. Eg, from #1195:
|
||
--
|
||
-- > - JavaScript uses 64-bit IEEE754 numbers which can only accurately
|
||
-- > represent integers up to 9007199254740991 (i.e. a maximum of 15 digits).
|
||
-- > - Java’s largest integers are limited to 18 digits.
|
||
-- > - Python 3 integers are unbounded.
|
||
-- > - Python 2 integers are limited to 18 digits like Java.
|
||
-- > - C and C++ number limits depend on platform — most platforms should
|
||
-- > be able to represent unsigned integers up to 64 bits, i.e. 19 digits.
|
||
--
|
||
-- It's not yet clear what is a good compromise.
|
||
-- For now, we make Decimals look like floating point numbers with
|
||
-- up to 10 decimal places (and an unbounded number of integer digits).
|
||
-- This still allows unparseable numbers to be generated in theory,
|
||
-- but hopefully this won't happen in practice.
|
||
instance ToJSON Decimal
|
||
where
|
||
toJSON d = Number $ fromRational $ toRational $ roundTo 10 d
|
||
|
||
instance ToJSON Amount
|
||
instance ToJSON AmountStyle
|
||
instance ToJSON Side
|
||
instance ToJSON DigitGroupStyle
|
||
instance ToJSON MixedAmount
|
||
instance ToJSON BalanceAssertion
|
||
instance ToJSON AmountPrice
|
||
instance ToJSON MarketPrice
|
||
instance ToJSON PostingType
|
||
|
||
instance ToJSON Posting where
|
||
toJSON Posting{..} = object
|
||
["pdate" .= pdate
|
||
,"pdate2" .= pdate2
|
||
,"pstatus" .= pstatus
|
||
,"paccount" .= paccount
|
||
,"pamount" .= pamount
|
||
,"pcomment" .= pcomment
|
||
,"ptype" .= ptype
|
||
,"ptags" .= ptags
|
||
,"pbalanceassertion" .= pbalanceassertion
|
||
-- To avoid a cycle, show just the parent transaction's index number
|
||
-- in a dummy field. When re-parsed, there will be no parent.
|
||
,"ptransaction_" .= maybe "" (show.tindex) ptransaction
|
||
-- This is probably not wanted in json, we discard it.
|
||
,"poriginal" .= (Nothing :: Maybe Posting)
|
||
]
|
||
|
||
instance ToJSON Transaction
|
||
instance ToJSON TransactionModifier
|
||
instance ToJSON PeriodicTransaction
|
||
instance ToJSON PriceDirective
|
||
instance ToJSON DateSpan
|
||
instance ToJSON Interval
|
||
instance ToJSON AccountAlias
|
||
instance ToJSON AccountType
|
||
instance ToJSONKey AccountType
|
||
instance ToJSON AccountDeclarationInfo
|
||
instance ToJSON Commodity
|
||
instance ToJSON TimeclockCode
|
||
instance ToJSON TimeclockEntry
|
||
instance ToJSON ClockTime
|
||
instance ToJSON Journal
|
||
|
||
instance ToJSON Account where
|
||
toJSON a = object
|
||
["aname" .= aname a
|
||
,"aebalance" .= aebalance a
|
||
,"aibalance" .= aibalance a
|
||
,"anumpostings" .= anumpostings a
|
||
,"aboring" .= aboring a
|
||
-- To avoid a cycle, show just the parent account's name
|
||
-- in a dummy field. When re-parsed, there will be no parent.
|
||
,"aparent_" .= maybe "" aname (aparent a)
|
||
-- Just the names of subaccounts, as a dummy field, ignored when parsed.
|
||
,"asubs_" .= map aname (asubs a)
|
||
-- The actual subaccounts (and their subs..), making a (probably highly redundant) tree
|
||
-- ,"asubs" .= asubs a
|
||
-- Omit the actual subaccounts
|
||
,"asubs" .= ([]::[Account])
|
||
]
|
||
|
||
deriving instance Generic (Ledger)
|
||
instance ToJSON Ledger
|
||
|
||
-- From JSON
|
||
|
||
instance FromJSON Status
|
||
instance FromJSON GenericSourcePos
|
||
instance FromJSON Amount
|
||
instance FromJSON AmountStyle
|
||
instance FromJSON Side
|
||
instance FromJSON DigitGroupStyle
|
||
instance FromJSON MixedAmount
|
||
instance FromJSON BalanceAssertion
|
||
instance FromJSON AmountPrice
|
||
instance FromJSON MarketPrice
|
||
instance FromJSON PostingType
|
||
instance FromJSON Posting
|
||
instance FromJSON Transaction
|
||
instance FromJSON AccountDeclarationInfo
|
||
-- XXX The ToJSON instance replaces subaccounts with just names.
|
||
-- Here we should try to make use of those to reconstruct the
|
||
-- parent-child relationships.
|
||
instance FromJSON Account
|
||
|
||
-- Decimal, various attempts
|
||
--
|
||
-- https://stackoverflow.com/questions/40331851/haskell-data-decimal-as-aeson-type
|
||
----instance FromJSON Decimal where parseJSON =
|
||
---- A.withScientific "Decimal" (return . right . eitherFromRational . toRational)
|
||
--
|
||
-- https://github.com/bos/aeson/issues/474
|
||
-- http://hackage.haskell.org/package/aeson-1.4.2.0/docs/Data-Aeson-TH.html
|
||
-- $(deriveFromJSON defaultOptions ''Decimal) -- doesn't work
|
||
-- $(deriveFromJSON defaultOptions ''DecimalRaw) -- works; requires TH, but gives better parse error messages
|
||
--
|
||
-- https://github.com/PaulJohnson/Haskell-Decimal/issues/6
|
||
--deriving instance Generic Decimal
|
||
--instance FromJSON Decimal
|
||
deriving instance Generic (DecimalRaw a)
|
||
instance FromJSON (DecimalRaw Integer)
|
||
--
|
||
-- @simonmichael, I think the code in your first comment should work if it compiles—though “work” doesn’t mean you can parse a JSON number directly into a `Decimal` using the generic instance, as you’ve discovered.
|
||
--
|
||
--Error messages with these extensions are always rather cryptic, but I’d prefer them to Template Haskell. Typically you’ll want to start by getting a generic `ToJSON` instance working, then use that to figure out what the `FromJSON` instance expects to parse: for a correct instance, `encode` and `decode` should give you an isomorphism between your type and a subset of `Bytestring` (up to the `Maybe` wrapper that `decode` returns).
|
||
--
|
||
--I don’t have time to test it right now, but I think it will also work without `DeriveAnyClass`, just using `DeriveGeneric` and `StandAloneDeriving`. It should also work to use the [`genericParseJSON`](http://hackage.haskell.org/package/aeson/docs/Data-Aeson.html#v:genericParseJSON) function to implement the class explicitly, something like this:
|
||
--
|
||
--{-# LANGUAGE DeriveGeneric #-}
|
||
--{-# LANGUAGE StandAloneDeriving #-}
|
||
--import GHC.Generics
|
||
--import Data.Aeson
|
||
--deriving instance Generic Decimal
|
||
--instance FromJSON Decimal where
|
||
-- parseJSON = genericParseJSON defaultOptions
|
||
--
|
||
--And of course you can avoid `StandAloneDeriving` entirely if you’re willing to wrap `Decimal` in your own `newtype`.
|
||
|
||
|
||
-- Utilities
|
||
|
||
-- | Read a json from a file and decode/parse it as the target type, if we can.
|
||
-- Example: >>> readJsonFile "in.json" :: IO MixedAmount
|
||
readJsonFile :: FromJSON a => FilePath -> IO a
|
||
readJsonFile f = do
|
||
bs <- BL.readFile f
|
||
let v = fromMaybe (error "could not decode bytestring as json value") (decode bs :: Maybe Value)
|
||
case fromJSON v :: FromJSON a => Result a of
|
||
Error e -> error e
|
||
Success t -> return t
|
||
|
||
-- | Write some to-JSON-convertible haskell value to a json file, if we can.
|
||
-- Example: >>> writeJsonFile "out.json" nullmixedamt
|
||
writeJsonFile :: ToJSON a => FilePath -> a -> IO ()
|
||
writeJsonFile f v = BL.writeFile f (encode v)
|