refactor/beef up readJournal/readJournalFile

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

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,
+       -- * Journal reading utilities
-       readJournalFile,
+       defaultJournalPath,
+       defaultJournal,
        readJournal,
-       journalFromPathAndString,
+       readJournalFile,
+       requireJournalFileExists,
+       ensureJournalFileExists,
+       -- * Temporary parser exports for Convert
        ledgeraccountname,
-       myJournalPath,
-       myJournal,
        someamount,
-       journalenvvar,
+       -- * Tests
-       journaldefaultfilename,
+       tests_Hledger_Read,
-       requireJournalFile,
-       ensureJournalFile,
 )
 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"
+journalEnvVar           = "LEDGER_FILE"
-journalenvvar2          = "LEDGER"
+journalEnvVar2          = "LEDGER"
-journaldefaultfilename  = ".hledger.journal"
+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
+-- | Read a Journal from this string or give an error message, using
--- data format, or if unspecified, trying all supported formats until one
+-- the specified data format or trying all known formats. CSV
--- succeeds. The file path is provided as an extra hint. Returns an error
+-- conversion rules may be provided for better conversion of that
--- message if the format is unsupported or if it is supported but parsing
+-- format, and/or a file path for better error messages.
--- fails.
+readJournal :: Maybe Format -> Maybe CsvReader.CsvRules -> Maybe FilePath -> String -> IO (Either String Journal)
-journalFromPathAndString :: Maybe String -> FilePath -> String -> IO (Either String Journal)
+readJournal format rules path s = do
-journalFromPathAndString format fp 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
+                   _   -> return $ Left $ bestErrorMsg errors s path
-    -- where
+    where
-
+      path' = fromMaybe "(string)" path
-tryReader :: FilePath -> String -> Reader -> IO (Either String Journal)
+      tryReader :: String -> Maybe FilePath -> Reader -> IO (Either String Journal)
-tryReader fp s r = do -- printf "trying to read %s format\n" (rFormat r)
+      tryReader s path r = do -- printf "trying to read %s format\n" (rFormat r)
-                      (runErrorT . (rParser r) fp) s
+                      (runErrorT . (rParser r) path') s
 
       -- unknown format
-bestErrorMsg [] fp _ = printf "could not parse %sdata in %s" (fmt formats) fp
+      bestErrorMsg :: [String] -> String -> Maybe FilePath -> String
-          where fmt [] = ""
+      bestErrorMsg [] _ path = printf "could not parse %sdata%s" fmts pathmsg
-                fmt [f] = f ++ " "
+          where fmts = case formats of
-                fmt fs = intercalate ", " (init fs) ++ " or " ++ last fs ++ " "
+                         [] -> ""
+                         [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
+-- | Read a Journal from this file (or stdin if the filename is -) or
--- trying all known formats, or give an error string.
+-- give an error message, using the specified data format or trying
-readJournalFile :: Maybe String -> FilePath -> IO (Either String Journal)
+-- all known formats. CSV conversion rules may be provided for better
-readJournalFile format "-" = getContents >>= journalFromPathAndString format "(stdin)"
+-- conversion of that format.
-readJournalFile format f = do
+readJournalFile :: Maybe Format -> Maybe CsvReader.CsvRules -> FilePath -> IO (Either String Journal)
-  requireJournalFile f
+readJournalFile format rules "-" = getContents >>= readJournal format rules (Just "(stdin)")
-  withFile f ReadMode $ \h -> hGetContents h >>= journalFromPathAndString format f
+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 ()
+requireJournalFileExists :: FilePath -> IO ()
-requireJournalFile f = do
+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 ()
+ensureJournalFileExists :: FilePath -> IO ()
-ensureJournalFile f = do
+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
 
   ]

hledger-lib/Hledger/Read/CsvReader.hs

@@ -6,6 +6,8 @@ data, like the convert command.
 -}
 
 module Hledger.Read.CsvReader (
+  CsvRules(..),
+  nullrules,
   reader,
   tests_Hledger_Read_CsvReader
 )

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

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|<span>Added transaction:<small><pre>#{chomp $ show t'}</pre></small>|]
@@ -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

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.

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
+   let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing Nothing str1 >>= either error' return
-                                j2 <- readJournal Nothing str2 >>= 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 ()
 

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

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'

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