--- * -*- outline-regexp:"--- \\*"; -*-
--- ** doc
-- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections.
{-|

File reading/parsing utilities used by multiple readers, and a good
amount of the parsers for journal format, to avoid import cycles
when JournalReader imports other readers.

Some of these might belong in Hledger.Read.JournalReader or Hledger.Read.

-}

--- ** language
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE NoMonoLocalBinds    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE Rank2Types          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeFamilies        #-}

--- ** exports
module Hledger.Read.Common (
  Reader (..),
  InputOpts(..),
  HasInputOpts(..),
  definputopts,
  rawOptsToInputOpts,

  -- * parsing utilities
  parseAndFinaliseJournal,
  initialiseAndParseJournal,
  journalFinalise,
  journalAddForecast,
  journalAddAutoPostings,
  setYear,
  getYear,
  setDefaultCommodityAndStyle,
  getDefaultCommodityAndStyle,
  getDefaultAmountStyle,
  getAmountStyle,
  addDeclaredAccountTags,
  addDeclaredAccountType,
  pushParentAccount,
  popParentAccount,
  getParentAccount,
  addAccountAlias,
  getAccountAliases,
  clearAccountAliases,
  journalAddFile,

  -- * parsers
  -- ** transaction bits
  statusp,
  codep,
  descriptionp,

  -- ** dates
  datep,
  datetimep,
  secondarydatep,

  -- ** account names
  modifiedaccountnamep,
  accountnamep,

  -- ** account aliases
  accountaliasp,

  -- ** amounts
  spaceandamountormissingp,
  amountp,
  amountpwithmultiplier,
  commoditysymbolp,
  priceamountp,
  balanceassertionp,
  lotpricep,
  numberp,
  fromRawNumber,
  rawnumberp,
  parseamount,
  parseamount',
  parsemixedamount,
  parsemixedamount',

  -- ** comments
  isLineCommentStart,
  isSameLineCommentStart,
  multilinecommentp,
  emptyorcommentlinep,
  followingcommentp,
  transactioncommentp,
  postingcommentp,

  -- ** bracketed dates
  bracketeddatetagsp,

  -- ** misc
  noncommenttextp,
  noncommenttext1p,
  singlespacedtext1p,
  singlespacednoncommenttext1p,
  singlespacedtextsatisfying1p,
  singlespacep,
  skipNonNewlineSpaces,
  skipNonNewlineSpaces1,
  aliasesFromOpts,

  -- * tests
  tests_Common,
)
where

--- ** imports
import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
import qualified Control.Monad.Fail as Fail (fail)
import Control.Monad.Except (ExceptT(..), liftEither, withExceptT)
import Control.Monad.State.Strict hiding (fail)
import Data.Bifunctor (bimap, second)
import Data.Char (digitToInt, isDigit, isSpace)
import Data.Decimal (DecimalRaw (Decimal), Decimal)
import Data.Either (lefts, rights)
import Data.Function ((&))
import Data.Functor ((<&>), ($>))
import Data.List (find, genericReplicate, union)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe)
import qualified Data.Map as M
import qualified Data.Semigroup as Sem
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorianValid, toGregorian)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Time.LocalTime (LocalTime(..), TimeOfDay(..))
import Data.Word (Word8)
import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, newline, string)
import Text.Megaparsec.Char.Lexer (decimal)
import Text.Megaparsec.Custom
  (FinalParseError, attachSource, finalErrorBundlePretty, parseErrorAt, parseErrorAtRegion)

import Hledger.Data
import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery)
import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToReportOpts)
import Hledger.Utils
import Hledger.Read.InputOptions
import System.FilePath (takeFileName)

--- ** doctest setup
-- $setup
-- >>> :set -XOverloadedStrings

--- ** types

-- main types; a few more below

-- | A hledger journal reader is a triple of storage format name, a
-- detector of that format, and a parser from that format to Journal.
-- The type variable m appears here so that rParserr can hold a
-- journal parser, which depends on it.
data Reader m = Reader {

     -- The canonical name of the format handled by this reader
     forall (m :: * -> *). Reader m -> [Char]
rFormat   :: StorageFormat

     -- The file extensions recognised as containing this format
    ,forall (m :: * -> *). Reader m -> [[Char]]
rExtensions :: [String]

     -- The entry point for reading this format, accepting input options, file
     -- path for error messages and file contents, producing an exception-raising IO
     -- action that produces a journal or error message.
    ,forall (m :: * -> *).
Reader m
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
rReadFn   :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal

     -- The actual megaparsec parser called by the above, in case
     -- another parser (includedirectivep) wants to use it directly.
    ,forall (m :: * -> *).
Reader m -> MonadIO m => ErroringJournalParser m Journal
rParser :: MonadIO m => ErroringJournalParser m ParsedJournal
    }

instance Show (Reader m) where show :: Reader m -> [Char]
show Reader m
r = forall (m :: * -> *). Reader m -> [Char]
rFormat Reader m
r forall a. [a] -> [a] -> [a]
++ [Char]
" reader"

-- | Parse an InputOpts from a RawOpts and a provided date.
-- This will fail with a usage error if the forecast period expression cannot be parsed.
rawOptsToInputOpts :: Day -> RawOpts -> InputOpts
rawOptsToInputOpts :: Day -> RawOpts -> InputOpts
rawOptsToInputOpts Day
day RawOpts
rawopts =

    let noinferprice :: Bool
noinferprice = [Char] -> RawOpts -> Bool
boolopt [Char]
"strict" RawOpts
rawopts Bool -> Bool -> Bool
|| [Char] -> RawOpts -> [Char]
stringopt [Char]
"args" RawOpts
rawopts forall a. Eq a => a -> a -> Bool
== [Char]
"balancednoautoconversion"

        -- Do we really need to do all this work just to get the requested end date? This is duplicating
        -- much of reportOptsToSpec.
        ropts :: ReportOpts
ropts = Day -> RawOpts -> ReportOpts
rawOptsToReportOpts Day
day RawOpts
rawopts
        argsquery :: [Query]
argsquery = forall a b. [Either a b] -> [a]
lefts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Day -> Text -> Either [Char] (Either Query QueryOpt)
parseQueryTerm Day
day) forall a b. (a -> b) -> a -> b
$ ReportOpts -> [Text]
querystring_ ReportOpts
ropts
        datequery :: Query
datequery = Query -> Query
simplifyQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDate forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Query] -> Query
And forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query
queryFromFlags ReportOpts
ropts forall a. a -> [a] -> [a]
: [Query]
argsquery

        styles :: Map Text AmountStyle
styles = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. [Char] -> a
err forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ RawOpts -> Either [Char] (Map Text AmountStyle)
commodityStyleFromRawOpts RawOpts
rawopts
          where err :: [Char] -> a
err [Char]
e = forall {a}. [Char] -> a
error' forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse commodity-style: '" forall a. [a] -> [a] -> [a]
++ [Char]
e forall a. [a] -> [a] -> [a]
++ [Char]
"'"  -- PARTIAL:

    in InputOpts
definputopts{
       -- files_             = listofstringopt "file" rawopts
       mformat_ :: Maybe [Char]
mformat_           = forall a. Maybe a
Nothing
      ,mrules_file_ :: Maybe [Char]
mrules_file_       = [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"rules-file" RawOpts
rawopts
      ,aliases_ :: [[Char]]
aliases_           = [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"alias" RawOpts
rawopts
      ,anon_ :: Bool
anon_              = [Char] -> RawOpts -> Bool
boolopt [Char]
"anon" RawOpts
rawopts
      ,new_ :: Bool
new_               = [Char] -> RawOpts -> Bool
boolopt [Char]
"new" RawOpts
rawopts
      ,new_save_ :: Bool
new_save_          = Bool
True
      ,pivot_ :: [Char]
pivot_             = [Char] -> RawOpts -> [Char]
stringopt [Char]
"pivot" RawOpts
rawopts
      ,forecast_ :: Maybe DateSpan
forecast_          = Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts Day
day RawOpts
rawopts
      ,reportspan_ :: DateSpan
reportspan_        = Maybe Day -> Maybe Day -> DateSpan
DateSpan (Bool -> Query -> Maybe Day
queryStartDate Bool
False Query
datequery) (Bool -> Query -> Maybe Day
queryEndDate Bool
False Query
datequery)
      ,auto_ :: Bool
auto_              = [Char] -> RawOpts -> Bool
boolopt [Char]
"auto" RawOpts
rawopts
      ,infer_equity_ :: Bool
infer_equity_      = [Char] -> RawOpts -> Bool
boolopt [Char]
"infer-equity" RawOpts
rawopts Bool -> Bool -> Bool
&& ReportOpts -> Maybe ConversionOp
conversionop_ ReportOpts
ropts forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just ConversionOp
ToCost
      ,infer_costs_ :: Bool
infer_costs_       = [Char] -> RawOpts -> Bool
boolopt [Char]
"infer-costs" RawOpts
rawopts
      ,balancingopts_ :: BalancingOpts
balancingopts_     = BalancingOpts
defbalancingopts{
                                 ignore_assertions_ :: Bool
ignore_assertions_ = [Char] -> RawOpts -> Bool
boolopt [Char]
"ignore-assertions" RawOpts
rawopts
                               , infer_transaction_prices_ :: Bool
infer_transaction_prices_ = Bool -> Bool
not Bool
noinferprice
                               , commodity_styles_ :: Maybe (Map Text AmountStyle)
commodity_styles_  = forall a. a -> Maybe a
Just Map Text AmountStyle
styles
                               }
      ,strict_ :: Bool
strict_            = [Char] -> RawOpts -> Bool
boolopt [Char]
"strict" RawOpts
rawopts
      ,_ioDay :: Day
_ioDay             = Day
day
      }

-- | Get the date span from --forecast's PERIODEXPR argument, if any.
-- This will fail with a usage error if the period expression cannot be parsed,
-- or if it contains a report interval.
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts Day
d RawOpts
rawopts = do
    [Char]
arg <- [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"forecast" RawOpts
rawopts
    let period :: Either HledgerParseErrors (Interval, DateSpan)
period = Day -> Text -> Either HledgerParseErrors (Interval, DateSpan)
parsePeriodExpr Day
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripquotes forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
arg
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
arg then DateSpan
nulldatespan else forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. HledgerParseErrors -> a
badParse (forall {b}. [Char] -> (Interval, b) -> b
getSpan [Char]
arg) Either HledgerParseErrors (Interval, DateSpan)
period
  where
    badParse :: HledgerParseErrors -> a
badParse HledgerParseErrors
e = forall {a}. [Char] -> a
usageError forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse forecast period : "forall a. [a] -> [a] -> [a]
++HledgerParseErrors -> [Char]
customErrorBundlePretty HledgerParseErrors
e
    getSpan :: [Char] -> (Interval, b) -> b
getSpan [Char]
arg (Interval
interval, b
requestedspan) = case Interval
interval of
        Interval
NoInterval -> b
requestedspan
        Interval
_          -> forall {a}. [Char] -> a
usageError forall a b. (a -> b) -> a -> b
$ [Char]
"--forecast's argument should not contain a report interval ("
                                 forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Interval
interval forall a. [a] -> [a] -> [a]
++ [Char]
" in \"" forall a. [a] -> [a] -> [a]
++ [Char]
arg forall a. [a] -> [a] -> [a]
++ [Char]
"\")"

-- | Given the name of the option and the raw options, returns either
-- | * a map of successfully parsed commodity styles, if all options where successfully parsed
-- | * the first option which failed to parse, if one or more options failed to parse
commodityStyleFromRawOpts :: RawOpts -> Either String (M.Map CommoditySymbol AmountStyle)
commodityStyleFromRawOpts :: RawOpts -> Either [Char] (Map Text AmountStyle)
commodityStyleFromRawOpts RawOpts
rawOpts =
    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Map Text AmountStyle
r -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
c,AmountStyle
a) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
c AmountStyle
a Map Text AmountStyle
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] (Text, AmountStyle)
parseCommodity) forall a. Monoid a => a
mempty [[Char]]
optList
  where
    optList :: [[Char]]
