{-# 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 (def)
import Data.Foldable (asum)
import Data.List (group, sort, sortBy)
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.Semigroup (sconcat)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (Day)
import Safe (headDef)
import System.Directory (doesFileExist, getHomeDirectory)
import System.Environment (getEnv)
import System.Exit (exitFailure)
import System.FilePath ((<.>), (</>), splitDirectories, splitFileName)
import System.Info (os)
import System.IO (stderr, writeFile)
import Text.Printf (hPrintf, printf)
import Hledger.Data.Dates (getCurrentDay, parsedateM, 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
dbg6IO "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 =
fmap (right (maybe def sconcat . nonEmpty) . sequence) . mapM (readJournalFile iopts)
readJournalFile :: InputOpts -> PrefixedFilePath -> IO (Either String Journal)
readJournalFile iopts prefixedfile = do
let
(mfmt, f) = splitReaderPrefix prefixedfile
iopts' = iopts{mformat_=asum [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
parsedate s = maybe (fail $ "could not parse date \"" ++ s ++ "\"") return $
parsedateM s
exists <- doesFileExist latestfile
if exists
then traverse (parsedate . T.unpack . T.strip) . T.lines =<< 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
]