module Hledger.Read (
defaultJournalPath,
defaultJournal,
readJournal,
readJournal',
readJournalFile,
requireJournalFileExists,
ensureJournalFileExists,
postingp,
accountnamep,
amountp,
amountp',
mamountp',
numberp,
codep,
samplejournal,
tests_Hledger_Read,
)
where
import qualified Control.Exception as C
import Control.Monad.Except
import Data.List
import Data.Maybe
import System.Directory (doesFileExist, getHomeDirectory)
import System.Environment (getEnv)
import System.Exit (exitFailure)
import System.FilePath ((</>))
import System.IO (IOMode(..), withFile, stdin, stderr, hSetNewlineMode, universalNewlineMode)
import Test.HUnit
import Text.Printf
import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.Types
import Hledger.Data.Journal (nullctx)
import Hledger.Read.JournalReader as JournalReader
import Hledger.Read.TimelogReader as TimelogReader
import Hledger.Read.CsvReader as CsvReader
import Hledger.Utils
import Prelude hiding (getContents, writeFile)
import Hledger.Utils.UTF8IOCompat (getContents, hGetContents, writeFile)
journalEnvVar = "LEDGER_FILE"
journalEnvVar2 = "LEDGER"
journalDefaultFilename = ".hledger.journal"
readers :: [Reader]
readers = [
JournalReader.reader
,TimelogReader.reader
,CsvReader.reader
]
defaultJournalPath :: IO String
defaultJournalPath = do
s <- envJournalPath
if null s then defaultJournalPath else return s
where
envJournalPath =
getEnv journalEnvVar
`C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2
`C.catch` (\(_::C.IOException) -> return ""))
defaultJournalPath = do
home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "")
return $ home </> journalDefaultFilename
defaultJournal :: IO Journal
defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return
readJournal' :: String -> IO Journal
readJournal' s = readJournal Nothing Nothing True Nothing s >>= either error' return
tests_readJournal' = [
"readJournal' parses sample journal" ~: do
_ <- samplejournal
assertBool "" True
]
readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> String -> IO (Either String Journal)
readJournal format rulesfile assrt path s =
tryReaders $ readersFor (format, path, s)
where
tryReaders :: [Reader] -> IO (Either String Journal)
tryReaders = firstSuccessOrBestError []
where
firstSuccessOrBestError :: [String] -> [Reader] -> IO (Either String Journal)
firstSuccessOrBestError [] [] = return $ Left "no readers found"
firstSuccessOrBestError errs (r:rs) = do
dbgAtM 1 "trying reader" (rFormat r)
result <- (runExceptT . (rParser r) rulesfile assrt path') s
dbgAtM 1 "reader result" $ either id show result
case result of Right j -> return $ Right j
Left e -> firstSuccessOrBestError (errs++[e]) rs
firstSuccessOrBestError (e:_) [] = return $ Left e
path' = fromMaybe "(string)" path
readersFor :: (Maybe StorageFormat, Maybe FilePath, String) -> [Reader]
readersFor (format,path,s) =
dbg ("possible readers for "++show (format,path,elideRight 30 s)) $
case format of
Just f -> case readerForStorageFormat f of Just r -> [r]
Nothing -> []
Nothing -> case path of Nothing -> readers
Just p -> case readersForPathAndData (p,s) of [] -> readers
rs -> rs
readerForStorageFormat :: StorageFormat -> Maybe Reader
readerForStorageFormat s | null rs = Nothing
| otherwise = Just $ head rs
where
rs = filter ((s==).rFormat) readers :: [Reader]
readersForPathAndData :: (FilePath,String) -> [Reader]
readersForPathAndData (f,s) = filter (\r -> (rDetector r) f s) readers
readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> FilePath -> IO (Either String Journal)
readJournalFile format rulesfile assrt "-" = do
hSetNewlineMode stdin universalNewlineMode
getContents >>= readJournal format rulesfile assrt (Just "-")
readJournalFile format rulesfile assrt f = do
requireJournalFileExists f
withFile f ReadMode $ \h -> do
hSetNewlineMode h universalNewlineMode
hGetContents h >>= readJournal format rulesfile assrt (Just f)
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
hPrintf stderr "Please create it first, eg with \"hledger add\" or a text editor.\n"
hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n"
exitFailure
ensureJournalFileExists :: FilePath -> IO ()
ensureJournalFileExists f = do
exists <- doesFileExist f
when (not exists) $ do
hPrintf stderr "Creating hledger journal file \"%s\".\n" f
newJournalContent >>= writeFile f
newJournalContent :: IO String
newJournalContent = do
d <- getCurrentDay
return $ printf "; journal created %s by hledger\n" (show d)
samplejournal = readJournal' $ unlines
["2008/01/01 income"
," assets:bank:checking $1"
," income:salary"
,""
,"comment"
,"multi line comment here"
,"for testing purposes"
,"end comment"
,""
,"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'
++ [
tests_Hledger_Read_TimelogReader,
tests_Hledger_Read_CsvReader,
"journal" ~: do
r <- runExceptT $ parseWithCtx nullctx JournalReader.journal ""
assertBool "journal should parse an empty file" (isRight $ r)
jE <- readJournal Nothing Nothing True Nothing ""
either error' (assertBool "journal parsing an empty file should give an empty journal" . null . jtxns) jE
]