{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Hledger.Read.Common (
Reader (..),
InputOpts(..),
HasInputOpts(..),
definputopts,
rawOptsToInputOpts,
parseAndFinaliseJournal,
initialiseAndParseJournal,
journalFinalise,
journalAddForecast,
journalAddAutoPostings,
setYear,
getYear,
setDefaultCommodityAndStyle,
getDefaultCommodityAndStyle,
getDefaultAmountStyle,
getAmountStyle,
addDeclaredAccountTags,
addDeclaredAccountType,
pushParentAccount,
popParentAccount,
getParentAccount,
addAccountAlias,
getAccountAliases,
clearAccountAliases,
journalAddFile,
statusp,
codep,
descriptionp,
datep,
datetimep,
secondarydatep,
modifiedaccountnamep,
accountnamep,
accountaliasp,
spaceandamountormissingp,
amountp,
amountp',
commoditysymbolp,
costp,
balanceassertionp,
lotcostp,
numberp,
fromRawNumber,
rawnumberp,
parseamount,
parseamount',
parsemixedamount,
parsemixedamount',
isLineCommentStart,
isSameLineCommentStart,
multilinecommentp,
emptyorcommentlinep,
followingcommentp,
transactioncommentp,
postingcommentp,
bracketeddatetagsp,
noncommenttextp,
noncommenttext1p,
singlespacedtext1p,
singlespacednoncommenttext1p,
singlespacedtextsatisfying1p,
singlespacep,
skipNonNewlineSpaces,
skipNonNewlineSpaces1,
aliasesFromOpts,
tests_Common,
)
where
import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
import Control.Monad (foldM, liftM2, when, unless, (>=>), (<=<))
import qualified Control.Monad.Fail as Fail (fail)
import Control.Monad.Except (ExceptT(..), liftEither, withExceptT)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.State.Strict (MonadState, evalStateT, modify', get, put)
import Control.Monad.Trans.Class (lift)
import Data.Bifunctor (bimap, second)
import Data.Char (digitToInt, isDigit, isSpace)
import Data.Decimal (DecimalRaw (Decimal), Decimal)
import Data.Either (rights)
import Data.Function ((&))
import Data.Functor ((<&>), ($>), void)
import Data.List (find, genericReplicate, union)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe)
import qualified Data.Map as M
import qualified Data.Semigroup as Sem
import Data.Text (Text, stripEnd)
import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorianValid, toGregorian)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..))
import Data.Word (Word8)
import System.FilePath (takeFileName)
import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, newline, string)
import Text.Megaparsec.Char.Lexer (decimal)
import Text.Megaparsec.Custom
(FinalParseError, attachSource, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion)
import Hledger.Data
import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery)
import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToReportOpts)
import Hledger.Utils
import Hledger.Read.InputOptions
data Reader m = Reader {
forall (m :: * -> *). Reader m -> [Char]
rFormat :: StorageFormat
,forall (m :: * -> *). Reader m -> [[Char]]
rExtensions :: [String]
,forall (m :: * -> *).
Reader m
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
rReadFn :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
,forall (m :: * -> *).
Reader m -> MonadIO m => ErroringJournalParser m Journal
rParser :: MonadIO m => ErroringJournalParser m ParsedJournal
}
instance Show (Reader m) where show :: Reader m -> [Char]
show Reader m
r = forall (m :: * -> *). Reader m -> [Char]
rFormat Reader m
r forall a. [a] -> [a] -> [a]
++ [Char]
" reader"
rawOptsToInputOpts :: Day -> RawOpts -> InputOpts
rawOptsToInputOpts :: Day -> RawOpts -> InputOpts
rawOptsToInputOpts Day
day RawOpts
rawopts =
let noinferbalancingcosts :: Bool
noinferbalancingcosts = [Char] -> RawOpts -> Bool
boolopt [Char]
"strict" RawOpts
rawopts Bool -> Bool -> Bool
|| [Char] -> RawOpts -> [Char]
stringopt [Char]
"args" RawOpts
rawopts forall a. Eq a => a -> a -> Bool
== [Char]
"balancednoautoconversion"
ropts :: ReportOpts
ropts = Day -> RawOpts -> ReportOpts
rawOptsToReportOpts Day
day RawOpts
rawopts
argsquery :: [Query]
argsquery = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
day) forall a b. (a -> b) -> a -> b
$ ReportOpts -> [Text]
querystring_ ReportOpts
ropts
datequery :: Query
datequery = Query -> Query
simplifyQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Query] -> Query
And forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query
queryFromFlags ReportOpts
ropts forall a. a -> [a] -> [a]
: [Query]
argsquery
styles :: Map Text AmountStyle
styles = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. [Char] -> a
err forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ RawOpts -> Either [Char] (Map Text AmountStyle)
commodityStyleFromRawOpts RawOpts
rawopts
where err :: [Char] -> a
err [Char]
e = forall {a}. [Char] -> a
error' forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse commodity-style: '" forall a. [a] -> [a] -> [a]
++ [Char]
e forall a. [a] -> [a] -> [a]
++ [Char]
"'"
in InputOpts
definputopts{
mformat_ :: Maybe [Char]
mformat_ = forall a. Maybe a
Nothing
,mrules_file_ :: Maybe [Char]
mrules_file_ = [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"rules-file" RawOpts
rawopts
,aliases_ :: [[Char]]
aliases_ = [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"alias" RawOpts
rawopts
,anon_ :: Bool
anon_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"anon" RawOpts
rawopts
,new_ :: Bool
new_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"new" RawOpts
rawopts
,new_save_ :: Bool
new_save_ = Bool
True
,pivot_ :: [Char]
pivot_ = [Char] -> RawOpts -> [Char]
stringopt [Char]
"pivot" RawOpts
rawopts
,forecast_ :: Maybe DateSpan
forecast_ = Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts Day
day RawOpts
rawopts
,verbose_tags_ :: Bool
verbose_tags_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"verbose-tags" RawOpts
rawopts
,reportspan_ :: DateSpan
reportspan_ = Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Query -> Maybe Day
queryStartDate Bool
False Query
datequery) (Day -> EFDay
Exact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Query -> Maybe Day
queryEndDate Bool
False Query
datequery)
,auto_ :: Bool
auto_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"auto" RawOpts
rawopts
,infer_equity_ :: Bool
infer_equity_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"infer-equity" RawOpts
rawopts Bool -> Bool -> Bool
&& ReportOpts -> Maybe ConversionOp
conversionop_ ReportOpts
ropts forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just ConversionOp
ToCost
,infer_costs_ :: Bool
infer_costs_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"infer-costs" RawOpts
rawopts
,balancingopts_ :: BalancingOpts
balancingopts_ = BalancingOpts
defbalancingopts{
ignore_assertions_ :: Bool
ignore_assertions_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"ignore-assertions" RawOpts
rawopts
, infer_balancing_costs_ :: Bool
infer_balancing_costs_ = Bool -> Bool
not Bool
noinferbalancingcosts
, commodity_styles_ :: Maybe (Map Text AmountStyle)
commodity_styles_ = forall a. a -> Maybe a
Just Map Text AmountStyle
styles
}
,strict_ :: Bool
strict_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"strict" RawOpts
rawopts
,_ioDay :: Day
_ioDay = Day
day
}
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts Day
d RawOpts
rawopts = do
[Char]
arg <- [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"forecast" RawOpts
rawopts
let period :: Either HledgerParseErrors (Interval, DateSpan)
period = Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
parsePeriodExpr Day
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripquotes forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
arg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
arg then DateSpan
nulldatespan else forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. HledgerParseErrors -> a
badParse (forall {b}. [Char] -> (Interval, b) -> b
getSpan [Char]
arg) Either HledgerParseErrors (Interval, DateSpan)
period
where
badParse :: HledgerParseErrors -> a
badParse HledgerParseErrors
e = forall {a}. [Char] -> a
usageError forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse forecast period : "forall a. [a] -> [a] -> [a]
++HledgerParseErrors -> [Char]
customErrorBundlePretty HledgerParseErrors
e
getSpan :: [Char] -> (Interval, b) -> b
getSpan [Char]
arg (Interval
interval, b
requestedspan) = case Interval
interval of
Interval
NoInterval -> b
requestedspan
Interval
_ -> forall {a}. [Char] -> a
usageError forall a b. (a -> b) -> a -> b
$ [Char]
"--forecast's argument should not contain a report interval ("
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Interval
interval forall a. [a] -> [a] -> [a]
++ [Char]
" in \"" forall a. [a] -> [a] -> [a]
++ [Char]
arg forall a. [a] -> [a] -> [a]
++ [Char]
"\")"
commodityStyleFromRawOpts :: RawOpts -> Either String (M.Map CommoditySymbol AmountStyle)
commodityStyleFromRawOpts :: RawOpts -> Either [Char] (Map Text AmountStyle)
commodityStyleFromRawOpts RawOpts
rawOpts =
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Map Text AmountStyle
r -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
c,AmountStyle
a) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
c AmountStyle
a Map Text AmountStyle
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] (Text, AmountStyle)
parseCommodity) forall a. Monoid a => a
mempty [[Char]]
optList
where
optList :: [[Char]]
optList = [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"commodity-style" RawOpts
rawOpts
parseCommodity :: [Char] -> Either [Char] (Text, AmountStyle)
parseCommodity [Char]
optStr = case [Char] -> Either HledgerParseErrors Amount
parseamount [Char]
optStr of
Left HledgerParseErrors
_ -> forall a b. a -> Either a b
Left [Char]
optStr
Right (Amount Text
acommodity Quantity
_ AmountStyle
astyle Maybe AmountPrice
_) -> forall a b. b -> Either a b
Right (Text
acommodity, AmountStyle
astyle)
parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
-> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal :: ErroringJournalParser IO Journal
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
parseAndFinaliseJournal ErroringJournalParser IO Journal
parser InputOpts
iopts [Char]
f Text
txt =
ErroringJournalParser IO Journal
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
initialiseAndParseJournal ErroringJournalParser IO Journal
parser InputOpts
iopts [Char]
f Text
txt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputOpts -> [Char] -> Text -> Journal -> ExceptT [Char] IO Journal
journalFinalise InputOpts
iopts [Char]
f Text
txt
initialiseAndParseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
-> FilePath -> Text -> ExceptT String IO Journal
initialiseAndParseJournal :: ErroringJournalParser IO Journal
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
initialiseAndParseJournal ErroringJournalParser IO Journal
parser InputOpts
iopts [Char]
f Text
txt =
forall a.
ExceptT FinalParseError IO (Either HledgerParseErrors a)
-> ExceptT [Char] IO a
prettyParseErrors forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ErroringJournalParser IO Journal
parser Journal
initJournal) [Char]
f Text
txt
where
y :: Integer
y = forall {a} {b} {c}. (a, b, c) -> a
first3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian forall a b. (a -> b) -> a -> b
$ InputOpts -> Day
_ioDay InputOpts
iopts
initJournal :: Journal
initJournal = Journal
nulljournal{jparsedefaultyear :: Maybe Integer
jparsedefaultyear = forall a. a -> Maybe a
Just Integer
y, jincludefilestack :: [[Char]]
jincludefilestack = [[Char]
f]}
prettyParseErrors :: ExceptT FinalParseError IO (Either (ParseErrorBundle Text HledgerParseErrorData) a)
-> ExceptT String IO a
prettyParseErrors :: forall a.
ExceptT FinalParseError IO (Either HledgerParseErrors a)
-> ExceptT [Char] IO a
prettyParseErrors = forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT HledgerParseErrors -> [Char]
customErrorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (FinalParseErrorBundle' HledgerParseErrorData -> [Char]
finalErrorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e.
[Char] -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
attachSource [Char]
f Text
txt)
journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal
journalFinalise :: InputOpts -> [Char] -> Text -> Journal -> ExceptT [Char] IO Journal
journalFinalise iopts :: InputOpts
iopts@InputOpts{Bool
[Char]
[[Char]]
Maybe [Char]
Maybe DateSpan
Day
DateSpan
BalancingOpts
_ioDay :: Day
strict_ :: Bool
balancingopts_ :: BalancingOpts
infer_costs_ :: Bool
infer_equity_ :: Bool
auto_ :: Bool
reportspan_ :: DateSpan
verbose_tags_ :: Bool
forecast_ :: Maybe DateSpan
pivot_ :: [Char]
new_save_ :: Bool
new_ :: Bool
anon_ :: Bool
aliases_ :: [[Char]]
mrules_file_ :: Maybe [Char]
mformat_ :: Maybe [Char]
_ioDay :: InputOpts -> Day
strict_ :: InputOpts -> Bool
balancingopts_ :: InputOpts -> BalancingOpts
infer_costs_ :: InputOpts -> Bool
infer_equity_ :: InputOpts -> Bool
auto_ :: InputOpts -> Bool
reportspan_ :: InputOpts -> DateSpan
verbose_tags_ :: InputOpts -> Bool
forecast_ :: InputOpts -> Maybe DateSpan
pivot_ :: InputOpts -> [Char]
new_save_ :: InputOpts -> Bool
new_ :: InputOpts -> Bool
anon_ :: InputOpts -> Bool
aliases_ :: InputOpts -> [[Char]]
mrules_file_ :: InputOpts -> Maybe [Char]
mformat_ :: InputOpts -> Maybe [Char]
..} [Char]
f Text
txt Journal
pj = do
POSIXTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall a b. (a -> b) -> a -> b
$ do
Journal
j <- Journal
pj{jglobalcommoditystyles :: Map Text AmountStyle
jglobalcommoditystyles=forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Maybe (Map Text AmountStyle)
commodity_styles_ BalancingOpts
balancingopts_}
forall a b. a -> (a -> b) -> b
& POSIXTime -> Journal -> Journal
journalSetLastReadTime POSIXTime
t
forall a b. a -> (a -> b) -> b
& ([Char], Text) -> Journal -> Journal
journalAddFile ([Char]
f, Text
txt)
forall a b. a -> (a -> b) -> b
& Journal -> Journal
journalReverse
forall a b. a -> (a -> b) -> b
& Journal -> Journal
journalAddAccountTypes
forall a b. a -> (a -> b) -> b
& Journal -> Either [Char] Journal
journalApplyCommodityStyles
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Bool -> Maybe DateSpan -> Journal -> Journal
journalAddForecast (Bool
verbose_tags_) (InputOpts -> Journal -> Maybe DateSpan
forecastPeriod InputOpts
iopts Journal
pj)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalPostingsAddAccountTags
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (if Bool
auto_ Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
pj)
then Bool -> Day -> BalancingOpts -> Journal -> Either [Char] Journal
journalAddAutoPostings Bool
verbose_tags_ Day
_ioDay BalancingOpts
balancingopts_
else forall (f :: * -> *) a. Applicative f => a -> f a
pure)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Journal -> Either [Char] Journal
journalMarkRedundantCosts
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
balancingopts_
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (if Bool
infer_costs_ then Journal -> Either [Char] Journal
journalInferCostsFromEquity else forall (f :: * -> *) a. Applicative f => a -> f a
pure)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (if Bool
infer_equity_ then Bool -> Journal -> Journal
journalAddInferredEquityPostings Bool
verbose_tags_ else forall a. a -> a
id)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalInferMarketPricesFromTransactions
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Int -> [Char] -> a -> a
traceOrLogAt Int
6 ([Char]
"journalFinalise: " forall a. Semigroup a => a -> a -> a
<> ShowS
takeFileName [Char]
f)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Char] -> Journal -> Journal
dbgJournalAcctDeclOrder ([Char]
"journalFinalise: " forall a. Semigroup a => a -> a -> a
<> ShowS
takeFileName [Char]
f forall a. Semigroup a => a -> a -> a
<> [Char]
" acct decls : ")
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalRenumberAccountDeclarations
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Char] -> Journal -> Journal
dbgJournalAcctDeclOrder ([Char]
"journalFinalise: " forall a. Semigroup a => a -> a -> a
<> ShowS
takeFileName [Char]
f forall a. Semigroup a => a -> a -> a
<> [Char]
" acct decls renumbered: ")
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
strict_ forall a b. (a -> b) -> a -> b
$ do
Journal -> Either [Char] ()
journalCheckAccounts Journal
j
Journal -> Either [Char] ()
journalCheckCommodities Journal
j
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j
journalAddAutoPostings :: Bool -> Day -> BalancingOpts -> Journal -> Either String Journal
journalAddAutoPostings :: Bool -> Day -> BalancingOpts -> Journal -> Either [Char] Journal
journalAddAutoPostings Bool
verbosetags Day
d BalancingOpts
bopts =
BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
bopts{ignore_assertions_ :: Bool
ignore_assertions_=Bool
True}
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> Day -> Journal -> Either [Char] Journal
journalModifyTransactions Bool
verbosetags Day
d
journalAddForecast :: Bool -> Maybe DateSpan -> Journal -> Journal
journalAddForecast :: Bool -> Maybe DateSpan -> Journal -> Journal
journalAddForecast Bool
_ Maybe DateSpan
Nothing Journal
j = Journal
j
journalAddForecast Bool
verbosetags (Just DateSpan
forecastspan) Journal
j = Journal
j{jtxns :: [Transaction]
jtxns = Journal -> [Transaction]
jtxns Journal
j forall a. [a] -> [a] -> [a]
++ [Transaction]
forecasttxns}
where
forecasttxns :: [Transaction]
forecasttxns =
forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> Transaction
txnTieKnot forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings (Map Text AmountStyle -> Posting -> Posting
postingApplyCommodityStyles forall a b. (a -> b) -> a -> b
$ Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (DateSpan -> Day -> Bool
spanContainsDate DateSpan
forecastspan forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Day
tdate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\PeriodicTransaction
pt -> Bool -> PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction Bool
verbosetags PeriodicTransaction
pt DateSpan
forecastspan)
forall a b. (a -> b) -> a -> b
$ Journal -> [PeriodicTransaction]
jperiodictxns Journal
j
setYear :: Year -> JournalParser m ()
setYear :: forall (m :: * -> *). Integer -> JournalParser m ()
setYear Integer
y = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsedefaultyear :: Maybe Integer
jparsedefaultyear=forall a. a -> Maybe a
Just Integer
y})
getYear :: JournalParser m (Maybe Year)
getYear :: forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> Maybe Integer
jparsedefaultyear forall s (m :: * -> *). MonadState s m => m s
get
getDecimalMarkStyle :: JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle :: forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle = do
Journal{Maybe Char
jparsedecimalmark :: Journal -> Maybe Char
jparsedecimalmark :: Maybe Char
jparsedecimalmark} <- forall s (m :: * -> *). MonadState s m => m s
get
let mdecmarkStyle :: Maybe AmountStyle
mdecmarkStyle = (\Char
c -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AmountStyle
amountstyle{asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. a -> Maybe a
Just Char
c}) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Char
jparsedecimalmark
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AmountStyle
mdecmarkStyle
setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle :: forall (m :: * -> *). (Text, AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle (Text, AmountStyle)
cs = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultcommodity=forall a. a -> Maybe a
Just (Text, AmountStyle)
cs})
getDefaultCommodityAndStyle :: JournalParser m (Maybe (CommoditySymbol,AmountStyle))
getDefaultCommodityAndStyle :: forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle = Journal -> Maybe (Text, AmountStyle)
jparsedefaultcommodity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall s (m :: * -> *). MonadState s m => m s
get
getDefaultAmountStyle :: JournalParser m (Maybe AmountStyle)
getDefaultAmountStyle :: forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDefaultAmountStyle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle
getAmountStyle :: CommoditySymbol -> JournalParser m (Maybe AmountStyle)
getAmountStyle :: forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
commodity = do
Journal{Map Text Commodity
jcommodities :: Journal -> Map Text Commodity
jcommodities :: Map Text Commodity
jcommodities} <- forall s (m :: * -> *). MonadState s m => m s
get
let mspecificStyle :: Maybe AmountStyle
mspecificStyle = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
commodity Map Text Commodity
jcommodities forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Commodity -> Maybe AmountStyle
cformat
Maybe AmountStyle
mdefaultStyle <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe AmountStyle
mspecificStyle, Maybe AmountStyle
mdefaultStyle]
addDeclaredAccountTags :: AccountName -> [Tag] -> JournalParser m ()
addDeclaredAccountTags :: forall (m :: * -> *). Text -> [Tag] -> JournalParser m ()
addDeclaredAccountTags Text
acct [Tag]
atags =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jdeclaredaccounttags :: Map Text [Tag]
jdeclaredaccounttags = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => [a] -> [a] -> [a]
union) Text
acct [Tag]
atags (Journal -> Map Text [Tag]
jdeclaredaccounttags Journal
j)})
addDeclaredAccountType :: AccountName -> AccountType -> JournalParser m ()
addDeclaredAccountType :: forall (m :: * -> *). Text -> AccountType -> JournalParser m ()
addDeclaredAccountType Text
acct AccountType
atype =
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jdeclaredaccounttypes :: Map AccountType [Text]
jdeclaredaccounttypes = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) AccountType
atype [Text
acct] (Journal -> Map AccountType [Text]
jdeclaredaccounttypes Journal
j)})
pushParentAccount :: AccountName -> JournalParser m ()
pushParentAccount :: forall (m :: * -> *). Text -> JournalParser m ()
pushParentAccount Text
acct = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparseparentaccounts :: [Text]
jparseparentaccounts = Text
acct forall a. a -> [a] -> [a]
: Journal -> [Text]
jparseparentaccounts Journal
j})
popParentAccount :: JournalParser m ()
popParentAccount :: forall (m :: * -> *). JournalParser m ()
popParentAccount = do
Journal
j <- forall s (m :: * -> *). MonadState s m => m s
get
case Journal -> [Text]
jparseparentaccounts Journal
j of
[] -> forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected (forall t. NonEmpty t -> ErrorItem t
Tokens (Char
'E' forall a. a -> [a] -> NonEmpty a
:| [Char]
"nd of apply account block with no beginning"))
(Text
_:[Text]
rest) -> forall s (m :: * -> *). MonadState s m => s -> m ()
put Journal
j{jparseparentaccounts :: [Text]
jparseparentaccounts=[Text]
rest}
getParentAccount :: JournalParser m AccountName
getParentAccount :: forall (m :: * -> *). JournalParser m Text
getParentAccount = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text] -> Text
concatAccountNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Text]
jparseparentaccounts) forall s (m :: * -> *). MonadState s m => m s
get
addAccountAlias :: MonadState Journal m => AccountAlias -> m ()
addAccountAlias :: forall (m :: * -> *). MonadState Journal m => AccountAlias -> m ()
addAccountAlias AccountAlias
a = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\(j :: Journal
j@Journal{[[Char]]
[([Char], Text)]
[(Text, AccountDeclarationInfo)]
[(Text, TagDeclarationInfo)]
[(Text, PayeeDeclarationInfo)]
[Text]
[MarketPrice]
[PriceDirective]
[TimeclockEntry]
[PeriodicTransaction]
[TransactionModifier]
[Transaction]
[AccountAlias]
Maybe Char
Maybe Integer
Maybe (Text, AmountStyle)
Text
Map Text [Tag]
Map Text Commodity
Map Text AmountStyle
Map Text AccountType
Map AccountType [Text]
POSIXTime
jlastreadtime :: Journal -> POSIXTime
jfiles :: Journal -> [([Char], Text)]
jfinalcommentlines :: Journal -> Text
jinferredmarketprices :: Journal -> [MarketPrice]
jpricedirectives :: Journal -> [PriceDirective]
jinferredcommodities :: Journal -> Map Text AmountStyle
jaccounttypes :: Journal -> Map Text AccountType
jdeclaredaccounts :: Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredtags :: Journal -> [(Text, TagDeclarationInfo)]
jdeclaredpayees :: Journal -> [(Text, PayeeDeclarationInfo)]
jparsetimeclockentries :: Journal -> [TimeclockEntry]
jparsealiases :: Journal -> [AccountAlias]
jlastreadtime :: POSIXTime
jfiles :: [([Char], Text)]
jfinalcommentlines :: Text
jtxns :: [Transaction]
jperiodictxns :: [PeriodicTransaction]
jtxnmodifiers :: [TransactionModifier]
jinferredmarketprices :: [MarketPrice]
jpricedirectives :: [PriceDirective]
jinferredcommodities :: Map Text AmountStyle
jcommodities :: Map Text Commodity
jglobalcommoditystyles :: Map Text AmountStyle
jaccounttypes :: Map Text AccountType
jdeclaredaccounttypes :: Map AccountType [Text]
jdeclaredaccounttags :: Map Text [Tag]
jdeclaredaccounts :: [(Text, AccountDeclarationInfo)]
jdeclaredtags :: [(Text, TagDeclarationInfo)]
jdeclaredpayees :: [(Text, PayeeDeclarationInfo)]
jincludefilestack :: [[Char]]
jparsetimeclockentries :: [TimeclockEntry]
jparsealiases :: [AccountAlias]
jparseparentaccounts :: [Text]
jparsedecimalmark :: Maybe Char
jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultyear :: Maybe Integer
jparseparentaccounts :: Journal -> [Text]
jdeclaredaccounttypes :: Journal -> Map AccountType [Text]
jdeclaredaccounttags :: Journal -> Map Text [Tag]
jcommodities :: Journal -> Map Text Commodity
jparsedefaultcommodity :: Journal -> Maybe (Text, AmountStyle)
jparsedecimalmark :: Journal -> Maybe Char
jperiodictxns :: Journal -> [PeriodicTransaction]
jtxns :: Journal -> [Transaction]
jtxnmodifiers :: Journal -> [TransactionModifier]
jglobalcommoditystyles :: Journal -> Map Text AmountStyle
jincludefilestack :: Journal -> [[Char]]
jparsedefaultyear :: Journal -> Maybe Integer
..}) -> Journal
j{jparsealiases :: [AccountAlias]
jparsealiases=AccountAlias
aforall a. a -> [a] -> [a]
:[AccountAlias]
jparsealiases})
getAccountAliases :: MonadState Journal m => m [AccountAlias]
getAccountAliases :: forall (m :: * -> *). MonadState Journal m => m [AccountAlias]
getAccountAliases = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> [AccountAlias]
jparsealiases forall s (m :: * -> *). MonadState s m => m s
get
clearAccountAliases :: MonadState Journal m => m ()
clearAccountAliases :: forall (m :: * -> *). MonadState Journal m => m ()
clearAccountAliases = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsealiases :: [AccountAlias]
jparsealiases=[]})
journalAddFile :: (FilePath,Text) -> Journal -> Journal
journalAddFile :: ([Char], Text) -> Journal -> Journal
journalAddFile ([Char], Text)
f j :: Journal
j@Journal{jfiles :: Journal -> [([Char], Text)]
jfiles=[([Char], Text)]
fs} = Journal
j{jfiles :: [([Char], Text)]
jfiles=[([Char], Text)]
fsforall a. [a] -> [a] -> [a]
++[([Char], Text)
f]}
match' :: TextParser m a -> TextParser m (Text, a)
match' :: forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' TextParser m a
p = do
(!Text
txt, a
p') <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match TextParser m a
p
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
txt, a
p')
statusp :: TextParser m Status
statusp :: forall (m :: * -> *). TextParser m Status
statusp =
forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice'
[ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cleared
, forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'!' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Status
Pending
, forall (m :: * -> *) a. Monad m => a -> m a
return Status
Unmarked
]
codep :: TextParser m Text
codep :: forall (m :: * -> *). TextParser m Text
codep = forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" forall a b. (a -> b) -> a -> b
$ do
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'('
Text
code <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
')' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n'
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"closing bracket ')' for transaction code"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
code
descriptionp :: TextParser m Text
descriptionp :: forall (m :: * -> *). TextParser m Text
descriptionp = forall (m :: * -> *). TextParser m Text
noncommenttextp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"description"
datep :: JournalParser m Day
datep :: forall (m :: * -> *). JournalParser m Day
datep = do
Maybe Integer
mYear <- forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear
datep' :: Maybe Year -> TextParser m Day
datep' :: forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear = do
Int
startOffset <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Either Integer Int
d1 <- forall (m :: * -> *). TextParser m (Either Integer Int)
yearorintp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"year or month"
Char
sep <- forall (m :: * -> *). TextParser m Char
datesepchar forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"date separator"
Int
d2 <- forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"month or day"
case Either Integer Int
d1 of
Left Integer
y -> forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
y Char
sep Int
d2
Right Int
m -> forall (m :: * -> *).
Int -> Maybe Integer -> Int -> Char -> Int -> TextParser m Day
partialDate Int
startOffset Maybe Integer
mYear Int
m Char
sep Int
d2
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"full or partial date"
where
fullDate :: Int -> Year -> Char -> Month -> TextParser m Day
fullDate :: forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
year Char
sep1 Int
month = do
Char
sep2 <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDateSepChar forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"date separator"
Int
day <- forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"day"
Int
endOffset <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
let dateStr :: [Char]
dateStr = forall a. Show a => a -> [Char]
show Integer
year forall a. [a] -> [a] -> [a]
++ [Char
sep1] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
month forall a. [a] -> [a] -> [a]
++ [Char
sep2] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
day
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
sep1 forall a. Eq a => a -> a -> Bool
/= Char
sep2) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset forall a b. (a -> b) -> a -> b
$
[Char]
"This date is malformed because the separators are different.\n"
forall a. [a] -> [a] -> [a]
++[Char]
"Please use consistent separators."
case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
Maybe Day
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset forall a b. (a -> b) -> a -> b
$
[Char]
"This date is invalid, please correct it: " forall a. [a] -> [a] -> [a]
++ [Char]
dateStr
Just Day
date -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Day
date
partialDate :: Int -> Maybe Year -> Month -> Char -> MonthDay -> TextParser m Day
partialDate :: forall (m :: * -> *).
Int -> Maybe Integer -> Int -> Char -> Int -> TextParser m Day
partialDate Int
startOffset Maybe Integer
myr Int
month Char
sep Int
day = do
Int
endOffset <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
case Maybe Integer
myr of
Just Integer
year ->
case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
Maybe Day
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset forall a b. (a -> b) -> a -> b
$
[Char]
"This date is invalid, please correct it: " forall a. [a] -> [a] -> [a]
++ [Char]
dateStr
Just Day
date -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Day
date
where dateStr :: [Char]
dateStr = forall a. Show a => a -> [Char]
show Integer
year forall a. [a] -> [a] -> [a]
++ [Char
sep] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
month forall a. [a] -> [a] -> [a]
++ [Char
sep] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
day
Maybe Integer
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset forall a b. (a -> b) -> a -> b
$
[Char]
"The partial date "forall a. [a] -> [a] -> [a]
++[Char]
dateStrforall a. [a] -> [a] -> [a]
++[Char]
" can not be parsed because the current year is unknown.\n"
forall a. [a] -> [a] -> [a]
++[Char]
"Consider making it a full date, or add a default year directive.\n"
where dateStr :: [Char]
dateStr = forall a. Show a => a -> [Char]
show Int
month forall a. [a] -> [a] -> [a]
++ [Char
sep] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
day
{-# INLINABLE datep' #-}
datetimep :: JournalParser m LocalTime
datetimep :: forall (m :: * -> *). JournalParser m LocalTime
datetimep = do
Maybe Integer
mYear <- forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Maybe Integer -> TextParser m LocalTime
datetimep' Maybe Integer
mYear
datetimep' :: Maybe Year -> TextParser m LocalTime
datetimep' :: forall (m :: * -> *). Maybe Integer -> TextParser m LocalTime
datetimep' Maybe Integer
mYear = do
Day
day <- forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
TimeOfDay
time <- forall (m :: * -> *). TextParser m TimeOfDay
timeOfDay
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (m :: * -> *). TextParser m [Char]
timeZone
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
time
where
timeOfDay :: TextParser m TimeOfDay
timeOfDay :: forall (m :: * -> *). TextParser m TimeOfDay
timeOfDay = do
Int
off1 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Int
h' <- forall (m :: * -> *). TextParser m Int
twoDigitDecimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"hour"
Int
off2 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
h' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
h' forall a. Ord a => a -> a -> Bool
<= Int
23) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
off1 Int
off2 [Char]
"invalid time (bad hour)"
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"':' (hour-minute separator)"
Int
off3 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Int
m' <- forall (m :: * -> *). TextParser m Int
twoDigitDecimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"minute"
Int
off4 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
m' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
m' forall a. Ord a => a -> a -> Bool
<= Int
59) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
off3 Int
off4 [Char]
"invalid time (bad minute)"
Int
s' <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
0 forall a b. (a -> b) -> a -> b
$ do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"':' (minute-second separator)"
Int
off5 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Int
s' <- forall (m :: * -> *). TextParser m Int
twoDigitDecimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"second"
Int
off6 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
s' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
s' forall a. Ord a => a -> a -> Bool
<= Int
59) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
off5 Int
off6 [Char]
"invalid time (bad second)"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
s'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h' Int
m' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s')
twoDigitDecimal :: TextParser m Int
twoDigitDecimal :: forall (m :: * -> *). TextParser m Int
twoDigitDecimal = do
Int
d1 <- Char -> Int
digitToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
Int
d2 <- Char -> Int
digitToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a second digit")
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
d1forall a. Num a => a -> a -> a
*Int
10 forall a. Num a => a -> a -> a
+ Int
d2
timeZone :: TextParser m String
timeZone :: forall (m :: * -> *). TextParser m [Char]
timeZone = do
Char
plusminus <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'+'
[Char]
fourDigits <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a digit (for a time zone)")
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char
plusminusforall a. a -> [a] -> [a]
:[Char]
fourDigits
secondarydatep :: Day -> TextParser m Day
secondarydatep :: forall (m :: * -> *). Day -> TextParser m Day
secondarydatep Day
primaryDate = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' (forall a. a -> Maybe a
Just Integer
primaryYear)
where primaryYear :: Integer
primaryYear = forall {a} {b} {c}. (a, b, c) -> a
first3 forall a b. (a -> b) -> a -> b
$ Day -> (Integer, Int, Int)
toGregorian Day
primaryDate
yearorintp :: TextParser m (Either Year Int)
yearorintp :: forall (m :: * -> *). TextParser m (Either Integer Int)
yearorintp = do
Text
yearOrMonth <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just [Char]
"digit") Char -> Bool
isDigit
let n :: Integer
n = Text -> Integer
readDecimal Text
yearOrMonth
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Text -> Int
T.length Text
yearOrMonth forall a. Ord a => a -> a -> Bool
>= Int
4 then forall a b. a -> Either a b
Left Integer
n else forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
n)
modifiedaccountnamep :: JournalParser m AccountName
modifiedaccountnamep :: forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep = do
Text
parent <- forall (m :: * -> *). JournalParser m Text
getParentAccount
[AccountAlias]
als <- forall (m :: * -> *). MonadState Journal m => m [AccountAlias]
getAccountAliases
Text
a <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
accountnamep
case [AccountAlias] -> Text -> Either [Char] Text
accountNameApplyAliases [AccountAlias]
als forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
joinAccountNames Text
parent Text
a of
Right Text
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Text
a'
Left [Char]
e -> forall {a}. [Char] -> a
error' [Char]
err
where
err :: [Char]
err = [Char]
"problem in account alias applied to "forall a. [a] -> [a] -> [a]
++Text -> [Char]
T.unpack Text
aforall a. [a] -> [a] -> [a]
++[Char]
": "forall a. [a] -> [a] -> [a]
++[Char]
e
accountnamep :: TextParser m AccountName
accountnamep :: forall (m :: * -> *). TextParser m Text
accountnamep = forall (m :: * -> *). TextParser m Text
singlespacedtext1p
noncommenttextp :: TextParser m T.Text
= forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSameLineCommentStart Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isNewline Token Text
c)
noncommenttext1p :: TextParser m T.Text
= forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (\Token Text
c -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSameLineCommentStart Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isNewline Token Text
c)
singlespacedtext1p :: TextParser m T.Text
singlespacedtext1p :: forall (m :: * -> *). TextParser m Text
singlespacedtext1p = forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p (forall a b. a -> b -> a
const Bool
True)
singlespacednoncommenttext1p :: TextParser m T.Text
= forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSameLineCommentStart)
singlespacedtextsatisfying1p :: (Char -> Bool) -> TextParser m T.Text
singlespacedtextsatisfying1p :: forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p Char -> Bool
f = do
Text
firstPart <- ParsecT HledgerParseErrorData Text m (Tokens Text)
partp
[Text]
otherParts <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). TextParser m ()
singlespacep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT HledgerParseErrorData Text m (Tokens Text)
partp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ Text
firstPart forall a. a -> [a] -> [a]
: [Text]
otherParts
where
partp :: ParsecT HledgerParseErrorData Text m (Tokens Text)
partp = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
f Token Text
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Token Text
c))
singlespacep :: TextParser m ()
singlespacep :: forall (m :: * -> *). TextParser m ()
singlespacep = forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline
spaceandamountormissingp :: JournalParser m MixedAmount
spaceandamountormissingp :: forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp =
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option MixedAmount
missingmixedamt forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
Amount -> MixedAmount
mixedAmount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m Amount
amountp
amountp :: JournalParser m Amount
amountp :: forall (m :: * -> *). JournalParser m Amount
amountp = forall (m :: * -> *). Bool -> JournalParser m Amount
amountp' Bool
False
amountp' :: Bool -> JournalParser m Amount
amountp' :: forall (m :: * -> *). Bool -> JournalParser m Amount
amountp' Bool
mult =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" forall a b. (a -> b) -> a -> b
$ do
let spaces :: StateT Journal (ParsecT HledgerParseErrorData Text m) ()
spaces = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Amount
amt <- forall (m :: * -> *). Bool -> JournalParser m Amount
simpleamountp Bool
mult forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces
(Maybe AmountPrice
mcost, Maybe ()
_valuationexpr, Maybe ()
_mlotcost, Maybe ()
_mlotdate, Maybe ()
_mlotnote) <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$
(,,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall (m :: * -> *). Amount -> JournalParser m AmountPrice
costp Amount
amt) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m ()
valuationexprp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m ()
lotcostp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m ()
lotdatep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m ()
lotnotep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Amount
amt { aprice :: Maybe AmountPrice
aprice = Maybe AmountPrice
mcost }
amountnobasisp :: JournalParser m Amount
amountnobasisp :: forall (m :: * -> *). JournalParser m Amount
amountnobasisp =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" forall a b. (a -> b) -> a -> b
$ do
let spaces :: StateT Journal (ParsecT HledgerParseErrorData Text m) ()
spaces = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Amount
amt <- forall (m :: * -> *). Bool -> JournalParser m Amount
simpleamountp Bool
False
forall (m :: * -> *). JournalParser m ()
spaces
Maybe AmountPrice
mprice <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Amount -> JournalParser m AmountPrice
costp Amount
amt forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Amount
amt { aprice :: Maybe AmountPrice
aprice = Maybe AmountPrice
mprice }
simpleamountp :: Bool -> JournalParser m Amount
simpleamountp :: forall (m :: * -> *). Bool -> JournalParser m Amount
simpleamountp Bool
mult =
do
Quantity -> Quantity
sign <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
leftsymbolamountp Quantity -> Quantity
sign forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
rightornosymbolamountp Quantity -> Quantity
sign
where
leftsymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount
leftsymbolamountp :: forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
leftsymbolamountp Quantity -> Quantity
sign = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" forall a b. (a -> b) -> a -> b
$ do
Text
c <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
commoditysymbolp
Maybe AmountStyle
mdecmarkStyle <- forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle
Maybe AmountStyle
mcommodityStyle <- forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
c
let suggestedStyle :: Maybe AmountStyle
suggestedStyle = Maybe AmountStyle
mdecmarkStyle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mcommodityStyle
Bool
commodityspaced <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m Bool
skipNonNewlineSpaces'
Quantity -> Quantity
sign2 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
Int
offBeforeNum <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Either AmbiguousNumber RawNumber
ambiguousRawNum <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
Maybe Integer
mExponent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall (m :: * -> *). TextParser m Integer
exponentp
Int
offAfterNum <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
let numRegion :: (Int, Int)
numRegion = (Int
offBeforeNum, Int
offAfterNum)
(Quantity
q,AmountPrecision
prec,Maybe Char
mdec,Maybe DigitGroupStyle
mgrps) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
suggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
let s :: AmountStyle
s = AmountStyle
amountstyle{ascommodityside :: Side
ascommodityside=Side
L, ascommodityspaced :: Bool
ascommodityspaced=Bool
commodityspaced, asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
forall (m :: * -> *) a. Monad m => a -> m a
return Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Quantity
aquantity=Quantity -> Quantity
sign (Quantity -> Quantity
sign2 Quantity
q), astyle :: AmountStyle
astyle=AmountStyle
s, aprice :: Maybe AmountPrice
aprice=forall a. Maybe a
Nothing}
rightornosymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount
rightornosymbolamountp :: forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
rightornosymbolamountp Quantity -> Quantity
sign = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" forall a b. (a -> b) -> a -> b
$ do
Int
offBeforeNum <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Either AmbiguousNumber RawNumber
ambiguousRawNum <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
Maybe Integer
mExponent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall (m :: * -> *). TextParser m Integer
exponentp
Int
offAfterNum <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
let numRegion :: (Int, Int)
numRegion = (Int
offBeforeNum, Int
offAfterNum)
Maybe (Bool, Text)
mSpaceAndCommodity <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m Bool
skipNonNewlineSpaces' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). TextParser m Text
commoditysymbolp
case Maybe (Bool, Text)
mSpaceAndCommodity of
Just (Bool
commodityspaced, Text
c) -> do
Maybe AmountStyle
mdecmarkStyle <- forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle
Maybe AmountStyle
mcommodityStyle <- forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
c
let msuggestedStyle :: Maybe AmountStyle
msuggestedStyle = Maybe AmountStyle
mdecmarkStyle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mcommodityStyle
(Quantity
q,AmountPrecision
prec,Maybe Char
mdec,Maybe DigitGroupStyle
mgrps) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
let s :: AmountStyle
s = AmountStyle
amountstyle{ascommodityside :: Side
ascommodityside=Side
R, ascommodityspaced :: Bool
ascommodityspaced=Bool
commodityspaced, asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
forall (m :: * -> *) a. Monad m => a -> m a
return Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Quantity
aquantity=Quantity -> Quantity
sign Quantity
q, astyle :: AmountStyle
astyle=AmountStyle
s, aprice :: Maybe AmountPrice
aprice=forall a. Maybe a
Nothing}
Maybe (Bool, Text)
Nothing -> do
Maybe AmountStyle
mdecmarkStyle <- forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle
Maybe AmountStyle
mcommodityStyle <- forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
""
Maybe AmountStyle
mdefaultStyle <- forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDefaultAmountStyle
let msuggestedStyle :: Maybe AmountStyle
msuggestedStyle = Maybe AmountStyle
mdecmarkStyle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mcommodityStyle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mdefaultStyle
(Quantity
q,AmountPrecision
prec,Maybe Char
mdec,Maybe DigitGroupStyle
mgrps) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
Maybe (Text, AmountStyle)
defcs <- forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle
let (Text
c,AmountStyle
s) = case (Bool
mult, Maybe (Text, AmountStyle)
defcs) of
(Bool
False, Just (Text
defc,AmountStyle
defs)) -> (Text
defc, AmountStyle
defs{asprecision :: AmountPrecision
asprecision=forall a. Ord a => a -> a -> a
max (AmountStyle -> AmountPrecision
asprecision AmountStyle
defs) AmountPrecision
prec})
(Bool, Maybe (Text, AmountStyle))
_ -> (Text
"", AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps})
forall (m :: * -> *) a. Monad m => a -> m a
return Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Quantity
aquantity=Quantity -> Quantity
sign Quantity
q, astyle :: AmountStyle
astyle=AmountStyle
s, aprice :: Maybe AmountPrice
aprice=forall a. Maybe a
Nothing}
interpretNumber
:: (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber :: forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
posRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousNum Maybe Integer
mExp =
let rawNum :: RawNumber
rawNum = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber Maybe AmountStyle
msuggestedStyle) forall a. a -> a
id Either AmbiguousNumber RawNumber
ambiguousNum
in case RawNumber
-> Maybe Integer
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
Left [Char]
errMsg -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion (Int, Int)
posRegion [Char]
errMsg
Right (Quantity
q,Word8
p,Maybe Char
d,Maybe DigitGroupStyle
g) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity
q, Word8 -> AmountPrecision
Precision Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g)
parseamount :: String -> Either HledgerParseErrors Amount
parseamount :: [Char] -> Either HledgerParseErrors Amount
parseamount [Char]
s = forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *). JournalParser m Amount
amountp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
nulljournal) [Char]
"" ([Char] -> Text
T.pack [Char]
s)
parseamount' :: String -> Amount
parseamount' :: [Char] -> Amount
parseamount' [Char]
s =
case [Char] -> Either HledgerParseErrors Amount
parseamount [Char]
s of
Right Amount
amt -> Amount
amt
Left HledgerParseErrors
err -> forall {a}. [Char] -> a
error' forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show HledgerParseErrors
err
parsemixedamount :: String -> Either HledgerParseErrors MixedAmount
parsemixedamount :: [Char] -> Either HledgerParseErrors MixedAmount
parsemixedamount = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Amount -> MixedAmount
mixedAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either HledgerParseErrors Amount
parseamount
parsemixedamount' :: String -> MixedAmount
parsemixedamount' :: [Char] -> MixedAmount
parsemixedamount' = Amount -> MixedAmount
mixedAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Amount
parseamount'
signp :: Num a => TextParser m (a -> a)
signp :: forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp = ((forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Num a => a -> a
negate forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. a -> a
id) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id
commoditysymbolp :: TextParser m CommoditySymbol
commoditysymbolp :: forall (m :: * -> *). TextParser m Text
commoditysymbolp =
forall (m :: * -> *). TextParser m Text
quotedcommoditysymbolp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). TextParser m Text
simplecommoditysymbolp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"commodity symbol"
quotedcommoditysymbolp :: TextParser m CommoditySymbol
quotedcommoditysymbolp :: forall (m :: * -> *). TextParser m Text
quotedcommoditysymbolp =
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing Char -> Bool
f
where f :: Char -> Bool
f Char
c = Char
c forall a. Eq a => a -> a -> Bool
/= Char
';' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\"'
simplecommoditysymbolp :: TextParser m CommoditySymbol
simplecommoditysymbolp :: forall (m :: * -> *). TextParser m Text
simplecommoditysymbolp = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNonsimpleCommodityChar)
costp :: Amount -> JournalParser m AmountPrice
costp :: forall (m :: * -> *). Amount -> JournalParser m AmountPrice
costp Amount
baseAmt =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"transaction price" forall a b. (a -> b) -> a -> b
$ do
Bool
parenthesised <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'@'
Bool
totalPrice <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'@' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
parenthesised forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Amount
priceAmount <- forall (m :: * -> *). Bool -> JournalParser m Amount
simpleamountp Bool
False
let amtsign' :: Quantity
amtsign' = forall a. Num a => a -> a
signum forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
baseAmt
amtsign :: Quantity
amtsign = if Quantity
amtsign' forall a. Eq a => a -> a -> Bool
== Quantity
0 then Quantity
1 else Quantity
amtsign'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
totalPrice
then Amount -> AmountPrice
TotalPrice Amount
priceAmount{aquantity :: Quantity
aquantity=Quantity
amtsign forall a. Num a => a -> a -> a
* Amount -> Quantity
aquantity Amount
priceAmount}
else Amount -> AmountPrice
UnitPrice Amount
priceAmount
valuationexprp :: JournalParser m ()
valuationexprp :: forall (m :: * -> *). JournalParser m ()
valuationexprp =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"valuation expression" forall a b. (a -> b) -> a -> b
$ do
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"(("
Text
_ <- Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
')',Char
'\n'])
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"))"
forall (m :: * -> *) a. Monad m => a -> m a
return ()
balanceassertionp :: JournalParser m BalanceAssertion
balanceassertionp :: forall (m :: * -> *). JournalParser m BalanceAssertion
balanceassertionp = do
SourcePos
sourcepos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
Bool
istotal <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
Bool
isinclusive <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Amount
a <- forall (m :: * -> *). JournalParser m Amount
amountnobasisp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"amount (for a balance assertion or assignment)"
forall (m :: * -> *) a. Monad m => a -> m a
return BalanceAssertion
{ baamount :: Amount
baamount = Amount
a
, batotal :: Bool
batotal = Bool
istotal
, bainclusive :: Bool
bainclusive = Bool
isinclusive
, baposition :: SourcePos
baposition = SourcePos
sourcepos
}
lotcostp :: JournalParser m ()
lotcostp :: forall (m :: * -> *). JournalParser m ()
lotcostp =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"ledger-style lot cost" forall a b. (a -> b) -> a -> b
$ do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'{'
Bool
doublebrace <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'{' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Bool
_fixed <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Amount
_a <- forall (m :: * -> *). Bool -> JournalParser m Amount
simpleamountp Bool
False
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'}'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
doublebrace) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'}'
lotdatep :: JournalParser m ()
lotdatep :: forall (m :: * -> *). JournalParser m ()
lotdatep =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"ledger-style lot date" forall a b. (a -> b) -> a -> b
$ do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'['
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Day
_d <- forall (m :: * -> *). JournalParser m Day
datep
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']'
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lotnotep :: JournalParser m ()
lotnotep :: forall (m :: * -> *). JournalParser m ()
lotnotep =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"ledger-style lot note" forall a b. (a -> b) -> a -> b
$ do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'('
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Text
_note <- Text -> Text
stripEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
')',Char
'\n'])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return ()
numberp :: Maybe AmountStyle -> TextParser m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp :: forall (m :: * -> *).
Maybe AmountStyle
-> TextParser
m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp Maybe AmountStyle
suggestedStyle = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"number" forall a b. (a -> b) -> a -> b
$ do
Quantity -> Quantity
sign <- forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
RawNumber
rawNum <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber Maybe AmountStyle
suggestedStyle) forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
Maybe Integer
mExp <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). TextParser m Integer
exponentp
forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"numberp suggestedStyle" Maybe AmountStyle
suggestedStyle seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return ()
case forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"numberp quantity,precision,mdecimalpoint,mgrps"
forall a b. (a -> b) -> a -> b
$ RawNumber
-> Maybe Integer
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
Left [Char]
errMsg -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
errMsg
Right (Quantity
q, Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity -> Quantity
sign Quantity
q, Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g)
exponentp :: TextParser m Integer
exponentp :: forall (m :: * -> *). TextParser m Integer
exponentp = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char' Char
'e' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"exponent"
fromRawNumber
:: RawNumber
-> Maybe Integer
-> Either String
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber :: RawNumber
-> Maybe Integer
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber (WithSeparators{}) (Just Integer
_) =
forall a b. a -> Either a b
Left [Char]
"invalid number: digit separators and exponents may not be used together"
fromRawNumber RawNumber
raw Maybe Integer
mExp = do
(Quantity
quantity, Word8
precision) <- Integer -> DigitGrp -> DigitGrp -> Either [Char] (Quantity, Word8)
toQuantity (forall a. a -> Maybe a -> a
fromMaybe Integer
0 Maybe Integer
mExp) (RawNumber -> DigitGrp
digitGroup RawNumber
raw) (RawNumber -> DigitGrp
decimalGroup RawNumber
raw)
forall (m :: * -> *) a. Monad m => a -> m a
return (Quantity
quantity, Word8
precision, RawNumber -> Maybe Char
mDecPt RawNumber
raw, RawNumber -> Maybe DigitGroupStyle
digitGroupStyle RawNumber
raw)
where
toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either String (Quantity, Word8)
toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either [Char] (Quantity, Word8)
toQuantity Integer
e DigitGrp
preDecimalGrp DigitGrp
postDecimalGrp
| Integer
precision forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a b. b -> Either a b
Right (forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
0 (Integer
digitGrpNum forall a. Num a => a -> a -> a
* Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^(-Integer
precision)), Word8
0)
| Integer
precision forall a. Ord a => a -> a -> Bool
< Integer
256 = forall a b. b -> Either a b
Right (forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
precision8 Integer
digitGrpNum, Word8
precision8)
| Bool
otherwise = forall a b. a -> Either a b
Left [Char]
"invalid number: numbers with more than 255 decimal places are currently not supported"
where
digitGrpNum :: Integer
digitGrpNum = DigitGrp -> Integer
digitGroupNumber forall a b. (a -> b) -> a -> b
$ DigitGrp
preDecimalGrp forall a. Semigroup a => a -> a -> a
<> DigitGrp
postDecimalGrp
precision :: Integer
precision = forall a. Integral a => a -> Integer
toInteger (DigitGrp -> Word
digitGroupLength DigitGrp
postDecimalGrp) forall a. Num a => a -> a -> a
- Integer
e
precision8 :: Word8
precision8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
precision :: Word8
mDecPt :: RawNumber -> Maybe Char
mDecPt (NoSeparators DigitGrp
_ Maybe (Char, DigitGrp)
mDecimals) = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Char, DigitGrp)
mDecimals
mDecPt (WithSeparators Char
_ [DigitGrp]
_ Maybe (Char, DigitGrp)
mDecimals) = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Char, DigitGrp)
mDecimals
decimalGroup :: RawNumber -> DigitGrp
decimalGroup (NoSeparators DigitGrp
_ Maybe (Char, DigitGrp)
mDecimals) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a b. (a, b) -> b
snd Maybe (Char, DigitGrp)
mDecimals
decimalGroup (WithSeparators Char
_ [DigitGrp]
_ Maybe (Char, DigitGrp)
mDecimals) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a b. (a, b) -> b
snd Maybe (Char, DigitGrp)
mDecimals
digitGroup :: RawNumber -> DigitGrp
digitGroup (NoSeparators DigitGrp
digitGrp Maybe (Char, DigitGrp)
_) = DigitGrp
digitGrp
digitGroup (WithSeparators Char
_ [DigitGrp]
digitGrps Maybe (Char, DigitGrp)
_) = forall a. Monoid a => [a] -> a
mconcat [DigitGrp]
digitGrps
digitGroupStyle :: RawNumber -> Maybe DigitGroupStyle
digitGroupStyle (NoSeparators DigitGrp
_ Maybe (Char, DigitGrp)
_) = forall a. Maybe a
Nothing
digitGroupStyle (WithSeparators Char
sep [DigitGrp]
grps Maybe (Char, DigitGrp)
_) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
sep forall a b. (a -> b) -> a -> b
$ [DigitGrp] -> [Word8]
groupSizes [DigitGrp]
grps
groupSizes :: [DigitGrp] -> [Word8]
groupSizes :: [DigitGrp] -> [Word8]
groupSizes [DigitGrp]
digitGrps = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ case forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. DigitGrp -> Word
digitGroupLength) [DigitGrp]
digitGrps of
(Word8
a:Word8
b:[Word8]
cs) | Word8
a forall a. Ord a => a -> a -> Bool
< Word8
b -> Word8
bforall a. a -> [a] -> [a]
:[Word8]
cs
[Word8]
gs -> [Word8]
gs
disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber Maybe AmountStyle
msuggestedStyle (AmbiguousNumber DigitGrp
grp1 Char
sep DigitGrp
grp2) =
if Char -> Bool
isDecimalMark Char
sep Bool -> Bool -> Bool
&&
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Char
sep Char -> AmountStyle -> Bool
`isValidDecimalBy`) Maybe AmountStyle
msuggestedStyle
then DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 (forall a. a -> Maybe a
Just (Char
sep, DigitGrp
grp2))
else Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
sep [DigitGrp
grp1, DigitGrp
grp2] forall a. Maybe a
Nothing
where
isValidDecimalBy :: Char -> AmountStyle -> Bool
isValidDecimalBy :: Char -> AmountStyle -> Bool
isValidDecimalBy Char
c = \case
AmountStyle{asdecimalpoint :: AmountStyle -> Maybe Char
asdecimalpoint = Just Char
d} -> Char
d forall a. Eq a => a -> a -> Bool
== Char
c
AmountStyle{asdigitgroups :: AmountStyle -> Maybe DigitGroupStyle
asdigitgroups = Just (DigitGroups Char
g [Word8]
_)} -> Char
g forall a. Eq a => a -> a -> Bool
/= Char
c
AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision = Precision Word8
0} -> Bool
False
AmountStyle
_ -> Bool
True
rawnumberp :: TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp :: forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"number" forall a b. (a -> b) -> a -> b
$ do
Either AmbiguousNumber RawNumber
rawNumber <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (m :: * -> *). TextParser m RawNumber
leadingDecimalPt forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits
Maybe (Token Text)
mExtraDecimalSep <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDecimalMark
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (Token Text)
mExtraDecimalSep) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
"invalid number (invalid use of separator)"
Maybe Int
mExtraFragment <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
' ' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
case Maybe Int
mExtraFragment of
Just Int
off -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
Int -> [Char] -> HledgerParseErrorData
parseErrorAt Int
off [Char]
"invalid number (excessive trailing digits)"
Maybe Int
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"rawnumberp" Either AmbiguousNumber RawNumber
rawNumber
where
leadingDecimalPt :: TextParser m RawNumber
leadingDecimalPt :: forall (m :: * -> *). TextParser m RawNumber
leadingDecimalPt = do
Char
decPt <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDecimalMark
DigitGrp
decGrp <- forall (m :: * -> *). TextParser m DigitGrp
digitgroupp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators forall a. Monoid a => a
mempty (forall a. a -> Maybe a
Just (Char
decPt, DigitGrp
decGrp))
leadingDigits :: TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits :: forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits = do
DigitGrp
grp1 <- forall (m :: * -> *). TextParser m DigitGrp
digitgroupp
forall (m :: * -> *).
DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber)
withSeparators DigitGrp
grp1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right (forall (m :: * -> *). DigitGrp -> TextParser m RawNumber
trailingDecimalPt DigitGrp
grp1)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 forall a. Maybe a
Nothing)
withSeparators :: DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber)
withSeparators :: forall (m :: * -> *).
DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber)
withSeparators DigitGrp
grp1 = do
(Char
sep, DigitGrp
grp2) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDigitSeparatorChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). TextParser m DigitGrp
digitgroupp
[DigitGrp]
grps <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TextParser m DigitGrp
digitgroupp
let digitGroups :: [DigitGrp]
digitGroups = DigitGrp
grp1 forall a. a -> [a] -> [a]
: DigitGrp
grp2 forall a. a -> [a] -> [a]
: [DigitGrp]
grps
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right (forall (m :: * -> *). Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt Char
sep [DigitGrp]
digitGroups)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (DigitGrp
-> Char
-> DigitGrp
-> [DigitGrp]
-> Either AmbiguousNumber RawNumber
withoutDecimalPt DigitGrp
grp1 Char
sep DigitGrp
grp2 [DigitGrp]
grps)
withDecimalPt :: Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt :: forall (m :: * -> *). Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt Char
digitSep [DigitGrp]
digitGroups = do
Char
decPt <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isDecimalMark Token Text
c Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
digitSep
DigitGrp
decDigitGrp <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty forall (m :: * -> *). TextParser m DigitGrp
digitgroupp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
digitSep [DigitGrp]
digitGroups (forall a. a -> Maybe a
Just (Char
decPt, DigitGrp
decDigitGrp))
withoutDecimalPt
:: DigitGrp
-> Char
-> DigitGrp
-> [DigitGrp]
-> Either AmbiguousNumber RawNumber
withoutDecimalPt :: DigitGrp
-> Char
-> DigitGrp
-> [DigitGrp]
-> Either AmbiguousNumber RawNumber
withoutDecimalPt DigitGrp
grp1 Char
sep DigitGrp
grp2 [DigitGrp]
grps
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DigitGrp]
grps Bool -> Bool -> Bool
&& Char -> Bool
isDecimalMark Char
sep =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ DigitGrp -> Char -> DigitGrp -> AmbiguousNumber
AmbiguousNumber DigitGrp
grp1 Char
sep DigitGrp
grp2
| Bool
otherwise = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
sep (DigitGrp
grp1forall a. a -> [a] -> [a]
:DigitGrp
grp2forall a. a -> [a] -> [a]
:[DigitGrp]
grps) forall a. Maybe a
Nothing
trailingDecimalPt :: DigitGrp -> TextParser m RawNumber
trailingDecimalPt :: forall (m :: * -> *). DigitGrp -> TextParser m RawNumber
trailingDecimalPt DigitGrp
grp1 = do
Char
decPt <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDecimalMark
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 (forall a. a -> Maybe a
Just (Char
decPt, forall a. Monoid a => a
mempty))
isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar Char
c = Char -> Bool
isDecimalMark Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' '
data RawNumber
= NoSeparators DigitGrp (Maybe (Char, DigitGrp))
| WithSeparators Char [DigitGrp] (Maybe (Char, DigitGrp))
deriving (Int -> RawNumber -> ShowS
[RawNumber] -> ShowS
RawNumber -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RawNumber] -> ShowS
$cshowList :: [RawNumber] -> ShowS
show :: RawNumber -> [Char]
$cshow :: RawNumber -> [Char]
showsPrec :: Int -> RawNumber -> ShowS
$cshowsPrec :: Int -> RawNumber -> ShowS
Show, RawNumber -> RawNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawNumber -> RawNumber -> Bool
$c/= :: RawNumber -> RawNumber -> Bool
== :: RawNumber -> RawNumber -> Bool
$c== :: RawNumber -> RawNumber -> Bool
Eq)
data AmbiguousNumber = AmbiguousNumber DigitGrp Char DigitGrp
deriving (Int -> AmbiguousNumber -> ShowS
[AmbiguousNumber] -> ShowS
AmbiguousNumber -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AmbiguousNumber] -> ShowS
$cshowList :: [AmbiguousNumber] -> ShowS
show :: AmbiguousNumber -> [Char]
$cshow :: AmbiguousNumber -> [Char]
showsPrec :: Int -> AmbiguousNumber -> ShowS
$cshowsPrec :: Int -> AmbiguousNumber -> ShowS
Show, AmbiguousNumber -> AmbiguousNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AmbiguousNumber -> AmbiguousNumber -> Bool
$c/= :: AmbiguousNumber -> AmbiguousNumber -> Bool
== :: AmbiguousNumber -> AmbiguousNumber -> Bool
$c== :: AmbiguousNumber -> AmbiguousNumber -> Bool
Eq)
data DigitGrp = DigitGrp {
DigitGrp -> Word
digitGroupLength :: !Word,
DigitGrp -> Integer
digitGroupNumber :: !Integer
} deriving (DigitGrp -> DigitGrp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DigitGrp -> DigitGrp -> Bool
$c/= :: DigitGrp -> DigitGrp -> Bool
== :: DigitGrp -> DigitGrp -> Bool
$c== :: DigitGrp -> DigitGrp -> Bool
Eq)
instance Show DigitGrp where
show :: DigitGrp -> [Char]
show (DigitGrp Word
len Integer
n) = [Char]
"\"" forall a. [a] -> [a] -> [a]
++ [Char]
padding forall a. [a] -> [a] -> [a]
++ [Char]
numStr forall a. [a] -> [a] -> [a]
++ [Char]
"\""
where numStr :: [Char]
numStr = forall a. Show a => a -> [Char]
show Integer
n
padding :: [Char]
padding = forall i a. Integral i => i -> a -> [a]
genericReplicate (forall a. Integral a => a -> Integer
toInteger Word
len forall a. Num a => a -> a -> a
- forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
numStr)) Char
'0'
instance Sem.Semigroup DigitGrp where
DigitGrp Word
l1 Integer
n1 <> :: DigitGrp -> DigitGrp -> DigitGrp
<> DigitGrp Word
l2 Integer
n2 = Word -> Integer -> DigitGrp
DigitGrp (Word
l1 forall a. Num a => a -> a -> a
+ Word
l2) (Integer
n1 forall a. Num a => a -> a -> a
* Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^Word
l2 forall a. Num a => a -> a -> a
+ Integer
n2)
instance Monoid DigitGrp where
mempty :: DigitGrp
mempty = Word -> Integer -> DigitGrp
DigitGrp Word
0 Integer
0
mappend :: DigitGrp -> DigitGrp -> DigitGrp
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)
digitgroupp :: TextParser m DigitGrp
digitgroupp :: forall (m :: * -> *). TextParser m DigitGrp
digitgroupp = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"digits"
forall a b. (a -> b) -> a -> b
$ Text -> DigitGrp
makeGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just [Char]
"digit") Char -> Bool
isDigit
where
makeGroup :: Text -> DigitGrp
makeGroup = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word -> Integer -> DigitGrp
DigitGrp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' forall {a} {b}. (Num a, Num b) => (a, b) -> Char -> (a, b)
step (Word
0, Integer
0)
step :: (a, b) -> Char -> (a, b)
step (!a
l, !b
a) Char
c = (a
lforall a. Num a => a -> a -> a
+a
1, b
aforall a. Num a => a -> a -> a
*b
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c))
multilinecommentp :: TextParser m ()
= ParsecT HledgerParseErrorData Text m ()
startComment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT HledgerParseErrorData Text m ()
anyLine forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
`skipManyTill` ParsecT HledgerParseErrorData Text m ()
endComment
where
startComment :: ParsecT HledgerParseErrorData Text m ()
startComment = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"comment" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TextParser m ()
trailingSpaces
endComment :: ParsecT HledgerParseErrorData Text m ()
endComment = forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end comment" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TextParser m ()
trailingSpaces
trailingSpaces :: ParsecT HledgerParseErrorData Text m ()
trailingSpaces = forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
anyLine :: ParsecT HledgerParseErrorData Text m ()
anyLine = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/=Char
'\n') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
{-# INLINABLE multilinecommentp #-}
emptyorcommentlinep :: TextParser m ()
= do
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
forall (m :: * -> *). TextParser m ()
skiplinecommentp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
where
skiplinecommentp :: TextParser m ()
skiplinecommentp :: forall (m :: * -> *). TextParser m ()
skiplinecommentp = do
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isLineCommentStart
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINABLE emptyorcommentlinep #-}
isLineCommentStart :: Char -> Bool
Char
'#' = Bool
True
isLineCommentStart Char
'*' = Bool
True
isLineCommentStart Char
';' = Bool
True
isLineCommentStart Char
_ = Bool
False
isSameLineCommentStart :: Char -> Bool
Char
';' = Bool
True
isSameLineCommentStart Char
_ = Bool
False
followingcommentp' :: (Monoid a, Show a) => TextParser m a -> TextParser m (Text, a)
TextParser m a
contentp = do
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
[(Text, a)]
sameLine <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall (m :: * -> *). TextParser m ()
headerp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' TextParser m a
contentp) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
()
_ <- forall (m :: * -> *). TextParser m ()
eolof
[(Text, a)]
nextLines <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TextParser m ()
headerp) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' TextParser m a
contentp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). TextParser m ()
eolof
let
sameLine' :: [(Text, a)]
sameLine' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, a)]
sameLine Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, a)]
nextLines) = [(Text
"",forall a. Monoid a => a
mempty)]
| Bool
otherwise = [(Text, a)]
sameLine
([Text]
texts, [a]
contents) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ [(Text, a)]
sameLine' forall a. [a] -> [a] -> [a]
++ [(Text, a)]
nextLines
strippedCommentText :: Text
strippedCommentText = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip [Text]
texts
commentContent :: a
commentContent = forall a. Monoid a => [a] -> a
mconcat [a]
contents
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
strippedCommentText, a
commentContent)
where
headerp :: ParsecT HledgerParseErrorData Text m ()
headerp = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
{-# INLINABLE followingcommentp' #-}
followingcommentp :: TextParser m Text
=
forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentp' (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
'\n'))
{-# INLINABLE followingcommentp #-}
transactioncommentp :: TextParser m (Text, [Tag])
= forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentp' forall (m :: * -> *). TextParser m [Tag]
commenttagsp
{-# INLINABLE transactioncommentp #-}
commenttagsp :: TextParser m [Tag]
= do
Text
tagName <- (forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSpace) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
':' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n')
forall (m :: * -> *). Text -> TextParser m [Tag]
atColon Text
tagName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
where
atColon :: Text -> TextParser m [Tag]
atColon :: forall (m :: * -> *). Text -> TextParser m [Tag]
atColon Text
name = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
if Text -> Bool
T.null Text
name
then forall (m :: * -> *). TextParser m [Tag]
commenttagsp
else do
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
Text
val <- forall (m :: * -> *). TextParser m Text
tagValue
let tag :: Tag
tag = (Text
name, Text
val)
(Tag
tagforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). TextParser m [Tag]
commenttagsp
tagValue :: TextParser m Text
tagValue :: forall (m :: * -> *). TextParser m Text
tagValue = do
Text
val <- Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n')
Maybe (Token Text)
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
','
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
val
{-# INLINABLE commenttagsp #-}
postingcommentp
:: Maybe Year -> TextParser m (Text, [Tag], Maybe Day, Maybe Day)
Maybe Integer
mYear = do
(Text
commentText, ([Tag]
tags, [DateTag]
dateTags)) <-
forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentp' (forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear)
let mdate :: Maybe Day
mdate = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Text
"date") forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [DateTag]
dateTags
mdate2 :: Maybe Day
mdate2 = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Text
"date2")forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [DateTag]
dateTags
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
commentText, [Tag]
tags, Maybe Day
mdate, Maybe Day
mdate2)
{-# INLINABLE postingcommentp #-}
commenttagsanddatesp
:: Maybe Year -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp :: forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear = do
(Text
txt, [DateTag]
dateTags) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
':'
let tagName :: Text
tagName = forall a. [a] -> a
last ((Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSpace Text
txt)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second) ([DateTag]
dateTagsforall a. [a] -> [a] -> [a]
++) (forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
atColon Text
tagName) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [DateTag]
dateTags)
where
readUpTo :: Char -> TextParser m [DateTag]
readUpTo :: forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
end = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
end Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'[')
forall (m :: * -> *).
TextParser m [DateTag] -> TextParser m [DateTag]
atBracket (forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
end) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
atBracket :: TextParser m [DateTag] -> TextParser m [DateTag]
atBracket :: forall (m :: * -> *).
TextParser m [DateTag] -> TextParser m [DateTag]
atBracket TextParser m [DateTag]
cont = do
[DateTag]
dateTags <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall (m :: * -> *). Maybe Integer -> TextParser m [DateTag]
bracketeddatetagsp Maybe Integer
mYear)
Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'['
[DateTag]
dateTags' <- TextParser m [DateTag]
cont
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [DateTag]
dateTags forall a. [a] -> [a] -> [a]
++ [DateTag]
dateTags'
atColon :: Text -> TextParser m ([Tag], [DateTag])
atColon :: forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
atColon Text
name = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
([Tag]
tags, [DateTag]
dateTags) <- case Text
name of
Text
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
Text
"date" -> forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name
Text
"date2" -> forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name
Text
_ -> forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
tagValue Text
name
Maybe (Token Text)
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
','
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([Tag]
tagsforall a. [a] -> [a] -> [a]
++) ([DateTag]
dateTagsforall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear
dateValue :: Text -> TextParser m ([Tag], [DateTag])
dateValue :: forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name = do
(Text
txt, (Day
date, [DateTag]
dateTags)) <- forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' forall a b. (a -> b) -> a -> b
$ do
Day
date <- forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear
[DateTag]
dateTags <- forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
','
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day
date, [DateTag]
dateTags)
let val :: Text
val = Text -> Text
T.strip Text
txt
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ( [(Text
name, Text
val)]
, (Text
name, Day
date) forall a. a -> [a] -> [a]
: [DateTag]
dateTags )
tagValue :: Text -> TextParser m ([Tag], [DateTag])
tagValue :: forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
tagValue Text
name = do
(Text
txt, [DateTag]
dateTags) <- forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
','
let val :: Text
val = Text -> Text
T.strip Text
txt
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ( [(Text
name, Text
val)]
, [DateTag]
dateTags )
{-# INLINABLE commenttagsanddatesp #-}
bracketeddatetagsp
:: Maybe Year -> TextParser m [(TagName, Day)]
bracketeddatetagsp :: forall (m :: * -> *). Maybe Integer -> TextParser m [DateTag]
bracketeddatetagsp Maybe Integer
mYear1 = do
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
Text
s <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']')
forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing Char -> Bool
isBracketedDateChar
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
s Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDateSepChar Text
s) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
"not a bracketed date"
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') forall a b. (a -> b) -> a -> b
$ do
Maybe Day
md1 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear1
let mYear2 :: Maybe Integer
mYear2 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> Integer
readYear Maybe Day
md1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Integer
mYear1
Maybe Day
md2 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [(Text
"date",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
md1, (Text
"date2",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
md2]
where
readYear :: Day -> Integer
readYear = forall {a} {b} {c}. (a, b, c) -> a
first3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian
isBracketedDateChar :: Char -> Bool
isBracketedDateChar Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDateSepChar Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'='
{-# INLINABLE bracketeddatetagsp #-}
aliasesFromOpts :: InputOpts -> [AccountAlias]
aliasesFromOpts :: InputOpts -> [AccountAlias]
aliasesFromOpts = forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
a -> forall t e a.
(Show t, Show (Token t), Show e) =>
Either (ParseErrorBundle t e) a -> a
fromparse forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser forall (m :: * -> *). TextParser m AccountAlias
accountaliasp ([Char]
"--alias "forall a. [a] -> [a] -> [a]
++ShowS
quoteIfNeeded [Char]
a) forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> [[Char]]
aliases_
accountaliasp :: TextParser m AccountAlias
accountaliasp :: forall (m :: * -> *). TextParser m AccountAlias
accountaliasp = forall (m :: * -> *). TextParser m AccountAlias
regexaliasp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). TextParser m AccountAlias
basicaliasp
basicaliasp :: TextParser m AccountAlias
basicaliasp :: forall (m :: * -> *). TextParser m AccountAlias
basicaliasp = do
[Char]
old <- ShowS
rstrip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"=" :: [Char]))
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
[Char]
new <- ShowS
rstrip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` forall (m :: * -> *). TextParser m ()
eolof
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> AccountAlias
BasicAlias ([Char] -> Text
T.pack [Char]
old) ([Char] -> Text
T.pack [Char]
new)
regexaliasp :: TextParser m AccountAlias
regexaliasp :: forall (m :: * -> *). TextParser m AccountAlias
regexaliasp = do
(Int
off1, Int
off2, Text
re) <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'/') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'/') forall a b. (a -> b) -> a -> b
$ do
Int
off1 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Text
re <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$
(Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"/\\\n\r" :: [Char]))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\\/"
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Char -> Text -> Text
T.cons (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\') (Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle))
Int
off2 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off1, Int
off2, Text
re)
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
[Char]
repl <- forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` forall (m :: * -> *). TextParser m ()
eolof
case Text -> Either [Char] Regexp
toRegexCI Text
re of
Right Regexp
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Regexp -> [Char] -> AccountAlias
RegexAlias Regexp
r [Char]
repl
Left [Char]
e -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$! Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
off1 Int
off2 [Char]
e
tests_Common :: TestTree
tests_Common = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Common" [
[Char] -> [TestTree] -> TestTree
testGroup [Char]
"amountp" [
[Char] -> Assertion -> TestTree
testCase [Char]
"basic" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Amount
amountp Text
"$47.18" (Quantity -> Amount
usd Quantity
47.18)
,[Char] -> Assertion -> TestTree
testCase [Char]
"ends with decimal mark" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Amount
amountp Text
"$1." (Quantity -> Amount
usd Quantity
1 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
0)
,[Char] -> Assertion -> TestTree
testCase [Char]
"unit price" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 @ €0.5"
Amount
nullamt{
acommodity :: Text
acommodity=Text
"$"
,aquantity :: Quantity
aquantity=Quantity
10
,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
0, asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. Maybe a
Nothing}
,aprice :: Maybe AmountPrice
aprice=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
UnitPrice forall a b. (a -> b) -> a -> b
$
Amount
nullamt{
acommodity :: Text
acommodity=Text
"€"
,aquantity :: Quantity
aquantity=Quantity
0.5
,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
1, asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. a -> Maybe a
Just Char
'.'}
}
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"total price" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 @@ €5"
Amount
nullamt{
acommodity :: Text
acommodity=Text
"$"
,aquantity :: Quantity
aquantity=Quantity
10
,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
0, asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. Maybe a
Nothing}
,aprice :: Maybe AmountPrice
aprice=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
TotalPrice forall a b. (a -> b) -> a -> b
$
Amount
nullamt{
acommodity :: Text
acommodity=Text
"€"
,aquantity :: Quantity
aquantity=Quantity
5
,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
0, asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. Maybe a
Nothing}
}
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"unit price, parenthesised" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 (@) €0.5"
,[Char] -> Assertion -> TestTree
testCase [Char]
"total price, parenthesised" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 (@@) €0.5"
]
,let p :: JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
Maybe AmountStyle
-> TextParser
m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp forall a. Maybe a
Nothing) :: JournalParser IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) in
[Char] -> Assertion -> TestTree
testCase [Char]
"numberp" forall a b. (a -> b) -> a -> b
$ do
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"0" (Quantity
0, Word8
0, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1" (Quantity
1, Word8
0, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.1" (Quantity
1.1, Word8
1, forall a. a -> Maybe a
Just Char
'.', forall a. Maybe a
Nothing)
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000.1" (Quantity
1000.1, Word8
1, forall a. a -> Maybe a
Just Char
'.', forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.00.000,1" (Quantity
100000.1, Word8
1, forall a. a -> Maybe a
Just Char
',', forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
'.' [Word8
3,Word8
2])
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000,000" (Quantity
1000000, Word8
0, forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3,Word8
3])
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1." (Quantity
1, Word8
0, forall a. a -> Maybe a
Just Char
'.', forall a. Maybe a
Nothing)
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1," (Quantity
1, Word8
0, forall a. a -> Maybe a
Just Char
',', forall a. Maybe a
Nothing)
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
".1" (Quantity
0.1, Word8
1, forall a. a -> Maybe a
Just Char
'.', forall a. Maybe a
Nothing)
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
",1" (Quantity
0.1, Word8
1, forall a. a -> Maybe a
Just Char
',', forall a. Maybe a
Nothing)
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"" [Char]
""
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000.000,1" [Char]
""
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.000,000.1" [Char]
""
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000.000.1" [Char]
""
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,,1" [Char]
""
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1..1" [Char]
""
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
".1," [Char]
""
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
",1." [Char]
""
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" (Quantity
1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555, Word8
255, forall a. a -> Maybe a
Just Char
'.', forall a. Maybe a
Nothing)
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" [Char]
""
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"spaceandamountormissingp" [
[Char] -> Assertion -> TestTree
testCase [Char]
"space and amount" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp Text
" $47.18" (Amount -> MixedAmount
mixedAmount forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
47.18)
,[Char] -> Assertion -> TestTree
testCase [Char]
"empty string" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp Text
"" MixedAmount
missingmixedamt
]
]