587 lines
		
	
	
		
			21 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			587 lines
		
	
	
		
			21 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| {-|
 | |
| 
 | |
| A reader for CSV files. Uses optional extra rules to help interpret the
 | |
| data, like the convert command.
 | |
| 
 | |
| -}
 | |
| 
 | |
| module Hledger.Read.CsvReader (
 | |
|   CsvRules(..),
 | |
|   nullrules,
 | |
|   reader,
 | |
|   tests_Hledger_Read_CsvReader
 | |
| )
 | |
| where
 | |
| import Control.Monad
 | |
| import Control.Monad.Error
 | |
| import Test.HUnit
 | |
| -- import Text.ParserCombinators.Parsec hiding (parse)
 | |
| import Data.List
 | |
| import Data.Maybe
 | |
| import Data.Ord
 | |
| import Data.Time.Format (parseTime)
 | |
| import Safe
 | |
| import System.Directory (doesFileExist)
 | |
| import System.Exit (exitFailure)
 | |
| import System.FilePath (takeBaseName, replaceExtension)
 | |
| import System.IO (stderr)
 | |
| import System.Locale (defaultTimeLocale)
 | |
| import Test.HUnit
 | |
| import Text.CSV (parseCSV, parseCSVFromFile, CSV)
 | |
| import Text.ParserCombinators.Parsec
 | |
| import Text.Printf (hPrintf)
 | |
| 
 | |
| import Hledger.Data
 | |
| import Hledger.Read.Utils
 | |
| import Prelude hiding (getContents)
 | |
| import Hledger.Utils.UTF8 (getContents)
 | |
| import Hledger.Utils
 | |
| import Hledger.Data.FormatStrings as FormatStrings
 | |
| import Hledger.Read.JournalReader (ledgeraccountname, someamount)
 | |
| -- import Hledger.Read.JournalReader (ledgerDirective, ledgerHistoricalPrice,
 | |
| --                                    ledgerDefaultYear, emptyLine, ledgerdatetime)
 | |
| 
 | |
| reader :: Reader
 | |
| reader = Reader format detect parse_
 | |
| 
 | |
| format :: String
 | |
| format = "csv"
 | |
| 
 | |
| -- | Does the given file path and data look like CSV ?
 | |
| detect :: FilePath -> String -> Bool
 | |
| detect f _ = fileSuffix f == format
 | |
| 
 | |
| -- | Parse and post-process a "Journal" from CSV data, or give an error.
 | |
| -- XXX currently ignores the string and reads from the file path
 | |
| parse_ :: FilePath -> String -> ErrorT String IO Journal
 | |
| parse_ f s = do
 | |
|   r <- liftIO $ journalFromCsv f s
 | |
|   case r of Left e -> throwError e
 | |
|             Right j -> return j
 | |
| 
 | |
| -- csvFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
 | |
| -- csvFile = do items <- many timelogItem
 | |
| --              eof
 | |
| --              ctx <- getState
 | |
| --              return (liftM (foldr (.) id) $ sequence items, ctx)
 | |
| 
 | |
| 
 | |
| 
 | |
| -- XXX copied from Convert.hs
 | |
| 
 | |
| {- |
 | |
| A set of data definitions and account-matching patterns sufficient to
 | |
| convert a particular CSV data file into meaningful journal transactions. See above.
 | |
| -}
 | |
| data CsvRules = CsvRules {
 | |
|       dateField :: Maybe FieldPosition,
 | |
|       dateFormat :: Maybe String,
 | |
|       statusField :: Maybe FieldPosition,
 | |
|       codeField :: Maybe FieldPosition,
 | |
|       descriptionField :: [FormatString],
 | |
|       amountField :: Maybe FieldPosition,
 | |
|       amountInField :: Maybe FieldPosition,
 | |
|       amountOutField :: Maybe FieldPosition,
 | |
|       currencyField :: Maybe FieldPosition,
 | |
|       baseCurrency :: Maybe String,
 | |
|       accountField :: Maybe FieldPosition,
 | |
|       account2Field :: Maybe FieldPosition,
 | |
|       effectiveDateField :: Maybe FieldPosition,
 | |
|       baseAccount :: AccountName,
 | |
|       accountRules :: [AccountRule]
 | |
| } deriving (Show, Eq)
 | |
