{-# 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 = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos
toEncoding :: Pos -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv a.
(KeyValue kv, Integral a, ToJSON a) =>
DecimalRaw a -> [kv]
decimalKV
toEncoding :: DecimalRaw a -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv a.
(KeyValue kv, Integral a, ToJSON a) =>
DecimalRaw a -> [kv]
decimalKV
decimalKV :: (KeyValue kv, Integral a, ToJSON a) => DecimalRaw a -> [kv]
decimalKV :: forall kv a.
(KeyValue kv, Integral a, ToJSON a) =>
DecimalRaw a -> [kv]
decimalKV DecimalRaw a
d = let d' :: DecimalRaw a
d' = if forall i. DecimalRaw i -> Word8
decimalPlaces DecimalRaw a
d forall a. Ord a => a -> a -> Bool
<= Word8
10 then DecimalRaw a
d else forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
10 DecimalRaw a
d in
[ Key
"decimalPlaces" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall i. DecimalRaw i -> Word8
decimalPlaces DecimalRaw a
d'
, Key
"decimalMantissa" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall i. DecimalRaw i -> i
decimalMantissa DecimalRaw a
d'
, Key
"floatingPoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall a b. (Real a, Fractional b) => a -> b
realToFrac DecimalRaw a
d' :: Double)
]
instance ToJSON Amount
instance ToJSON AmountStyle
instance ToJSON AmountPrecision where
toJSON :: AmountPrecision -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Precision Word8
n -> forall a. a -> Maybe a
Just Word8
n
AmountPrecision
NaturalPrecision -> forall a. Maybe a
Nothing
toEncoding :: AmountPrecision -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Precision Word8
n -> forall a. a -> Maybe a
Just Word8
n
AmountPrecision
NaturalPrecision -> forall a. Maybe a
Nothing
instance ToJSON Side
instance ToJSON DigitGroupStyle
instance ToJSON MixedAmount where
toJSON :: MixedAmount -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw
toEncoding :: MixedAmount -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> [Amount]
amountsRaw
instance ToJSON BalanceAssertion
instance ToJSON AmountPrice
instance ToJSON MarketPrice
instance ToJSON PostingType
instance ToJSON Posting where
toJSON :: Posting -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv. KeyValue kv => Posting -> [kv]
postingKV
toEncoding :: Posting -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv. KeyValue kv => Posting -> [kv]
postingKV
postingKV :: KeyValue kv => Posting -> [kv]
postingKV :: forall kv. KeyValue kv => Posting -> [kv]
postingKV Posting{[Tag]
Maybe Day
Maybe Transaction
Maybe Posting
Maybe BalanceAssertion
AccountName
Status
PostingType
MixedAmount
poriginal :: Posting -> Maybe Posting
ptransaction :: Posting -> Maybe Transaction
pbalanceassertion :: Posting -> Maybe BalanceAssertion
ptags :: Posting -> [Tag]
ptype :: Posting -> PostingType
pcomment :: Posting -> AccountName
pamount :: Posting -> MixedAmount
paccount :: Posting -> AccountName
pstatus :: Posting -> Status
pdate2 :: Posting -> Maybe Day
pdate :: Posting -> Maybe Day
poriginal :: Maybe Posting
ptransaction :: Maybe Transaction
pbalanceassertion :: Maybe BalanceAssertion
ptags :: [Tag]
ptype :: PostingType
pcomment :: AccountName
pamount :: MixedAmount
paccount :: AccountName
pstatus :: Status
pdate2 :: Maybe Day
pdate :: Maybe Day
..} =
[ Key
"pdate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Day
pdate
, Key
"pdate2" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Day
pdate2
, Key
"pstatus" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Status
pstatus
, Key
"paccount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AccountName
paccount
, Key
"pamount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MixedAmount
pamount
, Key
"pcomment" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AccountName
pcomment
, Key
"ptype" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PostingType
ptype
, Key
"ptags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Tag]
ptags
, Key
"pbalanceassertion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe BalanceAssertion
pbalanceassertion
, Key
"ptransaction_" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (forall a. Show a => a -> FilePath
showforall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> Integer
tindex) Maybe Transaction
ptransaction
, Key
"poriginal" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall a. Maybe a
Nothing :: Maybe Posting)
]
instance ToJSON Transaction
instance ToJSON TransactionModifier
instance ToJSON TMPostingRule
instance ToJSON PeriodicTransaction
instance ToJSON PriceDirective
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 Commodity
instance ToJSON TimeclockCode
instance ToJSON TimeclockEntry
instance ToJSON Journal
instance ToJSON Account where
toJSON :: Account -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv. KeyValue kv => Account -> [kv]
accountKV
toEncoding :: Account -> Encoding
toEncoding = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall kv. KeyValue kv => Account -> [kv]
accountKV
accountKV :: KeyValue kv => Account -> [kv]
accountKV :: forall kv. KeyValue kv => Account -> [kv]
accountKV Account
a =
[ Key
"aname" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Account -> AccountName
aname Account
a
, Key
"aebalance" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Account -> MixedAmount
aebalance Account
a
, Key
"aibalance" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Account -> MixedAmount
aibalance Account
a
, Key
"anumpostings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Account -> Int
anumpostings Account
a
, Key
"aboring" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Account -> Bool
aboring Account
a
, Key
"aparent_" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall b a. b -> (a -> b) -> Maybe a -> b
maybe AccountName
"" Account -> AccountName
aname (Account -> Maybe Account
aparent Account
a)
, Key
"asubs_" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a b. (a -> b) -> [a] -> [b]
map Account -> AccountName
aname (Account -> [Account]
asubs Account
a)
, Key
"asubs" forall kv v. (KeyValue 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Pos
mkPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
instance FromJSON Amount
instance FromJSON AmountStyle
instance FromJSON AmountPrecision where
parseJSON :: Value -> Parser AmountPrecision
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe AmountPrecision
NaturalPrecision Word8 -> AmountPrecision
Precision) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
instance FromJSON Side
instance FromJSON DigitGroupStyle
instance FromJSON MixedAmount where
parseJSON :: Value -> Parser MixedAmount
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed :: [Amount] -> MixedAmount) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
instance FromJSON BalanceAssertion
instance FromJSON AmountPrice
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 :: AccountName -> AccountName -> Ordering
confCompare=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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"could not decode JSON in "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> FilePath
show FilePath
fforall a. [a] -> [a] -> [a]
++FilePath
" to target value")
(forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bl :: Maybe Value)
case forall a. FromJSON a => Value -> Result a
fromJSON Value
v :: FromJSON a => Result a of
Error FilePath
e -> forall a. HasCallStack => FilePath -> a
error FilePath
e
Success a
t -> forall (m :: * -> *) a. Monad m => a -> m a
return a
t