{-# 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 :: StorageFormat
rFormat = StorageFormat
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 = ErroringJournalParser m Journal
MonadIO m => ErroringJournalParser m Journal
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 ErroringJournalParser IO Journal
forall (m :: * -> *). MonadIO m => JournalParser m Journal
timeclockfilep InputOpts
iopts String
fp Text
t
ExceptT String IO Journal
-> (Journal -> ExceptT String IO Journal)
-> ExceptT String IO Journal
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either String Journal -> ExceptT String IO Journal
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String Journal -> ExceptT String IO Journal)
-> (Journal -> Either String Journal)
-> Journal
-> ExceptT String IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AccountAlias] -> Journal -> Either String Journal
journalApplyAliases (InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts)
ExceptT String IO Journal
-> (Journal -> ExceptT String IO Journal)
-> ExceptT String IO Journal
forall a b.
ExceptT String IO a
-> (a -> ExceptT String IO b) -> ExceptT String IO b
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 StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall {m :: * -> *}.
StateT Journal (ParsecT HledgerParseErrorData Text m) ()
timeclockitemp
StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
j@Journal{jparsetimeclockentries=es} <- StateT Journal (ParsecT HledgerParseErrorData Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
now <- liftIO getCurrentLocalTime
let j' = Journal
j{jtxns = reverse $ timeclockEntriesToTransactions now $ reverse es, jparsetimeclockentries = []}
return j'
where
timeclockitemp :: StateT Journal (ParsecT HledgerParseErrorData Text m) ()
timeclockitemp = [StateT Journal (ParsecT HledgerParseErrorData Text m) ()]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). TextParser m ()
emptyorcommentlinep)
, JournalParser m TimeclockEntry
forall (m :: * -> *). JournalParser m TimeclockEntry
timeclockentryp JournalParser m TimeclockEntry
-> (TimeclockEntry
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> (a -> StateT Journal (ParsecT HledgerParseErrorData Text m) b)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TimeclockEntry
e -> (Journal -> Journal)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsetimeclockentries = e : jparsetimeclockentries j})
] StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
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
pos <- StateT Journal (ParsecT HledgerParseErrorData Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
code <- oneOf ("bhioO" :: [Char])
lift skipNonNewlineSpaces1
datetime <- datetimep
account <- fmap (fromMaybe "") $ optional $ lift skipNonNewlineSpaces1 >> modifiedaccountnamep
description <- fmap (maybe "" T.strip) $ optional $ lift $ skipNonNewlineSpaces1 >> descriptionp
(comment, tags) <- lift transactioncommentp
return $ TimeclockEntry pos (read [code]) datetime account description comment tags