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

A reader for the "timedot" file format.
Example:

@
;DATE
;ACCT  DOTS  # Each dot represents 15m, spaces are ignored
;ACCT  8    # numbers with or without a following h represent hours
;ACCT  5m   # numbers followed by m represent minutes

; on 2/1, 1h was spent on FOSS haskell work, 0.25h on research, etc.
2/1
fos.haskell   .... ..
biz.research  .
inc.client1   .... .... .... .... .... ....

2/2
biz.research  .
inc.client1   .... .... ..

@

-}

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

--- ** exports
module Hledger.Read.TimedotReader (
  -- * Reader
  reader,
  -- * Misc other exports
  timedotfilep,
)
where

--- ** imports
import Control.Monad
import Control.Monad.Except (ExceptT, liftEither)
import Control.Monad.State.Strict
import Data.Char (isSpace)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (Day)
import Text.Megaparsec hiding (parse)
import Text.Megaparsec.Char

import Hledger.Data
import Hledger.Read.Common
import Hledger.Utils
import Data.Decimal (roundTo)
import Data.Functor ((<&>))
import Data.List (sort)
import Data.List (group)
-- import Text.Megaparsec.Debug (dbg)

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

--- ** reader

reader :: MonadIO m => Reader m
reader :: forall (m :: * -> *). MonadIO m => Reader m
reader = Reader
  {rFormat :: StorageFormat
rFormat     = StorageFormat
Timedot
  ,rExtensions :: [String]
rExtensions = [String
"timedot"]
  ,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 => ErroringJournalParser m Journal
rParser    = ErroringJournalParser m Journal
MonadIO m => ErroringJournalParser m Journal
forall (m :: * -> *). JournalParser m Journal
timedotp
  }

-- | Parse and post-process a "Journal" from the timedot format, 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 ErroringJournalParser IO Journal
forall (m :: * -> *). JournalParser m Journal
timedotp 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

--- ** utilities

-- Trace parser state above a certain --debug level ?
tracelevel :: Int
tracelevel = Int
9
dp :: String -> JournalParser m ()
dp :: forall (m :: * -> *). String -> JournalParser m ()
dp = if Int
tracelevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then 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 ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> (String -> ParsecT HledgerParseErrorData Text m ())
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). Int -> String -> TextParser m ()
dbgparse Int
tracelevel else StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. a -> b -> a
const (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> String
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

--- ** parsers
{-
Rough grammar for timedot format:

timedot:           preamble day*
preamble:          (emptyline | commentline | orgheading)*
orgheading:        orgheadingprefix restofline
day:               dateline entry* (emptyline | commentline)*
dateline:          orgheadingprefix? date description?
orgheadingprefix:  star+ space+
description:       restofline  ; till semicolon?
entry:          orgheadingprefix? space* singlespaced (doublespace quantity?)?
doublespace:       space space+
quantity:          (dot (dot | space)* | number | number unit)

Date lines and item lines can begin with an org heading prefix, which is ignored.
Org headings before the first date line are ignored, regardless of content.
-}

timedotfilep :: JournalParser m Journal
timedotfilep = JournalParser m Journal
forall (m :: * -> *). JournalParser m Journal
timedotp -- XXX rename export above

timedotp :: JournalParser m ParsedJournal
timedotp :: forall (m :: * -> *). JournalParser m Journal
timedotp = JournalParser m ()
forall (m :: * -> *). JournalParser m ()
preamblep JournalParser m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
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
>> JournalParser m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many JournalParser m ()
forall (m :: * -> *). JournalParser m ()
dayp StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
-> JournalParser m () -> JournalParser m ()
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
>> JournalParser m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof JournalParser m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Journal
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Journal
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
>> StateT Journal (ParsecT HledgerParseErrorData Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get

preamblep :: JournalParser m ()
preamblep :: forall (m :: * -> *). JournalParser m ()
preamblep = do
  String -> JournalParser m ()
forall (m :: * -> *). String -> JournalParser m ()
dp String
"preamblep"
  StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
-> JournalParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
 -> JournalParser m ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
-> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ JournalParser m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (JournalParser m ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) [()])
-> JournalParser m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
forall a b. (a -> b) -> a -> b
$ StateT
  Journal
  (ParsecT HledgerParseErrorData Text m)
  (Day, Text, Text, [Tag])
-> JournalParser m ()
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> JournalParser m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy StateT
  Journal
  (ParsecT HledgerParseErrorData Text m)
  (Day, Text, Text, [Tag])
forall (m :: * -> *). JournalParser m (Day, Text, Text, [Tag])
datelinep JournalParser m () -> JournalParser m () -> JournalParser m ()
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
>> (ParsecT HledgerParseErrorData Text m () -> JournalParser 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 () -> JournalParser m ())
-> ParsecT HledgerParseErrorData Text m () -> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). String -> TextParser m ()
emptyorcommentlinep2 String
"#;*")

