diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 6357a9ca0..c1cb9ac5a 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -11,17 +11,17 @@ A reader for CSV data, using an extra rules file to help interpret the data. -- stack haddock hledger-lib --fast --no-haddock-deps --haddock-arguments='--ignore-all-exports' --open --- ** language -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns #-} --- ** exports module Hledger.Read.CsvReader ( @@ -52,7 +52,6 @@ import Control.Monad.Trans.Class (lift) import Data.Char (toLower, isDigit, isSpace, isAlphaNum, isAscii, ord) import Data.Bifunctor (first) import "base-compat-batteries" Data.List.Compat -import qualified Data.List.Split as LS (splitOn) import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.MemoUgly (memo) import Data.Ord (comparing) @@ -61,6 +60,8 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day) import Data.Time.Format (parseTimeM, defaultTimeLocale) import Safe (atMay, headMay, lastMay, readDef, readMay) @@ -88,7 +89,7 @@ import Hledger.Read.Common (aliasesFromOpts, Reader(..),InputOpts(..), amountp, type CSV = [CsvRecord] type CsvRecord = [CsvValue] -type CsvValue = String +type CsvValue = Text --- ** reader @@ -164,7 +165,7 @@ defaultRulesText csvfile = T.pack $ unlines ," account2 assets:bank:savings\n" ] -addDirective :: (DirectiveName, String) -> CsvRulesParsed -> CsvRulesParsed +addDirective :: (DirectiveName, Text) -> CsvRulesParsed -> CsvRulesParsed addDirective d r = r{rdirectives=d:rdirectives r} addAssignment :: (HledgerFieldName, FieldTemplate) -> CsvRulesParsed -> CsvRulesParsed @@ -181,7 +182,7 @@ addAssignmentsFromList fs r = foldl' maybeAddAssignment r journalfieldnames where maybeAddAssignment rules f = (maybe id addAssignmentFromIndex $ elemIndex f fs) rules where - addAssignmentFromIndex i = addAssignment (f, "%"++show (i+1)) + addAssignmentFromIndex i = addAssignment (f, T.pack $ '%':show (i+1)) addConditionalBlock :: ConditionalBlock -> CsvRulesParsed -> CsvRulesParsed addConditionalBlock b r = r{rconditionalblocks=b:rconditionalblocks r} @@ -240,7 +241,7 @@ validateRules rules = do -- | A set of data definitions and account-matching patterns sufficient to -- convert a particular CSV data file into meaningful journal transactions. data CsvRules' a = CsvRules' { - rdirectives :: [(DirectiveName,String)], + rdirectives :: [(DirectiveName,Text)], -- ^ top-level rules, as (keyword, value) pairs rcsvfieldindexes :: [(CsvFieldName, CsvFieldIndex)], -- ^ csv field names and their column number, if declared by a fields list @@ -260,7 +261,7 @@ type CsvRulesParsed = CsvRules' () -- | Type used after parsing is done. Directives, assignments and conditional blocks -- are in the same order as they were in the unput file and rblocksassigning is functional. -- Ready to be used for CSV record processing -type CsvRules = CsvRules' (String -> [ConditionalBlock]) +type CsvRules = CsvRules' (Text -> [ConditionalBlock]) instance Eq CsvRules where r1 == r2 = (rdirectives r1, rcsvfieldindexes r1, rassignments r1) == @@ -277,27 +278,27 @@ instance Show CsvRules where type CsvRulesParser a = StateT CsvRulesParsed SimpleTextParser a -- | The keyword of a CSV rule - "fields", "skip", "if", etc. -type DirectiveName = String +type DirectiveName = Text -- | CSV field name. -type CsvFieldName = String +type CsvFieldName = Text -- | 1-based CSV column number. type CsvFieldIndex = Int -- | Percent symbol followed by a CSV field name or column number. Eg: %date, %1. -type CsvFieldReference = String +type CsvFieldReference = Text -- | One of the standard hledger fields or pseudo-fields that can be assigned to. -- Eg date, account1, amount, amount1-in, date-format. -type HledgerFieldName = String +type HledgerFieldName = Text -- | A text value to be assigned to a hledger field, possibly -- containing csv field references to be interpolated. -type FieldTemplate = String +type FieldTemplate = Text -- | A strptime date parsing pattern, as supported by Data.Time.Format. -type DateFormat = String +type DateFormat = Text -- | A prefix for a matcher test, either & or none (implicit or). data MatcherPrefix = And | None @@ -453,16 +454,16 @@ commentlinep = lift skipNonNewlineSpaces >> commentcharp >> lift restofline >> r commentcharp :: CsvRulesParser Char commentcharp = oneOf (";#*" :: [Char]) -directivep :: CsvRulesParser (DirectiveName, String) +directivep :: CsvRulesParser (DirectiveName, Text) directivep = (do lift $ dbgparse 8 "trying directive" - d <- fmap T.unpack $ choiceInState $ map (lift . string . T.pack) directives + d <- choiceInState $ map (lift . string) directives v <- (((char ':' >> lift (many spacenonewline)) <|> lift (some spacenonewline)) >> directivevalp) <|> (optional (char ':') >> lift skipNonNewlineSpaces >> lift eolof >> return "") return (d, v) ) "directive" -directives :: [String] +directives :: [Text] directives = ["date-format" ,"decimal-mark" @@ -474,8 +475,8 @@ directives = , "balance-type" ] -directivevalp :: CsvRulesParser String -directivevalp = anySingle `manyTill` lift eolof +directivevalp :: CsvRulesParser Text +directivevalp = T.pack <$> anySingle `manyTill` lift eolof fieldnamelistp :: CsvRulesParser [CsvFieldName] fieldnamelistp = (do @@ -487,21 +488,18 @@ fieldnamelistp = (do f <- fromMaybe "" <$> optional fieldnamep fs <- some $ (separator >> fromMaybe "" <$> optional fieldnamep) lift restofline - return $ map (map toLower) $ f:fs + return . map T.toLower $ f:fs ) "field name list" -fieldnamep :: CsvRulesParser String +fieldnamep :: CsvRulesParser Text fieldnamep = quotedfieldnamep <|> barefieldnamep -quotedfieldnamep :: CsvRulesParser String -quotedfieldnamep = do - char '"' - f <- some $ noneOf ("\"\n:;#~" :: [Char]) - char '"' - return f +quotedfieldnamep :: CsvRulesParser Text +quotedfieldnamep = + char '"' *> takeWhile1P Nothing (`notElem` ("\"\n:;#~" :: [Char])) <* char '"' -barefieldnamep :: CsvRulesParser String -barefieldnamep = some $ noneOf (" \t\n,;#~" :: [Char]) +barefieldnamep :: CsvRulesParser Text +barefieldnamep = takeWhile1P Nothing (`notElem` (" \t\n,;#~" :: [Char])) fieldassignmentp :: CsvRulesParser (HledgerFieldName, FieldTemplate) fieldassignmentp = do @@ -513,10 +511,10 @@ fieldassignmentp = do return (f,v) "field assignment" -journalfieldnamep :: CsvRulesParser String +journalfieldnamep :: CsvRulesParser Text journalfieldnamep = do lift (dbgparse 8 "trying journalfieldnamep") - T.unpack <$> choiceInState (map (lift . string . T.pack) journalfieldnames) + choiceInState $ map (lift . string) journalfieldnames maxpostings = 99 @@ -524,14 +522,14 @@ maxpostings = 99 -- Names must precede any other name they contain, for the parser -- (amount-in before amount; date2 before date). TODO: fix journalfieldnames = - concat [[ "account" ++ i - ,"amount" ++ i ++ "-in" - ,"amount" ++ i ++ "-out" - ,"amount" ++ i - ,"balance" ++ i - ,"comment" ++ i - ,"currency" ++ i - ] | x <- [maxpostings, (maxpostings-1)..1], let i = show x] + concat [[ "account" <> i + ,"amount" <> i <> "-in" + ,"amount" <> i <> "-out" + ,"amount" <> i + ,"balance" <> i + ,"comment" <> i + ,"currency" <> i + ] | x <- [maxpostings, (maxpostings-1)..1], let i = T.pack $ show x] ++ ["amount-in" ,"amount-out" @@ -556,10 +554,10 @@ assignmentseparatorp = do ] return () -fieldvalp :: CsvRulesParser String +fieldvalp :: CsvRulesParser Text fieldvalp = do lift $ dbgparse 8 "trying fieldvalp" - anySingle `manyTill` lift eolof + T.pack <$> anySingle `manyTill` lift eolof -- A conditional block: one or more matchers, one per line, followed by one or more indented rules. conditionalblockp :: CsvRulesParser ConditionalBlock @@ -587,14 +585,14 @@ conditionaltablep :: CsvRulesParser [ConditionalBlock] conditionaltablep = do lift $ dbgparse 8 "trying conditionaltablep" start <- getOffset - string "if" + string "if" sep <- lift $ satisfy (\c -> not (isAlphaNum c || isSpace c)) fields <- journalfieldnamep `sepBy1` (char sep) newline body <- flip manyTill (lift eolof) $ do off <- getOffset m <- matcherp' (char sep >> return ()) - vs <- LS.splitOn [sep] <$> lift restofline + vs <- T.split (==sep) . T.pack <$> lift restofline if (length vs /= length fields) then customFailure $ parseErrorAt off $ ((printf "line of conditional table should have %d values, but this one has only %d\n" (length fields) (length vs)) :: String) else return (m,vs) @@ -655,8 +653,8 @@ csvfieldreferencep :: CsvRulesParser CsvFieldReference csvfieldreferencep = do lift $ dbgparse 8 "trying csvfieldreferencep" char '%' - f <- fieldnamep - return $ '%' : quoteIfNeeded f + f <- T.unpack <$> fieldnamep -- XXX unpack and then pack + return . T.pack $ '%' : quoteIfNeeded f -- A single regular expression regexp :: CsvRulesParser () -> CsvRulesParser Regexp @@ -721,7 +719,7 @@ readJournalFromCsv mrulesfile csvfile csvdata = let skiplines = case getDirective "skip" rules of Nothing -> 0 Just "" -> 1 - Just s -> readDef (throwerr $ "could not parse skip value: " ++ show s) s + Just s -> readDef (throwerr $ "could not parse skip value: " ++ show s) $ T.unpack s -- parse csv let @@ -785,12 +783,11 @@ readJournalFromCsv mrulesfile csvfile csvdata = -- | Parse special separator names TAB and SPACE, or return the first -- character. Return Nothing on empty string -parseSeparator :: String -> Maybe Char -parseSeparator = specials . map toLower +parseSeparator :: Text -> Maybe Char +parseSeparator = specials . T.toLower where specials "space" = Just ' ' specials "tab" = Just '\t' - specials (x:_) = Just x - specials [] = Nothing + specials xs = fst <$> T.uncons xs parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV) parseCsv separator filePath csvdata = @@ -813,15 +810,13 @@ parseResultToCsv :: (Foldable t, Functor t) => t (t B.ByteString) -> CSV parseResultToCsv = toListList . unpackFields where toListList = toList . fmap toList - unpackFields = (fmap . fmap) (T.unpack . T.decodeUtf8) + unpackFields = (fmap . fmap) T.decodeUtf8 -printCSV :: CSV -> String -printCSV records = unlined (printRecord `map` records) - where printRecord = concat . intersperse "," . map printField - printField f = "\"" ++ concatMap escape f ++ "\"" - escape '"' = "\"\"" - escape x = [x] - unlined = concat . intersperse "\n" +printCSV :: CSV -> TL.Text +printCSV = TB.toLazyText . unlined . map printRecord + where printRecord = mconcat . map TB.fromText . intersperse "," . map printField + printField = wrap "\"" "\"" . T.replace "\"" "\\\"\\\"" + unlined = (<> TB.fromText "\n") . mconcat . intersperse "\n" -- | Return the cleaned up and validated CSV data (can be empty), or an error. validateCsv :: CsvRules -> Int -> Either String CSV -> Either String [CsvRecord] @@ -834,7 +829,7 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr (Nothing, Nothing) -> Nothing (Just _, _) -> Just maxBound (Nothing, Just "") -> Just 1 - (Nothing, Just x) -> Just (read x) + (Nothing, Just x) -> Just (read $ T.unpack x) applyConditionalSkips [] = [] applyConditionalSkips (r:rest) = case skipCount r of @@ -866,7 +861,7 @@ validateCsv rules numhdrlines (Right rs) = validate $ applyConditionalSkips $ dr --- ** converting csv records to transactions showRules rules record = - unlines $ catMaybes [ (("the "++fld++" rule is: ")++) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames] + T.unlines $ catMaybes [ (("the "<>fld<>" rule is: ")<>) <$> getEffectiveAssignment rules record fld | fld <- journalfieldnames] -- | Look up the value (template) of a csv rule by rule keyword. csvRule :: CsvRules -> DirectiveName -> Maybe FieldTemplate @@ -880,7 +875,7 @@ hledgerField = getEffectiveAssignment -- | Look up the final value assigned to a hledger field, with csv field -- references interpolated. -hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe String +hledgerFieldValue :: CsvRules -> CsvRecord -> HledgerFieldName -> Maybe Text hledgerFieldValue rules record = fmap (renderTemplate rules record) . hledgerField rules record transactionFromCsvRecord :: SourcePos -> CsvRules -> CsvRecord -> Transaction @@ -892,18 +887,18 @@ transactionFromCsvRecord sourcepos rules record = t rule = csvRule rules :: DirectiveName -> Maybe FieldTemplate -- ruleval = csvRuleValue rules record :: DirectiveName -> Maybe String field = hledgerField rules record :: HledgerFieldName -> Maybe FieldTemplate - fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String + fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text parsedate = parseDateWithCustomOrDefaultFormats (rule "date-format") - mkdateerror datefield datevalue mdateformat = unlines - ["error: could not parse \""++datevalue++"\" as a date using date format " - ++maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" show mdateformat + mkdateerror datefield datevalue mdateformat = T.unpack $ T.unlines + ["error: could not parse \""<>datevalue<>"\" as a date using date format " + <>maybe "\"YYYY/M/D\", \"YYYY-M-D\" or \"YYYY.M.D\"" (T.pack . show) mdateformat ,showRecord record - ,"the "++datefield++" rule is: "++(fromMaybe "required, but missing" $ field datefield) - ,"the date-format is: "++fromMaybe "unspecified" mdateformat + ,"the "<>datefield<>" rule is: "<>(fromMaybe "required, but missing" $ field datefield) + ,"the date-format is: "<>fromMaybe "unspecified" mdateformat ,"you may need to " - ++"change your "++datefield++" rule, " - ++maybe "add a" (const "change your") mdateformat++" date-format rule, " - ++"or "++maybe "add a" (const "change your") mskip++" skip rule" + <>"change your "<>datefield<>" rule, " + <>maybe "add a" (const "change your") mdateformat<>" date-format rule, " + <>"or "<>maybe "add a" (const "change your") mskip<>" skip rule" ,"for m/d/y or d/m/y dates, use date-format %-m/%-d/%Y or date-format %-d/%-m/%Y" ] where @@ -923,10 +918,10 @@ transactionFromCsvRecord sourcepos rules record = t status = case fieldval "status" of Nothing -> Unmarked - Just s -> either statuserror id $ runParser (statusp <* eof) "" $ T.pack s + Just s -> either statuserror id $ runParser (statusp <* eof) "" s where statuserror err = error' $ unlines - ["error: could not parse \""++s++"\" as a cleared status (should be *, ! or empty)" + ["error: could not parse \""<>T.unpack s<>"\" as a cleared status (should be *, ! or empty)" ,"the parse error is: "++customErrorBundlePretty err ] code = maybe "" singleline $ fieldval "code" @@ -934,14 +929,16 @@ transactionFromCsvRecord sourcepos rules record = t comment = maybe "" singleline $ fieldval "comment" precomment = maybe "" singleline $ fieldval "precomment" + singleline = T.unwords . filter (not . T.null) . map T.strip . T.lines + ---------------------------------------------------------------------- -- 3. Generate the postings for which an account has been assigned -- (possibly indirectly due to an amount or balance assignment) - p1IsVirtual = (accountNamePostingType . T.pack <$> fieldval "account1") == Just VirtualPosting + p1IsVirtual = (accountNamePostingType <$> fieldval "account1") == Just VirtualPosting ps = [p | n <- [1..maxpostings] - ,let comment = T.pack $ fromMaybe "" $ fieldval ("comment"++show n) - ,let currency = fromMaybe "" (fieldval ("currency"++show n) <|> fieldval "currency") + ,let comment = fromMaybe "" $ fieldval ("comment"<> T.pack (show n)) + ,let currency = fromMaybe "" (fieldval ("currency"<> T.pack (show n)) <|> fieldval "currency") ,let mamount = getAmount rules record currency p1IsVirtual n ,let mbalance = getBalance rules record currency n ,Just (acct,isfinal) <- [getAccount rules record mamount mbalance n] -- skips Nothings @@ -965,10 +962,10 @@ transactionFromCsvRecord sourcepos rules record = t ,tdate = date' ,tdate2 = mdate2' ,tstatus = status - ,tcode = T.pack code - ,tdescription = T.pack description - ,tcomment = T.pack comment - ,tprecedingcomment = T.pack precomment + ,tcode = code + ,tdescription = description + ,tcomment = comment + ,tprecedingcomment = precomment ,tpostings = ps } @@ -979,7 +976,7 @@ transactionFromCsvRecord sourcepos rules record = t -- For postings 1 or 2 it also looks at "amount", "amount-in", "amount-out". -- If more than one of these has a value, it looks for one that is non-zero. -- If there's multiple non-zeros, or no non-zeros but multiple zeros, it throws an error. -getAmount :: CsvRules -> CsvRecord -> String -> Bool -> Int -> Maybe MixedAmount +getAmount :: CsvRules -> CsvRecord -> Text -> Bool -> Int -> Maybe MixedAmount getAmount rules record currency p1IsVirtual n = -- Warning, many tricky corner cases here. -- docs: hledger_csv.m4.md #### amount @@ -988,14 +985,15 @@ getAmount rules record currency p1IsVirtual n = unnumberedfieldnames = ["amount","amount-in","amount-out"] -- amount field names which can affect this posting - fieldnames = map (("amount"++show n)++) ["","-in","-out"] + fieldnames = map (("amount"<> T.pack(show n))<>) ["","-in","-out"] -- For posting 1, also recognise the old amount/amount-in/amount-out names. -- For posting 2, the same but only if posting 1 needs balancing. ++ if n==1 || n==2 && not p1IsVirtual then unnumberedfieldnames else [] -- assignments to any of these field names with non-empty values assignments = [(f,a') | f <- fieldnames - , Just v@(_:_) <- [strip . renderTemplate rules record <$> hledgerField rules record f] + , Just v <- [T.strip . renderTemplate rules record <$> hledgerField rules record f] + , not $ T.null v , let a = parseAmount rules record currency v -- With amount/amount-in/amount-out, in posting 2, -- flip the sign and convert to cost, as they did before 1.17 @@ -1006,7 +1004,7 @@ getAmount rules record currency p1IsVirtual n = assignments' | any isnumbered assignments = filter isnumbered assignments | otherwise = assignments where - isnumbered (f,_) = any (flip elem ['0'..'9']) f + isnumbered (f,_) = T.any (flip elem ['0'..'9']) f -- if there's more than one value and only some are zeros, discard the zeros assignments'' @@ -1017,24 +1015,24 @@ getAmount rules record currency p1IsVirtual n = in case -- dbg0 ("amounts for posting "++show n) assignments'' of [] -> Nothing - [(f,a)] | "-out" `isSuffixOf` f -> Just (-a) -- for -out fields, flip the sign + [(f,a)] | "-out" `T.isSuffixOf` f -> Just (-a) -- for -out fields, flip the sign [(_,a)] -> Just a - fs -> error' $ unlines $ [ -- PARTIAL: + fs -> error' . T.unpack . T.unlines $ [ -- PARTIAL: "multiple non-zero amounts or multiple zero amounts assigned," ,"please ensure just one. (https://hledger.org/csv.html#amount)" - ," " ++ showRecord record - ," for posting: " ++ show n + ," " <> showRecord record + ," for posting: " <> T.pack (show n) ] - ++ [" assignment: " ++ f ++ " " ++ - fromMaybe "" (hledgerField rules record f) ++ - "\t=> value: " ++ showMixedAmount a -- XXX not sure this is showing all the right info + ++ [" assignment: " <> f <> " " <> + fromMaybe "" (hledgerField rules record f) <> + "\t=> value: " <> T.pack (showMixedAmount a) -- XXX not sure this is showing all the right info | (f,a) <- fs] -- | Figure out the expected balance (assertion or assignment) specified for posting N, -- if any (and its parse position). -getBalance :: CsvRules -> CsvRecord -> String -> Int -> Maybe (Amount, GenericSourcePos) +getBalance :: CsvRules -> CsvRecord -> Text -> Int -> Maybe (Amount, GenericSourcePos) getBalance rules record currency n = do - v <- (fieldval ("balance"++show n) + v <- (fieldval ("balance"<> T.pack (show n)) -- for posting 1, also recognise the old field name <|> if n==1 then fieldval "balance" else Nothing) case v of @@ -1043,30 +1041,29 @@ getBalance rules record currency n = do parseBalanceAmount rules record currency n s ,nullsourcepos -- parse position to show when assertion fails, ) -- XXX the csv record's line number would be good - where - fieldval = fmap strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe String + fieldval = fmap T.strip . hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text -- | Given a non-empty amount string (from CSV) to parse, along with a -- possibly non-empty currency symbol to prepend, -- parse as a hledger MixedAmount (as in journal format), or raise an error. -- The whole CSV record is provided for the error message. -parseAmount :: CsvRules -> CsvRecord -> String -> String -> MixedAmount +parseAmount :: CsvRules -> CsvRecord -> Text -> Text -> MixedAmount parseAmount rules record currency s = - either mkerror (Mixed . (:[])) $ -- PARTIAL: - runParser (evalStateT (amountp <* eof) journalparsestate) "" $ - T.pack $ (currency++) $ simplifySign s + either mkerror (Mixed . (:[])) $ -- PARTIAL: + runParser (evalStateT (amountp <* eof) journalparsestate) "" $ + currency <> simplifySign s where journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules} - mkerror e = error' $ unlines - ["error: could not parse \""++s++"\" as an amount" + mkerror e = error' . T.unpack $ T.unlines + ["error: could not parse \"" <> s <> "\" as an amount" ,showRecord record ,showRules rules record -- ,"the default-currency is: "++fromMaybe "unspecified" (getDirective "default-currency" rules) - ,"the parse error is: "++customErrorBundlePretty e - ,"you may need to " - ++"change your amount*, balance*, or currency* rules, " - ++"or add or change your skip rule" + ,"the parse error is: " <> T.pack (customErrorBundlePretty e) + ,"you may need to \ + \change your amount*, balance*, or currency* rules, \ + \or add or change your skip rule" ] -- XXX unify these ^v @@ -1076,30 +1073,30 @@ parseAmount rules record currency s = -- possibly non-empty currency symbol to prepend, -- parse as a hledger Amount (as in journal format), or raise an error. -- The CSV record and the field's numeric suffix are provided for the error message. -parseBalanceAmount :: CsvRules -> CsvRecord -> String -> Int -> String -> Amount +parseBalanceAmount :: CsvRules -> CsvRecord -> Text -> Int -> Text -> Amount parseBalanceAmount rules record currency n s = either (mkerror n s) id $ runParser (evalStateT (amountp <* eof) journalparsestate) "" $ - T.pack $ (currency++) $ simplifySign s + currency <> simplifySign s -- the csv record's line number would be good where journalparsestate = nulljournal{jparsedecimalmark=parseDecimalMark rules} - mkerror n s e = error' $ unlines - ["error: could not parse \""++s++"\" as balance"++show n++" amount" + mkerror n s e = error' . T.unpack $ T.unlines + ["error: could not parse \"" <> s <> "\" as balance"<> T.pack (show n) <> " amount" ,showRecord record ,showRules rules record -- ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency - ,"the parse error is: "++customErrorBundlePretty e + ,"the parse error is: "<> T.pack (customErrorBundlePretty e) ] -- Read a valid decimal mark from the decimal-mark rule, if any. -- If the rule is present with an invalid argument, raise an error. parseDecimalMark :: CsvRules -> Maybe DecimalMark -parseDecimalMark rules = - case rules `csvRule` "decimal-mark" of - Nothing -> Nothing - Just [c] | isDecimalMark c -> Just c - Just s -> error' $ "decimal-mark's argument should be \".\" or \",\" (not \""++s++"\")" +parseDecimalMark rules = do + s <- rules `csvRule` "decimal-mark" + case T.uncons s of + Just (c, rest) | T.null rest && isDecimalMark c -> return c + _ -> error' . T.unpack $ "decimal-mark's argument should be \".\" or \",\" (not \""<>s<>"\")" -- | Make a balance assertion for the given amount, with the given parse -- position (to be shown in assertion failures), with the assertion type @@ -1116,8 +1113,8 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos} Just "==" -> nullassertion{batotal=True} Just "=*" -> nullassertion{bainclusive=True} Just "==*" -> nullassertion{batotal=True, bainclusive=True} - Just x -> error' $ unlines -- PARTIAL: - [ "balance-type \"" ++ x ++"\" is invalid. Use =, ==, =* or ==*." + Just x -> error' . T.unpack $ T.unlines -- PARTIAL: + [ "balance-type \"" <> x <>"\" is invalid. Use =, ==, =* or ==*." , showRecord record , showRules rules record ] @@ -1128,8 +1125,8 @@ mkBalanceAssertion rules record (amt, pos) = assrt{baamount=amt, baposition=pos} getAccount :: CsvRules -> CsvRecord -> Maybe MixedAmount -> Maybe (Amount, GenericSourcePos) -> Int -> Maybe (AccountName, Bool) getAccount rules record mamount mbalance n = let - fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe String - maccount = T.pack <$> fieldval ("account"++show n) + fieldval = hledgerFieldValue rules record :: HledgerFieldName -> Maybe Text + maccount = fieldval ("account"<> T.pack (show n)) in case maccount of -- accountN is set to the empty string - no posting will be generated Just "" -> Nothing @@ -1150,7 +1147,7 @@ getAccount rules record mamount mbalance n = unknownExpenseAccount = "expenses:unknown" unknownIncomeAccount = "income:unknown" -type CsvAmountString = String +type CsvAmountString = Text -- | Canonicalise the sign in a CSV amount string. -- Such strings can have a minus sign, negating parentheses, @@ -1171,18 +1168,20 @@ type CsvAmountString = String -- >>> simplifySign "((1))" -- "1" simplifySign :: CsvAmountString -> CsvAmountString -simplifySign ('(':s) | lastMay s == Just ')' = simplifySign $ negateStr $ init s -simplifySign ('-':'(':s) | lastMay s == Just ')' = simplifySign $ init s -simplifySign ('-':'-':s) = s -simplifySign s = s +simplifySign amtstr + | Just ('(',t) <- T.uncons amtstr, Just (amt,')') <- T.unsnoc t = simplifySign $ negateStr amt + | Just ('-',b) <- T.uncons amtstr, Just ('(',t) <- T.uncons b, Just (amt,')') <- T.unsnoc t = simplifySign amt + | Just ('-',m) <- T.uncons amtstr, Just ('-',amt) <- T.uncons m = amt + | otherwise = amtstr -negateStr :: String -> String -negateStr ('-':s) = s -negateStr s = '-':s +negateStr :: Text -> Text +negateStr amtstr = case T.uncons amtstr of + Just ('-',s) -> s + _ -> T.cons '-' amtstr -- | Show a (approximate) recreation of the original CSV record. -showRecord :: CsvRecord -> String -showRecord r = "record values: "++intercalate "," (map show r) +showRecord :: CsvRecord -> Text +showRecord r = "record values: "<>T.intercalate "," (map (wrap "\"" "\"") r) -- | Given the conversion rules, a CSV record and a hledger field name, find -- the value template ultimately assigned to this field, if any, by a field @@ -1217,47 +1216,48 @@ getEffectiveAssignment rules record f = lastMay $ map snd $ assignments -- - any quotes enclosing field values are removed -- - and the field separator is always comma -- which means that a field containing a comma will look like two fields. - wholecsvline = dbg7 "wholecsvline" $ intercalate "," record - matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat csvfieldvalue + wholecsvline = dbg7 "wholecsvline" . T.unpack $ T.intercalate "," record + matcherMatches (FieldMatcher _ csvfieldref pat) = regexMatch pat $ T.unpack csvfieldvalue where -- the value of the referenced CSV field to match against. csvfieldvalue = dbg7 "csvfieldvalue" $ replaceCsvFieldReference rules record csvfieldref -- | Render a field assignment's template, possibly interpolating referenced -- CSV field values. Outer whitespace is removed from interpolated values. -renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> String -renderTemplate rules record t = maybe t concat $ parseMaybe +renderTemplate :: CsvRules -> CsvRecord -> FieldTemplate -> Text +renderTemplate rules record t = maybe t mconcat $ parseMaybe (many $ takeWhile1P Nothing (/='%') <|> replaceCsvFieldReference rules record <$> referencep) t where - referencep = liftA2 (:) (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr String String + referencep = liftA2 T.cons (char '%') (takeWhile1P (Just "reference") isDescriptorChar) :: Parsec CustomErr Text Text isDescriptorChar c = isAscii c && (isAlphaNum c || c == '_' || c == '-') -- | Replace something that looks like a reference to a csv field ("%date" or "%1) -- with that field's value. If it doesn't look like a field reference, or if we -- can't find such a field, leave it unchanged. -replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> String -replaceCsvFieldReference rules record s@('%':fieldname) = fromMaybe s $ csvFieldValue rules record fieldname -replaceCsvFieldReference _ _ s = s +replaceCsvFieldReference :: CsvRules -> CsvRecord -> CsvFieldReference -> Text +replaceCsvFieldReference rules record s = case T.uncons s of + Just ('%', fieldname) -> fromMaybe s $ csvFieldValue rules record fieldname + _ -> s -- | Get the (whitespace-stripped) value of a CSV field, identified by its name or -- column number, ("date" or "1"), from the given CSV record, if such a field exists. -csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe String +csvFieldValue :: CsvRules -> CsvRecord -> CsvFieldName -> Maybe Text csvFieldValue rules record fieldname = do - fieldindex <- if | all isDigit fieldname -> readMay fieldname - | otherwise -> lookup (map toLower fieldname) $ rcsvfieldindexes rules - fieldvalue <- strip <$> atMay record (fieldindex-1) + fieldindex <- if | T.all isDigit fieldname -> readMay $ T.unpack fieldname + | otherwise -> lookup (T.toLower fieldname) $ rcsvfieldindexes rules + fieldvalue <- T.strip <$> atMay record (fieldindex-1) return fieldvalue -- | Parse the date string using the specified date-format, or if unspecified -- the "simple date" formats (YYYY/MM/DD, YYYY-MM-DD, YYYY.MM.DD, leading -- zeroes optional). -parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> String -> Maybe Day +parseDateWithCustomOrDefaultFormats :: Maybe DateFormat -> Text -> Maybe Day parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats where - parsewith = flip (parseTimeM True defaultTimeLocale) s - formats = maybe + parsewith = flip (parseTimeM True defaultTimeLocale) (T.unpack s) + formats = map T.unpack $ maybe ["%Y/%-m/%-d" ,"%Y-%-m-%-d" ,"%Y.%-m.%-d" diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index dc4e07e4b..19c9948f0 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -351,13 +351,13 @@ budgetReportAsCsv -- heading row ("Account" : - concatMap (\span -> [T.unpack $ showDateSpan span, "budget"]) colspans + concatMap (\span -> [showDateSpan span, "budget"]) colspans ++ concat [["Total" ,"budget"] | row_total_] ++ concat [["Average","budget"] | average_] ) : -- account rows - [T.unpack (displayFull a) : + [displayFull a : map showmamt (flattentuples abamts) ++ concat [[showmamt mactualrowtot, showmamt mbudgetrowtot] | row_total_] ++ concat [[showmamt mactualrowavg, showmamt mbudgetrowavg] | average_] @@ -377,7 +377,7 @@ budgetReportAsCsv where flattentuples abs = concat [[a,b] | (a,b) <- abs] - showmamt = maybe "" (showMixedAmountOneLineWithoutPrice False) + showmamt = maybe "" (T.pack . showMixedAmountOneLineWithoutPrice False) -- tests diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 0125aa472..8def63904 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack -- @@ -125,7 +125,6 @@ library , pretty-simple >4 && <5 , regex-tdfa , safe >=0.2 - , split >=0.1 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 @@ -176,7 +175,6 @@ test-suite doctest , pretty-simple >4 && <5 , regex-tdfa , safe >=0.2 - , split >=0.1 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 @@ -229,7 +227,6 @@ test-suite unittest , pretty-simple >4 && <5 , regex-tdfa , safe >=0.2 - , split >=0.1 , tabular >=0.2 , tasty >=1.2.3 , tasty-hunit >=0.10.0.2 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index ca4b641f7..d620be972 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -58,7 +58,6 @@ dependencies: - pretty-simple >4 && <5 - regex-tdfa - safe >=0.2 -- split >=0.1 - tabular >=0.2 - tasty >=1.2.3 - tasty-hunit >=0.10.0.2 diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index c32443891..267a9d316 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -113,7 +113,7 @@ aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do reverse items -- select renderer render | fmt=="txt" = accountTransactionsReportAsText opts reportq thisacctq - | fmt=="csv" = TL.pack . printCSV . accountTransactionsReportAsCsv reportq thisacctq + | fmt=="csv" = printCSV . accountTransactionsReportAsCsv reportq thisacctq | fmt=="json" = toJsonText | otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL: where @@ -130,14 +130,12 @@ accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransaction accountTransactionsReportItemAsCsvRecord reportq thisacctq (t@Transaction{tindex,tcode,tdescription}, _, _issplit, otheracctsstr, change, balance) - = [idx,date,code,desc,T.unpack otheracctsstr,amt,bal] + = [idx,date,tcode,tdescription,otheracctsstr,amt,bal] where - idx = show tindex - date = T.unpack . showDate $ transactionRegisterDate reportq thisacctq t - code = T.unpack tcode - desc = T.unpack tdescription - amt = showMixedAmountOneLineWithoutPrice False change - bal = showMixedAmountOneLineWithoutPrice False balance + idx = T.pack $ show tindex + date = showDate $ transactionRegisterDate reportq thisacctq t + amt = T.pack $ showMixedAmountOneLineWithoutPrice False change + bal = T.pack $ showMixedAmountOneLineWithoutPrice False balance -- | Render a register report as plain text suitable for console output. accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> TL.Text diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 79c454383..e385aa7db 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -321,8 +321,8 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do assrt = not $ ignore_assertions_ $ inputopts_ opts render = case fmt of "txt" -> budgetReportAsText ropts - "json" -> (++"\n") . TL.unpack . toJsonText - "csv" -> (++"\n") . printCSV . budgetReportAsCsv ropts + "json" -> TL.unpack . (<>"\n") . toJsonText + "csv" -> TL.unpack . printCSV . budgetReportAsCsv ropts _ -> const $ error' $ unsupportedOutputFormatError fmt writeOutput opts $ render budgetreport @@ -330,21 +330,21 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do if multiperiod then do -- multi period balance report let report = multiBalanceReport rspec j render = case fmt of - "txt" -> multiBalanceReportAsText ropts - "csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts - "html" -> (++"\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts - "json" -> (++"\n") . TL.unpack . toJsonText + "txt" -> TL.pack . multiBalanceReportAsText ropts + "csv" -> printCSV . multiBalanceReportAsCsv ropts + "html" -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts + "json" -> (<>"\n") . toJsonText _ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: - writeOutput opts $ render report + writeOutputLazyText opts $ render report else do -- single period simple balance report let report = balanceReport rspec j -- simple Ledger-style balance report render = case fmt of - "txt" -> balanceReportAsText - "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r - "json" -> const $ (++"\n") . TL.unpack . toJsonText - _ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: - writeOutput opts $ render ropts report + "txt" -> \ropts -> TL.pack . balanceReportAsText ropts + "csv" -> \ropts -> printCSV . balanceReportAsCsv ropts + "json" -> const $ (<>"\n") . toJsonText + _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: + writeOutputLazyText opts $ render ropts report -- XXX should all the per-report, per-format rendering code live in the command module, @@ -356,11 +356,11 @@ balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV balanceReportAsCsv opts (items, total) = ["account","balance"] : - [[T.unpack a, showMixedAmountOneLineWithoutPrice False b] | (a, _, _, b) <- items] + [[a, T.pack $ showMixedAmountOneLineWithoutPrice False b] | (a, _, _, b) <- items] ++ if no_total_ opts then [] - else [["total", showMixedAmountOneLineWithoutPrice False total]] + else [["total", T.pack $ showMixedAmountOneLineWithoutPrice False total]] -- | Render a single-column balance report as plain text. balanceReportAsText :: ReportOpts -> BalanceReport -> String @@ -446,12 +446,12 @@ multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_} (PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) = maybetranspose $ - ("Account" : map (T.unpack . showDateSpan) colspans + ("Account" : map showDateSpan colspans ++ ["Total" | row_total_] ++ ["Average" | average_] ) : - [T.unpack (displayFull a) : - map (showMixedAmountOneLineWithoutPrice False) + [displayFull a : + map (T.pack . showMixedAmountOneLineWithoutPrice False) (amts ++ [rowtot | row_total_] ++ [rowavg | average_]) @@ -460,7 +460,7 @@ multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_} if no_total_ opts then [] else ["Total:" : - map (showMixedAmountOneLineWithoutPrice False) ( + map (T.pack . showMixedAmountOneLineWithoutPrice False) ( coltotals ++ [tot | row_total_] ++ [avg | average_] @@ -496,7 +496,7 @@ multiBalanceReportHtmlRows ropts mbr = ) -- | Render one MultiBalanceReport heading row as a HTML table row. -multiBalanceReportHtmlHeadRow :: ReportOpts -> [String] -> Html () +multiBalanceReportHtmlHeadRow :: ReportOpts -> [T.Text] -> Html () multiBalanceReportHtmlHeadRow _ [] = mempty -- shouldn't happen multiBalanceReportHtmlHeadRow ropts (acct:rest) = let @@ -514,7 +514,7 @@ multiBalanceReportHtmlHeadRow ropts (acct:rest) = ++ [td_ [class_ "rowaverage", defstyle] (toHtml a) | a <- avg] -- | Render one MultiBalanceReport data row as a HTML table row. -multiBalanceReportHtmlBodyRow :: ReportOpts -> [String] -> Html () +multiBalanceReportHtmlBodyRow :: ReportOpts -> [T.Text] -> Html () multiBalanceReportHtmlBodyRow _ [] = mempty -- shouldn't happen multiBalanceReportHtmlBodyRow ropts (label:rest) = let @@ -532,7 +532,7 @@ multiBalanceReportHtmlBodyRow ropts (label:rest) = ++ [td_ [class_ "amount rowaverage", defstyle] (toHtml a) | a <- avg] -- | Render one MultiBalanceReport totals row as a HTML table row. -multiBalanceReportHtmlFootRow :: ReportOpts -> [String] -> Html () +multiBalanceReportHtmlFootRow :: ReportOpts -> [T.Text] -> Html () multiBalanceReportHtmlFootRow _ropts [] = mempty -- TODO pad totals row with zeros when subreport is empty -- multiBalanceReportHtmlFootRow ropts $ diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 0921a144e..35d47dc0d 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -60,7 +60,7 @@ printEntries opts@CliOpts{reportspec_=rspec} j = where fmt = outputFormatFromOpts opts render | fmt=="txt" = entriesReportAsText opts - | fmt=="csv" = TL.pack . printCSV . entriesReportAsCsv + | fmt=="csv" = printCSV . entriesReportAsCsv | fmt=="json" = toJsonText | fmt=="sql" = entriesReportAsSql | otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL: @@ -137,9 +137,7 @@ entriesReportAsSql txns = TB.toLazyText $ mconcat where values vs = TB.fromText "(" <> mconcat (intersperse (TB.fromText ",") $ map toSql vs) <> TB.fromText ")\n" toSql "" = TB.fromText "NULL" - toSql s = TB.fromText "'" <> TB.fromString (concatMap quoteChar s) <> TB.fromText "'" - quoteChar '\'' = "''" - quoteChar c = [c] + toSql s = TB.fromText "'" <> TB.fromText (T.replace "'" "''" s) <> TB.fromText "'" csv = concatMap transactionToCSV txns entriesReportAsCsv :: EntriesReport -> CSV @@ -151,16 +149,16 @@ entriesReportAsCsv txns = -- The txnidx field (transaction index) allows postings to be grouped back into transactions. transactionToCSV :: Transaction -> CSV transactionToCSV t = - map (\p -> show idx:date:date2:status:code:description:comment:p) + map (\p -> T.pack (show idx):date:date2:status:code:description:comment:p) (concatMap postingToCSV $ tpostings t) where idx = tindex t - description = T.unpack $ tdescription t - date = T.unpack $ showDate (tdate t) - date2 = maybe "" (T.unpack . showDate) (tdate2 t) - status = show $ tstatus t - code = T.unpack $ tcode t - comment = chomp $ strip $ T.unpack $ tcomment t + description = tdescription t + date = showDate (tdate t) + date2 = maybe "" showDate $ tdate2 t + status = T.pack . show $ tstatus t + code = tcode t + comment = T.strip $ tcomment t postingToCSV :: Posting -> CSV postingToCSV p = @@ -168,17 +166,16 @@ postingToCSV p = -- commodity goes into separate column, so we suppress it, along with digit group -- separators and prices let a_ = a{acommodity="",astyle=(astyle a){asdigitgroups=Nothing},aprice=Nothing} in - let amount = showAmount a_ in - let commodity = T.unpack c in - let credit = if q < 0 then showAmount $ negate a_ else "" in - let debit = if q >= 0 then showAmount a_ else "" in - [account, amount, commodity, credit, debit, status, comment]) + let amount = T.pack $ showAmount a_ in + let credit = if q < 0 then T.pack . showAmount $ negate a_ else "" in + let debit = if q >= 0 then T.pack $ showAmount a_ else "" in + [account, amount, c, credit, debit, status, comment]) amounts where Mixed amounts = pamount p - status = show $ pstatus p - account = T.unpack $ showAccountName Nothing (ptype p) (paccount p) - comment = T.unpack . textChomp . T.strip $ pcomment p + status = T.pack . show $ pstatus p + account = showAccountName Nothing (ptype p) (paccount p) + comment = T.strip $ pcomment p -- --match diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 9e93f3ef5..74151e0fa 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -64,7 +64,7 @@ register opts@CliOpts{reportspec_=rspec} j = where fmt = outputFormatFromOpts opts render | fmt=="txt" = postingsReportAsText opts - | fmt=="csv" = TL.pack . printCSV . postingsReportAsCsv + | fmt=="csv" = printCSV . postingsReportAsCsv | fmt=="json" = toJsonText | otherwise = error' $ unsupportedOutputFormatError fmt -- PARTIAL: @@ -77,18 +77,18 @@ postingsReportAsCsv is = postingsReportItemAsCsvRecord :: PostingsReportItem -> CsvRecord postingsReportItemAsCsvRecord (_, _, _, p, b) = [idx,date,code,desc,acct,amt,bal] where - idx = show $ maybe 0 tindex $ ptransaction p - date = T.unpack . showDate $ postingDate p -- XXX csv should show date2 with --date2 - code = maybe "" (T.unpack . tcode) $ ptransaction p - desc = T.unpack . maybe "" tdescription $ ptransaction p - acct = T.unpack . bracket $ paccount p + idx = T.pack . show . maybe 0 tindex $ ptransaction p + date = showDate $ postingDate p -- XXX csv should show date2 with --date2 + code = maybe "" tcode $ ptransaction p + desc = maybe "" tdescription $ ptransaction p + acct = bracket $ paccount p where bracket = case ptype p of BalancedVirtualPosting -> wrap "[" "]" VirtualPosting -> wrap "(" ")" _ -> id - amt = showMixedAmountOneLineWithoutPrice False $ pamount p - bal = showMixedAmountOneLineWithoutPrice False b + amt = T.pack $ showMixedAmountOneLineWithoutPrice False $ pamount p + bal = T.pack $ showMixedAmountOneLineWithoutPrice False b -- | Render a register report as plain text suitable for console output. postingsReportAsText :: CliOpts -> PostingsReport -> TL.Text diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index e50a586ac..132ef8f03 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -154,7 +154,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r -- render appropriately render = case outputFormatFromOpts opts of "txt" -> TL.pack . compoundBalanceReportAsText ropts' - "csv" -> TL.pack . printCSV . compoundBalanceReportAsCsv ropts' + "csv" -> printCSV . compoundBalanceReportAsCsv ropts' "html" -> L.renderText . compoundBalanceReportAsHtml ropts' "json" -> toJsonText x -> error' $ unsupportedOutputFormatError x @@ -230,18 +230,18 @@ concatTables (Table hLeft hTop dat) (Table hLeft' _ dat') = -- optional overall totals row is added. compoundBalanceReportAsCsv :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> CSV compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subreports (PeriodicReportRow _ coltotals grandtotal grandavg)) = - addtotals $ - padRow title : - map T.unpack ("Account" : - map showDateSpanMonthAbbrev colspans - ++ (if row_total_ ropts then ["Total"] else []) - ++ (if average_ ropts then ["Average"] else []) - ) : - concatMap (subreportAsCsv ropts) subreports + addtotals $ + padRow (T.pack title) + : ( "Account" + : map showDateSpanMonthAbbrev colspans + ++ (if row_total_ ropts then ["Total"] else []) + ++ (if average_ ropts then ["Average"] else []) + ) + : concatMap (subreportAsCsv ropts) subreports where -- | Add a subreport title row and drop the heading row. subreportAsCsv ropts (subreporttitle, multibalreport, _) = - padRow subreporttitle : + padRow (T.pack subreporttitle) : tail (multiBalanceReportAsCsv ropts multibalreport) padRow s = take numcols $ s : repeat "" where @@ -257,7 +257,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor | no_total_ ropts || length subreports == 1 = id | otherwise = (++ ["Net:" : - map (showMixedAmountOneLineWithoutPrice False) ( + map (T.pack . showMixedAmountOneLineWithoutPrice False) ( coltotals ++ (if row_total_ ropts then [grandtotal] else []) ++ (if average_ ropts then [grandavg] else [])