diff --git a/NOTES.org b/NOTES.org index f41f154d6..5711baaf7 100644 --- a/NOTES.org +++ b/NOTES.org @@ -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 diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index a6c028f75..34f841667 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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, diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index a7659e45e..2020dd43b 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 66120f79a..f7e99ef08 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 3b2778963..144e99a65 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/TimelogReader.hs b/hledger-lib/Hledger/Read/TimelogReader.hs index 512dd96d0..206aaece9 100644 --- a/hledger-lib/Hledger/Read/TimelogReader.hs +++ b/hledger-lib/Hledger/Read/TimelogReader.hs @@ -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 diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index cba21823c..576eb1e84 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -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 diff --git a/hledger/Hledger/Cli/Convert.hs b/hledger/Hledger/Cli/Convert.hs index 74fda0844..89855d7f4 100644 --- a/hledger/Hledger/Cli/Convert.hs +++ b/hledger/Hledger/Cli/Convert.hs @@ -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 diff --git a/hledger/Hledger/Cli/Format.hs b/hledger/Hledger/Cli/Format.hs index 630c3c951..fdfc5f7ff 100644 --- a/hledger/Hledger/Cli/Format.hs +++ b/hledger/Hledger/Cli/Format.hs @@ -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" ] ] diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index 0fc4def69..cbed38d98 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -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.