{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Read (
PrefixedFilePath,
defaultJournal,
defaultJournalPath,
readJournalFiles,
readJournalFile,
requireJournalFileExists,
ensureJournalFileExists,
readJournal,
readJournal',
JournalReader.accountaliasp,
JournalReader.postingp,
findReader,
splitReaderPrefix,
module Hledger.Read.Common,
tests_Read,
) where
import Control.Arrow (right)
import qualified Control.Exception as C
import Control.Monad (when)
import "mtl" Control.Monad.Except (runExceptT)
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.Info (os)
import System.IO
import Text.Printf
import Hledger.Data.Dates (getCurrentDay, parsedate, showDate)
import Hledger.Data.Types
import Hledger.Read.Common
import Hledger.Read.JournalReader as JournalReader
import Hledger.Read.CsvReader (tests_CsvReader)
import Hledger.Utils
import Prelude hiding (getContents, writeFile)
journalEnvVar = "LEDGER_FILE"
journalEnvVar2 = "LEDGER"
journalDefaultFilename = ".hledger.journal"
readJournal' :: Text -> IO Journal
readJournal' t = readJournal def Nothing t >>= either error' return
readJournal :: InputOpts -> Maybe FilePath -> Text -> IO (Either String Journal)
readJournal iopts mpath txt = do
let r :: Reader IO =
fromMaybe JournalReader.reader $ findReader (mformat_ iopts) mpath
dbg1IO "trying reader" (rFormat r)
(runExceptT . (rReadFn r) iopts (fromMaybe "(string)" mpath)) txt
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
type PrefixedFilePath = FilePath
readJournalFiles :: InputOpts -> [PrefixedFilePath] -> 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
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
when (os/="mingw32" && isWindowsUnsafeDotPath f) $ do
hPrintf stderr "Part of file path %s\n ends with a dot, which is unsafe on Windows; please use a different path.\n" (show f)
exitFailure
exists <- doesFileExist f
when (not exists) $ do
hPrintf stderr "Creating hledger journal file %s.\n" f
newJournalContent >>= writeFile f
isWindowsUnsafeDotPath :: FilePath -> Bool
isWindowsUnsafeDotPath =
not . null .
filter (not . all (=='.')) .
filter ((=='.').last) .
splitDirectories
newJournalContent :: IO String
newJournalContent = do
d <- getCurrentDay
return $ printf "; journal created %s by hledger\n" (show d)
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
tests_Read = tests "Read" [
tests_Common
,tests_CsvReader
,tests_JournalReader
]