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