lib: replace jsonPrettyText with toJsonText in Hledger.Data.Json

This commit is contained in:
Simon Michael 2020-06-06 12:33:06 -07:00
parent 5198d7b066
commit b86ced5ee9
6 changed files with 27 additions and 28 deletions

View File

@ -28,15 +28,20 @@ JSON instances. Should they be in Types.hs ?
module Hledger.Data.Json ( module Hledger.Data.Json (
-- * Instances -- * Instances
-- * Utilities -- * Utilities
readJsonFile toJsonText
,writeJsonFile ,writeJsonFile
,readJsonFile
) where ) where
import Data.Aeson import Data.Aeson
import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
--import Data.Aeson.TH --import Data.Aeson.TH
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.Decimal import Data.Decimal
import Data.Maybe 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 GHC.Generics (Generic)
import System.Time (ClockTime) import System.Time (ClockTime)
@ -201,17 +206,24 @@ instance FromJSON (DecimalRaw Integer)
-- Utilities -- Utilities
-- | Read a json from a file and decode/parse it as the target type, if we can. -- | Show a JSON-convertible haskell value as pretty-printed JSON text.
-- Example: >>> readJsonFile "in.json" :: IO MixedAmount toJsonText :: ToJSON a => a -> TL.Text
toJsonText = (<>"\n") . toLazyText . encodePrettyToTextBuilder
-- | Write a JSON-convertible haskell value to a pretty-printed JSON file.
-- Eg: writeJsonFile "a.json" nulltransaction
writeJsonFile :: ToJSON a => FilePath -> a -> IO ()
writeJsonFile f = TL.writeFile f . toJsonText
-- we write with Text and read with ByteString, is that fine ?
-- | Read a JSON file and decode it to the target type, or raise an error if we can't.
-- Eg: readJsonFile "a.json" :: IO Transaction
readJsonFile :: FromJSON a => FilePath -> IO a readJsonFile :: FromJSON a => FilePath -> IO a
readJsonFile f = do readJsonFile f = do
bs <- BL.readFile f bl <- BL.readFile f
let v = fromMaybe (error "could not decode bytestring as json value") (decode bs :: Maybe Value) let v = fromMaybe (error $ "could not decode JSON in "++show f++" to target value")
(decode bl :: Maybe Value)
case fromJSON v :: FromJSON a => Result a of case fromJSON v :: FromJSON a => Result a of
Error e -> error e Error e -> error e
Success t -> return t 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)

View File

@ -26,7 +26,6 @@ module Hledger.Utils.Text
stripquotes, stripquotes,
-- isSingleQuoted, -- isSingleQuoted,
-- isDoubleQuoted, -- isDoubleQuoted,
jsonPrettyText,
-- -- * single-line layout -- -- * single-line layout
textstrip, textstrip,
textlstrip, textlstrip,
@ -60,8 +59,6 @@ module Hledger.Utils.Text
) )
where where
import Data.Aeson (Value)
import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
-- import Data.Char -- import Data.Char
import Data.List import Data.List
#if !(MIN_VERSION_base(4,11,0)) #if !(MIN_VERSION_base(4,11,0))
@ -69,8 +66,6 @@ import Data.Monoid
#endif #endif
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Builder (toLazyText)
-- import Text.Parsec -- import Text.Parsec
-- import Text.Printf (printf) -- import Text.Printf (printf)
@ -83,10 +78,6 @@ import Hledger.Utils.Test
-- lowercase = map toLower -- lowercase = map toLower
-- uppercase = map toUpper -- uppercase = map toUpper
-- | Pretty-print a JSON value.
jsonPrettyText :: Value -> TL.Text
jsonPrettyText = toLazyText . encodePrettyToTextBuilder
-- | Remove leading and trailing whitespace. -- | Remove leading and trailing whitespace.
textstrip :: Text -> Text textstrip :: Text -> Text
textstrip = textlstrip . textrstrip textstrip = textlstrip . textrstrip

View File

