{-# LANGUAGE CPP, BangPatterns, DeriveDataTypeable, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PackageImports #-}
module Hledger.Read.Common (
Reader (..),
InputOpts (..),
definputopts,
rawOptsToInputOpts,
runTextParser,
rtp,
runJournalParser,
rjp,
runErroringJournalParser,
rejp,
genericSourcePos,
journalSourcePos,
parseAndFinaliseJournal,
parseAndFinaliseJournal',
finaliseJournal,
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,
fixedlotpricep,
numberp,
fromRawNumber,
rawnumberp,
multilinecommentp,
emptyorcommentlinep,
followingcommentp,
transactioncommentp,
postingcommentp,
bracketeddatetagsp,
singlespacedtextp,
singlespacedtextsatisfyingp,
singlespacep,
tests_Common,
)
where
import Prelude ()
import "base-compat-batteries" Prelude.Compat hiding (fail, readFile)
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
import Data.Data
import Data.Decimal (DecimalRaw (Decimal), Decimal)
import Data.Default
import Data.Functor.Identity
import "base-compat-batteries" Data.List.Compat
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe
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
import Data.Time.LocalTime
import System.Time (getClockTime)
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer (decimal)
import Text.Megaparsec.Custom
import Hledger.Data
import Hledger.Utils
data Reader = Reader {
Reader -> StorageFormat
rFormat :: StorageFormat
,Reader -> [StorageFormat]
rExtensions :: [String]
,Reader
-> InputOpts
-> StorageFormat
-> Text
-> ExceptT StorageFormat IO Journal
rParser :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
,Reader -> Bool
rExperimental :: Bool
}
instance Show Reader where show :: Reader -> StorageFormat
show r :: Reader
r = Reader -> StorageFormat
rFormat Reader
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 -> Char
separator_ :: Char
,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, Typeable InputOpts
Constr
DataType
Typeable InputOpts =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputOpts -> c InputOpts)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputOpts)
-> (InputOpts -> Constr)
-> (InputOpts -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputOpts))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InputOpts))
-> ((forall b. Data b => b -> b) -> InputOpts -> InputOpts)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputOpts -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputOpts -> r)
-> (forall u. (forall d. Data d => d -> u) -> InputOpts -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> InputOpts -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InputOpts -> m InputOpts)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputOpts -> m InputOpts)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputOpts -> m InputOpts)
-> Data InputOpts
InputOpts -> Constr
InputOpts -> DataType
(forall b. Data b => b -> b) -> InputOpts -> InputOpts
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputOpts -> c InputOpts
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputOpts
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> InputOpts -> u
forall u. (forall d. Data d => d -> u) -> InputOpts -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputOpts -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputOpts -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InputOpts -> m InputOpts
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputOpts -> m InputOpts
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputOpts
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputOpts -> c InputOpts
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputOpts)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InputOpts)
$cInputOpts :: Constr
$tInputOpts :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> InputOpts -> m InputOpts
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputOpts -> m InputOpts
gmapMp :: (forall d. Data d => d -> m d) -> InputOpts -> m InputOpts
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InputOpts -> m InputOpts
gmapM :: (forall d. Data d => d -> m d) -> InputOpts -> m InputOpts
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InputOpts -> m InputOpts
gmapQi :: Int -> (forall d. Data d => d -> u) -> InputOpts -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InputOpts -> u
gmapQ :: (forall d. Data d => d -> u) -> InputOpts -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InputOpts -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputOpts -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InputOpts -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputOpts -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InputOpts -> r
gmapT :: (forall b. Data b => b -> b) -> InputOpts -> InputOpts
$cgmapT :: (forall b. Data b => b -> b) -> InputOpts -> InputOpts
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InputOpts)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InputOpts)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c InputOpts)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InputOpts)
dataTypeOf :: InputOpts -> DataType
$cdataTypeOf :: InputOpts -> DataType
toConstr :: InputOpts -> Constr
$ctoConstr :: InputOpts -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputOpts
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InputOpts
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputOpts -> c InputOpts
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InputOpts -> c InputOpts
$cp1Data :: Typeable InputOpts
Data)
instance Default InputOpts where def :: InputOpts
def = InputOpts
definputopts
definputopts :: InputOpts
definputopts :: InputOpts
definputopts = Maybe StorageFormat
-> Maybe StorageFormat
-> Char
-> [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
-> Char
-> [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
,separator_ :: Char
separator_ = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe ',' (StorageFormat -> RawOpts -> Maybe Char
maybecharopt "separator" 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
forall a. Monoid a => a
mempty) "" 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
forall a. Monoid a => a
mempty) "" 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) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Pos -> Int) -> Pos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
p) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Pos -> Int) -> Pos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Pos -> Int) -> Pos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
unPos (Pos -> Int) -> Pos -> Int
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
p, Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ 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
finaliseJournal 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
finaliseJournal InputOpts
iopts StorageFormat
f Text
txt Journal
pj
finaliseJournal :: InputOpts -> FilePath -> Text -> Journal -> ExceptT String IO Journal
finaliseJournal :: InputOpts
-> StorageFormat
-> Text
-> Journal
-> ExceptT StorageFormat IO Journal
finaliseJournal 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
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' ->
let fj :: Either StorageFormat Journal
fj =
if InputOpts -> Bool
auto_ InputOpts
iopts Bool -> Bool -> Bool
&& (Bool -> Bool
not (Bool -> Bool) -> (Journal -> Bool) -> Journal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TransactionModifier] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TransactionModifier] -> Bool)
-> (Journal -> [TransactionModifier]) -> Journal -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [TransactionModifier]
jtxnmodifiers) Journal
pj
then
(
(Journal -> Journal
journalModifyTransactions (Journal -> Journal)
-> Either StorageFormat Journal -> Either StorageFormat Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Either StorageFormat Journal -> Either StorageFormat Journal)
-> Either StorageFormat Journal -> Either StorageFormat Journal
forall a b. (a -> b) -> a -> b
$
Bool -> Journal -> Either StorageFormat Journal
journalBalanceTransactions Bool
False (Journal -> Either StorageFormat Journal)
-> Journal -> Either StorageFormat Journal
forall a b. (a -> b) -> a -> b
$
Journal -> Journal
journalReverse (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
ClockTime -> Journal -> Journal
journalSetLastReadTime ClockTime
t (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
(StorageFormat, Text) -> Journal -> Journal
journalAddFile (StorageFormat
f, Text
txt) (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
Journal
pj')
Either StorageFormat Journal
-> (Journal -> Either StorageFormat Journal)
-> Either StorageFormat Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\j :: 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 -> Either StorageFormat Journal)
-> Journal -> Either StorageFormat Journal
forall a b. (a -> b) -> a -> b
$
Journal
j)
else
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 -> Either StorageFormat Journal)
-> Journal -> Either StorageFormat Journal
forall a b. (a -> b) -> a -> b
$
Journal -> Journal
journalReverse (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
ClockTime -> Journal -> Journal
journalSetLastReadTime ClockTime
t (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
(StorageFormat, Text) -> Journal -> Journal
journalAddFile (StorageFormat
f, Text
txt) (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$
Journal
pj'
in
case Either StorageFormat Journal
fj of
Left e :: StorageFormat
e -> StorageFormat -> ExceptT StorageFormat IO Journal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError StorageFormat
e
Right j :: Journal
j -> Journal -> ExceptT StorageFormat IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j
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{..}) -> 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]}
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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
Integer
d1 <- ParsecT CustomErr Text m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT CustomErr Text m Integer
-> StorageFormat -> ParsecT CustomErr Text m Integer
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "year or month"
Char
sep <- (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
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"
Int -> Integer -> Char -> Int -> TextParser m Day
forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
d1 Char
sep Int
d2 TextParser m Day -> TextParser m Day -> TextParser m Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Integer -> Integer -> Char -> Int -> TextParser m Day
forall (m :: * -> *).
Int -> Maybe Integer -> Integer -> Char -> Int -> TextParser m Day
partialDate Int
startOffset Maybe Integer
mYear Integer
d1 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 -> Integer -> Char -> Int -> 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 -> Integer -> Char -> Int -> TextParser m Day
partialDate :: Int -> Maybe Integer -> Integer -> Char -> Int -> TextParser m Day
partialDate startOffset :: Int
startOffset mYear :: Maybe Integer
mYear month :: Integer
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 (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
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]
++ Integer -> StorageFormat
forall a. Show a => a -> StorageFormat
show Integer
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 = Integer -> StorageFormat
forall a. Show a => a -> StorageFormat
show Integer
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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
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
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
$!
[AccountAlias] -> Text -> Text
accountNameApplyAliases [AccountAlias]
aliases (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Text
joinAccountNames Text
parent
Text
a
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 <- ParsecT CustomErr Text m (Tokens Text)
TextParser m 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
*> ParsecT CustomErr Text m (Tokens Text)
TextParser m 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 -> TextParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline TextParser m () -> 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
[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
Amount
amount <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountwithoutpricep
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
Maybe AmountPrice
mprice <- JournalParser m (Maybe AmountPrice)
forall (m :: * -> *). JournalParser m (Maybe AmountPrice)
priceamountp
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
-> StateT Journal (ParsecT CustomErr Text m) Bool)
-> ParsecT CustomErr Text m Bool
-> StateT Journal (ParsecT CustomErr Text m) Bool
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text m Char -> ParsecT CustomErr Text m Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m Bool
skipMany' ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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 Int
mExponent <- ParsecT CustomErr Text m (Maybe Int)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Maybe Int)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Int))
-> ParsecT CustomErr Text m (Maybe Int)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Int)
forall a b. (a -> b) -> a -> b
$ 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
try ParsecT CustomErr Text m Int
forall (m :: * -> *). TextParser m Int
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 :: Int
prec,mdec :: Maybe Char
mdec,mgrps :: Maybe DigitGroupStyle
mgrps) <- ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, Int, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Int
-> ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Int
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
suggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Int
mExponent
let s :: AmountStyle
s = AmountStyle
amountstyle{ascommodityside :: Side
ascommodityside=Side
L, ascommodityspaced :: Bool
ascommodityspaced=Bool
commodityspaced, asprecision :: Int
asprecision=Int
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 Int
mExponent <- ParsecT CustomErr Text m (Maybe Int)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT CustomErr Text m (Maybe Int)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Int))
-> ParsecT CustomErr Text m (Maybe Int)
-> StateT Journal (ParsecT CustomErr Text m) (Maybe Int)
forall a b. (a -> b) -> a -> b
$ 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
try ParsecT CustomErr Text m Int
forall (m :: * -> *). TextParser m Int
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 Char -> ParsecT CustomErr Text m Bool
forall (m :: * -> *) a. MonadPlus m => m a -> m Bool
skipMany' ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline 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 :: Int
prec,mdec :: Maybe Char
mdec,mgrps :: Maybe DigitGroupStyle
mgrps) <- ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, Int, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Int
-> ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Int
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
suggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Int
mExponent
let s :: AmountStyle
s = AmountStyle
amountstyle{ascommodityside :: Side
ascommodityside=Side
R, ascommodityspaced :: Bool
ascommodityspaced=Bool
commodityspaced, asprecision :: Int
asprecision=Int
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 :: Int
prec,mdec :: Maybe Char
mdec,mgrps :: Maybe DigitGroupStyle
mgrps) <- ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, Int, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StateT
Journal
(ParsecT CustomErr Text m)
(Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Int
-> ParsecT
CustomErr Text m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Int
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
suggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Int
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 :: Int
asprecision=Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (AmountStyle -> Int
asprecision AmountStyle
defs) Int
prec})
_ -> ("", AmountStyle
amountstyle{asprecision :: Int
asprecision=Int
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 Int
-> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
interpretNumber :: (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Int
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
interpretNumber posRegion :: (Int, Int)
posRegion suggestedStyle :: Maybe AmountStyle
suggestedStyle ambiguousNum :: Either AmbiguousNumber RawNumber
ambiguousNum mExp :: Maybe Int
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 Int
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Int
mExp of
Left errMsg :: StorageFormat
errMsg -> CustomErr
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomErr
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle))
-> CustomErr
-> TextParser m (Decimal, Int, 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 res :: (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
res -> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
res
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
forall a. Monoid a => a
mempty) "" (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)
-> 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
skipMany' :: MonadPlus m => m a -> m Bool
skipMany' :: m a -> m Bool
skipMany' p :: m a
p = Bool -> m Bool
go Bool
False
where
go :: Bool -> m Bool
go !Bool
isNull = do
Bool
more <- Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m a -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m a
p)
if Bool
more
then Bool -> m Bool
go Bool
True
else Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
isNull
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 (Maybe AmountPrice)
priceamountp :: JournalParser m (Maybe AmountPrice)
priceamountp = Maybe AmountPrice
-> JournalParser m (Maybe AmountPrice)
-> JournalParser m (Maybe AmountPrice)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Maybe AmountPrice
forall a. Maybe a
Nothing (JournalParser m (Maybe AmountPrice)
-> JournalParser m (Maybe AmountPrice))
-> JournalParser m (Maybe AmountPrice)
-> JournalParser m (Maybe AmountPrice)
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
'@'
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
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
Amount
priceAmount <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountwithoutpricep JournalParser m Amount -> StorageFormat -> JournalParser m Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "unpriced amount (specifying a price)"
Maybe AmountPrice -> JournalParser m (Maybe AmountPrice)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AmountPrice -> JournalParser m (Maybe AmountPrice))
-> Maybe AmountPrice -> JournalParser m (Maybe AmountPrice)
forall a b. (a -> b) -> a -> b
$ AmountPrice -> Maybe AmountPrice
forall a. a -> Maybe a
Just (AmountPrice -> Maybe AmountPrice)
-> AmountPrice -> Maybe 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
Amount
a <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountp 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
}
fixedlotpricep :: JournalParser m (Maybe Amount)
fixedlotpricep :: JournalParser m (Maybe Amount)
fixedlotpricep = StateT Journal (ParsecT CustomErr Text m) Amount
-> JournalParser m (Maybe Amount)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT CustomErr Text m) Amount
-> JournalParser m (Maybe Amount))
-> StateT Journal (ParsecT CustomErr Text m) Amount
-> JournalParser m (Maybe Amount)
forall a b. (a -> b) -> a -> b
$ do
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
$ 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
Amount
a <- StateT Journal (ParsecT CustomErr Text m) Amount
forall (m :: * -> *). JournalParser m Amount
amountwithoutpricep StateT Journal (ParsecT CustomErr Text m) Amount
-> StorageFormat
-> StateT Journal (ParsecT CustomErr Text m) Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "unpriced amount (for an ignored ledger-style fixed lot price)"
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline)
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 -> StateT Journal (ParsecT CustomErr Text m) Amount
forall (m :: * -> *) a. Monad m => a -> m a
return Amount
a
numberp :: Maybe AmountStyle -> TextParser m (Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
numberp :: Maybe AmountStyle
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
numberp suggestedStyle :: Maybe AmountStyle
suggestedStyle = StorageFormat
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
StorageFormat -> m a -> m a
label "number" (TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle))
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> TextParser m (Decimal, Int, 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 Int
mExp <- 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
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
$ ParsecT CustomErr Text m Int
forall (m :: * -> *). TextParser m Int
exponentp
StorageFormat -> Maybe AmountStyle -> Maybe AmountStyle
forall a. Show a => StorageFormat -> a -> a
dbg8 "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, Int, Maybe Char, Maybe DigitGroupStyle)
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall a. Show a => StorageFormat -> a -> a
dbg8 "numberp quantity,precision,mdecimalpoint,mgrps"
(Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle))
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ RawNumber
-> Maybe Int
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Int
mExp of
Left errMsg :: StorageFormat
errMsg -> StorageFormat
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *) a. MonadFail m => StorageFormat -> m a
Fail.fail StorageFormat
errMsg
Right (q :: Decimal
q, p :: Int
p, d :: Maybe Char
d, g :: Maybe DigitGroupStyle
g) -> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decimal -> Decimal
sign Decimal
q, Int
p, Maybe Char
d, Maybe DigitGroupStyle
g)
exponentp :: TextParser m Int
exponentp :: TextParser m Int
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 (Int -> Int)
-> ParsecT CustomErr Text m (Int -> Int)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT CustomErr Text m (Int -> Int)
forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp ParsecT CustomErr Text m (Int -> Int)
-> TextParser m Int -> TextParser m Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TextParser m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal TextParser m Int -> StorageFormat -> TextParser m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> StorageFormat -> m a
<?> "exponent"
fromRawNumber
:: RawNumber
-> Maybe Int
-> Either String
(Quantity, Int, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber :: RawNumber
-> Maybe Int
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber raw :: RawNumber
raw mExp :: Maybe Int
mExp = case RawNumber
raw of
NoSeparators digitGrp :: DigitGrp
digitGrp mDecimals :: Maybe (Char, DigitGrp)
mDecimals ->
let mDecPt :: Maybe Char
mDecPt = ((Char, DigitGrp) -> Char) -> Maybe (Char, DigitGrp) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, DigitGrp) -> Char
forall a b. (a, b) -> a
fst Maybe (Char, DigitGrp)
mDecimals
decimalGrp :: DigitGrp
decimalGrp = 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
(quantity :: Decimal
quantity, precision :: Int
precision) =
((Decimal, Int) -> (Decimal, Int))
-> (Int -> (Decimal, Int) -> (Decimal, Int))
-> Maybe Int
-> (Decimal, Int)
-> (Decimal, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Decimal, Int) -> (Decimal, Int)
forall a. a -> a
id Int -> (Decimal, Int) -> (Decimal, Int)
applyExp Maybe Int
mExp ((Decimal, Int) -> (Decimal, Int))
-> (Decimal, Int) -> (Decimal, Int)
forall a b. (a -> b) -> a -> b
$ DigitGrp -> DigitGrp -> (Decimal, Int)
toQuantity DigitGrp
digitGrp DigitGrp
decimalGrp
in (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall a b. b -> Either a b
Right (Decimal
quantity, Int
precision, Maybe Char
mDecPt, Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
WithSeparators digitSep :: Char
digitSep digitGrps :: [DigitGrp]
digitGrps mDecimals :: Maybe (Char, DigitGrp)
mDecimals -> case Maybe Int
mExp of
Nothing ->
let mDecPt :: Maybe Char
mDecPt = ((Char, DigitGrp) -> Char) -> Maybe (Char, DigitGrp) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, DigitGrp) -> Char
forall a b. (a, b) -> a
fst Maybe (Char, DigitGrp)
mDecimals
decimalGrp :: DigitGrp
decimalGrp = 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
digitGroupStyle :: DigitGroupStyle
digitGroupStyle = Char -> [Int] -> DigitGroupStyle
DigitGroups Char
digitSep ([DigitGrp] -> [Int]
groupSizes [DigitGrp]
digitGrps)
(quantity :: Decimal
quantity, precision :: Int
precision) = DigitGrp -> DigitGrp -> (Decimal, Int)
toQuantity ([DigitGrp] -> DigitGrp
forall a. Monoid a => [a] -> a
mconcat [DigitGrp]
digitGrps) DigitGrp
decimalGrp
in (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall a b. b -> Either a b
Right (Decimal
quantity, Int
precision, Maybe Char
mDecPt, DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just DigitGroupStyle
digitGroupStyle)
Just _ -> StorageFormat
-> Either
StorageFormat (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
forall a b. a -> Either a b
Left
"invalid number: mixing digit separators with exponents is not allowed"
where
groupSizes :: [DigitGrp] -> [Int]
groupSizes :: [DigitGrp] -> [Int]
groupSizes digitGrps :: [DigitGrp]
digitGrps = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ case (DigitGrp -> Int) -> [DigitGrp] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map DigitGrp -> Int
digitGroupLength [DigitGrp]
digitGrps of
(a :: Int
a:b :: Int
b:cs :: [Int]
cs) | Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
b -> Int
bInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
cs
gs :: [Int]
gs -> [Int]
gs
toQuantity :: DigitGrp -> DigitGrp -> (Quantity, Int)
toQuantity :: DigitGrp -> DigitGrp -> (Decimal, Int)
toQuantity preDecimalGrp :: DigitGrp
preDecimalGrp postDecimalGrp :: DigitGrp
postDecimalGrp = (Decimal
quantity, Int
precision)
where
quantity :: Decimal
quantity = Word8 -> Integer -> Decimal
forall i. Word8 -> i -> DecimalRaw i
Decimal (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
precision)
(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 :: Int
precision = DigitGrp -> Int
digitGroupLength DigitGrp
postDecimalGrp
applyExp :: Int -> (Decimal, Int) -> (Decimal, Int)
applyExp :: Int -> (Decimal, Int) -> (Decimal, Int)
applyExp exponent :: Int
exponent (quantity :: Decimal
quantity, precision :: Int
precision) =
(Decimal
quantity Decimal -> Decimal -> Decimal
forall a. Num a => a -> a -> a
* 10Decimal -> Int -> Decimal
forall a b. (Fractional a, Integral b) => a -> b -> a
^^Int
exponent, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int
precision Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
exponent))
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 -> Int
asprecision = Int
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
dbg8 "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 -> Int
digitGroupLength :: !Int,
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 :: Int
len num :: Integer
num)
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = "\"" 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]
++ "\""
| Bool
otherwise = "\"\""
where numStr :: StorageFormat
numStr = Integer -> StorageFormat
forall a. Show a => a -> StorageFormat
show Integer
num
padding :: StorageFormat
padding = Int -> Char -> StorageFormat
forall a. Int -> a -> [a]
replicate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- StorageFormat -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length StorageFormat
numStr) '0'
instance Sem.Semigroup DigitGrp where
DigitGrp l1 :: Int
l1 n1 :: Integer
n1 <> :: DigitGrp -> DigitGrp -> DigitGrp
<> DigitGrp l2 :: Int
l2 n2 :: Integer
n2 = Int -> Integer -> DigitGrp
DigitGrp (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2) (Integer
n1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
l2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n2)
instance Monoid DigitGrp where
mempty :: DigitGrp
mempty = Int -> 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 = (Int -> Integer -> DigitGrp) -> (Int, Integer) -> DigitGrp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Integer -> DigitGrp
DigitGrp ((Int, Integer) -> DigitGrp)
-> (Text -> (Int, Integer)) -> Text -> DigitGrp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Integer) -> Char -> (Int, Integer))
-> (Int, Integer) -> StorageFormat -> (Int, Integer)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Integer) -> Char -> (Int, Integer)
forall a b. (Num a, Num b) => (a, b) -> Char -> (a, b)
step (0, 0) (StorageFormat -> (Int, Integer))
-> (Text -> StorageFormat) -> Text -> (Int, 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline 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
ParsecT CustomErr Text m Char -> TextParser m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
[(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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
{-# 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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
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 Char -> ParsecT CustomErr Text m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany ParsecT CustomErr Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT CustomErr s m Char
spacenonewline
(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 #-}
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)
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, Monoid 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, Monoid 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 -> Int -> Amount
`withPrecision` 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, Monoid 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 :: Int
asprecision=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 :: Int
asprecision=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, Monoid 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 :: Int
asprecision=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 :: Int
asprecision=0, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
forall a. Maybe a
Nothing}
}
}
]
,let p :: JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
p = ParsecT
CustomErr Text IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> JournalParser
IO (Decimal, Int, 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, Int, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
Maybe AmountStyle
-> TextParser m (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
numberp Maybe AmountStyle
forall a. Maybe a
Nothing) :: JournalParser IO (Quantity, Int, 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, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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 -> [Int] -> DigitGroupStyle
DigitGroups ',' [3])
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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 -> [Int] -> DigitGroupStyle
DigitGroups '.' [3,2])
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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 -> [Int] -> DigitGroupStyle
DigitGroups ',' [3,3])
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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, Int, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq JournalParser IO (Decimal, Int, 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, Int, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
p "" ""
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
p "1,000.000,1" ""
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
p "1.000,000.1" ""
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
p "1,000.000.1" ""
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
p "1,,1" ""
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
p "1..1" ""
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
p ".1," ""
JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
-> StorageFormat -> StorageFormat -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Monoid st) =>
StateT st (ParsecT CustomErr Text IO) a
-> StorageFormat -> StorageFormat -> Assertion
assertParseError JournalParser IO (Decimal, Int, Maybe Char, Maybe DigitGroupStyle)
p ",1." ""
,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, Monoid 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, Monoid 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
]
]