more file reading cleanup, try each known format in turn

Currently this is just the journal and timelog file formats.  This is more
scalable, but when things go wrong there is no longer just a single parse
error. For now we'll just show the first error, the one from the journal
file parser.

Hledger/Cli/Commands/Web.hs

@@ -37,6 +37,7 @@ import Hledger.Cli.Commands.Print
 import Hledger.Cli.Commands.Register
 import Hledger.Data
 import Hledger.Read
+import Hledger.Read.Journal (someamount)
 import Hledger.Cli.Options hiding (value)
 #ifdef MAKE
 import Paths_hledger_make (getDataFileName)

Hledger/Cli/Tests.hs

@@ -36,7 +36,8 @@ import System.Time (ClockTime(TOD))
 import Hledger.Cli.Commands.All
 import Hledger.Data  -- including testing utils in Hledger.Data.Utils
 import Hledger.Read.Common (emptyCtx)
-import Hledger.Read (someamount,readJournal)
+import Hledger.Read (readJournal)
+import Hledger.Read.Journal (someamount)
 import Hledger.Cli.Options
 import Hledger.Cli.Utils
 

hledger-lib/Hledger/Data/Utils.hs

@@ -321,3 +321,15 @@ isRight = not . isLeft
 
 strictReadFile :: FilePath -> IO String
 strictReadFile f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s
+
+-- -- | Expand ~ in a file path (does not handle ~name).
+-- tildeExpand :: FilePath -> IO FilePath
+-- tildeExpand ('~':[])     = getHomeDirectory
+-- tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
+-- --handle ~name, requires -fvia-C or ghc 6.8:
+-- --import System.Posix.User
+-- -- tildeExpand ('~':xs)     =  do let (user, path) = span (/= '/') xs
+-- --                                pw <- getUserEntryForName user
+-- --                                return (homeDirectory pw ++ path)
+-- tildeExpand xs           =  return xs
+

hledger-lib/Hledger/Read.hs

@@ -7,35 +7,50 @@ Read hledger data from various data formats, and related utilities.
 
 module Hledger.Read (
        tests_Hledger_Read,
-       module Hledger.Read.Common,
-       Hledger.Read.Journal.someamount,
-       readJournalFile,
-       readJournal,
        myLedgerPath,
        myTimelogPath,
        myJournal,
        myTimelog,
+       readJournalFile,
+       readJournal,
 )
 where
 import Hledger.Data.Types (Journal(..))
 import Hledger.Data.Utils
 import Hledger.Read.Common
-import qualified Hledger.Read.Journal (parseJournal,parseJournalFile,ledgerFile,someamount,tests_Journal)
-import qualified Hledger.Read.Timelog (tests_Timelog) --parseJournal
+import qualified Hledger.Read.Journal (parseJournal,ledgerFile,tests_Journal)
+import qualified Hledger.Read.Timelog (parseJournal,tests_Timelog)
 
 import Control.Monad.Error
+import Data.Either (partitionEithers)
 import System.Directory (getHomeDirectory)
 import System.Environment (getEnv)
 import System.FilePath ((</>))
 import System.Exit
 import System.IO (stderr)
 #if __GLASGOW_HASKELL__ <= 610
-import System.IO.UTF8 (hPutStrLn)
+import Prelude hiding (readFile, putStr, putStrLn, print, getContents)
+import System.IO.UTF8
 #else
 import System.IO (hPutStrLn)
 #endif
 
 
+formats = [
+  "journal"
+ ,"timelog"
+-- ,"csv"
+ ]
+
+unknownformatmsg fp = printf "could not recognise %sdata in %s" (fmt formats) fp
+    where fmt [] = ""
+          fmt [f] = f ++ " "
+          fmt fs = intercalate ", " (init fs) ++ " or " ++ last fs ++ " "
+
+parsers = [Hledger.Read.Journal.parseJournal
+          ,Hledger.Read.Timelog.parseJournal
+          ]
+
 ledgerenvvar           = "LEDGER"
 timelogenvvar          = "TIMELOG"
 ledgerdefaultfilename  = ".ledger"
