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

A reader for the timeclock file format generated by timeclock.el
(<http://www.emacswiki.org/emacs/TimeClock>). Example:

@
i 2007\/03\/10 12:26:00 hledger
o 2007\/03\/10 17:26:02
@

From timeclock.el 2.6:

@
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.
@

-}

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

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

--- ** imports
import           Prelude ()
import "base-compat-batteries" Prelude.Compat
import           Control.Monad
import           Control.Monad.Except (ExceptT)
import           Control.Monad.State.Strict
import           Data.Maybe (fromMaybe)
import           Data.Text (Text)
import qualified Data.Text as T
import           Text.Megaparsec hiding (parse)

import           Hledger.Data
-- XXX too much reuse ?
import           Hledger.Read.Common
import           Hledger.Utils

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

--- ** reader

reader :: MonadIO m => Reader m
reader :: Reader m
reader = Reader :: forall (m :: * -> *).
StorageFormat
-> [StorageFormat]
-> (InputOpts
    -> StorageFormat -> Text -> ExceptT StorageFormat IO Journal)
-> (MonadIO m => ErroringJournalParser m Journal)
-> Reader m
Reader
  {rFormat :: StorageFormat
rFormat     = StorageFormat
"timeclock"
  ,rExtensions :: [StorageFormat]
rExtensions = [StorageFormat
"timeclock"]
  ,rReadFn :: InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
rReadFn     = InputOpts
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse
  ,rParser :: MonadIO m => ErroringJournalParser m Journal
rParser    = MonadIO m => ErroringJournalParser m Journal
forall (m :: * -> *). MonadIO m => 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
-> StorageFormat -> Text -> ExceptT StorageFormat IO Journal
parse = JournalParser IO Journal
-> InputOpts
-> StorageFormat
-> Text
-> ExceptT StorageFormat IO Journal
parseAndFinaliseJournal' JournalParser IO Journal
forall (m :: * -> *). MonadIO m => JournalParser m Journal
timeclockfilep

--- ** parsers

timeclockfilep :: MonadIO m => JournalParser m ParsedJournal
timeclockfilep :: JournalParser m Journal
timeclockfilep = do StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). StateT Journal (ParsecT CustomErr Text m) ()
timeclockitemp
                    StateT Journal (ParsecT CustomErr 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 CustomErr Text m) LocalTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO LocalTime
getCurrentLocalTime
                    -- entries have been parsed in reverse order. timeclockEntriesToTransactions
                    -- expects them to be in normal order, then we must reverse again since
                    -- journalFinalise expects them in reverse order
                    let j' :: Journal
j' = Journal
j{jtxns :: [Transaction]
jtxns = [Transaction] -> [Transaction]
forall a. [a] -> [a]
reverse ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ LocalTime -> [TimeclockEntry] -> [Transaction]
timeclockEntriesToTransactions LocalTime
now ([TimeclockEntry] -> [Transaction])
-> [TimeclockEntry] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ [TimeclockEntry] -> [TimeclockEntry]
forall a. [a] -> [a]
reverse [TimeclockEntry]
es, jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries = []}
                    Journal -> JournalParser m Journal
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 CustomErr Text m) ()
timeclockitemp = [StateT Journal (ParsecT CustomErr Text m) ()]
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [
                            StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
emptyorcommentlinep)
                          , JournalParser m TimeclockEntry
forall (m :: * -> *). JournalParser m TimeclockEntry
timeclockentryp JournalParser m TimeclockEntry
-> (TimeclockEntry -> StateT Journal (ParsecT CustomErr Text m) ())
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TimeclockEntry
e -> (Journal -> Journal)
-> StateT Journal (ParsecT CustomErr Text m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsetimeclockentries :: [TimeclockEntry]
jparsetimeclockentries = TimeclockEntry
e TimeclockEntry -> [TimeclockEntry] -> [TimeclockEntry]
forall a. a -> [a] -> [a]
: Journal -> [TimeclockEntry]
jparsetimeclockentries Journal
j})
                          ] StateT Journal (ParsecT CustomErr Text m) ()
-> StorageFormat -> StateT Journal (ParsecT CustomErr Text m) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> StorageFormat
"timeclock entry, comment line, or empty line"

-- | Parse a timeclock entry.
timeclockentryp :: JournalParser m TimeclockEntry
timeclockentryp :: JournalParser m TimeclockEntry
timeclockentryp = do
  GenericSourcePos
sourcepos <- SourcePos -> GenericSourcePos
genericSourcePos (SourcePos -> GenericSourcePos)
-> StateT Journal (ParsecT CustomErr Text m) SourcePos
-> StateT Journal (ParsecT CustomErr Text m) GenericSourcePos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m SourcePos
-> StateT Journal (ParsecT CustomErr Text m) SourcePos
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  Char
code <- [Token Text]
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (StorageFormat
"bhioO" :: [Char])
  ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
  LocalTime
datetime <- JournalParser m LocalTime
forall (m :: * -> *). JournalParser m LocalTime
datetimep
  Text
account <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Text)
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) Text
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT Journal (ParsecT CustomErr Text m) Text
forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep)
  Text
description <- StorageFormat -> Text
T.pack (StorageFormat -> Text)
-> (Maybe StorageFormat -> StorageFormat)
-> Maybe StorageFormat
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Maybe StorageFormat -> StorageFormat
forall a. a -> Maybe a -> a
fromMaybe StorageFormat
"" (Maybe StorageFormat -> Text)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe StorageFormat)
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m (Maybe StorageFormat)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe StorageFormat)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m StorageFormat
-> ParsecT CustomErr Text m (Maybe StorageFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m StorageFormat
-> ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
restofline))
  TimeclockEntry -> JournalParser m TimeclockEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeclockEntry -> JournalParser m TimeclockEntry)
-> TimeclockEntry -> JournalParser m TimeclockEntry
forall a b. (a -> b) -> a -> b
$ GenericSourcePos
-> TimeclockCode -> LocalTime -> Text -> Text -> TimeclockEntry
TimeclockEntry GenericSourcePos
sourcepos (StorageFormat -> TimeclockCode
forall a. Read a => StorageFormat -> a
read [Char
code]) LocalTime
datetime Text
account Text
description