{-# 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,
parseAndFinaliseJournal',
journalFinalise,
journalCheckAccountsDeclared,
journalCheckCommoditiesDeclared,
journalCheckPayeesDeclared,
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, runExceptT, throwError)
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
(attachSource, customErrorBundlePretty, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion)
import Hledger.Data
import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery)
import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToReportOpts)
import Hledger.Utils
import Text.Printf (printf)
import Hledger.Read.InputOptions
data Reader m = Reader {
forall (m :: * -> *). Reader m -> [Char]
rFormat :: StorageFormat
,forall (m :: * -> *). Reader m -> [[Char]]
rExtensions :: [String]
,forall (m :: * -> *).
Reader m
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
rReadFn :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
,forall (m :: * -> *).
Reader m -> MonadIO m => ErroringJournalParser m Journal
rParser :: MonadIO m => ErroringJournalParser m ParsedJournal
}
instance Show (Reader m) where show :: Reader m -> [Char]
show Reader m
r = Reader m -> [Char]
forall (m :: * -> *). Reader m -> [Char]
rFormat Reader m
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" reader"
rawOptsToInputOpts :: Day -> RawOpts -> InputOpts
rawOptsToInputOpts :: Day -> RawOpts -> InputOpts
rawOptsToInputOpts Day
day RawOpts
rawopts =
let noinferprice :: Bool
noinferprice = [Char] -> RawOpts -> Bool
boolopt [Char]
"strict" RawOpts
rawopts Bool -> Bool -> Bool
|| [Char] -> RawOpts -> [Char]
stringopt [Char]
"args" RawOpts
rawopts [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"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 [Char] (Either Query QueryOpt)] -> [Either Query QueryOpt]
forall a b. [Either a b] -> [b]
rights ([Either [Char] (Either Query QueryOpt)]
-> [Either Query QueryOpt])
-> ([Text] -> [Either [Char] (Either Query QueryOpt)])
-> [Text]
-> [Either Query QueryOpt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either [Char] (Either Query QueryOpt))
-> [Text] -> [Either [Char] (Either Query QueryOpt)]
forall a b. (a -> b) -> [a] -> [b]
map (Day -> Text -> Either [Char] (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 = ([Char] -> Map Text AmountStyle)
-> (Map Text AmountStyle -> Map Text AmountStyle)
-> Either [Char] (Map Text AmountStyle)
-> Map Text AmountStyle
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Map Text AmountStyle
forall {a}. [Char] -> a
err Map Text AmountStyle -> Map Text AmountStyle
forall a. a -> a
id (Either [Char] (Map Text AmountStyle) -> Map Text AmountStyle)
-> Either [Char] (Map Text AmountStyle) -> Map Text AmountStyle
forall a b. (a -> b) -> a -> b
$ RawOpts -> Either [Char] (Map Text AmountStyle)
commodityStyleFromRawOpts RawOpts
rawopts
where err :: [Char] -> a
err [Char]
e = [Char] -> a
forall {a}. [Char] -> a
error' ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse commodity-style: '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
in InputOpts :: Maybe [Char]
-> Maybe [Char]
-> [[Char]]
-> Bool
-> Bool
-> Bool
-> [Char]
-> Maybe DateSpan
-> DateSpan
-> Bool
-> Bool
-> BalancingOpts
-> Bool
-> Day
-> InputOpts
InputOpts{
mformat_ :: Maybe [Char]
mformat_ = Maybe [Char]
forall a. Maybe a
Nothing
,mrules_file_ :: Maybe [Char]
mrules_file_ = [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"rules-file" RawOpts
rawopts
,aliases_ :: [[Char]]
aliases_ = [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"alias" RawOpts
rawopts
,anon_ :: Bool
anon_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"anon" RawOpts
rawopts
,new_ :: Bool
new_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"new" RawOpts
rawopts
,new_save_ :: Bool
new_save_ = Bool
True
,pivot_ :: [Char]
pivot_ = [Char] -> RawOpts -> [Char]
stringopt [Char]
"pivot" RawOpts
rawopts
,forecast_ :: Maybe DateSpan
forecast_ = Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts Day
day RawOpts
rawopts
,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_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"auto" RawOpts
rawopts
,infer_equity_ :: Bool
infer_equity_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"infer-equity" RawOpts
rawopts Bool -> Bool -> Bool
&& ReportOpts -> Maybe ConversionOp
conversionop_ ReportOpts
ropts 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_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"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_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"strict" RawOpts
rawopts
,_ioDay :: Day
_ioDay = Day
day
}
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts Day
d RawOpts
rawopts = do
[Char]
arg <- [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"forecast" RawOpts
rawopts
let period :: Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
period = Day
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr Day
d (Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan))
-> (Text -> Text)
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripquotes (Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan))
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
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 [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
arg then DateSpan
nulldatespan else (ParseErrorBundle Text CustomErr -> DateSpan)
-> ((Interval, DateSpan) -> DateSpan)
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> DateSpan
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseErrorBundle Text CustomErr -> DateSpan
forall {a}. ParseErrorBundle Text CustomErr -> a
badParse ([Char] -> (Interval, DateSpan) -> DateSpan
forall {b}. [Char] -> (Interval, b) -> b
getSpan [Char]
arg) Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
period
where
badParse :: ParseErrorBundle Text CustomErr -> a
badParse ParseErrorBundle Text CustomErr
e = [Char] -> a
forall {a}. [Char] -> a
usageError ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse forecast period : "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
getSpan :: [Char] -> (Interval, b) -> b
getSpan [Char]
arg (Interval
interval, b
requestedspan) = case Interval
interval of
Interval
NoInterval -> b
requestedspan
Interval
_ -> [Char] -> b
forall {a}. [Char] -> a
usageError ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [Char]
"--forecast's argument should not contain a report interval ("
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Interval -> [Char]
forall a. Show a => a -> [Char]
show Interval
interval [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
arg [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\")"
commodityStyleFromRawOpts :: RawOpts -> Either String (M.Map CommoditySymbol AmountStyle)
commodityStyleFromRawOpts :: RawOpts -> Either [Char] (Map Text AmountStyle)
commodityStyleFromRawOpts RawOpts
rawOpts =
(Map Text AmountStyle
-> [Char] -> Either [Char] (Map Text AmountStyle))
-> Map Text AmountStyle
-> [[Char]]
-> Either [Char] (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 [Char] (Text, AmountStyle)
-> Either [Char] (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 [Char] (Text, AmountStyle)
-> Either [Char] (Map Text AmountStyle))
-> ([Char] -> Either [Char] (Text, AmountStyle))
-> [Char]
-> Either [Char] (Map Text AmountStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] (Text, AmountStyle)
parseCommodity) Map Text AmountStyle
forall a. Monoid a => a
mempty [[Char]]
optList
where
optList :: [[Char]]
optList = [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"commodity-style" RawOpts
rawOpts
parseCommodity :: [Char] -> Either [Char] (Text, AmountStyle)
parseCommodity [Char]
optStr = case [Char] -> Either (ParseErrorBundle Text CustomErr) Amount
amountp'' [Char]
optStr of
Left ParseErrorBundle Text CustomErr
_ -> [Char] -> Either [Char] (Text, AmountStyle)
forall a b. a -> Either a b
Left [Char]
optStr
Right (Amount Text
acommodity Quantity
_ AmountStyle
astyle Maybe AmountPrice
_) -> (Text, AmountStyle) -> Either [Char] (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 -> [Char] -> Text -> ExceptT [Char] IO Journal
parseAndFinaliseJournal ErroringJournalParser IO Journal
parser InputOpts
iopts [Char]
f Text
txt = do
let 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 :: [[Char]]
jincludefilestack = [[Char]
f] }
Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal)
eep <- IO
(Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal))
-> ExceptT
[Char]
IO
(Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal))
-> ExceptT
[Char]
IO
(Either
FinalParseError
(Either (ParseErrorBundle Text CustomErr) Journal)))
-> IO
(Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal))
-> ExceptT
[Char]
IO
(Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal))
forall a b. (a -> b) -> a -> b
$ ExceptT
FinalParseError
IO
(Either (ParseErrorBundle Text CustomErr) Journal)
-> IO
(Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
FinalParseError
IO
(Either (ParseErrorBundle Text CustomErr) Journal)
-> IO
(Either
FinalParseError
(Either (ParseErrorBundle Text CustomErr) Journal)))
-> ExceptT
FinalParseError
IO
(Either (ParseErrorBundle Text CustomErr) Journal)
-> IO
(Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal))
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text (ExceptT FinalParseError IO) Journal
-> [Char]
-> Text
-> ExceptT
FinalParseError
IO
(Either (ParseErrorBundle Text CustomErr) Journal)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (ErroringJournalParser IO Journal
-> Journal
-> ParsecT CustomErr 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) [Char]
f Text
txt
case Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal)
eep of
Left FinalParseError
finalParseError -> [Char] -> ExceptT [Char] IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> ExceptT [Char] IO Journal)
-> [Char] -> ExceptT [Char] IO Journal
forall a b. (a -> b) -> a -> b
$ FinalParseErrorBundle' CustomErr -> [Char]
finalErrorBundlePretty (FinalParseErrorBundle' CustomErr -> [Char])
-> FinalParseErrorBundle' CustomErr -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
-> Text -> FinalParseError -> FinalParseErrorBundle' CustomErr
forall e.
[Char] -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
attachSource [Char]
f Text
txt FinalParseError
finalParseError
Right Either (ParseErrorBundle Text CustomErr) Journal
ep -> case Either (ParseErrorBundle Text CustomErr) Journal
ep of
Left ParseErrorBundle Text CustomErr
e -> [Char] -> ExceptT [Char] IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> ExceptT [Char] IO Journal)
-> [Char] -> ExceptT [Char] IO Journal
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
Right Journal
pj -> InputOpts -> [Char] -> Text -> Journal -> ExceptT [Char] IO Journal
journalFinalise InputOpts
iopts [Char]
f Text
txt Journal
pj
parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts
-> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal' :: JournalParser IO Journal
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
parseAndFinaliseJournal' JournalParser IO Journal
parser InputOpts
iopts [Char]
f Text
txt = do
let 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 :: [[Char]]
jincludefilestack = [[Char]
f] }
Either (ParseErrorBundle Text CustomErr) Journal
ep <- IO (Either (ParseErrorBundle Text CustomErr) Journal)
-> ExceptT
[Char] IO (Either (ParseErrorBundle Text CustomErr) Journal)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (ParseErrorBundle Text CustomErr) Journal)
-> ExceptT
[Char] IO (Either (ParseErrorBundle Text CustomErr) Journal))
-> IO (Either (ParseErrorBundle Text CustomErr) Journal)
-> ExceptT
[Char] IO (Either (ParseErrorBundle Text CustomErr) Journal)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text IO Journal
-> [Char]
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) Journal)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (JournalParser IO Journal
-> Journal -> ParsecT CustomErr Text IO Journal
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT JournalParser IO Journal
parser Journal
initJournal) [Char]
f Text
txt
case Either (ParseErrorBundle Text CustomErr) Journal
ep of
Left ParseErrorBundle Text CustomErr
e -> [Char] -> ExceptT [Char] IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([Char] -> ExceptT [Char] IO Journal)
-> [Char] -> ExceptT [Char] IO Journal
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
Right Journal
pj ->
case [AccountAlias] -> Journal -> Either [Char] Journal
journalApplyAliases (InputOpts -> [AccountAlias]
aliasesFromOpts InputOpts
iopts) Journal
pj of
Left [Char]
e -> [Char] -> ExceptT [Char] IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError [Char]
e
Right Journal
pj' -> InputOpts -> [Char] -> Text -> Journal -> ExceptT [Char] IO Journal
journalFinalise InputOpts
iopts [Char]
f Text
txt Journal
pj'
journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal
journalFinalise :: InputOpts -> [Char] -> Text -> Journal -> ExceptT [Char] 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} [Char]
f Text
txt Journal
pj = do
POSIXTime
t <- IO POSIXTime -> ExceptT [Char] IO POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
Either [Char] Journal -> ExceptT [Char] IO Journal
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] Journal -> ExceptT [Char] IO Journal)
-> Either [Char] Journal -> ExceptT [Char] 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
& ([Char], Text) -> Journal -> Journal
journalAddFile ([Char]
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 [Char] Journal) -> Either [Char] Journal
forall a b. a -> (a -> b) -> b
& Journal -> Either [Char] Journal
journalApplyCommodityStyles
Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] 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 [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalPostingsAddAccountTags
Either [Char] Journal
-> (Journal -> Either [Char] Journal) -> Either [Char] 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 [Char] Journal
journalAddAutoPostings Day
_ioDay BalancingOpts
balancingopts_
else Journal -> Either [Char] Journal
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
Either [Char] Journal
-> (Journal -> Either [Char] Journal) -> Either [Char] Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
balancingopts_
Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] 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 [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalInferMarketPricesFromTransactions
Bool -> Either [Char] () -> Either [Char] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
strict_ (Either [Char] () -> Either [Char] ())
-> Either [Char] () -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$ do
Journal -> Either [Char] ()
journalCheckAccountsDeclared Journal
j
Journal -> Either [Char] ()
journalCheckCommoditiesDeclared Journal
j
Journal -> Either [Char] Journal
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j
journalAddAutoPostings :: Day -> BalancingOpts -> Journal -> Either String Journal
journalAddAutoPostings :: Day -> BalancingOpts -> Journal -> Either [Char] Journal
journalAddAutoPostings Day
d BalancingOpts
bopts =
BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
bopts{ignore_assertions_ :: Bool
ignore_assertions_=Bool
True}
(Journal -> Either [Char] Journal)
-> (Journal -> Either [Char] Journal)
-> Journal
-> Either [Char] Journal
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Day -> Journal -> Either [Char] 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
journalCheckPayeesDeclared :: Journal -> Either String ()
journalCheckPayeesDeclared :: Journal -> Either [Char] ()
journalCheckPayeesDeclared Journal
j = (Transaction -> Either [Char] ())
-> [Transaction] -> Either [Char] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Transaction -> Either [Char] ()
checkpayee (Journal -> [Transaction]
jtxns Journal
j)
where
checkpayee :: Transaction -> Either [Char] ()
checkpayee Transaction
t
| Text
p Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ps = () -> Either [Char] ()
forall a b. b -> Either a b
Right ()
| Bool
otherwise = [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ()) -> [Char] -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$
[Char] -> [Char] -> [Char] -> Text -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"undeclared payee \"%s\"\nat: %s\n\n%s"
(Text -> [Char]
T.unpack Text
p)
((SourcePos, SourcePos) -> [Char]
showSourcePosPair ((SourcePos, SourcePos) -> [Char])
-> (SourcePos, SourcePos) -> [Char]
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t)
(Text -> Text -> Text -> Text
linesPrepend2 Text
"> " Text
" " (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
textChomp (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t)
where
p :: Text
p = Transaction -> Text
transactionPayee Transaction
t
ps :: [Text]
ps = Journal -> [Text]
journalPayeesDeclared Journal
j
journalCheckAccountsDeclared :: Journal -> Either String ()
journalCheckAccountsDeclared :: Journal -> Either [Char] ()
journalCheckAccountsDeclared Journal
j = (Posting -> Either [Char] ()) -> [Posting] -> Either [Char] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> Either [Char] ()
checkacct (Journal -> [Posting]
journalPostings Journal
j)
where
checkacct :: Posting -> Either [Char] ()
checkacct Posting{Text
paccount :: Posting -> Text
paccount :: Text
paccount,Maybe Transaction
ptransaction :: Posting -> Maybe Transaction
ptransaction :: Maybe Transaction
ptransaction}
| Text
paccount Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
as = () -> Either [Char] ()
forall a b. b -> Either a b
Right ()
| Bool
otherwise = [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ()) -> [Char] -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$
([Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"undeclared account \"%s\"\n" (Text -> [Char]
T.unpack Text
paccount))
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ case Maybe Transaction
ptransaction of
Maybe Transaction
Nothing -> [Char]
""
Just Transaction
t -> [Char] -> [Char] -> Text -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"in transaction at: %s\n\n%s"
((SourcePos, SourcePos) -> [Char]
showSourcePosPair ((SourcePos, SourcePos) -> [Char])
-> (SourcePos, SourcePos) -> [Char]
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t)
(Text -> Text -> Text
linesPrepend Text
" " (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
textChomp (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t)
where
as :: [Text]
as = Journal -> [Text]
journalAccountNamesDeclared Journal
j
journalCheckCommoditiesDeclared :: Journal -> Either String ()
journalCheckCommoditiesDeclared :: Journal -> Either [Char] ()
journalCheckCommoditiesDeclared Journal
j =
(Posting -> Either [Char] ()) -> [Posting] -> Either [Char] ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> Either [Char] ()
checkcommodities (Journal -> [Posting]
journalPostings Journal
j)
where
checkcommodities :: Posting -> Either [Char] ()
checkcommodities Posting{[Tag]
Maybe Day
Maybe Transaction
Maybe Posting
Maybe BalanceAssertion
Text
Status
PostingType
MixedAmount
poriginal :: Posting -> Maybe Posting
pbalanceassertion :: Posting -> Maybe BalanceAssertion
ptags :: Posting -> [Tag]
ptype :: Posting -> PostingType
pcomment :: Posting -> Text
pamount :: Posting -> MixedAmount
pstatus :: Posting -> Status
pdate2 :: Posting -> Maybe Day
pdate :: Posting -> Maybe Day
poriginal :: Maybe Posting
ptransaction :: Maybe Transaction
pbalanceassertion :: Maybe BalanceAssertion
ptags :: [Tag]
ptype :: PostingType
pcomment :: Text
pamount :: MixedAmount
paccount :: Text
pstatus :: Status
pdate2 :: Maybe Day
pdate :: Maybe Day
ptransaction :: Posting -> Maybe Transaction
paccount :: Posting -> Text
..} =
case Maybe Text
mfirstundeclaredcomm of
Maybe Text
Nothing -> () -> Either [Char] ()
forall a b. b -> Either a b
Right ()
Just Text
c -> [Char] -> Either [Char] ()
forall a b. a -> Either a b
Left ([Char] -> Either [Char] ()) -> [Char] -> Either [Char] ()
forall a b. (a -> b) -> a -> b
$
([Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"undeclared commodity \"%s\"\n" (Text -> [Char]
T.unpack Text
c))
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ case Maybe Transaction
ptransaction of
Maybe Transaction
Nothing -> [Char]
""
Just Transaction
t -> [Char] -> [Char] -> Text -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"in transaction at: %s\n\n%s"
((SourcePos, SourcePos) -> [Char]
showSourcePosPair ((SourcePos, SourcePos) -> [Char])
-> (SourcePos, SourcePos) -> [Char]
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t)
(Text -> Text -> Text
linesPrepend Text
" " (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
textChomp (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t)
where
mfirstundeclaredcomm :: Maybe Text
mfirstundeclaredcomm =
(Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Map Text Commodity -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Journal -> Map Text Commodity
jcommodities Journal
j)
([Text] -> Maybe Text)
-> ([Amount] -> [Text]) -> [Amount] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Text) -> [Amount] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Text
acommodity
([Amount] -> [Text])
-> ([Amount] -> [Amount]) -> [Amount] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Amount] -> [Amount])
-> (BalanceAssertion -> [Amount] -> [Amount])
-> Maybe BalanceAssertion
-> [Amount]
-> [Amount]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Amount] -> [Amount]
forall a. a -> a
id ((:) (Amount -> [Amount] -> [Amount])
-> (BalanceAssertion -> Amount)
-> BalanceAssertion
-> [Amount]
-> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalanceAssertion -> Amount
baamount) Maybe BalanceAssertion
pbalanceassertion)
([Amount] -> [Amount])
-> ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> Bool) -> [Amount] -> [Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Amount -> Bool) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Bool
isIgnorable)
([Amount] -> Maybe Text) -> [Amount] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amountsRaw MixedAmount
pamount
isIgnorable :: Amount -> Bool
isIgnorable Amount
a = (Text -> Bool
T.null (Amount -> Text
acommodity Amount
a) Bool -> Bool -> Bool
&& Amount -> Bool
amountIsZero Amount
a) Bool -> Bool -> Bool
|| Amount
a Amount -> Amount -> Bool
forall a. Eq a => a -> a -> Bool
== Amount
missingamt
setYear :: Year -> JournalParser m ()
setYear :: forall (m :: * -> *). Integer -> JournalParser m ()
setYear Integer
y = (Journal -> Journal)
-> StateT Journal (ParsecT CustomErr Text 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 :: forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear = (Journal -> Maybe Integer)
-> StateT Journal (ParsecT CustomErr Text m) Journal
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> Maybe Integer
jparsedefaultyear StateT Journal (ParsecT CustomErr Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
getDecimalMarkStyle :: JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle :: forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle = do
Journal{Maybe Char
jparsedecimalmark :: Journal -> Maybe Char
jparsedecimalmark :: Maybe Char
jparsedecimalmark} <- StateT Journal (ParsecT CustomErr Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
let mdecmarkStyle :: Maybe AmountStyle
mdecmarkStyle = (\Char
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 Char
asdecimalpoint=Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c}) (Char -> Maybe AmountStyle) -> Maybe Char -> Maybe AmountStyle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Char
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 :: forall (m :: * -> *). (Text, AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle (Text, AmountStyle)
cs = (Journal -> Journal)
-> StateT Journal (ParsecT CustomErr Text 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 :: forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle = Journal -> Maybe (Text, AmountStyle)
jparsedefaultcommodity (Journal -> Maybe (Text, AmountStyle))
-> StateT Journal (ParsecT CustomErr Text m) Journal
-> StateT
Journal (ParsecT CustomErr Text m) (Maybe (Text, AmountStyle))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` StateT Journal (ParsecT CustomErr Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
getDefaultAmountStyle :: JournalParser m (Maybe AmountStyle)
getDefaultAmountStyle :: forall (m :: * -> *). 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 CustomErr Text m) (Maybe (Text, AmountStyle))
-> StateT Journal (ParsecT CustomErr Text m) (Maybe AmountStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
Journal (ParsecT CustomErr Text m) (Maybe (Text, AmountStyle))
forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle
getAmountStyle :: CommoditySymbol -> JournalParser m (Maybe AmountStyle)
getAmountStyle :: forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
commodity = do
Journal{Map Text Commodity
jcommodities :: Map Text Commodity
jcommodities :: Journal -> Map Text Commodity
jcommodities} <- StateT Journal (ParsecT CustomErr 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 CustomErr Text m) (Maybe (Text, AmountStyle))
-> JournalParser m (Maybe AmountStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
Journal (ParsecT CustomErr 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 :: forall (m :: * -> *). Text -> [Tag] -> JournalParser m ()
addDeclaredAccountTags Text
acct [Tag]
atags =
(Journal -> Journal)
-> StateT Journal (ParsecT CustomErr Text 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 :: forall (m :: * -> *). Text -> AccountType -> JournalParser m ()
addDeclaredAccountType Text
acct AccountType
atype =
(Journal -> Journal)
-> StateT Journal (ParsecT CustomErr Text 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 :: forall (m :: * -> *). Text -> JournalParser m ()
pushParentAccount Text
acct = (Journal -> Journal)
-> StateT Journal (ParsecT CustomErr Text 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 :: forall (m :: * -> *). JournalParser m ()
popParentAccount = do
Journal
j <- StateT Journal (ParsecT CustomErr 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 Char -> ErrorItem Char
forall t. NonEmpty t -> ErrorItem t
Tokens (Char
'E' Char -> [Char] -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| [Char]
"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 :: forall (m :: * -> *). JournalParser m Text
getParentAccount = (Journal -> Text)
-> StateT Journal (ParsecT CustomErr Text m) Journal
-> StateT Journal (ParsecT CustomErr Text 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 CustomErr Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
addAccountAlias :: MonadState Journal m => AccountAlias -> m ()
addAccountAlias :: forall (m :: * -> *). MonadState Journal m => AccountAlias -> m ()
addAccountAlias AccountAlias
a = (Journal -> Journal) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\(j :: Journal
j@Journal{[[Char]]
[([Char], Text)]
[(Text, AccountDeclarationInfo)]
[(Text, PayeeDeclarationInfo)]
[Text]
[MarketPrice]
[PriceDirective]
[TimeclockEntry]
[PeriodicTransaction]
[TransactionModifier]
[Transaction]
[AccountAlias]
Maybe Char
Maybe Integer
Maybe (Text, AmountStyle)
Text
Map Text [Tag]
Map Text Commodity
Map Text AmountStyle
Map Text AccountType
Map AccountType [Text]
POSIXTime
jlastreadtime :: Journal -> POSIXTime
jfiles :: Journal -> [([Char], Text)]
jfinalcommentlines :: Journal -> Text
jinferredmarketprices :: Journal -> [MarketPrice]
jpricedirectives :: Journal -> [PriceDirective]
jinferredcommodities :: Journal -> Map Text AmountStyle
jaccounttypes :: Journal -> Map Text AccountType
jdeclaredaccounts :: Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredpayees :: Journal -> [(Text, PayeeDeclarationInfo)]
jparsetimeclockentries :: Journal -> [TimeclockEntry]
jparsealiases :: Journal -> [AccountAlias]
jlastreadtime :: POSIXTime
jfiles :: [([Char], Text)]
jfinalcommentlines :: Text
jtxns :: [Transaction]
jperiodictxns :: [PeriodicTransaction]
jtxnmodifiers :: [TransactionModifier]
jinferredmarketprices :: [MarketPrice]
jpricedirectives :: [PriceDirective]
jinferredcommodities :: Map Text AmountStyle
jcommodities :: Map Text Commodity
jglobalcommoditystyles :: Map Text AmountStyle
jaccounttypes :: Map Text AccountType
jdeclaredaccounttypes :: Map AccountType [Text]
jdeclaredaccounttags :: Map Text [Tag]
jdeclaredaccounts :: [(Text, AccountDeclarationInfo)]
jdeclaredpayees :: [(Text, PayeeDeclarationInfo)]
jincludefilestack :: [[Char]]
jparsetimeclockentries :: [TimeclockEntry]
jparsealiases :: [AccountAlias]
jparseparentaccounts :: [Text]
jparsedecimalmark :: Maybe Char
jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultyear :: Maybe Integer
jparseparentaccounts :: Journal -> [Text]
jdeclaredaccounttypes :: Journal -> Map AccountType [Text]
jdeclaredaccounttags :: Journal -> Map Text [Tag]
jparsedefaultcommodity :: Journal -> Maybe (Text, AmountStyle)
jparsedecimalmark :: Journal -> Maybe Char
jcommodities :: Journal -> Map Text Commodity
jperiodictxns :: Journal -> [PeriodicTransaction]
jtxns :: Journal -> [Transaction]
jtxnmodifiers :: Journal -> [TransactionModifier]
jglobalcommoditystyles :: Journal -> Map Text AmountStyle
jincludefilestack :: Journal -> [[Char]]
jparsedefaultyear :: Journal -> Maybe Integer
..}) -> Journal
j{jparsealiases :: [AccountAlias]
jparsealiases=AccountAlias
aAccountAlias -> [AccountAlias] -> [AccountAlias]
forall a. a -> [a] -> [a]
:[AccountAlias]
jparsealiases})
getAccountAliases :: MonadState Journal m => m [AccountAlias]
getAccountAliases :: forall (m :: * -> *). MonadState Journal m => 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 :: forall (m :: * -> *). MonadState Journal m => 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 :: ([Char], Text) -> Journal -> Journal
journalAddFile ([Char], Text)
f j :: Journal
j@Journal{jfiles :: Journal -> [([Char], Text)]
jfiles=[([Char], Text)]
fs} = Journal
j{jfiles :: [([Char], Text)]
jfiles=[([Char], Text)]
fs[([Char], Text)] -> [([Char], Text)] -> [([Char], Text)]
forall a. [a] -> [a] -> [a]
++[([Char], Text)
f]}
match' :: TextParser m a -> TextParser m (Text, a)
match' :: forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' TextParser m a
p = do
(!Text
txt, a
p) <- TextParser m a -> ParsecT CustomErr 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 :: forall (m :: * -> *). TextParser m Status
statusp =
[TextParser m Status] -> TextParser m Status
forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice'
[ ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*' ParsecT CustomErr Text m Char
-> 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 CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'!' ParsecT CustomErr Text m Char
-> 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 :: forall (m :: * -> *). TextParser m Text
codep = Text
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" (ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall a b. (a -> b) -> a -> b
$ do
ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char)
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
forall a b. (a -> b) -> a -> b
$ do
ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'('
Text
code <- Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing ((Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text))
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n'
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT CustomErr Text m Char
-> [Char] -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"closing bracket ')' for transaction code"
Text -> ParsecT CustomErr Text m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
code
descriptionp :: TextParser m Text
descriptionp :: forall (m :: * -> *). TextParser m Text
descriptionp = TextParser m Text
forall (m :: * -> *). TextParser m Text
noncommenttextp TextParser m Text -> [Char] -> TextParser m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"description"
datep :: JournalParser m Day
datep :: forall (m :: * -> *). JournalParser m Day
datep = do
Maybe Integer
mYear <- JournalParser m (Maybe Integer)
forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
ParsecT CustomErr Text m Day -> JournalParser m Day
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m Day -> JournalParser m Day)
-> ParsecT CustomErr Text m Day -> JournalParser m Day
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> ParsecT CustomErr Text m Day
forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear
datep' :: Maybe Year -> TextParser m Day
datep' :: forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear = do
Int
startOffset <- ParsecT CustomErr 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)
-> [Char] -> TextParser m (Either Integer Int)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"year or month"
Char
sep <- TextParser m Char
forall (m :: * -> *). TextParser m Char
datesepchar TextParser m Char -> [Char] -> TextParser m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"date separator"
Int
d2 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT CustomErr Text m Int
-> [Char] -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"month or day"
case Either Integer Int
d1 of
Left Integer
y -> Int -> Integer -> Char -> Int -> ParsecT CustomErr Text m Day
forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
y Char
sep Int
d2
Right Int
m -> Int
-> Maybe Integer
-> Int
-> Char
-> Int
-> ParsecT CustomErr Text m Day
forall (m :: * -> *).
Int -> Maybe Integer -> Int -> Char -> Int -> TextParser m Day
partialDate Int
startOffset Maybe Integer
mYear Int
m Char
sep Int
d2
ParsecT CustomErr Text m Day
-> [Char] -> ParsecT CustomErr Text m Day
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"full or partial date"
where
fullDate :: Int -> Year -> Char -> Month -> TextParser m Day
fullDate :: forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
year Char
sep1 Int
month = do
Char
sep2 <- (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isDateSepChar ParsecT CustomErr Text m Char
-> [Char] -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"date separator"
Int
day <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT CustomErr Text m Int
-> [Char] -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"day"
Int
endOffset <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
let dateStr :: [Char]
dateStr = Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
year [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
sep1] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
month [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
sep2] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
day
Bool -> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
sep1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
sep2) (ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ CustomErr -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> ParsecT CustomErr Text m ())
-> CustomErr -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> CustomErr
parseErrorAtRegion Int
startOffset Int
endOffset ([Char] -> CustomErr) -> [Char] -> CustomErr
forall a b. (a -> b) -> a -> b
$
[Char]
"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 -> CustomErr -> TextParser m Day
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> TextParser m Day) -> CustomErr -> TextParser m Day
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> CustomErr
parseErrorAtRegion Int
startOffset Int
endOffset ([Char] -> CustomErr) -> [Char] -> CustomErr
forall a b. (a -> b) -> a -> b
$
[Char]
"well-formed but invalid date: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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 :: forall (m :: * -> *).
Int -> Maybe Integer -> Int -> Char -> Int -> TextParser m Day
partialDate Int
startOffset Maybe Integer
mYear Int
month Char
sep Int
day = do
Int
endOffset <- ParsecT CustomErr 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 -> CustomErr -> TextParser m Day
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> TextParser m Day) -> CustomErr -> TextParser m Day
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> CustomErr
parseErrorAtRegion Int
startOffset Int
endOffset ([Char] -> CustomErr) -> [Char] -> CustomErr
forall a b. (a -> b) -> a -> b
$
[Char]
"well-formed but invalid date: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
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 :: [Char]
dateStr = Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
year [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
sep] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
month [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
sep] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
day
Maybe Integer
Nothing -> CustomErr -> TextParser m Day
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> TextParser m Day) -> CustomErr -> TextParser m Day
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> CustomErr
parseErrorAtRegion Int
startOffset Int
endOffset ([Char] -> CustomErr) -> [Char] -> CustomErr
forall a b. (a -> b) -> a -> b
$
[Char]
"partial date "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
dateStr[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" found, but the current year is unknown"
where dateStr :: [Char]
dateStr = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
month [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
sep] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
day
{-# INLINABLE datep' #-}
datetimep :: JournalParser m LocalTime
datetimep :: forall (m :: * -> *). JournalParser m LocalTime
datetimep = do
Maybe Integer
mYear <- JournalParser m (Maybe Integer)
forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
ParsecT CustomErr Text m LocalTime -> JournalParser m LocalTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m LocalTime -> JournalParser m LocalTime)
-> ParsecT CustomErr Text m LocalTime -> JournalParser m LocalTime
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> ParsecT CustomErr Text m LocalTime
forall (m :: * -> *). Maybe Integer -> TextParser m LocalTime
datetimep' Maybe Integer
mYear
datetimep' :: Maybe Year -> TextParser m LocalTime
datetimep' :: forall (m :: * -> *). Maybe Integer -> TextParser m LocalTime
datetimep' Maybe Integer
mYear = do
Day
day <- Maybe Integer -> TextParser m Day
forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear
ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
TimeOfDay
time <- TextParser m TimeOfDay
forall (m :: * -> *). TextParser m TimeOfDay
timeOfDay
ParsecT CustomErr Text m [Char]
-> ParsecT CustomErr Text m (Maybe [Char])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT CustomErr Text m [Char]
forall (m :: * -> *). TextParser m [Char]
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 :: forall (m :: * -> *). TextParser m TimeOfDay
timeOfDay = do
Int
off1 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Int
h' <- ParsecT CustomErr Text m Int
forall (m :: * -> *). TextParser m Int
twoDigitDecimal ParsecT CustomErr Text m Int
-> [Char] -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"hour"
Int
off2 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Bool -> ParsecT CustomErr Text m () -> ParsecT CustomErr 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 CustomErr Text m () -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ CustomErr -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> ParsecT CustomErr Text m ())
-> CustomErr -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$
Int -> Int -> [Char] -> CustomErr
parseErrorAtRegion Int
off1 Int
off2 [Char]
"invalid time (bad hour)"
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' ParsecT CustomErr Text m Char
-> [Char] -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"':' (hour-minute separator)"
Int
off3 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Int
m' <- ParsecT CustomErr Text m Int
forall (m :: * -> *). TextParser m Int
twoDigitDecimal ParsecT CustomErr Text m Int
-> [Char] -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"minute"
Int
off4 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Bool -> ParsecT CustomErr Text m () -> ParsecT CustomErr 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 CustomErr Text m () -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ CustomErr -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> ParsecT CustomErr Text m ())
-> CustomErr -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$
Int -> Int -> [Char] -> CustomErr
parseErrorAtRegion Int
off3 Int
off4 [Char]
"invalid time (bad minute)"
Int
s' <- Int -> ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
0 (ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int)
-> ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
forall a b. (a -> b) -> a -> b
$ do
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' ParsecT CustomErr Text m Char
-> [Char] -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"':' (minute-second separator)"
Int
off5 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Int
s' <- ParsecT CustomErr Text m Int
forall (m :: * -> *). TextParser m Int
twoDigitDecimal ParsecT CustomErr Text m Int
-> [Char] -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"second"
Int
off6 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Bool -> ParsecT CustomErr Text m () -> ParsecT CustomErr 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 CustomErr Text m () -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ CustomErr -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> ParsecT CustomErr Text m ())
-> CustomErr -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$
Int -> Int -> [Char] -> CustomErr
parseErrorAtRegion Int
off5 Int
off6 [Char]
"invalid time (bad second)"
Int -> ParsecT CustomErr 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 :: forall (m :: * -> *). TextParser m Int
twoDigitDecimal = do
Int
d1 <- Char -> Int
digitToInt (Char -> Int) -> ParsecT CustomErr Text m Char -> TextParser m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
Int
d2 <- Char -> Int
digitToInt (Char -> Int) -> ParsecT CustomErr Text m Char -> TextParser m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT CustomErr Text m Char
-> [Char] -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"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 :: forall (m :: * -> *). TextParser m [Char]
timeZone = do
Char
plusminus <- (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text))
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'
[Char]
fourDigits <- Int -> ParsecT CustomErr Text m Char -> TextParser m [Char]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 (ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar ParsecT CustomErr Text m Char
-> [Char] -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a digit (for a time zone)")
[Char] -> TextParser m [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> TextParser m [Char]) -> [Char] -> TextParser m [Char]
forall a b. (a -> b) -> a -> b
$ Char
plusminusChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
fourDigits
secondarydatep :: Day -> TextParser m Day
secondarydatep :: forall (m :: * -> *). Day -> TextParser m Day
secondarydatep Day
primaryDate = Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'=' ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m Day -> ParsecT CustomErr Text m Day
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Integer -> ParsecT CustomErr Text 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 :: forall (m :: * -> *). TextParser m (Either Integer Int)
yearorintp = do
Text
yearOrMonth <- Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"digit") Char -> 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 :: forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep = do
Text
parent <- JournalParser m Text
forall (m :: * -> *). JournalParser m Text
getParentAccount
[AccountAlias]
aliases <- StateT Journal (ParsecT CustomErr Text m) [AccountAlias]
forall (m :: * -> *). MonadState Journal m => m [AccountAlias]
getAccountAliases
Text
a <- ParsecT CustomErr Text m Text -> JournalParser m Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Text
forall (m :: * -> *). TextParser m Text
accountnamep
case [AccountAlias] -> Text -> Either [Char] Text
accountNameApplyAliases [AccountAlias]
aliases (Text -> Either [Char] Text) -> Text -> Either [Char] 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 [Char]
e -> [Char] -> JournalParser m Text
forall {a}. [Char] -> a
error' [Char]
err
where
err :: [Char]
err = [Char]
"problem in account alias applied to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Text -> [Char]
T.unpack Text
a[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
": "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
e
accountnamep :: TextParser m AccountName
accountnamep :: forall (m :: * -> *). TextParser m Text
accountnamep = TextParser m Text
forall (m :: * -> *). TextParser m Text
singlespacedtext1p
noncommenttextp :: TextParser m T.Text
= Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSameLineCommentStart Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isNewline Char
Token Text
c)
noncommenttext1p :: TextParser m T.Text
= Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSameLineCommentStart Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isNewline Char
Token Text
c)
singlespacedtext1p :: TextParser m T.Text
singlespacedtext1p :: forall (m :: * -> *). TextParser m Text
singlespacedtext1p = (Char -> Bool) -> TextParser m Text
forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
singlespacednoncommenttext1p :: TextParser m T.Text
= (Char -> Bool) -> TextParser m Text
forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSameLineCommentStart)
singlespacedtextsatisfying1p :: (Char -> Bool) -> TextParser m T.Text
singlespacedtextsatisfying1p :: forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p Char -> Bool
pred = do
Text
firstPart <- TextParser m Text
ParsecT CustomErr Text m (Tokens Text)
partp
[Text]
otherParts <- TextParser m Text -> ParsecT CustomErr Text m [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (TextParser m Text -> ParsecT CustomErr Text m [Text])
-> TextParser m Text -> ParsecT CustomErr 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 CustomErr 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 CustomErr Text m (Tokens Text)
partp = Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
pred Char
Token Text
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
Token Text
c))
singlespacep :: TextParser m ()
singlespacep :: forall (m :: * -> *). TextParser m ()
singlespacep = ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
spaceandamountormissingp :: JournalParser m MixedAmount
spaceandamountormissingp :: forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp =
MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option MixedAmount
missingmixedamt (StateT Journal (ParsecT CustomErr Text m) MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount)
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Journal (ParsecT CustomErr Text m) MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount)
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
forall a b. (a -> b) -> a -> b
$ do
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ())
-> ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1
Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount)
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) MixedAmount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) Amount
forall (m :: * -> *). JournalParser m Amount
amountp
amountp :: JournalParser m Amount
amountp :: forall (m :: * -> *). JournalParser m Amount
amountp = Bool -> JournalParser m Amount
forall (m :: * -> *). Bool -> JournalParser m Amount
amountpwithmultiplier Bool
False
amountpwithmultiplier :: Bool -> JournalParser m Amount
amountpwithmultiplier :: forall (m :: * -> *). Bool -> JournalParser m Amount
amountpwithmultiplier Bool
mult = [Char]
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" (StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount)
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall a b. (a -> b) -> a -> b
$ do
let spaces :: StateT Journal (ParsecT CustomErr Text m) ()
spaces = ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ())
-> ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Amount
amount <- Bool -> StateT Journal (ParsecT CustomErr Text m) Amount
forall (m :: * -> *). Bool -> JournalParser m Amount
amountwithoutpricep Bool
mult StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces
(Maybe AmountPrice
mprice, Maybe ()
_elotprice, Maybe ()
_elotdate) <- Permutation
(StateT Journal (ParsecT CustomErr Text m))
(Maybe AmountPrice, Maybe (), Maybe ())
-> StateT
Journal
(ParsecT CustomErr Text m)
(Maybe AmountPrice, Maybe (), Maybe ())
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation
(StateT Journal (ParsecT CustomErr Text m))
(Maybe AmountPrice, Maybe (), Maybe ())
-> StateT
Journal
(ParsecT CustomErr Text m)
(Maybe AmountPrice, Maybe (), Maybe ()))
-> Permutation
(StateT Journal (ParsecT CustomErr Text m))
(Maybe AmountPrice, Maybe (), Maybe ())
-> StateT
Journal
(ParsecT CustomErr 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 CustomErr Text m)) (Maybe AmountPrice)
-> Permutation
(StateT Journal (ParsecT CustomErr 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 CustomErr Text m) (Maybe AmountPrice)
-> Permutation
(StateT Journal (ParsecT CustomErr 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 CustomErr Text m) AmountPrice
-> StateT Journal (ParsecT CustomErr Text m) (Maybe AmountPrice)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Amount -> StateT Journal (ParsecT CustomErr Text m) AmountPrice
forall (m :: * -> *). Amount -> JournalParser m AmountPrice
priceamountp Amount
amount StateT Journal (ParsecT CustomErr Text m) (Maybe AmountPrice)
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) (Maybe AmountPrice)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces)
Permutation
(StateT Journal (ParsecT CustomErr Text m))
(Maybe () -> Maybe () -> (Maybe AmountPrice, Maybe (), Maybe ()))
-> Permutation
(StateT Journal (ParsecT CustomErr Text m)) (Maybe ())
-> Permutation
(StateT Journal (ParsecT CustomErr Text m))
(Maybe () -> (Maybe AmountPrice, Maybe (), Maybe ()))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ()
-> StateT Journal (ParsecT CustomErr Text m) (Maybe ())
-> Permutation
(StateT Journal (ParsecT CustomErr 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 CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). JournalParser m ()
lotpricep StateT Journal (ParsecT CustomErr Text m) (Maybe ())
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces)
Permutation
(StateT Journal (ParsecT CustomErr Text m))
(Maybe () -> (Maybe AmountPrice, Maybe (), Maybe ()))
-> Permutation
(StateT Journal (ParsecT CustomErr Text m)) (Maybe ())
-> Permutation
(StateT Journal (ParsecT CustomErr Text m))
(Maybe AmountPrice, Maybe (), Maybe ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ()
-> StateT Journal (ParsecT CustomErr Text m) (Maybe ())
-> Permutation
(StateT Journal (ParsecT CustomErr 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 CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). JournalParser m ()
lotdatep StateT Journal (ParsecT CustomErr Text m) (Maybe ())
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) (Maybe ())
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces)
Amount -> StateT Journal (ParsecT CustomErr Text m) Amount
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Amount -> StateT Journal (ParsecT CustomErr Text m) Amount)
-> Amount -> StateT Journal (ParsecT CustomErr Text m) Amount
forall a b. (a -> b) -> a -> b
$ Amount
amount { aprice :: Maybe AmountPrice
aprice = Maybe AmountPrice
mprice }
amountpnolotpricesp :: JournalParser m Amount
amountpnolotpricesp :: forall (m :: * -> *). JournalParser m Amount
amountpnolotpricesp = [Char]
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" (StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount)
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall a b. (a -> b) -> a -> b
$ do
let spaces :: StateT Journal (ParsecT CustomErr Text m) ()
spaces = ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ())
-> ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Amount
amount <- Bool -> StateT Journal (ParsecT CustomErr Text m) Amount
forall (m :: * -> *). Bool -> JournalParser m Amount
amountwithoutpricep Bool
False
StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces
Maybe AmountPrice
mprice <- StateT Journal (ParsecT CustomErr Text m) AmountPrice
-> StateT Journal (ParsecT CustomErr Text m) (Maybe AmountPrice)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT CustomErr Text m) AmountPrice
-> StateT Journal (ParsecT CustomErr Text m) (Maybe AmountPrice))
-> StateT Journal (ParsecT CustomErr Text m) AmountPrice
-> StateT Journal (ParsecT CustomErr Text m) (Maybe AmountPrice)
forall a b. (a -> b) -> a -> b
$ Amount -> StateT Journal (ParsecT CustomErr Text m) AmountPrice
forall (m :: * -> *). Amount -> JournalParser m AmountPrice
priceamountp Amount
amount StateT Journal (ParsecT CustomErr Text m) AmountPrice
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) AmountPrice
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces
Amount -> StateT Journal (ParsecT CustomErr Text m) Amount
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Amount -> StateT Journal (ParsecT CustomErr Text m) Amount)
-> Amount -> StateT Journal (ParsecT CustomErr Text m) Amount
forall a b. (a -> b) -> a -> b
$ Amount
amount { aprice :: Maybe AmountPrice
aprice = Maybe AmountPrice
mprice }
amountwithoutpricep :: Bool -> JournalParser m Amount
amountwithoutpricep :: forall (m :: * -> *). Bool -> JournalParser m Amount
amountwithoutpricep Bool
mult = do
Quantity -> Quantity
sign <- ParsecT CustomErr Text m (Quantity -> Quantity)
-> StateT Journal (ParsecT CustomErr Text m) (Quantity -> Quantity)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr 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 :: forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
leftsymbolamountp Quantity -> Quantity
sign = [Char]
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" (StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount)
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall a b. (a -> b) -> a -> b
$ do
Text
c <- ParsecT CustomErr Text m Text
-> StateT Journal (ParsecT CustomErr Text m) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr 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 CustomErr Text m Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m Bool
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m Bool
skipNonNewlineSpaces'
Quantity -> Quantity
sign2 <- ParsecT CustomErr Text m (Quantity -> Quantity)
-> StateT Journal (ParsecT CustomErr Text m) (Quantity -> Quantity)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Quantity -> Quantity)
-> StateT
Journal (ParsecT CustomErr Text m) (Quantity -> Quantity))
-> ParsecT CustomErr Text m (Quantity -> Quantity)
-> StateT Journal (ParsecT CustomErr Text m) (Quantity -> Quantity)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m (Quantity -> Quantity)
forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
Int
offBeforeNum <- StateT Journal (ParsecT CustomErr Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Either AmbiguousNumber RawNumber
ambiguousRawNum <- ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Either AmbiguousNumber RawNumber)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
Maybe Integer
mExponent <- ParsecT CustomErr Text m (Maybe Integer)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Integer)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Maybe Integer)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Integer))
-> ParsecT CustomErr Text m (Maybe Integer)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m (Maybe Integer))
-> ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomErr Text m Integer
forall (m :: * -> *). TextParser m Integer
exponentp
Int
offAfterNum <- StateT Journal (ParsecT CustomErr 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 Char
mdec,Maybe DigitGroupStyle
mgrps) <- ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
suggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
let s :: AmountStyle
s = AmountStyle
amountstyle{ascommodityside :: Side
ascommodityside=Side
L, ascommodityspaced :: Bool
ascommodityspaced=Bool
commodityspaced, asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
Amount -> StateT Journal (ParsecT CustomErr Text 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 :: forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
rightornosymbolamountp Quantity -> Quantity
sign = [Char]
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" (StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount)
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall a b. (a -> b) -> a -> b
$ do
Int
offBeforeNum <- StateT Journal (ParsecT CustomErr Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Either AmbiguousNumber RawNumber
ambiguousRawNum <- ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Either AmbiguousNumber RawNumber)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
Maybe Integer
mExponent <- ParsecT CustomErr Text m (Maybe Integer)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Integer)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Maybe Integer)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Integer))
-> ParsecT CustomErr Text m (Maybe Integer)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m (Maybe Integer))
-> ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomErr Text m Integer
forall (m :: * -> *). TextParser m Integer
exponentp
Int
offAfterNum <- StateT Journal (ParsecT CustomErr 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 CustomErr Text m (Maybe (Bool, Text))
-> StateT Journal (ParsecT CustomErr Text m) (Maybe (Bool, Text))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Maybe (Bool, Text))
-> StateT Journal (ParsecT CustomErr Text m) (Maybe (Bool, Text)))
-> ParsecT CustomErr Text m (Maybe (Bool, Text))
-> StateT Journal (ParsecT CustomErr Text m) (Maybe (Bool, Text))
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m (Bool, Text)
-> ParsecT CustomErr Text m (Maybe (Bool, Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m (Bool, Text)
-> ParsecT CustomErr Text m (Maybe (Bool, Text)))
-> ParsecT CustomErr Text m (Bool, Text)
-> ParsecT CustomErr Text m (Maybe (Bool, Text))
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m (Bool, Text)
-> ParsecT CustomErr Text m (Bool, Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m (Bool, Text)
-> ParsecT CustomErr Text m (Bool, Text))
-> ParsecT CustomErr Text m (Bool, Text)
-> ParsecT CustomErr Text m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ (,) (Bool -> Text -> (Bool, Text))
-> ParsecT CustomErr Text m Bool
-> ParsecT CustomErr Text m (Text -> (Bool, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m Bool
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m Bool
skipNonNewlineSpaces' ParsecT CustomErr Text m (Text -> (Bool, Text))
-> ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m (Bool, Text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomErr 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 Char
mdec,Maybe DigitGroupStyle
mgrps) <- ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
let s :: AmountStyle
s = AmountStyle
amountstyle{ascommodityside :: Side
ascommodityside=Side
R, ascommodityspaced :: Bool
ascommodityspaced=Bool
commodityspaced, asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
Amount -> StateT Journal (ParsecT CustomErr Text 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 Char
mdec,Maybe DigitGroupStyle
mgrps) <- ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> ParsecT
CustomErr
Text
m
(Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
Maybe (Text, AmountStyle)
defcs <- 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 Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps})
Amount -> StateT Journal (ParsecT CustomErr Text 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 :: forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
posRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousNum Maybe Integer
mExp =
let rawNum :: RawNumber
rawNum = (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
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
Left [Char]
errMsg -> CustomErr
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> CustomErr
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$
(Int -> Int -> [Char] -> CustomErr)
-> (Int, Int) -> [Char] -> CustomErr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> [Char] -> CustomErr
parseErrorAtRegion (Int, Int)
posRegion [Char]
errMsg
Right (Quantity
q,Word8
p,Maybe Char
d,Maybe DigitGroupStyle
g) -> (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> TextParser
m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity
q, Word8 -> AmountPrecision
Precision Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g)
amountp'' :: String -> Either (ParseErrorBundle Text CustomErr) Amount
amountp'' :: [Char] -> Either (ParseErrorBundle Text CustomErr) Amount
amountp'' [Char]
s = Parsec CustomErr Text Amount
-> [Char]
-> Text
-> Either (ParseErrorBundle Text CustomErr) Amount
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal (ParsecT CustomErr Text Identity) Amount
-> Journal -> Parsec CustomErr Text Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal (ParsecT CustomErr Text Identity) Amount
-> StateT Journal (ParsecT CustomErr Text Identity) ()
-> StateT Journal (ParsecT CustomErr Text Identity) Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr Text Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
nulljournal) [Char]
"" ([Char] -> Text
T.pack [Char]
s)
amountp' :: String -> Amount
amountp' :: [Char] -> Amount
amountp' [Char]
s =
case [Char] -> Either (ParseErrorBundle Text CustomErr) Amount
amountp'' [Char]
s of
Right Amount
amt -> Amount
amt
Left ParseErrorBundle Text CustomErr
err -> [Char] -> Amount
forall {a}. [Char] -> a
error' ([Char] -> Amount) -> [Char] -> Amount
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> [Char]
forall a. Show a => a -> [Char]
show ParseErrorBundle Text CustomErr
err
mamountp' :: String -> MixedAmount
mamountp' :: [Char] -> MixedAmount
mamountp' = Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount)
-> ([Char] -> Amount) -> [Char] -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Amount
amountp'
signp :: Num a => TextParser m (a -> a)
signp :: forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp = ((Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT CustomErr Text m Char
-> (a -> a) -> ParsecT CustomErr Text m (a -> a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a -> a
forall a. Num a => a -> a
negate ParsecT CustomErr Text m (a -> a)
-> ParsecT CustomErr Text m (a -> a)
-> ParsecT CustomErr Text m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+' ParsecT CustomErr Text m Char
-> (a -> a) -> ParsecT CustomErr Text m (a -> a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a -> a
forall a. a -> a
id) ParsecT CustomErr Text m (a -> a)
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m (a -> a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces) ParsecT CustomErr Text m (a -> a)
-> ParsecT CustomErr Text m (a -> a)
-> ParsecT CustomErr Text m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> ParsecT CustomErr Text m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id
commoditysymbolp :: TextParser m CommoditySymbol
commoditysymbolp :: forall (m :: * -> *). 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 -> [Char] -> TextParser m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"commodity symbol"
quotedcommoditysymbolp :: TextParser m CommoditySymbol
quotedcommoditysymbolp :: forall (m :: * -> *). TextParser m Text
quotedcommoditysymbolp =
ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
f
where f :: Char -> Bool
f Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\"'
simplecommoditysymbolp :: TextParser m CommoditySymbol
simplecommoditysymbolp :: forall (m :: * -> *). TextParser m Text
simplecommoditysymbolp = Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNonsimpleCommodityChar)
priceamountp :: Amount -> JournalParser m AmountPrice
priceamountp :: forall (m :: * -> *). Amount -> JournalParser m AmountPrice
priceamountp Amount
baseAmt = [Char]
-> StateT Journal (ParsecT CustomErr Text m) AmountPrice
-> StateT Journal (ParsecT CustomErr Text m) AmountPrice
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"transaction price" (StateT Journal (ParsecT CustomErr Text m) AmountPrice
-> StateT Journal (ParsecT CustomErr Text m) AmountPrice)
-> StateT Journal (ParsecT CustomErr Text m) AmountPrice
-> StateT Journal (ParsecT CustomErr Text m) AmountPrice
forall a b. (a -> b) -> a -> b
$ do
Bool
parenthesised <- Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool)
-> StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> StateT Journal (ParsecT CustomErr Text m) Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'@'
Bool
totalPrice <- Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'@' StateT Journal (ParsecT CustomErr Text m) Char
-> Bool -> StateT Journal (ParsecT CustomErr Text m) Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> StateT Journal (ParsecT CustomErr Text m) Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Bool
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
parenthesised (StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ())
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) ())
-> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')'
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
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
-> StateT Journal (ParsecT CustomErr Text m) AmountPrice
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AmountPrice
-> StateT Journal (ParsecT CustomErr Text m) AmountPrice)
-> AmountPrice
-> StateT Journal (ParsecT CustomErr Text 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 :: forall (m :: * -> *). JournalParser m BalanceAssertion
balanceassertionp = do
SourcePos
sourcepos <- StateT Journal (ParsecT CustomErr Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
Bool
istotal <- (Maybe Char -> Bool)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) Bool)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char))
-> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char)
-> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
Bool
isinclusive <- (Maybe Char -> Bool)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) Bool)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char))
-> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char)
-> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*'
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Amount
a <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountpnolotpricesp JournalParser m Amount -> [Char] -> JournalParser m Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"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 :: forall (m :: * -> *). JournalParser m ()
lotpricep = [Char]
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"ledger-style lot price" (StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ())
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ do
Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{'
Bool
doublebrace <- Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool)
-> StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{' StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> StateT Journal (ParsecT CustomErr Text m) Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Bool
_fixed <- (Maybe Char -> Bool)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) Bool)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char))
-> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Amount
_a <- Bool -> JournalParser m Amount
forall (m :: * -> *). Bool -> JournalParser m Amount
amountwithoutpricep Bool
False
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
Bool
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
doublebrace) (StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ())
-> StateT Journal (ParsecT CustomErr Text m) ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) ())
-> StateT Journal (ParsecT CustomErr Text m) Char
-> StateT Journal (ParsecT CustomErr Text m) ()
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
lotdatep :: JournalParser m ()
lotdatep :: forall (m :: * -> *). JournalParser m ()
lotdatep = (do
Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'['
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Day
_d <- JournalParser m Day
forall (m :: * -> *). JournalParser m Day
datep
ParsecT CustomErr Text m ()
-> StateT Journal (ParsecT CustomErr Text m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']'
() -> StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) StateT Journal (ParsecT CustomErr Text m) ()
-> [Char] -> StateT Journal (ParsecT CustomErr Text m) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"ledger-style lot date"
numberp :: Maybe AmountStyle -> TextParser m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp :: forall (m :: * -> *).
Maybe AmountStyle
-> TextParser
m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp Maybe AmountStyle
suggestedStyle = [Char]
-> ParsecT
CustomErr
Text
m
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> ParsecT
CustomErr
Text
m
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"number" (ParsecT
CustomErr
Text
m
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> ParsecT
CustomErr
Text
m
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr
Text
m
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> ParsecT
CustomErr
Text
m
(Quantity, Word8, Maybe Char, 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 CustomErr Text m (Either AmbiguousNumber RawNumber)
-> ParsecT CustomErr Text m RawNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
Maybe Integer
mExp <- ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m (Maybe Integer))
-> ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m Integer
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m Integer)
-> ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m Integer
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Integer
forall (m :: * -> *). TextParser m Integer
exponentp
[Char] -> Maybe AmountStyle -> Maybe AmountStyle
forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"numberp suggestedStyle" Maybe AmountStyle
suggestedStyle Maybe AmountStyle
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
`seq` () -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case [Char]
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"numberp quantity,precision,mdecimalpoint,mgrps"
(Either [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle))
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ RawNumber
-> Maybe Integer
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
Left [Char]
errMsg -> [Char]
-> ParsecT
CustomErr
Text
m
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
errMsg
Right (Quantity
q, Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g) -> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> ParsecT
CustomErr
Text
m
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity -> Quantity
sign Quantity
q, Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g)
exponentp :: TextParser m Integer
exponentp :: forall (m :: * -> *). TextParser m Integer
exponentp = Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char' Char
Token Text
'e' ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Integer -> Integer)
-> ParsecT CustomErr Text m (Integer -> Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m (Integer -> Integer)
forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp ParsecT CustomErr Text m (Integer -> Integer)
-> ParsecT CustomErr Text m Integer
-> ParsecT CustomErr Text m Integer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomErr Text m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT CustomErr Text m Integer
-> [Char] -> ParsecT CustomErr Text m Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"exponent"
fromRawNumber
:: RawNumber
-> Maybe Integer
-> Either String
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber :: RawNumber
-> Maybe Integer
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber (WithSeparators{}) (Just Integer
_) =
[Char]
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a b. a -> Either a b
Left [Char]
"invalid number: digit separators and exponents may not be used together"
fromRawNumber RawNumber
raw Maybe Integer
mExp = do
(Quantity
quantity, Word8
precision) <- Integer -> DigitGrp -> DigitGrp -> Either [Char] (Quantity, Word8)
toQuantity (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 Char, Maybe DigitGroupStyle)
-> Either
[Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Quantity
quantity, Word8
precision, RawNumber -> Maybe Char
mDecPt RawNumber
raw, RawNumber -> Maybe DigitGroupStyle
digitGroupStyle RawNumber
raw)
where
toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either String (Quantity, Word8)
toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either [Char] (Quantity, Word8)
toQuantity Integer
e DigitGrp
preDecimalGrp DigitGrp
postDecimalGrp
| Integer
precision Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = (Quantity, Word8) -> Either [Char] (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 [Char] (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 = [Char] -> Either [Char] (Quantity, Word8)
forall a b. a -> Either a b
Left [Char]
"invalid number: numbers with more than 255 decimal places are currently not supported"
where
digitGrpNum :: Integer
digitGrpNum = DigitGrp -> Integer
digitGroupNumber (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 Char
mDecPt (NoSeparators DigitGrp
_ Maybe (Char, DigitGrp)
mDecimals) = (Char, DigitGrp) -> Char
forall a b. (a, b) -> a
fst ((Char, DigitGrp) -> Char) -> Maybe (Char, DigitGrp) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Char, DigitGrp)
mDecimals
mDecPt (WithSeparators Char
_ [DigitGrp]
_ Maybe (Char, DigitGrp)
mDecimals) = (Char, DigitGrp) -> Char
forall a b. (a, b) -> a
fst ((Char, DigitGrp) -> Char) -> Maybe (Char, DigitGrp) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Char, DigitGrp)
mDecimals
decimalGroup :: RawNumber -> DigitGrp
decimalGroup (NoSeparators DigitGrp
_ Maybe (Char, DigitGrp)
mDecimals) = DigitGrp
-> ((Char, DigitGrp) -> DigitGrp)
-> Maybe (Char, DigitGrp)
-> DigitGrp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DigitGrp
forall a. Monoid a => a
mempty (Char, DigitGrp) -> DigitGrp
forall a b. (a, b) -> b
snd Maybe (Char, DigitGrp)
mDecimals
decimalGroup (WithSeparators Char
_ [DigitGrp]
_ Maybe (Char, DigitGrp)
mDecimals) = DigitGrp
-> ((Char, DigitGrp) -> DigitGrp)
-> Maybe (Char, DigitGrp)
-> DigitGrp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DigitGrp
forall a. Monoid a => a
mempty (Char, DigitGrp) -> DigitGrp
forall a b. (a, b) -> b
snd Maybe (Char, DigitGrp)
mDecimals
digitGroup :: RawNumber -> DigitGrp
digitGroup (NoSeparators DigitGrp
digitGrp Maybe (Char, DigitGrp)
_) = DigitGrp
digitGrp
digitGroup (WithSeparators Char
_ [DigitGrp]
digitGrps Maybe (Char, DigitGrp)
_) = [DigitGrp] -> DigitGrp
forall a. Monoid a => [a] -> a
mconcat [DigitGrp]
digitGrps
digitGroupStyle :: RawNumber -> Maybe DigitGroupStyle
digitGroupStyle (NoSeparators DigitGrp
_ Maybe (Char, DigitGrp)
_) = Maybe DigitGroupStyle
forall a. Maybe a
Nothing
digitGroupStyle (WithSeparators Char
sep [DigitGrp]
grps Maybe (Char, 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
. Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
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 Char
sep DigitGrp
grp2) =
if Char -> Bool
isDecimalMark Char
sep Bool -> Bool -> Bool
&&
Bool -> (AmountStyle -> Bool) -> Maybe AmountStyle -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Char
sep Char -> AmountStyle -> Bool
`isValidDecimalBy`) Maybe AmountStyle
msuggestedStyle
then DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 ((Char, DigitGrp) -> Maybe (Char, DigitGrp)
forall a. a -> Maybe a
Just (Char
sep, DigitGrp
grp2))
else Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
sep [DigitGrp
grp1, DigitGrp
grp2] Maybe (Char, DigitGrp)
forall a. Maybe a
Nothing
where
isValidDecimalBy :: Char -> AmountStyle -> Bool
isValidDecimalBy :: Char -> AmountStyle -> Bool
isValidDecimalBy Char
c = \case
AmountStyle{asdecimalpoint :: AmountStyle -> Maybe Char
asdecimalpoint = Just Char
d} -> Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c
AmountStyle{asdigitgroups :: AmountStyle -> Maybe DigitGroupStyle
asdigitgroups = Just (DigitGroups Char
g [Word8]
_)} -> Char
g Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c
AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision = Precision Word8
0} -> Bool
False
AmountStyle
_ -> Bool
True
rawnumberp :: TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp :: forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp = [Char]
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"number" (ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber))
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
forall a b. (a -> b) -> a -> b
$ do
Either AmbiguousNumber RawNumber
rawNumber <- (RawNumber -> Either AmbiguousNumber RawNumber)
-> ParsecT CustomErr Text m RawNumber
-> ParsecT CustomErr Text 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 CustomErr Text m RawNumber
forall (m :: * -> *). TextParser m RawNumber
leadingDecimalPt ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits
Maybe Char
mExtraDecimalSep <- ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char))
-> ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char)
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
forall a b. (a -> b) -> a -> b
$ (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isDecimalMark
Bool -> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
mExtraDecimalSep) (ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$
[Char] -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
"invalid number (invalid use of separator)"
Maybe Int
mExtraFragment <- ParsecT CustomErr Text m Int
-> ParsecT CustomErr Text m (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Int
-> ParsecT CustomErr Text m (Maybe Int))
-> ParsecT CustomErr Text m Int
-> ParsecT CustomErr Text m (Maybe Int)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int)
-> ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int)
-> ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
forall a b. (a -> b) -> a -> b
$
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' ' ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m Int -> ParsecT CustomErr Text m Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset ParsecT CustomErr Text m Int
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
case Maybe Int
mExtraFragment of
Just Int
off -> CustomErr -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> ParsecT CustomErr Text m ())
-> CustomErr -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$
Int -> [Char] -> CustomErr
parseErrorAt Int
off [Char]
"invalid number (excessive trailing digits)"
Maybe Int
Nothing -> () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Either AmbiguousNumber RawNumber
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AmbiguousNumber RawNumber
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber))
-> Either AmbiguousNumber RawNumber
-> ParsecT CustomErr Text m (Either AmbiguousNumber RawNumber)
forall a b. (a -> b) -> a -> b
$ [Char]
-> Either AmbiguousNumber RawNumber
-> Either AmbiguousNumber RawNumber
forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"rawnumberp" Either AmbiguousNumber RawNumber
rawNumber
where
leadingDecimalPt :: TextParser m RawNumber
leadingDecimalPt :: forall (m :: * -> *). TextParser m RawNumber
leadingDecimalPt = do
Char
decPt <- (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> 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 (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
forall a. Monoid a => a
mempty ((Char, DigitGrp) -> Maybe (Char, DigitGrp)
forall a. a -> Maybe a
Just (Char
decPt, DigitGrp
decGrp))
leadingDigits :: TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits :: forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits = do
DigitGrp
grp1 <- 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 CustomErr 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 CustomErr 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 (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 Maybe (Char, DigitGrp)
forall a. Maybe a
Nothing)
withSeparators :: DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber)
withSeparators :: forall (m :: * -> *).
DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber)
withSeparators DigitGrp
grp1 = do
(Char
sep, DigitGrp
grp2) <- ParsecT CustomErr Text m (Char, DigitGrp)
-> ParsecT CustomErr Text m (Char, DigitGrp)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m (Char, DigitGrp)
-> ParsecT CustomErr Text m (Char, DigitGrp))
-> ParsecT CustomErr Text m (Char, DigitGrp)
-> ParsecT CustomErr Text m (Char, DigitGrp)
forall a b. (a -> b) -> a -> b
$ (,) (Char -> DigitGrp -> (Char, DigitGrp))
-> ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (DigitGrp -> (Char, DigitGrp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isDigitSeparatorChar ParsecT CustomErr Text m (DigitGrp -> (Char, DigitGrp))
-> ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m (Char, DigitGrp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomErr Text m DigitGrp
forall (m :: * -> *). TextParser m DigitGrp
digitgroupp
[DigitGrp]
grps <- ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m [DigitGrp]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m [DigitGrp])
-> ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m [DigitGrp]
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m DigitGrp
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m DigitGrp)
-> ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m DigitGrp
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
sep ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m DigitGrp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr 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 CustomErr 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 (Char -> [DigitGrp] -> ParsecT CustomErr Text m RawNumber
forall (m :: * -> *). Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt Char
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
-> Char
-> DigitGrp
-> [DigitGrp]
-> Either AmbiguousNumber RawNumber
withoutDecimalPt DigitGrp
grp1 Char
sep DigitGrp
grp2 [DigitGrp]
grps)
withDecimalPt :: Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt :: forall (m :: * -> *). Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt Char
digitSep [DigitGrp]
digitGroups = do
Char
decPt <- (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text))
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isDecimalMark Char
Token Text
c Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
digitSep
DigitGrp
decDigitGrp <- DigitGrp
-> ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m DigitGrp
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option DigitGrp
forall a. Monoid a => a
mempty ParsecT CustomErr 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
$ Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
digitSep [DigitGrp]
digitGroups ((Char, DigitGrp) -> Maybe (Char, DigitGrp)
forall a. a -> Maybe a
Just (Char
decPt, DigitGrp
decDigitGrp))
withoutDecimalPt
:: DigitGrp
-> Char
-> DigitGrp
-> [DigitGrp]
-> Either AmbiguousNumber RawNumber
withoutDecimalPt :: DigitGrp
-> Char
-> DigitGrp
-> [DigitGrp]
-> Either AmbiguousNumber RawNumber
withoutDecimalPt DigitGrp
grp1 Char
sep DigitGrp
grp2 [DigitGrp]
grps
| [DigitGrp] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DigitGrp]
grps Bool -> Bool -> Bool
&& Char -> Bool
isDecimalMark Char
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 -> Char -> DigitGrp -> AmbiguousNumber
AmbiguousNumber DigitGrp
grp1 Char
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
$ Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
sep (DigitGrp
grp1DigitGrp -> [DigitGrp] -> [DigitGrp]
forall a. a -> [a] -> [a]
:DigitGrp
grp2DigitGrp -> [DigitGrp] -> [DigitGrp]
forall a. a -> [a] -> [a]
:[DigitGrp]
grps) Maybe (Char, DigitGrp)
forall a. Maybe a
Nothing
trailingDecimalPt :: DigitGrp -> TextParser m RawNumber
trailingDecimalPt :: forall (m :: * -> *). DigitGrp -> TextParser m RawNumber
trailingDecimalPt DigitGrp
grp1 = do
Char
decPt <- (Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> 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 (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 ((Char, DigitGrp) -> Maybe (Char, DigitGrp)
forall a. a -> Maybe a
Just (Char
decPt, DigitGrp
forall a. Monoid a => a
mempty))
isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar Char
c = Char -> Bool
isDecimalMark Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
data RawNumber
= NoSeparators DigitGrp (Maybe (Char, DigitGrp))
| WithSeparators Char [DigitGrp] (Maybe (Char, DigitGrp))
deriving (Int -> RawNumber -> [Char] -> [Char]
[RawNumber] -> [Char] -> [Char]
RawNumber -> [Char]
(Int -> RawNumber -> [Char] -> [Char])
-> (RawNumber -> [Char])
-> ([RawNumber] -> [Char] -> [Char])
-> Show RawNumber
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [RawNumber] -> [Char] -> [Char]
$cshowList :: [RawNumber] -> [Char] -> [Char]
show :: RawNumber -> [Char]
$cshow :: RawNumber -> [Char]
showsPrec :: Int -> RawNumber -> [Char] -> [Char]
$cshowsPrec :: Int -> RawNumber -> [Char] -> [Char]
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 -> [Char] -> [Char]
[AmbiguousNumber] -> [Char] -> [Char]
AmbiguousNumber -> [Char]
(Int -> AmbiguousNumber -> [Char] -> [Char])
-> (AmbiguousNumber -> [Char])
-> ([AmbiguousNumber] -> [Char] -> [Char])
-> Show AmbiguousNumber
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [AmbiguousNumber] -> [Char] -> [Char]
$cshowList :: [AmbiguousNumber] -> [Char] -> [Char]
show :: AmbiguousNumber -> [Char]
$cshow :: AmbiguousNumber -> [Char]
showsPrec :: Int -> AmbiguousNumber -> [Char] -> [Char]
$cshowsPrec :: Int -> AmbiguousNumber -> [Char] -> [Char]
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 -> [Char]
show (DigitGrp Word
len Integer
num) = [Char]
"\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
padding [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
numStr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
where numStr :: [Char]
numStr = Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
num
padding :: [Char]
padding = Integer -> Char -> [Char]
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 ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
numStr)) Char
'0'
instance Sem.Semigroup DigitGrp where
DigitGrp Word
l1 Integer
n1 <> :: DigitGrp -> DigitGrp -> DigitGrp
<> DigitGrp Word
l2 Integer
n2 = Word -> Integer -> DigitGrp
DigitGrp (Word
l1 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 :: forall (m :: * -> *). TextParser m DigitGrp
digitgroupp = [Char]
-> ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m DigitGrp
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"digits"
(ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m DigitGrp)
-> ParsecT CustomErr Text m DigitGrp
-> ParsecT CustomErr Text m DigitGrp
forall a b. (a -> b) -> a -> b
$ Text -> DigitGrp
makeGroup (Text -> DigitGrp)
-> ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m DigitGrp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"digit") Char -> 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) -> Char -> (Word, Integer))
-> (Word, Integer) -> Text -> (Word, Integer)
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (Word, Integer) -> Char -> (Word, Integer)
forall {a} {b}. (Num a, Num b) => (a, b) -> Char -> (a, b)
step (Word
0, Integer
0)
step :: (a, b) -> Char -> (a, b)
step (!a
l, !b
a) Char
c = (a
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 (Char -> Int
digitToInt Char
c))
multilinecommentp :: TextParser m ()
= ParsecT CustomErr Text m ()
startComment ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m ()
anyLine ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
`skipManyTill` ParsecT CustomErr Text m ()
endComment
where
startComment :: ParsecT CustomErr Text m ()
startComment = Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"comment" ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
trailingSpaces
endComment :: ParsecT CustomErr Text m ()
endComment = ParsecT CustomErr Text m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end comment" ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
trailingSpaces
trailingSpaces :: ParsecT CustomErr Text m ()
trailingSpaces = ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
anyLine :: ParsecT CustomErr Text m ()
anyLine = ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') ParsecT CustomErr Text m (Tokens Text)
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
{-# INLINABLE multilinecommentp #-}
emptyorcommentlinep :: TextParser m ()
= do
TextParser m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr 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 CustomErr Text m Char -> TextParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
where
skiplinecommentp :: TextParser m ()
skiplinecommentp :: forall (m :: * -> *). TextParser m ()
skiplinecommentp = do
(Token Text -> Bool) -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isLineCommentStart
ParsecT CustomErr Text m Text -> TextParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomErr Text m Text -> TextParser m ())
-> ParsecT CustomErr Text m Text -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
() -> TextParser m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINABLE emptyorcommentlinep #-}
isLineCommentStart :: Char -> Bool
Char
'#' = Bool
True
isLineCommentStart Char
'*' = Bool
True
isLineCommentStart Char
';' = Bool
True
isLineCommentStart Char
_ = Bool
False
isSameLineCommentStart :: Char -> Bool
Char
';' = Bool
True
isSameLineCommentStart Char
_ = Bool
False
followingcommentp' :: (Monoid a, Show a) => TextParser m a -> TextParser m (Text, a)
TextParser m a
contentp = do
ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
[(Text, a)]
sameLine <- ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
headerp ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m [(Text, a)]
-> ParsecT CustomErr 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 CustomErr 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 CustomErr Text m [(Text, a)]
-> ParsecT CustomErr Text m [(Text, a)]
-> ParsecT CustomErr Text m [(Text, a)]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [(Text, a)] -> ParsecT CustomErr Text m [(Text, a)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
()
_ <- ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
eolof
[(Text, a)]
nextLines <- TextParser m (Text, a) -> ParsecT CustomErr Text m [(Text, a)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (TextParser m (Text, a) -> ParsecT CustomErr Text m [(Text, a)])
-> TextParser m (Text, a) -> ParsecT CustomErr Text m [(Text, a)]
forall a b. (a -> b) -> a -> b
$
ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces1 ParsecT CustomErr Text m ()
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
headerp) ParsecT CustomErr 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 CustomErr Text m () -> TextParser m (Text, a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr 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 CustomErr Text m ()
headerp = Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
';' ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
{-# INLINABLE followingcommentp' #-}
followingcommentp :: TextParser m Text
=
(Text, ()) -> Text
forall a b. (a, b) -> a
fst ((Text, ()) -> Text)
-> ParsecT CustomErr Text m (Text, ())
-> ParsecT CustomErr Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextParser m () -> ParsecT CustomErr Text m (Text, ())
forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentp' (ParsecT CustomErr Text m Text -> TextParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomErr Text m Text -> TextParser m ())
-> ParsecT CustomErr Text m Text -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\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
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSpace) (Text -> Text)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\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 :: forall (m :: * -> *). Text -> TextParser m [Tag]
atColon Text
name = Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m [Tag] -> ParsecT CustomErr Text m [Tag]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
if Text -> Bool
T.null Text
name
then ParsecT CustomErr Text m [Tag]
forall (m :: * -> *). TextParser m [Tag]
commenttagsp
else do
ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr 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])
-> ParsecT CustomErr Text m [Tag] -> ParsecT CustomErr Text m [Tag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m [Tag]
forall (m :: * -> *). TextParser m [Tag]
commenttagsp
tagValue :: TextParser m Text
tagValue :: forall (m :: * -> *). 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 [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
Maybe Char
_ <- ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char))
-> ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
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 :: forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear = do
(Text
txt, [DateTag]
dateTags) <- ParsecT CustomErr Text m [DateTag]
-> ParsecT CustomErr Text m (Tokens Text, [DateTag])
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match (ParsecT CustomErr Text m [DateTag]
-> ParsecT CustomErr Text m (Tokens Text, [DateTag]))
-> ParsecT CustomErr Text m [DateTag]
-> ParsecT CustomErr Text m (Tokens Text, [DateTag])
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT CustomErr Text m [DateTag]
forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
':'
let tagName :: Text
tagName = [Text] -> Text
forall a. [a] -> a
last ((Char -> Bool) -> Text -> [Text]
T.split Char -> 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 :: forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
end = do
ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
end Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[')
TextParser m [DateTag] -> TextParser m [DateTag]
forall (m :: * -> *).
TextParser m [DateTag] -> TextParser m [DateTag]
atBracket (Char -> TextParser m [DateTag]
forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
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 :: forall (m :: * -> *).
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)
Char
_ <- Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
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 :: forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
atColon Text
name = Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m ([Tag], [DateTag])
-> ParsecT CustomErr Text m ([Tag], [DateTag])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
([Tag]
tags, [DateTag]
dateTags) <- case Text
name of
Text
"" -> ([Tag], [DateTag]) -> ParsecT CustomErr Text m ([Tag], [DateTag])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
Text
"date" -> Text -> ParsecT CustomErr Text m ([Tag], [DateTag])
forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name
Text
"date2" -> Text -> ParsecT CustomErr Text m ([Tag], [DateTag])
forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name
Text
_ -> Text -> ParsecT CustomErr Text m ([Tag], [DateTag])
forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
tagValue Text
name
Maybe Char
_ <- ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char))
-> ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
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]))
-> ParsecT CustomErr Text m ([Tag], [DateTag])
-> ParsecT CustomErr Text m ([Tag], [DateTag])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer -> ParsecT CustomErr Text m ([Tag], [DateTag])
forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear
dateValue :: Text -> TextParser m ([Tag], [DateTag])
dateValue :: forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name = do
(Text
txt, (Day
date, [DateTag]
dateTags)) <- 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 <- Char -> TextParser m [DateTag]
forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
','
(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 :: forall (m :: * -> *). 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
$ Char -> TextParser m [DateTag]
forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
','
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 :: forall (m :: * -> *). Maybe Integer -> TextParser m [DateTag]
bracketeddatetagsp Maybe Integer
mYear1 = do
ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$ do
Text
s <- ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead
(ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m Text
-> ParsecT CustomErr Text m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']')
(ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isBracketedDateChar
Bool -> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
s Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDateSepChar Text
s) (ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ())
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall a b. (a -> b) -> a -> b
$
[Char] -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
"not a bracketed date"
ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m Char
-> 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 CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
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 CustomErr Text m Day
-> ParsecT CustomErr Text m (Maybe Day)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Day
-> ParsecT CustomErr Text m (Maybe Day))
-> ParsecT CustomErr Text m Day
-> ParsecT CustomErr Text m (Maybe Day)
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> ParsecT CustomErr 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 CustomErr Text m Day
-> ParsecT CustomErr Text m (Maybe Day)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text m Day
-> ParsecT CustomErr Text m (Maybe Day))
-> ParsecT CustomErr Text m Day
-> ParsecT CustomErr Text m (Maybe Day)
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'=' ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m Day -> ParsecT CustomErr Text m Day
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Integer -> ParsecT CustomErr 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 :: Char -> Bool
isBracketedDateChar Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDateSepChar Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'='
{-# INLINABLE bracketeddatetagsp #-}
aliasesFromOpts :: InputOpts -> [AccountAlias]
aliasesFromOpts :: InputOpts -> [AccountAlias]
aliasesFromOpts = ([Char] -> AccountAlias) -> [[Char]] -> [AccountAlias]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
a -> Either (ParseErrorBundle Text CustomErr) AccountAlias
-> AccountAlias
forall t e a.
(Show t, Show (Token t), Show e) =>
Either (ParseErrorBundle t e) a -> a
fromparse (Either (ParseErrorBundle Text CustomErr) AccountAlias
-> AccountAlias)
-> Either (ParseErrorBundle Text CustomErr) AccountAlias
-> AccountAlias
forall a b. (a -> b) -> a -> b
$ Parsec CustomErr Text AccountAlias
-> [Char]
-> Text
-> Either (ParseErrorBundle Text CustomErr) AccountAlias
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser Parsec CustomErr Text AccountAlias
forall (m :: * -> *). TextParser m AccountAlias
accountaliasp ([Char]
"--alias "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char] -> [Char]
quoteIfNeeded [Char]
a) (Text -> Either (ParseErrorBundle Text CustomErr) AccountAlias)
-> Text -> Either (ParseErrorBundle Text CustomErr) AccountAlias
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
a)
([[Char]] -> [AccountAlias])
-> (InputOpts -> [[Char]]) -> InputOpts -> [AccountAlias]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> [[Char]]
aliases_
accountaliasp :: TextParser m AccountAlias
accountaliasp :: forall (m :: * -> *). 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 :: forall (m :: * -> *). TextParser m AccountAlias
basicaliasp = do
[Char]
old <- [Char] -> [Char]
rstrip ([Char] -> [Char])
-> ParsecT CustomErr Text m [Char]
-> ParsecT CustomErr Text m [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m [Char])
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m [Char]
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT CustomErr Text m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"=" :: [Char]))
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
[Char]
new <- [Char] -> [Char]
rstrip ([Char] -> [Char])
-> ParsecT CustomErr Text m [Char]
-> ParsecT CustomErr Text m [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr 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 ([Char] -> Text
T.pack [Char]
old) ([Char] -> Text
T.pack [Char]
new)
regexaliasp :: TextParser m AccountAlias
regexaliasp :: forall (m :: * -> *). TextParser m AccountAlias
regexaliasp = do
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/'
Int
off1 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
[Char]
re <- ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m [Char])
-> ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m [Char]
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT CustomErr Text m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"/\n\r" :: [Char])
Int
off2 <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/'
ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
ParsecT CustomErr Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT CustomErr s m ()
skipNonNewlineSpaces
[Char]
repl <- ParsecT CustomErr Text m Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT CustomErr Text m ()
forall (m :: * -> *). TextParser m ()
eolof
case Text -> Either [Char] Regexp
toRegexCI (Text -> Either [Char] Regexp) -> Text -> Either [Char] Regexp
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
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 -> [Char] -> AccountAlias
RegexAlias Regexp
r [Char]
repl
Left [Char]
e -> CustomErr -> TextParser m AccountAlias
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr -> TextParser m AccountAlias)
-> CustomErr -> TextParser m AccountAlias
forall a b. (a -> b) -> a -> b
$! Int -> Int -> [Char] -> CustomErr
parseErrorAtRegion Int
off1 Int
off2 [Char]
e
tests_Common :: TestTree
tests_Common = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Common" [
[Char] -> [TestTree] -> TestTree
testGroup [Char]
"amountp" [
[Char] -> Assertion -> TestTree
testCase [Char]
"basic" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Amount
-> Text -> Amount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr Text IO) Amount
forall (m :: * -> *). JournalParser m Amount
amountp Text
"$47.18" (Quantity -> Amount
usd Quantity
47.18)
,[Char] -> Assertion -> TestTree
testCase [Char]
"ends with decimal mark" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Amount
-> Text -> Amount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr 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)
,[Char] -> Assertion -> TestTree
testCase [Char]
"unit price" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Amount
-> Text -> Amount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr 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 Char
asdecimalpoint=Maybe Char
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 Char
asdecimalpoint=Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.'}
}
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"total price" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Amount
-> Text -> Amount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr 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 Char
asdecimalpoint=Maybe Char
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 Char
asdecimalpoint=Maybe Char
forall a. Maybe a
Nothing}
}
}
,[Char] -> Assertion -> TestTree
testCase [Char]
"unit price, parenthesised" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Amount
-> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) Amount
forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 (@) €0.5"
,[Char] -> Assertion -> TestTree
testCase [Char]
"total price, parenthesised" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) Amount
-> Text -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT Journal (ParsecT CustomErr Text IO) Amount
forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 (@@) €0.5"
]
,let p :: JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p = ParsecT
CustomErr
Text
IO
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe AmountStyle
-> ParsecT
CustomErr
Text
IO
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
Maybe AmountStyle
-> TextParser
m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp Maybe AmountStyle
forall a. Maybe a
Nothing) :: JournalParser IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) in
[Char] -> Assertion -> TestTree
testCase [Char]
"numberp" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"0" (Quantity
0, Word8
0, Maybe Char
forall a. Maybe a
Nothing, Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1" (Quantity
1, Word8
0, Maybe Char
forall a. Maybe a
Nothing, Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.1" (Quantity
1.1, Word8
1, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000.1" (Quantity
1000.1, Word8
1, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (DigitGroupStyle -> Maybe DigitGroupStyle)
-> DigitGroupStyle -> Maybe DigitGroupStyle
forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.00.000,1" (Quantity
100000.1, Word8
1, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',', DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (DigitGroupStyle -> Maybe DigitGroupStyle)
-> DigitGroupStyle -> Maybe DigitGroupStyle
forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
'.' [Word8
3,Word8
2])
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000,000" (Quantity
1000000, Word8
0, Maybe Char
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
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3,Word8
3])
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1." (Quantity
1, Word8
0, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1," (Quantity
1, Word8
0, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
".1" (Quantity
0.1, Word8
1, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
",1" (Quantity
0.1, Word8
1, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> [Char] -> [Char] -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p [Char]
"" [Char]
""
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> [Char] -> [Char] -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p [Char]
"1,000.000,1" [Char]
""
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> [Char] -> [Char] -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p [Char]
"1.000,000.1" [Char]
""
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> [Char] -> [Char] -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p [Char]
"1,000.000.1" [Char]
""
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> [Char] -> [Char] -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p [Char]
"1,,1" [Char]
""
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> [Char] -> [Char] -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p [Char]
"1..1" [Char]
""
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> [Char] -> [Char] -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p [Char]
".1," [Char]
""
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> [Char] -> [Char] -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p [Char]
",1." [Char]
""
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" (Quantity
1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555, Word8
255, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> [Char] -> [Char] -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError JournalParser
IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p [Char]
"1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" [Char]
""
,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"spaceandamountormissingp" [
[Char] -> Assertion -> TestTree
testCase [Char]
"space and amount" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) MixedAmount
-> Text -> MixedAmount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr 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)
,[Char] -> Assertion -> TestTree
testCase [Char]
"empty string" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text IO) MixedAmount
-> Text -> MixedAmount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT CustomErr Text IO) MixedAmount
forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp Text
"" MixedAmount
missingmixedamt
]
]