-- | Parse timedot day entries to multi-posting time transactions for that day.
-- @
-- 2020/2/1 optional day description
-- fos.haskell  .... ..
-- biz.research .
-- inc.client1  .... .... .... .... .... ....
-- @
dayp :: JournalParser m ()
dayp :: forall (m :: * -> *). JournalParser m ()
dayp = String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
String
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"timedot day entry" (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ do
  String -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). String -> JournalParser m ()
dp String
"dayp"
  SourcePos
pos <- StateT Journal (ParsecT HledgerParseErrorData Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  (Day
date,Text
desc,Text
comment,[Tag]
tags) <- JournalParser m (Day, Text, Text, [Tag])
forall (m :: * -> *). JournalParser m (Day, Text, Text, [Tag])
datelinep
  String -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). String -> JournalParser m ()
dp String
"dayp1"
  StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
commentlinesp
  String -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). String -> JournalParser m ()
dp String
"dayp2"
  [Posting]
ps <- (StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) [[Posting]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) [[Posting]])
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) [[Posting]]
forall a b. (a -> b) -> a -> b
$ String -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). String -> JournalParser m ()
dp String
"dayp3" StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
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
>> StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
forall (m :: * -> *). JournalParser m [Posting]
timedotentryp StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
commentlinesp) StateT Journal (ParsecT HledgerParseErrorData Text m) [[Posting]]
-> ([[Posting]] -> [Posting])
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Posting]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [[Posting]] -> [Posting]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  SourcePos
endpos <- StateT Journal (ParsecT HledgerParseErrorData Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  let t :: Transaction
t = Transaction -> Transaction
txnTieKnot (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction
nulltransaction{
    tsourcepos   = (pos, endpos),
    tdate        = date,
    tstatus      = Cleared,
    tdescription = desc,
    tcomment     = comment,
    ttags        = tags,
    tpostings    = ps
    }
  (Journal -> Journal)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((Journal -> Journal)
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> (Journal -> Journal)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ Transaction -> Journal -> Journal
addTransaction Transaction
t

datelinep :: JournalParser m (Day,Text,Text,[Tag])
datelinep :: forall (m :: * -> *). JournalParser m (Day, Text, Text, [Tag])
datelinep = do
  String -> JournalParser m ()
forall (m :: * -> *). String -> JournalParser m ()
dp String
"datelinep"
  ParsecT HledgerParseErrorData Text m (Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
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 (Maybe ())
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe ()))
-> ParsecT HledgerParseErrorData Text m (Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT HledgerParseErrorData Text m ()
forall {m :: * -> *}. ParsecT HledgerParseErrorData Text m ()
orgheadingprefixp
  Day
date <- JournalParser m Day
forall (m :: * -> *). JournalParser m Day
datep
  Text
desc <- Text -> Text
T.strip (Text -> Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
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
  (Day, Text, Text, [Tag])
-> JournalParser m (Day, Text, Text, [Tag])
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Day
date, Text
desc, Text
comment, [Tag]
tags)

-- | Zero or more empty lines or hash/semicolon comment lines
-- or org headlines which do not start a new day.
commentlinesp :: JournalParser m ()
commentlinesp :: forall (m :: * -> *). JournalParser m ()
commentlinesp = do
  String -> JournalParser m ()
forall (m :: * -> *). String -> JournalParser m ()
dp String
"commentlinesp"
  StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
-> JournalParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
 -> JournalParser m ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
-> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ JournalParser m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (JournalParser m ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) [()])
-> JournalParser m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [()]
forall a b. (a -> b) -> a -> b
$ JournalParser m () -> JournalParser m ()
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 () -> JournalParser m ())
-> JournalParser m () -> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m () -> JournalParser 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 () -> JournalParser m ())
-> ParsecT HledgerParseErrorData Text m () -> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). String -> TextParser m ()
emptyorcommentlinep2 String
"#;"

