2012-03-30 01:19:35 +04:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2010-05-30 23:11:58 +04:00
|
|
|
{-|
|
|
|
|
|
2012-03-23 20:21:41 +04:00
|
|
|
This is the entry point to hledger's reading system, which can read
|
2012-03-24 22:08:11 +04:00
|
|
|
Journals from various data formats. Use this module if you want to parse
|
|
|
|
journal data or read journal files. Generally it should not be necessary
|
2012-03-23 20:21:41 +04:00
|
|
|
to import modules below this one.
|
2010-05-30 23:11:58 +04:00
|
|
|
|
2009-04-04 12:50:36 +04:00
|
|
|
-}
|
|
|
|
|
2010-05-30 23:11:58 +04:00
|
|
|
module Hledger.Read (
|
2012-03-24 22:08:11 +04:00
|
|
|
-- * Journal reading API
|
2012-03-23 20:21:41 +04:00
|
|
|
defaultJournalPath,
|
|
|
|
defaultJournal,
|
2010-06-25 18:56:48 +04:00
|
|
|
readJournal,
|
2012-04-14 05:10:39 +04:00
|
|
|
readJournal',
|
2012-03-23 20:21:41 +04:00
|
|
|
readJournalFile,
|
|
|
|
requireJournalFileExists,
|
|
|
|
ensureJournalFileExists,
|
2012-03-24 22:08:11 +04:00
|
|
|
-- * Parsers used elsewhere
|
2014-02-06 01:02:24 +04:00
|
|
|
postingp,
|
2014-02-06 06:55:38 +04:00
|
|
|
accountnamep,
|
2012-11-20 01:20:10 +04:00
|
|
|
amountp,
|
|
|
|
amountp',
|
2012-11-20 03:17:55 +04:00
|
|
|
mamountp',
|
2014-02-06 06:55:38 +04:00
|
|
|
numberp,
|
|
|
|
codep,
|
2012-03-23 20:21:41 +04:00
|
|
|
-- * Tests
|
2012-05-27 22:14:20 +04:00
|
|
|
samplejournal,
|
2012-03-23 20:21:41 +04:00
|
|
|
tests_Hledger_Read,
|
2010-05-30 23:11:58 +04:00
|
|
|
)
|
2009-04-04 12:50:36 +04:00
|
|
|
where
|
2012-03-30 01:19:35 +04:00
|
|
|
import qualified Control.Exception as C
|
2009-04-04 12:50:36 +04:00
|
|
|
import Control.Monad.Error
|
2011-05-28 08:11:44 +04:00
|
|
|
import Data.List
|
2012-03-23 20:21:41 +04:00
|
|
|
import Data.Maybe
|
2010-07-13 23:36:43 +04:00
|
|
|
import System.Directory (doesFileExist, getHomeDirectory)
|
2009-04-04 12:50:36 +04:00
|
|
|
import System.Environment (getEnv)
|
2011-09-23 07:53:14 +04:00
|
|
|
import System.Exit (exitFailure)
|
2010-05-30 23:11:58 +04:00
|
|
|
import System.FilePath ((</>))
|
2013-04-13 03:18:20 +04:00
|
|
|
import System.IO (IOMode(..), withFile, stdin, stderr, hSetNewlineMode, universalNewlineMode)
|
2011-05-28 08:11:44 +04:00
|
|
|
import Test.HUnit
|
|
|
|
import Text.Printf
|
2011-01-21 04:24:51 +03:00
|
|
|
|
|
|
|
import Hledger.Data.Dates (getCurrentDay)
|
2012-03-24 05:58:34 +04:00
|
|
|
import Hledger.Data.Types
|
2011-01-21 04:24:51 +03:00
|
|
|
import Hledger.Data.Journal (nullctx)
|
|
|
|
import Hledger.Read.JournalReader as JournalReader
|
|
|
|
import Hledger.Read.TimelogReader as TimelogReader
|
2012-03-11 01:55:48 +04:00
|
|
|
import Hledger.Read.CsvReader as CsvReader
|
2011-05-28 08:11:44 +04:00
|
|
|
import Hledger.Utils
|
2011-09-23 07:53:14 +04:00
|
|
|
import Prelude hiding (getContents, writeFile)
|
2012-03-29 23:06:31 +04:00
|
|
|
import Hledger.Utils.UTF8IOCompat (getContents, hGetContents, writeFile)
|
2009-04-04 12:50:36 +04:00
|
|
|
|
|
|
|
|
2012-03-23 20:21:41 +04:00
|
|
|
journalEnvVar = "LEDGER_FILE"
|
|
|
|
journalEnvVar2 = "LEDGER"
|
|
|
|
journalDefaultFilename = ".hledger.journal"
|
2009-04-04 12:50:36 +04:00
|
|
|
|
2012-03-10 22:13:32 +04:00
|
|
|
-- The available data file readers, each one handling a particular data
|
|
|
|
-- format. The first is also used as the default for unknown formats.
|
2010-06-25 18:56:48 +04:00
|
|
|
readers :: [Reader]
|
|
|
|
readers = [
|
2010-11-15 10:01:46 +03:00
|
|
|
JournalReader.reader
|
|
|
|
,TimelogReader.reader
|
2012-03-23 21:14:24 +04:00
|
|
|
,CsvReader.reader
|
2010-06-25 18:56:48 +04:00
|
|
|
]
|
|
|
|
|
2012-03-10 22:13:32 +04:00
|
|
|
-- | All the data formats we can read.
|
2012-03-23 21:13:30 +04:00
|
|
|
-- formats = map rFormat readers
|
2010-06-25 18:56:48 +04:00
|
|
|
|
2012-03-23 20:21:41 +04:00
|
|
|
-- | 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
|
2012-03-30 01:19:35 +04:00
|
|
|
envJournalPath =
|
|
|
|
getEnv journalEnvVar
|
|
|
|
`C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2
|
|
|
|
`C.catch` (\(_::C.IOException) -> return ""))
|
2012-03-23 20:21:41 +04:00
|
|
|
defaultJournalPath = do
|
2012-03-30 01:19:35 +04:00
|
|
|
home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "")
|
2012-03-23 20:21:41 +04:00
|
|
|
return $ home </> journalDefaultFilename
|
|
|
|
|
|
|
|
-- | Read the default journal file specified by the environment, or raise an error.
|
|
|
|
defaultJournal :: IO Journal
|
2014-07-02 05:26:37 +04:00
|
|
|
defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return
|
2012-03-23 20:21:41 +04:00
|
|
|
|
2012-04-14 05:10:39 +04:00
|
|
|
-- | Read a journal from the given string, trying all known formats, or simply throw an error.
|
|
|
|
readJournal' :: String -> IO Journal
|
2014-07-02 05:26:37 +04:00
|
|
|
readJournal' s = readJournal Nothing Nothing True Nothing s >>= either error' return
|
2012-04-14 05:10:39 +04:00
|
|
|
|
2012-05-27 22:14:20 +04:00
|
|
|
tests_readJournal' = [
|
|
|
|
"readJournal' parses sample journal" ~: do
|
|
|
|
_ <- samplejournal
|
|
|
|
assertBool "" True
|
|
|
|
]
|
|
|
|
|
|
|
|
|
2012-05-28 22:40:36 +04:00
|
|
|
|
|
|
|
-- | Read a journal from this string, trying whatever readers seem appropriate:
|
|
|
|
--
|
|
|
|
-- - if a format is specified, try that reader only
|
|
|
|
--
|
|
|
|
-- - or if one or more readers recognises the file path and data, try those
|
|
|
|
--
|
|
|
|
-- - otherwise, try them all.
|
|
|
|
--
|
|
|
|
-- A CSV conversion rules file may also be specified for use by the CSV reader.
|
2014-07-02 05:26:37 +04:00
|
|
|
-- Also there is a flag specifying whether to check or ignore balance assertions in the journal.
|
|
|
|
readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> String -> IO (Either String Journal)
|
|
|
|
readJournal format rulesfile assrt path s =
|
2012-05-28 22:40:36 +04:00
|
|
|
tryReaders $ readersFor (format, path, s)
|
2012-03-23 21:13:30 +04:00
|
|
|
where
|
2012-05-28 22:40:36 +04:00
|
|
|
-- try each reader in turn, returning the error of the first if all fail
|
|
|
|
tryReaders :: [Reader] -> IO (Either String Journal)
|
|
|
|
tryReaders = firstSuccessOrBestError []
|
2012-03-23 21:13:30 +04:00
|
|
|
where
|
2012-05-28 22:40:36 +04:00
|
|
|
firstSuccessOrBestError :: [String] -> [Reader] -> IO (Either String Journal)
|
|
|
|
firstSuccessOrBestError [] [] = return $ Left "no readers found"
|
|
|
|
firstSuccessOrBestError errs (r:rs) = do
|
2014-05-10 04:55:32 +04:00
|
|
|
dbgAtM 1 "trying reader" (rFormat r)
|
2014-07-02 05:26:37 +04:00
|
|
|
result <- (runErrorT . (rParser r) rulesfile assrt path') s
|
2014-05-10 04:55:32 +04:00
|
|
|
dbgAtM 1 "reader result" $ either id show result
|
2012-05-28 22:40:36 +04:00
|
|
|
case result of Right j -> return $ Right j -- success!
|
|
|
|
Left e -> firstSuccessOrBestError (errs++[e]) rs -- keep trying
|
|
|
|
firstSuccessOrBestError (e:_) [] = return $ Left e -- none left, return first error
|
|
|
|
path' = fromMaybe "(string)" path
|
|
|
|
|
|
|
|
-- | Which readers are worth trying for this (possibly unspecified) format, filepath, and data ?
|
2014-03-03 01:37:10 +04:00
|
|
|
readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader]
|
2012-05-28 22:40:36 +04:00
|
|
|
readersFor (format,path,s) =
|
2014-05-10 04:55:32 +04:00
|
|
|
dbg ("possible readers for "++show (format,path,elideRight 30 s)) $
|
2012-05-28 22:40:36 +04:00
|
|
|
case format of
|
2014-03-03 01:37:10 +04:00
|
|
|
Just f -> case readerForStorageFormat f of Just r -> [r]
|
|
|
|
Nothing -> []
|
2012-05-28 22:40:36 +04:00
|
|
|
Nothing -> case path of Nothing -> readers
|
|
|
|
Just p -> case readersForPathAndData (p,s) of [] -> readers
|
|
|
|
rs -> rs
|
|
|
|
|
|
|
|
-- | Find the (first) reader which can handle the given format, if any.
|
2014-03-03 01:37:10 +04:00
|
|
|
readerForStorageFormat :: StorageFormat -> Maybe Reader
|
|
|
|
readerForStorageFormat s | null rs = Nothing
|
2012-05-28 22:40:36 +04:00
|
|
|
| otherwise = Just $ head rs
|
|
|
|
where
|
|
|
|
rs = filter ((s==).rFormat) readers :: [Reader]
|
|
|
|
|
|
|
|
-- | Find the readers which think they can handle the given file path and data, if any.
|
|
|
|
readersForPathAndData :: (FilePath,String) -> [Reader]
|
|
|
|
readersForPathAndData (f,s) = filter (\r -> (rDetector r) f s) readers
|
2012-03-23 20:21:41 +04:00
|
|
|
|
2012-03-24 22:08:11 +04:00
|
|
|
-- | 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. A CSV conversion rules file may be specified for better
|
2014-07-02 05:26:37 +04:00
|
|
|
-- conversion of that format. Also there is a flag specifying whether
|
|
|
|
-- to check or ignore balance assertions in the journal.
|
|
|
|
readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> FilePath -> IO (Either String Journal)
|
|
|
|
readJournalFile format rulesfile assrt "-" = do
|
2013-04-13 03:18:20 +04:00
|
|
|
hSetNewlineMode stdin universalNewlineMode
|
2014-07-02 05:26:37 +04:00
|
|
|
getContents >>= readJournal format rulesfile assrt (Just "-")
|
|
|
|
readJournalFile format rulesfile assrt f = do
|
2012-03-23 20:21:41 +04:00
|
|
|
requireJournalFileExists f
|
2013-04-13 03:18:20 +04:00
|
|
|
withFile f ReadMode $ \h -> do
|
|
|
|
hSetNewlineMode h universalNewlineMode
|
2014-07-02 05:26:37 +04:00
|
|
|
hGetContents h >>= readJournal format rulesfile assrt (Just f)
|
2010-07-13 23:36:43 +04:00
|
|
|
|
2011-09-23 07:53:14 +04:00
|
|
|
-- | If the specified journal file does not exist, give a helpful error and quit.
|
2012-03-23 20:21:41 +04:00
|
|
|
requireJournalFileExists :: FilePath -> IO ()
|
|
|
|
requireJournalFileExists f = do
|
2011-09-23 07:53:14 +04:00
|
|
|
exists <- doesFileExist f
|
|
|
|
when (not exists) $ do
|
|
|
|
hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f
|
2014-02-12 21:15:21 +04:00
|
|
|
hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"
|
2011-09-23 07:53:14 +04:00
|
|
|
hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n"
|
|
|
|
exitFailure
|
|
|
|
|
|
|
|
-- | Ensure there is a journal file at the given path, creating an empty one if needed.
|
2012-03-23 20:21:41 +04:00
|
|
|
ensureJournalFileExists :: FilePath -> IO ()
|
|
|
|
ensureJournalFileExists f = do
|
2010-07-13 23:36:43 +04:00
|
|
|
exists <- doesFileExist f
|
|
|
|
when (not exists) $ do
|
2011-09-23 07:53:14 +04:00
|
|
|
hPrintf stderr "Creating hledger journal file \"%s\".\n" f
|
2011-09-28 00:55:48 +04:00
|
|
|
-- note Hledger.Utils.UTF8.* do no line ending conversion on windows,
|
|
|
|
-- we currently require unix line endings on all platforms.
|
2011-09-23 07:53:14 +04:00
|
|
|
newJournalContent >>= writeFile f
|
2010-07-13 23:36:43 +04:00
|
|
|
|
|
|
|
-- | Give the content for a new auto-created journal file.
|
2011-09-23 07:53:14 +04:00
|
|
|
newJournalContent :: IO String
|
|
|
|
newJournalContent = do
|
2010-07-13 23:36:43 +04:00
|
|
|
d <- getCurrentDay
|
2011-09-27 00:56:01 +04:00
|
|
|
return $ printf "; journal created %s by hledger\n" (show d)
|
2010-06-25 18:56:48 +04:00
|
|
|
|
2012-05-27 22:14:20 +04:00
|
|
|
-- tests
|
|
|
|
|
|
|
|
samplejournal = readJournal' $ unlines
|
|
|
|
["2008/01/01 income"
|
|
|
|
," assets:bank:checking $1"
|
|
|
|
," income:salary"
|
|
|
|
,""
|
|
|
|
,"2008/06/01 gift"
|
|
|
|
," assets:bank:checking $1"
|
|
|
|
," income:gifts"
|
|
|
|
,""
|
|
|
|
,"2008/06/02 save"
|
|
|
|
," assets:bank:saving $1"
|
|
|
|
," assets:bank:checking"
|
|
|
|
,""
|
|
|
|
,"2008/06/03 * eat & shop"
|
|
|
|
," expenses:food $1"
|
|
|
|
," expenses:supplies $1"
|
|
|
|
," assets:cash"
|
|
|
|
,""
|
|
|
|
,"2008/12/31 * pay off"
|
|
|
|
," liabilities:debts $1"
|
|
|
|
," assets:bank:checking"
|
|
|
|
]
|
|
|
|
|
|
|
|
tests_Hledger_Read = TestList $
|
|
|
|
tests_readJournal'
|
|
|
|
++ [
|
2012-12-06 04:28:23 +04:00
|
|
|
-- tests_Hledger_Read_JournalReader,
|
2010-12-27 23:26:22 +03:00
|
|
|
tests_Hledger_Read_TimelogReader,
|
2012-03-11 01:55:48 +04:00
|
|
|
tests_Hledger_Read_CsvReader,
|
2010-05-30 23:11:58 +04:00
|
|
|
|
2012-05-09 19:34:05 +04:00
|
|
|
"journal" ~: do
|
|
|
|
assertBool "journal should parse an empty file" (isRight $ parseWithCtx nullctx JournalReader.journal "")
|
2014-07-02 05:26:37 +04:00
|
|
|
jE <- readJournal Nothing Nothing True Nothing "" -- don't know how to get it from journal
|
2012-05-09 19:34:05 +04:00
|
|
|
either error' (assertBool "journal parsing an empty file should give an empty journal" . null . jtxns) jE
|
2010-05-30 23:11:58 +04:00
|
|
|
|
|
|
|
]
|