{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoMonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Hledger.Read.Common (
Reader (..),
InputOpts (..),
definputopts,
rawOptsToInputOpts,
runTextParser,
rtp,
runJournalParser,
rjp,
runErroringJournalParser,
rejp,
genericSourcePos,
journalSourcePos,
parseAndFinaliseJournal,
parseAndFinaliseJournal',
journalFinalise,
setYear,
getYear,
setDefaultCommodityAndStyle,
getDefaultCommodityAndStyle,
getDefaultAmountStyle,
getAmountStyle,
addDeclaredAccountType,
pushParentAccount,
popParentAccount,
getParentAccount,
addAccountAlias,
getAccountAliases,
clearAccountAliases,
journalAddFile,
statusp,
codep,
descriptionp,
datep,
datetimep,
secondarydatep,
modifiedaccountnamep,
accountnamep,
spaceandamountormissingp,
amountp,
amountp',
mamountp',
commoditysymbolp,
priceamountp,
balanceassertionp,
lotpricep,
numberp,
fromRawNumber,
rawnumberp,
multilinecommentp,
emptyorcommentlinep,
followingcommentp,
transactioncommentp,
postingcommentp,
bracketeddatetagsp,
singlespacedtextp,
singlespacedtextsatisfyingp,
singlespacep,
skipNonNewlineSpaces,
skipNonNewlineSpaces1,
tests_Common,
)
where
import Prelude ()
import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
import qualified "base-compat-batteries" Control.Monad.Fail.Compat as Fail (fail)
import Control.Monad.Except (ExceptT(..), 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.Default (Default(..))
import Data.Function ((&))
import Data.Functor.Identity (Identity)
import "base-compat-batteries" Data.List.Compat
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.LocalTime (LocalTime(..), TimeOfDay(..))
import Data.Word (Word8)
import System.Time (getClockTime)
import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, newline, string)
import Text.Megaparsec.Char.Lexer (decimal)
import Text.Megaparsec.Custom
(FinalParseError, attachSource, customErrorBundlePretty,
finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion)
import Hledger.Data
import Hledger.Utils
data Reader m = Reader {
Reader m -> StorageFormat
rFormat :: StorageFormat
,Reader m -> [StorageFormat]
rExtensions :: [String]
,Reader m
-> InputOpts
-> StorageFormat
-> Text
-> ExceptT StorageFormat IO Journal
rReadFn :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
,Reader m -> MonadIO m => ErroringJournalParser m Journal
rParser :: MonadIO m => ErroringJournalParser m ParsedJournal
}
instance Show (Reader m) where show :: Reader m -> StorageFormat
show r :: Reader m
r = Reader m -> StorageFormat
forall (m :: * -> *). Reader m -> StorageFormat
rFormat Reader m
r StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ " reader"
data InputOpts = InputOpts {
InputOpts -> Maybe StorageFormat
mformat_ :: Maybe StorageFormat
,InputOpts -> Maybe StorageFormat
mrules_file_ :: Maybe FilePath
,InputOpts -> [StorageFormat]
aliases_ :: [String]
,InputOpts -> Bool
anon_ :: Bool
,InputOpts -> Bool
ignore_assertions_ :: Bool
,InputOpts -> Bool
new_ :: Bool
,InputOpts -> Bool
new_save_ :: Bool
,InputOpts -> StorageFormat
pivot_ :: String
,InputOpts -> Bool
auto_ :: Bool
} deriving (Int -> InputOpts -> ShowS
[InputOpts] -> ShowS
InputOpts -> StorageFormat
(Int -> InputOpts -> ShowS)
-> (InputOpts -> StorageFormat)
-> ([InputOpts] -> ShowS)
-> Show InputOpts
forall a.
(Int -> a -> ShowS)
-> (a -> StorageFormat) -> ([a] -> ShowS) -> Show a
showList :: [InputOpts] -> ShowS
$cshowList :: [InputOpts] -> ShowS
show :: InputOpts -> StorageFormat
$cshow :: InputOpts -> StorageFormat
showsPrec :: Int -> InputOpts -> ShowS
$cshowsPrec :: Int -> InputOpts -> ShowS
Show)
instance Default InputOpts where def :: InputOpts
def = InputOpts
definputopts
definputopts :: InputOpts
definputopts :: InputOpts
definputopts = Maybe StorageFormat
-> Maybe StorageFormat
-> [StorageFormat]
-> Bool
-> Bool
-> Bool
-> Bool
-> StorageFormat
-> Bool
-> InputOpts
InputOpts Maybe StorageFormat
forall a. Default a => a
def Maybe StorageFormat
forall a. Default a => a
def [StorageFormat]
forall a. Default a => a
def Bool
forall a. Default a => a
def Bool
forall a. Default a => a
def Bool
forall a. Default a => a
def Bool
True StorageFormat
forall a. Default a => a
def Bool
forall a. Default a => a
def
rawOptsToInputOpts :: RawOpts -> InputOpts
rawOptsToInputOpts :: RawOpts -> InputOpts
rawOptsToInputOpts rawopts :: RawOpts
rawopts = InputOpts :: Maybe StorageFormat
-> Maybe StorageFormat
-> [StorageFormat]
-> Bool
-> Bool
-> Bool
-> Bool
-> StorageFormat
-> Bool
-> InputOpts
InputOpts{
mformat_ :: Maybe StorageFormat
mformat_ = Maybe StorageFormat
forall a. Maybe a
Nothing
,mrules_file_ :: Maybe StorageFormat
mrules_file_ = StorageFormat -> RawOpts -> Maybe StorageFormat
maybestringopt "rules-file" RawOpts
rawopts
,aliases_ :: [StorageFormat]
aliases_ = StorageFormat -> RawOpts -> [StorageFormat]
listofstringopt "alias" RawOpts
rawopts
,anon_ :: Bool
anon_ = StorageFormat -> RawOpts -> Bool
boolopt "anon" RawOpts
rawopts
,ignore_assertions_ :: Bool
ignore_assertions_ = StorageFormat -> RawOpts -> Bool
boolopt "ignore-assertions" RawOpts
rawopts
,new_ :: Bool
new_ = StorageFormat -> RawOpts -> Bool
boolopt "new" RawOpts
rawopts
,new_save_ :: Bool
new_save_ = Bool
True
,pivot_ :: StorageFormat
pivot_ = StorageFormat -> RawOpts -> StorageFormat
stringopt "pivot" RawOpts
rawopts
,auto_ :: Bool
auto_ = StorageFormat -> RawOpts -> Bool
boolopt "auto" RawOpts
rawopts
}
runTextParser, rtp
:: TextParser Identity a -> Text -> Either (ParseErrorBundle Text CustomErr) a
runTextParser :: TextParser Identity a
-> Text -> Either (ParseErrorBundle Text CustomErr) a
runTextParser p :: TextParser Identity a
p t :: Text
t = TextParser Identity a
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) a
forall e s a.
Parsec e s a
-> StorageFormat -> s -> Either (ParseErrorBundle s e) a
runParser TextParser Identity a
p "" Text
t
rtp :: TextParser Identity a
-> Text -> Either (ParseErrorBundle Text CustomErr) a
rtp = TextParser Identity a
-> Text -> Either (ParseErrorBundle Text CustomErr) a
forall a.
TextParser Identity a
-> Text -> Either (ParseErrorBundle Text CustomErr) a
runTextParser
runJournalParser, rjp
:: Monad m
=> JournalParser m a -> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
runJournalParser :: JournalParser m a
-> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
runJournalParser p :: JournalParser m a
p t :: Text
t = ParsecT CustomErr Text m a
-> StorageFormat
-> Text
-> m (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> StorageFormat -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (JournalParser m a -> Journal -> ParsecT CustomErr Text m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT JournalParser m a
p Journal
nulljournal) "" Text
t
rjp :: JournalParser m a
-> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
rjp = JournalParser m a
-> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) a.
Monad m =>
JournalParser m a
-> Text -> m (Either (ParseErrorBundle Text CustomErr) a)
runJournalParser
runErroringJournalParser, rejp
:: Monad m
=> ErroringJournalParser m a
-> Text
-> m (Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
runErroringJournalParser :: ErroringJournalParser m a
-> Text
-> m (Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
runErroringJournalParser p :: ErroringJournalParser m a
p t :: Text
t =
ExceptT
FinalParseError m (Either (ParseErrorBundle Text CustomErr) a)
-> m (Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
FinalParseError m (Either (ParseErrorBundle Text CustomErr) a)
-> m (Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) a)))
-> ExceptT
FinalParseError m (Either (ParseErrorBundle Text CustomErr) a)
-> m (Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text (ExceptT FinalParseError m) a
-> StorageFormat
-> Text
-> ExceptT
FinalParseError m (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> StorageFormat -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (ErroringJournalParser m a
-> Journal -> ParsecT CustomErr Text (ExceptT FinalParseError m) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ErroringJournalParser m a
p Journal
nulljournal) "" Text
t
rejp :: ErroringJournalParser m a
-> Text
-> m (Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
rejp = ErroringJournalParser m a
-> Text
-> m (Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
forall (m :: * -> *) a.
Monad m =>
ErroringJournalParser m a
-> Text
-> m (Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
runErroringJournalParser
genericSourcePos :: SourcePos -> GenericSourcePos
genericSourcePos :: SourcePos -> GenericSourcePos
genericSourcePos p :: SourcePos
p = StorageFormat -> Int -> Int -> GenericSourcePos
GenericSourcePos (SourcePos -> StorageFormat
sourceName SourcePos
p) (Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
p) (Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn SourcePos
p)
journalSourcePos :: SourcePos -> SourcePos -> GenericSourcePos
journalSourcePos :: SourcePos -> SourcePos -> GenericSourcePos
journalSourcePos p :: SourcePos
p p' :: SourcePos
p' = StorageFormat -> (Int, Int) -> GenericSourcePos
JournalSourcePos (SourcePos -> StorageFormat
sourceName SourcePos
p) (Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
p, Int
line')
where line' :: Int
line' | (Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn SourcePos
p') Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Pos -> Int
unPos (SourcePos -> Pos
sourceLine SourcePos
p') Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
| Bool
otherwise = Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
p'
parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
-> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal :: ErroringJournalParser IO Journal
-> InputOpts
-> StorageFormat
-> Text
-> ExceptT StorageFormat IO Journal
parseAndFinaliseJournal parser :: ErroringJournalParser IO Journal
parser iopts :: InputOpts
iopts f :: StorageFormat
f txt :: Text
txt = do
Integer
y <- IO Integer -> ExceptT StorageFormat IO Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCurrentYear
let initJournal :: Journal
initJournal = Journal
nulljournal{ jparsedefaultyear :: Maybe Integer
jparsedefaultyear = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
y, jincludefilestack :: [StorageFormat]
jincludefilestack = [StorageFormat
f] }
Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal)
eep <- IO
(Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal))
-> ExceptT
StorageFormat
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
StorageFormat
IO
(Either
FinalParseError
(Either (ParseErrorBundle Text CustomErr) Journal)))
-> IO
(Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal))
-> ExceptT
StorageFormat
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
-> StorageFormat
-> Text
-> ExceptT
FinalParseError
IO
(Either (ParseErrorBundle Text CustomErr) Journal)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> StorageFormat -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (ErroringJournalParser IO Journal
-> Journal
-> ParsecT 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) StorageFormat
f Text
txt
case Either
FinalParseError (Either (ParseErrorBundle Text CustomErr) Journal)
eep of
Left finalParseError :: FinalParseError
finalParseError -> StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StorageFormat -> ExceptT StorageFormat IO Journal)
-> StorageFormat -> ExceptT StorageFormat IO Journal
forall a b. (a -> b) -> a -> b
$ FinalParseErrorBundle' CustomErr -> StorageFormat
finalErrorBundlePretty (FinalParseErrorBundle' CustomErr -> StorageFormat)
-> FinalParseErrorBundle' CustomErr -> StorageFormat
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> Text -> FinalParseError -> FinalParseErrorBundle' CustomErr
forall e.
StorageFormat
-> Text -> FinalParseError' e -> FinalParseErrorBundle' e
attachSource StorageFormat
f Text
txt FinalParseError
finalParseError
Right ep :: Either (ParseErrorBundle Text CustomErr) Journal
ep -> case Either (ParseErrorBundle Text CustomErr) Journal
ep of
Left e :: ParseErrorBundle Text CustomErr
e -> StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StorageFormat -> ExceptT StorageFormat IO Journal)
-> StorageFormat -> ExceptT StorageFormat IO Journal
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
Right pj :: Journal
pj -> InputOpts
-> StorageFormat
-> Text
-> Journal
-> ExceptT StorageFormat IO Journal
journalFinalise InputOpts
iopts StorageFormat
f Text
txt Journal
pj
parseAndFinaliseJournal' :: JournalParser IO ParsedJournal -> InputOpts
-> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal' :: JournalParser IO Journal
-> InputOpts
-> StorageFormat
-> Text
-> ExceptT StorageFormat IO Journal
parseAndFinaliseJournal' parser :: JournalParser IO Journal
parser iopts :: InputOpts
iopts f :: StorageFormat
f txt :: Text
txt = do
Integer
y <- IO Integer -> ExceptT StorageFormat IO Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCurrentYear
let initJournal :: Journal
initJournal = Journal
nulljournal
{ jparsedefaultyear :: Maybe Integer
jparsedefaultyear = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
y
, jincludefilestack :: [StorageFormat]
jincludefilestack = [StorageFormat
f] }
Either (ParseErrorBundle Text CustomErr) Journal
ep <- IO (Either (ParseErrorBundle Text CustomErr) Journal)
-> ExceptT
StorageFormat IO (Either (ParseErrorBundle Text CustomErr) Journal)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (ParseErrorBundle Text CustomErr) Journal)
-> ExceptT
StorageFormat
IO
(Either (ParseErrorBundle Text CustomErr) Journal))
-> IO (Either (ParseErrorBundle Text CustomErr) Journal)
-> ExceptT
StorageFormat IO (Either (ParseErrorBundle Text CustomErr) Journal)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text IO Journal
-> StorageFormat
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) Journal)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> StorageFormat -> 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) StorageFormat
f Text
txt
case Either (ParseErrorBundle Text CustomErr) Journal
ep of
Left e :: ParseErrorBundle Text CustomErr
e -> StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (StorageFormat -> ExceptT StorageFormat IO Journal)
-> StorageFormat -> ExceptT StorageFormat IO Journal
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> StorageFormat
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
Right pj :: Journal
pj -> InputOpts
-> StorageFormat
-> Text
-> Journal
-> ExceptT StorageFormat IO Journal
journalFinalise InputOpts
iopts StorageFormat
f Text
txt Journal
pj
journalFinalise :: InputOpts -> FilePath -> Text -> Journal -> ExceptT String IO Journal
journalFinalise :: InputOpts
-> StorageFormat
-> Text
-> Journal
-> ExceptT StorageFormat IO Journal
journalFinalise iopts :: InputOpts
iopts f :: StorageFormat
f txt :: Text
txt pj :: Journal
pj = do
ClockTime
t <- IO ClockTime -> ExceptT StorageFormat IO ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ClockTime
getClockTime
Day
d <- IO Day -> ExceptT StorageFormat IO Day
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
case Journal -> Either StorageFormat Journal
journalApplyCommodityStyles Journal
pj of
Left e :: StorageFormat
e -> StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StorageFormat
e
Right pj' :: Journal
pj' -> (StorageFormat -> ExceptT StorageFormat IO Journal)
-> (Journal -> ExceptT StorageFormat IO Journal)
-> Either StorageFormat Journal
-> ExceptT StorageFormat IO Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Journal -> ExceptT StorageFormat IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StorageFormat Journal -> ExceptT StorageFormat IO Journal)
-> Either StorageFormat Journal -> ExceptT StorageFormat IO Journal
forall a b. (a -> b) -> a -> b
$
Journal
pj'
Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
& (StorageFormat, Text) -> Journal -> Journal
journalAddFile (StorageFormat
f, Text
txt)
Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
& ClockTime -> Journal -> Journal
journalSetLastReadTime ClockTime
t
Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
& Journal -> Journal
journalReverse
Journal
-> (Journal -> Either StorageFormat Journal)
-> Either StorageFormat Journal
forall a b. a -> (a -> b) -> b
& (if Bool -> Bool
not (InputOpts -> Bool
auto_ InputOpts
iopts) Bool -> Bool -> Bool
|| [TransactionModifier] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Journal -> [TransactionModifier]
jtxnmodifiers Journal
pj)
then
Bool -> Journal -> Either StorageFormat Journal
journalBalanceTransactions (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ InputOpts -> Bool
ignore_assertions_ InputOpts
iopts)
else \j :: Journal
j -> do
Journal
j' <- Bool -> Journal -> Either StorageFormat Journal
journalBalanceTransactions Bool
False Journal
j
case Day -> Journal -> Either StorageFormat Journal
journalModifyTransactions Day
d Journal
j' of
Left e :: StorageFormat
e -> StorageFormat -> Either StorageFormat Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StorageFormat
e
Right j'' :: Journal
j'' -> do
Journal
j''' <- Journal -> Either StorageFormat Journal
journalApplyCommodityStyles Journal
j''
Bool -> Journal -> Either StorageFormat Journal
journalBalanceTransactions (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ InputOpts -> Bool
ignore_assertions_ InputOpts
iopts) Journal
j'''
)
Either StorageFormat Journal
-> (Either StorageFormat Journal -> Either StorageFormat Journal)
-> Either StorageFormat Journal
forall a b. a -> (a -> b) -> b
& (Journal -> Journal)
-> Either StorageFormat Journal -> Either StorageFormat Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> Journal
journalInferMarketPricesFromTransactions
setYear :: Year -> JournalParser m ()
setYear :: Integer -> JournalParser m ()
setYear y :: Integer
y = (Journal -> Journal) -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: Journal
j -> Journal
j{jparsedefaultyear :: Maybe Integer
jparsedefaultyear=Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
y})
getYear :: JournalParser m (Maybe Year)
getYear :: JournalParser m (Maybe Integer)
getYear = (Journal -> Maybe Integer)
-> StateT Journal (ParsecT CustomErr Text m) Journal
-> JournalParser m (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> Maybe Integer
jparsedefaultyear StateT Journal (ParsecT CustomErr Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle :: (Text, AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle cs :: (Text, AmountStyle)
cs = (Journal -> Journal) -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: Journal
j -> Journal
j{jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultcommodity=(Text, AmountStyle) -> Maybe (Text, AmountStyle)
forall a. a -> Maybe a
Just (Text, AmountStyle)
cs})
getDefaultCommodityAndStyle :: JournalParser m (Maybe (CommoditySymbol,AmountStyle))
getDefaultCommodityAndStyle :: JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle = Journal -> Maybe (Text, AmountStyle)
jparsedefaultcommodity (Journal -> Maybe (Text, AmountStyle))
-> StateT Journal (ParsecT CustomErr Text m) Journal
-> JournalParser 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 :: 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))
-> 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
getAmountStyle :: CommoditySymbol -> JournalParser m (Maybe AmountStyle)
getAmountStyle :: Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle commodity :: Text
commodity = do
Maybe AmountStyle
specificStyle <- Maybe AmountStyle
-> (Commodity -> Maybe AmountStyle)
-> Maybe Commodity
-> Maybe AmountStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe AmountStyle
forall a. Maybe a
Nothing Commodity -> Maybe AmountStyle
cformat (Maybe Commodity -> Maybe AmountStyle)
-> (Journal -> Maybe Commodity) -> Journal -> Maybe AmountStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Map Text Commodity -> Maybe Commodity
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
commodity (Map Text Commodity -> Maybe Commodity)
-> (Journal -> Map Text Commodity) -> Journal -> Maybe Commodity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Map Text Commodity
jcommodities (Journal -> Maybe AmountStyle)
-> StateT Journal (ParsecT CustomErr Text m) Journal
-> JournalParser m (Maybe AmountStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT CustomErr Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
Maybe AmountStyle
defaultStyle <- ((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
let effectiveStyle :: Maybe AmountStyle
effectiveStyle = [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
specificStyle, Maybe AmountStyle
defaultStyle]
Maybe AmountStyle -> JournalParser m (Maybe AmountStyle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AmountStyle
effectiveStyle
addDeclaredAccountType :: AccountName -> AccountType -> JournalParser m ()
addDeclaredAccountType :: Text -> AccountType -> JournalParser m ()
addDeclaredAccountType acct :: Text
acct atype :: AccountType
atype =
(Journal -> Journal) -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: Journal
j -> Journal
j{jdeclaredaccounttypes :: Map AccountType [Text]
jdeclaredaccounttypes = ([Text] -> [Text] -> [Text])
-> AccountType
-> [Text]
-> Map AccountType [Text]
-> Map AccountType [Text]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
(++) AccountType
atype [Text
acct] (Journal -> Map AccountType [Text]
jdeclaredaccounttypes Journal
j)})
pushParentAccount :: AccountName -> JournalParser m ()
pushParentAccount :: Text -> JournalParser m ()
pushParentAccount acct :: Text
acct = (Journal -> Journal) -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: Journal
j -> Journal
j{jparseparentaccounts :: [Text]
jparseparentaccounts = Text
acct Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Journal -> [Text]
jparseparentaccounts Journal
j})
popParentAccount :: JournalParser m ()
popParentAccount :: JournalParser m ()
popParentAccount = do
Journal
j <- StateT Journal (ParsecT 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 ('E' Char -> StorageFormat -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| "nd of apply account block with no beginning"))
(_:rest :: [Text]
rest) -> Journal -> JournalParser m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Journal
j{jparseparentaccounts :: [Text]
jparseparentaccounts=[Text]
rest}
getParentAccount :: JournalParser m AccountName
getParentAccount :: JournalParser m Text
getParentAccount = (Journal -> Text)
-> StateT Journal (ParsecT CustomErr Text m) Journal
-> JournalParser m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text] -> Text
concatAccountNames ([Text] -> Text) -> (Journal -> [Text]) -> Journal -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> (Journal -> [Text]) -> Journal -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Text]
jparseparentaccounts) StateT Journal (ParsecT CustomErr Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
addAccountAlias :: MonadState Journal m => AccountAlias -> m ()
addAccountAlias :: AccountAlias -> m ()
addAccountAlias a :: AccountAlias
a = (Journal -> Journal) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\(j :: Journal
j@Journal{..}) -> Journal
j{jparsealiases :: [AccountAlias]
jparsealiases=AccountAlias
aAccountAlias -> [AccountAlias] -> [AccountAlias]
forall a. a -> [a] -> [a]
:[AccountAlias]
jparsealiases})
getAccountAliases :: MonadState Journal m => m [AccountAlias]
getAccountAliases :: m [AccountAlias]
getAccountAliases = (Journal -> [AccountAlias]) -> m Journal -> m [AccountAlias]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> [AccountAlias]
jparsealiases m Journal
forall s (m :: * -> *). MonadState s m => m s
get
clearAccountAliases :: MonadState Journal m => m ()
clearAccountAliases :: m ()
clearAccountAliases = (Journal -> Journal) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\j :: Journal
j -> Journal
j{jparsealiases :: [AccountAlias]
jparsealiases=[]})
journalAddFile :: (FilePath,Text) -> Journal -> Journal
journalAddFile :: (StorageFormat, Text) -> Journal -> Journal
journalAddFile f :: (StorageFormat, Text)
f j :: Journal
j@Journal{jfiles :: Journal -> [(StorageFormat, Text)]
jfiles=[(StorageFormat, Text)]
fs} = Journal
j{jfiles :: [(StorageFormat, Text)]
jfiles=[(StorageFormat, Text)]
fs[(StorageFormat, Text)]
-> [(StorageFormat, Text)] -> [(StorageFormat, Text)]
forall a. [a] -> [a] -> [a]
++[(StorageFormat, Text)
f]}
match' :: TextParser m a -> TextParser m (Text, a)
match' :: TextParser m a -> TextParser m (Text, a)
match' p :: TextParser m a
p = do
(!Text
txt, p :: 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 :: 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 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 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 :: TextParser m Text
codep = Text -> TextParser m Text -> TextParser m Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option "" (TextParser m Text -> TextParser m Text)
-> TextParser m Text -> TextParser 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 Token Text
'('
Text
code <- Maybe StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe StorageFormat
forall a. Maybe a
Nothing ((Token Text -> Bool) -> TextParser m Text)
-> (Token Text -> Bool) -> TextParser m Text
forall a b. (a -> b) -> a -> b
$ \c :: Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ')' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\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 Token Text
')' ParsecT CustomErr Text m Char
-> StorageFormat -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "closing bracket ')' for transaction code"
Text -> TextParser m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
code
descriptionp :: TextParser m Text
descriptionp :: TextParser m Text
descriptionp = Maybe StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe StorageFormat
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
semicolonOrNewline)
where semicolonOrNewline :: Char -> Bool
semicolonOrNewline c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ';' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n'
datep :: JournalParser m Day
datep :: JournalParser m Day
datep = do
Maybe Integer
mYear <- JournalParser m (Maybe Integer)
forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
ParsecT 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' :: Maybe Integer -> TextParser m Day
datep' mYear :: 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)
-> StorageFormat -> TextParser m (Either Integer Int)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "year or month"
Char
sep <- TextParser m Char
forall (m :: * -> *). TextParser m Char
datesepchar TextParser m Char -> StorageFormat -> TextParser m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
-> StorageFormat -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "month or day"
case Either Integer Int
d1 of
Left y :: Integer
y -> Int -> Integer -> Char -> Int -> TextParser m Day
forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
y Char
sep Int
d2
Right m :: Int
m -> Int -> Maybe Integer -> Int -> Char -> Int -> TextParser 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
TextParser m Day -> StorageFormat -> TextParser m Day
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "full or partial date"
where
fullDate :: Int -> Year -> Char -> Month -> TextParser m Day
fullDate :: Int -> Integer -> Char -> Int -> TextParser m Day
fullDate startOffset :: Int
startOffset year :: Integer
year sep1 :: Char
sep1 month :: 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
-> StorageFormat -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
-> StorageFormat -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "day"
Int
endOffset <- ParsecT CustomErr Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
let dateStr :: StorageFormat
dateStr = Integer -> StorageFormat
forall a. Show a => a -> StorageFormat
show Integer
year StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
sep1] StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
month StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
sep2] StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> StorageFormat
forall a. Show a => a -> StorageFormat
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 -> StorageFormat -> CustomErr
parseErrorAtRegion Int
startOffset Int
endOffset (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$
"invalid date (mixing date separators is not allowed): " StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ StorageFormat
dateStr
case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
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 -> StorageFormat -> CustomErr
parseErrorAtRegion Int
startOffset Int
endOffset (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$
"well-formed but invalid date: " StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ StorageFormat
dateStr
Just date :: Day
date -> Day -> TextParser m Day
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> TextParser m Day) -> Day -> TextParser m Day
forall a b. (a -> b) -> a -> b
$! Day
date
partialDate :: Int -> Maybe Year -> Month -> Char -> MonthDay -> TextParser m Day
partialDate :: Int -> Maybe Integer -> Int -> Char -> Int -> TextParser m Day
partialDate startOffset :: Int
startOffset mYear :: Maybe Integer
mYear month :: Int
month sep :: Char
sep day :: 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 year :: Integer
year ->
case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
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 -> StorageFormat -> CustomErr
parseErrorAtRegion Int
startOffset Int
endOffset (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$
"well-formed but invalid date: " StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ StorageFormat
dateStr
Just date :: Day
date -> Day -> TextParser m Day
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> TextParser m Day) -> Day -> TextParser m Day
forall a b. (a -> b) -> a -> b
$! Day
date
where dateStr :: StorageFormat
dateStr = Integer -> StorageFormat
forall a. Show a => a -> StorageFormat
show Integer
year StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
sep] StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
month StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
sep] StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
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 -> StorageFormat -> CustomErr
parseErrorAtRegion Int
startOffset Int
endOffset (StorageFormat -> CustomErr) -> StorageFormat -> CustomErr
forall a b. (a -> b) -> a -> b
$
"partial date "StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++StorageFormat
dateStrStorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++" found, but the current year is unknown"
where dateStr :: StorageFormat
dateStr = Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
month StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
sep] StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> StorageFormat
forall a. Show a => a -> StorageFormat
show Int
day
{-# INLINABLE datep' #-}
datetimep :: JournalParser m LocalTime
datetimep :: JournalParser m LocalTime
datetimep = do
Maybe Integer
mYear <- JournalParser m (Maybe Integer)
forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
ParsecT 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' :: Maybe Integer -> TextParser m LocalTime
datetimep' mYear :: 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 StorageFormat
-> ParsecT CustomErr Text m (Maybe StorageFormat)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT CustomErr Text m StorageFormat
forall (m :: * -> *). TextParser m StorageFormat
timeZone
LocalTime -> TextParser m LocalTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalTime -> TextParser m LocalTime)
-> LocalTime -> TextParser m LocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
time
where
timeOfDay :: TextParser m TimeOfDay
timeOfDay :: TextParser m TimeOfDay
timeOfDay = do
Int
off1 <- ParsecT 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
-> StorageFormat -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
>= 0 Bool -> Bool -> Bool
&& Int
h' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 -> StorageFormat -> CustomErr
parseErrorAtRegion Int
off1 Int
off2 "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 Token Text
':' ParsecT CustomErr Text m Char
-> StorageFormat -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "':' (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
-> StorageFormat -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
>= 0 Bool -> Bool -> Bool
&& Int
m' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 -> StorageFormat -> CustomErr
parseErrorAtRegion Int
off3 Int
off4 "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 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 Token Text
':' ParsecT CustomErr Text m Char
-> StorageFormat -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "':' (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
-> StorageFormat -> ParsecT CustomErr Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
>= 0 Bool -> Bool -> Bool
&& Int
s' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 -> StorageFormat -> CustomErr
parseErrorAtRegion Int
off5 Int
off6 "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 :: 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
-> StorageFormat -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "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
*10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d2
timeZone :: TextParser m String
timeZone :: TextParser m StorageFormat
timeZone = do
Char
plusminus <- (Token Text -> Bool) -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Token Text -> Bool) -> ParsecT CustomErr Text m Char)
-> (Token Text -> Bool) -> ParsecT CustomErr Text m Char
forall a b. (a -> b) -> a -> b
$ \c :: Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '+'
StorageFormat
fourDigits <- Int -> ParsecT CustomErr Text m Char -> TextParser m StorageFormat
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count 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
-> StorageFormat -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "a digit (for a time zone)")
StorageFormat -> TextParser m StorageFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StorageFormat -> TextParser m StorageFormat)
-> StorageFormat -> TextParser m StorageFormat
forall a b. (a -> b) -> a -> b
$ Char
plusminusChar -> ShowS
forall a. a -> [a] -> [a]
:StorageFormat
fourDigits
secondarydatep :: Day -> TextParser m Day
secondarydatep :: Day -> TextParser m Day
secondarydatep primaryDate :: 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 Token Text
'=' ParsecT CustomErr Text m Char
-> TextParser m Day -> TextParser m Day
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Integer -> TextParser m Day
forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
primaryYear)
where primaryYear :: Integer
primaryYear = (Integer, Int, Int) -> Integer
forall a b c. (a, b, c) -> a
first3 ((Integer, Int, Int) -> Integer) -> (Integer, Int, Int) -> Integer
forall a b. (a -> b) -> a -> b
$ Day -> (Integer, Int, Int)
toGregorian Day
primaryDate
yearorintp :: TextParser m (Either Year Int)
yearorintp :: TextParser m (Either Integer Int)
yearorintp = do
Text
yearOrMonth <- Maybe StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just "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
>= 4 then Integer -> Either Integer Int
forall a b. a -> Either a b
Left Integer
n else Int -> Either Integer Int
forall a b. b -> Either a b
Right (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
modifiedaccountnamep :: JournalParser m AccountName
modifiedaccountnamep :: JournalParser m Text
modifiedaccountnamep = do
Text
parent <- JournalParser m Text
forall (m :: * -> *). JournalParser m Text
getParentAccount
[AccountAlias]
aliases <- StateT Journal (ParsecT 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 StorageFormat Text
accountNameApplyAliases [AccountAlias]
aliases (Text -> Either StorageFormat Text)
-> Text -> Either StorageFormat Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
joinAccountNames Text
parent Text
a of
Right a' :: 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 e :: StorageFormat
e -> StorageFormat -> JournalParser m Text
forall a. StorageFormat -> a
error' StorageFormat
err
where
err :: StorageFormat
err = "problem in account alias applied to "StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> StorageFormat
T.unpack Text
aStorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++": "StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++StorageFormat
e
accountnamep :: TextParser m AccountName
accountnamep :: TextParser m Text
accountnamep = TextParser m Text
forall (m :: * -> *). TextParser m Text
singlespacedtextp
singlespacedtextp :: TextParser m T.Text
singlespacedtextp :: TextParser m Text
singlespacedtextp = (Char -> Bool) -> TextParser m Text
forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfyingp (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)
singlespacedtextsatisfyingp :: (Char -> Bool) -> TextParser m T.Text
singlespacedtextsatisfyingp :: (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfyingp pred :: 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 StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe StorageFormat
forall a. Maybe a
Nothing (\c :: 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 :: 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 -> TextParser m () -> TextParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m Char -> TextParser 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 :: JournalParser m MixedAmount
spaceandamountormissingp =
MixedAmount
-> JournalParser m MixedAmount -> JournalParser m MixedAmount
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option MixedAmount
missingmixedamt (JournalParser m MixedAmount -> JournalParser m MixedAmount)
-> JournalParser m MixedAmount -> JournalParser m MixedAmount
forall a b. (a -> b) -> a -> b
$ JournalParser m MixedAmount -> JournalParser m MixedAmount
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (JournalParser m MixedAmount -> JournalParser m MixedAmount)
-> JournalParser m MixedAmount -> JournalParser m MixedAmount
forall a b. (a -> b) -> a -> b
$ do
ParsecT 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
Mixed ([Amount] -> MixedAmount)
-> (Amount -> [Amount]) -> Amount -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
:[]) (Amount -> MixedAmount)
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> JournalParser 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 :: JournalParser m Amount
amountp = StorageFormat -> JournalParser m Amount -> JournalParser m Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "amount" (JournalParser m Amount -> JournalParser m Amount)
-> JournalParser m Amount -> JournalParser m Amount
forall a b. (a -> b) -> a -> b
$ do
let spaces :: StateT Journal (ParsecT 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 <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountwithoutpricep JournalParser m Amount
-> StateT Journal (ParsecT CustomErr Text m) ()
-> JournalParser m Amount
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). StateT Journal (ParsecT CustomErr Text m) ()
spaces
(mprice :: Maybe AmountPrice
mprice, _elotprice :: Maybe ()
_elotprice, _elotdate :: 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, Monad 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
<$> StateT Journal (ParsecT CustomErr Text m) AmountPrice
forall (m :: * -> *). JournalParser m AmountPrice
priceamountp 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 :: * -> *). StateT Journal (ParsecT CustomErr Text 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 :: * -> *). StateT Journal (ParsecT CustomErr Text 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 :: * -> *). StateT Journal (ParsecT CustomErr Text 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 :: * -> *). StateT Journal (ParsecT CustomErr Text 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 :: * -> *). StateT Journal (ParsecT CustomErr Text m) ()
spaces)
Amount -> JournalParser m Amount
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Amount -> JournalParser m Amount)
-> Amount -> JournalParser m Amount
forall a b. (a -> b) -> a -> b
$ Amount
amount { aprice :: Maybe AmountPrice
aprice = Maybe AmountPrice
mprice }
amountpnolotprices :: JournalParser m Amount
amountpnolotprices :: JournalParser m Amount
amountpnolotprices = StorageFormat -> JournalParser m Amount -> JournalParser m Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "amount" (JournalParser m Amount -> JournalParser m Amount)
-> JournalParser m Amount -> JournalParser m Amount
forall a b. (a -> b) -> a -> b
$ do
let spaces :: StateT Journal (ParsecT 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 <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountwithoutpricep
StateT Journal (ParsecT CustomErr Text m) ()
forall (m :: * -> *). StateT Journal (ParsecT CustomErr Text 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
$ StateT Journal (ParsecT CustomErr Text m) AmountPrice
forall (m :: * -> *). JournalParser m AmountPrice
priceamountp 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 :: * -> *). StateT Journal (ParsecT CustomErr Text m) ()
spaces
Amount -> JournalParser m Amount
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Amount -> JournalParser m Amount)
-> Amount -> JournalParser m Amount
forall a b. (a -> b) -> a -> b
$ Amount
amount { aprice :: Maybe AmountPrice
aprice = Maybe AmountPrice
mprice }
amountwithoutpricep :: JournalParser m Amount
amountwithoutpricep :: JournalParser m Amount
amountwithoutpricep = do
(mult :: Bool
mult, sign :: Decimal -> Decimal
sign) <- ParsecT CustomErr Text m (Bool, Decimal -> Decimal)
-> StateT
Journal (ParsecT CustomErr Text m) (Bool, Decimal -> Decimal)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Bool, Decimal -> Decimal)
-> StateT
Journal (ParsecT CustomErr Text m) (Bool, Decimal -> Decimal))
-> ParsecT CustomErr Text m (Bool, Decimal -> Decimal)
-> StateT
Journal (ParsecT CustomErr Text m) (Bool, Decimal -> Decimal)
forall a b. (a -> b) -> a -> b
$ (,) (Bool -> (Decimal -> Decimal) -> (Bool, Decimal -> Decimal))
-> ParsecT CustomErr Text m Bool
-> ParsecT
CustomErr
Text
m
((Decimal -> Decimal) -> (Bool, Decimal -> Decimal))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m Bool
forall (m :: * -> *). TextParser m Bool
multiplierp ParsecT
CustomErr
Text
m
((Decimal -> Decimal) -> (Bool, Decimal -> Decimal))
-> ParsecT CustomErr Text m (Decimal -> Decimal)
-> ParsecT CustomErr Text m (Bool, Decimal -> Decimal)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomErr Text m (Decimal -> Decimal)
forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
Bool -> (Decimal -> Decimal) -> JournalParser m Amount
forall (m :: * -> *).
Bool -> (Decimal -> Decimal) -> JournalParser m Amount
leftsymbolamountp Bool
mult Decimal -> Decimal
sign JournalParser m Amount
-> JournalParser m Amount -> JournalParser m Amount
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> (Decimal -> Decimal) -> JournalParser m Amount
forall (m :: * -> *).
Bool -> (Decimal -> Decimal) -> JournalParser m Amount
rightornosymbolamountp Bool
mult Decimal -> Decimal
sign
where
leftsymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount
leftsymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount
leftsymbolamountp mult :: Bool
mult sign :: Decimal -> Decimal
sign = StorageFormat -> JournalParser m Amount -> JournalParser m Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "amount" (JournalParser m Amount -> JournalParser m Amount)
-> JournalParser m Amount -> JournalParser 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
suggestedStyle <- Text -> JournalParser m (Maybe AmountStyle)
forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
c
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'
Decimal -> Decimal
sign2 <- ParsecT CustomErr Text m (Decimal -> Decimal)
-> StateT Journal (ParsecT CustomErr Text m) (Decimal -> Decimal)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Decimal -> Decimal)
-> StateT Journal (ParsecT CustomErr Text m) (Decimal -> Decimal))
-> ParsecT CustomErr Text m (Decimal -> Decimal)
-> StateT Journal (ParsecT CustomErr Text m) (Decimal -> Decimal)
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m (Decimal -> Decimal)
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)
(q :: Decimal
q,prec :: AmountPrecision
prec,mdec :: Maybe Char
mdec,mgrps :: Maybe DigitGroupStyle
mgrps) <- ParsecT
CustomErr
Text
m
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr
Text
m
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr
Text
m
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, 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
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Decimal, 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 -> JournalParser m Amount
forall (m :: * -> *) a. Monad m => a -> m a
return (Amount -> JournalParser m Amount)
-> Amount -> JournalParser m Amount
forall a b. (a -> b) -> a -> b
$ Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Decimal
aquantity=Decimal -> Decimal
sign (Decimal -> Decimal
sign2 Decimal
q), aismultiplier :: Bool
aismultiplier=Bool
mult, astyle :: AmountStyle
astyle=AmountStyle
s, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing}
rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount
rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount
rightornosymbolamountp mult :: Bool
mult sign :: Decimal -> Decimal
sign = StorageFormat -> JournalParser m Amount -> JournalParser m Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "amount" (JournalParser m Amount -> JournalParser m Amount)
-> JournalParser m Amount -> JournalParser m Amount
forall a b. (a -> b) -> a -> b
$ do
Int
offBeforeNum <- StateT Journal (ParsecT 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 (commodityspaced :: Bool
commodityspaced, c :: Text
c) -> do
Maybe AmountStyle
suggestedStyle <- Text -> JournalParser m (Maybe AmountStyle)
forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
c
(q :: Decimal
q,prec :: AmountPrecision
prec,mdec :: Maybe Char
mdec,mgrps :: Maybe DigitGroupStyle
mgrps) <- ParsecT
CustomErr
Text
m
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr
Text
m
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr
Text
m
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, 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
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Decimal, 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
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 -> JournalParser m Amount
forall (m :: * -> *) a. Monad m => a -> m a
return (Amount -> JournalParser m Amount)
-> Amount -> JournalParser m Amount
forall a b. (a -> b) -> a -> b
$ Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Decimal
aquantity=Decimal -> Decimal
sign Decimal
q, aismultiplier :: Bool
aismultiplier=Bool
mult, astyle :: AmountStyle
astyle=AmountStyle
s, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing}
Nothing -> do
Maybe AmountStyle
suggestedStyle <- JournalParser m (Maybe AmountStyle)
forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDefaultAmountStyle
(q :: Decimal
q,prec :: AmountPrecision
prec,mdec :: Maybe Char
mdec,mgrps :: Maybe DigitGroupStyle
mgrps) <- ParsecT
CustomErr
Text
m
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr
Text
m
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr
Text
m
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, 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
(Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
suggestedStyle 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 (c :: Text
c,s :: AmountStyle
s) = case (Bool
mult, Maybe (Text, AmountStyle)
defcs) of
(False, Just (defc :: Text
defc,defs :: 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})
_ -> ("", AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps})
Amount -> JournalParser m Amount
forall (m :: * -> *) a. Monad m => a -> m a
return (Amount -> JournalParser m Amount)
-> Amount -> JournalParser m Amount
forall a b. (a -> b) -> a -> b
$ Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Decimal
aquantity=Decimal -> Decimal
sign Decimal
q, aismultiplier :: Bool
aismultiplier=Bool
mult, astyle :: AmountStyle
astyle=AmountStyle
s, aprice :: Maybe AmountPrice
aprice=Maybe AmountPrice
forall a. Maybe a
Nothing}
interpretNumber
:: (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber :: (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
m (Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber posRegion :: (Int, Int)
posRegion suggestedStyle :: Maybe AmountStyle
suggestedStyle ambiguousNum :: Either AmbiguousNumber RawNumber
ambiguousNum mExp :: 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
suggestedStyle) RawNumber -> RawNumber
forall a. a -> a
id Either AmbiguousNumber RawNumber
ambiguousNum
in case RawNumber
-> Maybe Integer
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
Left errMsg :: StorageFormat
errMsg -> CustomErr
-> TextParser
m (Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr
-> TextParser
m (Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> CustomErr
-> TextParser
m (Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$
(Int -> Int -> StorageFormat -> CustomErr)
-> (Int, Int) -> StorageFormat -> CustomErr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> StorageFormat -> CustomErr
parseErrorAtRegion (Int, Int)
posRegion StorageFormat
errMsg
Right (q :: Decimal
q,p :: Word8
p,d :: Maybe Char
d,g :: Maybe DigitGroupStyle
g) -> (Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> TextParser
m (Decimal, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decimal
q, Word8 -> AmountPrecision
Precision Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g)
amountp' :: String -> Amount
amountp' :: StorageFormat -> Amount
amountp' s :: StorageFormat
s =
case Parsec CustomErr Text Amount
-> StorageFormat
-> Text
-> Either (ParseErrorBundle Text CustomErr) Amount
forall e s a.
Parsec e s a
-> StorageFormat -> 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) "" (StorageFormat -> Text
T.pack StorageFormat
s) of
Right amt :: Amount
amt -> Amount
amt
Left err :: ParseErrorBundle Text CustomErr
err -> StorageFormat -> Amount
forall a. StorageFormat -> a
error' (StorageFormat -> Amount) -> StorageFormat -> Amount
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> StorageFormat
forall a. Show a => a -> StorageFormat
show ParseErrorBundle Text CustomErr
err
mamountp' :: String -> MixedAmount
mamountp' :: StorageFormat -> MixedAmount
mamountp' = [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount)
-> (StorageFormat -> [Amount]) -> StorageFormat -> MixedAmount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Amount -> [Amount] -> [Amount]
forall a. a -> [a] -> [a]
:[]) (Amount -> [Amount])
-> (StorageFormat -> Amount) -> StorageFormat -> [Amount]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageFormat -> Amount
amountp'
signp :: Num a => TextParser m (a -> a)
signp :: TextParser m (a -> a)
signp = ((Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'-' ParsecT CustomErr Text m Char
-> TextParser m (a -> a) -> TextParser m (a -> a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a) -> TextParser m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. Num a => a -> a
negate TextParser m (a -> a)
-> TextParser m (a -> a) -> TextParser m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'+' ParsecT CustomErr Text m Char
-> TextParser m (a -> a) -> TextParser m (a -> a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a) -> TextParser m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id) TextParser m (a -> a)
-> ParsecT CustomErr Text m () -> TextParser 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) TextParser m (a -> a)
-> TextParser m (a -> a) -> TextParser m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> TextParser m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id
multiplierp :: TextParser m Bool
multiplierp :: TextParser m Bool
multiplierp = Bool -> TextParser m Bool -> TextParser m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (TextParser m Bool -> TextParser m Bool)
-> TextParser m Bool -> TextParser m Bool
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 Token Text
'*' ParsecT CustomErr Text m Char
-> TextParser m Bool -> TextParser m Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> TextParser m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
commoditysymbolp :: TextParser m CommoditySymbol
commoditysymbolp :: TextParser m Text
commoditysymbolp =
TextParser m Text
forall (m :: * -> *). TextParser m Text
quotedcommoditysymbolp TextParser m Text -> TextParser m Text -> TextParser m Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser m Text
forall (m :: * -> *). TextParser m Text
simplecommoditysymbolp TextParser m Text -> StorageFormat -> TextParser m Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "commodity symbol"
quotedcommoditysymbolp :: TextParser m CommoditySymbol
quotedcommoditysymbolp :: TextParser m Text
quotedcommoditysymbolp =
ParsecT CustomErr Text m Char
-> ParsecT CustomErr Text m Char
-> TextParser m Text
-> TextParser m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT CustomErr Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
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 Token Text
'"') (TextParser m Text -> TextParser m Text)
-> TextParser m Text -> TextParser m Text
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe StorageFormat
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
f
where f :: Char -> Bool
f c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ';' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\"'
simplecommoditysymbolp :: TextParser m CommoditySymbol
simplecommoditysymbolp :: TextParser m Text
simplecommoditysymbolp = Maybe StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe StorageFormat
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNonsimpleCommodityChar)
priceamountp :: JournalParser m AmountPrice
priceamountp :: JournalParser m AmountPrice
priceamountp = StorageFormat
-> JournalParser m AmountPrice -> JournalParser m AmountPrice
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "transaction price" (JournalParser m AmountPrice -> JournalParser m AmountPrice)
-> JournalParser m AmountPrice -> JournalParser m AmountPrice
forall a b. (a -> b) -> a -> b
$ do
Bool
parenthesised <- Bool
-> StateT Journal (ParsecT 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 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 Token Text
'@'
Amount -> AmountPrice
priceConstructor <- 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 Token Text
'@' StateT Journal (ParsecT CustomErr Text m) Char
-> StateT
Journal (ParsecT CustomErr Text m) (Amount -> AmountPrice)
-> StateT
Journal (ParsecT CustomErr Text m) (Amount -> AmountPrice)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Amount -> AmountPrice)
-> StateT
Journal (ParsecT CustomErr Text m) (Amount -> AmountPrice)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Amount -> AmountPrice
TotalPrice StateT Journal (ParsecT CustomErr Text m) (Amount -> AmountPrice)
-> StateT
Journal (ParsecT CustomErr Text m) (Amount -> AmountPrice)
-> StateT
Journal (ParsecT CustomErr Text m) (Amount -> AmountPrice)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Amount -> AmountPrice)
-> StateT
Journal (ParsecT CustomErr Text m) (Amount -> AmountPrice)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Amount -> AmountPrice
UnitPrice
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 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 <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountwithoutpricep
AmountPrice -> JournalParser m AmountPrice
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AmountPrice -> JournalParser m AmountPrice)
-> AmountPrice -> JournalParser m AmountPrice
forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
priceConstructor Amount
priceAmount
balanceassertionp :: JournalParser m BalanceAssertion
balanceassertionp :: JournalParser m BalanceAssertion
balanceassertionp = do
GenericSourcePos
sourcepos <- SourcePos -> GenericSourcePos
genericSourcePos (SourcePos -> GenericSourcePos)
-> StateT Journal (ParsecT CustomErr Text m) SourcePos
-> StateT Journal (ParsecT CustomErr Text m) GenericSourcePos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text m SourcePos
-> StateT Journal (ParsecT CustomErr Text m) SourcePos
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT CustomErr Text m SourcePos
forall e s (m :: * -> *). 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 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 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 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
amountpnolotprices JournalParser m Amount -> StorageFormat -> JournalParser m Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "amount (for a balance assertion or assignment)"
BalanceAssertion -> JournalParser m BalanceAssertion
forall (m :: * -> *) a. Monad m => a -> m a
return BalanceAssertion :: Amount -> Bool -> Bool -> GenericSourcePos -> BalanceAssertion
BalanceAssertion
{ baamount :: Amount
baamount = Amount
a
, batotal :: Bool
batotal = Bool
istotal
, bainclusive :: Bool
bainclusive = Bool
isinclusive
, baposition :: GenericSourcePos
baposition = GenericSourcePos
sourcepos
}
lotpricep :: JournalParser m ()
lotpricep :: JournalParser m ()
lotpricep = StorageFormat -> JournalParser m () -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "ledger-style lot price" (JournalParser m () -> JournalParser m ())
-> JournalParser m () -> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ do
Token Text
-> StateT Journal (ParsecT CustomErr Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
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 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 () -> JournalParser 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 JournalParser 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 Token Text
'='
ParsecT CustomErr Text m () -> JournalParser 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
amountwithoutpricep
ParsecT CustomErr Text m () -> JournalParser 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 Token Text
'}'
Bool -> JournalParser m () -> JournalParser m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
doublebrace) (JournalParser m () -> JournalParser m ())
-> JournalParser m () -> JournalParser m ()
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT CustomErr Text m) Char
-> JournalParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Journal (ParsecT CustomErr Text m) Char
-> JournalParser m ())
-> StateT Journal (ParsecT CustomErr Text m) Char
-> JournalParser 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 Token Text
'}'
() -> JournalParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lotdatep :: JournalParser m ()
lotdatep :: 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 Token Text
'['
ParsecT CustomErr Text m () -> JournalParser 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 () -> JournalParser 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 Token Text
']'
() -> JournalParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
) JournalParser m () -> StorageFormat -> JournalParser m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "ledger-style lot date"
numberp :: Maybe AmountStyle -> TextParser m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp :: Maybe AmountStyle
-> TextParser m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp suggestedStyle :: Maybe AmountStyle
suggestedStyle = StorageFormat
-> TextParser m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> TextParser m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "number" (TextParser m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> TextParser
m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle))
-> TextParser m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> TextParser m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ do
Decimal -> Decimal
sign <- TextParser m (Decimal -> Decimal)
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
StorageFormat -> Maybe AmountStyle -> Maybe AmountStyle
forall a. Show a => StorageFormat -> a -> a
dbg7 "numberp suggestedStyle" Maybe AmountStyle
suggestedStyle Maybe AmountStyle
-> ParsecT CustomErr Text m () -> ParsecT CustomErr Text m ()
forall a b. a -> b -> b
`seq` () -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
case StorageFormat
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a. Show a => StorageFormat -> a -> a
dbg7 "numberp quantity,precision,mdecimalpoint,mgrps"
(Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle))
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ RawNumber
-> Maybe Integer
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
Left errMsg :: StorageFormat
errMsg -> StorageFormat
-> TextParser m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *) a. MonadFail m => StorageFormat -> m a
Fail.fail StorageFormat
errMsg
Right (q :: Decimal
q, p :: Word8
p, d :: Maybe Char
d, g :: Maybe DigitGroupStyle
g) -> (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> TextParser m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decimal -> Decimal
sign Decimal
q, Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g)
exponentp :: TextParser m Integer
exponentp :: 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' 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)
-> TextParser m Integer -> TextParser m Integer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TextParser m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal TextParser m Integer -> StorageFormat -> TextParser m Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "exponent"
fromRawNumber
:: RawNumber
-> Maybe Integer
-> Either String
(Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber :: RawNumber
-> Maybe Integer
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber (WithSeparators _ _ _) (Just _) =
StorageFormat
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a b. a -> Either a b
Left "invalid number: mixing digit separators with exponents is not allowed"
fromRawNumber raw :: RawNumber
raw mExp :: Maybe Integer
mExp = do
(quantity :: Decimal
quantity, precision :: Word8
precision) <- Integer
-> DigitGrp -> DigitGrp -> Either StorageFormat (Decimal, Word8)
toQuantity (Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe 0 Maybe Integer
mExp) (RawNumber -> DigitGrp
digitGroup RawNumber
raw) (RawNumber -> DigitGrp
decimalGroup RawNumber
raw)
(Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
StorageFormat (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Decimal
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 StorageFormat (Decimal, Word8)
toQuantity e :: Integer
e preDecimalGrp :: DigitGrp
preDecimalGrp postDecimalGrp :: DigitGrp
postDecimalGrp
| Integer
precision Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = (Decimal, Word8) -> Either StorageFormat (Decimal, Word8)
forall a b. b -> Either a b
Right (Word8 -> Integer -> Decimal
forall i. Word8 -> i -> DecimalRaw i
Decimal 0 (Integer
digitGrpNum Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Integer
precision)), 0)
| Integer
precision Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 256 = (Decimal, Word8) -> Either StorageFormat (Decimal, Word8)
forall a b. b -> Either a b
Right (Word8 -> Integer -> Decimal
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
precision8 Integer
digitGrpNum, Word8
precision8)
| Bool
otherwise = StorageFormat -> Either StorageFormat (Decimal, Word8)
forall a b. a -> Either a b
Left "invalid number: numbers with more than 255 decimal digits are not allowed at this time"
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 _ mDecimals :: 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 _ _ mDecimals :: 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 _ mDecimals :: 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 _ _ mDecimals :: 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
digitGrp _) = DigitGrp
digitGrp
digitGroup (WithSeparators _ digitGrps :: [DigitGrp]
digitGrps _) = [DigitGrp] -> DigitGrp
forall a. Monoid a => [a] -> a
mconcat [DigitGrp]
digitGrps
digitGroupStyle :: RawNumber -> Maybe DigitGroupStyle
digitGroupStyle (NoSeparators _ _) = Maybe DigitGroupStyle
forall a. Maybe a
Nothing
digitGroupStyle (WithSeparators sep :: Char
sep grps :: [DigitGrp]
grps _) = 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 digitGrps :: [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
(a :: Word8
a:b :: Word8
b:cs :: [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
gs :: [Word8]
gs -> [Word8]
gs
disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber suggestedStyle :: Maybe AmountStyle
suggestedStyle (AmbiguousNumber grp1 :: DigitGrp
grp1 sep :: Char
sep grp2 :: DigitGrp
grp2) =
if Char -> Bool
isDecimalPointChar 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
suggestedStyle
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 c :: Char
c = \case
AmountStyle{asdecimalpoint :: AmountStyle -> Maybe Char
asdecimalpoint = Just d :: Char
d} -> Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c
AmountStyle{asdigitgroups :: AmountStyle -> Maybe DigitGroupStyle
asdigitgroups = Just (DigitGroups g :: Char
g _)} -> Char
g Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c
AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision = Precision 0} -> Bool
False
_ -> Bool
True
rawnumberp :: TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp :: TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp = StorageFormat
-> TextParser m (Either AmbiguousNumber RawNumber)
-> TextParser m (Either AmbiguousNumber RawNumber)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "number" (TextParser m (Either AmbiguousNumber RawNumber)
-> TextParser m (Either AmbiguousNumber RawNumber))
-> TextParser m (Either AmbiguousNumber RawNumber)
-> TextParser m (Either AmbiguousNumber RawNumber)
forall a b. (a -> b) -> a -> b
$ do
Either AmbiguousNumber RawNumber
rawNumber <- (RawNumber -> Either AmbiguousNumber RawNumber)
-> ParsecT 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 ParsecT CustomErr Text m RawNumber
forall (m :: * -> *). TextParser m RawNumber
leadingDecimalPt TextParser m (Either AmbiguousNumber RawNumber)
-> TextParser m (Either AmbiguousNumber RawNumber)
-> TextParser m (Either AmbiguousNumber RawNumber)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits
Maybe 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
isDecimalPointChar
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
$
StorageFormat -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadFail m => StorageFormat -> m a
Fail.fail "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 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 off :: 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 -> StorageFormat -> CustomErr
parseErrorAt Int
off "invalid number (excessive trailing digits)"
Nothing -> () -> ParsecT CustomErr Text m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Either AmbiguousNumber RawNumber
-> TextParser m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AmbiguousNumber RawNumber
-> TextParser m (Either AmbiguousNumber RawNumber))
-> Either AmbiguousNumber RawNumber
-> TextParser m (Either AmbiguousNumber RawNumber)
forall a b. (a -> b) -> a -> b
$ StorageFormat
-> Either AmbiguousNumber RawNumber
-> Either AmbiguousNumber RawNumber
forall a. Show a => StorageFormat -> a -> a
dbg7 "rawnumberp" Either AmbiguousNumber RawNumber
rawNumber
where
leadingDecimalPt :: TextParser m RawNumber
leadingDecimalPt :: 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
isDecimalPointChar
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 :: 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 :: DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber)
withSeparators grp1 :: DigitGrp
grp1 = do
(sep :: Char
sep, grp2 :: 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 :: Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt digitSep :: Char
digitSep digitGroups :: [DigitGrp]
digitGroups = do
Char
decPt <- (Token Text -> Bool) -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Token Text -> Bool) -> ParsecT CustomErr Text m Char)
-> (Token Text -> Bool) -> ParsecT CustomErr Text m Char
forall a b. (a -> b) -> a -> b
$ \c :: Token Text
c -> Char -> Bool
isDecimalPointChar 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 grp1 :: DigitGrp
grp1 sep :: Char
sep grp2 :: DigitGrp
grp2 grps :: [DigitGrp]
grps
| [DigitGrp] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DigitGrp]
grps Bool -> Bool -> Bool
&& Char -> Bool
isDecimalPointChar 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 :: DigitGrp -> TextParser m RawNumber
trailingDecimalPt grp1 :: 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
isDecimalPointChar
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))
isDecimalPointChar :: Char -> Bool
isDecimalPointChar :: Char -> Bool
isDecimalPointChar c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ','
isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar c :: Char
c = Char -> Bool
isDecimalPointChar Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' '
data RawNumber
= NoSeparators DigitGrp (Maybe (Char, DigitGrp))
| WithSeparators Char [DigitGrp] (Maybe (Char, DigitGrp))
deriving (Int -> RawNumber -> ShowS
[RawNumber] -> ShowS
RawNumber -> StorageFormat
(Int -> RawNumber -> ShowS)
-> (RawNumber -> StorageFormat)
-> ([RawNumber] -> ShowS)
-> Show RawNumber
forall a.
(Int -> a -> ShowS)
-> (a -> StorageFormat) -> ([a] -> ShowS) -> Show a
showList :: [RawNumber] -> ShowS
$cshowList :: [RawNumber] -> ShowS
show :: RawNumber -> StorageFormat
$cshow :: RawNumber -> StorageFormat
showsPrec :: Int -> RawNumber -> ShowS
$cshowsPrec :: Int -> RawNumber -> ShowS
Show, RawNumber -> RawNumber -> Bool
(RawNumber -> RawNumber -> Bool)
-> (RawNumber -> RawNumber -> Bool) -> Eq RawNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawNumber -> RawNumber -> Bool
$c/= :: RawNumber -> RawNumber -> Bool
== :: RawNumber -> RawNumber -> Bool
$c== :: RawNumber -> RawNumber -> Bool
Eq)
data AmbiguousNumber = AmbiguousNumber DigitGrp Char DigitGrp
deriving (Int -> AmbiguousNumber -> ShowS
[AmbiguousNumber] -> ShowS
AmbiguousNumber -> StorageFormat
(Int -> AmbiguousNumber -> ShowS)
-> (AmbiguousNumber -> StorageFormat)
-> ([AmbiguousNumber] -> ShowS)
-> Show AmbiguousNumber
forall a.
(Int -> a -> ShowS)
-> (a -> StorageFormat) -> ([a] -> ShowS) -> Show a
showList :: [AmbiguousNumber] -> ShowS
$cshowList :: [AmbiguousNumber] -> ShowS
show :: AmbiguousNumber -> StorageFormat
$cshow :: AmbiguousNumber -> StorageFormat
showsPrec :: Int -> AmbiguousNumber -> ShowS
$cshowsPrec :: Int -> AmbiguousNumber -> ShowS
Show, AmbiguousNumber -> AmbiguousNumber -> Bool
(AmbiguousNumber -> AmbiguousNumber -> Bool)
-> (AmbiguousNumber -> AmbiguousNumber -> Bool)
-> Eq AmbiguousNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AmbiguousNumber -> AmbiguousNumber -> Bool
$c/= :: AmbiguousNumber -> AmbiguousNumber -> Bool
== :: AmbiguousNumber -> AmbiguousNumber -> Bool
$c== :: AmbiguousNumber -> AmbiguousNumber -> Bool
Eq)
data DigitGrp = DigitGrp {
DigitGrp -> Word
digitGroupLength :: !Word,
DigitGrp -> Integer
digitGroupNumber :: !Integer
} deriving (DigitGrp -> DigitGrp -> Bool
(DigitGrp -> DigitGrp -> Bool)
-> (DigitGrp -> DigitGrp -> Bool) -> Eq DigitGrp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DigitGrp -> DigitGrp -> Bool
$c/= :: DigitGrp -> DigitGrp -> Bool
== :: DigitGrp -> DigitGrp -> Bool
$c== :: DigitGrp -> DigitGrp -> Bool
Eq)
instance Show DigitGrp where
show :: DigitGrp -> StorageFormat
show (DigitGrp len :: Word
len num :: Integer
num) = "\"" StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ StorageFormat
padding StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ StorageFormat
numStr StorageFormat -> ShowS
forall a. [a] -> [a] -> [a]
++ "\""
where numStr :: StorageFormat
numStr = Integer -> StorageFormat
forall a. Show a => a -> StorageFormat
show Integer
num
padding :: StorageFormat
padding = Integer -> Char -> StorageFormat
forall i a. Integral i => i -> a -> [a]
genericReplicate (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
len Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a. Integral a => a -> Integer
toInteger (StorageFormat -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length StorageFormat
numStr)) '0'
instance Sem.Semigroup DigitGrp where
DigitGrp l1 :: Word
l1 n1 :: Integer
n1 <> :: DigitGrp -> DigitGrp -> DigitGrp
<> DigitGrp l2 :: Word
l2 n2 :: 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
* 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 0 0
mappend :: DigitGrp -> DigitGrp -> DigitGrp
mappend = DigitGrp -> DigitGrp -> DigitGrp
forall a. Semigroup a => a -> a -> a
(Sem.<>)
digitgroupp :: TextParser m DigitGrp
digitgroupp :: TextParser m DigitGrp
digitgroupp = StorageFormat -> TextParser m DigitGrp -> TextParser m DigitGrp
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "digits"
(TextParser m DigitGrp -> TextParser m DigitGrp)
-> TextParser m DigitGrp -> TextParser m DigitGrp
forall a b. (a -> b) -> a -> b
$ Text -> DigitGrp
makeGroup (Text -> DigitGrp)
-> ParsecT CustomErr Text m Text -> TextParser m DigitGrp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (StorageFormat -> Maybe StorageFormat
forall a. a -> Maybe a
Just "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) -> StorageFormat -> (Word, Integer)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word, Integer) -> Char -> (Word, Integer)
forall a b. (Num a, Num b) => (a, b) -> Char -> (a, b)
step (0, 0) (StorageFormat -> (Word, Integer))
-> (Text -> StorageFormat) -> Text -> (Word, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StorageFormat
T.unpack
step :: (a, b) -> Char -> (a, b)
step (!a
l, !b
a) c :: Char
c = (a
la -> a -> a
forall a. Num a => a -> a -> a
+1, b
ab -> b -> b
forall a. Num a => a -> a -> a
*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 ()
= TextParser m ()
startComment TextParser m () -> TextParser m () -> TextParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TextParser m ()
anyLine TextParser m () -> TextParser m () -> TextParser m ()
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
`skipManyTill` TextParser m ()
endComment
where
startComment :: TextParser m ()
startComment = Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "comment" ParsecT CustomErr Text m Text -> TextParser m () -> TextParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TextParser m ()
forall (m :: * -> *). TextParser m ()
trailingSpaces
endComment :: TextParser m ()
endComment = TextParser m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof TextParser m () -> TextParser m () -> TextParser m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "end comment" ParsecT CustomErr Text m Text -> TextParser m () -> TextParser m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TextParser m ()
forall (m :: * -> *). TextParser m ()
trailingSpaces
trailingSpaces :: ParsecT 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 :: TextParser m ()
anyLine = ParsecT CustomErr Text m Char -> TextParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT CustomErr Text m Char -> TextParser m ())
-> ParsecT CustomErr Text m Char -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe StorageFormat
forall a. Maybe a
Nothing (\c :: Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\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 :: TextParser m ()
skiplinecommentp = do
(Token Text -> Bool) -> ParsecT CustomErr Text m Char
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Token Text -> Bool) -> ParsecT CustomErr Text m Char)
-> (Token Text -> Bool) -> ParsecT CustomErr Text m Char
forall a b. (a -> b) -> a -> b
$ \c :: Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ';' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '#' Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '*'
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 StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe StorageFormat
forall a. Maybe a
Nothing (\c :: Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\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 #-}
followingcommentp' :: (Monoid a, Show a) => TextParser m a -> TextParser m (Text, a)
contentp :: 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) = [("",a
forall a. Monoid a => a
mempty)]
| Bool
otherwise = [(Text, a)]
sameLine
(texts :: [Text]
texts, contents :: [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 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, ()) -> TextParser 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' (TextParser m Text -> TextParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (TextParser m Text -> TextParser m ())
-> TextParser m Text -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ Maybe StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe StorageFormat
forall a. Maybe a
Nothing (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\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)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([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)
(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 StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe StorageFormat
forall a. Maybe a
Nothing (\c :: Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ':' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\n')
Text -> TextParser m [Tag]
forall (m :: * -> *). Text -> TextParser m [Tag]
atColon Text
tagName TextParser m [Tag] -> TextParser m [Tag] -> TextParser m [Tag]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Tag] -> TextParser m [Tag]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
where
atColon :: Text -> TextParser m [Tag]
atColon :: Text -> TextParser m [Tag]
atColon name :: 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 Token Text
':' ParsecT CustomErr Text m Char
-> TextParser m [Tag] -> TextParser m [Tag]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
if Text -> Bool
T.null Text
name
then TextParser m [Tag]
forall (m :: * -> *). TextParser m [Tag]
commenttagsp
else do
ParsecT 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]) -> TextParser m [Tag] -> TextParser m [Tag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextParser m [Tag]
forall (m :: * -> *). TextParser m [Tag]
commenttagsp
tagValue :: TextParser m Text
tagValue :: TextParser m Text
tagValue = do
Text
val <- Text -> Text
T.strip (Text -> Text) -> TextParser m Text -> TextParser m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe StorageFormat
forall a. Maybe a
Nothing (\c :: Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ',' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\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 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)
mYear :: Maybe Integer
mYear = do
(commentText :: Text
commentText, (tags :: [Tag]
tags, dateTags :: [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) -> Maybe DateTag -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DateTag -> Day
forall a b. (a, b) -> b
snd (Maybe DateTag -> Maybe Day) -> Maybe DateTag -> Maybe Day
forall a b. (a -> b) -> a -> 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
=="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) -> Maybe DateTag -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DateTag -> Day
forall a b. (a, b) -> b
snd (Maybe DateTag -> Maybe Day) -> Maybe DateTag -> Maybe Day
forall a b. (a -> b) -> a -> 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
=="date2")(Text -> Bool) -> (DateTag -> Text) -> DateTag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DateTag -> Text
forall a b. (a, b) -> a
fst) [DateTag]
dateTags
(Text, [Tag], Maybe Day, Maybe Day)
-> TextParser m (Text, [Tag], Maybe Day, Maybe Day)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
commentText, [Tag]
tags, Maybe Day
mdate, Maybe Day
mdate2)
{-# INLINABLE postingcommentp #-}
commenttagsanddatesp
:: Maybe Year -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp :: Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp mYear :: Maybe Integer
mYear = do
(txt :: Text
txt, dateTags :: [DateTag]
dateTags) <- ParsecT CustomErr Text m [DateTag]
-> ParsecT CustomErr Text m (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 (Text, [DateTag]))
-> ParsecT CustomErr Text m [DateTag]
-> ParsecT CustomErr Text m (Text, [DateTag])
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT CustomErr Text m [DateTag]
forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo ':'
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 :: Char -> TextParser m [DateTag]
readUpTo end :: 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 StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe StorageFormat
forall a. Maybe a
Nothing (\c :: 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
/= '\n' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '[')
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 :: TextParser m [DateTag] -> TextParser m [DateTag]
atBracket cont :: 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 Token Text
'['
[DateTag]
dateTags' <- TextParser m [DateTag]
cont
[DateTag] -> TextParser m [DateTag]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DateTag] -> TextParser m [DateTag])
-> [DateTag] -> TextParser m [DateTag]
forall a b. (a -> b) -> a -> b
$ [DateTag]
dateTags [DateTag] -> [DateTag] -> [DateTag]
forall a. [a] -> [a] -> [a]
++ [DateTag]
dateTags'
atColon :: Text -> TextParser m ([Tag], [DateTag])
atColon :: Text -> TextParser m ([Tag], [DateTag])
atColon name :: 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 Token Text
':' ParsecT CustomErr Text m Char
-> TextParser m ([Tag], [DateTag])
-> TextParser 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
(tags :: [Tag]
tags, dateTags :: [DateTag]
dateTags) <- case Text
name of
"" -> ([Tag], [DateTag]) -> TextParser m ([Tag], [DateTag])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
"date" -> Text -> TextParser m ([Tag], [DateTag])
forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name
"date2" -> Text -> TextParser m ([Tag], [DateTag])
forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name
_ -> Text -> TextParser 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 Token Text
','
([Tag] -> [Tag])
-> ([DateTag] -> [DateTag])
-> ([Tag], [DateTag])
-> ([Tag], [DateTag])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([Tag]
tags[Tag] -> [Tag] -> [Tag]
forall a. [a] -> [a] -> [a]
++) ([DateTag]
dateTags[DateTag] -> [DateTag] -> [DateTag]
forall a. [a] -> [a] -> [a]
++) (([Tag], [DateTag]) -> ([Tag], [DateTag]))
-> TextParser m ([Tag], [DateTag])
-> TextParser m ([Tag], [DateTag])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer -> TextParser m ([Tag], [DateTag])
forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear
dateValue :: Text -> TextParser m ([Tag], [DateTag])
dateValue :: Text -> TextParser m ([Tag], [DateTag])
dateValue name :: Text
name = do
(txt :: Text
txt, (date :: Day
date, dateTags :: [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 ','
(Day, [DateTag]) -> TextParser m (Day, [DateTag])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day
date, [DateTag]
dateTags)
let val :: Text
val = Text -> Text
T.strip Text
txt
([Tag], [DateTag]) -> TextParser m ([Tag], [DateTag])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Tag], [DateTag]) -> TextParser m ([Tag], [DateTag]))
-> ([Tag], [DateTag]) -> TextParser m ([Tag], [DateTag])
forall a b. (a -> b) -> a -> b
$ ( [(Text
name, Text
val)]
, (Text
name, Day
date) DateTag -> [DateTag] -> [DateTag]
forall a. a -> [a] -> [a]
: [DateTag]
dateTags )
tagValue :: Text -> TextParser m ([Tag], [DateTag])
tagValue :: Text -> TextParser m ([Tag], [DateTag])
tagValue name :: Text
name = do
(txt :: Text
txt, dateTags :: [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 ','
let val :: Text
val = Text -> Text
T.strip Text
txt
([Tag], [DateTag]) -> TextParser m ([Tag], [DateTag])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Tag], [DateTag]) -> TextParser m ([Tag], [DateTag]))
-> ([Tag], [DateTag]) -> TextParser m ([Tag], [DateTag])
forall a b. (a -> b) -> a -> b
$ ( [(Text
name, Text
val)]
, [DateTag]
dateTags )
{-# INLINABLE commenttagsanddatesp #-}
bracketeddatetagsp
:: Maybe Year -> TextParser m [(TagName, Day)]
bracketeddatetagsp :: Maybe Integer -> TextParser m [DateTag]
bracketeddatetagsp mYear1 :: 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 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 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 StorageFormat
-> (Token Text -> Bool) -> ParsecT CustomErr Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe StorageFormat -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe StorageFormat
forall a. Maybe a
Nothing 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
$
StorageFormat -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadFail m => StorageFormat -> m a
Fail.fail "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 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 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 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 [("date",) (Day -> DateTag) -> Maybe Day -> Maybe DateTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
md1, ("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 c :: 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
== '='
{-# INLINABLE bracketeddatetagsp #-}
tests_Common :: TestTree
tests_Common = StorageFormat -> [TestTree] -> TestTree
tests "Common" [
StorageFormat -> [TestTree] -> TestTree
tests "amountp" [
StorageFormat -> Assertion -> TestTree
test "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 "$47.18" (Decimal -> Amount
usd 47.18)
,StorageFormat -> Assertion -> TestTree
test "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 "$1." (Decimal -> Amount
usd 1 Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision 0)
,StorageFormat -> Assertion -> TestTree
test "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 "$10 @ €0.5"
Amount
amount{
acommodity :: Text
acommodity="$"
,aquantity :: Decimal
aquantity=10
,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision 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="€"
,aquantity :: Decimal
aquantity=0.5
,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision 1, asdecimalpoint :: Maybe Char
asdecimalpoint=Char -> Maybe Char
forall a. a -> Maybe a
Just '.'}
}
}
,StorageFormat -> Assertion -> TestTree
test "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 "$10 @@ €5"
Amount
amount{
acommodity :: Text
acommodity="$"
,aquantity :: Decimal
aquantity=10
,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision 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="€"
,aquantity :: Decimal
aquantity=5
,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision 0, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
forall a. Maybe a
Nothing}
}
}
,StorageFormat -> Assertion -> TestTree
test "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 "$10 (@) €0.5"
,StorageFormat -> Assertion -> TestTree
test "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 "$10 (@@) €0.5"
]
,let p :: JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p = ParsecT
CustomErr
Text
IO
(Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> JournalParser
IO (Decimal, 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
(Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
Maybe AmountStyle
-> TextParser m (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp Maybe AmountStyle
forall a. Maybe a
Nothing) :: JournalParser IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) in
StorageFormat -> Assertion -> TestTree
test "numberp" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "0" (0, 0, Maybe Char
forall a. Maybe a
Nothing, Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1" (1, 0, Maybe Char
forall a. Maybe a
Nothing, Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1.1" (1.1, 1, Char -> Maybe Char
forall a. a -> Maybe a
Just '.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1,000.1" (1000.1, 1, Char -> Maybe Char
forall a. a -> Maybe a
Just '.', 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 ',' [3])
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1.00.000,1" (100000.1, 1, Char -> Maybe Char
forall a. a -> Maybe a
Just ',', 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 '.' [3,2])
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1,000,000" (1000000, 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 ',' [3,3])
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1." (1, 0, Char -> Maybe Char
forall a. a -> Maybe a
Just '.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1," (1, 0, Char -> Maybe Char
forall a. a -> Maybe a
Just ',', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p ".1" (0.1, 1, Char -> Maybe Char
forall a. a -> Maybe a
Just '.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p ",1" (0.1, 1, Char -> Maybe Char
forall a. a -> Maybe a
Just ',', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "" ""
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1,000.000,1" ""
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1.000,000.1" ""
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1,000.000.1" ""
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1,,1" ""
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1..1" ""
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p ".1," ""
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p ",1." ""
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, 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 (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" (1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555, 255, Char -> Maybe Char
forall a. a -> Maybe a
Just '.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser
IO (Decimal, Word8, Maybe Char, Maybe DigitGroupStyle)
p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" ""
,StorageFormat -> [TestTree] -> TestTree
tests "spaceandamountormissingp" [
StorageFormat -> Assertion -> TestTree
test "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 " $47.18" ([Amount] -> MixedAmount
Mixed [Decimal -> Amount
usd 47.18])
,StorageFormat -> Assertion -> TestTree
test "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 "" MixedAmount
missingmixedamt
]
]