optList = [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"commodity-style" RawOpts
rawOpts
    parseCommodity :: [Char] -> Either [Char] (Text, AmountStyle)
parseCommodity [Char]
optStr = case [Char] -> Either HledgerParseErrors Amount
parseamount [Char]
optStr of
        Left HledgerParseErrors
_ -> forall a b. a -> Either a b
Left [Char]
optStr
        Right (Amount Text
acommodity Quantity
_ AmountStyle
astyle Maybe AmountPrice
_) -> forall a b. b -> Either a b
Right (Text
acommodity, AmountStyle
astyle)

-- | Given a parser to ParsedJournal, input options, file path and
-- content: run the parser on the content, and finalise the result to
-- get a Journal; or throw an error.
parseAndFinaliseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
                           -> FilePath -> Text -> ExceptT String IO Journal
parseAndFinaliseJournal :: ErroringJournalParser IO Journal
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
parseAndFinaliseJournal ErroringJournalParser IO Journal
parser InputOpts
iopts [Char]
f Text
txt =
    ErroringJournalParser IO Journal
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
initialiseAndParseJournal ErroringJournalParser IO Journal
parser InputOpts
iopts [Char]
f Text
txt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputOpts -> [Char] -> Text -> Journal -> ExceptT [Char] IO Journal
journalFinalise InputOpts
iopts [Char]
f Text
txt

-- | Given a parser to ParsedJournal, input options, file path and
-- content: run the parser on the content. This is all steps of
-- 'parseAndFinaliseJournal' without the finalisation step, and is used when
-- you need to perform other actions before finalisation, as in parsing
-- Timeclock and Timedot files.
initialiseAndParseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
                          -> FilePath -> Text -> ExceptT String IO Journal
initialiseAndParseJournal :: ErroringJournalParser IO Journal
-> InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
initialiseAndParseJournal ErroringJournalParser IO Journal
parser InputOpts
iopts [Char]
f Text
txt =
    forall a.
ExceptT FinalParseError IO (Either HledgerParseErrors a)
-> ExceptT [Char] IO a
prettyParseErrors forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ErroringJournalParser IO Journal
parser Journal
initJournal) [Char]
f Text
txt
  where
    y :: Integer
y = forall {a} {b} {c}. (a, b, c) -> a
first3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian forall a b. (a -> b) -> a -> b
$ InputOpts -> Day
_ioDay InputOpts
iopts
    initJournal :: Journal
initJournal = Journal
nulljournal{jparsedefaultyear :: Maybe Integer
jparsedefaultyear = forall a. a -> Maybe a
Just Integer
y, jincludefilestack :: [[Char]]
jincludefilestack = [[Char]
f]}
    -- Flatten parse errors and final parse errors, and output each as a pretty String.
    prettyParseErrors :: ExceptT FinalParseError IO (Either (ParseErrorBundle Text HledgerParseErrorData) a)
                      -> ExceptT String IO a
    prettyParseErrors :: forall a.
ExceptT FinalParseError IO (Either HledgerParseErrors a)
-> ExceptT [Char] IO a
prettyParseErrors = forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT HledgerParseErrors -> [Char]
customErrorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
                    forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (FinalParseErrorBundle' HledgerParseErrorData -> [Char]
finalErrorBundlePretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e.
[Char] -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
attachSource [Char]
f Text
txt)

{- HLINT ignore journalFinalise "Redundant <&>" -} -- silence this warning, the code is clearer as is
-- NB activates TH, may slow compilation ? https://github.com/ndmitchell/hlint/blob/master/README.md#customizing-the-hints
-- | Post-process a Journal that has just been parsed or generated, in this order:
--
-- - add misc info (file path, read time) 
--
-- - reverse transactions into their original parse order
--
-- - apply canonical commodity styles
--
-- - add tags from account directives to postings' tags
--
-- - add forecast transactions if enabled
--
-- - add tags from account directives to postings' tags (again to affect forecast transactions)
--
-- - add auto postings if enabled
--
-- - add tags from account directives to postings' tags (again to affect auto postings)
--
-- - evaluate balance assignments and balance each transaction
--
-- - check balance assertions if enabled
--
-- - infer equity postings in conversion transactions if enabled
--
-- - infer market prices from costs if enabled
--
-- - check all accounts have been declared if in strict mode
--
-- - check all commodities have been declared if in strict mode
--
journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal
journalFinalise :: InputOpts -> [Char] -> Text -> Journal -> ExceptT [Char] IO Journal
journalFinalise iopts :: InputOpts
iopts@InputOpts{Bool
[Char]
[[Char]]
Maybe [Char]
Maybe DateSpan
Day
DateSpan
BalancingOpts
_ioDay :: Day
strict_ :: Bool
balancingopts_ :: BalancingOpts
infer_costs_ :: Bool
infer_equity_ :: Bool
auto_ :: Bool
reportspan_ :: DateSpan
forecast_ :: Maybe DateSpan
pivot_ :: [Char]
new_save_ :: Bool
new_ :: Bool
anon_ :: Bool
aliases_ :: [[Char]]
mrules_file_ :: Maybe [Char]
mformat_ :: Maybe [Char]
_ioDay :: InputOpts -> Day
strict_ :: InputOpts -> Bool
balancingopts_ :: InputOpts -> BalancingOpts
infer_costs_ :: InputOpts -> Bool
infer_equity_ :: InputOpts -> Bool
auto_ :: InputOpts -> Bool
reportspan_ :: InputOpts -> DateSpan
forecast_ :: InputOpts -> Maybe DateSpan
pivot_ :: InputOpts -> [Char]
new_save_ :: InputOpts -> Bool
new_ :: InputOpts -> Bool
anon_ :: InputOpts -> Bool
aliases_ :: InputOpts -> [[Char]]
mrules_file_ :: InputOpts -> Maybe [Char]
mformat_ :: InputOpts -> Maybe [Char]
..} [Char]
f Text
txt Journal
pj = do
  POSIXTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither forall a b. (a -> b) -> a -> b
$ do
    Journal
j <- Journal
pj{jglobalcommoditystyles :: Map Text AmountStyle
jglobalcommoditystyles=forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ BalancingOpts -> Maybe (Map Text AmountStyle)
commodity_styles_ BalancingOpts
balancingopts_}
      forall a b. a -> (a -> b) -> b
&   POSIXTime -> Journal -> Journal
journalSetLastReadTime POSIXTime
t                       -- save the last read time
      forall a b. a -> (a -> b) -> b
&   ([Char], Text) -> Journal -> Journal
journalAddFile ([Char]
f, Text
txt)                        -- save the main file's info
      forall a b. a -> (a -> b) -> b
&   Journal -> Journal
journalReverse                                 -- convert all lists to the order they were parsed
      forall a b. a -> (a -> b) -> b
&   Journal -> Journal
journalAddAccountTypes                         -- build a map of all known account types
      forall a b. a -> (a -> b) -> b
&   Journal -> Either [Char] Journal
journalApplyCommodityStyles                    -- Infer and apply commodity styles - should be done early
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe DateSpan -> Journal -> Journal
journalAddForecast (InputOpts -> Journal -> Maybe DateSpan
forecastPeriod InputOpts
iopts Journal
pj)   -- Add forecast transactions if enabled
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalPostingsAddAccountTags                  -- Add account tags to postings, so they can be matched by auto postings.
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (if Bool
auto_ Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
pj)
              then Day -> BalancingOpts -> Journal -> Either [Char] Journal
journalAddAutoPostings Day
_ioDay BalancingOpts
balancingopts_  -- Add auto postings if enabled, and account tags if needed
              else forall (f :: * -> *) a. Applicative f => a -> f a
pure)
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (if Bool
infer_costs_  then Journal -> Either [Char] Journal
journalAddPricesFromEquity else forall (f :: * -> *) a. Applicative f => a -> f a
pure)      -- Add inferred transaction prices from equity postings, if present
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
balancingopts_                         -- Balance all transactions and maybe check balance assertions.
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (if Bool
infer_equity_ then Journal -> Journal
journalAddInferredEquityPostings else forall a. a -> a
id)  -- Add inferred equity postings, after balancing and generating auto postings
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalInferMarketPricesFromTransactions       -- infer market prices from commodity-exchanging transactions
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. Int -> [Char] -> a -> a
traceOrLogAt Int
6 ([Char]
"journalFinalise: " forall a. Semigroup a => a -> a -> a
<> ShowS
takeFileName [Char]
f)  -- debug logging
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Char] -> Journal -> Journal
dbgJournalAcctDeclOrder ([Char]
"journalFinalise: " forall a. Semigroup a => a -> a -> a
<> ShowS
takeFileName [Char]
f forall a. Semigroup a => a -> a -> a
<> [Char]
"   acct decls           : ")
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalRenumberAccountDeclarations
      forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Char] -> Journal -> Journal
dbgJournalAcctDeclOrder ([Char]
"journalFinalise: " forall a. Semigroup a => a -> a -> a
<> ShowS
takeFileName [Char]
f forall a. Semigroup a => a -> a -> a
<> [Char]
"   acct decls renumbered: ")
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
strict_ forall a b. (a -> b) -> a -> b
$ do
      Journal -> Either [Char] ()
journalCheckAccounts Journal
j                     -- If in strict mode, check all postings are to declared accounts
      Journal -> Either [Char] ()
journalCheckCommodities Journal
j                  -- and using declared commodities
    forall (m :: * -> *) a. Monad m => a -> m a
return Journal
j

-- | Apply any auto posting rules to generate extra postings on this journal's transactions.
journalAddAutoPostings :: Day -> BalancingOpts -> Journal -> Either String Journal
journalAddAutoPostings :: Day -> BalancingOpts -> Journal -> Either [Char] Journal
journalAddAutoPostings Day
d BalancingOpts
bopts =
    -- Balance all transactions without checking balance assertions,
    BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
bopts{ignore_assertions_ :: Bool
ignore_assertions_=Bool
True}
    -- then add the auto postings
    -- (Note adding auto postings after balancing means #893b fails;
    -- adding them before balancing probably means #893a, #928, #938 fail.)
    forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Day -> Journal -> Either [Char] Journal
journalModifyTransactions Day
d

-- | Generate periodic transactions from all periodic transaction rules in the journal.
-- These transactions are added to the in-memory Journal (but not the on-disk file).
--
-- The start & end date for generated periodic transactions are determined in
-- a somewhat complicated way; see the hledger manual -> Periodic transactions.
journalAddForecast :: Maybe DateSpan -> Journal -> Journal
journalAddForecast :: Maybe DateSpan -> Journal -> Journal
journalAddForecast Maybe DateSpan
Nothing             Journal
j = Journal
j
journalAddForecast (Just DateSpan
forecastspan) Journal
j = Journal
j{jtxns :: [Transaction]
jtxns = Journal -> [Transaction]
jtxns Journal
j forall a. [a] -> [a] -> [a]
++ [Transaction]
forecasttxns}
  where
    forecasttxns :: [Transaction]
forecasttxns =
        forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> Transaction
txnTieKnot forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings (Map Text AmountStyle -> Posting -> Posting
postingApplyCommodityStyles forall a b. (a -> b) -> a -> b
$ Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j))
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (DateSpan -> Day -> Bool
spanContainsDate DateSpan
forecastspan forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Day
tdate)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PeriodicTransaction -> DateSpan -> [Transaction]
`runPeriodicTransaction` DateSpan
forecastspan)
      forall a b. (a -> b) -> a -> b
$ Journal -> [PeriodicTransaction]
jperiodictxns Journal
j

setYear :: Year -> JournalParser m ()
setYear :: forall (m :: * -> *). Integer -> JournalParser m ()
setYear Integer
y = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsedefaultyear :: Maybe Integer
jparsedefaultyear=forall a. a -> Maybe a
Just Integer
y})

getYear :: JournalParser m (Maybe Year)
getYear :: forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> Maybe Integer
jparsedefaultyear forall s (m :: * -> *). MonadState s m => m s
get

-- | Get the decimal mark that has been specified for parsing, if any
-- (eg by the CSV decimal-mark rule, or possibly a future journal directive).
-- Return it as an AmountStyle that amount parsers can use.
getDecimalMarkStyle :: JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle :: forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle = do
  Journal{Maybe Char
jparsedecimalmark :: Journal -> Maybe Char
jparsedecimalmark :: Maybe Char
jparsedecimalmark} <- forall s (m :: * -> *). MonadState s m => m s
get
  let mdecmarkStyle :: Maybe AmountStyle
mdecmarkStyle = (\Char
c -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ AmountStyle
amountstyle{asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. a -> Maybe a
Just Char
c}) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Char
jparsedecimalmark
  forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AmountStyle
mdecmarkStyle

setDefaultCommodityAndStyle :: (CommoditySymbol,AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle :: forall (m :: * -> *). (Text, AmountStyle) -> JournalParser m ()
setDefaultCommodityAndStyle (Text, AmountStyle)
cs = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultcommodity=forall a. a -> Maybe a
Just (Text, AmountStyle)
cs})

getDefaultCommodityAndStyle :: JournalParser m (Maybe (CommoditySymbol,AmountStyle))
getDefaultCommodityAndStyle :: forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle = Journal -> Maybe (Text, AmountStyle)
jparsedefaultcommodity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall s (m :: * -> *). MonadState s m => m s
get

-- | Get amount style associated with default currency.
--
-- Returns 'AmountStyle' used to defined by a latest default commodity directive
-- prior to current position within this file or its parents.
getDefaultAmountStyle :: JournalParser m (Maybe AmountStyle)
getDefaultAmountStyle :: forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDefaultAmountStyle = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle

-- | Get the 'AmountStyle' declared by the most recently parsed (in the current or parent files,
-- prior to the current position) commodity directive for the given commodity, if any.
getAmountStyle :: CommoditySymbol -> JournalParser m (Maybe AmountStyle)
getAmountStyle :: forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
commodity = do
  Journal{Map Text Commodity
jcommodities :: Journal -> Map Text Commodity
jcommodities :: Map Text Commodity
jcommodities} <- forall s (m :: * -> *). MonadState s m => m s
get
  let mspecificStyle :: Maybe AmountStyle