| 
 | |
| nullrules = CsvRules {
 | |
|       dateField=Nothing,
 | |
|       dateFormat=Nothing,
 | |
|       statusField=Nothing,
 | |
|       codeField=Nothing,
 | |
|       descriptionField=[],
 | |
|       amountField=Nothing,
 | |
|       amountInField=Nothing,
 | |
|       amountOutField=Nothing,
 | |
|       currencyField=Nothing,
 | |
|       baseCurrency=Nothing,
 | |
|       accountField=Nothing,
 | |
|       account2Field=Nothing,
 | |
|       effectiveDateField=Nothing,
 | |
|       baseAccount="unknown",
 | |
|       accountRules=[]
 | |
| }
 | |
| 
 | |
| type FieldPosition = Int
 | |
| 
 | |
| type AccountRule = (
 | |
|    [(String, Maybe String)] -- list of regex match patterns with optional replacements
 | |
|   ,AccountName              -- account name to use for a transaction matching this rule
 | |
|   )
 | |
| 
 | |
| type CsvRecord = [String]
 | |
| 
 | |
| 
 | |
| -- | Read the CSV file named as an argument and print equivalent journal transactions,
 | |
| -- using/creating a .rules file.
 | |
| journalFromCsv :: FilePath -> String -> IO (Either String Journal)
 | |
| journalFromCsv csvfile content = do
 | |
|   let usingStdin = csvfile == "-"
 | |
|       -- rulesFileSpecified = isJust $ rules_file_ opts
 | |
|       rulesfile = rulesFileFor csvfile
 | |
|   -- when (usingStdin && (not rulesFileSpecified)) $ error' "please use --rules-file to specify a rules file when converting stdin"
 | |
|   csvparse <- parseCsv csvfile content
 | |
|   let records = case csvparse of
 | |
|                   Left e -> error' $ show e
 | |
|                   Right rs -> filter (/= [""]) rs
 | |
|   exists <- doesFileExist rulesfile
 | |
|   if (not exists) then do
 | |
|                   hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile
 | |
|                   writeFile rulesfile initialRulesFileContent
 | |
|    else
 | |
|       hPrintf stderr "using conversion rules file %s\n" rulesfile
 | |
|   rules <- liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile
 | |
|   let invalid = validateRules rules
 | |
|   -- when (debug_ opts) $ hPrintf stderr "rules: %s\n" (show rules)
 | |
|   when (isJust invalid) $ error (fromJust invalid)
 | |
|   let requiredfields = max 2 (maxFieldIndex rules + 1)
 | |
|       badrecords = take 1 $ filter ((< requiredfields).length) records
 | |
|   if null badrecords
 | |
|    then do
 | |
|      return $ Right nulljournal{jtxns=sortBy (comparing tdate) $ map (transactionFromCsvRecord rules) records}
 | |
|    else
 | |
|      return $ Left (unlines [
 | |
|                       "Warning, at least one CSV record does not contain a field referenced by the"
 | |
|                      ,"conversion rules file, or has less than two fields. Are you converting a"
 | |
|                      ,"valid CSV file ? First bad record:"
 | |
|                      , show $ head badrecords
 | |
|                      ])
 | |
| 
 | |
| parseCsv :: FilePath -> String -> IO (Either ParseError CSV)
 | |
| parseCsv path content =
 | |
|   case path of
 | |
|     "-" -> liftM (parseCSV "(stdin)") getContents
 | |
|     _   -> return $ parseCSV path content
 | |
| 
 | |
| -- | The highest (0-based) field index referenced in the field
 | |
| -- definitions, or -1 if no fields are defined.
 | |
| maxFieldIndex :: CsvRules -> Int
 | |
| maxFieldIndex r = maximumDef (-1) $ catMaybes [
 | |
|                    dateField r
 | |
|                   ,statusField r
 | |
|                   ,codeField r
 | |
|                   ,amountField r
 | |
|                   ,amountInField r
 | |
|                   ,amountOutField r
 | |
|                   ,currencyField r
 | |
|                   ,accountField r
 | |
|                   ,account2Field r
 | |
|                   ,effectiveDateField r
 | |
|                   ]
 | |
