{-# LANGUAGE OverloadedStrings #-}
module Hledger.Read.TimedotReader (
reader,
timedotfilep,
)
where
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 hiding (emptyorcommentlinep)
import Hledger.Utils
reader :: MonadIO m => Reader m
reader :: forall (m :: * -> *). MonadIO m => Reader m
reader = Reader
{rFormat :: String
rFormat = String
"timedot"
,rExtensions :: [String]
rExtensions = [String
"timedot"]
,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 :: * -> *). JournalParser m Journal
timedotp
}
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
traceparse, traceparse' :: String -> TextParser m ()
traceparse :: forall (m :: * -> *). String -> TextParser m ()
traceparse = TextParser m () -> String -> TextParser m ()
forall a b. a -> b -> a
const (TextParser m () -> String -> TextParser m ())
-> TextParser m () -> String -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ () -> TextParser m ()
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
traceparse' :: forall (m :: * -> *). String -> TextParser m ()
traceparse' = TextParser m () -> String -> TextParser m ()
forall a b. a -> b -> a
const (TextParser m () -> String -> TextParser m ())
-> TextParser m () -> String -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ () -> TextParser m ()
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
timedotfilep :: JournalParser m Journal
timedotfilep = JournalParser m Journal
forall (m :: * -> *). JournalParser m Journal
timedotp
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
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 ()
traceparse String
"preamblep"
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 ()
emptyorcommentlinep String
"#;*")
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 ()
traceparse' String
"preamblep"
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
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) ())
-> ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). String -> TextParser m ()
traceparse 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
StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
commentlinesp
[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
$ 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
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 :: (SourcePos, SourcePos)
tsourcepos = (SourcePos
pos, SourcePos
endpos),
tdate :: Day
tdate = Day
date,
tstatus :: Status
tstatus = Status
Cleared,
tdescription :: Text
tdescription = Text
desc,
tcomment :: Text
tcomment = Text
comment,
ttags :: [Tag]
ttags = [Tag]
tags,
tpostings :: [Posting]
tpostings = [Posting]
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
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) ())
-> ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). String -> TextParser m ()
traceparse 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)
commentlinesp :: JournalParser m ()
= do
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 ()
traceparse 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 ()
emptyorcommentlinep String
"#;"
orgheadingprefixp :: ParsecT HledgerParseErrorData Text m ()
orgheadingprefixp = do
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
timedotentryp :: JournalParser m Posting
timedotentryp :: forall (m :: * -> *). JournalParser m Posting
timedotentryp = 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 ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). String -> TextParser m ()
traceparse String
"timedotentryp"
StateT
Journal
(ParsecT HledgerParseErrorData Text m)
(Day, Text, Text, [Tag])
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text 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 ()
-> 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
(Hours
hours, Text
comment, [Tag]
tags) <-
StateT
Journal (ParsecT HledgerParseErrorData Text m) (Hours, Text, [Tag])
-> StateT
Journal (ParsecT HledgerParseErrorData Text m) (Hours, Text, [Tag])
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 (do
(Text
c,[Tag]
ts) <- 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
(Hours, Text, [Tag])
-> StateT
Journal (ParsecT HledgerParseErrorData Text m) (Hours, Text, [Tag])
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hours
0, Text
c, [Tag]
ts)
)
StateT
Journal (ParsecT HledgerParseErrorData Text m) (Hours, Text, [Tag])
-> StateT
Journal (ParsecT HledgerParseErrorData Text m) (Hours, Text, [Tag])
-> StateT
Journal (ParsecT HledgerParseErrorData Text m) (Hours, 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
<|> (do
Hours
h <- ParsecT HledgerParseErrorData Text m Hours
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Hours
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
forall (m :: * -> *). TextParser m Hours
durationp
(Text
c,[Tag]
ts) <- 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
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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) 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
"",[]))
(Hours, Text, [Tag])
-> StateT
Journal (ParsecT HledgerParseErrorData Text m) (Hours, Text, [Tag])
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hours
h,Text
c,[Tag]
ts)
)
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 :: AmountPrecision
asprecision=AmountPrecision -> AmountPrecision -> AmountPrecision
forall a. Ord a => a -> a -> a
max (AmountStyle -> AmountPrecision
asprecision AmountStyle
defs) (Word8 -> AmountPrecision
Precision Word8
2)})
Maybe (Text, AmountStyle)
_ -> (Text
"", AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
2})
Posting -> JournalParser m Posting
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Posting -> JournalParser m Posting)
-> Posting -> JournalParser m Posting
forall a b. (a -> b) -> a -> b
$ Posting
nullposting{paccount :: Text
paccount=Text
a
,pamount :: MixedAmount
pamount=Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Hours
aquantity=Hours
hours, astyle :: AmountStyle
astyle=AmountStyle
s}
,ptype :: PostingType
ptype=PostingType
VirtualPosting
,pcomment :: Text
pcomment=Text
comment
,ptags :: [Tag]
ptags=[Tag]
tags
}
type Hours = Quantity
durationp :: TextParser m Hours
durationp :: forall (m :: * -> *). TextParser m Hours
durationp = do
String -> TextParser m ()
forall (m :: * -> *). String -> TextParser m ()
traceparse String
"durationp"
TextParser m Hours -> TextParser 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 TextParser m Hours
forall (m :: * -> *). TextParser m Hours
numericquantityp TextParser m Hours -> TextParser m Hours -> TextParser m Hours
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
<|> TextParser m Hours
forall (m :: * -> *). TextParser m Hours
dotquantityp
numericquantityp :: TextParser m Hours
numericquantityp :: forall (m :: * -> *). TextParser m Hours
numericquantityp = do
(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 ->
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
Hours -> TextParser m Hours
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return Hours
q'
timeUnits :: [(Tokens Text, Hours)]
timeUnits =
[(Tokens Text
"s",Hours
2.777777777777778e-4)
,(Tokens Text
"mo",Hours
5040)
,(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)
]
dotquantityp :: TextParser m Quantity
dotquantityp :: forall (m :: * -> *). TextParser m Hours
dotquantityp = do
String
dots <- (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) (String -> String)
-> ParsecT HledgerParseErrorData Text m String
-> ParsecT HledgerParseErrorData Text m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (String
". " :: [Char]))
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 (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
emptyorcommentlinep :: [Char] -> TextParser m ()
String
cs =
String
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a.
String
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label (String
"empty line or comment line beginning with "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cs) (ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ())
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a b. (a -> b) -> a -> b
$ do
String -> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). String -> TextParser m ()
traceparse String
"emptyorcommentlinep"
ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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)
newline ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
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 (Tokens Text)
-> ParsecT HledgerParseErrorData Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT HledgerParseErrorData Text m (Tokens Text)
commentp
String -> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). String -> TextParser m ()
traceparse' String
"emptyorcommentlinep"
where
commentp :: ParsecT HledgerParseErrorData Text m (Tokens Text)
commentp = do
[ParsecT HledgerParseErrorData Text m String]
-> ParsecT HledgerParseErrorData Text m String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((Char -> ParsecT HledgerParseErrorData Text m String)
-> String -> [ParsecT HledgerParseErrorData Text m String]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some(ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m String)
-> (Char -> ParsecT HledgerParseErrorData Text m Char)
-> Char
-> ParsecT HledgerParseErrorData Text m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> ParsecT HledgerParseErrorData Text m Char
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) String
cs)
Maybe String
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe String
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
Token Text
'\n') ParsecT HledgerParseErrorData Text m (Tokens Text)
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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)
newline