mspecificStyle = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
commodity Map Text Commodity
jcommodities forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Commodity -> Maybe AmountStyle
cformat
  Maybe AmountStyle
mdefaultStyle <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe AmountStyle
mspecificStyle, Maybe AmountStyle
mdefaultStyle]

addDeclaredAccountTags :: AccountName -> [Tag] -> JournalParser m ()
addDeclaredAccountTags :: forall (m :: * -> *). Text -> [Tag] -> JournalParser m ()
addDeclaredAccountTags Text
acct [Tag]
atags =
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jdeclaredaccounttags :: Map Text [Tag]
jdeclaredaccounttags = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => [a] -> [a] -> [a]
union) Text
acct [Tag]
atags (Journal -> Map Text [Tag]
jdeclaredaccounttags Journal
j)})

addDeclaredAccountType :: AccountName -> AccountType -> JournalParser m ()
addDeclaredAccountType :: forall (m :: * -> *). Text -> AccountType -> JournalParser m ()
addDeclaredAccountType Text
acct AccountType
atype =
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jdeclaredaccounttypes :: Map AccountType [Text]
jdeclaredaccounttypes = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. [a] -> [a] -> [a]
(++) AccountType
atype [Text
acct] (Journal -> Map AccountType [Text]
jdeclaredaccounttypes Journal
j)})

pushParentAccount :: AccountName -> JournalParser m ()
pushParentAccount :: forall (m :: * -> *). Text -> JournalParser m ()
pushParentAccount Text
acct = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparseparentaccounts :: [Text]
jparseparentaccounts = Text
acct forall a. a -> [a] -> [a]
: Journal -> [Text]
jparseparentaccounts Journal
j})

popParentAccount :: JournalParser m ()
popParentAccount :: forall (m :: * -> *). JournalParser m ()
popParentAccount = do
  Journal
j <- forall s (m :: * -> *). MonadState s m => m s
get
  case Journal -> [Text]
jparseparentaccounts Journal
j of
    []       -> forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected (forall t. NonEmpty t -> ErrorItem t
Tokens (Char
'E' forall a. a -> [a] -> NonEmpty a
:| [Char]
"nd of apply account block with no beginning"))
    (Text
_:[Text]
rest) -> forall s (m :: * -> *). MonadState s m => s -> m ()
put Journal
j{jparseparentaccounts :: [Text]
jparseparentaccounts=[Text]
rest}

getParentAccount :: JournalParser m AccountName
getParentAccount :: forall (m :: * -> *). JournalParser m Text
getParentAccount = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Text] -> Text
concatAccountNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Text]
jparseparentaccounts) forall s (m :: * -> *). MonadState s m => m s
get

addAccountAlias :: MonadState Journal m => AccountAlias -> m ()
addAccountAlias :: forall (m :: * -> *). MonadState Journal m => AccountAlias -> m ()
addAccountAlias AccountAlias
a = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\(j :: Journal
j@Journal{[[Char]]
[([Char], Text)]
[(Text, AccountDeclarationInfo)]
[(Text, PayeeDeclarationInfo)]
[Text]
[MarketPrice]
[PriceDirective]
[TimeclockEntry]
[PeriodicTransaction]
[TransactionModifier]
[Transaction]
[AccountAlias]
Maybe Char
Maybe Integer
Maybe (Text, AmountStyle)
Text
Map Text [Tag]
Map Text Commodity
Map Text AmountStyle
Map Text AccountType
Map AccountType [Text]
POSIXTime
jlastreadtime :: Journal -> POSIXTime
jfiles :: Journal -> [([Char], Text)]
jfinalcommentlines :: Journal -> Text
jinferredmarketprices :: Journal -> [MarketPrice]
jpricedirectives :: Journal -> [PriceDirective]
jinferredcommodities :: Journal -> Map Text AmountStyle
jaccounttypes :: Journal -> Map Text AccountType
jdeclaredaccounts :: Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredpayees :: Journal -> [(Text, PayeeDeclarationInfo)]
jparsetimeclockentries :: Journal -> [TimeclockEntry]
jparsealiases :: Journal -> [AccountAlias]
jlastreadtime :: POSIXTime
jfiles :: [([Char], Text)]
jfinalcommentlines :: Text
jtxns :: [Transaction]
jperiodictxns :: [PeriodicTransaction]
jtxnmodifiers :: [TransactionModifier]
jinferredmarketprices :: [MarketPrice]
jpricedirectives :: [PriceDirective]
jinferredcommodities :: Map Text AmountStyle
jcommodities :: Map Text Commodity
jglobalcommoditystyles :: Map Text AmountStyle
jaccounttypes :: Map Text AccountType
jdeclaredaccounttypes :: Map AccountType [Text]
jdeclaredaccounttags :: Map Text [Tag]
jdeclaredaccounts :: [(Text, AccountDeclarationInfo)]
jdeclaredpayees :: [(Text, PayeeDeclarationInfo)]
jincludefilestack :: [[Char]]
jparsetimeclockentries :: [TimeclockEntry]
jparsealiases :: [AccountAlias]
jparseparentaccounts :: [Text]
jparsedecimalmark :: Maybe Char
jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultyear :: Maybe Integer
jparseparentaccounts :: Journal -> [Text]
jdeclaredaccounttypes :: Journal -> Map AccountType [Text]
jdeclaredaccounttags :: Journal -> Map Text [Tag]
jcommodities :: Journal -> Map Text Commodity
jparsedefaultcommodity :: Journal -> Maybe (Text, AmountStyle)
jparsedecimalmark :: Journal -> Maybe Char
jperiodictxns :: Journal -> [PeriodicTransaction]
jtxns :: Journal -> [Transaction]
jtxnmodifiers :: Journal -> [TransactionModifier]
jglobalcommoditystyles :: Journal -> Map Text AmountStyle
jincludefilestack :: Journal -> [[Char]]
jparsedefaultyear :: Journal -> Maybe Integer
..}) -> Journal
j{jparsealiases :: [AccountAlias]
jparsealiases=AccountAlias
aforall a. a -> [a] -> [a]
:[AccountAlias]
jparsealiases})

getAccountAliases :: MonadState Journal m => m [AccountAlias]
getAccountAliases :: forall (m :: * -> *). MonadState Journal m => m [AccountAlias]
getAccountAliases = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Journal -> [AccountAlias]
jparsealiases forall s (m :: * -> *). MonadState s m => m s
get

clearAccountAliases :: MonadState Journal m => m ()
clearAccountAliases :: forall (m :: * -> *). MonadState Journal m => m ()
clearAccountAliases = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsealiases :: [AccountAlias]
jparsealiases=[]})

-- getTransactionCount :: MonadState Journal m =>  m Integer
-- getTransactionCount = fmap jparsetransactioncount get
--
-- setTransactionCount :: MonadState Journal m => Integer -> m ()
-- setTransactionCount i = modify' (\j -> j{jparsetransactioncount=i})
--
-- -- | Increment the transaction index by one and return the new value.
-- incrementTransactionCount :: MonadState Journal m => m Integer
-- incrementTransactionCount = do
--   modify' (\j -> j{jparsetransactioncount=jparsetransactioncount j + 1})
--   getTransactionCount

journalAddFile :: (FilePath,Text) -> Journal -> Journal
journalAddFile :: ([Char], Text) -> Journal -> Journal
journalAddFile ([Char], Text)
f j :: Journal
j@Journal{jfiles :: Journal -> [([Char], Text)]
jfiles=[([Char], Text)]
fs} = Journal
j{jfiles :: [([Char], Text)]
jfiles=[([Char], Text)]
fsforall a. [a] -> [a] -> [a]
++[([Char], Text)
f]}
  -- append, unlike the other fields, even though we do a final reverse,
  -- to compensate for additional reversal due to including/monoid-concatting

-- A version of `match` that is strict in the returned text
match' :: TextParser m a -> TextParser m (Text, a)
match' :: forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' TextParser m a
p = do
  (!Text
txt, a
p') <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match TextParser m a
p
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
txt, a
p')

--- ** parsers
--- *** transaction bits

statusp :: TextParser m Status
statusp :: forall (m :: * -> *). TextParser m Status
statusp =
  forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice'
    [ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cleared
    , forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'!' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Status
Pending
    , forall (m :: * -> *) a. Monad m => a -> m a
return Status
Unmarked
    ]

codep :: TextParser m Text
codep :: forall (m :: * -> *). TextParser m Text
codep = forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" forall a b. (a -> b) -> a -> b
$ do
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
    forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'('
  Text
code <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
')' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n'
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"closing bracket ')' for transaction code"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
code

-- | Parse possibly empty text until a semicolon or newline.
-- Whitespace is preserved (for now - perhaps helps preserve alignment 
-- of same-line comments ?).
descriptionp :: TextParser m Text
descriptionp :: forall (m :: * -> *). TextParser m Text
descriptionp = forall (m :: * -> *). TextParser m Text
noncommenttextp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"description"

--- *** dates

-- | Parse a date in YYYY-MM-DD format.
-- Slash (/) and period (.) are also allowed as separators.
-- The year may be omitted if a default year has been set.
-- Leading zeroes may be omitted.
datep :: JournalParser m Day
datep :: forall (m :: * -> *). JournalParser m Day
datep = do
  Maybe Integer
mYear <- forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear

datep' :: Maybe Year -> TextParser m Day
datep' :: forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear = do
    Int
startOffset <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Either Integer Int
d1 <- forall (m :: * -> *). TextParser m (Either Integer Int)
yearorintp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"year or month"
    Char
sep <- forall (m :: * -> *). TextParser m Char
datesepchar forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"date separator"
    Int
d2 <- forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"month or day"
    case Either Integer Int
d1 of
         Left Integer
y  -> forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
y Char
sep Int
d2
         Right Int
m -> forall (m :: * -> *).
Int -> Maybe Integer -> Int -> Char -> Int -> TextParser m Day
partialDate Int
startOffset Maybe Integer
mYear Int
m Char
sep Int
d2
    forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"full or partial date"
  where
    fullDate :: Int -> Year -> Char -> Month -> TextParser m Day
    fullDate :: forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
year Char
sep1 Int
month = do
      Char
sep2 <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDateSepChar forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"date separator"
      Int
day <- forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"day"
      Int
endOffset <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      let dateStr :: [Char]
dateStr = forall a. Show a => a -> [Char]
show Integer
year forall a. [a] -> [a] -> [a]
++ [Char
sep1] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
month forall a. [a] -> [a] -> [a]
++ [Char
sep2] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
day

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
sep1 forall a. Eq a => a -> a -> Bool
/= Char
sep2) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset forall a b. (a -> b) -> a -> b
$
        [Char]
"This date is malformed because the separators are different.\n"
        forall a. [a] -> [a] -> [a]
++[Char]
"Please use consistent separators."

      case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
        Maybe Day
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset forall a b. (a -> b) -> a -> b
$
                     [Char]
"This date is invalid, please correct it: " forall a. [a] -> [a] -> [a]
++ [Char]
dateStr
        Just Day
date -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Day
date

    partialDate :: Int -> Maybe Year -> Month -> Char -> MonthDay -> TextParser m Day
    partialDate :: forall (m :: * -> *).
Int -> Maybe Integer -> Int -> Char -> Int -> TextParser m Day
partialDate Int
startOffset Maybe Integer
myr Int
month Char
sep Int
day = do
      Int
endOffset <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      case Maybe Integer
myr of
        Just Integer
year ->
          case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
            Maybe Day
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset forall a b. (a -> b) -> a -> b
$
                        [Char]
"This date is invalid, please correct it: " forall a. [a] -> [a] -> [a]
++ [Char]
dateStr
            Just Day
date -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Day
date
          where dateStr :: [Char]
dateStr = forall a. Show a => a -> [Char]
show Integer
year forall a. [a] -> [a] -> [a]
++ [Char
sep] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
month forall a. [a] -> [a] -> [a]
++ [Char
sep] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
day

        Maybe Integer
Nothing -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset forall a b. (a -> b) -> a -> b
$
          [Char]
"The partial date "forall a. [a] -> [a] -> [a]
++[Char]
dateStrforall a. [a] -> [a] -> [a]
++[Char]
" can not be parsed because the current year is unknown.\n"
          forall a. [a] -> [a] -> [a]
++[Char]
"Consider making it a full date, or add a default year directive.\n"
          where dateStr :: [Char]
dateStr = forall a. Show a => a -> [Char]
show Int
month forall a. [a] -> [a] -> [a]
++ [Char
sep] forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
day

