{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
module Hledger.Data.Json (
toJsonText
,writeJsonFile
,readJsonFile
) where
#if !(MIN_VERSION_base(4,13,0))
import Data.Semigroup ((<>))
#endif
import Data.Aeson
import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
import qualified Data.ByteString.Lazy as BL
import Data.Decimal
import Data.Maybe
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import Data.Text.Lazy.Builder (toLazyText)
import GHC.Generics (Generic)
import System.Time (ClockTime)
import Hledger.Data.Types
instance ToJSON Status
instance ToJSON GenericSourcePos
instance ToJSON Decimal where
toJSON :: Decimal -> Value
toJSON d :: Decimal
d = [Pair] -> Value
object
["decimalPlaces" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word8 -> Value
forall a. ToJSON a => a -> Value
toJSON Word8
decimalPlaces
,"decimalMantissa" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
decimalMantissa
,"floatingPoint" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Double -> Value
forall a. ToJSON a => a -> Value
toJSON (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Decimal -> Rational
forall a. Real a => a -> Rational
toRational Decimal
d' :: Double)
]
where d' :: Decimal
d'@Decimal{..} = Word8 -> Decimal -> Decimal
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo 10 Decimal
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 -> Value
toJSON Posting{..} = [Pair] -> Value
object
["pdate" Text -> Maybe Day -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Day
pdate
,"pdate2" Text -> Maybe Day -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Day
pdate2
,"pstatus" Text -> Status -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Status
pstatus
,"paccount" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
paccount
,"pamount" Text -> MixedAmount -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MixedAmount
pamount
,"pcomment" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
pcomment
,"ptype" Text -> PostingType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PostingType
ptype
,"ptags" Text -> [Tag] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Tag]
ptags
,"pbalanceassertion" Text -> Maybe BalanceAssertion -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe BalanceAssertion
pbalanceassertion
,"ptransaction_" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> (Transaction -> String) -> Maybe Transaction -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (Integer -> String
forall a. Show a => a -> String
show(Integer -> String)
-> (Transaction -> Integer) -> Transaction -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> Integer
tindex) Maybe Transaction
ptransaction
,"poriginal" Text -> Maybe Posting -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Maybe Posting
forall a. Maybe a
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 :: Account -> Value
toJSON a :: Account
a = [Pair] -> Value
object
["aname" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Account -> Text
aname Account
a
,"aebalance" Text -> MixedAmount -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Account -> MixedAmount
aebalance Account
a
,"aibalance" Text -> MixedAmount -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Account -> MixedAmount
aibalance Account
a
,"anumpostings" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Account -> Int
anumpostings Account
a
,"aboring" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Account -> Bool
aboring Account
a
,"aparent_" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text -> (Account -> Text) -> Maybe Account -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" Account -> Text
aname (Account -> Maybe Account
aparent Account
a)
,"asubs_" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Account -> Text) -> [Account] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Account -> Text
aname (Account -> [Account]
asubs Account
a)
,"asubs" Text -> [Account] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ([]::[Account])
]
deriving instance Generic (Ledger)
instance ToJSON Ledger
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
instance FromJSON Account
deriving instance Generic (DecimalRaw a)
instance FromJSON (DecimalRaw Integer)
toJsonText :: ToJSON a => a -> TL.Text
toJsonText :: a -> Text
toJsonText = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>"\n") (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. ToJSON a => a -> Builder
encodePrettyToTextBuilder
writeJsonFile :: ToJSON a => FilePath -> a -> IO ()
writeJsonFile :: String -> a -> IO ()
writeJsonFile f :: String
f = String -> Text -> IO ()
TL.writeFile String
f (Text -> IO ()) -> (a -> Text) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToJSON a => a -> Text
toJsonText
readJsonFile :: FromJSON a => FilePath -> IO a
readJsonFile :: String -> IO a
readJsonFile f :: String
f = do
ByteString
bl <- String -> IO ByteString
BL.readFile String
f
let v :: Value
v = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (String -> Value
forall a. HasCallStack => String -> a
error (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ "could not decode JSON in "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
show String
fString -> String -> String
forall a. [a] -> [a] -> [a]
++" 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 e :: String
e -> String -> IO a
forall a. HasCallStack => String -> a
error String
e
Success t :: a
t -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
t