{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
module Hledger.Read (
PrefixedFilePath,
defaultJournal,
defaultJournalPath,
readJournalFiles,
readJournalFile,
requireJournalFileExists,
ensureJournalFileExists,
splitReaderPrefix,
readJournal,
readJournal',
JournalReader.postingp,
module Hledger.Read.Common,
samplejournal,
tests_Hledger_Read,
) where
import Control.Arrow (right)
import qualified Control.Exception as C
import Control.Monad.Except
import Data.Default
import Data.List
import Data.Maybe
import Data.Ord
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (Day)
import Safe
import System.Directory (doesFileExist, getHomeDirectory)
import System.Environment (getEnv)
import System.Exit (exitFailure)
import System.FilePath
import System.IO
import Test.HUnit
import Text.Printf
import Hledger.Data.Dates (getCurrentDay, parsedate, showDate)
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)
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 def >>= 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
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 def Nothing t >>= either error' return
tests_readJournal' = [
"readJournal' parses sample journal" ~: do
_ <- samplejournal
assertBool "" True
]
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'
readJournalFiles :: InputOpts -> [FilePath] -> IO (Either String Journal)
readJournalFiles iopts =
(right mconcat1 . sequence <$>) . mapM (readJournalFile iopts)
where
mconcat1 :: Monoid t => [t] -> t
mconcat1 [] = mempty
mconcat1 x = foldr1 mappend x
readJournalFile :: InputOpts -> PrefixedFilePath -> IO (Either String Journal)
readJournalFile iopts prefixedfile = do
let
(mfmt, f) = splitReaderPrefix prefixedfile
iopts' = iopts{mformat_=firstJust [mfmt, mformat_ iopts]}
requireJournalFileExists f
t <- readFileOrStdinPortably f
ej <- readJournal iopts' (Just f) t
case ej of
Left e -> return $ Left e
Right j | new_ iopts -> do
ds <- previousLatestDates f
let (newj, newds) = journalFilterSinceLatestDates ds j
when (new_save_ iopts && not (null newds)) $ saveLatestDates newds f
return $ Right newj
Right j -> return $ Right j
type LatestDates = [Day]
latestDates :: [Day] -> LatestDates
latestDates = headDef [] . take 1 . group . reverse . sort
saveLatestDates :: LatestDates -> FilePath -> IO ()
saveLatestDates dates f = writeFile (latestDatesFileFor f) $ unlines $ map showDate dates
previousLatestDates :: FilePath -> IO LatestDates
previousLatestDates f = do
let latestfile = latestDatesFileFor f
exists <- doesFileExist latestfile
if exists
then map (parsedate . strip) . lines . strip . T.unpack <$> readFileStrictly latestfile
else return []
latestDatesFileFor :: FilePath -> FilePath
latestDatesFileFor f = dir </> ".latest" <.> fname
where
(dir, fname) = splitFileName f
readFileStrictly :: FilePath -> IO Text
readFileStrictly f = readFilePortably f >>= \t -> C.evaluate (T.length t) >> return t
journalFilterSinceLatestDates :: LatestDates -> Journal -> (Journal, LatestDates)
journalFilterSinceLatestDates [] j = (j, latestDates $ map tdate $ jtxns j)
journalFilterSinceLatestDates ds@(d:_) j = (j', ds')
where
samedateorlaterts = filter ((>= d).tdate) $ jtxns j
(samedatets, laterts) = span ((== d).tdate) $ sortBy (comparing tdate) samedateorlaterts
newsamedatets = drop (length ds) samedatets
j' = j{jtxns=newsamedatets++laterts}
ds' = latestDates $ map tdate $ samedatets++laterts
readJournal :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal)
readJournal iopts mfile txt =
tryReaders iopts mfile specifiedorallreaders txt
where
specifiedorallreaders = maybe stablereaders (:[]) $ findReader (mformat_ iopts) mfile
stablereaders = filter (not.rExperimental) readers
tryReaders :: InputOpts -> Maybe FilePath -> [Reader] -> Text -> IO (Either String Journal)
tryReaders iopts mpath readers txt = 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) iopts path) txt
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)" mpath
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 def Nothing ""
either error' (assertBool "journalp parsing an empty file should give an empty journal" . null . jtxns) jE
]