| 
 | |
| -- rulesFileFor :: CliOpts -> FilePath -> FilePath
 | |
| -- rulesFileFor CliOpts{rules_file_=Just f} _ = f
 | |
| -- rulesFileFor CliOpts{rules_file_=Nothing} csvfile = replaceExtension csvfile ".rules"
 | |
| rulesFileFor :: FilePath -> FilePath
 | |
| rulesFileFor = flip replaceExtension ".rules"
 | |
| 
 | |
| initialRulesFileContent :: String
 | |
| initialRulesFileContent = let prognameandversion = "hledger" in
 | |
|     "# csv conversion rules file generated by " ++ prognameandversion ++ "\n" ++
 | |
|     "# Add rules to this file for more accurate conversion, see\n"++
 | |
|     "# http://hledger.org/MANUAL.html#convert\n" ++
 | |
|     "\n" ++
 | |
|     "base-account assets:bank:checking\n" ++
 | |
|     "date-field 0\n" ++
 | |
|     "description-field 4\n" ++
 | |
|     "amount-field 1\n" ++
 | |
|     "base-currency $\n" ++
 | |
|     "\n" ++
 | |
|     "# account-assigning rules\n" ++
 | |
|     "\n" ++
 | |
|     "SPECTRUM\n" ++
 | |
|     "expenses:health:gym\n" ++
 | |
|     "\n" ++
 | |
|     "ITUNES\n" ++
 | |
|     "BLKBSTR=BLOCKBUSTER\n" ++
 | |
|     "expenses:entertainment\n" ++
 | |
|     "\n" ++
 | |
|     "(TO|FROM) SAVINGS\n" ++
 | |
|     "assets:bank:savings\n"
 | |
| 
 | |
| validateRules :: CsvRules -> Maybe String
 | |
| validateRules rules = let
 | |
|     hasAmount = isJust $ amountField rules
 | |
|     hasIn = isJust $ amountInField rules
 | |
|     hasOut = isJust $ amountOutField rules
 | |
|   in case (hasAmount, hasIn, hasOut) of
 | |
|     (True, True, _) -> Just "Don't specify amount-in-field when specifying amount-field"
 | |
|     (True, _, True) -> Just "Don't specify amount-out-field when specifying amount-field"
 | |
|     (_, False, True) -> Just "Please specify amount-in-field when specifying amount-out-field"
 | |
|     (_, True, False) -> Just "Please specify amount-out-field when specifying amount-in-field"
 | |
|     (False, False, False) -> Just "Please specify either amount-field, or amount-in-field and amount-out-field"
 | |
|     _ -> Nothing
 | |
| 
 | |
| -- rules file parser
 | |
| 
 | |
| parseCsvRulesFile :: FilePath -> IO (Either ParseError CsvRules)
 | |
| parseCsvRulesFile f = do
 | |
|   s <- readFile f
 | |
|   return $ parseCsvRules f s
 | |
| 
 | |
| parseCsvRules :: FilePath -> String -> Either ParseError CsvRules
 | |
| parseCsvRules rulesfile s = runParser csvrulesfile nullrules{baseAccount=takeBaseName rulesfile} rulesfile s
 | |
| 
 | |
| csvrulesfile :: GenParser Char CsvRules CsvRules
 | |
| csvrulesfile = do
 | |
|   many blankorcommentline
 | |
|   many definitions
 | |
|   r <- getState
 | |
|   ars <- many accountrule
 | |
|   many blankorcommentline
 | |
|   eof
 | |
|   return r{accountRules=ars}
 | |
| 
 | |
| definitions :: GenParser Char CsvRules ()
 | |
| definitions = do
 | |
|   choice' [
 | |
|     datefield
 | |
|    ,dateformat
 | |
|    ,statusfield
 | |
|    ,codefield
 | |
|    ,descriptionfield
 | |
|    ,amountfield
 | |
|    ,amountinfield
 | |
