diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 9f231053a..a6c028f75 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -173,11 +173,14 @@ data Journal = Journal { -- raise an error. type JournalUpdate = ErrorT String IO (Journal -> Journal) +-- | The id of a data format understood by hledger, eg @journal@ or @csv@. +type Format = String + -- | A hledger journal reader is a triple of format name, format-detecting -- predicate, and a parser to Journal. data Reader = Reader { -- name of the format this reader handles - rFormat :: String + 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 diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index d08498cd4..b3c9f910b 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -1,27 +1,31 @@ {-| -Read hledger data from various data formats, and related utilities. +This is the entry point to hledger's reading system, which can read +Journals from various data formats. Use this module if you want to +parse journal data or read journal files; it should not be necessary +to import modules below this one. -} module Hledger.Read ( - tests_Hledger_Read, - readJournalFile, + -- * Journal reading utilities + defaultJournalPath, + defaultJournal, readJournal, - journalFromPathAndString, + readJournalFile, + requireJournalFileExists, + ensureJournalFileExists, + -- * Temporary parser exports for Convert ledgeraccountname, - myJournalPath, - myJournal, someamount, - journalenvvar, - journaldefaultfilename, - requireJournalFile, - ensureJournalFile, + -- * Tests + tests_Hledger_Read, ) where import Control.Monad.Error import Data.Either (partitionEithers) import Data.List +import Data.Maybe import Safe (headDef) import System.Directory (doesFileExist, getHomeDirectory) import System.Environment (getEnv) @@ -32,7 +36,7 @@ import Test.HUnit import Text.Printf import Hledger.Data.Dates (getCurrentDay) -import Hledger.Data.Types (Journal(..), Reader(..)) +import Hledger.Data.Types (Journal(..), Reader(..), Format) import Hledger.Data.Journal (nullctx) import Hledger.Read.JournalReader as JournalReader import Hledger.Read.TimelogReader as TimelogReader @@ -42,9 +46,9 @@ import Prelude hiding (getContents, writeFile) import Hledger.Utils.UTF8 (getContents, hGetContents, writeFile) -journalenvvar = "LEDGER_FILE" -journalenvvar2 = "LEDGER" -journaldefaultfilename = ".hledger.journal" +journalEnvVar = "LEDGER_FILE" +journalEnvVar2 = "LEDGER" +journalDefaultFilename = ".hledger.journal" -- The available data file readers, each one handling a particular data -- format. The first is also used as the default for unknown formats. @@ -58,54 +62,84 @@ readers = [ -- | All the data formats we can read. formats = map rFormat readers +-- | Get the default journal file path specified by the environment. +-- Like ledger, we look first for the LEDGER_FILE environment +-- variable, and if that does not exist, for the legacy LEDGER +-- environment variable. If neither is set, or the value is blank, +-- return the hard-coded default, which is @.hledger.journal@ in the +-- users's home directory (or in the current directory, if we cannot +-- determine a home directory). +defaultJournalPath :: IO String +defaultJournalPath = do + s <- envJournalPath + if null s then defaultJournalPath else return s + where + envJournalPath = getEnv journalEnvVar `catch` (\_ -> getEnv journalEnvVar2 `catch` (\_ -> return "")) + defaultJournalPath = do + home <- getHomeDirectory `catch` (\_ -> return "") + return $ home journalDefaultFilename + +-- | Read the default journal file specified by the environment, or raise an error. +defaultJournal :: IO Journal +defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing >>= either error' return + -- | Find the reader which can handle the given format, if any. -- Typically there is just one; only the first is returned. -readerForFormat :: String -> Maybe Reader +readerForFormat :: Format -> Maybe Reader readerForFormat s | null rs = Nothing | otherwise = Just $ head rs where rs = filter ((s==).rFormat) readers :: [Reader] --- | Do our best to read a Journal from this string using the specified --- data format, or if unspecified, trying all supported formats until one --- succeeds. The file path is provided as an extra hint. Returns an error --- message if the format is unsupported or if it is supported but parsing --- fails. -journalFromPathAndString :: Maybe String -> FilePath -> String -> IO (Either String Journal) -journalFromPathAndString format fp s = do +-- | Read a Journal from this string or give an error message, using +-- 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 rules path s = do let readerstotry = case format of Nothing -> readers Just f -> case readerForFormat f of Just r -> [r] Nothing -> [] - (errors, journals) <- partitionEithers `fmap` mapM (tryReader fp s) readerstotry + (errors, journals) <- partitionEithers `fmap` mapM (tryReader s path) readerstotry -- XXX lazify case journals of j:_ -> return $ Right j - _ -> return $ Left $ bestErrorMsg errors fp s - -- where - -tryReader :: FilePath -> String -> Reader -> IO (Either String Journal) -tryReader fp s r = do -- printf "trying to read %s format\n" (rFormat r) - (runErrorT . (rParser r) fp) s + _ -> return $ Left $ bestErrorMsg errors s path + where + path' = fromMaybe "(string)" path + tryReader :: String -> Maybe FilePath -> Reader -> IO (Either String Journal) + tryReader s path r = do -- printf "trying to read %s format\n" (rFormat r) + (runErrorT . (rParser r) path') s -- unknown format -bestErrorMsg [] fp _ = printf "could not parse %sdata in %s" (fmt formats) fp - where fmt [] = "" - fmt [f] = f ++ " " - fmt fs = intercalate ", " (init fs) ++ " or " ++ last fs ++ " " + bestErrorMsg :: [String] -> String -> Maybe FilePath -> String + bestErrorMsg [] _ path = printf "could not parse %sdata%s" fmts pathmsg + where fmts = case formats of + [] -> "" + [f] -> f ++ " " + fs -> intercalate ", " (init fs) ++ " or " ++ last fs ++ " " + pathmsg = case path of + Nothing -> "" + Just p -> " in "++p -- one or more errors - report (the most appropriate ?) one -bestErrorMsg es fp s = printf "could not parse %s data in %s\n%s" (rFormat r) fp e + bestErrorMsg es s path = printf "could not parse %s data%s\n%s" (rFormat r) pathmsg e where (r,e) = headDef (head readers, head es) $ filter detects $ zip readers es - detects (r,_) = (rDetector r) fp s + detects (r,_) = (rDetector r) path' s + pathmsg = case path of + Nothing -> "" + Just p -> " in "++p --- | Read a journal from this file, using the specified data format or --- trying all known formats, or give an error string. -readJournalFile :: Maybe String -> FilePath -> IO (Either String Journal) -readJournalFile format "-" = getContents >>= journalFromPathAndString format "(stdin)" -readJournalFile format f = do - requireJournalFile f - withFile f ReadMode $ \h -> hGetContents h >>= journalFromPathAndString format f +-- | Read a Journal from this file (or stdin if the filename is -) or +-- give an error message, using the specified data format or trying +-- all known formats. CSV conversion rules may be provided for better +-- conversion of that format. +readJournalFile :: Maybe Format -> Maybe CsvReader.CsvRules -> FilePath -> IO (Either String Journal) +readJournalFile format rules "-" = getContents >>= readJournal format rules (Just "(stdin)") +readJournalFile format rules f = do + requireJournalFileExists f + withFile f ReadMode $ \h -> hGetContents h >>= readJournal format rules (Just f) -- | If the specified journal file does not exist, give a helpful error and quit. -requireJournalFile :: FilePath -> IO () -requireJournalFile f = do +requireJournalFileExists :: FilePath -> IO () +requireJournalFileExists f = do exists <- doesFileExist f when (not exists) $ do hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f @@ -114,8 +148,8 @@ requireJournalFile f = do exitFailure -- | Ensure there is a journal file at the given path, creating an empty one if needed. -ensureJournalFile :: FilePath -> IO () -ensureJournalFile f = do +ensureJournalFileExists :: FilePath -> IO () +ensureJournalFileExists f = do exists <- doesFileExist f when (not exists) $ do hPrintf stderr "Creating hledger journal file \"%s\".\n" f @@ -129,31 +163,6 @@ newJournalContent = do d <- getCurrentDay return $ printf "; journal created %s by hledger\n" (show d) --- | Read a Journal from this string, using the specified data format or --- trying all known formats, or give an error string. -readJournal :: Maybe String -> String -> IO (Either String Journal) -readJournal format s = journalFromPathAndString format "(string)" s - --- | Get the user's journal file path. Like ledger, we look first for the --- LEDGER_FILE environment variable, and if that does not exist, for the --- legacy LEDGER environment variable. If neither is set, or the value is --- blank, return the default journal file path, which is --- ".hledger.journal" in the users's home directory, or if we cannot --- determine that, in the current directory. -myJournalPath :: IO String -myJournalPath = do - s <- envJournalPath - if null s then defaultJournalPath else return s - where - envJournalPath = getEnv journalenvvar `catch` (\_ -> getEnv journalenvvar2 `catch` (\_ -> return "")) - defaultJournalPath = do - home <- getHomeDirectory `catch` (\_ -> return "") - return $ home journaldefaultfilename - --- | Read the user's default journal file, or give an error. -myJournal :: IO Journal -myJournal = myJournalPath >>= readJournalFile Nothing >>= either error' return - tests_Hledger_Read = TestList [ tests_Hledger_Read_JournalReader, @@ -162,7 +171,7 @@ tests_Hledger_Read = TestList "journalFile" ~: do assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx nullctx JournalReader.journalFile "") - jE <- readJournal Nothing "" -- don't know how to get it from journalFile + jE <- readJournal Nothing Nothing Nothing "" -- don't know how to get it from journalFile either error' (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE ] diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index b3172e22f..66120f79a 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -6,8 +6,10 @@ data, like the convert command. -} module Hledger.Read.CsvReader ( - reader, - tests_Hledger_Read_CsvReader + CsvRules(..), + nullrules, + reader, + tests_Hledger_Read_CsvReader ) where import Control.Monad diff --git a/hledger-lib/Hledger/Read/Utils.hs b/hledger-lib/Hledger/Read/Utils.hs index 3a0aa20f2..61741c655 100644 --- a/hledger-lib/Hledger/Read/Utils.hs +++ b/hledger-lib/Hledger/Read/Utils.hs @@ -1,6 +1,8 @@ {-# LANGUAGE RecordWildCards #-} {-| -Utilities common to hledger journal readers. + +Utilities used throughout hledger's read system. + -} module Hledger.Read.Utils diff --git a/hledger-web/Hledger/Web/Handlers.hs b/hledger-web/Hledger/Web/Handlers.hs index cf548e1be..742c16208 100644 --- a/hledger-web/Hledger/Web/Handlers.hs +++ b/hledger-web/Hledger/Web/Handlers.hs @@ -516,7 +516,7 @@ handleAdd = do |] Right t -> do let t' = txnTieKnot t -- XXX move into balanceTransaction - liftIO $ do ensureJournalFile journalpath + liftIO $ do ensureJournalFileExists journalpath appendToJournalFileOrStdout journalpath $ showTransaction t' -- setMessage $ toHtml $ (printf "Added transaction:\n%s" (show t') :: String) setMessage [$shamlet|Added transaction:
#{chomp $ show t'}
|] @@ -561,7 +561,7 @@ handleEdit = do setMessage "No change" redirect RedirectTemporary JournalR else do - jE <- liftIO $ journalFromPathAndString Nothing journalpath tnew + jE <- liftIO $ readJournal Nothing Nothing (Just journalpath) tnew either (\e -> do setMessage $ toHtml e diff --git a/hledger-web/hledger-web.hs b/hledger-web/hledger-web.hs index 37c74b119..26fda47e6 100644 --- a/hledger-web/hledger-web.hs +++ b/hledger-web/hledger-web.hs @@ -43,11 +43,11 @@ runWith opts = run opts | "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp webmode) >> exitSuccess | "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) - | otherwise = journalFilePathFromOpts (cliopts_ opts) >>= ensureJournalFile >> withJournalDo' opts web + | otherwise = journalFilePathFromOpts (cliopts_ opts) >>= ensureJournalFileExists >> withJournalDo' opts web withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO () withJournalDo' opts cmd = do - journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>= + journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing Nothing >>= either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts)) -- | The web command. diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 586bb811a..b36a9d5a7 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -53,8 +53,8 @@ tests_Hledger_Cli = TestList ,"account directive" ~: - let sameParse str1 str2 = do j1 <- readJournal Nothing str1 >>= either error' return - j2 <- readJournal Nothing str2 >>= either error' return + let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing Nothing str1 >>= either error' return + j2 <- readJournal Nothing Nothing Nothing str2 >>= either error' return j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1} in TestList [ @@ -85,7 +85,7 @@ tests_Hledger_Cli = TestList ) ,"account directive should preserve \"virtual\" posting type" ~: do - j <- readJournal Nothing "!account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return + j <- readJournal Nothing Nothing Nothing "!account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j assertBool "" $ (paccount p) == "test:from" assertBool "" $ (ptype p) == VirtualPosting @@ -93,7 +93,7 @@ tests_Hledger_Cli = TestList ] ,"account aliases" ~: do - Right j <- readJournal Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" + Right j <- readJournal Nothing Nothing Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" let p = head $ tpostings $ head $ jtxns j assertBool "" $ paccount p == "equity:draw:personal:food" @@ -235,7 +235,7 @@ tests_Hledger_Cli = TestList ] ,"balance report with cost basis" ~: do - j <- (readJournal Nothing $ unlines + j <- (readJournal Nothing Nothing Nothing $ unlines ["" ,"2008/1/1 test " ," a:b 10h @ $50" @@ -266,7 +266,7 @@ tests_Hledger_Cli = TestList -- `is` "aa:aa:aaaaaaaaaaaaaa") ,"default year" ~: do - j <- readJournal Nothing defaultyear_journal_str >>= either error' return + j <- readJournal Nothing Nothing Nothing defaultyear_journal_str >>= either error' return tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 return () diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index ee0fff5c3..c59ef371b 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -19,7 +19,7 @@ You can use the command line: or ghci: > $ ghci hledger -> > j <- readJournalFile "data/sample.journal" +> > j <- readJournalFile Nothing Nothing "data/sample.journal" > > register [] ["income","expenses"] j > 2008/01/01 income income:salary $-1 $-1 > 2008/06/01 gift income:gifts $-1 $-2 @@ -46,7 +46,7 @@ import System.Exit import System.Process import Text.Printf -import Hledger (ensureJournalFile) +import Hledger (ensureJournalFileExists) import Hledger.Cli.Add import Hledger.Cli.Balance import Hledger.Cli.Convert @@ -73,7 +73,7 @@ main = do | (null matchedaddon) && "version" `in_` (rawopts_ opts) = putStrLn prognameandversion | (null matchedaddon) && "binary-filename" `in_` (rawopts_ opts) = putStrLn $ binaryfilename progname | null cmd = putStr $ showModeHelp mainmode' - | cmd `isPrefixOf` "add" = showModeHelpOr addmode $ journalFilePathFromOpts opts >>= ensureJournalFile >> withJournalDo opts add + | cmd `isPrefixOf` "add" = showModeHelpOr addmode $ journalFilePathFromOpts opts >>= ensureJournalFileExists >> withJournalDo opts add | cmd `isPrefixOf` "convert" = showModeHelpOr convertmode $ convert opts | cmd `isPrefixOf` "test" = showModeHelpOr testmode $ runtests opts | any (cmd `isPrefixOf`) ["accounts","balance"] = showModeHelpOr accountsmode $ withJournalDo opts balance diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index 844488037..0fc4def69 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -422,10 +422,10 @@ defaultBalanceFormatString = [ ] -- | Get the journal file path from options, an environment variable, or a default. --- If the path contains a literal tilde raise an error to avoid confusion. +-- If the path contains a literal tilde raise an error to avoid confusion. XXX journalFilePathFromOpts :: CliOpts -> IO String journalFilePathFromOpts opts = do - f <- myJournalPath + f <- defaultJournalPath let f' = fromMaybe f $ file_ opts if '~' `elem` f' then error' $ printf "~ in the journal file path is not supported, please adjust (%s)" f' diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 0db2414b9..b299e2a5e 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -48,20 +48,20 @@ withJournalDo opts cmd = do -- We kludgily read the file before parsing to grab the full text, unless -- it's stdin, or it doesn't exist and we are adding. We read it strictly -- to let the add command work. - journalFilePathFromOpts opts >>= readJournalFile Nothing >>= + journalFilePathFromOpts opts >>= readJournalFile Nothing Nothing >>= either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts)) -- -- | Get a journal from the given string and options, or throw an error. -- readJournalWithOpts :: CliOpts -> String -> IO Journal --- readJournalWithOpts opts s = readJournal Nothing s >>= either error' return +-- readJournalWithOpts opts s = readJournal Nothing Nothing Nothing s >>= either error' return -- | Get a journal from the given string, or throw an error. readJournal' :: String -> IO Journal -readJournal' s = readJournal Nothing s >>= either error' return +readJournal' s = readJournal Nothing Nothing Nothing s >>= either error' return -- | Re-read a journal from its data file, or return an error string. journalReload :: Journal -> IO (Either String Journal) -journalReload j = readJournalFile Nothing $ journalFilePath j +journalReload j = readJournalFile Nothing Nothing $ journalFilePath j -- | Re-read a journal from its data file mostly, only if the file has -- changed since last read (or if there is no file, ie data read from