lib: Add more efficient toEncoding for custom ToJSON declarations.

hledger-lib/Hledger/Data/Json.hs

@@ -81,12 +81,15 @@ instance ToJSON GenericSourcePos
 -- remains manageable in practice. (I'm not sure how to limit the number
 -- of significant digits in a Decimal right now.)
 instance (Integral a, ToJSON a) => ToJSON (DecimalRaw a) where
-  toJSON d = object
+  toJSON = object . decimalKV
-      [ "decimalPlaces"   .= toJSON (decimalPlaces d')
+  toEncoding = pairs . mconcat . decimalKV
-      , "decimalMantissa" .= toJSON (decimalMantissa d')
+
-      , "floatingPoint"   .= toJSON (realToFrac d' :: Double)
+decimalKV :: (KeyValue kv, Integral a, ToJSON a) => DecimalRaw a -> [kv]
-      ]
+decimalKV d = let d' = if decimalPlaces d <= 10 then d else roundTo 10 d in
-    where d' = if decimalPlaces d <= 10 then d else roundTo 10 d
+    [ "decimalPlaces"   .= decimalPlaces d'
+    , "decimalMantissa" .= decimalMantissa d'
+    , "floatingPoint"   .= (realToFrac d' :: Double)
+    ]
 
 instance ToJSON Amount
 instance ToJSON AmountStyle
@@ -96,6 +99,9 @@ instance ToJSON AmountPrecision where
   toJSON = toJSON . \case
     Precision n      -> Just n
     NaturalPrecision -> Nothing
+  toEncoding = toEncoding . \case
+    Precision n      -> Just n
+    NaturalPrecision -> Nothing
 
 instance ToJSON Side
 instance ToJSON DigitGroupStyle
@@ -106,21 +112,25 @@ instance ToJSON MarketPrice
 instance ToJSON PostingType
 
 instance ToJSON Posting where
-  toJSON Posting{..} = object
+  toJSON = object . postingKV
-    ["pdate"             .= pdate
+  toEncoding = pairs . mconcat . postingKV
-    ,"pdate2"            .= pdate2
+
-    ,"pstatus"           .= pstatus
+postingKV :: KeyValue kv => Posting -> [kv]
-    ,"paccount"          .= paccount
+postingKV Posting{..} =
-    ,"pamount"           .= pamount
+    [ "pdate"             .= pdate
-    ,"pcomment"          .= pcomment
+    , "pdate2"            .= pdate2
-    ,"ptype"             .= ptype
+    , "pstatus"           .= pstatus
-    ,"ptags"             .= ptags
+    , "paccount"          .= paccount
-    ,"pbalanceassertion" .= pbalanceassertion
+    , "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
+    , "ptransaction_"     .= maybe "" (show.tindex) ptransaction
     -- This is probably not wanted in json, we discard it.
-    ,"poriginal"         .= (Nothing :: Maybe Posting)
+    , "poriginal"         .= (Nothing :: Maybe Posting)
     ]
 
 instance ToJSON Transaction
@@ -141,21 +151,25 @@ instance ToJSON ClockTime
 instance ToJSON Journal
 
 instance ToJSON Account where
-  toJSON a = object
+  toJSON = object . accountKV
-    ["aname"        .= aname a
+  toEncoding = pairs . mconcat . accountKV
-    ,"aebalance"    .= aebalance a
+
-    ,"aibalance"    .= aibalance a
+accountKV :: KeyValue kv => Account -> [kv]
-    ,"anumpostings" .= anumpostings a
+accountKV a =
-    ,"aboring"      .= aboring a
+    [ "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)
+    , "aparent_"     .= maybe "" aname (aparent a)
     -- Just the names of subaccounts, as a dummy field, ignored when parsed.
-    ,"asubs_"       .= map aname (asubs a)
+    , "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])
+    , "asubs"        .= ([]::[Account])
     ]
 
 deriving instance Generic (Ledger)