{-# INLINABLE datep' #-}

-- | Parse a date and time in YYYY-MM-DD HH:MM[:SS][+-ZZZZ] format.
-- Slash (/) and period (.) are also allowed as date separators.
-- The year may be omitted if a default year has been set.
-- Seconds are optional.
-- The timezone is optional and ignored (the time is always interpreted as a local time).
-- Leading zeroes may be omitted (except in a timezone).
datetimep :: JournalParser m LocalTime
datetimep :: forall (m :: * -> *). JournalParser m LocalTime
datetimep = do
  Maybe Integer
mYear <- forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Maybe Integer -> TextParser m LocalTime
datetimep' Maybe Integer
mYear

datetimep' :: Maybe Year -> TextParser m LocalTime
datetimep' :: forall (m :: * -> *). Maybe Integer -> TextParser m LocalTime
datetimep' Maybe Integer
mYear = do
  Day
day <- forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear
  forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
  TimeOfDay
time <- forall (m :: * -> *). TextParser m TimeOfDay
timeOfDay
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall (m :: * -> *). TextParser m [Char]
timeZone -- ignoring time zones
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
time

  where
    timeOfDay :: TextParser m TimeOfDay
    timeOfDay :: forall (m :: * -> *). TextParser m TimeOfDay
timeOfDay = do
      Int
off1 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      Int
h' <- forall (m :: * -> *). TextParser m Int
twoDigitDecimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"hour"
      Int
off2 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
h' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
h' forall a. Ord a => a -> a -> Bool
<= Int
23) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
        Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
off1 Int
off2 [Char]
"invalid time (bad hour)"

      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"':' (hour-minute separator)"
      Int
off3 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      Int
m' <- forall (m :: * -> *). TextParser m Int
twoDigitDecimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"minute"
      Int
off4 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
m' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
m' forall a. Ord a => a -> a -> Bool
<= Int
59) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
        Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
off3 Int
off4 [Char]
"invalid time (bad minute)"

      Int
s' <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Int
0 forall a b. (a -> b) -> a -> b
$ do
        forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"':' (minute-second separator)"
        Int
off5 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
        Int
s' <- forall (m :: * -> *). TextParser m Int
twoDigitDecimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"second"
        Int
off6 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
s' forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
s' forall a. Ord a => a -> a -> Bool
<= Int
59) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
          Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
off5 Int
off6 [Char]
"invalid time (bad second)"
          -- we do not support leap seconds
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
s'

      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h' Int
m' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s')

    twoDigitDecimal :: TextParser m Int
    twoDigitDecimal :: forall (m :: * -> *). TextParser m Int
twoDigitDecimal = do
      Int
d1 <- Char -> Int
digitToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
      Int
d2 <- Char -> Int
digitToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a second digit")
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int
d1forall a. Num a => a -> a -> a
*Int
10 forall a. Num a => a -> a -> a
+ Int
d2

    timeZone :: TextParser m String
    timeZone :: forall (m :: * -> *). TextParser m [Char]
timeZone = do
      Char
plusminus <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'+'
      [Char]
fourDigits <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"a digit (for a time zone)")
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char
plusminusforall a. a -> [a] -> [a]
:[Char]
fourDigits

secondarydatep :: Day -> TextParser m Day
secondarydatep :: forall (m :: * -> *). Day -> TextParser m Day
secondarydatep Day
primaryDate = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' (forall a. a -> Maybe a
Just Integer
primaryYear)
  where primaryYear :: Integer
primaryYear = forall {a} {b} {c}. (a, b, c) -> a
first3 forall a b. (a -> b) -> a -> b
$ Day -> (Integer, Int, Int)
toGregorian Day
primaryDate

-- | Parse a year number or an Int. Years must contain at least four
-- digits.
yearorintp :: TextParser m (Either Year Int)
yearorintp :: forall (m :: * -> *). TextParser m (Either Integer Int)
yearorintp = do
    Text
yearOrMonth <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just [Char]
"digit") Char -> Bool
isDigit
    let n :: Integer
n = Text -> Integer
readDecimal Text
yearOrMonth
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Text -> Int
T.length Text
yearOrMonth forall a. Ord a => a -> a -> Bool
>= Int
4 then forall a b. a -> Either a b
Left Integer
n else forall a b. b -> Either a b
Right (forall a. Num a => Integer -> a
fromInteger Integer
n)

--- *** account names

-- | Parse an account name (plus one following space if present),
-- then apply any parent account prefix and/or account aliases currently in effect,
-- in that order. (Ie first add the parent account prefix, then rewrite with aliases).
-- This calls error if any account alias with an invalid regular expression exists.
modifiedaccountnamep :: JournalParser m AccountName
modifiedaccountnamep :: forall (m :: * -> *). JournalParser m Text
modifiedaccountnamep = do
  Text
parent  <- forall (m :: * -> *). JournalParser m Text
getParentAccount
  [AccountAlias]
als     <- forall (m :: * -> *). MonadState Journal m => m [AccountAlias]
getAccountAliases
  -- off1    <- getOffset
  Text
a       <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
accountnamep
  -- off2    <- getOffset
  -- XXX or accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function)
  case [AccountAlias] -> Text -> Either [Char] Text
accountNameApplyAliases [AccountAlias]
als forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
joinAccountNames Text
parent Text
a of
    Right Text
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Text
a'
    -- should not happen, regexaliasp will have displayed a better error already:
    -- (XXX why does customFailure cause error to be displayed there, but not here ?)
    -- Left e  -> customFailure $! parseErrorAtRegion off1 off2 err
    Left [Char]
e   -> forall {a}. [Char] -> a
error' [Char]
err  -- PARTIAL:
      where
        err :: [Char]
err = [Char]
"problem in account alias applied to "forall a. [a] -> [a] -> [a]
++Text -> [Char]
T.unpack Text
aforall a. [a] -> [a] -> [a]
++[Char]
": "forall a. [a] -> [a] -> [a]
++[Char]
e

-- | Parse an account name, plus one following space if present.
-- Account names have one or more parts separated by the account separator character,
-- and are terminated by two or more spaces (or end of input).
-- Each part is at least one character long, may have single spaces inside it,
-- and starts with a non-whitespace.
-- Note, this means "{account}", "%^!" and ";comment" are all accepted
-- (parent parsers usually prevent/consume the last).
-- It should have required parts to start with an alphanumeric;
-- for now it remains as-is for backwards compatibility.
accountnamep :: TextParser m AccountName
accountnamep :: forall (m :: * -> *). TextParser m Text
accountnamep = forall (m :: * -> *). TextParser m Text
singlespacedtext1p

-- | Parse possibly empty text, including whitespace, 
-- until a comment start (semicolon) or newline.
noncommenttextp :: TextParser m T.Text
noncommenttextp :: forall (m :: * -> *). TextParser m Text
noncommenttextp = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSameLineCommentStart Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isNewline Token Text
c)

-- | Parse non-empty text, including whitespace, 
-- until a comment start (semicolon) or newline.
noncommenttext1p :: TextParser m T.Text
noncommenttext1p :: forall (m :: * -> *). TextParser m Text
noncommenttext1p = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (\Token Text
c -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSameLineCommentStart Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isNewline Token Text
c)

-- | Parse non-empty, single-spaced text starting and ending with non-whitespace,
-- until a double space or newline.
singlespacedtext1p :: TextParser m T.Text
singlespacedtext1p :: forall (m :: * -> *). TextParser m Text
singlespacedtext1p = forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p (forall a b. a -> b -> a
const Bool
True)

-- | Parse non-empty, single-spaced text starting and ending with non-whitespace,
-- until a comment start (semicolon), double space, or newline.
singlespacednoncommenttext1p :: TextParser m T.Text
singlespacednoncommenttext1p :: forall (m :: * -> *). TextParser m Text
singlespacednoncommenttext1p = forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSameLineCommentStart)

-- | Parse non-empty, single-spaced text starting and ending with non-whitespace,
-- where all characters satisfy the given predicate.
singlespacedtextsatisfying1p :: (Char -> Bool) -> TextParser m T.Text
singlespacedtextsatisfying1p :: forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p Char -> Bool
f = do
  Text
firstPart <- ParsecT HledgerParseErrorData Text m (Tokens Text)
partp
  [Text]
otherParts <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). TextParser m ()
singlespacep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT HledgerParseErrorData Text m (Tokens Text)
partp
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ Text
firstPart forall a. a -> [a] -> [a]
: [Text]
otherParts
  where
    partp :: ParsecT HledgerParseErrorData Text m (Tokens Text)
partp = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
f Token Text
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Token Text
c))

-- | Parse one non-newline whitespace character that is not followed by another one.
singlespacep :: TextParser m ()
singlespacep :: forall (m :: * -> *). TextParser m ()
singlespacep = forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline

--- *** amounts

-- | Parse whitespace then an amount, with an optional left or right
-- currency symbol and optional price, or return the special
-- "missing" marker amount.
spaceandamountormissingp :: JournalParser m MixedAmount
spaceandamountormissingp :: forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp =
  forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option MixedAmount
missingmixedamt forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1
    Amount -> MixedAmount
mixedAmount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m Amount
amountp

-- | Parse a single-commodity amount, with optional symbol on the left
-- or right, followed by, in any order: an optional transaction price,
-- an optional ledger-style lot price, and/or an optional ledger-style
-- lot date. A lot price and lot date will be ignored.
--
-- To parse the amount's quantity (number) we need to know which character 
-- represents a decimal mark. We find it in one of three ways:
--
-- 1. If a decimal mark has been set explicitly in the journal parse state, 
--    we use that
--
-- 2. Or if the journal has a commodity declaration for the amount's commodity,
--    we get the decimal mark from  that
--
-- 3. Otherwise we will parse any valid decimal mark appearing in the
--    number, as long as the number appears well formed.
--
-- Note 3 is the default zero-config case; it means we automatically handle
-- files with any supported decimal mark, but it also allows different decimal marks
-- in  different amounts, which is a bit too loose. There's an open issue.
amountp :: JournalParser m Amount
amountp :: forall (m :: * -> *). JournalParser m Amount
amountp = forall (m :: * -> *). Bool -> JournalParser m Amount
amountpwithmultiplier Bool
False

amountpwithmultiplier :: Bool -> JournalParser m Amount
amountpwithmultiplier :: forall (m :: * -> *). Bool -> JournalParser m Amount
amountpwithmultiplier Bool
mult = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" forall a b. (a -> b) -> a -> b
$ do
  let spaces :: StateT Journal (ParsecT HledgerParseErrorData Text m) ()
spaces = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Amount
amt <- forall (m :: * -> *). Bool -> JournalParser m Amount
amountwithoutpricep Bool
mult forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces
  (Maybe AmountPrice
mprice, Maybe ()
_elotprice, Maybe ()
_elotdate) <- forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation forall a b. (a -> b) -> a -> b
$
    (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). Amount -> JournalParser m AmountPrice
priceamountp Amount
amt forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces)
         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m ()
lotpricep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces)
         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). JournalParser m ()
lotdatep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Amount
amt { aprice :: Maybe AmountPrice
aprice = Maybe AmountPrice
mprice }

amountpnolotpricesp :: JournalParser m Amount
amountpnolotpricesp :: forall (m :: * -> *). JournalParser m Amount
amountpnolotpricesp = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" forall a b. (a -> b) -> a -> b
$ do
  let spaces :: StateT Journal (ParsecT HledgerParseErrorData Text m) ()
spaces = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Amount
amt <- forall (m :: * -> *). Bool -> JournalParser m Amount
amountwithoutpricep Bool
False
  forall (m :: * -> *). JournalParser m ()
spaces
  Maybe AmountPrice
mprice <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Amount -> JournalParser m AmountPrice
priceamountp Amount
amt forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). JournalParser m ()
spaces
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Amount
amt { aprice :: Maybe AmountPrice
aprice = Maybe AmountPrice
mprice }

amountwithoutpricep :: Bool -> JournalParser m Amount
amountwithoutpricep :: forall (m :: * -> *). Bool -> JournalParser m Amount
amountwithoutpricep Bool
mult = do
  Quantity -> Quantity
sign <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
  forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
leftsymbolamountp Quantity -> Quantity
sign forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
rightornosymbolamountp Quantity -> Quantity
sign

  where

  leftsymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount
  leftsymbolamountp :: forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
leftsymbolamountp Quantity -> Quantity
sign = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" forall a b. (a -> b) -> a -> b
$ do
    Text
c <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). TextParser m Text
commoditysymbolp
    Maybe AmountStyle
mdecmarkStyle <- forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle
    Maybe AmountStyle
mcommodityStyle <- forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
c
    -- XXX amounts of this commodity in periodic transaction rules and auto posting rules ? #1461
    let suggestedStyle :: Maybe AmountStyle
suggestedStyle = Maybe AmountStyle
mdecmarkStyle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mcommodityStyle
    Bool
commodityspaced <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m Bool
skipNonNewlineSpaces'
    Quantity -> Quantity
sign2 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
    Int
offBeforeNum <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Either AmbiguousNumber RawNumber
ambiguousRawNum <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
    Maybe Integer
mExponent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall (m :: * -> *). TextParser m Integer
exponentp
    Int
offAfterNum <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    let numRegion :: (Int, Int)
numRegion = (Int
offBeforeNum, Int
offAfterNum)
    (Quantity
q,AmountPrecision
prec,Maybe Char
mdec,Maybe DigitGroupStyle
mgrps) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
     m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
suggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
    let s :: AmountStyle
s = AmountStyle
amountstyle{ascommodityside :: Side
ascommodityside=Side
L, ascommodityspaced :: Bool
ascommodityspaced=Bool
commodityspaced, asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
    forall (m :: * -> *) a. Monad m => a -> m a
return Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Quantity
aquantity=Quantity -> Quantity
sign (Quantity -> Quantity
sign2 Quantity
q), astyle :: AmountStyle
astyle=AmountStyle
s, aprice :: Maybe AmountPrice
aprice=forall a. Maybe a
Nothing}

  rightornosymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount
  rightornosymbolamountp :: forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
