convert: Adding support for formatting expressions in description-field

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:

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 =

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

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

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