|    ,amountoutfield
 | |
|    ,currencyfield
 | |
|    ,accountfield
 | |
|    ,account2field
 | |
|    ,effectivedatefield
 | |
|    ,basecurrency
 | |
|    ,baseaccount
 | |
|    ,commentline
 | |
|    ] <?> "definition"
 | |
|   return ()
 | |
| 
 | |
| datefield = do
 | |
|   string "date-field"
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{dateField=readMay v})
 | |
| 
 | |
| effectivedatefield = do
 | |
|   string "effective-date-field"
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{effectiveDateField=readMay v})
 | |
| 
 | |
| dateformat = do
 | |
|   string "date-format"
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{dateFormat=Just v})
 | |
| 
 | |
| codefield = do
 | |
|   string "code-field"
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{codeField=readMay v})
 | |
| 
 | |
| statusfield = do
 | |
|   string "status-field"
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   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
 | |
|   formatS <- descriptionFieldValue
 | |
|   restofline
 | |
|   updateState (\x -> x{descriptionField=formatS})
 | |
| 
 | |
| amountfield = do
 | |
|   string "amount-field"
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   x <- updateState (\r -> r{amountField=readMay v})
 | |
|   return x
 | |
| 
 | |
| amountinfield = do
 | |
|   choice [string "amount-in-field", string "in-field"]
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{amountInField=readMay v})
 | |
| 
 | |
| amountoutfield = do
 | |
|   choice [string "amount-out-field", string "out-field"]
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{amountOutField=readMay v})
 | |
| 
 | |
| currencyfield = do
 | |
|   string "currency-field"
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{currencyField=readMay v})
 | |
| 
 | |
| accountfield = do
 | |
|   string "account-field"
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{accountField=readMay v})
 | |
| 
 | |
| account2field = do
 | |
|   string "account2-field"
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{account2Field=readMay v})
 | |
| 
 | |
| basecurrency = do
 | |
|   choice [string "base-currency", string "currency"]
 | |
|   many1 spacenonewline
 | |
|   v <- restofline
 | |
|   updateState (\r -> r{baseCurrency=Just v})
 | |
| 
 | |
| baseaccount = do
 | |
|   string "base-account"
 | |
|   many1 spacenonewline
 | |
|   v <- ledgeraccountname
 | |
|   optional newline
 | |
|   updateState (\r -> r{baseAccount=v})
 | |
| 
 | |
| accountrule :: GenParser Char CsvRules AccountRule
 | |
| accountrule = do
 | |
|   many blankorcommentline
 | |
|   pats <- many1 matchreplacepattern
 | |
|   guard $ length pats >= 2
 | |
|   let pats' = init pats
 | |
|       acct = either (fail.show) id $ runParser ledgeraccountname () "" $ fst $ last pats
 | |
|   many blankorcommentline
 | |