@ -253,7 +253,6 @@ module Hledger.Cli.Commands.Balance (
,tests_Balance ,tests_Balance
) where ) where
import Data.Aeson (toJSON)
import Data.List import Data.List
import Data.Maybe import Data.Maybe
--import qualified Data.Map as Map --import qualified Data.Map as Map
@ -320,7 +319,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
assrt = not $ ignore_assertions_ $ inputopts_ opts assrt = not $ ignore_assertions_ $ inputopts_ opts
render = case fmt of render = case fmt of
"txt" -> budgetReportAsText ropts "txt" -> budgetReportAsText ropts
"json" -> (++"\n") . TL.unpack . jsonPrettyText . toJSON "json" -> (++"\n") . TL.unpack . toJsonText
_ -> const $ error' $ unsupportedOutputFormatError fmt _ -> const $ error' $ unsupportedOutputFormatError fmt
writeOutput opts $ render budgetreport writeOutput opts $ render budgetreport
@ -331,7 +330,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
"txt" -> multiBalanceReportAsText ropts "txt" -> multiBalanceReportAsText ropts
"csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts "csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts
"html" -> (++"\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts "html" -> (++"\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts
"json" -> (++"\n") . TL.unpack . jsonPrettyText . toJSON "json" -> (++"\n") . TL.unpack . toJsonText
_ -> const $ error' $ unsupportedOutputFormatError fmt _ -> const $ error' $ unsupportedOutputFormatError fmt
writeOutput opts $ render report writeOutput opts $ render report
@ -346,7 +345,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
render = case fmt of render = case fmt of
"txt" -> balanceReportAsText "txt" -> balanceReportAsText
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
"json" -> const $ (++"\n") . TL.unpack . jsonPrettyText . toJSON "json" -> const $ (++"\n") . TL.unpack . toJsonText
_ -> const $ error' $ unsupportedOutputFormatError fmt _ -> const $ error' $ unsupportedOutputFormatError fmt
writeOutput opts $ render ropts report writeOutput opts $ render ropts report

View File

@ -15,7 +15,6 @@ module Hledger.Cli.Commands.Print (
) )
where where
import Data.Aeson (toJSON)
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
@ -60,7 +59,7 @@ printEntries opts@CliOpts{reportopts_=ropts} j = do
render = case fmt of render = case fmt of
"txt" -> entriesReportAsText opts "txt" -> entriesReportAsText opts
"csv" -> (++"\n") . printCSV . entriesReportAsCsv "csv" -> (++"\n") . printCSV . entriesReportAsCsv
"json" -> (++"\n") . TL.unpack . jsonPrettyText . toJSON "json" -> (++"\n") . TL.unpack . toJsonText
_ -> const $ error' $ unsupportedOutputFormatError fmt _ -> const $ error' $ unsupportedOutputFormatError fmt
writeOutput opts $ render $ entriesReport ropts q j writeOutput opts $ render $ entriesReport ropts q j

View File

@ -18,7 +18,6 @@ module Hledger.Cli.Commands.Register (
,tests_Register ,tests_Register
) where ) where
import Data.Aeson (toJSON)
import Data.List import Data.List
import Data.Maybe import Data.Maybe
-- import Data.Text (Text) -- import Data.Text (Text)
@ -64,7 +63,7 @@ register opts@CliOpts{reportopts_=ropts} j = do
let fmt = outputFormatFromOpts opts let fmt = outputFormatFromOpts opts
render | fmt=="txt" = postingsReportAsText render | fmt=="txt" = postingsReportAsText
| fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv) | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
| fmt=="json" = const ((++"\n") . TL.unpack . jsonPrettyText . toJSON) | fmt=="json" = const ((++"\n") . TL.unpack . toJsonText)
| otherwise = const $ error' $ unsupportedOutputFormatError fmt | otherwise = const $ error' $ unsupportedOutputFormatError fmt
writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j

View File

@ -13,7 +13,6 @@ module Hledger.Cli.CompoundBalanceCommand (
,compoundBalanceCommand ,compoundBalanceCommand
) where ) where
import Data.Aeson (toJSON)
import Data.List (foldl') import Data.List (foldl')
import Data.Maybe import Data.Maybe
import qualified Data.Text as TS import qualified Data.Text as TS
@ -240,7 +239,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
"txt" -> compoundBalanceReportAsText ropts' cbr "txt" -> compoundBalanceReportAsText ropts' cbr
"csv" -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n" "csv" -> printCSV (compoundBalanceReportAsCsv ropts cbr) ++ "\n"
"html" -> (++"\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr "html" -> (++"\n") $ TL.unpack $ L.renderText $ compoundBalanceReportAsHtml ropts cbr
"json" -> (++"\n") $ TL.unpack $ jsonPrettyText $ toJSON cbr "json" -> (++"\n") $ TL.unpack $ toJsonText cbr
_ -> error' $ unsupportedOutputFormatError fmt _ -> error' $ unsupportedOutputFormatError fmt
-- | Summarise one or more (inclusive) end dates, in a way that's -- | Summarise one or more (inclusive) end dates, in a way that's