-- orgnondatelinep :: JournalParser m ()
-- orgnondatelinep = do
--   dp "orgnondatelinep"
--   lift orgheadingprefixp
--   notFollowedBy datelinep
--   void $ lift restofline

orgheadingprefixp :: ParsecT HledgerParseErrorData Text m ()
orgheadingprefixp = ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*') ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
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 ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1

-- | Parse a single timedot entry to one (dateless) transaction.
-- @
-- fos.haskell  .... ..
-- @
timedotentryp :: JournalParser m [Posting]
timedotentryp :: forall (m :: * -> *). JournalParser m [Posting]
timedotentryp = do
  String -> JournalParser m ()
forall (m :: * -> *). String -> JournalParser m ()
dp String
"timedotentryp"
  StateT
  Journal
  (ParsecT HledgerParseErrorData Text m)
  (Day, Text, Text, [Tag])
-> JournalParser m ()
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> JournalParser m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy StateT
  Journal
  (ParsecT HledgerParseErrorData Text m)
  (Day, Text, Text, [Tag])
forall (m :: * -> *). JournalParser m (Day, Text, Text, [Tag])
datelinep
  ParsecT HledgerParseErrorData Text m (Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
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 (Maybe ())
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe ()))
-> ParsecT HledgerParseErrorData Text m (Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT HledgerParseErrorData Text m ()
 -> ParsecT HledgerParseErrorData Text m (Maybe ()))
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m (Maybe ())
forall a b. (a -> b) -> a -> b
$ [ParsecT HledgerParseErrorData Text m ()]
-> ParsecT HledgerParseErrorData Text m ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ParsecT HledgerParseErrorData Text m ()
forall {m :: * -> *}. ParsecT HledgerParseErrorData Text m ()
orgheadingprefixp, ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1]
  Text
a <- JournalParser m Text
forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep
  ParsecT HledgerParseErrorData Text m () -> JournalParser 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
  [(Hours, Text)]
taggedhours <- ParsecT HledgerParseErrorData Text m [(Hours, Text)]
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) [(Hours, 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 [(Hours, Text)]
forall (m :: * -> *). TextParser m [(Hours, Text)]
durationsp
  (Text
comment0, [Tag]
tags0) <-
         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    -- not postingp, don't bother with date: tags here
     StateT Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag])
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag])
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag])
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
StateT Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag])
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag])
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
>> (Text, [Tag])
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Text, [Tag])
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"",[]))
  Maybe (Text, AmountStyle)
mcs <- JournalParser m (Maybe (Text, AmountStyle))
forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle
  let 
    (Text
c,AmountStyle
s) = case Maybe (Text, AmountStyle)
mcs of
      Just (Text
defc,AmountStyle
defs) -> (Text
defc, AmountStyle
defs{asprecision=max (asprecision defs) (Precision 2)})
      Maybe (Text, AmountStyle)
_ -> (Text
"", AmountStyle
amountstyle{asprecision=Precision 2})
    ps :: [Posting]
