module Hledger.Read (
PrefixedFilePath,
defaultJournal,
defaultJournalPath,
readJournalFiles,
readJournalFile,
requireJournalFileExists,
ensureJournalFileExists,
splitReaderPrefix,
readJournal,
readJournal',
JournalReader.accountaliasp,
JournalReader.postingp,
module Hledger.Read.Common,
samplejournal,
tests_Hledger_Read,
) where
import Control.Applicative ((<|>))
import Control.Arrow (right)
import qualified Control.Exception as C
import Control.Monad.Except
import Data.List
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Safe
import System.Directory (doesFileExist, getHomeDirectory)
import System.Environment (getEnv)
import System.Exit (exitFailure)
import System.FilePath ((</>), takeExtension)
import System.IO (stderr)
import Test.HUnit
import Text.Printf
import Hledger.Data.Dates (getCurrentDay)
import Hledger.Data.Types
import Hledger.Read.Common
import qualified Hledger.Read.JournalReader as JournalReader
import qualified Hledger.Read.TimedotReader as TimedotReader
import qualified Hledger.Read.TimeclockReader as TimeclockReader
import qualified Hledger.Read.CsvReader as CsvReader
import Hledger.Utils
import Prelude hiding (getContents, writeFile)
import Hledger.Utils.UTF8IOCompat (writeFile)
journalEnvVar = "LEDGER_FILE"
journalEnvVar2 = "LEDGER"
journalDefaultFilename = ".hledger.journal"
readers :: [Reader]
readers = [
JournalReader.reader
,TimeclockReader.reader
,TimedotReader.reader
,CsvReader.reader
]
readerNames :: [String]
readerNames = map rFormat readers
type PrefixedFilePath = FilePath
defaultJournal :: IO Journal
defaultJournal = defaultJournalPath >>= readJournalFile Nothing Nothing True >>= either error' return
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
readJournalFiles :: Maybe StorageFormat -> Maybe FilePath -> Bool -> [PrefixedFilePath] -> IO (Either String Journal)
readJournalFiles mformat mrulesfile assrt prefixedfiles = do
(right mconcat1 . sequence)
<$> mapM (readJournalFile mformat mrulesfile assrt) prefixedfiles
where mconcat1 :: Monoid t => [t] -> t
mconcat1 [] = mempty
mconcat1 x = foldr1 mappend x
readJournalFile :: Maybe StorageFormat -> Maybe FilePath -> Bool -> PrefixedFilePath -> IO (Either String Journal)
readJournalFile mformat mrulesfile assrt prefixedfile = do
let
(mprefixformat, f) = splitReaderPrefix prefixedfile
mfmt = mformat <|> mprefixformat
requireJournalFileExists f
readFileOrStdinAnyLineEnding f >>= readJournal mfmt mrulesfile assrt (Just f)
splitReaderPrefix :: PrefixedFilePath -> (Maybe String, FilePath)
splitReaderPrefix f =
headDef (Nothing, f)
[(Just r, drop (length r + 1) f) | r <- readerNames, (r++":") `isPrefixOf` f]
requireJournalFileExists :: FilePath -> IO ()
requireJournalFileExists "-" = return ()
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)
readJournal' :: Text -> IO Journal
readJournal' t = readJournal Nothing Nothing True Nothing t >>= either error' return
tests_readJournal' = [
"readJournal' parses sample journal" ~: do
_ <- samplejournal
assertBool "" True
]
readJournal :: Maybe StorageFormat -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
readJournal mformat mrulesfile assrt mfile txt =
let
stablereaders = filter (not.rExperimental) readers
rs = maybe stablereaders (:[]) $ findReader mformat mfile
in
tryReaders rs mrulesfile assrt mfile txt
findReader :: Maybe StorageFormat -> Maybe FilePath -> Maybe Reader
findReader Nothing Nothing = Nothing
findReader (Just fmt) _ = headMay [r | r <- readers, rFormat r == fmt]
findReader Nothing (Just path) =
case prefix of
Just fmt -> headMay [r | r <- readers, rFormat r == fmt]
Nothing -> headMay [r | r <- readers, ext `elem` rExtensions r]
where
(prefix,path') = splitReaderPrefix path
ext = drop 1 $ takeExtension path'
tryReaders :: [Reader] -> Maybe FilePath -> Bool -> Maybe FilePath -> Text -> IO (Either String Journal)
tryReaders readers mrulesfile assrt path t = firstSuccessOrFirstError [] readers
where
firstSuccessOrFirstError :: [String] -> [Reader] -> IO (Either String Journal)
firstSuccessOrFirstError [] [] = return $ Left "no readers found"
firstSuccessOrFirstError errs (r:rs) = do
dbg1IO "trying reader" (rFormat r)
result <- (runExceptT . (rParser r) mrulesfile assrt path') t
dbg1IO "reader result" $ either id show result
case result of Right j -> return $ Right j
Left e -> firstSuccessOrFirstError (errs++[e]) rs
firstSuccessOrFirstError (e:_) [] = return $ Left e
path' = fromMaybe "(string)" path
samplejournal = readJournal' $ T.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'
++ [
JournalReader.tests_Hledger_Read_JournalReader,
TimeclockReader.tests_Hledger_Read_TimeclockReader,
TimedotReader.tests_Hledger_Read_TimedotReader,
CsvReader.tests_Hledger_Read_CsvReader,
"journal" ~: do
r <- runExceptT $ parseWithState mempty JournalReader.journalp ""
assertBool "journalp should parse an empty file" (isRight $ r)
jE <- readJournal Nothing Nothing True Nothing ""
either error' (assertBool "journalp parsing an empty file should give an empty journal" . null . jtxns) jE
]