simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-20 02:37:12 +03:00
Code Issues Projects Releases Wiki Activity

cli: Use Text Builder for Entries Reports.

Browse Source
This commit is contained in:
Stephen Morgan 2020-10-27 18:06:43 +11:00
parent 12a6435c51
commit b9dbed6713
1 changed files with 23 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
hledger/Hledger/Cli/Commands/Print.hs
View File

@ -17,9 +17,10 @@ where
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.Text (Text) import Data.Text (Text)
import Data.List (intercalate) import Data.List (intersperse)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit
import Hledger.Read.CsvReader (CSV, printCSV) import Hledger.Read.CsvReader (CSV, printCSV)
@ -53,18 +54,18 @@ print' opts j = do
Just desc -> printMatch opts j $ T.pack desc Just desc -> printMatch opts j $ T.pack desc
printEntries :: CliOpts -> Journal -> IO () printEntries :: CliOpts -> Journal -> IO ()
printEntries opts@CliOpts{reportspec_=rspec} j = do printEntries opts@CliOpts{reportspec_=rspec} j =
let fmt = outputFormatFromOpts opts writeOutputLazyText opts . render $ entriesReport rspec j
render = case fmt of where
"txt" -> entriesReportAsText opts fmt = outputFormatFromOpts opts
"csv" -> (++"\n") . printCSV . entriesReportAsCsv render | fmt=="txt" = entriesReportAsText opts
"json" -> (++"\n") . TL.unpack . toJsonText | fmt=="csv" = TL.pack . printCSV . entriesReportAsCsv
"sql" -> entriesReportAsSql | fmt=="json" = toJsonText
_ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: | fmt=="sql" = entriesReportAsSql
writeOutput opts $ render $ entriesReport rspec j | otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL:
entriesReportAsText :: CliOpts -> EntriesReport -> String entriesReportAsText :: CliOpts -> EntriesReport -> TL.Text
entriesReportAsText opts = concatMap (showTransaction . whichtxn) entriesReportAsText opts = TB.toLazyText . foldMap (TB.fromString . showTransaction . whichtxn)
where where
whichtxn whichtxn
-- With -x, use the fully-inferred txn with all amounts & txn prices explicit. -- With -x, use the fully-inferred txn with all amounts & txn prices explicit.
@ -125,16 +126,17 @@ originalPostingPreservingAccount p = (originalPosting p) { paccount = paccount p
-- ] -- ]
-- ] -- ]
entriesReportAsSql :: EntriesReport -> String entriesReportAsSql :: EntriesReport -> TL.Text
entriesReportAsSql txns = entriesReportAsSql txns = TB.toLazyText $ mconcat
"create table if not exists postings(id serial,txnidx int,date1 date,date2 date,status text,code text,description text,comment text,account text,amount numeric,commodity text,credit numeric,debit numeric,posting_status text,posting_comment text);\n"++ [ TB.fromText "create table if not exists postings(id serial,txnidx int,date1 date,date2 date,status text,code text,description text,comment text,account text,amount numeric,commodity text,credit numeric,debit numeric,posting_status text,posting_comment text);\n"
"insert into postings(txnidx,date1,date2,status,code,description,comment,account,amount,commodity,credit,debit,posting_status,posting_comment) values\n"++ , TB.fromText "insert into postings(txnidx,date1,date2,status,code,description,comment,account,amount,commodity,credit,debit,posting_status,posting_comment) values\n"
(intercalate "," (map values csv)) , mconcat . intersperse (TB.fromText ",") $ map values csv
++";\n" , TB.fromText ";\n"
]
where where
values vs = "(" ++ (intercalate "," $ map toSql vs) ++ ")\n" values vs = TB.fromText "(" <> mconcat (intersperse (TB.fromText ",") $ map toSql vs) <> TB.fromText ")\n"
toSql "" = "NULL" toSql "" = TB.fromText "NULL"
toSql s = "'" ++ (concatMap quoteChar s) ++ "'" toSql s = TB.fromText "'" <> TB.fromString (concatMap quoteChar s) <> TB.fromText "'"
quoteChar '\'' = "''" quoteChar '\'' = "''"
quoteChar c = [c] quoteChar c = [c]
csv = concatMap transactionToCSV txns csv = concatMap transactionToCSV txns