{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Read (
PrefixedFilePath,
defaultJournal,
defaultJournalPath,
requireJournalFileExists,
ensureJournalFileExists,
readJournal,
readJournalFile,
readJournalFiles,
runExceptT,
readJournal',
readJournalFile',
readJournalFiles',
orDieTrying,
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)
import "mtl" Control.Monad.Except (ExceptT(..), runExceptT)
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 (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)
import System.Directory (doesFileExist, getHomeDirectory)
import System.Environment (getEnv)
import System.Exit (exitFailure)
import System.FilePath ((<.>), (</>), splitDirectories, splitFileName, takeFileName)
import System.Info (os)
import System.IO (hPutStr, stderr)
import Hledger.Data.Dates (getCurrentDay, parsedateM, 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)
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 String
defaultJournalPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> String -> ExceptT String IO Journal
readJournalFile InputOpts
definputopts forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> a
error' forall (m :: * -> *) a. Monad m => a -> m a
return
defaultJournalPath :: IO String
defaultJournalPath :: IO String
defaultJournalPath = do
String
s <- IO String
envJournalPath
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then IO String
defpath else forall (m :: * -> *) a. Monad m => a -> m a
return String
s
where
envJournalPath :: IO String
envJournalPath =
String -> IO String
getEnv String
journalEnvVar
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` (\(IOException
_::C.IOException) -> String -> IO String
getEnv String
journalEnvVar2
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` (\(IOException
_::C.IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
""))
defpath :: IO String
defpath = do
String
home <- IO String
getHomeDirectory forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` (\(IOException
_::C.IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"")
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
home String -> String -> String
</> String
journalDefaultFilename
type PrefixedFilePath = FilePath
readJournal :: InputOpts -> Maybe FilePath -> Text -> ExceptT String IO Journal
readJournal :: InputOpts -> Maybe String -> Text -> ExceptT String IO Journal
readJournal InputOpts
iopts Maybe String
mpath Text
txt = do
let Reader IO
r :: Reader IO = forall a. a -> Maybe a -> a
fromMaybe forall (m :: * -> *). MonadIO m => Reader m
JournalReader.reader forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
Maybe String -> Maybe String -> Maybe (Reader m)
findReader (InputOpts -> Maybe String
mformat_ InputOpts
iopts) Maybe String
mpath
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg6IO String
"readJournal: trying reader" (forall (m :: * -> *). Reader m -> String
rFormat Reader IO
r)
forall (m :: * -> *).
Reader m
-> InputOpts -> String -> Text -> ExceptT String IO Journal
rReadFn Reader IO
r InputOpts
iopts (forall a. a -> Maybe a -> a
fromMaybe String
"(string)" Maybe String
mpath) Text
txt
readJournalFile :: InputOpts -> PrefixedFilePath -> ExceptT String IO Journal
readJournalFile :: InputOpts -> String -> ExceptT String IO Journal
readJournalFile InputOpts
iopts String
prefixedfile = do
let
(Maybe String
mfmt, String
f) = String -> (Maybe String, String)
splitReaderPrefix String
prefixedfile
iopts' :: InputOpts
iopts' = InputOpts
iopts{mformat_ :: Maybe String
mformat_=forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe String
mfmt, InputOpts -> Maybe String
mformat_ InputOpts
iopts]}
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
requireJournalFileExists String
f
Text
t <-
forall a. Int -> String -> a -> a
traceOrLogAt Int
6 (String
"readJournalFile: "forall a. [a] -> [a] -> [a]
++String -> String
takeFileName String
f) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Text
readFileOrStdinPortably String
f
Journal
j <- InputOpts -> Maybe String -> Text -> ExceptT String IO Journal
readJournal InputOpts
iopts' (forall a. a -> Maybe a
Just String
f) Text
t
if InputOpts -> Bool
new_ InputOpts
iopts
then do
LatestDates
ds <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO LatestDates
previousLatestDates String
f
let (Journal
newj, LatestDates
newds) = LatestDates -> Journal -> (Journal, LatestDates)
journalFilterSinceLatestDates LatestDates
ds Journal
j
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (InputOpts -> Bool
new_save_ InputOpts
iopts Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null LatestDates
newds)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ LatestDates -> String -> IO ()
saveLatestDates LatestDates
newds String
f
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
newj
else forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j
readJournalFiles :: InputOpts -> [PrefixedFilePath] -> ExceptT String IO Journal
readJournalFiles :: InputOpts -> [String] -> ExceptT String IO Journal
readJournalFiles InputOpts
iopts =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Default a => a
def forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
nonEmpty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (InputOpts -> String -> ExceptT String IO Journal
readJournalFile InputOpts
iopts)
readJournal' :: Text -> IO Journal
readJournal' :: Text -> IO Journal
readJournal' = forall (m :: * -> *) a. MonadIO m => ExceptT String m a -> m a
orDieTrying forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> Maybe String -> Text -> ExceptT String IO Journal
readJournal InputOpts
definputopts forall a. Maybe a
Nothing
readJournalFile' :: PrefixedFilePath -> IO Journal
readJournalFile' :: String -> IO Journal
readJournalFile' = forall (m :: * -> *) a. MonadIO m => ExceptT String m a -> m a
orDieTrying 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' = forall (m :: * -> *) a. MonadIO m => ExceptT String m a -> m a
orDieTrying 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail) forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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
"-" = forall (m :: * -> *) a. Monad m => a -> m a
return ()
requireJournalFileExists String
f = do
Bool
exists <- String -> IO Bool
doesFileExist String
f
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"The hledger journal file \"" forall a. Semigroup a => a -> a -> a
<> String
f forall a. Semigroup a => a -> a -> a
<> String
"\" was not found.\n"
Handle -> String -> IO ()
hPutStr Handle
stderr String
"Please create it first, eg with \"hledger add\" or a text editor.\n"
Handle -> String -> IO ()
hPutStr Handle
stderr String
"Or, specify an existing journal file with -f or LEDGER_FILE.\n"
forall a. IO a
exitFailure
ensureJournalFileExists :: FilePath -> IO ()
ensureJournalFileExists :: String -> IO ()
ensureJournalFileExists String
f = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
osforall a. Eq a => a -> a -> Bool
/=String
"mingw32" Bool -> Bool -> Bool
&& String -> Bool
isWindowsUnsafeDotPath String
f) forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Part of file path \"" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
f forall a. Semigroup a => a -> a -> a
<> String
"\"\n ends with a dot, which is unsafe on Windows; please use a different path.\n"
forall a. IO a
exitFailure
Bool
exists <- String -> IO Bool
doesFileExist String
f
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hPutStr Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Creating hledger journal file " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
f forall a. Semigroup a => a -> a -> a
<> String
".\n"
IO Text
newJournalContent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Text -> IO ()
T.writeFile String
f
isWindowsUnsafeDotPath :: FilePath -> Bool
isWindowsUnsafeDotPath :: String -> Bool
isWindowsUnsafeDotPath = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
x -> forall a. [a] -> a
last String
x forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
/=Char
'.') String
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories
newJournalContent :: IO Text
newJournalContent :: IO Text
newJournalContent = do
Day
d <- IO Day
getCurrentDay
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
"; journal created " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Day
d) forall a. Semigroup a => a -> a -> a
<> Text
" by hledger\n"
type LatestDates = [Day]
latestDates :: [Day] -> LatestDates
latestDates :: LatestDates -> LatestDates
latestDates = forall a. a -> [a] -> a
headDef [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Day -> Text
showDate LatestDates
dates
previousLatestDates :: FilePath -> IO LatestDates
previousLatestDates :: String -> IO LatestDates
previousLatestDates String
f = do
let latestfile :: String
latestfile = String -> String
latestDatesFileFor String
f
parsedate :: String -> m Day
parsedate String
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"could not parse date \"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\"") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
String -> Maybe Day
parsedateM String
s
Bool
exists <- String -> IO Bool
doesFileExist String
latestfile
if Bool
exists
then forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {m :: * -> *}. MonadFail m => String -> m Day
parsedate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Text
readFileStrictly String
latestfile
else forall (m :: * -> *) a. Monad m => a -> m a
return []
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
readFileStrictly :: FilePath -> IO Text
readFileStrictly :: String -> IO Text
readFileStrictly String
f = String -> IO Text
readFilePortably String
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
t -> forall a. a -> IO a
C.evaluate (Text -> Int
T.length Text
t) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
journalFilterSinceLatestDates :: LatestDates -> Journal -> (Journal, LatestDates)
journalFilterSinceLatestDates :: LatestDates -> Journal -> (Journal, LatestDates)
journalFilterSinceLatestDates [] Journal
j = (Journal
j, LatestDates -> LatestDates
latestDates forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>= Day
d)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> Day
tdate) forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
([Transaction]
samedatets, [Transaction]
laterts) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Eq a => a -> a -> Bool
== Day
d)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Transaction -> Day
tdate) forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Transaction -> Day
tdate) [Transaction]
samedateorlaterts
newsamedatets :: [Transaction]
newsamedatets = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length LatestDates
ds) [Transaction]
samedatets
j' :: Journal
j' = Journal
j{jtxns :: [Transaction]
jtxns=[Transaction]
newsamedatetsforall a. [a] -> [a] -> [a]
++[Transaction]
laterts}
ds' :: LatestDates
ds' = LatestDates -> LatestDates
latestDates forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Day
tdate forall a b. (a -> b) -> a -> b
$ [Transaction]
samedatetsforall 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
]