--- * -*- outline-regexp:"--- \\*"; -*-
--- ** doc
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.

-- Keep relevant parts synced with manual:
{-|

A reader for the timeclock file format.

What exactly is this format ? It was introduced in timeclock.el (<http://www.emacswiki.org/emacs/TimeClock>).
The old specification in timeclock.el 2.6 was:

@
A timeclock contains data in the form of a single entry per line.
Each entry has the form:

  CODE YYYY/MM/DD HH:MM:SS [COMMENT]

CODE is one of: b, h, i, o or O.  COMMENT is optional when the code is
i, o or O.  The meanings of the codes are:

  b  Set the current time balance, or \"time debt\".  Useful when
     archiving old log data, when a debt must be carried forward.
     The COMMENT here is the number of seconds of debt.

  h  Set the required working time for the given day.  This must
     be the first entry for that day.  The COMMENT in this case is
     the number of hours in this workday.  Floating point amounts
     are allowed.

  i  Clock in.  The COMMENT in this case should be the name of the
     project worked on.

  o  Clock out.  COMMENT is unnecessary, but can be used to provide
     a description of how the period went, for example.

  O  Final clock out.  Whatever project was being worked on, it is
     now finished.  Useful for creating summary reports.
@

Ledger's timeclock format is different, and hledger's timeclock format is different again.
For example: in a clock-in entry, after the time,

- timeclock.el's timeclock has 0-1 fields: [COMMENT]
- Ledger's timeclock has 0-2 fields:       [ACCOUNT[  PAYEE]]
- hledger's timeclock has 1-3 fields:      ACCOUNT[  DESCRIPTION[;COMMENT]]

hledger's timeclock format is:

@
# Comment lines like these, and blank lines, are ignored:
# comment line
; comment line
* comment line

# Lines beginning with b, h, or capital O are also ignored, for compatibility:
b SIMPLEDATE HH:MM[:SS][+-ZZZZ][ TEXT]
h SIMPLEDATE HH:MM[:SS][+-ZZZZ][ TEXT]
O SIMPLEDATE HH:MM[:SS][+-ZZZZ][ TEXT]

# Lines beginning with i or o are are clock-in / clock-out entries:
i SIMPLEDATE HH:MM[:SS][+-ZZZZ] ACCOUNT[  DESCRIPTION][;COMMENT]]
o SIMPLEDATE HH:MM[:SS][+-ZZZZ][ ACCOUNT][;COMMENT]
@

The date is a hledger [simple date](#simple-dates) (YYYY-MM-DD or similar).
The time parts must use two digits.
The seconds are optional.
A + or - four-digit time zone is accepted for compatibility, but currently ignored; times are always interpreted as a local time.

In clock-in entries (`i`), the account name is required.
A transaction description, separated from the account name by 2+ spaces, is optional.
A transaction comment, beginning with `;`, is also optional.

In clock-out entries (`o`) have no description, but can have a comment if you wish.
A clock-in and clock-out pair form a "transaction" posting some number of hours to an account - also known as a session.
Eg:

```timeclock
i 2015/03/30 09:00:00 session1
o 2015/03/30 10:00:00
```

```cli
$ hledger -f a.timeclock print
2015-03-30 * 09:00-10:00
    (session1)           1.00h
```

Clock-ins and clock-outs are matched by their account/session name.
If a clock-outs does not specify a name, the most recent unclosed clock-in is closed.
Also, sessions spanning more than one day are automatically split at day boundaries.
Eg, the following time log:

```timeclock
i 2015/03/30 09:00:00 some account  optional description after 2 spaces ; optional comment, tags:
o 2015/03/30 09:20:00
i 2015/03/31 22:21:45 another:account
o 2015/04/01 02:00:34
i 2015/04/02 12:00:00 another:account  ; this demonstrates multple sessions being clocked in
i 2015/04/02 13:00:00 some account
o 2015/04/02 14:00:00
o 2015/04/02 15:00:00 another:account
```

generates these transactions:

```cli
$ hledger -f t.timeclock print
2015-03-30 * optional description after 2 spaces   ; optional comment, tags:
    (some account)           0.33h

2015-03-31 * 22:21-23:59
    (another:account)           1.64h

2015-04-01 * 00:00-02:00
    (another:account)           2.01h

2015-04-02 * 12:00-15:00  ; this demonstrates multiple sessions being clocked in
    (another:account)           3.00h

2015-04-02 * 13:00-14:00
    (some account)           1.00h

```

-}

--- ** language
{-# LANGUAGE OverloadedStrings #-}

--- ** exports
module Hledger.Read.TimeclockReader (
  -- * Reader
  reader,
  -- * Misc other exports
  timeclockfilep,
)
where

--- ** imports
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
-- XXX too much reuse ?
import           Hledger.Read.Common
import           Hledger.Utils
import Data.Text as T (strip)
import Data.Functor ((<&>))

--- ** doctest setup
-- $setup
-- >>> :set -XOverloadedStrings

--- ** reader

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 -> Handle -> ExceptT String IO Journal
rReadFn     = (InputOpts -> String -> Text -> ExceptT String IO Journal)
-> InputOpts -> String -> Handle -> ExceptT String IO Journal
handleReadFnToTextReadFn InputOpts -> String -> Text -> ExceptT String IO Journal
parse
  ,rParser :: MonadIO m => InputOpts -> ErroringJournalParser m Journal
rParser     = MonadIO m => InputOpts -> ErroringJournalParser m Journal
InputOpts -> ErroringJournalParser m Journal
forall (m :: * -> *).
MonadIO m =>
InputOpts -> JournalParser m Journal
timeclockfilep
  }

-- | Parse and post-process a "Journal" from timeclock.el's timeclock
-- format, saving the provided file path and the current time, or give an
-- error.
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 (InputOpts -> ErroringJournalParser IO Journal
forall (m :: * -> *).
MonadIO m =>
InputOpts -> JournalParser m Journal
timeclockfilep InputOpts
iopts) 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

--- ** parsers

-- timeclockfilepspecial :: InputOpts -> JournalParser m ParsedJournal
-- timeclockfilepspecial args = 
-- timeclockfilep args

timeclockfilep :: MonadIO m => InputOpts -> JournalParser m ParsedJournal
timeclockfilep :: forall (m :: * -> *).
MonadIO m =>
InputOpts -> JournalParser m Journal
timeclockfilep InputOpts
iopts = 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
j@Journal{jparsetimeclockentries :: Journal -> [TimeclockEntry]
jparsetimeclockentries=[TimeclockEntry]
es} <- JournalParser m Journal
forall s (m :: * -> *). MonadState s m => m s
get
  -- Convert timeclock entries in this journal to transactions, closing any unfinished sessions.
  -- Doing this here rather than in journalFinalise means timeclock sessions can't span file boundaries,
  -- but it simplifies code above.
  LocalTime
now <- IO LocalTime
-> StateT Journal (ParsecT HledgerParseErrorData Text m) LocalTime
forall a.
IO a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO LocalTime
getCurrentLocalTime
  -- journalFinalise expects the transactions in reverse order, so reverse the output in either case
  let
    j' :: Journal
j' = if InputOpts -> Bool
_oldtimeclock InputOpts
iopts
      then
        -- timeclockToTransactionsOld expects the entries to be in normal order, 
        -- but they have been parsed in reverse order, so reverse them before calling
        Journal
j{jtxns = reverse $ timeclockToTransactionsOld now $ reverse es, jparsetimeclockentries = []}
      else
        -- We don't need to reverse these transactions 
        -- since they are sorted inside of timeclockToTransactions
        Journal
j{jtxns = reverse $ timeclockToTransactions now es, jparsetimeclockentries = []}
  Journal -> JournalParser m Journal
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j'
  where
    -- As all ledger line types can be distinguished by the first
    -- character, excepting transactions versus empty (blank or
    -- comment-only) lines, can use choice w/o try
    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
entryp 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"
      where entryp :: JournalParser m TimeclockEntry
entryp = if InputOpts -> Bool
_oldtimeclock InputOpts
iopts then JournalParser m TimeclockEntry
forall {m :: * -> *}. JournalParser m TimeclockEntry
oldtimeclockentryp else JournalParser m TimeclockEntry
forall {m :: * -> *}. JournalParser m TimeclockEntry
timeclockentryp

-- | Parse a timeclock entry (loose pre-1.50 format).
oldtimeclockentryp :: JournalParser m TimeclockEntry
oldtimeclockentryp :: forall {m :: * -> *}. JournalParser m TimeclockEntry
oldtimeclockentryp = do
  SourcePos
pos <- StateT Journal (ParsecT HledgerParseErrorData Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  Char
code <- [Token Text]
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"bhioO" :: [Char])
  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 s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  LocalTime
datetime <- JournalParser m LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep
  Text
account     <- (Maybe Text -> Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall a b.
(a -> b)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"") (StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT HledgerParseErrorData Text m) Text
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text))
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ 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 s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (m :: * -> *). Bool -> JournalParser m Text
modifiedaccountnamep Bool
True
  Text