ps = [
      Posting
nullposting{paccount=a
                ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hours, astyle=s}
                ,ptype=VirtualPosting
                ,pcomment=comment
                ,ptags=tags
                }
      | (Hours
hours,Text
tagval) <- [(Hours, Text)]
taggedhours
      , let tag :: Tag
tag = (Text
"t",Text
tagval)
      , let tags :: [Tag]
tags    = if Text -> Bool
T.null Text
tagval then [Tag]
tags0    else [Tag]
tags0 [Tag] -> [Tag] -> [Tag]
forall a. [a] -> [a] -> [a]
++ [Tag
tag]
      , let comment :: Text
comment = if Text -> Bool
T.null Text
tagval then Text
comment0 else Text
comment0 Text -> Tag -> Text
`commentAddTagUnspaced` Tag
tag
      ]
  [Posting] -> JournalParser m [Posting]
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Posting]
ps

type Hours = Quantity

-- | Parse one or more durations in hours, each with an optional tag value
-- (or empty string for none).
durationsp :: TextParser m [(Hours,TagValue)]
durationsp :: forall (m :: * -> *). TextParser m [(Hours, Text)]
durationsp =
      (ParsecT HledgerParseErrorData Text m Hours
-> ParsecT HledgerParseErrorData Text m Hours
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT HledgerParseErrorData Text m Hours
forall (m :: * -> *). TextParser m Hours
numericquantityp ParsecT HledgerParseErrorData Text m Hours
-> (Hours -> [(Hours, Text)])
-> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Hours
h -> [(Hours
h,Text
"")])  -- try needed because numbers can begin with .
  ParsecT HledgerParseErrorData Text m [(Hours, Text)]
-> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
-> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT HledgerParseErrorData Text m Hours
forall (m :: * -> *). TextParser m Hours
dotquantityp     ParsecT HledgerParseErrorData Text m Hours
-> (Hours -> [(Hours, Text)])
-> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Hours
h -> [(Hours
h,Text
"")])
  ParsecT HledgerParseErrorData Text m [(Hours, Text)]
-> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
-> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
forall (m :: * -> *). TextParser m [(Hours, Text)]
letterquantitiesp
  ParsecT HledgerParseErrorData Text m [(Hours, Text)]
-> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
-> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [(Hours, Text)]
-> ParsecT HledgerParseErrorData Text m [(Hours, Text)]
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(Hours
0,Text
"")]

-- | Parse a duration of seconds, minutes, hours, days, weeks, months or years,
-- written as a decimal number followed by s, m, h, d, w, mo or y, assuming h
-- if there is no unit. Returns the duration as hours, assuming
-- 1m = 60s, 1h = 60m, 1d = 24h, 1w = 7d, 1mo = 30d, 1y=365d.
-- @
-- 1.5
-- 1.5h
-- 90m
-- @
numericquantityp :: TextParser m Hours
numericquantityp :: forall (m :: * -> *). TextParser m Hours
numericquantityp = do
  -- dp "numericquantityp"
  (Hours
q, Word8
_, Maybe Char
_, Maybe DigitGroupStyle
_) <- Maybe AmountStyle
-> TextParser m (Hours, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
Maybe AmountStyle
-> TextParser m (Hours, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp Maybe AmountStyle
forall a. Maybe a
Nothing
  Maybe (Tokens Text)
msymbol <- ParsecT HledgerParseErrorData Text m (Tokens Text)
-> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT HledgerParseErrorData Text m (Tokens Text)
 -> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text)))
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
-> ParsecT HledgerParseErrorData Text m (Maybe (Tokens Text))
forall a b. (a -> b) -> a -> b
$ [ParsecT HledgerParseErrorData Text m (Tokens Text)]
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([ParsecT HledgerParseErrorData Text m (Tokens Text)]
 -> ParsecT HledgerParseErrorData Text m (Tokens Text))
-> [ParsecT HledgerParseErrorData Text m (Tokens Text)]
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall a b. (a -> b) -> a -> b
$ ((Tokens Text, Hours)
 -> ParsecT HledgerParseErrorData Text m (Tokens Text))