@@ -65,27 +80,28 @@ myJournal = myLedgerPath >>= readJournalFile
 myTimelog :: IO Journal
 myTimelog = myTimelogPath >>= readJournalFile
 
--- | Read a journal from this file, or throw an error.
+-- | Read a journal from this file, trying all known data formats,
+-- or give an error.
 readJournalFile :: FilePath -> IO Journal
-readJournalFile f =
-  (runErrorT . Hledger.Read.Journal.parseJournalFile) f >>= either printerror return
-  where printerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
+readJournalFile "-" = getContents >>= journalFromPathAndString "(stdin)"
+readJournalFile f   = readFile f  >>= journalFromPathAndString f
 
--- | Read a Journal from this string, or throw an error.
+-- | Read a Journal from this string, trying all known data formats, or
+-- give an error.
 readJournal :: String -> IO Journal
-readJournal s =
-  (runErrorT . Hledger.Read.Journal.parseJournal "(from string)") s >>= either error return
+readJournal = journalFromPathAndString "(string)"
 
--- -- | Expand ~ in a file path (does not handle ~name).
--- tildeExpand :: FilePath -> IO FilePath
--- tildeExpand ('~':[])     = getHomeDirectory
--- tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
--- --handle ~name, requires -fvia-C or ghc 6.8:
--- --import System.Posix.User
--- -- tildeExpand ('~':xs)     =  do let (user, path) = span (/= '/') xs
--- --                                pw <- getUserEntryForName user
--- --                                return (homeDirectory pw ++ path)
--- tildeExpand xs           =  return xs
+-- | Read a Journal from this string, trying each known data format in
+-- turn, or give an error.  The file path is also required.
+journalFromPathAndString :: FilePath -> String -> IO Journal
+journalFromPathAndString f s = do
+  (errors, journals) <- partitionEithers `fmap` mapM try parsers
+  case journals of j:_ -> return j
+                   _   -> hPutStrLn stderr (errmsg errors) >> exitWith (ExitFailure 1)
+    where
+      try p = (runErrorT . p f) s
+      errmsg [] = unknownformatmsg f
+      errmsg (e:_) = unlines [unknownformatmsg f, e]
 
 tests_Hledger_Read = TestList
   [

hledger-lib/Hledger/Read/Common.hs

@@ -9,17 +9,29 @@ module Hledger.Read.Common
 where
 
 import Control.Monad.Error
-import Data.List
+import Hledger.Data.Utils
 import Hledger.Data.Types (Journal)
-import Text.ParserCombinators.Parsec
+import Hledger.Data.Journal
 import System.Directory (getHomeDirectory)
 import System.FilePath(takeDirectory,combine)
+import System.Time (getClockTime)
+import Text.ParserCombinators.Parsec
 
 
 -- | A JournalUpdate is some transformation of a "Journal". It can do I/O
 -- or raise an error.
 type JournalUpdate = ErrorT String IO (Journal -> Journal)
 
+-- | Given a JournalUpdate-generating parsec parser, file path and data string,
+-- parse and post-process a Journal so that it's ready to use, or give an error.
+parseJournalWith :: (GenParser Char LedgerFileCtx JournalUpdate) -> FilePath -> String -> ErrorT String IO Journal
+parseJournalWith p f s = do
+  tc <- liftIO getClockTime
+  tl <- liftIO getCurrentLocalTime
+  case runParser p emptyCtx f s of
+    Right updates -> liftM (journalFinalise tc tl f s) $ updates `ap` return nulljournal
+    Left err      -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ?
+
 -- | Some context kept during parsing.
 data LedgerFileCtx = Ctx {
       ctxYear     :: !(Maybe Integer)  -- ^ the default year most recently specified with Y

hledger-lib/Hledger/Read/Journal.hs

@@ -103,15 +103,20 @@ i, o, b, h
 
 -}
 
-module Hledger.Read.Journal {- (
+module Hledger.Read.Journal (
+       tests_Journal,
        parseJournal,
-       parseJournalFile,
+       ledgerFile,
        someamount,
-       emptyCtx,
-       ledgeraccountname
-) -}
+       ledgeraccountname,
+       ledgerExclamationDirective,
+       ledgerHistoricalPrice,
+       ledgerDefaultYear,
+       emptyLine,
+       ledgerdatetime,
+)
 where
-import Control.Monad.Error (ErrorT(..), MonadIO, liftIO, throwError, catchError)
+import Control.Monad.Error (ErrorT(..), throwError, catchError)
 import Text.ParserCombinators.Parsec
 #if __GLASGOW_HASKELL__ <= 610
 import Prelude hiding (readFile, putStr, putStrLn, print, getContents)
@@ -127,27 +132,14 @@ import Hledger.Data.Posting
 import Hledger.Data.Journal
 import Hledger.Data.Commodity (dollars,dollar,unknown,nonsimplecommoditychars)
 import Hledger.Read.Common
-import System.Time (getClockTime)
 
 
 -- let's get to it
 
--- | Parse and post-process a journal file or timelog file to a "Journal",
--- or give an error.
-parseJournalFile :: FilePath -> ErrorT String IO Journal
-parseJournalFile "-" = liftIO getContents >>= parseJournal "-"
-parseJournalFile f   = liftIO (readFile f) >>= parseJournal f
-
 -- | Parse and post-process a "Journal" from hledger's journal file
--- format, saving the provided file path and the current time, or give an
--- error.
+-- format, or give an error.
 parseJournal :: FilePath -> String -> ErrorT String IO Journal
-parseJournal f s = do
-  tc <- liftIO getClockTime
-  tl <- liftIO getCurrentLocalTime
-  case runParser ledgerFile emptyCtx f s of
-    Right m  -> liftM (journalFinalise tc tl f s) $ m `ap` return nulljournal
-    Left err -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ?
+parseJournal = parseJournalWith ledgerFile
 
 -- | Top-level journal parser. Returns a single composite, I/O performing,
 -- error-raising "JournalUpdate" which can be applied to an empty journal
@@ -170,7 +162,7 @@ ledgerFile = do items <- many ledgerItem
                           , ledgerTagDirective
                           , ledgerEndTagDirective
                           , emptyLine >> return (return id)
-                          ] <?> "ledger transaction, timelog entry, or directive"
+                          ] <?> "ledger transaction or directive"
 
 emptyLine :: GenParser Char st ()
 emptyLine = do many spacenonewline

