{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Hledger.Read (
PrefixedFilePath,
defaultJournal,
defaultJournalWith,
defaultJournalSafely,
defaultJournalSafelyWith,
defaultJournalPath,
requireJournalFileExists,
ensureJournalFileExists,
journalEnvVar,
journalDefaultFilename,
runExceptT,
readJournal,
readJournalFile,
readJournalFiles,
readJournalFilesAndLatestDates,
readJournal',
readJournal'',
readJournalFile',
readJournalFiles',
orDieTrying,
saveLatestDates,
saveLatestDatesForFiles,
isWindowsUnsafeDotPath,
JournalReader.tmpostingrulep,
findReader,
splitReaderPrefix,
runJournalParser,
module Hledger.Read.Common,
module Hledger.Read.InputOptions,
tests_Read,
) where
import qualified Control.Exception as C
import Control.Monad (unless, when, forM, (<=<))
import "mtl" Control.Monad.Except (ExceptT(..), runExceptT, liftEither)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Default (def)
import Data.Foldable (asum)
import Data.List (group, sort, sortBy)
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Ord (comparing)
import Data.Semigroup (sconcat)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time (Day)
import Safe (headDef, headMay)
import System.Directory (doesFileExist)
import System.Environment (getEnv)
import System.FilePath ((<.>), (</>), splitDirectories, splitFileName, takeFileName)
import System.Info (os)
import System.IO (Handle, hPutStrLn, stderr)
import Hledger.Data.Dates (getCurrentDay, parsedate, showDate)
import Hledger.Data.Types
import Hledger.Read.Common
import Hledger.Read.InputOptions
import Hledger.Read.JournalReader as JournalReader
import Hledger.Read.CsvReader (tests_CsvReader)
import Hledger.Read.RulesReader (tests_RulesReader)
import Hledger.Utils
import Prelude hiding (getContents, writeFile)
import Hledger.Data.JournalChecks (journalStrictChecks)
import Text.Printf (printf)
journalEnvVar :: String
journalEnvVar = String
"LEDGER_FILE"
journalEnvVar2 :: String
journalEnvVar2 = String
"LEDGER"
journalDefaultFilename :: String
journalDefaultFilename = String
".hledger.journal"
defaultJournal :: IO Journal
defaultJournal :: IO Journal
defaultJournal = IO (Either String Journal)
defaultJournalSafely IO (Either String Journal)
-> (Either String Journal -> IO Journal) -> IO Journal
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Journal)
-> (Journal -> IO Journal) -> Either String Journal -> IO Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Journal
forall a. String -> a
error' Journal -> IO Journal
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
defaultJournalWith :: InputOpts -> IO Journal
defaultJournalWith :: InputOpts -> IO Journal
defaultJournalWith InputOpts
iopts = InputOpts -> IO (Either String Journal)
defaultJournalSafelyWith InputOpts
iopts IO (Either String Journal)
-> (Either String Journal -> IO Journal) -> IO Journal
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Journal)
-> (Journal -> IO Journal) -> Either String Journal -> IO Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO Journal
forall a. String -> a
error' Journal -> IO Journal
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
defaultJournalSafely :: IO (Either String Journal)
defaultJournalSafely :: IO (Either String Journal)
defaultJournalSafely = InputOpts -> IO (Either String Journal)
defaultJournalSafelyWith InputOpts
definputopts
defaultJournalSafelyWith :: InputOpts -> IO (Either String Journal)
defaultJournalSafelyWith :: InputOpts -> IO (Either String Journal)
defaultJournalSafelyWith InputOpts
iopts = (do
f <- IO String
defaultJournalPath
runExceptT $ readJournalFile iopts f
) IO (Either String Journal)
-> [Handler (Either String Journal)] -> IO (Either String Journal)
forall a. IO a -> [Handler a] -> IO a
`C.catches` [
(ErrorCall -> IO (Either String Journal))
-> Handler (Either String Journal)
forall a e. Exception e => (e -> IO a) -> Handler a
C.Handler (\(ErrorCall
e :: C.ErrorCall) -> Either String Journal -> IO (Either String Journal)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Journal -> IO (Either String Journal))
-> Either String Journal -> IO (Either String Journal)
forall a b. (a -> b) -> a -> b
$ String -> Either String Journal
forall a b. a -> Either a b
Left (String -> Either String Journal)
-> String -> Either String Journal
forall a b. (a -> b) -> a -> b
$ ErrorCall -> String
forall a. Show a => a -> String
show ErrorCall
e)
,(IOException -> IO (Either String Journal))
-> Handler (Either String Journal)
forall a e. Exception e => (e -> IO a) -> Handler a
C.Handler (\(IOException
e :: C.IOException) -> Either String Journal -> IO (Either String Journal)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Journal -> IO (Either String Journal))
-> Either String Journal -> IO (Either String Journal)
forall a b. (a -> b) -> a -> b
$ String -> Either String Journal
forall a b. a -> Either a b
Left (String -> Either String Journal)
-> String -> Either String Journal
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show IOException
e)
]
defaultJournalPath :: IO String
defaultJournalPath :: IO String
defaultJournalPath = do
p <- IO String
envJournalPath
if null p
then defpath
else do
ps <- expandGlob "." p `C.catch` (\(IOException
_::C.IOException) -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
maybe defpath return $ headMay ps
where
envJournalPath :: IO String
envJournalPath =
String -> IO String
getEnv String
journalEnvVar
IO String -> (IOException -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` (\(IOException
_::C.IOException) -> String -> IO String
getEnv String
journalEnvVar2
IO String -> (IOException -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` (\(IOException
_::C.IOException) -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""))
defpath :: IO String
defpath = do
home <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe String)
getHomeSafe
return $ home </> journalDefaultFilename
type PrefixedFilePath = FilePath
readJournal :: InputOpts -> Maybe FilePath -> Handle -> ExceptT String IO Journal
readJournal :: InputOpts -> Maybe String -> Handle -> ExceptT String IO Journal
readJournal iopts :: InputOpts
iopts@InputOpts{Bool
strict_ :: Bool
strict_ :: InputOpts -> Bool
strict_, Bool
_defer :: Bool
_defer :: InputOpts -> Bool
_defer} Maybe String
mpath Handle
hdl = do
let Reader IO
r :: Reader IO = Reader IO -> Maybe (Reader IO) -> Reader IO
forall a. a -> Maybe a -> a
fromMaybe Reader IO
forall (m :: * -> *). MonadIO m => Reader m
JournalReader.reader (Maybe (Reader IO) -> Reader IO) -> Maybe (Reader IO) -> Reader IO
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat -> Maybe String -> Maybe (Reader IO)
forall (m :: * -> *).
MonadIO m =>
Maybe StorageFormat -> Maybe String -> Maybe (Reader m)
findReader (InputOpts -> Maybe StorageFormat
mformat_ InputOpts
iopts) Maybe String
mpath
String -> StorageFormat -> ExceptT String IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"readJournal: trying reader" (Reader IO -> StorageFormat
forall (m :: * -> *). Reader m -> StorageFormat
rFormat Reader IO
r)
j <- Reader IO
-> InputOpts -> String -> Handle -> ExceptT String IO Journal
forall (m :: * -> *).
Reader m
-> InputOpts -> String -> Handle -> ExceptT String IO Journal
rReadFn Reader IO
r InputOpts
iopts (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"-" Maybe String
mpath) Handle
hdl
when (strict_ && not _defer) $ liftEither $ journalStrictChecks j
return j
readJournalFile :: InputOpts -> PrefixedFilePath -> ExceptT String IO Journal
readJournalFile :: InputOpts -> String -> ExceptT String IO Journal
readJournalFile iopts :: InputOpts
iopts@InputOpts{Bool
new_ :: Bool
new_ :: InputOpts -> Bool
new_, Bool
new_save_ :: Bool
new_save_ :: InputOpts -> Bool
new_save_, Bool
_defer :: InputOpts -> Bool
_defer :: Bool
_defer} String
prefixedfile = do
(j, mlatestdates) <- InputOpts
-> String -> ExceptT String IO (Journal, Maybe LatestDatesForFile)
readJournalFileAndLatestDates InputOpts
iopts String
prefixedfile
when (new_ && new_save_ && not _defer) $ liftIO $
case mlatestdates of
Maybe LatestDatesForFile
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (LatestDatesForFile String
f LatestDates
ds) -> LatestDates -> String -> IO ()
saveLatestDates LatestDates
ds String
f
return j
readJournalFileAndLatestDates :: InputOpts -> PrefixedFilePath -> ExceptT String IO (Journal, Maybe LatestDatesForFile)
readJournalFileAndLatestDates :: InputOpts
-> String -> ExceptT String IO (Journal, Maybe LatestDatesForFile)
readJournalFileAndLatestDates InputOpts
iopts String
prefixedfile = do
let
(Maybe StorageFormat
mfmt, String
f) = String -> (Maybe StorageFormat, String)
splitReaderPrefix String
prefixedfile
iopts' :: InputOpts
iopts' = InputOpts
iopts{mformat_=asum [mfmt, mformat_ iopts]}
IO () -> ExceptT String IO ()
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT String IO ()) -> IO () -> ExceptT String IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
requireJournalFileExists String
f
h <-
String -> ExceptT String IO Handle -> ExceptT String IO Handle
forall a. String -> a -> a
dbg6Msg (String
"readJournalFile: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
takeFileName String
f) (ExceptT String IO Handle -> ExceptT String IO Handle)
-> ExceptT String IO Handle -> ExceptT String IO Handle
forall a b. (a -> b) -> a -> b
$
IO Handle -> ExceptT String IO Handle
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> ExceptT String IO Handle)
-> IO Handle -> ExceptT String IO Handle
forall a b. (a -> b) -> a -> b
$ String -> IO Handle
openFileOrStdin String
f
j <- readJournal iopts' (Just f) h
if new_ iopts
then do
ds <- liftIO $ previousLatestDates f
let (newj, newds) = journalFilterSinceLatestDates ds j
return (newj, Just $ LatestDatesForFile f newds)
else
return (j, Nothing)
readJournalFiles :: InputOpts -> [PrefixedFilePath] -> ExceptT String IO Journal
readJournalFiles :: InputOpts -> [String] -> ExceptT String IO Journal
readJournalFiles iopts :: InputOpts
iopts@InputOpts{Bool
strict_ :: InputOpts -> Bool
strict_ :: Bool
strict_, Bool
new_ :: InputOpts -> Bool
new_ :: Bool
new_, Bool
new_save_ :: InputOpts -> Bool
new_save_ :: Bool
new_save_} [String]
prefixedfiles = do
let iopts' :: InputOpts
iopts' = InputOpts
iopts{_defer=True}
(j, latestdatesforfiles) <-
String
-> ExceptT String IO (Journal, [LatestDatesForFile])
-> ExceptT String IO (Journal, [LatestDatesForFile])
forall a. String -> a -> a
dbg6Msg (String
"readJournalFiles: "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show [String]
prefixedfiles) (ExceptT String IO (Journal, [LatestDatesForFile])
-> ExceptT String IO (Journal, [LatestDatesForFile]))
-> ExceptT String IO (Journal, [LatestDatesForFile])
-> ExceptT String IO (Journal, [LatestDatesForFile])
forall a b. (a -> b) -> a -> b
$
InputOpts
-> [String] -> ExceptT String IO (Journal, [LatestDatesForFile])
readJournalFilesAndLatestDates InputOpts
iopts' [String]
prefixedfiles
when strict_ $ liftEither $ journalStrictChecks j
when (new_ && new_save_) $ liftIO $ saveLatestDatesForFiles latestdatesforfiles
return j
readJournalFilesAndLatestDates :: InputOpts -> [PrefixedFilePath] -> ExceptT String IO (Journal, [LatestDatesForFile])
readJournalFilesAndLatestDates :: InputOpts
-> [String] -> ExceptT String IO (Journal, [LatestDatesForFile])
readJournalFilesAndLatestDates InputOpts
iopts [String]
pfs = do
(js, lastdates) <- [(Journal, Maybe LatestDatesForFile)]
-> ([Journal], [Maybe LatestDatesForFile])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Journal, Maybe LatestDatesForFile)]
-> ([Journal], [Maybe LatestDatesForFile]))
-> ExceptT String IO [(Journal, Maybe LatestDatesForFile)]
-> ExceptT String IO ([Journal], [Maybe LatestDatesForFile])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ExceptT String IO (Journal, Maybe LatestDatesForFile))
-> [String]
-> ExceptT String IO [(Journal, Maybe LatestDatesForFile)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (InputOpts
-> String -> ExceptT String IO (Journal, Maybe LatestDatesForFile)
readJournalFileAndLatestDates InputOpts
iopts) [String]
pfs
return (maybe def sconcat $ nonEmpty js, catMaybes lastdates)
readJournal' :: Handle -> IO Journal
readJournal' :: Handle -> IO Journal
readJournal' = ExceptT String IO Journal -> IO Journal
forall (m :: * -> *) a. MonadIO m => ExceptT String m a -> m a
orDieTrying (ExceptT String IO Journal -> IO Journal)
-> (Handle -> ExceptT String IO Journal) -> Handle -> IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> Maybe String -> Handle -> ExceptT String IO Journal
readJournal InputOpts
definputopts Maybe String
forall a. Maybe a
Nothing
readJournal'' :: Text -> IO Journal
readJournal'' :: Text -> IO Journal
readJournal'' = Handle -> IO Journal
readJournal' (Handle -> IO Journal) -> (Text -> IO Handle) -> Text -> IO Journal
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> IO Handle
inputToHandle
readJournalFile' :: PrefixedFilePath -> IO Journal
readJournalFile' :: String -> IO Journal
readJournalFile' = ExceptT String IO Journal -> IO Journal
forall (m :: * -> *) a. MonadIO m => ExceptT String m a -> m a
orDieTrying (ExceptT String IO Journal -> IO Journal)
-> (String -> ExceptT String IO Journal) -> String -> IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> String -> ExceptT String IO Journal
readJournalFile InputOpts
definputopts
readJournalFiles' :: [PrefixedFilePath] -> IO Journal
readJournalFiles' :: [String] -> IO Journal
readJournalFiles' = ExceptT String IO Journal -> IO Journal
forall (m :: * -> *) a. MonadIO m => ExceptT String m a -> m a
orDieTrying (ExceptT String IO Journal -> IO Journal)
-> ([String] -> ExceptT String IO Journal)
-> [String]
-> IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> [String] -> ExceptT String IO Journal
readJournalFiles InputOpts
definputopts
orDieTrying :: MonadIO m => ExceptT String m a -> m a
orDieTrying :: forall (m :: * -> *) a. MonadIO m => ExceptT String m a -> m a
orDieTrying ExceptT String m a
a = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (String -> IO a) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO a
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail) a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> m a) -> m (Either String a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptT String m a -> m (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT String m a
a
requireJournalFileExists :: FilePath -> IO ()
requireJournalFileExists :: String -> IO ()
requireJournalFileExists String
"-" = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
requireJournalFileExists String
f = do
exists <- String -> IO Bool
doesFileExist String
f
unless exists $ error' $ unlines
[ "data file \"" <> f <> "\" was not found."
,"Please create it first, eg with \"hledger add\" or a text editor."
,"Or, specify an existing data file with -f or $LEDGER_FILE."
]
ensureJournalFileExists :: FilePath -> IO ()
ensureJournalFileExists :: String -> IO ()
ensureJournalFileExists String
f = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
osString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"mingw32" Bool -> Bool -> Bool
&& String -> Bool
isWindowsUnsafeDotPath String
f) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall a. String -> a
error' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Part of file path \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\"\n ends with a dot, which is unsafe on Windows; please use a different path.\n"
exists <- String -> IO Bool
doesFileExist String
f
unless exists $ do
hPutStrLn stderr $ "Creating hledger journal file " <> show f
newJournalContent >>= T.writeFile f
isWindowsUnsafeDotPath :: FilePath -> Bool
isWindowsUnsafeDotPath :: String -> Bool
isWindowsUnsafeDotPath = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
x -> String -> Char
forall a. HasCallStack => [a] -> a
last String
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'.') String
x) ([String] -> Bool) -> (String -> [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories
newJournalContent :: IO Text
newJournalContent :: IO Text
newJournalContent = do
d <- IO Day
getCurrentDay
return $ "; journal created " <> T.pack (show d) <> " by hledger\n"
type LatestDates = [Day]
data LatestDatesForFile = LatestDatesForFile FilePath LatestDates
latestDates :: [Day] -> LatestDates
latestDates :: LatestDates -> LatestDates
latestDates = {-# HLINT ignore "Avoid reverse" #-}
LatestDates -> [LatestDates] -> LatestDates
forall a. a -> [a] -> a
headDef [] ([LatestDates] -> LatestDates)
-> (LatestDates -> [LatestDates]) -> LatestDates -> LatestDates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [LatestDates] -> [LatestDates]
forall a. Int -> [a] -> [a]
take Int
1 ([LatestDates] -> [LatestDates])
-> (LatestDates -> [LatestDates]) -> LatestDates -> [LatestDates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LatestDates -> [LatestDates]
forall a. Eq a => [a] -> [[a]]
group (LatestDates -> [LatestDates])
-> (LatestDates -> LatestDates) -> LatestDates -> [LatestDates]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LatestDates -> LatestDates
forall a. [a] -> [a]
reverse (LatestDates -> LatestDates)
-> (LatestDates -> LatestDates) -> LatestDates -> LatestDates
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LatestDates -> LatestDates
forall a. Ord a => [a] -> [a]
sort
saveLatestDates :: LatestDates -> FilePath -> IO ()
saveLatestDates :: LatestDates -> String -> IO ()
saveLatestDates LatestDates
dates String
f = String -> Text -> IO ()
T.writeFile (String -> String
latestDatesFileFor String
f) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Day -> Text) -> LatestDates -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Day -> Text
showDate LatestDates
dates
saveLatestDatesForFiles :: [LatestDatesForFile] -> IO ()
saveLatestDatesForFiles :: [LatestDatesForFile] -> IO ()
saveLatestDatesForFiles = (LatestDatesForFile -> IO ()) -> [LatestDatesForFile] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(LatestDatesForFile String
f LatestDates
ds) -> LatestDates -> String -> IO ()
saveLatestDates LatestDates
ds String
f)
previousLatestDates :: FilePath -> IO LatestDates
previousLatestDates :: String -> IO LatestDates
previousLatestDates String
f = do
let latestfile :: String
latestfile = String -> String
latestDatesFileFor String
f
exists <- String -> IO Bool
doesFileExist String
latestfile
t <- if exists then readFileStrictly latestfile else return T.empty
let nls = [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1::Int ..] ([Text] -> [(Int, Text)]) -> [Text] -> [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
t
fmap catMaybes $ forM nls $ \(Int
n,Text
l) -> do
let s :: String
s = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
l
case (String
s, String -> Maybe Day
parsedate String
s) of
(String
"", Maybe Day
_) -> Maybe Day -> IO (Maybe Day)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Day
forall a. Maybe a
Nothing
(String
_, Maybe Day
Nothing) -> String -> IO (Maybe Day)
forall a. String -> a
error' (String -> String -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s:%d: invalid date: \"%s\"" String
latestfile Int
n String
s)
(String
_, Just Day
d) -> Maybe Day -> IO (Maybe Day)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Day -> IO (Maybe Day)) -> Maybe Day -> IO (Maybe Day)
forall a b. (a -> b) -> a -> b
$ Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
latestDatesFileFor :: FilePath -> FilePath
latestDatesFileFor :: String -> String
latestDatesFileFor String
f = String
dir String -> String -> String
</> String
".latest" String -> String -> String
<.> String
fname
where
(String
dir, String
fname) = String -> (String, String)
splitFileName String
f
journalFilterSinceLatestDates :: LatestDates -> Journal -> (Journal, LatestDates)
journalFilterSinceLatestDates :: LatestDates -> Journal -> (Journal, LatestDates)
journalFilterSinceLatestDates [] Journal
j = (Journal
j, LatestDates -> LatestDates
latestDates (LatestDates -> LatestDates) -> LatestDates -> LatestDates
forall a b. (a -> b) -> a -> b
$ (Transaction -> Day) -> [Transaction] -> LatestDates
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate ([Transaction] -> LatestDates) -> [Transaction] -> LatestDates
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j)
journalFilterSinceLatestDates ds :: LatestDates
ds@(Day
d:LatestDates
_) Journal
j = (Journal
j', LatestDates
ds')
where
samedateorlaterts :: [Transaction]
samedateorlaterts = (Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
d)(Day -> Bool) -> (Transaction -> Day) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> Day
tdate) ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
([Transaction]
samedatets, [Transaction]
laterts) = (Transaction -> Bool)
-> [Transaction] -> ([Transaction], [Transaction])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
== Day
d)(Day -> Bool) -> (Transaction -> Day) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> Day
tdate) ([Transaction] -> ([Transaction], [Transaction]))
-> [Transaction] -> ([Transaction], [Transaction])
forall a b. (a -> b) -> a -> b
$ (Transaction -> Transaction -> Ordering)
-> [Transaction] -> [Transaction]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Transaction -> Day) -> Transaction -> Transaction -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Transaction -> Day
tdate) [Transaction]
samedateorlaterts
newsamedatets :: [Transaction]
newsamedatets = Int -> [Transaction] -> [Transaction]
forall a. Int -> [a] -> [a]
drop (LatestDates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length LatestDates
ds) [Transaction]
samedatets
j' :: Journal
j' = Journal
j{jtxns=newsamedatets++laterts}
ds' :: LatestDates
ds' = LatestDates -> LatestDates
latestDates (LatestDates -> LatestDates) -> LatestDates -> LatestDates
forall a b. (a -> b) -> a -> b
$ (Transaction -> Day) -> [Transaction] -> LatestDates
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate ([Transaction] -> LatestDates) -> [Transaction] -> LatestDates
forall a b. (a -> b) -> a -> b
$ [Transaction]
samedatets[Transaction] -> [Transaction] -> [Transaction]
forall a. [a] -> [a] -> [a]
++[Transaction]
laterts
tests_Read :: TestTree
tests_Read = String -> [TestTree] -> TestTree
testGroup String
"Read" [
TestTree
tests_Common
,TestTree
tests_CsvReader
,TestTree
tests_JournalReader
,TestTree
tests_RulesReader
]