-> [(Tokens Text, Hours)]
-> [ParsecT HledgerParseErrorData Text m (Tokens Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text))
-> ((Tokens Text, Hours) -> Tokens Text)
-> (Tokens Text, Hours)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tokens Text, Hours) -> Tokens Text
forall a b. (a, b) -> a
fst) [(Tokens Text, Hours)]
timeUnits
  ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  let q' :: Hours
q' =
        case Maybe (Tokens Text)
msymbol of
          Maybe (Tokens Text)
Nothing  -> Hours
q
          Just Tokens Text
sym -> Word8 -> Hours -> Hours
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo Word8
2 (Hours -> Hours) -> Hours -> Hours
forall a b. (a -> b) -> a -> b
$
            case Tokens Text -> [(Tokens Text, Hours)] -> Maybe Hours
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Tokens Text
sym [(Tokens Text, Hours)]
timeUnits of
              Just Hours
mult -> Hours
q Hours -> Hours -> Hours
forall a. Num a => a -> a -> a
* Hours
mult
              Maybe Hours
Nothing   -> Hours
q  -- shouldn't happen.. ignore
  Hours -> TextParser m Hours
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return Hours
q'

-- (symbol, equivalent in hours).
timeUnits :: [(Tokens Text, Hours)]
timeUnits =
  [(Tokens Text
"s",Hours
2.777777777777778e-4)
  ,(Tokens Text
"mo",Hours
5040) -- before "m"
  ,(Tokens Text
"m",Hours
1.6666666666666666e-2)
  ,(Tokens Text
"h",Hours
1)
  ,(Tokens Text
"d",Hours
24)
  ,(Tokens Text
"w",Hours
168)
  ,(Tokens Text
"y",Hours
61320)
  ]

-- | Parse a quantity written as a line of one or more dots,
-- each representing 0.25, ignoring any interspersed spaces
-- after the first dot.
-- @
-- .... ..
-- @
dotquantityp :: TextParser m Hours
dotquantityp :: forall (m :: * -> *). TextParser m Hours
dotquantityp = do
  -- dp "dotquantityp"
  Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'
  String
dots <- ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ([Token Text] -> ParsecT HledgerParseErrorData Text m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'.', Char
' ']) ParsecT HledgerParseErrorData Text m String
-> (String -> String)
-> ParsecT HledgerParseErrorData Text m String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace)
  Hours -> TextParser m Hours
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hours -> TextParser m Hours) -> Hours -> TextParser m Hours
forall a b. (a -> b) -> a -> b
$ Int -> Hours
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
dots) Hours -> Hours -> Hours
forall a. Fractional a => a -> a -> a
/ Hours
4

-- | Parse a quantity written as a line of one or more letters,
-- each representing 0.25 with a tag "t" whose value is the letter,
-- ignoring any interspersed spaces after the first letter.
letterquantitiesp :: TextParser m [(Hours, TagValue)]
letterquantitiesp :: forall (m :: * -> *). TextParser m [(Hours, Text)]
letterquantitiesp =
  -- dp "letterquantitiesp"
  do
    Char
letter1 <- ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar
    String
letters <- ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
letterChar ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Char
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT HledgerParseErrorData Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline) ParsecT HledgerParseErrorData Text m String
-> (String -> String)
-> ParsecT HledgerParseErrorData Text m String
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace)
    let groups :: [(Hours, Text)]
groups =
          [ (Int -> Hours
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
t) Hours -> Hours -> Hours
forall a. Fractional a => a -> a -> a
/ Hours
4, Char -> Text
T.singleton Char
c)
          | t :: String
t@(Char
c:String
_) <- String -> [String]
forall a. Eq a => [a] -> [[a]]
group (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Ord a => [a] -> [a]
sort (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char
letter1Char -> String -> String
forall a. a -> [a] -> [a]
:String
letters
          ]
    [(Hours, Text)] -> TextParser m [(Hours, Text)]
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Hours, Text)]
groups