rightornosymbolamountp Quantity -> Quantity
sign = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" forall a b. (a -> b) -> a -> b
$ do
    Int
offBeforeNum <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Either AmbiguousNumber RawNumber
ambiguousRawNum <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
    Maybe Integer
mExponent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall (m :: * -> *). TextParser m Integer
exponentp
    Int
offAfterNum <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    let numRegion :: (Int, Int)
numRegion = (Int
offBeforeNum, Int
offAfterNum)
    Maybe (Bool, Text)
mSpaceAndCommodity <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m Bool
skipNonNewlineSpaces' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). TextParser m Text
commoditysymbolp
    case Maybe (Bool, Text)
mSpaceAndCommodity of
      -- right symbol amount
      Just (Bool
commodityspaced, Text
c) -> do
        Maybe AmountStyle
mdecmarkStyle <- forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle
        Maybe AmountStyle
mcommodityStyle <- forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
c
        -- XXX amounts of this commodity in periodic transaction rules and auto posting rules ? #1461
        let msuggestedStyle :: Maybe AmountStyle
msuggestedStyle = Maybe AmountStyle
mdecmarkStyle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mcommodityStyle
        (Quantity
q,AmountPrecision
prec,Maybe Char
mdec,Maybe DigitGroupStyle
mgrps) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
     m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
        let s :: AmountStyle
s = AmountStyle
amountstyle{ascommodityside :: Side
ascommodityside=Side
R, ascommodityspaced :: Bool
ascommodityspaced=Bool
commodityspaced, asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps}
        forall (m :: * -> *) a. Monad m => a -> m a
return Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Quantity
aquantity=Quantity -> Quantity
sign Quantity
q, astyle :: AmountStyle
astyle=AmountStyle
s, aprice :: Maybe AmountPrice
aprice=forall a. Maybe a
Nothing}
      -- no symbol amount
      Maybe (Bool, Text)
Nothing -> do
        -- look for a number style to use when parsing, based on
        -- these things we've already parsed, in this order of preference:
        Maybe AmountStyle
mdecmarkStyle   <- forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle   -- a decimal-mark CSV rule
        Maybe AmountStyle
mcommodityStyle <- forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
""     -- a commodity directive for the no-symbol commodity
        Maybe AmountStyle
mdefaultStyle   <- forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDefaultAmountStyle -- a D default commodity directive
        -- XXX no-symbol amounts in periodic transaction rules and auto posting rules ? #1461
        let msuggestedStyle :: Maybe AmountStyle
msuggestedStyle = Maybe AmountStyle
mdecmarkStyle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mcommodityStyle forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mdefaultStyle
        (Quantity
q,AmountPrecision
prec,Maybe Char
mdec,Maybe DigitGroupStyle
mgrps) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
     m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
        -- if a default commodity has been set, apply it and its style to this amount
        -- (unless it's a multiplier in an automated posting)
        Maybe (Text, AmountStyle)
defcs <- forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle
        let (Text
c,AmountStyle
s) = case (Bool
mult, Maybe (Text, AmountStyle)
defcs) of
              (Bool
False, Just (Text
defc,AmountStyle
defs)) -> (Text
defc, AmountStyle
defs{asprecision :: AmountPrecision
asprecision=forall a. Ord a => a -> a -> a
max (AmountStyle -> AmountPrecision
asprecision AmountStyle
defs) AmountPrecision
prec})
              (Bool, Maybe (Text, AmountStyle))
_ -> (Text
"", AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=AmountPrecision
prec, asdecimalpoint :: Maybe Char
asdecimalpoint=Maybe Char
mdec, asdigitgroups :: Maybe DigitGroupStyle
asdigitgroups=Maybe DigitGroupStyle
mgrps})
        forall (m :: * -> *) a. Monad m => a -> m a
return Amount
nullamt{acommodity :: Text
acommodity=Text
c, aquantity :: Quantity
aquantity=Quantity -> Quantity
sign Quantity
q, astyle :: AmountStyle
astyle=AmountStyle
s, aprice :: Maybe AmountPrice
aprice=forall a. Maybe a
Nothing}

  -- For reducing code duplication. Doesn't parse anything. Has the type
  -- of a parser only in order to throw parse errors (for convenience).
  interpretNumber
    :: (Int, Int) -- offsets
    -> Maybe AmountStyle
    -> Either AmbiguousNumber RawNumber
    -> Maybe Integer
    -> TextParser m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
  interpretNumber :: forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
     m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
posRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousNum Maybe Integer
mExp =
    let rawNum :: RawNumber
rawNum = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber Maybe AmountStyle
msuggestedStyle) forall a. a -> a
id Either AmbiguousNumber RawNumber
ambiguousNum
    in  case RawNumber
-> Maybe Integer
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
          Left [Char]
errMsg -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
                           forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion (Int, Int)
posRegion [Char]
errMsg
          Right (Quantity
q,Word8
p,Maybe Char
d,Maybe DigitGroupStyle
g) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity
q, Word8 -> AmountPrecision
Precision Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g)

-- | Try to parse a single-commodity amount from a string
parseamount :: String -> Either HledgerParseErrors Amount
parseamount :: [Char] -> Either HledgerParseErrors Amount
parseamount [Char]
s = forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *). JournalParser m Amount
amountp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
nulljournal) [Char]
"" ([Char] -> Text
T.pack [Char]
s)

-- | Parse a single-commodity amount from a string, or get an error.
parseamount' :: String -> Amount
parseamount' :: [Char] -> Amount
parseamount' [Char]
s =
  case [Char] -> Either HledgerParseErrors Amount
parseamount [Char]
s of
    Right Amount
amt -> Amount
amt
    Left HledgerParseErrors
err  -> forall {a}. [Char] -> a
error' forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show HledgerParseErrors
err  -- PARTIAL: XXX should throwError

-- | Like parseamount', but returns a MixedAmount.
parsemixedamount :: String -> Either HledgerParseErrors MixedAmount
parsemixedamount :: [Char] -> Either HledgerParseErrors MixedAmount
parsemixedamount = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Amount -> MixedAmount
mixedAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either HledgerParseErrors Amount
parseamount

-- | Like parseamount', but returns a MixedAmount.
parsemixedamount' :: String -> MixedAmount
parsemixedamount' :: [Char] -> MixedAmount
parsemixedamount' = Amount -> MixedAmount
mixedAmount forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Amount
parseamount'

-- | Parse a minus or plus sign followed by zero or more spaces,
-- or nothing, returning a function that negates or does nothing.
signp :: Num a => TextParser m (a -> a)
signp :: forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp = ((forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Num a => a -> a
negate forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. a -> a
id) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id

commoditysymbolp :: TextParser m CommoditySymbol
commoditysymbolp :: forall (m :: * -> *). TextParser m Text
commoditysymbolp =
  forall (m :: * -> *). TextParser m Text
quotedcommoditysymbolp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). TextParser m Text
simplecommoditysymbolp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"commodity symbol"

quotedcommoditysymbolp :: TextParser m CommoditySymbol
quotedcommoditysymbolp :: forall (m :: * -> *). TextParser m Text
quotedcommoditysymbolp =
  forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'"') forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing Char -> Bool
f
  where f :: Char -> Bool
f Char
c = Char
c forall a. Eq a => a -> a -> Bool
/= Char
';' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\"'

simplecommoditysymbolp :: TextParser m CommoditySymbol
simplecommoditysymbolp :: forall (m :: * -> *). TextParser m Text
simplecommoditysymbolp = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isNonsimpleCommodityChar)

priceamountp :: Amount -> JournalParser m AmountPrice
priceamountp :: forall (m :: * -> *). Amount -> JournalParser m AmountPrice
priceamountp Amount
baseAmt = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"transaction price" forall a b. (a -> b) -> a -> b
$ do
  -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs
  Bool
parenthesised <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'@'
  Bool
totalPrice <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'@' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
parenthesised forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')'

  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Amount
priceAmount <- forall (m :: * -> *). Bool -> JournalParser m Amount
amountwithoutpricep Bool
False -- <?> "unpriced amount (specifying a price)"

  let amtsign' :: Quantity
amtsign' = forall a. Num a => a -> a
signum forall a b. (a -> b) -> a -> b
$ Amount -> Quantity
aquantity Amount
baseAmt
      amtsign :: Quantity
amtsign  = if Quantity
amtsign' forall a. Eq a => a -> a -> Bool
== Quantity
0 then Quantity
1 else Quantity
amtsign'

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
totalPrice
            then Amount -> AmountPrice
TotalPrice Amount
priceAmount{aquantity :: Quantity
aquantity=Quantity
amtsign forall a. Num a => a -> a -> a
* Amount -> Quantity
aquantity Amount
priceAmount}
            else Amount -> AmountPrice
UnitPrice  Amount
priceAmount


balanceassertionp :: JournalParser m BalanceAssertion
balanceassertionp :: forall (m :: * -> *). JournalParser m BalanceAssertion
balanceassertionp = do
  SourcePos
sourcepos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
  Bool
istotal <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
  Bool
isinclusive <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*'
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  -- this amount can have a price; balance assertions ignore it,
  -- but balance assignments will use it
  Amount
a <- forall (m :: * -> *). JournalParser m Amount
amountpnolotpricesp forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"amount (for a balance assertion or assignment)"
  forall (m :: * -> *) a. Monad m => a -> m a
return BalanceAssertion
    { baamount :: Amount
baamount    = Amount
a
    , batotal :: Bool
batotal     = Bool
istotal
    , bainclusive :: Bool
bainclusive = Bool
isinclusive
    , baposition :: SourcePos
baposition  = SourcePos
sourcepos
    }

-- Parse a Ledger-style fixed {=UNITPRICE} or non-fixed {UNITPRICE}
-- or fixed {{=TOTALPRICE}} or non-fixed {{TOTALPRICE}} lot price,
-- and ignore it.
-- https://www.ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices .
lotpricep :: JournalParser m ()
lotpricep :: forall (m :: * -> *). JournalParser m ()
lotpricep = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"ledger-style lot price" forall a b. (a -> b) -> a -> b
$ do
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'{'
  Bool
doublebrace <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'{' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  Bool
_fixed <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Amount
_a <- forall (m :: * -> *). Bool -> JournalParser m Amount
amountwithoutpricep Bool
False
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'}'
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
doublebrace) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'}'

-- Parse a Ledger-style lot date [DATE], and ignore it.
-- https://www.ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices .
lotdatep :: JournalParser m ()
lotdatep :: forall (m :: * -> *). JournalParser m ()
lotdatep = (do
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'['
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Day
_d <- forall (m :: * -> *). JournalParser m Day
datep
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']'
  forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"ledger-style lot date"

-- | Parse a string representation of a number for its value and display
-- attributes.
--
-- Some international number formats are accepted, eg either period or comma
-- may be used for the decimal mark, and the other of these may be used for
-- separating digit groups in the integer part. See
-- http://en.wikipedia.org/wiki/Decimal_separator for more examples.
--
-- This returns: the parsed numeric value, the precision (number of digits
-- seen following the decimal mark), the decimal mark character used if any,
-- and the digit group style if any.
--
numberp :: Maybe AmountStyle -> TextParser m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp :: forall (m :: * -> *).
Maybe AmountStyle
-> TextParser
     m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp Maybe AmountStyle
suggestedStyle = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"number" forall a b. (a -> b) -> a -> b
$ do
    -- a number is an optional sign followed by a sequence of digits possibly
    -- interspersed with periods, commas, or both
    -- dbgparse 0 "numberp"
    Quantity -> Quantity
sign <- forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
    RawNumber
rawNum <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber Maybe AmountStyle
suggestedStyle) forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
    Maybe Integer
mExp <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). TextParser m Integer
exponentp
    forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"numberp suggestedStyle" Maybe AmountStyle
suggestedStyle seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"numberp quantity,precision,mdecimalpoint,mgrps"
           forall a b. (a -> b) -> a -> b
$ RawNumber
-> Maybe Integer
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
      Left [Char]
errMsg -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
errMsg
      Right (Quantity
q, Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity -> Quantity
sign Quantity
q, Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g)

exponentp :: TextParser m Integer
exponentp :: forall (m :: * -> *). TextParser m Integer
exponentp = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char' Char
'e' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"exponent"

-- | Interpret a raw number as a decimal number.
--
-- Returns:
-- - the decimal number
-- - the precision (number of digits after the decimal point)
-- - the decimal point character, if any
-- - the digit group style, if any (digit group character and sizes of digit groups)
fromRawNumber
  :: RawNumber
  -> Maybe Integer
  -> Either String
            (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber :: RawNumber
-> Maybe Integer
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber (WithSeparators{}) (Just Integer
_) =
    forall a b. a -> Either a b
Left [Char]
"invalid number: digit separators and exponents may not be used together"
fromRawNumber RawNumber
raw Maybe Integer
mExp = do
    (Quantity
quantity, Word8
precision) <- Integer -> DigitGrp -> DigitGrp -> Either [Char] (Quantity, Word8)
toQuantity (forall a. a -> Maybe a -> a
fromMaybe Integer
0 Maybe Integer
mExp) (RawNumber -> DigitGrp
digitGroup RawNumber
raw) (RawNumber -> DigitGrp
decimalGroup RawNumber
raw)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Quantity
quantity, Word8
precision, RawNumber -> Maybe Char
mDecPt RawNumber
raw, RawNumber -> Maybe DigitGroupStyle
digitGroupStyle RawNumber
raw)
  where
    toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either String (Quantity, Word8)
    toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either [Char] (Quantity, Word8)
