{-# LANGUAGE OverloadedStrings #-}
module Hledger.Read.TimeclockReader (
reader,
timeclockfilep,
)
where
import Control.Monad
import Control.Monad.Except (ExceptT, liftEither)
import Control.Monad.State.Strict
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Text.Megaparsec hiding (parse)
import Hledger.Data
import Hledger.Read.Common
import Hledger.Utils
import Data.Text as T (strip)
reader :: MonadIO m => Reader m
reader :: forall (m :: * -> *). MonadIO m => Reader m
reader = Reader
{rFormat :: String
rFormat = String
"timeclock"
,rExtensions :: [String]
rExtensions = [String
"timeclock"]
,rReadFn :: InputOpts -> String -> Text -> ExceptT String IO Journal
rReadFn = InputOpts -> String -> Text -> ExceptT String IO Journal
parse
,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser = forall (m :: * -> *). MonadIO m => JournalParser m Journal
timeclockfilep
}
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
parse :: InputOpts -> String -> Text -> ExceptT String IO Journal
parse InputOpts
iopts String
fp Text
t = ErroringJournalParser IO Journal
-> InputOpts -> String -> Text -> ExceptT String IO Journal
initialiseAndParseJournal forall (m :: * -> *). MonadIO m => JournalParser m Journal
timeclockfilep InputOpts
iopts String
fp Text
t
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountAlias] -> Journal -> Either String Journal
journalApplyAliases (InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputOpts -> String -> Text -> Journal -> ExceptT String IO Journal
journalFinalise InputOpts
iopts String
fp Text
t
timeclockfilep :: MonadIO m => JournalParser m ParsedJournal
timeclockfilep :: forall (m :: * -> *). MonadIO m => JournalParser m Journal
timeclockfilep = do forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall {m :: * -> *}.
StateT Journal (ParsecT HledgerParseErrorData Text m) ()
timeclockitemp
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
j :: Journal
j@Journal{jparsetimeclockentries :: Journal -> [TimeclockEntry]
jparsetimeclockentries=[TimeclockEntry]
es} <- forall s (m :: * -> *). MonadState s m => m s
get
LocalTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO LocalTime
getCurrentLocalTime
let j' :: Journal
j' = Journal
j{jtxns :: [Transaction]
jtxns = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions LocalTime
now forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [TimeclockEntry]
es, jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries = []}
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j'
where
timeclockitemp :: StateT Journal (ParsecT HledgerParseErrorData Text m) ()
timeclockitemp = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m ()
emptyorcommentlinep)
, forall (m :: * -> *). JournalParser m TimeclockEntry
timeclockentryp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TimeclockEntry
e -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries = TimeclockEntry
e forall a. a -> [a] -> [a]
: Journal -> [TimeclockEntry]
jparsetimeclockentries Journal
j})
] forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"timeclock entry, comment line, or empty line"
timeclockentryp :: JournalParser m TimeclockEntry
timeclockentryp :: forall (m :: * -> *). JournalParser m TimeclockEntry
timeclockentryp = do
SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Char
code <- forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"bhioO" :: [Char])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
LocalTime
datetime <- forall (m :: * -> *). JournalParser m LocalTime
datetimep
Text
account <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe Text
"") forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep
Text
description <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
T.strip) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). TextParser m Text
descriptionp
(Text
comment, [Tag]
tags) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SourcePos
-> TimeclockCode
-> LocalTime
-> Text
-> Text
-> Text
-> [Tag]
-> TimeclockEntry
TimeclockEntry SourcePos
pos (forall a. Read a => String -> a
read [Char
code]) LocalTime
datetime Text
account Text
description Text
comment [Tag]
tags