{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Data.Json (
toJsonText
,writeJsonFile
,readJsonFile
) where
import Data.Aeson
import Data.Aeson.Encode.Pretty (Config(..), Indent(..), NumberFormat(..),
encodePretty', encodePrettyToTextBuilder')
import qualified Data.ByteString.Lazy as BL
import Data.Decimal (DecimalRaw(..), roundTo)
import Data.Maybe (fromMaybe)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Text.Megaparsec (Pos, SourcePos, mkPos, unPos)
import Hledger.Data.Types
import Hledger.Data.Amount (amountsRaw, mixed)
instance ToJSON Status
instance ToJSON SourcePos
instance ToJSON Pos where
toJSON :: Pos -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> (Pos -> Int) -> Pos -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos
toEncoding :: Pos -> Encoding
toEncoding = Int -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Int -> Encoding) -> (Pos -> Int) -> Pos -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos
instance (Integral a, ToJSON a) => ToJSON (DecimalRaw a) where
toJSON :: DecimalRaw a -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (DecimalRaw a -> [Pair]) -> DecimalRaw a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecimalRaw a -> [Pair]
forall e kv a.
(KeyValue e kv, Integral a, ToJSON a) =>
DecimalRaw a -> [kv]
decimalKV
toEncoding :: DecimalRaw a -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (DecimalRaw a -> Series) -> DecimalRaw a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (DecimalRaw a -> [Series]) -> DecimalRaw a -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecimalRaw a -> [Series]
forall e kv a.
(KeyValue e kv, Integral a, ToJSON a) =>
DecimalRaw a -> [kv]
decimalKV
decimalKV :: (
#if MIN_VERSION_aeson(2,2,0)
KeyValue e kv,
#else
KeyValue kv,
#endif
Integral a, ToJSON a) => DecimalRaw a -> [kv]
decimalKV :: forall e kv a.
(KeyValue e kv, Integral a, ToJSON a) =>
DecimalRaw a -> [kv]
decimalKV DecimalRaw a
d = let d' :: DecimalRaw a
d' = if DecimalRaw a -> Word8
forall i. DecimalRaw i -> Word8
decimalPlaces DecimalRaw a
d Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
10 then DecimalRaw a
d else Word8 -> DecimalRaw a -> DecimalRaw a
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
10 DecimalRaw a
d in
[ Key
"decimalPlaces" Key -> Word8 -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DecimalRaw a -> Word8
forall i. DecimalRaw i -> Word8
decimalPlaces DecimalRaw a
d'
, Key
"decimalMantissa" Key -> a -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= DecimalRaw a -> a
forall i. DecimalRaw i -> i
decimalMantissa DecimalRaw a
d'
, Key
"floatingPoint" Key -> Double -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (DecimalRaw a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac DecimalRaw a
d' :: Double)
]
instance ToJSON Amount
instance ToJSON Rounding
instance ToJSON AmountStyle
instance ToJSON AmountPrecision where
toJSON :: AmountPrecision -> Value
toJSON = Maybe Word8 -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Word8 -> Value)
-> (AmountPrecision -> Maybe Word8) -> AmountPrecision -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Precision Word8
n -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
n
AmountPrecision
NaturalPrecision -> Maybe Word8
forall a. Maybe a
Nothing
toEncoding :: AmountPrecision -> Encoding
toEncoding = Maybe Word8 -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Maybe Word8 -> Encoding)
-> (AmountPrecision -> Maybe Word8) -> AmountPrecision -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Precision Word8
n -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
n
AmountPrecision
NaturalPrecision -> Maybe Word8
forall a. Maybe a
Nothing
instance ToJSON Side
instance ToJSON DigitGroupStyle
instance ToJSON MixedAmount where
toJSON :: MixedAmount -> Value
toJSON = [Amount] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Amount] -> Value)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw
toEncoding :: MixedAmount -> Encoding
toEncoding = [Amount] -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding ([Amount] -> Encoding)
-> (MixedAmount -> [Amount]) -> MixedAmount -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw
instance ToJSON BalanceAssertion
instance ToJSON AmountCost
instance ToJSON MarketPrice
instance ToJSON PostingType
instance ToJSON Posting where
toJSON :: Posting -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (Posting -> [Pair]) -> Posting -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> [Pair]
forall e kv. KeyValue e kv => Posting -> [kv]
postingKV
toEncoding :: Posting -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding) -> (Posting -> Series) -> Posting -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> (Posting -> [Series]) -> Posting -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> [Series]
forall e kv. KeyValue e kv => Posting -> [kv]
postingKV
postingKV ::
#if MIN_VERSION_aeson(2,2,0)
KeyValue e kv
#else
KeyValue kv
#endif
=> Posting -> [kv]
postingKV :: forall e kv. KeyValue e kv => Posting -> [kv]
postingKV Posting{[Tag]
Maybe Day
Maybe Transaction
Maybe Posting
Maybe BalanceAssertion
Text
Status
PostingType
MixedAmount
pdate :: Maybe Day
pdate2 :: Maybe Day
pstatus :: Status
paccount :: Text
pamount :: MixedAmount
pcomment :: Text
ptype :: PostingType
ptags :: [Tag]
pbalanceassertion :: Maybe BalanceAssertion
ptransaction :: Maybe Transaction
poriginal :: Maybe Posting
pdate :: Posting -> Maybe Day
pdate2 :: Posting -> Maybe Day
pstatus :: Posting -> Status
paccount :: Posting -> Text
pamount :: Posting -> MixedAmount
pcomment :: Posting -> Text
ptype :: Posting -> PostingType
ptags :: Posting -> [Tag]
pbalanceassertion :: Posting -> Maybe BalanceAssertion
ptransaction :: Posting -> Maybe Transaction
poriginal :: Posting -> Maybe Posting
..} =
[ Key
"pdate" Key -> Maybe Day -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Day
pdate
, Key
"pdate2" Key -> Maybe Day -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Day
pdate2
, Key
"pstatus" Key -> Status -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Status
pstatus
, Key
"paccount" Key -> Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
paccount
, Key
"pamount" Key -> MixedAmount -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MixedAmount
pamount
, Key
"pcomment" Key -> Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
pcomment
, Key
"ptype" Key -> PostingType -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PostingType
ptype
, Key
"ptags" Key -> [Tag] -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Tag]
ptags
, Key
"pbalanceassertion" Key -> Maybe BalanceAssertion -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe BalanceAssertion
pbalanceassertion
, Key
"ptransaction_" Key -> FilePath -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= FilePath
-> (Transaction -> FilePath) -> Maybe Transaction -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (Integer -> FilePath
forall a. Show a => a -> FilePath
show(Integer -> FilePath)
-> (Transaction -> Integer) -> Transaction -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> Integer
tindex) Maybe Transaction
ptransaction
, Key
"poriginal" Key -> Maybe Posting -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Maybe Posting
forall a. Maybe a
Nothing :: Maybe Posting)
]
instance ToJSON Transaction
instance ToJSON TransactionModifier
instance ToJSON TMPostingRule
instance ToJSON PeriodicTransaction
instance ToJSON PriceDirective
instance ToJSON EFDay
instance ToJSON DateSpan
instance ToJSON Interval
instance ToJSON Period
instance ToJSON AccountAlias
instance ToJSON AccountType
instance ToJSONKey AccountType
instance ToJSON AccountDeclarationInfo
instance ToJSON PayeeDeclarationInfo
instance ToJSON TagDeclarationInfo
instance ToJSON Commodity
instance ToJSON TimeclockCode
instance ToJSON TimeclockEntry
instance ToJSON Journal
instance ToJSON Account where
toJSON :: Account -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value) -> (Account -> [Pair]) -> Account -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account -> [Pair]
forall e kv. KeyValue e kv => Account -> [kv]
accountKV
toEncoding :: Account -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding) -> (Account -> Series) -> Account -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> (Account -> [Series]) -> Account -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Account -> [Series]
forall e kv. KeyValue e kv => Account -> [kv]
accountKV
accountKV ::
#if MIN_VERSION_aeson(2,2,0)
KeyValue e kv
#else
KeyValue kv
#endif
=> Account -> [kv]
accountKV :: forall e kv. KeyValue e kv => Account -> [kv]
accountKV Account
a =
[ Key
"aname" Key -> Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Account -> Text
aname Account
a
, Key
"adeclarationinfo" Key -> Maybe AccountDeclarationInfo -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Account -> Maybe AccountDeclarationInfo
adeclarationinfo Account
a
, Key
"aebalance" Key -> MixedAmount -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Account -> MixedAmount
aebalance Account
a
, Key
"aibalance" Key -> MixedAmount -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Account -> MixedAmount
aibalance Account
a
, Key
"anumpostings" Key -> Int -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Account -> Int
anumpostings Account
a
, Key
"aboring" Key -> Bool -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Account -> Bool
aboring Account
a
, Key
"aparent_" Key -> Text -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> (Account -> Text) -> Maybe Account -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Account -> Text
aname (Account -> Maybe Account
aparent Account
a)
, Key
"asubs_" Key -> [Text] -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Account -> Text) -> [Account] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Account -> Text
aname (Account -> [Account]
asubs Account
a)
, Key
"asubs" Key -> [Account] -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ([]::[Account])
]
instance ToJSON Ledger
instance FromJSON Status
instance FromJSON SourcePos
instance FromJSON Pos where
parseJSON :: Value -> Parser Pos
parseJSON = (Int -> Pos) -> Parser Int -> Parser Pos
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Pos
mkPos (Parser Int -> Parser Pos)
-> (Value -> Parser Int) -> Value -> Parser Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON
instance FromJSON Amount
instance FromJSON Rounding
instance FromJSON AmountStyle
instance FromJSON AmountPrecision where
parseJSON :: Value -> Parser AmountPrecision
parseJSON = (Maybe Word8 -> AmountPrecision)
-> Parser (Maybe Word8) -> Parser AmountPrecision
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AmountPrecision
-> (Word8 -> AmountPrecision) -> Maybe Word8 -> AmountPrecision
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AmountPrecision
NaturalPrecision Word8 -> AmountPrecision
Precision) (Parser (Maybe Word8) -> Parser AmountPrecision)
-> (Value -> Parser (Maybe Word8))
-> Value
-> Parser AmountPrecision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (Maybe Word8)
forall a. FromJSON a => Value -> Parser a
parseJSON
instance FromJSON Side
instance FromJSON DigitGroupStyle
instance FromJSON MixedAmount where
parseJSON :: Value -> Parser MixedAmount
parseJSON = ([Amount] -> MixedAmount) -> Parser [Amount] -> Parser MixedAmount
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed :: [Amount] -> MixedAmount) (Parser [Amount] -> Parser MixedAmount)
-> (Value -> Parser [Amount]) -> Value -> Parser MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser [Amount]
forall a. FromJSON a => Value -> Parser a
parseJSON
instance FromJSON BalanceAssertion
instance FromJSON AmountCost
instance FromJSON MarketPrice
instance FromJSON PostingType
instance FromJSON Posting
instance FromJSON Transaction
instance FromJSON AccountDeclarationInfo
instance FromJSON Account
instance FromJSON (DecimalRaw Integer)
jsonConf :: Config
jsonConf :: Config
jsonConf = Config{confIndent :: Indent
confIndent=Int -> Indent
Spaces Int
2, confCompare :: Text -> Text -> Ordering
confCompare=Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare, confNumFormat :: NumberFormat
confNumFormat=NumberFormat
Generic, confTrailingNewline :: Bool
confTrailingNewline=Bool
True}
toJsonText :: ToJSON a => a -> TL.Text
toJsonText :: forall a. ToJSON a => a -> Text
toJsonText = Builder -> Text
TB.toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> Builder
forall a. ToJSON a => Config -> a -> Builder
encodePrettyToTextBuilder' Config
jsonConf
writeJsonFile :: ToJSON a => FilePath -> a -> IO ()
writeJsonFile :: forall a. ToJSON a => FilePath -> a -> IO ()
writeJsonFile FilePath
f = FilePath -> ByteString -> IO ()
BL.writeFile FilePath
f (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
jsonConf
readJsonFile :: FromJSON a => FilePath -> IO a
readJsonFile :: forall a. FromJSON a => FilePath -> IO a
readJsonFile FilePath
f = do
ByteString
bl <- FilePath -> IO ByteString
BL.readFile FilePath
f
let v :: Value
v = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Value
forall a. HasCallStack => FilePath -> a
error (FilePath -> Value) -> FilePath -> Value
forall a b. (a -> b) -> a -> b
$ FilePath
"could not decode JSON in "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
fFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
" to target value")
(ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bl :: Maybe Value)
case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
v :: FromJSON a => Result a of
Error FilePath
e -> FilePath -> IO a
forall a. HasCallStack => FilePath -> a
error FilePath
e
Success a
t -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
t