toQuantity Integer
e DigitGrp
preDecimalGrp DigitGrp
postDecimalGrp
      | Integer
precision forall a. Ord a => a -> a -> Bool
< Integer
0   = forall a b. b -> Either a b
Right (forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
0 (Integer
digitGrpNum forall a. Num a => a -> a -> a
* Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^(-Integer
precision)), Word8
0)
      | Integer
precision forall a. Ord a => a -> a -> Bool
< Integer
256 = forall a b. b -> Either a b
Right (forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
precision8 Integer
digitGrpNum, Word8
precision8)
      | Bool
otherwise = forall a b. a -> Either a b
Left [Char]
"invalid number: numbers with more than 255 decimal places are currently not supported"
      where
        digitGrpNum :: Integer
digitGrpNum = DigitGrp -> Integer
digitGroupNumber forall a b. (a -> b) -> a -> b
$ DigitGrp
preDecimalGrp forall a. Semigroup a => a -> a -> a
<> DigitGrp
postDecimalGrp
        precision :: Integer
precision   = forall a. Integral a => a -> Integer
toInteger (DigitGrp -> Word
digitGroupLength DigitGrp
postDecimalGrp) forall a. Num a => a -> a -> a
- Integer
e
        precision8 :: Word8
precision8  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
precision :: Word8

    mDecPt :: RawNumber -> Maybe Char
mDecPt (NoSeparators DigitGrp
_ Maybe (Char, DigitGrp)
mDecimals)           = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Char, DigitGrp)
mDecimals
    mDecPt (WithSeparators Char
_ [DigitGrp]
_ Maybe (Char, DigitGrp)
mDecimals)       = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Char, DigitGrp)
mDecimals
    decimalGroup :: RawNumber -> DigitGrp
decimalGroup (NoSeparators DigitGrp
_ Maybe (Char, DigitGrp)
mDecimals)     = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a b. (a, b) -> b
snd Maybe (Char, DigitGrp)
mDecimals
    decimalGroup (WithSeparators Char
_ [DigitGrp]
_ Maybe (Char, DigitGrp)
mDecimals) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a b. (a, b) -> b
snd Maybe (Char, DigitGrp)
mDecimals
    digitGroup :: RawNumber -> DigitGrp
digitGroup (NoSeparators DigitGrp
digitGrp Maybe (Char, DigitGrp)
_)        = DigitGrp
digitGrp
    digitGroup (WithSeparators Char
_ [DigitGrp]
digitGrps Maybe (Char, DigitGrp)
_)   = forall a. Monoid a => [a] -> a
mconcat [DigitGrp]
digitGrps
    digitGroupStyle :: RawNumber -> Maybe DigitGroupStyle
digitGroupStyle (NoSeparators DigitGrp
_ Maybe (Char, DigitGrp)
_)          = forall a. Maybe a
Nothing
    digitGroupStyle (WithSeparators Char
sep [DigitGrp]
grps Maybe (Char, DigitGrp)
_) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
sep forall a b. (a -> b) -> a -> b
$ [DigitGrp] -> [Word8]
groupSizes [DigitGrp]
grps

    -- Outputs digit group sizes from least significant to most significant
    groupSizes :: [DigitGrp] -> [Word8]
    groupSizes :: [DigitGrp] -> [Word8]
groupSizes [DigitGrp]
digitGrps = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ case forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. DigitGrp -> Word
digitGroupLength) [DigitGrp]
digitGrps of
      (Word8
a:Word8
b:[Word8]
cs) | Word8
a forall a. Ord a => a -> a -> Bool
< Word8
b -> Word8
bforall a. a -> [a] -> [a]
:[Word8]
cs
      [Word8]
gs               -> [Word8]
gs

disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber Maybe AmountStyle
msuggestedStyle (AmbiguousNumber DigitGrp
grp1 Char
sep DigitGrp
grp2) =
  -- If present, use the suggested style to disambiguate;
  -- otherwise, assume that the separator is a decimal point where possible.
  if Char -> Bool
isDecimalMark Char
sep Bool -> Bool -> Bool
&&
     forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Char
sep Char -> AmountStyle -> Bool
`isValidDecimalBy`) Maybe AmountStyle
msuggestedStyle
  then DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 (forall a. a -> Maybe a
Just (Char
sep, DigitGrp
grp2))
  else Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
sep [DigitGrp
grp1, DigitGrp
grp2] forall a. Maybe a
Nothing
  where
    isValidDecimalBy :: Char -> AmountStyle -> Bool
    isValidDecimalBy :: Char -> AmountStyle -> Bool
isValidDecimalBy Char
c = \case
      AmountStyle{asdecimalpoint :: AmountStyle -> Maybe Char
asdecimalpoint = Just Char
d} -> Char
d forall a. Eq a => a -> a -> Bool
== Char
c
      AmountStyle{asdigitgroups :: AmountStyle -> Maybe DigitGroupStyle
asdigitgroups = Just (DigitGroups Char
g [Word8]
_)} -> Char
g forall a. Eq a => a -> a -> Bool
/= Char
c
      AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision = Precision Word8
0} -> Bool
False
      AmountStyle
_ -> Bool
True

-- | Parse and interpret the structure of a number without external hints.
-- Numbers are digit strings, possibly separated into digit groups by one
-- of two types of separators. (1) Numbers may optionally have a decimal
-- mark, which may be either a period or comma. (2) Numbers may
-- optionally contain digit group marks, which must all be either a
-- period, a comma, or a space.
--
-- It is our task to deduce the characters used as decimal mark and
-- digit group mark, based on the allowed syntax. For instance, we
-- make use of the fact that a decimal mark can occur at most once and
-- must be to the right of all digit group marks.
--
-- >>> parseTest rawnumberp "1,234,567.89"
-- Right (WithSeparators ',' ["1","234","567"] (Just ('.',"89")))
-- >>> parseTest rawnumberp "1,000"
-- Left (AmbiguousNumber "1" ',' "000")
-- >>> parseTest rawnumberp "1 000"
-- Right (WithSeparators ' ' ["1","000"] Nothing)
--
rawnumberp :: TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp :: forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"number" forall a b. (a -> b) -> a -> b
$ do
  Either AmbiguousNumber RawNumber
rawNumber <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (m :: * -> *). TextParser m RawNumber
leadingDecimalPt forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits

  -- Guard against mistyped numbers
  Maybe (Token Text)
mExtraDecimalSep <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDecimalMark
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (Token Text)
mExtraDecimalSep) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
"invalid number (invalid use of separator)"

  Maybe Int
mExtraFragment <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
' ' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
  case Maybe Int
mExtraFragment of
    Just Int
off -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$
                  Int -> [Char] -> HledgerParseErrorData
parseErrorAt Int
off [Char]
"invalid number (excessive trailing digits)"
    Maybe Int
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"rawnumberp" Either AmbiguousNumber RawNumber
rawNumber
  where

  leadingDecimalPt :: TextParser m RawNumber
  leadingDecimalPt :: forall (m :: * -> *). TextParser m RawNumber
leadingDecimalPt = do
    Char
decPt <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDecimalMark
    DigitGrp
decGrp <- forall (m :: * -> *). TextParser m DigitGrp
digitgroupp
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators forall a. Monoid a => a
mempty (forall a. a -> Maybe a
Just (Char
decPt, DigitGrp
decGrp))

  leadingDigits :: TextParser m (Either AmbiguousNumber RawNumber)
  leadingDigits :: forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits = do
    DigitGrp
grp1 <- forall (m :: * -> *). TextParser m DigitGrp
digitgroupp
    forall (m :: * -> *).
DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber)
withSeparators DigitGrp
grp1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right (forall (m :: * -> *). DigitGrp -> TextParser m RawNumber
trailingDecimalPt DigitGrp
grp1)
                        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 forall a. Maybe a
Nothing)

  withSeparators :: DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber)
  withSeparators :: forall (m :: * -> *).
DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber)
withSeparators DigitGrp
grp1 = do
    (Char
sep, DigitGrp
grp2) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDigitSeparatorChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). TextParser m DigitGrp
digitgroupp
    [DigitGrp]
grps <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TextParser m DigitGrp
digitgroupp

    let digitGroups :: [DigitGrp]
digitGroups = DigitGrp
grp1 forall a. a -> [a] -> [a]
: DigitGrp
grp2 forall a. a -> [a] -> [a]
: [DigitGrp]
grps
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right (forall (m :: * -> *). Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt Char
sep [DigitGrp]
digitGroups)
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure (DigitGrp
-> Char
-> DigitGrp
-> [DigitGrp]
-> Either AmbiguousNumber RawNumber
withoutDecimalPt DigitGrp
grp1 Char
sep DigitGrp
grp2 [DigitGrp]
grps)

  withDecimalPt :: Char -> [DigitGrp] -> TextParser m RawNumber
  withDecimalPt :: forall (m :: * -> *). Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt Char
digitSep [DigitGrp]
digitGroups = do
    Char
decPt <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isDecimalMark Token Text
c Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
digitSep
    DigitGrp
decDigitGrp <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty forall (m :: * -> *). TextParser m DigitGrp
digitgroupp

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
digitSep [DigitGrp]
digitGroups (forall a. a -> Maybe a
Just (Char
decPt, DigitGrp
decDigitGrp))

  withoutDecimalPt
    :: DigitGrp
    -> Char
    -> DigitGrp
    -> [DigitGrp]
    -> Either AmbiguousNumber RawNumber
  withoutDecimalPt :: DigitGrp
-> Char
-> DigitGrp
-> [DigitGrp]
-> Either AmbiguousNumber RawNumber
withoutDecimalPt DigitGrp
grp1 Char
sep DigitGrp
grp2 [DigitGrp]
grps
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DigitGrp]
grps Bool -> Bool -> Bool
&& Char -> Bool
isDecimalMark Char
sep =
        forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ DigitGrp -> Char -> DigitGrp -> AmbiguousNumber
AmbiguousNumber DigitGrp
grp1 Char
sep DigitGrp
grp2
    | Bool
otherwise = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
sep (DigitGrp
grp1forall a. a -> [a] -> [a]
:DigitGrp
grp2forall a. a -> [a] -> [a]
:[DigitGrp]
grps) forall a. Maybe a
Nothing

  trailingDecimalPt :: DigitGrp -> TextParser m RawNumber
  trailingDecimalPt :: forall (m :: * -> *). DigitGrp -> TextParser m RawNumber
trailingDecimalPt DigitGrp
grp1 = do
    Char
decPt <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isDecimalMark
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 (forall a. a -> Maybe a
Just (Char
decPt, forall a. Monoid a => a
mempty))

isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar Char
c = Char -> Bool
isDecimalMark Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' '

-- | Some kinds of number literal we might parse.
data RawNumber
  = NoSeparators   DigitGrp (Maybe (Char, DigitGrp))
    -- ^ A number with no digit group marks (eg 100),
    --   or with a leading or trailing comma or period
    --   which (apparently) we interpret as a decimal mark (like 100. or .100)
  | WithSeparators Char [DigitGrp] (Maybe (Char, DigitGrp))
    -- ^ A number with identifiable digit group marks
    --   (eg 1,000,000 or 1,000.50 or 1 000)
  deriving (Int -> RawNumber -> ShowS
[RawNumber] -> ShowS
RawNumber -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RawNumber] -> ShowS
$cshowList :: [RawNumber] -> ShowS
show :: RawNumber -> [Char]
$cshow :: RawNumber -> [Char]
showsPrec :: Int -> RawNumber -> ShowS
$cshowsPrec :: Int -> RawNumber -> ShowS
Show, RawNumber -> RawNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawNumber -> RawNumber -> Bool
$c/= :: RawNumber -> RawNumber -> Bool
== :: RawNumber -> RawNumber -> Bool
$c== :: RawNumber -> RawNumber -> Bool
Eq)

-- | Another kind of number literal: this one contains either a digit
-- group separator or a decimal mark, we're not sure which (eg 1,000 or 100.50).
data AmbiguousNumber = AmbiguousNumber DigitGrp Char DigitGrp
  deriving (Int -> AmbiguousNumber -> ShowS
[AmbiguousNumber] -> ShowS
AmbiguousNumber -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AmbiguousNumber] -> ShowS
$cshowList :: [AmbiguousNumber] -> ShowS
show :: AmbiguousNumber -> [Char]
$cshow :: AmbiguousNumber -> [Char]
showsPrec :: Int -> AmbiguousNumber -> ShowS
$cshowsPrec :: Int -> AmbiguousNumber -> ShowS
Show, AmbiguousNumber -> AmbiguousNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AmbiguousNumber -> AmbiguousNumber -> Bool
$c/= :: AmbiguousNumber -> AmbiguousNumber -> Bool
== :: AmbiguousNumber -> AmbiguousNumber -> Bool
$c== :: AmbiguousNumber -> AmbiguousNumber -> Bool
Eq)

