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 *** inspiration
http://community.haskell.org/~ndm/downloads/paper-hoogle_overview-19_nov_2008.pdf -> Design Guidelines http://community.haskell.org/~ndm/downloads/paper-hoogle_overview-19_nov_2008.pdf -> Design Guidelines
** features/wishlist ** features/wishlist
*** don't moan about ~
*** support apostrophe digit group separator *** support apostrophe digit group separator
*** detect .hs plugins *** detect .hs plugins
*** Clint's ofx support *** Clint's ofx support

View File

@ -183,9 +183,65 @@ data Reader = Reader {
rFormat :: Format rFormat :: Format
-- quickly check if this reader can probably handle the given file path and file content -- quickly check if this reader can probably handle the given file path and file content
,rDetector :: FilePath -> String -> Bool ,rDetector :: FilePath -> String -> Bool
-- really parse the given file path and file content, returning a journal or error -- parse the given string, using the given parsing rules if any, returning a journal or error aware of the given file path
,rParser :: FilePath -> String -> ErrorT String IO Journal ,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 { data Ledger = Ledger {
journal :: Journal, journal :: Journal,
accountnametree :: Tree AccountName, accountnametree :: Tree AccountName,

View File

@ -34,7 +34,7 @@ import Test.HUnit
import Text.Printf import Text.Printf
import Hledger.Data.Dates (getCurrentDay) import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.Types (Journal(..), Reader(..), Format) import Hledger.Data.Types
import Hledger.Data.Journal (nullctx) import Hledger.Data.Journal (nullctx)
import Hledger.Read.JournalReader as JournalReader import Hledger.Read.JournalReader as JournalReader
import Hledger.Read.TimelogReader as TimelogReader 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 -- the specified data format or trying all known formats. CSV
-- conversion rules may be provided for better conversion of that -- conversion rules may be provided for better conversion of that
-- format, and/or a file path for better error messages. -- format, and/or a file path for better error messages.
readJournal :: Maybe Format -> Maybe CsvReader.CsvRules -> Maybe FilePath -> String -> IO (Either String Journal) readJournal :: Maybe Format -> Maybe ParseRules -> Maybe FilePath -> String -> IO (Either String Journal)
readJournal format _ path s = readJournal format rules path s =
let readerstotry = case format of Nothing -> readers let readerstotry = case format of Nothing -> readers
Just f -> case readerForFormat f of Just r -> [r] Just f -> case readerForFormat f of Just r -> [r]
Nothing -> [] Nothing -> []
@ -103,7 +103,7 @@ readJournal format _ path s =
path' = fromMaybe "(string)" path path' = fromMaybe "(string)" path
tryReader :: Reader -> IO (Either String Journal) tryReader :: Reader -> IO (Either String Journal)
tryReader r = do -- printf "trying %s reader\n" (rFormat r) 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; -- if no reader succeeds, we return the error of the first;
-- ideally it would be the error of the most likely intended -- 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. -- | Parse and post-process a "Journal" from CSV data, or give an error.
-- XXX currently ignores the string and reads from the file path -- XXX currently ignores the string and reads from the file path
parse_ :: FilePath -> String -> ErrorT String IO Journal parse_ :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
parse_ f s = do parse_ rules f s = do
r <- liftIO $ journalFromCsv f s r <- liftIO $ journalFromCsv rules f s
case r of Left e -> throwError e case r of Left e -> throwError e
Right j -> return j 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 { nullrules = CsvRules {
dateField=Nothing, dateField=Nothing,
dateFormat=Nothing, dateFormat=Nothing,
@ -109,35 +85,32 @@ nullrules = CsvRules {
accountRules=[] 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] type CsvRecord = [String]
-- | Read the CSV file named as an argument and print equivalent journal transactions, -- | Read the CSV file named as an argument and print equivalent journal transactions,
-- using/creating a .rules file. -- using/creating a .rules file.
journalFromCsv :: FilePath -> String -> IO (Either String Journal) journalFromCsv :: Maybe CsvRules -> FilePath -> String -> IO (Either String Journal)
journalFromCsv csvfile content = do journalFromCsv csvrules csvfile content = do
let usingStdin = csvfile == "-" let usingStdin = csvfile == "-"
-- rulesFileSpecified = isJust $ rules_file_ opts -- 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" -- when (usingStdin && (not rulesFileSpecified)) $ error' "please use --rules-file to specify a rules file when converting stdin"
csvparse <- parseCsv csvfile content csvparse <- parseCsv csvfile content
let records = case csvparse of let records = case csvparse of
Left e -> error' $ show e Left e -> error' $ show e
Right rs -> filter (/= [""]) rs Right rs -> filter (/= [""]) rs
exists <- doesFileExist rulesfile rules <- case csvrules of
if (not exists) then do Nothing -> do
hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile let rulesfile = rulesFileFor csvfile
writeFile rulesfile initialRulesFileContent exists <- doesFileExist rulesfile
else if (not exists)
hPrintf stderr "using conversion rules file %s\n" rulesfile then do
rules <- liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile 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 let invalid = validateRules rules
-- when (debug_ opts) $ hPrintf stderr "rules: %s\n" (show rules) -- when (debug_ opts) $ hPrintf stderr "rules: %s\n" (show rules)
when (isJust invalid) $ error (fromJust invalid) when (isJust invalid) $ error (fromJust invalid)
@ -384,15 +357,15 @@ matchreplacepattern = do
return (matchpat,replpat) return (matchpat,replpat)
-- csv record conversion -- 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 formatD record leftJustified min max f = case f of
FieldNo n -> maybe "" show $ atMay record n FieldNo n -> maybe "" show $ atMay record n
-- Some of these might in theory in read from fields -- Some of these might in theory in read from fields
FormatStrings.Account -> "" AccountField -> ""
DepthSpacer -> "" DepthSpacerField -> ""
Total -> "" TotalField -> ""
DefaultDate -> "" DefaultDateField -> ""
Description -> "" DescriptionField -> ""
where where
show = formatValue leftJustified min max 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 -- | Parse and post-process a "Journal" from hledger's journal file
-- format, or give an error. -- format, or give an error.
parse :: FilePath -> String -> ErrorT String IO Journal parse :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
parse = parseJournalWith journalFile parse _ = parseJournalWith journalFile
-- | Top-level journal parser. Returns a single composite, I/O performing, -- | Top-level journal parser. Returns a single composite, I/O performing,
-- error-raising "JournalUpdate" (and final "JournalContext") which can be -- 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 -- | Parse and post-process a "Journal" from timeclock.el's timelog
-- format, saving the provided file path and the current time, or give an -- format, saving the provided file path and the current time, or give an
-- error. -- error.
parse :: FilePath -> String -> ErrorT String IO Journal parse :: Maybe ParseRules -> FilePath -> String -> ErrorT String IO Journal
parse = parseJournalWith timelogFile parse _ = parseJournalWith timelogFile
timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext) timelogFile :: GenParser Char JournalContext (JournalUpdate,JournalContext)
timelogFile = do items <- many timelogItem timelogFile = do items <- many timelogItem

View File

@ -170,13 +170,13 @@ formatAccountsReportItem opts accountName depth amount (fmt:fmts) =
FormatLiteral l -> l FormatLiteral l -> l
FormatField ljust min max field -> formatField opts accountName depth amount ljust min max field 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 formatField opts accountName depth total ljust min max field = case field of
Format.Account -> formatValue ljust min max $ maybe "" (accountNameDrop (drop_ opts)) accountName AccountField -> formatValue ljust min max $ maybe "" (accountNameDrop (drop_ opts)) accountName
Format.DepthSpacer -> case min of DepthSpacerField -> case min of
Just m -> formatValue ljust Nothing max $ replicate (depth * m) ' ' Just m -> formatValue ljust Nothing max $ replicate (depth * m) ' '
Nothing -> formatValue ljust Nothing max $ replicate depth ' ' 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 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.Options
import Hledger.Cli.Version 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 { nullrules = CsvRules {
dateField=Nothing, dateField=Nothing,
dateFormat=Nothing, dateFormat=Nothing,
@ -68,13 +46,6 @@ nullrules = CsvRules {
accountRules=[] 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] type CsvRecord = [String]
@ -344,15 +315,15 @@ matchreplacepattern = do
return (matchpat,replpat) return (matchpat,replpat)
-- csv record conversion -- 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 formatD record leftJustified min max f = case f of
FieldNo n -> maybe "" show $ atMay record n FieldNo n -> maybe "" show $ atMay record n
-- Some of these might in theory in read from fields -- Some of these might in theory in read from fields
Format.Account -> "" AccountField -> ""
DepthSpacer -> "" DepthSpacerField -> ""
Total -> "" TotalField -> ""
DefaultDate -> "" DefaultDateField -> ""
Description -> "" DescriptionField -> ""
where where
show = formatValue leftJustified min max show = formatValue leftJustified min max

View File

@ -3,7 +3,7 @@ module Hledger.Cli.Format (
, formatStrings , formatStrings
, formatValue , formatValue
, FormatString(..) , FormatString(..)
, Field(..) , HledgerFormatField(..)
, tests , tests
) where ) where
@ -14,23 +14,8 @@ import Test.HUnit
import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec
import Text.Printf 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 :: Bool -> Maybe Int -> Maybe Int -> String -> String
formatValue leftJustified min max value = printf formatS value formatValue leftJustified min max value = printf formatS value
@ -49,13 +34,13 @@ parseFormatString input = case (runParser formatStrings () "(unknown)") input of
Parsers Parsers
-} -}
field :: GenParser Char st Field field :: GenParser Char st HledgerFormatField
field = do field = do
try (string "account" >> return Account) try (string "account" >> return AccountField)
<|> try (string "depth_spacer" >> return DepthSpacer) <|> try (string "depth_spacer" >> return DepthSpacerField)
<|> try (string "date" >> return Description) <|> try (string "date" >> return DescriptionField)
<|> try (string "description" >> return Description) <|> try (string "description" >> return DescriptionField)
<|> try (string "total" >> return Total) <|> try (string "total" >> return TotalField)
<|> try (many1 digit >>= (\s -> return $ FieldNo $ read s)) <|> try (many1 digit >>= (\s -> return $ FieldNo $ read s))
formatField :: GenParser Char st FormatString formatField :: GenParser Char st FormatString
@ -106,28 +91,28 @@ tests = test [ formattingTests ++ parserTests ]
formattingTests = [ formattingTests = [
testFormat (FormatLiteral " ") "" " " testFormat (FormatLiteral " ") "" " "
, testFormat (FormatField False Nothing Nothing Description) "description" "description" , testFormat (FormatField False Nothing Nothing DescriptionField) "description" "description"
, testFormat (FormatField False (Just 20) Nothing Description) "description" " description" , testFormat (FormatField False (Just 20) Nothing DescriptionField) "description" " description"
, testFormat (FormatField False Nothing (Just 20) Description) "description" "description" , testFormat (FormatField False Nothing (Just 20) DescriptionField) "description" "description"
, testFormat (FormatField True Nothing (Just 20) Description) "description" "description" , testFormat (FormatField True Nothing (Just 20) DescriptionField) "description" "description"
, testFormat (FormatField True (Just 20) Nothing Description) "description" "description " , testFormat (FormatField True (Just 20) Nothing DescriptionField) "description" "description "
, testFormat (FormatField True (Just 20) (Just 20) Description) "description" "description " , testFormat (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description "
, testFormat (FormatField True Nothing (Just 3) Description) "description" "des" , testFormat (FormatField True Nothing (Just 3) DescriptionField) "description" "des"
] ]
parserTests = [ parserTests = [
testParser "" [] testParser "" []
, testParser "D" [FormatLiteral "D"] , testParser "D" [FormatLiteral "D"]
, testParser "%(date)" [FormatField False Nothing Nothing Description] , testParser "%(date)" [FormatField False Nothing Nothing DescriptionField]
, testParser "%(total)" [FormatField False Nothing Nothing Total] , testParser "%(total)" [FormatField False Nothing Nothing TotalField]
, testParser "Hello %(date)!" [FormatLiteral "Hello ", FormatField False Nothing Nothing Description, FormatLiteral "!"] , testParser "Hello %(date)!" [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]
, testParser "%-(date)" [FormatField True Nothing Nothing Description] , testParser "%-(date)" [FormatField True Nothing Nothing DescriptionField]
, testParser "%20(date)" [FormatField False (Just 20) Nothing Description] , testParser "%20(date)" [FormatField False (Just 20) Nothing DescriptionField]
, testParser "%.10(date)" [FormatField False Nothing (Just 10) Description] , testParser "%.10(date)" [FormatField False Nothing (Just 10) DescriptionField]
, testParser "%20.10(date)" [FormatField False (Just 20) (Just 10) Description] , testParser "%20.10(date)" [FormatField False (Just 20) (Just 10) DescriptionField]
, testParser "%20(account) %.10(total)\n" [ FormatField False (Just 20) Nothing Account , testParser "%20(account) %.10(total)\n" [ FormatField False (Just 20) Nothing AccountField
, FormatLiteral " " , FormatLiteral " "
, FormatField False Nothing (Just 10) Total , FormatField False Nothing (Just 10) TotalField
, FormatLiteral "\n" , 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)" -- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)"
defaultBalanceFormatString :: [FormatString] defaultBalanceFormatString :: [FormatString]
defaultBalanceFormatString = [ defaultBalanceFormatString = [
FormatField False (Just 20) Nothing Total FormatField False (Just 20) Nothing TotalField
, FormatLiteral " " , FormatLiteral " "
, FormatField True (Just 2) Nothing DepthSpacer , FormatField True (Just 2) Nothing DepthSpacerField
, FormatField True Nothing Nothing Format.Account , FormatField True Nothing Nothing AccountField
] ]
-- | Get the journal file path from options, an environment variable, or a default. -- | Get the journal file path from options, an environment variable, or a default.