description <- (Maybe Text -> Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall a b.
(a -> b)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
T.strip) (StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Text)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT HledgerParseErrorData Text m) Text
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text))
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
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 Text
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Text)
-> ParsecT HledgerParseErrorData Text m Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
descriptionp
  (Text
comment, [Tag]
tags) <- ParsecT HledgerParseErrorData Text m (Text, [Tag])
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag])
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 (Text, [Tag])
forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp
  TimeclockEntry -> JournalParser m TimeclockEntry
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeclockEntry -> JournalParser m TimeclockEntry)
-> TimeclockEntry -> JournalParser m TimeclockEntry
forall a b. (a -> b) -> a -> b
$ SourcePos
-> TimeclockCode
-> LocalTime
-> Text
-> Text
-> Text
-> [Tag]
-> TimeclockEntry
TimeclockEntry SourcePos
pos (String -> TimeclockCode
forall a. Read a => String -> a
read [Char
code]) LocalTime
datetime Text
account Text
description Text
comment [Tag]
tags

-- | Parse a timeclock entry (more robust post-1.50 format).
timeclockentryp :: JournalParser m TimeclockEntry
timeclockentryp :: forall {m :: * -> *}. JournalParser m TimeclockEntry
timeclockentryp = do
  SourcePos
pos <- StateT Journal (ParsecT HledgerParseErrorData Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  Char
code <- [Token Text]
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"iobhO" :: [Char])
  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 s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  LocalTime
