diff --git a/MANUAL.md b/MANUAL.md index 778115148..992d81822 100644 --- a/MANUAL.md +++ b/MANUAL.md @@ -674,6 +674,28 @@ Notes: track the expenses in the currencies there were made, while keeping your base account in single currency +#### Formatting the description field + +If you want to combine more than one field from the CVS row into +the description field you can use an formatting expression for +`description-field`. + +With this rule: + + $ description-field %(1)/%(3) + +and this CVS input: + + $ 11/2009/09,Flubber Co,50,My comment + +you will get this record: + + 2009/09/11 Flubber Co/My comment + income:unknown $50 + Assets:MyAccount $-50 + +#### Converting streams + The convert command also supports converting standard input if you're streaming a CSV file from the web or another tool. Use `-` as the input file and hledger will read from stdin: diff --git a/hledger/Hledger/Cli/Convert.hs b/hledger/Hledger/Cli/Convert.hs index 0635ca4d8..f1017533a 100644 --- a/hledger/Hledger/Cli/Convert.hs +++ b/hledger/Hledger/Cli/Convert.hs @@ -8,7 +8,7 @@ import Prelude hiding (getContents) import Control.Monad (when, guard, liftM) import Data.Maybe import Data.Time.Format (parseTime) -import Safe (atDef, maximumDef) +import Safe (atDef, atMay, maximumDef) import Safe (readDef, readMay) import System.Directory (doesFileExist) import System.Exit (exitFailure) @@ -20,6 +20,8 @@ import Text.CSV (parseCSV, parseCSVFromFile, printCSV, CSV) import Text.ParserCombinators.Parsec import Text.Printf (hPrintf) +import Hledger.Cli.Format +import qualified Hledger.Cli.Format as Format import Hledger.Cli.Version import Hledger.Cli.Options (Opt(Debug), progname_cli, rulesFileFromOpts) import Hledger.Data.Amount (nullmixedamt, costOfMixedAmount) @@ -27,7 +29,7 @@ import Hledger.Data.Dates (firstJust, showDate, parsedate) import Hledger.Data (Journal,AccountName,Transaction(..),Posting(..),PostingType(..)) import Hledger.Data.Journal (nullctx) import Hledger.Read.JournalReader (someamount,ledgeraccountname) -import Hledger.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error', regexMatchesCI, regexReplaceCI) +import Hledger.Utils (choice', strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error', regexMatchesCI, regexReplaceCI) import Hledger.Utils.UTF8 (getContents) {- | @@ -39,7 +41,7 @@ data CsvRules = CsvRules { dateFormat :: Maybe String, statusField :: Maybe FieldPosition, codeField :: Maybe FieldPosition, - descriptionField :: Maybe FieldPosition, + descriptionField :: [FormatString], amountField :: Maybe FieldPosition, inField :: Maybe FieldPosition, outField :: Maybe FieldPosition, @@ -57,7 +59,7 @@ nullrules = CsvRules { dateFormat=Nothing, statusField=Nothing, codeField=Nothing, - descriptionField=Nothing, + descriptionField=[], amountField=Nothing, inField=Nothing, outField=Nothing, @@ -131,7 +133,6 @@ maxFieldIndex r = maximumDef (-1) $ catMaybes [ dateField r ,statusField r ,codeField r - ,descriptionField r ,amountField r ,inField r ,outField r @@ -205,9 +206,6 @@ csvrulesfile = do eof return r{accountRules=ars} --- | Real independent parser choice, even when alternative matches share a prefix. -choice' parsers = choice $ map try (init parsers) ++ [last parsers] - definitions :: GenParser Char CsvRules () definitions = do choice' [ @@ -233,100 +231,96 @@ datefield = do string "date-field" many1 spacenonewline v <- restofline - r <- getState - setState r{dateField=readMay v} + updateState (\r -> r{dateField=readMay v}) effectivedatefield = do string "effective-date-field" many1 spacenonewline v <- restofline - r <- getState - setState r{effectiveDateField=readMay v} + updateState (\r -> r{effectiveDateField=readMay v}) dateformat = do string "date-format" many1 spacenonewline v <- restofline - r <- getState - setState r{dateFormat=Just v} + updateState (\r -> r{dateFormat=Just v}) codefield = do string "code-field" many1 spacenonewline v <- restofline - r <- getState - setState r{codeField=readMay v} + updateState (\r -> r{codeField=readMay v}) statusfield = do string "status-field" many1 spacenonewline v <- restofline - r <- getState - setState r{statusField=readMay v} + updateState (\r -> r{statusField=readMay v}) + +descriptionFieldValue :: GenParser Char st [FormatString] +descriptionFieldValue = do +-- try (fieldNo <* spacenonewline) + try fieldNo + <|> formatStrings + where + fieldNo = many1 digit >>= \x -> return [FormatField False Nothing Nothing $ FieldNo $ read x] descriptionfield = do string "description-field" many1 spacenonewline - v <- restofline - r <- getState - setState r{descriptionField=readMay v} + formatS <- descriptionFieldValue + restofline + updateState (\x -> x{descriptionField=formatS}) amountfield = do string "amount-field" many1 spacenonewline v <- restofline - r <- getState - setState r{amountField=readMay v} + x <- updateState (\r -> r{amountField=readMay v}) + return x infield = do string "in-field" many1 spacenonewline v <- restofline - r <- getState - setState r{inField=readMay v} + updateState (\r -> r{inField=readMay v}) outfield = do string "out-field" many1 spacenonewline v <- restofline - r <- getState - setState r{outField=readMay v} + updateState (\r -> r{outField=readMay v}) currencyfield = do string "currency-field" many1 spacenonewline v <- restofline - r <- getState - setState r{currencyField=readMay v} + updateState (\r -> r{currencyField=readMay v}) accountfield = do string "account-field" many1 spacenonewline v <- restofline - r <- getState - setState r{accountField=readMay v} + updateState (\r -> r{accountField=readMay v}) account2field = do string "account2-field" many1 spacenonewline v <- restofline - r <- getState - setState r{account2Field=readMay v} + updateState (\r -> r{account2Field=readMay v}) basecurrency = do string "currency" many1 spacenonewline v <- restofline - r <- getState - setState r{baseCurrency=Just v} + updateState (\r -> r{baseCurrency=Just v}) baseaccount = do string "base-account" many1 spacenonewline v <- ledgeraccountname optional newline - r <- getState - setState r{baseAccount=v} + updateState (\r -> r{baseAccount=v}) accountrule :: GenParser Char CsvRules AccountRule accountrule = do @@ -339,7 +333,7 @@ accountrule = do return (pats',acct) "account rule" -blanklines = many1 blankline >> return () +blanklines = many1 blankline blankline = many spacenonewline >> newline >> return () "blank line" @@ -362,6 +356,24 @@ printTxn debug rules rec = do putStr $ show $ transactionFromCsvRecord rules rec -- csv record conversion +formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> Field -> String +formatD record leftJustified min max f = case f of + FieldNo n -> maybe "" show $ atMay record n + -- Some of these might in theory in read from fields + Format.Account -> "" + DepthSpacer -> "" + Total -> "" + DefaultDate -> "" + Description -> "" + where + show = formatValue leftJustified min max + +formatDescription :: CsvRecord -> [FormatString] -> String +formatDescription _ [] = "" +formatDescription record (f:fs) = s ++ (formatDescription record fs) + where s = case f of + FormatLiteral l -> l + FormatField leftJustified min max field -> formatD record leftJustified min max field transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction transactionFromCsvRecord rules fields = @@ -371,7 +383,7 @@ transactionFromCsvRecord rules fields = return $ parsedate $ normaliseDate (dateFormat rules) $ (atDef "" fields) idx status = maybe False (null . strip . (atDef "" fields)) (statusField rules) code = maybe "" (atDef "" fields) (codeField rules) - desc = maybe "" (atDef "" fields) (descriptionField rules) + desc = formatDescription fields (descriptionField rules) comment = "" precomment = "" baseacc = maybe (baseAccount rules) (atDef "" fields) (accountField rules) @@ -466,7 +478,29 @@ getAmount rules fields = case (accountField rules) of c = maybe "" (atDef "" fields) (inField rules) d = maybe "" (atDef "" fields) (outField rules) -tests_Hledger_Cli_Convert = TestList [ +tests_Hledger_Cli_Convert = TestList (test_parser ++ test_description_parsing) + +test_description_parsing = [ + "description-field 1" ~: assertParseDescription "description-field 1\n" [FormatField False Nothing Nothing (FieldNo 1)] + , "description-field 1 " ~: assertParseDescription "description-field 1 \n" [FormatField False Nothing Nothing (FieldNo 1)] + , "description-field %(1)" ~: assertParseDescription "description-field %(1)\n" [FormatField False Nothing Nothing (FieldNo 1)] + , "description-field %(1)/$(2)" ~: assertParseDescription "description-field %(1)/%(2)\n" [ + FormatField False Nothing Nothing (FieldNo 1) + , FormatLiteral "/" + , FormatField False Nothing Nothing (FieldNo 2) + ] + ] + where + assertParseDescription string expected = do assertParseEqual (parseDescription string) (nullrules {descriptionField = expected}) + parseDescription :: String -> Either ParseError CsvRules + parseDescription x = runParser descriptionfieldWrapper nullrules "(unknown)" x + descriptionfieldWrapper :: GenParser Char CsvRules CsvRules + descriptionfieldWrapper = do + descriptionfield + r <- getState + return r + +test_parser = [ "convert rules parsing: empty file" ~: do -- let assertMixedAmountParse parseresult mixedamount = diff --git a/hledger/Hledger/Cli/Format.hs b/hledger/Hledger/Cli/Format.hs index c573722f9..78d3630a4 100644 --- a/hledger/Hledger/Cli/Format.hs +++ b/hledger/Hledger/Cli/Format.hs @@ -1,5 +1,6 @@ module Hledger.Cli.Format ( parseFormatString + , formatStrings , formatValue , FormatString(..) , Field(..) @@ -7,19 +8,12 @@ module Hledger.Cli.Format ( ) where import Numeric +import Data.Char (isPrint) import Data.Maybe import Test.HUnit import Text.ParserCombinators.Parsec import Text.Printf -{- -%[-][MIN WIDTH][.MAX WIDTH]EXPR - -%-P a transaction's payee, left justified -%20P The same, right justified, at least 20 chars wide -%.20P The same, no more than 20 chars wide -%-.20P Left justified, maximum twenty chars wide --} data Field = Account @@ -27,6 +21,7 @@ data Field = | Description | Total | DepthSpacer + | FieldNo Int deriving (Show, Eq) data FormatString = @@ -47,7 +42,7 @@ formatValue leftJustified min max value = printf formatS value formatS = "%" ++ l ++ min' ++ max' ++ "s" parseFormatString :: String -> Either String [FormatString] -parseFormatString input = case parse formatStrings "(unknown)" input of +parseFormatString input = case (runParser formatStrings () "(unknown)") input of Left y -> Left $ show y Right x -> Right x @@ -55,42 +50,45 @@ parseFormatString input = case parse formatStrings "(unknown)" input of Parsers -} -field :: Parser Field +field :: GenParser Char st Field field = do try (string "account" >> return Account) --- <|> try (string "date" >> return DefaultDate) --- <|> try (string "description" >> return Description) <|> try (string "depth_spacer" >> return DepthSpacer) + <|> try (string "date" >> return Description) + <|> try (string "description" >> return Description) <|> try (string "total" >> return Total) + <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s)) -formatField :: Parser FormatString +formatField :: GenParser Char st FormatString formatField = do char '%' leftJustified <- optionMaybe (char '-') minWidth <- optionMaybe (many1 $ digit) - maxWidth <- optionMaybe (do char '.'; many1 $ digit) + maxWidth <- optionMaybe (do char '.'; many1 $ digit) -- TODO: Can this be (char '1') *> (many1 digit) char '(' - field <- field + f <- field char ')' - return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) field + return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f where parseDec s = case s of Just text -> Just m where ((m,_):_) = readDec text _ -> Nothing -formatLiteral :: Parser FormatString +formatLiteral :: GenParser Char st FormatString formatLiteral = do s <- many1 c return $ FormatLiteral s where - c = noneOf "%" + isPrintableButNotPercentage x = isPrint x && (not $ x == '%') + c = (satisfy isPrintableButNotPercentage "printable character") <|> try (string "%%" >> return '%') -formatString :: Parser FormatString +formatString :: GenParser Char st FormatString formatString = formatField <|> formatLiteral +formatStrings :: GenParser Char st [FormatString] formatStrings = many formatString testFormat :: FormatString -> String -> String -> Assertion diff --git a/tests/convert-with-in-and-out-fields.test b/tests/convert-with-in-and-out-fields.test index 6f80801a6..e336afc70 100644 --- a/tests/convert-with-in-and-out-fields.test +++ b/tests/convert-with-in-and-out-fields.test @@ -1,5 +1,5 @@ # Conversion from CSV to Ledger with in-field and out-field -rm -rf unused.journal convert.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules ; touch unused.journal ; bin/hledger -f unused.journal convert --rules convert.rules - ; rm -rf unused.journal convert.rules +rm -rf unused.journal$$ convert.rules$$; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\nin-field 2\nout-field 3\ncurrency $\n' >convert.rules$$ ; touch unused.journal$$ ; bin/hledger -f unused.journal$$ convert --rules convert.rules$$ - ; rm -rf *$$ <<< 10/2009/09,Flubber Co,50, 11/2009/09,Flubber Co,,50 @@ -12,6 +12,5 @@ rm -rf unused.journal convert.rules; printf 'base-account Assets:MyAccount\ndate income:unknown $-50 Assets:MyAccount $50 ->>>2 -using conversion rules file convert.rules +>>>2 /using conversion rules file convert.rules[0-9]*.$/ >>>=0 diff --git a/tests/convert.test b/tests/convert.test index 3fd1f6d6f..fac3b79b6 100644 --- a/tests/convert.test +++ b/tests/convert.test @@ -1,5 +1,5 @@ # Conversion from CSV to Ledger -rm -rf unused.journal input.csv input.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' > input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv ; touch unused.journal ; bin/hledger -f unused.journal convert input.csv ; rm -rf unused.journal input.csv input.rules +rm -rf input.rules; printf 'base-account Assets:MyAccount\ndate-field 0\ndate-format %%d/%%Y/%%m\ndescription-field 1\namount-field 2\ncurrency $\n' > input.rules ; printf '10/2009/09,Flubber Co,50' > input.csv$$ ; touch unused.journal$$ ; bin/hledger -f unused.journal$$ convert input.csv$$ ; rm -rf input.rules *$$ >>> 2009/09/10 Flubber Co income:unknown $-50