|   return (pats',acct)
 | |
|  <?> "account rule"
 | |
| 
 | |
| blanklines = many1 blankline
 | |
| 
 | |
| blankline = many spacenonewline >> newline >> return () <?> "blank line"
 | |
| 
 | |
| commentchar = oneOf ";#"
 | |
| 
 | |
| commentline = many spacenonewline >> commentchar >> restofline >> return () <?> "comment line"
 | |
| 
 | |
| blankorcommentline = choice' [blankline, commentline]
 | |
| 
 | |
| matchreplacepattern = do
 | |
|   notFollowedBy commentchar
 | |
|   matchpat <- many1 (noneOf "=\n")
 | |
|   replpat <- optionMaybe $ do {char '='; many $ noneOf "\n"}
 | |
|   newline
 | |
|   return (matchpat,replpat)
 | |
| 
 | |
| -- 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
 | |
|   FormatStrings.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 =
 | |
|   let 
 | |
|       date = parsedate $ normaliseDate (dateFormat rules) $ maybe "1900/1/1" (atDef "" fields) (dateField rules)
 | |
|       effectivedate = do idx <- effectiveDateField rules
 | |
|                          return $ parsedate $ normaliseDate (dateFormat rules) $ (atDef "" fields) idx
 | |
|       status = maybe False (null . strip . (atDef "" fields)) (statusField rules)
 | |
|       code = maybe "" (atDef "" fields) (codeField rules)
 | |
|       desc = formatDescription fields (descriptionField rules)
 | |
|       comment = ""
 | |
|       precomment = ""
 | |
|       baseacc = maybe (baseAccount rules) (atDef "" fields) (accountField rules)
 | |
|       amountstr = getAmount rules fields
 | |
|       amountstr' = strnegate amountstr where strnegate ('-':s) = s
 | |
|                                              strnegate s = '-':s
 | |
|       currency = maybe (fromMaybe "" $ baseCurrency rules) (atDef "" fields) (currencyField rules)
 | |
|       amountstr'' = currency ++ amountstr'
 | |
|       amountparse = runParser someamount nullctx "" amountstr''
 | |
|       amount = either (const nullmixedamt) id amountparse
 | |
|       -- Using costOfMixedAmount here to allow complex costs like "10 GBP @@ 15 USD".
 | |
|       -- Aim is to have "10 GBP @@ 15 USD" applied to account "acct", but have "-15USD" applied to "baseacct"
 | |
|       baseamount = costOfMixedAmount amount
 | |
|       unknownacct | (readDef 0 amountstr' :: Double) < 0 = "income:unknown"
 | |
|                   | otherwise = "expenses:unknown"
 | |
|       (acct',newdesc) = identify (accountRules rules) unknownacct desc
 | |
|       acct = maybe acct' (atDef "" fields) (account2Field rules)
 | |
|       t = Transaction {
 | |
|               tdate=date,
 | |
|               teffectivedate=effectivedate,
 | |
|               tstatus=status,
 | |
|               tcode=code,
 | |
|               tdescription=newdesc,
 | |
|               tcomment=comment,
 | |
|               tpreceding_comment_lines=precomment,
 | |
|               tmetadata=[],
 | |
|               tpostings=[
 | |
|                    Posting {
 | |
|                      pstatus=False,
 | |
|                      paccount=acct,
 | |
|                      pamount=amount,
 | |
|                      pcomment="",
 | |
|                      ptype=RegularPosting,
 | |
|                      pmetadata=[],
 | |
|                      ptransaction=Just t
 | |
|                    },
 | |
|                    Posting {
 | |
|                      pstatus=False,
 | |
|                      paccount=baseacc,
 | |
|                      pamount=(-baseamount),
 | |
|                      pcomment="",
 | |
|                      ptype=RegularPosting,
 | |
|                      pmetadata=[],
 | |
|                      ptransaction=Just t
 | |
|                    }
 | |
|                   ]
 | |
|             }
 | |
|   in t
 | |
| 
 | |
| -- | Convert some date string with unknown format to YYYY/MM/DD.
 | |
| normaliseDate :: Maybe String -- ^ User-supplied date format: this should be tried in preference to all others
 | |
|               -> String -> String
 | |
| normaliseDate mb_user_format s =
 | |
|     let parsewith = flip (parseTime defaultTimeLocale) s in
 | |
|     maybe (error' $ "could not parse \""++s++"\" as a date, consider adding a date-format directive or upgrading")
 | |
|           showDate $
 | |
|           firstJust $ (map parsewith $
 | |
|                        maybe [] (:[]) mb_user_format
 | |
|                        -- the - modifier requires time-1.2.0.5, released
 | |
|                        -- in 2011/5, so for now we emulate it for wider
 | |
|                        -- compatibility.  time < 1.2.0.5 also has a buggy
 | |
|                        -- %y which we don't do anything about.
 | |
|                        -- ++ [
 | |
|                        -- "%Y/%m/%d"
 | |
|                        -- ,"%Y/%-m/%-d"
 | |
|                        -- ,"%Y-%m-%d"
 | |
|                        -- ,"%Y-%-m-%-d"
 | |
|                        -- ,"%m/%d/%Y"
 | |
|                        -- ,"%-m/%-d/%Y"
 | |
|                        -- ,"%m-%d-%Y"
 | |
|                        -- ,"%-m-%-d-%Y"
 | |
|                        -- ]
 | |
|                       )
 | |
|                       ++ [
 | |
|                        parseTime defaultTimeLocale "%Y/%m/%e" s
 | |
|                       ,parseTime defaultTimeLocale "%Y-%m-%e" s
 | |
|                       ,parseTime defaultTimeLocale "%m/%e/%Y" s
 | |
|                       ,parseTime defaultTimeLocale "%m-%e-%Y" s
 | |
|                       ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)
 | |
|                       ,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)
 | |
|                       ,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s)
 | |
|                       ,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s)
 | |
|                       ]
 | |
