convert: basic csv file checking, warn instead of erroring when records lack a referenced field
This commit is contained in:
		
							parent
							
								
									21e4f87102
								
							
						
					
					
						commit
						b396e8e4a2
					
				@ -10,6 +10,7 @@ import Ledger.Types (Ledger,AccountName,Transaction(..),Posting(..),PostingType(
 | 
			
		||||
import Ledger.Utils (strip, spacenonewline, restofline)
 | 
			
		||||
import Ledger.Parse (someamount, emptyCtx, ledgeraccountname)
 | 
			
		||||
import Ledger.Amount (nullmixedamt)
 | 
			
		||||
import Safe (atDef)
 | 
			
		||||
import System.IO (stderr)
 | 
			
		||||
import Text.CSV (parseCSVFromFile, printCSV)
 | 
			
		||||
import Text.Printf (hPrintf)
 | 
			
		||||
@ -21,6 +22,7 @@ import Data.Time.Format (parseTime)
 | 
			
		||||
import Control.Monad (when, guard)
 | 
			
		||||
import Safe (readDef, readMay)
 | 
			
		||||
import System.Directory (doesFileExist)
 | 
			
		||||
import System.Exit (exitFailure)
 | 
			
		||||
import System.FilePath.Posix (takeBaseName, replaceExtension)
 | 
			
		||||
import Text.ParserCombinators.Parsec
 | 
			
		||||
 | 
			
		||||
@ -46,7 +48,26 @@ convert opts args _ = do
 | 
			
		||||
                  Left e -> error $ show e
 | 
			
		||||
                  Right r -> r
 | 
			
		||||
  when debug $ hPrintf stderr "rules: %s\n" (show rules)
 | 
			
		||||
  mapM_ (printTxn debug rules) records
 | 
			
		||||
  let maxfield = maxFieldIndex rules
 | 
			
		||||
      shortrecords = filter ((< maxfield).length) records
 | 
			
		||||
  if null shortrecords
 | 
			
		||||
   then mapM_ (printTxn debug rules) records
 | 
			
		||||
   else do
 | 
			
		||||
     hPrintf stderr (unlines [
 | 
			
		||||
                      "Warning, one or more CSV records do not contain field %d referenced by the"
 | 
			
		||||
                     ,"conversion rules file. Are you converting a valid CSV file ? First bad record:\n%s"
 | 
			
		||||
                     ]) maxfield (show $ head shortrecords)
 | 
			
		||||
     exitFailure
 | 
			
		||||
 | 
			
		||||
maxFieldIndex :: CsvRules -> Int
 | 
			
		||||
maxFieldIndex r = maximum $ catMaybes [
 | 
			
		||||
                   dateField r
 | 
			
		||||
                  ,statusField r
 | 
			
		||||
                  ,codeField r
 | 
			
		||||
                  ,descriptionField r
 | 
			
		||||
                  ,amountField r
 | 
			
		||||
                  ,currencyField r
 | 
			
		||||
                  ]
 | 
			
		||||
 | 
			
		||||
rulesFileFor :: FilePath -> FilePath
 | 
			
		||||
rulesFileFor csvfile = replaceExtension csvfile ".rules"
 | 
			
		||||
@ -232,7 +253,7 @@ matchreplacepattern = do
 | 
			
		||||
 | 
			
		||||
printTxn :: Bool -> CsvRules -> CsvRecord -> IO ()
 | 
			
		||||
printTxn debug rules rec = do
 | 
			
		||||
  when debug $ hPrintf stderr "csv: %s" (printCSV [rec])
 | 
			
		||||
  when debug $ hPrintf stderr "record: %s" (printCSV [rec])
 | 
			
		||||
  putStr $ show $ transactionFromCsvRecord rules rec
 | 
			
		||||
 | 
			
		||||
-- csv record conversion
 | 
			
		||||
@ -240,16 +261,16 @@ printTxn debug rules rec = do
 | 
			
		||||
transactionFromCsvRecord :: CsvRules -> CsvRecord -> Transaction
 | 
			
		||||
transactionFromCsvRecord rules fields =
 | 
			
		||||
  let 
 | 
			
		||||
      date = parsedate $ normaliseDate $ maybe "1900/1/1" (fields !!) (dateField rules)
 | 
			
		||||
      status = maybe False (null . strip . (fields !!)) (statusField rules)
 | 
			
		||||
      code = maybe "" (fields !!) (codeField rules)
 | 
			
		||||
      desc = maybe "" (fields !!) (descriptionField rules)
 | 
			
		||||
      date = parsedate $ normaliseDate $ maybe "1900/1/1" (atDef "" fields) (dateField rules)
 | 
			
		||||
      status = maybe False (null . strip . (atDef "" fields)) (statusField rules)
 | 
			
		||||
      code = maybe "" (atDef "" fields) (codeField rules)
 | 
			
		||||
      desc = maybe "" (atDef "" fields) (descriptionField rules)
 | 
			
		||||
      comment = ""
 | 
			
		||||
      precomment = ""
 | 
			
		||||
      amountstr = maybe "" (fields !!) (amountField rules)
 | 
			
		||||
      amountstr = maybe "" (atDef "" fields) (amountField rules)
 | 
			
		||||
      amountstr' = strnegate amountstr where strnegate ('-':s) = s
 | 
			
		||||
                                             strnegate s = '-':s
 | 
			
		||||
      currency = maybe (fromMaybe "" $ baseCurrency rules) (fields !!) (currencyField rules)
 | 
			
		||||
      currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules)
 | 
			
		||||
      amountstr'' = currency ++ amountstr'
 | 
			
		||||
      amountparse = runParser someamount emptyCtx "" amountstr''
 | 
			
		||||
      amount = either (const nullmixedamt) id amountparse
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user