hledger-lib/Hledger/Read/Timelog.hs

@@ -42,29 +42,23 @@ o 2007/03/10 17:26:02
 
 -}
 
-module Hledger.Read.Timelog {- (
+module Hledger.Read.Timelog (
+       tests_Timelog,
        parseJournal,
-       parseJournalFile
-) -}
+)
 where
-import Control.Monad.Error (ErrorT(..), MonadIO, liftIO, throwError)
+import Control.Monad.Error (ErrorT(..))
 import Text.ParserCombinators.Parsec
-import System.Time (getClockTime)
 import Hledger.Data
-import Hledger.Read.Common (LedgerFileCtx,JournalUpdate,emptyCtx,getParentAccount)
-import Hledger.Read.Journal hiding (parseJournal, parseJournalFile)
+import Hledger.Read.Common
+import Hledger.Read.Journal hiding (parseJournal)
 
 
 -- | 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.
 parseJournal :: FilePath -> String -> ErrorT String IO Journal
-parseJournal f s = do
-  tc <- liftIO getClockTime
-  tl <- liftIO getCurrentLocalTime
-  case runParser timelogFile emptyCtx f s of
-    Right m  -> liftM (journalFinalise tc tl f s) $ m `ap` return nulljournal
-    Left err -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ?
+parseJournal = parseJournalWith timelogFile
 
 timelogFile :: GenParser Char LedgerFileCtx JournalUpdate
 timelogFile = do items <- many timelogItem