| 
 | |
| -- | Apply account matching rules to a transaction description to obtain
 | |
| -- the most appropriate account and a new description.
 | |
| identify :: [AccountRule] -> String -> String -> (String,String)
 | |
| identify rules defacct desc | null matchingrules = (defacct,desc)
 | |
|                             | otherwise = (acct,newdesc)
 | |
|     where
 | |
|       matchingrules = filter ismatch rules :: [AccountRule]
 | |
|           where ismatch = any ((`regexMatchesCI` desc) . fst) . fst
 | |
|       (prs,acct) = head matchingrules
 | |
|       p_ms_r = filter (\(_,m,_) -> m) $ map (\(p,r) -> (p, p `regexMatchesCI` desc, r)) prs
 | |
|       (p,_,r) = head p_ms_r
 | |
|       newdesc = case r of Just repl -> regexReplaceCI p repl desc
 | |
|                           Nothing   -> desc
 | |
| 
 | |
| caseinsensitive = ("(?i)"++)
 | |
| 
 | |
| getAmount :: CsvRules -> CsvRecord -> String
 | |
| getAmount rules fields = case amountField rules of
 | |
|   Just f  -> maybe "" (atDef "" fields) $ Just f
 | |
|   Nothing ->
 | |
|     case (i, o) of
 | |
|       (x, "") -> x
 | |
|       ("", x) -> "-"++x
 | |
|       p -> error' $ "using amount-in-field and amount-out-field, found a value in both fields: "++show p
 | |
|     where
 | |
|       i = maybe "" (atDef "" fields) (amountInField rules)
 | |
|       o = maybe "" (atDef "" fields) (amountOutField rules)
 | |
| 
 | |
| tests_Hledger_Read_CsvReader = 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 =
 | |
|      --         (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount)
 | |
|     assertParseEqual (parseCsvRules "unknown" "") nullrules
 | |
| 
 | |
|   ,"convert rules parsing: accountrule" ~: do
 | |
|      assertParseEqual (parseWithCtx nullrules accountrule "A\na\n") -- leading blank line required
 | |
|                  ([("A",Nothing)], "a")
 | |
| 
 | |
|   ,"convert rules parsing: trailing comments" ~: do
 | |
|      assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#\n")
 | |
| 
 | |
|   ,"convert rules parsing: trailing blank lines" ~: do
 | |
|      assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n  \n")
 | |
| 
 | |
|   -- not supported
 | |
|   -- ,"convert rules parsing: no final newline" ~: do
 | |
|   --    assertParse (parseWithCtx nullrules csvrulesfile "A\na")
 | |
|   --    assertParse (parseWithCtx nullrules csvrulesfile "A\na\n# \n#")
 | |
|   --    assertParse (parseWithCtx nullrules csvrulesfile "A\na\n\n  ")
 | |
| 
 | |
|                  -- (nullrules{
 | |
|                  --   -- dateField=Maybe FieldPosition,
 | |
|                  --   -- statusField=Maybe FieldPosition,
 | |
|                  --   -- codeField=Maybe FieldPosition,
 | |
|                  --   -- descriptionField=Maybe FieldPosition,
 | |
|                  --   -- amountField=Maybe FieldPosition,
 | |
|                  --   -- currencyField=Maybe FieldPosition,
 | |
|                  --   -- baseCurrency=Maybe String,
 | |
|                  --   -- baseAccount=AccountName,
 | |
|                  --   accountRules=[
 | |
|                  --        ([("A",Nothing)], "a")
 | |
|                  --       ]
 | |
|                  --  })
 | |
| 
 | |
|   ]
 |