-- | Description of a single digit group in a number literal.
-- "Thousands" is one well known digit grouping, but there are others.
data DigitGrp = DigitGrp {
  DigitGrp -> Word
digitGroupLength :: !Word,    -- ^ The number of digits in this group.
                                -- This is Word to avoid the need to do overflow
                                -- checking for the Semigroup instance of DigitGrp.
  DigitGrp -> Integer
digitGroupNumber :: !Integer  -- ^ The natural number formed by this group's digits. This should always be positive.
} deriving (DigitGrp -> DigitGrp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DigitGrp -> DigitGrp -> Bool
$c/= :: DigitGrp -> DigitGrp -> Bool
== :: DigitGrp -> DigitGrp -> Bool
$c== :: DigitGrp -> DigitGrp -> Bool
Eq)

-- | A custom show instance, showing digit groups as the parser saw them.
instance Show DigitGrp where
  show :: DigitGrp -> [Char]
show (DigitGrp Word
len Integer
n) = [Char]
"\"" forall a. [a] -> [a] -> [a]
++ [Char]
padding forall a. [a] -> [a] -> [a]
++ [Char]
numStr forall a. [a] -> [a] -> [a]
++ [Char]
"\""
    where numStr :: [Char]
numStr = forall a. Show a => a -> [Char]
show Integer
n
          padding :: [Char]
padding = forall i a. Integral i => i -> a -> [a]
genericReplicate (forall a. Integral a => a -> Integer
toInteger Word
len forall a. Num a => a -> a -> a
- forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
numStr)) Char
'0'

instance Sem.Semigroup DigitGrp where
  DigitGrp Word
l1 Integer
n1 <> :: DigitGrp -> DigitGrp -> DigitGrp
<> DigitGrp Word
l2 Integer
n2 = Word -> Integer -> DigitGrp
DigitGrp (Word
l1 forall a. Num a => a -> a -> a
+ Word
l2) (Integer
n1 forall a. Num a => a -> a -> a
* Integer
10forall a b. (Num a, Integral b) => a -> b -> a
^Word
l2 forall a. Num a => a -> a -> a
+ Integer
n2)

instance Monoid DigitGrp where
  mempty :: DigitGrp
mempty = Word -> Integer -> DigitGrp
DigitGrp Word
0 Integer
0
  mappend :: DigitGrp -> DigitGrp -> DigitGrp
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)

digitgroupp :: TextParser m DigitGrp
digitgroupp :: forall (m :: * -> *). TextParser m DigitGrp
digitgroupp = forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"digits"
            forall a b. (a -> b) -> a -> b
$ Text -> DigitGrp
makeGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just [Char]
"digit") Char -> Bool
isDigit
  where
    makeGroup :: Text -> DigitGrp
makeGroup = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word -> Integer -> DigitGrp
DigitGrp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' forall {a} {b}. (Num a, Num b) => (a, b) -> Char -> (a, b)
step (Word
0, Integer
0)
    step :: (a, b) -> Char -> (a, b)
step (!a
l, !b
a) Char
c = (a
lforall a. Num a => a -> a -> a
+a
1, b
aforall a. Num a => a -> a -> a
*b
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
c))

--- *** comments

multilinecommentp :: TextParser m ()
multilinecommentp :: forall (m :: * -> *). TextParser m ()
multilinecommentp = ParsecT HledgerParseErrorData Text m ()
startComment forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT HledgerParseErrorData Text m ()
anyLine forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
`skipManyTill` ParsecT HledgerParseErrorData Text m ()
endComment
  where
    startComment :: ParsecT HledgerParseErrorData Text m ()
startComment = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"comment" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TextParser m ()
trailingSpaces
    endComment :: ParsecT HledgerParseErrorData Text m ()
endComment = forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end comment" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TextParser m ()
trailingSpaces

    trailingSpaces :: ParsecT HledgerParseErrorData Text m ()
trailingSpaces = forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
    anyLine :: ParsecT HledgerParseErrorData Text m ()
anyLine = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/=Char
'\n') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

{-# INLINABLE multilinecommentp #-}

-- | A blank or comment line in journal format: a line that's empty or
-- containing only whitespace or whose first non-whitespace character
-- is semicolon, hash, or star.
emptyorcommentlinep :: TextParser m ()
emptyorcommentlinep :: forall (m :: * -> *). TextParser m ()
emptyorcommentlinep = do
  forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  forall (m :: * -> *). TextParser m ()
skiplinecommentp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  where
    skiplinecommentp :: TextParser m ()
    skiplinecommentp :: forall (m :: * -> *). TextParser m ()
skiplinecommentp = do
      forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isLineCommentStart
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{-# INLINABLE emptyorcommentlinep #-}

-- | Is this a character that, as the first non-whitespace on a line,
-- starts a comment line ?
isLineCommentStart :: Char -> Bool
isLineCommentStart :: Char -> Bool
isLineCommentStart Char
'#' = Bool
True
isLineCommentStart Char
'*' = Bool
True
isLineCommentStart Char
';' = Bool
True
isLineCommentStart Char
_   = Bool
False

-- | Is this a character that, appearing anywhere within a line,
-- starts a comment ?
isSameLineCommentStart :: Char -> Bool
isSameLineCommentStart :: Char -> Bool
isSameLineCommentStart Char
';' = Bool
True
isSameLineCommentStart Char
_   = Bool
False

-- A parser for (possibly multiline) comments following a journal item.
--
-- Comments following a journal item begin with a semicolon and extend to
-- the end of the line. They may span multiple lines; any comment lines 
-- not on the same line as the journal item must be indented (preceded by
-- leading whitespace).
--
-- Like Ledger, we sometimes allow data to be embedded in comments. Eg,
-- comments on the account directive and on transactions can contain tags,
-- and comments on postings can contain tags and/or bracketed posting dates.
-- To handle these variations, this parser takes as parameter a subparser,
-- which should consume all input up until the next newline, and which can
-- optionally extract some kind of data from it.
-- followingcommentp' returns this data along with the full text of the comment.
--
-- See followingcommentp for tests.
--
followingcommentp' :: (Monoid a, Show a) => TextParser m a -> TextParser m (Text, a)
followingcommentp' :: forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentp' TextParser m a
contentp = do
  forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  -- there can be 0 or 1 sameLine
  [(Text, a)]
sameLine <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall (m :: * -> *). TextParser m ()
headerp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' TextParser m a
contentp) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  ()
_ <- forall (m :: * -> *). TextParser m ()
eolof
  -- there can be 0 or more nextLines
  [(Text, a)]
nextLines <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall a b. (a -> b) -> a -> b
$
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). TextParser m ()
headerp) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' TextParser m a
contentp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). TextParser m ()
eolof
  let
    -- if there's just a next-line comment, insert an empty same-line comment
    -- so the next-line comment doesn't get rendered as a same-line comment.
    sameLine' :: [(Text, a)]
sameLine' | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, a)]
sameLine Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, a)]
nextLines) = [(Text
"",forall a. Monoid a => a
mempty)]
              | Bool
otherwise = [(Text, a)]
sameLine
    ([Text]
texts, [a]
contents) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ [(Text, a)]
sameLine' forall a. [a] -> [a] -> [a]
++ [(Text, a)]
nextLines
    strippedCommentText :: Text
strippedCommentText = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip [Text]
texts
    commentContent :: a
commentContent = forall a. Monoid a => [a] -> a
mconcat [a]
contents
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
strippedCommentText, a
commentContent)

  where
    headerp :: ParsecT HledgerParseErrorData Text m ()
headerp = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces

{-# INLINABLE followingcommentp' #-}

-- | Parse the text of a (possibly multiline) comment following a journal item.
--
-- >>> rtp followingcommentp ""   -- no comment
-- Right ""
-- >>> rtp followingcommentp ";"    -- just a (empty) same-line comment. newline is added
-- Right "\n"
-- >>> rtp followingcommentp ";  \n"
-- Right "\n"
-- >>> rtp followingcommentp ";\n ;\n"  -- a same-line and a next-line comment
-- Right "\n\n"
-- >>> rtp followingcommentp "\n ;\n"  -- just a next-line comment. Insert an empty same-line comment so the next-line comment doesn't become a same-line comment.
-- Right "\n\n"
--
followingcommentp :: TextParser m Text
followingcommentp :: forall (m :: * -> *). TextParser m Text
followingcommentp =
  forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentp' (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
'\n'))  -- XXX support \r\n ?
{-# INLINABLE followingcommentp #-}


-- | Parse a transaction comment and extract its tags.
--
-- The first line of a transaction may be followed by comments, which
-- begin with semicolons and extend to the end of the line. Transaction
-- comments may span multiple lines, but comment lines below the
-- transaction must be preceded by leading whitespace.
--
-- 2000/1/1 ; a transaction comment starting on the same line ...
--   ; extending to the next line
--   account1  $1
--   account2
--
-- Tags are name-value pairs.
--
-- >>> let getTags (_,tags) = tags
-- >>> let parseTags = fmap getTags . rtp transactioncommentp
--
-- >>> parseTags "; name1: val1, name2:all this is value2"
-- Right [("name1","val1"),("name2","all this is value2")]
--
-- A tag's name must be immediately followed by a colon, without
-- separating whitespace. The corresponding value consists of all the text
-- following the colon up until the next colon or newline, stripped of
-- leading and trailing whitespace.
--
transactioncommentp :: TextParser m (Text, [Tag])
transactioncommentp :: forall (m :: * -> *). TextParser m (Text, [Tag])
transactioncommentp = forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentp' forall (m :: * -> *). TextParser m [Tag]
commenttagsp
{-# INLINABLE transactioncommentp #-}

commenttagsp :: TextParser m [Tag]
commenttagsp :: forall (m :: * -> *). TextParser m [Tag]
commenttagsp = do
  Text
tagName <- (forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSpace) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
':' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  forall (m :: * -> *). Text -> TextParser m [Tag]
atColon Text
tagName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure [] -- if not ':', then either '\n' or EOF

  where
    atColon :: Text -> TextParser m [Tag]
    atColon :: forall (m :: * -> *). Text -> TextParser m [Tag]
atColon Text
name = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
      if Text -> Bool
T.null Text
name
        then forall (m :: * -> *). TextParser m [Tag]
commenttagsp
        else do
          forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
          Text
val <- forall (m :: * -> *). TextParser m Text
tagValue
          let tag :: Tag
tag = (Text
name, Text
val)
          (Tag
tagforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). TextParser m [Tag]
commenttagsp

    tagValue :: TextParser m Text
    tagValue :: forall (m :: * -> *). TextParser m Text
tagValue = do
      Text
val <- Text -> Text
T.strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
',' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n')
      Maybe (Token Text)
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
','
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
val

{-# INLINABLE commenttagsp #-}


-- | Parse a posting comment and extract its tags and dates.
--
-- Postings may be followed by comments, which begin with semicolons and
-- extend to the end of the line. Posting comments may span multiple
-- lines, but comment lines below the posting must be preceded by
-- leading whitespace.
--
-- 2000/1/1
--   account1  $1 ; a posting comment starting on the same line ...
--   ; extending to the next line
--
--   account2
--   ; a posting comment beginning on the next line
--
-- Tags are name-value pairs.
--
-- >>> let getTags (_,tags,_,_) = tags
-- >>> let parseTags = fmap getTags . rtp (postingcommentp Nothing)
--
-- >>> parseTags "; name1: val1, name2:all this is value2"
-- Right [("name1","val1"),("name2","all this is value2")]
--
-- A tag's name must be immediately followed by a colon, without
-- separating whitespace. The corresponding value consists of all the text
-- following the colon up until the next colon or newline, stripped of
-- leading and trailing whitespace.
--
-- Posting dates may be expressed with "date"/"date2" tags or with
-- bracketed date syntax. Posting dates will inherit their year from the
-- transaction date if the year is not specified. We throw parse errors on
-- invalid dates.
--
-- >>> let getDates (_,_,d1,d2) = (d1, d2)
-- >>> let parseDates = fmap getDates . rtp (postingcommentp (Just 2000))
--
-- >>> parseDates "; date: 1/2, date2: 1999/12/31"
-- Right (Just 2000-01-02,Just 1999-12-31)
-- >>> parseDates "; [1/2=1999/12/31]"
-- Right (Just 2000-01-02,Just 1999-12-31)
--
-- Example: tags, date tags, and bracketed dates
-- >>> rtp (postingcommentp (Just 2000)) "; a:b, date:3/4, [=5/6]"
-- Right ("a:b, date:3/4, [=5/6]\n",[("a","b"),("date","3/4")],Just 2000-03-04,Just 2000-05-06)
--
-- Example: extraction of dates from date tags ignores trailing text
-- >>> rtp (postingcommentp (Just 2000)) "; date:3/4=5/6"
-- Right ("date:3/4=5/6\n",[("date","3/4=5/6")],Just 2000-03-04,Nothing)
--
postingcommentp
  :: Maybe Year -> TextParser m (Text, [Tag], Maybe Day, Maybe Day)
postingcommentp :: forall (m :: * -> *).
Maybe Integer -> TextParser m (Text, [Tag], Maybe Day, Maybe Day)
postingcommentp Maybe Integer
mYear = do
  (Text
commentText, ([Tag]
tags, [DateTag]
dateTags)) <-
    forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentp' (forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear)
  let mdate :: Maybe Day
mdate  = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Text
"date") forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [DateTag]
dateTags
      mdate2 :: Maybe Day
mdate2 = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Text
"date2")forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) [DateTag]
dateTags
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
commentText, [Tag]
tags, Maybe Day
mdate, Maybe Day
mdate2)
{-# INLINABLE postingcommentp #-}


commenttagsanddatesp
  :: Maybe Year -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp :: forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear = do
  (Text
txt, [DateTag]
dateTags) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
':'
  -- next char is either ':' or '\n' (or EOF)
  let tagName :: Text
tagName = forall a. [a] -> a
last ((Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSpace Text
txt)
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second) ([DateTag]
dateTagsforall a. [a] -> [a] -> [a]
++) (forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
atColon Text
tagName) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [DateTag]
dateTags) -- if not ':', then either '\n' or EOF

  where
    readUpTo :: Char -> TextParser m [DateTag]
    readUpTo :: forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
end = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
end Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'[')
      -- if not '[' then ':' or '\n' or EOF
      forall (m :: * -> *).
TextParser m [DateTag] -> TextParser m [DateTag]
atBracket (forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
end) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    atBracket :: TextParser m [DateTag] -> TextParser m [DateTag]
    atBracket :: forall (m :: * -> *).
TextParser m [DateTag] -> TextParser m [DateTag]
atBracket TextParser m [DateTag]
cont = do
      -- Uses the fact that bracketed date-tags cannot contain newlines
      [DateTag]
dateTags <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall (m :: * -> *). Maybe Integer -> TextParser m [DateTag]
bracketeddatetagsp Maybe Integer
mYear)
      Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'['
      [DateTag]
dateTags' <- TextParser m [DateTag]
cont
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [DateTag]
dateTags forall a. [a] -> [a] -> [a]
++ [DateTag]
dateTags'

    atColon :: Text -> TextParser m ([Tag], [DateTag])
    atColon :: forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
atColon Text
name = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
      forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
      ([Tag]
tags, [DateTag]
dateTags) <- case Text
name of
        Text
""      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
        Text
"date"  -> forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name
        Text
"date2" -> forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name
        Text
_       -> forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
tagValue Text
name
      Maybe (Token Text)
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
','
      forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([Tag]
tagsforall a. [a] -> [a] -> [a]
++) ([DateTag]
dateTagsforall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear

    dateValue :: Text -> TextParser m ([Tag], [DateTag])
    dateValue :: forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
dateValue Text
name = do
      (Text
txt, (Day
date, [DateTag]
dateTags)) <- forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' forall a b. (a -> b) -> a -> b
$ do
        Day
date <- forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear
        [DateTag]
dateTags <- forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
','
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day
date, [DateTag]
dateTags)
      let val :: Text
val = Text -> Text
T.strip Text
txt
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ( [(Text
name, Text
val)]
             , (Text
name, Day
date) forall a. a -> [a] -> [a]
: [DateTag]
dateTags )

    tagValue :: Text -> TextParser m ([Tag], [DateTag])
    tagValue :: forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
tagValue Text
name = do
      (Text
txt, [DateTag]
dateTags) <- forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
','
      let val :: Text
val = Text -> Text
T.strip Text
txt
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ( [(Text
name, Text
val)]
             , [DateTag]
dateTags )

{-# INLINABLE commenttagsanddatesp #-}

-- | Parse Ledger-style bracketed posting dates ([DATE=DATE2]), as
-- "date" and/or "date2" tags. Anything that looks like an attempt at
-- this (a square-bracketed sequence of 0123456789/-.= containing at
-- least one digit and one date separator) is also parsed, and will
-- throw an appropriate error.
--
-- The dates are parsed in full here so that errors are reported in
-- the right position. A missing year in DATE can be inferred if a
-- default date is provided. A missing year in DATE2 will be inferred
-- from DATE.
--
-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]"
-- Right [("date",2016-01-02),("date2",2016-03-04)]
--
-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[1]"
-- Left ...not a bracketed date...
--
-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]"
-- Left ...1:2:...This date is invalid...
--
-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[1/31]"
-- Left ...1:2:...The partial date 1/31 can not be parsed...
--
-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]"
-- Left ...1:13:...expecting month or day...
--
bracketeddatetagsp
  :: Maybe Year -> TextParser m [(TagName, Day)]
bracketeddatetagsp :: forall (m :: * -> *). Maybe Integer -> TextParser m [DateTag]
bracketeddatetagsp Maybe Integer
mYear1 = do
  -- dbgparse 0 "bracketeddatetagsp"
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
    Text
s <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead
       forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']')
       forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing Char -> Bool
isBracketedDateChar
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
s Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDateSepChar Text
s) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
"not a bracketed date"
  -- Looks sufficiently like a bracketed date to commit to parsing a date

  forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') forall a b. (a -> b) -> a -> b
$ do
    Maybe Day
md1 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear1

    let mYear2 :: Maybe Integer
mYear2 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> Integer
readYear Maybe Day
md1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Integer
mYear1
    Maybe Day
md2 <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear2

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [(Text
"date",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
md1, (Text
"date2",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
md2]

  where
    readYear :: Day -> Integer
readYear = forall {a} {b} {c}. (a, b, c) -> a
first3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian
    isBracketedDateChar :: Char -> Bool
isBracketedDateChar Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDateSepChar Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'='

{-# INLINABLE bracketeddatetagsp #-}

-- | Get the account name aliases from options, if any.
aliasesFromOpts :: InputOpts -> [AccountAlias]
aliasesFromOpts :: InputOpts -> [AccountAlias]
aliasesFromOpts = forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
a -> forall t e a.
(Show t, Show (Token t), Show e) =>
Either (ParseErrorBundle t e) a -> a
fromparse forall a b. (a -> b) -> a -> b
$ forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser forall (m :: * -> *). TextParser m AccountAlias
accountaliasp ([Char]
"--alias "forall a. [a] -> [a] -> [a]
++ShowS
quoteIfNeeded [Char]
a) forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
a)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> [[Char]]
aliases_

accountaliasp :: TextParser m AccountAlias
accountaliasp :: forall (m :: * -> *). TextParser m AccountAlias
accountaliasp = forall (m :: * -> *). TextParser m AccountAlias
regexaliasp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). TextParser m AccountAlias
basicaliasp

basicaliasp :: TextParser m AccountAlias
basicaliasp :: forall (m :: * -> *). TextParser m AccountAlias
basicaliasp = do
  -- dbgparse 0 "basicaliasp"
  [Char]
old <- ShowS
rstrip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"=" :: [Char]))
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
  forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  [Char]
new <- ShowS
rstrip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` forall (m :: * -> *). TextParser m ()
eolof  -- eol in journal, eof in command lines, normally
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> AccountAlias
BasicAlias ([Char] -> Text
T.pack [Char]
old) ([Char] -> Text
T.pack [Char]
new)

regexaliasp :: TextParser m AccountAlias
regexaliasp :: forall (m :: * -> *). TextParser m AccountAlias
regexaliasp = do
  -- dbgparse 0 "regexaliasp"
  (Int
off1, Int
off2, Text
re) <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'/') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'/') forall a b. (a -> b) -> a -> b
$ do
    Int
off1 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Text
re <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$
             (Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"/\\\n\r" :: [Char]))               -- paranoid: don't try to read past line end
             forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\\/"                                             -- allow escaping forward slashes
             forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Char -> Text -> Text
T.cons (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\') (Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle))  -- Otherwise leave backslashes in
    Int
off2 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off1, Int
off2, Text
re)
  forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'='
  forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  [Char]
repl <- forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` forall (m :: * -> *). TextParser m ()
eolof
  case Text -> Either [Char] Regexp
toRegexCI Text
re of
    Right Regexp
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Regexp -> [Char] -> AccountAlias
RegexAlias Regexp
r [Char]
repl
    Left [Char]
e  -> forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure forall a b. (a -> b) -> a -> b
$! Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
off1 Int
off2 [Char]
e

--- ** tests

tests_Common :: TestTree
tests_Common = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Common" [

   [Char] -> [TestTree] -> TestTree
testGroup [Char]
"amountp" [
    [Char] -> Assertion -> TestTree
testCase [Char]
"basic"                  forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Amount
amountp Text
"$47.18"     (Quantity -> Amount
usd Quantity
47.18)
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"ends with decimal mark" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Amount
amountp Text
"$1."        (Quantity -> Amount
usd Quantity
1  Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
0)
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"unit price"             forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 @ €0.5"
      -- not precise enough:
      -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.'
      Amount
nullamt{
         acommodity :: Text
acommodity=Text
"$"
        ,aquantity :: Quantity
aquantity=Quantity
10 -- need to test internal precision with roundTo ? I think not
        ,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
0, asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. Maybe a
Nothing}
        ,aprice :: Maybe AmountPrice
aprice=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
UnitPrice forall a b. (a -> b) -> a -> b
$
          Amount
nullamt{
             acommodity :: Text
acommodity=Text
"€"
            ,aquantity :: Quantity
aquantity=Quantity
0.5
            ,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
1, asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. a -> Maybe a
Just Char
'.'}
            }
        }
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"total price"            forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 @@ €5"
      Amount
nullamt{
         acommodity :: Text
acommodity=Text
"$"
        ,aquantity :: Quantity
aquantity=Quantity
10
        ,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
0, asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. Maybe a
Nothing}
        ,aprice :: Maybe AmountPrice
aprice=forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Amount -> AmountPrice
TotalPrice forall a b. (a -> b) -> a -> b
$
          Amount
nullamt{
             acommodity :: Text
acommodity=Text
"€"
            ,aquantity :: Quantity
aquantity=Quantity
5
            ,astyle :: AmountStyle
astyle=AmountStyle
amountstyle{asprecision :: AmountPrecision
asprecision=Word8 -> AmountPrecision
Precision Word8
0, asdecimalpoint :: Maybe Char
asdecimalpoint=forall a. Maybe a
Nothing}
            }
        }
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"unit price, parenthesised" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 (@) €0.5"
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"total price, parenthesised" forall a b. (a -> b) -> a -> b
$ forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 (@@) €0.5"
   ]

  ,let p :: JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
Maybe AmountStyle
-> TextParser
     m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp forall a. Maybe a
Nothing) :: JournalParser IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) in
   [Char] -> Assertion -> TestTree
testCase [Char]
"numberp" forall a b. (a -> b) -> a -> b
$ do
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"0"          (Quantity
0, Word8
0, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1"          (Quantity
1, Word8
0, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.1"        (Quantity
1.1, Word8
1, forall a. a -> Maybe a
Just Char
'.', forall a. Maybe a
Nothing)
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000.1"    (Quantity
1000.1, Word8
1, forall a. a -> Maybe a
Just Char
'.', forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.00.000,1" (Quantity
100000.1, Word8
1, forall a. a -> Maybe a
Just Char
',', forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
'.' [Word8
3,Word8
2])
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000,000"  (Quantity
1000000, Word8
0, forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3,Word8
3])  -- could be simplified to [3]
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1."         (Quantity
1, Word8
0, forall a. a -> Maybe a
Just Char
'.', forall a. Maybe a
Nothing)
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,"         (Quantity
1, Word8
0, forall a. a -> Maybe a
Just Char
',', forall a. Maybe a
Nothing)
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
".1"         (Quantity
0.1, Word8
1, forall a. a -> Maybe a
Just Char
'.', forall a. Maybe a
Nothing)
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
",1"         (Quantity
0.1, Word8
1, forall a. a -> Maybe a
Just Char
',', forall a. Maybe a
Nothing)
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"" [Char]
""
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000.000,1" [Char]
""
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.000,000.1" [Char]
""
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,000.000.1" [Char]
""
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,,1" [Char]
""
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1..1" [Char]
""
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
".1," [Char]
""
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
",1." [Char]
""
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq    JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" (Quantity
1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555, Word8
255, forall a. a -> Maybe a
Just Char
'.', forall a. Maybe a
Nothing)
     forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> [Char] -> Assertion
assertParseError JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" [Char]
""

  ,[Char] -> [TestTree] -> TestTree
testGroup [Char]
"spaceandamountormissingp" [
     [Char] -> Assertion -> TestTree
testCase [Char]
"space and amount" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp Text
" $47.18" (Amount -> MixedAmount
mixedAmount forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
47.18)
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"empty string" forall a b. (a -> b) -> a -> b
$ forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp Text
"" MixedAmount
missingmixedamt
    -- ,testCase "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt  -- XXX should it ?
    -- ,testCase "just amount" $ assertParseError spaceandamountormissingp "$47.18" ""  -- succeeds, consuming nothing
    ]

  ]