push csv rule and format string types down

This commit is contained in:
Simon Michael 2012-03-24 01:58:34 +00:00
parent f4602cc803
commit e396c0dc8d
10 changed files with 128 additions and 142 deletions

View File

@ -1325,6 +1325,7 @@ http://ajaxcssblog.com/jquery/url-read-request-variables/
*** inspiration
http://community.haskell.org/~ndm/downloads/paper-hoogle_overview-19_nov_2008.pdf -> Design Guidelines
** features/wishlist
*** don't moan about ~
*** support apostrophe digit group separator
*** detect .hs plugins
*** Clint's ofx support

View File

@ -183,9 +183,65 @@ data Reader = Reader {
rFormat :: Format
-- quickly check if this reader can probably handle the given file path and file content
,rDetector :: FilePath -> String -> Bool
-- really parse the given file path and file content, returning a journal or error
,rParser :: FilePath -> String -> ErrorT String IO Journal
}
-- parse the given string, using the given parsing rules if any, returning a journal or error aware of the given file path
,rParser :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
}
-- data format parse/conversion rules
-- currently the only parse (conversion) rules are those for the CSV format
type ParseRules = CsvRules
-- 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)
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
)
-- format strings
data HledgerFormatField =
AccountField
| DefaultDateField
| DescriptionField
| TotalField
| DepthSpacerField
| FieldNo Int
deriving (Show, Eq)
data FormatString =
FormatLiteral String
| FormatField Bool -- Left justified ?
(Maybe Int) -- Min width
(Maybe Int) -- Max width
HledgerFormatField -- Field
deriving (Show, Eq)
data Ledger = Ledger {
journal :: Journal,
accountnametree :: Tree AccountName,

View File

@ -34,7 +34,7 @@ import Test.HUnit
import Text.Printf
import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.Types (Journal(..), Reader(..), Format)
import Hledger.Data.Types
import Hledger.Data.Journal (nullctx)
import Hledger.Read.JournalReader as JournalReader
import Hledger.Read.TimelogReader as TimelogReader
@ -93,8 +93,8 @@ readerForFormat s | null rs = Nothing
-- the specified data format or trying all known formats. CSV
-- conversion rules may be provided for better conversion of that
-- format, and/or a file path for better error messages.
readJournal :: Maybe Format -> Maybe CsvReader.CsvRules -> Maybe FilePath -> String -> IO (Either String Journal)
readJournal format _ path s =
readJournal :: Maybe Format -> Maybe ParseRules -> Maybe FilePath -> String -> IO (Either String Journal)
readJournal format rules path s =
let readerstotry = case format of Nothing -> readers
Just f -> case readerForFormat f of Just r -> [r]
Nothing -> []
@ -103,7 +103,7 @@ readJournal format _ path s =
path' = fromMaybe "(string)" path
tryReader :: Reader -> IO (Either String Journal)
tryReader r = do -- printf "trying %s reader\n" (rFormat r)
(runErrorT . (rParser r) path') s
(runErrorT . (rParser r) rules path') s
-- if no reader succeeds, we return the error of the first;
-- ideally it would be the error of the most likely intended

View File

@ -53,9 +53,9 @@ 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
parse_ :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
parse_ rules f s = do
r <- liftIO $ journalFromCsv rules f s
case r of Left e -> throwError e
Right j -> return j
@ -67,30 +67,6 @@ parse_ f s = do
-- 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,
@ -109,35 +85,32 @@ nullrules = CsvRules {
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
journalFromCsv :: Maybe CsvRules -> FilePath -> String -> IO (Either String Journal)
journalFromCsv csvrules 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
rules <- case csvrules of
Nothing -> do
let rulesfile = rulesFileFor csvfile
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
liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile
Just r -> return r
let invalid = validateRules rules
-- when (debug_ opts) $ hPrintf stderr "rules: %s\n" (show rules)
when (isJust invalid) $ error (fromJust invalid)
@ -384,15 +357,15 @@ matchreplacepattern = do
return (matchpat,replpat)
-- csv record conversion
formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> Field -> String
formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> 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 -> ""
AccountField -> ""
DepthSpacerField -> ""
TotalField -> ""
DefaultDateField -> ""
DescriptionField -> ""
where
show = formatValue leftJustified min max

View File

@ -153,8 +153,8 @@ detect f _ = fileSuffix f == format
-- | Parse and post-process a "Journal" from hledger's journal file
-- format, or give an error.
parse :: FilePath -> String -> ErrorT String IO Journal
parse = parseJournalWith journalFile
parse :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
parse _ = parseJournalWith journalFile
-- | Top-level journal parser. Returns a single composite, I/O performing,
-- error-raising "JournalUpdate" (and final "JournalContext") which can be

View File

@ -71,8 +71,8 @@ detect f _ = fileSuffix f == format
-- | Parse and post-process a "Journal" from timeclock.el's timelog
-- format, saving the provided file path and the current time, or give an
-- error.
parse :: FilePath -> String -> ErrorT String IO Journal
parse = parseJournalWith timelogFile
parse :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
parse _ = parseJournalWith timelogFile
timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
timelogFile = do items <- many timelogItem

View File

@ -170,13 +170,13 @@ formatAccountsReportItem opts accountName depth amount (fmt:fmts) =
FormatLiteral l -> l
FormatField ljust min max field -> formatField opts accountName depth amount ljust min max field
formatField :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> Field -> String
formatField :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> String
formatField opts accountName depth total ljust min max field = case field of
Format.Account -> formatValue ljust min max $ maybe "" (accountNameDrop (drop_ opts)) accountName
Format.DepthSpacer -> case min of
AccountField -> formatValue ljust min max $ maybe "" (accountNameDrop (drop_ opts)) accountName
DepthSpacerField -> case min of
Just m -> formatValue ljust Nothing max $ replicate (depth * m) ' '
Nothing -> formatValue ljust Nothing max $ replicate depth ' '
Format.Total -> formatValue ljust min max $ showAmountWithoutPrice total
TotalField -> formatValue ljust min max $ showAmountWithoutPrice total
_ -> ""
tests_Hledger_Cli_Balance = TestList

View File

@ -28,28 +28,6 @@ import qualified Hledger.Cli.Format as Format
import Hledger.Cli.Options
import Hledger.Cli.Version
{- |
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,
@ -68,13 +46,6 @@ nullrules = CsvRules {
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]
@ -344,15 +315,15 @@ matchreplacepattern = do
return (matchpat,replpat)
-- csv record conversion
formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> Field -> String
formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> 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 -> ""
AccountField -> ""
DepthSpacerField -> ""
TotalField -> ""
DefaultDateField -> ""
DescriptionField -> ""
where
show = formatValue leftJustified min max

View File

@ -3,7 +3,7 @@ module Hledger.Cli.Format (
, formatStrings
, formatValue
, FormatString(..)
, Field(..)
, HledgerFormatField(..)
, tests
) where
@ -14,23 +14,8 @@ import Test.HUnit
import Text.ParserCombinators.Parsec
import Text.Printf
import Hledger.Data.Types
data Field =
Account
| DefaultDate
| Description
| Total
| DepthSpacer
| FieldNo Int
deriving (Show, Eq)
data FormatString =
FormatLiteral String
| FormatField Bool -- Left justified ?
(Maybe Int) -- Min width
(Maybe Int) -- Max width
Field -- Field
deriving (Show, Eq)
formatValue :: Bool -> Maybe Int -> Maybe Int -> String -> String
formatValue leftJustified min max value = printf formatS value
@ -49,13 +34,13 @@ parseFormatString input = case (runParser formatStrings () "(unknown)") input of
Parsers
-}
field :: GenParser Char st Field
field :: GenParser Char st HledgerFormatField
field = do
try (string "account" >> return Account)
<|> try (string "depth_spacer" >> return DepthSpacer)
<|> try (string "date" >> return Description)
<|> try (string "description" >> return Description)
<|> try (string "total" >> return Total)
try (string "account" >> return AccountField)
<|> try (string "depth_spacer" >> return DepthSpacerField)
<|> try (string "date" >> return DescriptionField)
<|> try (string "description" >> return DescriptionField)
<|> try (string "total" >> return TotalField)
<|> try (many1 digit >>= (\s -> return $ FieldNo $ read s))
formatField :: GenParser Char st FormatString
@ -106,28 +91,28 @@ tests = test [ formattingTests ++ parserTests ]
formattingTests = [
testFormat (FormatLiteral " ") "" " "
, testFormat (FormatField False Nothing Nothing Description) "description" "description"
, testFormat (FormatField False (Just 20) Nothing Description) "description" " description"
, testFormat (FormatField False Nothing (Just 20) Description) "description" "description"
, testFormat (FormatField True Nothing (Just 20) Description) "description" "description"
, testFormat (FormatField True (Just 20) Nothing Description) "description" "description "
, testFormat (FormatField True (Just 20) (Just 20) Description) "description" "description "
, testFormat (FormatField True Nothing (Just 3) Description) "description" "des"
, testFormat (FormatField False Nothing Nothing DescriptionField) "description" "description"
, testFormat (FormatField False (Just 20) Nothing DescriptionField) "description" " description"
, testFormat (FormatField False Nothing (Just 20) DescriptionField) "description" "description"
, testFormat (FormatField True Nothing (Just 20) DescriptionField) "description" "description"
, testFormat (FormatField True (Just 20) Nothing DescriptionField) "description" "description "
, testFormat (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description "
, testFormat (FormatField True Nothing (Just 3) DescriptionField) "description" "des"
]
parserTests = [
testParser "" []
, testParser "D" [FormatLiteral "D"]
, testParser "%(date)" [FormatField False Nothing Nothing Description]
, testParser "%(total)" [FormatField False Nothing Nothing Total]
, testParser "Hello %(date)!" [FormatLiteral "Hello ", FormatField False Nothing Nothing Description, FormatLiteral "!"]
, testParser "%-(date)" [FormatField True Nothing Nothing Description]
, testParser "%20(date)" [FormatField False (Just 20) Nothing Description]
, testParser "%.10(date)" [FormatField False Nothing (Just 10) Description]
, testParser "%20.10(date)" [FormatField False (Just 20) (Just 10) Description]
, testParser "%20(account) %.10(total)\n" [ FormatField False (Just 20) Nothing Account
, testParser "%(date)" [FormatField False Nothing Nothing DescriptionField]
, testParser "%(total)" [FormatField False Nothing Nothing TotalField]
, testParser "Hello %(date)!" [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]
, testParser "%-(date)" [FormatField True Nothing Nothing DescriptionField]
, testParser "%20(date)" [FormatField False (Just 20) Nothing DescriptionField]
, testParser "%.10(date)" [FormatField False Nothing (Just 10) DescriptionField]
, testParser "%20.10(date)" [FormatField False (Just 20) (Just 10) DescriptionField]
, testParser "%20(account) %.10(total)\n" [ FormatField False (Just 20) Nothing AccountField
, FormatLiteral " "
, FormatField False Nothing (Just 10) Total
, FormatField False Nothing (Just 10) TotalField
, FormatLiteral "\n"
]
]

View File

@ -415,10 +415,10 @@ formatFromOpts = maybe (Right defaultBalanceFormatString) parseFormatString . fo
-- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)"
defaultBalanceFormatString :: [FormatString]
defaultBalanceFormatString = [
FormatField False (Just 20) Nothing Total
FormatField False (Just 20) Nothing TotalField
, FormatLiteral " "
, FormatField True (Just 2) Nothing DepthSpacer
, FormatField True Nothing Nothing Format.Account
, FormatField True (Just 2) Nothing DepthSpacerField
, FormatField True Nothing Nothing AccountField
]
-- | Get the journal file path from options, an environment variable, or a default.