datetime <- JournalParser m LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep
  (Text
account, Text
description) <- case Char
code of
    Char
'i' -> do
      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 s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
      Text
a <- Bool -> JournalParser m Text
forall (m :: * -> *). Bool -> JournalParser m Text
modifiedaccountnamep Bool
False
      Text
d <- JournalParser m Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT HledgerParseErrorData Text m Text -> JournalParser m Text
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 Text -> JournalParser m Text)
-> ParsecT HledgerParseErrorData Text m Text
-> JournalParser m Text
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
descriptionp) StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
-> (Maybe Text -> Text) -> JournalParser m Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Text -> Text
T.strip
      Tag -> StateT Journal (ParsecT HledgerParseErrorData Text m) Tag
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
a, Text
d)
    Char
'o' -> do
      -- Notice the try needed here to avoid a parse error if there's trailing spaces.
      -- Unlike descriptionp above, modifiedaccountnamep requires nonempty text.
      -- And when a parser in an optional fails after consuming input, optional doesn't backtrack,
      -- it propagates the failure.
      Text
a <- JournalParser m Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (JournalParser m Text -> JournalParser m Text
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (JournalParser m Text -> JournalParser m Text)
-> JournalParser m Text -> JournalParser m Text
forall a b. (a -> b) -> a -> b
$ 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 s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> JournalParser m Text -> JournalParser m Text
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> JournalParser m Text
forall (m :: * -> *). Bool -> JournalParser m Text
modifiedaccountnamep Bool
False) StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe Text)
-> (Maybe Text -> Text) -> JournalParser m Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
""
      Tag -> StateT Journal (ParsecT HledgerParseErrorData Text m) Tag
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
a, Text
"")
    Char
_ -> Tag -> StateT Journal (ParsecT HledgerParseErrorData Text m) Tag
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"", Text
"")
  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 s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  (Text
comment, [Tag]
tags) <- ParsecT HledgerParseErrorData Text m (Text, [Tag])
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag])
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 (Text, [Tag])
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag]))
-> ParsecT HledgerParseErrorData Text m (Text, [Tag])
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag])
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m (Text, [Tag])
-> ParsecT HledgerParseErrorData Text m (Maybe (Text, [Tag]))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT HledgerParseErrorData Text m (Text, [Tag])
forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp ParsecT HledgerParseErrorData Text m (Maybe (Text, [Tag]))
-> (Maybe (Text, [Tag]) -> (Text, [Tag]))
-> ParsecT HledgerParseErrorData Text m (Text, [Tag])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text, [Tag]) -> Maybe (Text, [Tag]) -> (Text, [Tag])
forall a. a -> Maybe a -> a
fromMaybe (Text
"",[])
  TimeclockEntry -> JournalParser m TimeclockEntry
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeclockEntry -> JournalParser m TimeclockEntry)
-> TimeclockEntry -> JournalParser m TimeclockEntry
forall a b. (a -> b) -> a -> b
$ SourcePos
-> TimeclockCode
-> LocalTime
-> Text
-> Text
-> Text
-> [Tag]
-> TimeclockEntry
TimeclockEntry SourcePos
pos (String -> TimeclockCode
forall a. Read a => String -> a
read [Char
code]) LocalTime
datetime Text
account Text
description Text
comment [Tag]
tags