--- * -*- 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        #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Functor law" #-}

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

  -- * 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,
  amountp',
  commoditysymbolp,
  costp,
  balanceassertionp,
  lotcostp,
  numberp,
  fromRawNumber,
  rawnumberp,
  parseamount,
  parseamount',
  parsemixedamount,
  parsemixedamount',

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

  -- ** bracketed dates
  bracketeddatetagsp,

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

  -- * tests
  tests_Common,
)
where

--- ** imports
import Control.Applicative.Permutations (runPermutation, toPermutationWithDefault)
import Control.Monad (foldM, liftM2, when, unless, (>=>), (<=<))
import qualified Control.Monad.Fail as Fail (fail)
import Control.Monad.Except (ExceptT(..), liftEither, withExceptT)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.State.Strict (MonadState, evalStateT, modify', get, put)
import Control.Monad.Trans.Class (lift)
import Data.Bifunctor (bimap, second)
import Data.Char (digitToInt, isDigit, isSpace)
import Data.Decimal (DecimalRaw (Decimal), Decimal)
import Data.Either (rights)
import Data.Function ((&))
import Data.Functor ((<&>), ($>), void)
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, stripEnd)
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 System.FilePath (takeFileName)
import System.IO (Handle)
import Text.Megaparsec
import Text.Megaparsec.Char (char, char', digitChar, newline, string)
import Text.Megaparsec.Char.Lexer (decimal)

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

--- ** 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 -> StorageFormat
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 via the handle, producing an exception-raising IO
     -- action that produces a journal or error message.
    ,forall (m :: * -> *).
Reader m
-> InputOpts -> [Char] -> Handle -> ExceptT [Char] IO Journal
rReadFn   :: InputOpts -> FilePath -> Handle -> 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 = StorageFormat -> [Char]
forall a. Show a => a -> [Char]
show (Reader m -> StorageFormat
forall (m :: * -> *). Reader m -> StorageFormat
rFormat Reader m
r) [Char] -> ShowS
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 -> Bool -> Bool -> RawOpts -> InputOpts
rawOptsToInputOpts :: Day -> Bool -> Bool -> RawOpts -> InputOpts
rawOptsToInputOpts Day
day Bool
usecoloronstdout Bool
postingaccttags RawOpts
rawopts =

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

        -- 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 -> Bool -> RawOpts -> ReportOpts
rawOptsToReportOpts Day
day Bool
usecoloronstdout RawOpts
rawopts
        argsquery :: [Query]
argsquery = ((Query, [QueryOpt]) -> Query) -> [(Query, [QueryOpt])] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map (Query, [QueryOpt]) -> Query
forall a b. (a, b) -> a
fst ([(Query, [QueryOpt])] -> [Query])
-> ([Text] -> [(Query, [QueryOpt])]) -> [Text] -> [Query]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either [Char] (Query, [QueryOpt])] -> [(Query, [QueryOpt])]
forall a b. [Either a b] -> [b]
rights ([Either [Char] (Query, [QueryOpt])] -> [(Query, [QueryOpt])])
-> ([Text] -> [Either [Char] (Query, [QueryOpt])])
-> [Text]
-> [(Query, [QueryOpt])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either [Char] (Query, [QueryOpt]))
-> [Text] -> [Either [Char] (Query, [QueryOpt])]
forall a b. (a -> b) -> [a] -> [b]
map (Day -> Text -> Either [Char] (Query, [QueryOpt])
parseQueryTerm Day
day) ([Text] -> [Query]) -> [Text] -> [Query]
forall a b. (a -> b) -> a -> b
$ ReportOpts -> [Text]
querystring_ ReportOpts
ropts
        datequery :: Query
datequery = Query -> Query
simplifyQuery (Query -> Query) -> ([Query] -> Query) -> [Query] -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDate (Query -> Query) -> ([Query] -> Query) -> [Query] -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Query] -> Query
And ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Query
queryFromFlags ReportOpts
ropts Query -> [Query] -> [Query]
forall a. a -> [a] -> [a]
: [Query]
argsquery

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

    in InputOpts
definputopts{
       -- files_             = listofstringopt "file" rawopts
       mformat_           = Nothing
      ,mrules_file_       = maybestringopt "rules" rawopts
      ,aliases_           = listofstringopt "alias" rawopts
      ,anon_              = boolopt "obfuscate" rawopts
      ,new_               = boolopt "new" rawopts
      ,new_save_          = True
      ,pivot_             = stringopt "pivot" rawopts
      ,forecast_          = forecastPeriodFromRawOpts day rawopts
      ,posting_account_tags_ = postingaccttags
      ,verbose_tags_      = boolopt "verbose-tags" rawopts
      ,reportspan_        = DateSpan (Exact <$> queryStartDate False datequery) (Exact <$> queryEndDate False datequery)
      ,auto_              = boolopt "auto" rawopts
      ,infer_equity_      = boolopt "infer-equity" rawopts && conversionop_ ropts /= Just ToCost
      ,infer_costs_       = boolopt "infer-costs" rawopts
      ,balancingopts_     = defbalancingopts{
                                 ignore_assertions_     = boolopt "ignore-assertions" rawopts
                               , infer_balancing_costs_ = not noinferbalancingcosts
                               , commodity_styles_      = Just styles
                               }
      ,strict_            = boolopt "strict" rawopts
      ,_ioDay             = day
      }

handleReadFnToTextReadFn :: (InputOpts -> FilePath -> Text -> ExceptT String IO Journal) -> InputOpts -> FilePath -> Handle -> ExceptT String IO Journal
handleReadFnToTextReadFn :: (InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal)
-> InputOpts -> [Char] -> Handle -> ExceptT [Char] IO Journal
handleReadFnToTextReadFn InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
p InputOpts
iopts [Char]
fp =
  InputOpts -> [Char] -> Text -> ExceptT [Char] IO Journal
p InputOpts
iopts [Char]
fp (Text -> ExceptT [Char] IO Journal)
-> (Handle -> ExceptT [Char] IO Text)
-> Handle
-> ExceptT [Char] IO Journal
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO Text -> ExceptT [Char] IO Text
forall (m :: * -> *) a. Monad m => m a -> ExceptT [Char] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Text -> ExceptT [Char] IO Text)
-> (Handle -> IO Text) -> Handle -> ExceptT [Char] IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Text
readHandlePortably

-- | 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 (Text -> Either HledgerParseErrors (Interval, DateSpan))
-> (Text -> Text)
-> Text
-> Either HledgerParseErrors (Interval, DateSpan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripquotes (Text -> Either HledgerParseErrors (Interval, DateSpan))
-> Text -> Either HledgerParseErrors (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
arg
    DateSpan -> Maybe DateSpan
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (DateSpan -> Maybe DateSpan) -> DateSpan -> Maybe DateSpan
forall a b. (a -> b) -> a -> b
$ if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
arg then DateSpan
nulldatespan else (HledgerParseErrors -> DateSpan)
-> ((Interval, DateSpan) -> DateSpan)
-> Either HledgerParseErrors (Interval, DateSpan)
-> DateSpan
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HledgerParseErrors -> DateSpan
forall {a}. HledgerParseErrors -> a
badParse ([Char] -> (Interval, DateSpan) -> DateSpan
forall {b}. [Char] -> (Interval, b) -> b
getSpan [Char]
arg) Either HledgerParseErrors (Interval, DateSpan)
period
  where
    badParse :: HledgerParseErrors -> a
badParse HledgerParseErrors
e = [Char] -> a
forall {a}. [Char] -> a
usageError ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"could not parse forecast period : "[Char] -> ShowS
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
_          -> [Char] -> b
forall {a}. [Char] -> a
usageError ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [Char]
"--forecast's argument should not contain a report interval ("
                                 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Interval -> [Char]
forall a. Show a => a -> [Char]
show Interval
interval [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" in \"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
arg [Char] -> ShowS
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 =
    (Map Text AmountStyle
 -> [Char] -> Either [Char] (Map Text AmountStyle))
-> Map Text AmountStyle
-> [[Char]]
-> Either [Char] (Map Text AmountStyle)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Map Text AmountStyle
r -> ((Text, AmountStyle) -> Map Text AmountStyle)
-> Either [Char] (Text, AmountStyle)
-> Either [Char] (Map Text AmountStyle)
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
c,AmountStyle
a) -> Text -> AmountStyle -> Map Text AmountStyle -> Map Text AmountStyle
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
c AmountStyle
a Map Text AmountStyle
r) (Either [Char] (Text, AmountStyle)
 -> Either [Char] (Map Text AmountStyle))
-> ([Char] -> Either [Char] (Text, AmountStyle))
-> [Char]
-> Either [Char] (Map Text AmountStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] (Text, AmountStyle)
parseCommodity) Map Text AmountStyle
forall a. Monoid a => a
mempty [[Char]]
optList
  where
    optList :: [[Char]]
optList = [Char] -> RawOpts -> [[Char]]
listofstringopt [Char]
"commodity-style" RawOpts
rawOpts
    parseCommodity :: [Char] -> Either [Char] (Text, AmountStyle)
parseCommodity [Char]
optStr = case [Char] -> Either HledgerParseErrors Amount
parseamount [Char]
optStr of
        Left HledgerParseErrors
_ -> [Char] -> Either [Char] (Text, AmountStyle)
forall a b. a -> Either a b
Left [Char]
optStr
        Right (Amount Text
acommodity Quantity
_ AmountStyle
astyle Maybe AmountCost
_) -> (Text, AmountStyle) -> Either [Char] (Text, AmountStyle)
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 ExceptT [Char] IO Journal
-> (Journal -> ExceptT [Char] IO Journal)
-> ExceptT [Char] IO Journal
forall a b.
ExceptT [Char] IO a
-> (a -> ExceptT [Char] IO b) -> ExceptT [Char] IO b
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 =
    ExceptT FinalParseError IO (Either HledgerParseErrors Journal)
-> ExceptT [Char] IO Journal
forall a.
ExceptT FinalParseError IO (Either HledgerParseErrors a)
-> ExceptT [Char] IO a
prettyParseErrors (ExceptT FinalParseError IO (Either HledgerParseErrors Journal)
 -> ExceptT [Char] IO Journal)
-> ExceptT FinalParseError IO (Either HledgerParseErrors Journal)
-> ExceptT [Char] IO Journal
forall a b. (a -> b) -> a -> b
$ ParsecT
  HledgerParseErrorData Text (ExceptT FinalParseError IO) Journal
-> [Char]
-> Text
-> ExceptT FinalParseError IO (Either HledgerParseErrors Journal)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (ErroringJournalParser IO Journal
-> Journal
-> ParsecT
     HledgerParseErrorData Text (ExceptT FinalParseError IO) Journal
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ErroringJournalParser IO Journal
parser Journal
initJournal) [Char]
f Text
txt
  where
    y :: Integer
y = (Integer, Int, Int) -> Integer
forall {a} {b} {c}. (a, b, c) -> a
first3 ((Integer, Int, Int) -> Integer)
-> (Day -> (Integer, Int, Int)) -> Day -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian (Day -> Integer) -> Day -> Integer
forall a b. (a -> b) -> a -> b
$ InputOpts -> Day
_ioDay InputOpts
iopts
    initJournal :: Journal
initJournal = Journal
nulljournal{jparsedefaultyear = Just y, jincludefilestack = [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 = (HledgerParseErrors -> [Char])
-> ExceptT HledgerParseErrors IO a -> ExceptT [Char] IO a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT HledgerParseErrors -> [Char]
customErrorBundlePretty (ExceptT HledgerParseErrors IO a -> ExceptT [Char] IO a)
-> (Either HledgerParseErrors a -> ExceptT HledgerParseErrors IO a)
-> Either HledgerParseErrors a
-> ExceptT [Char] IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either HledgerParseErrors a -> ExceptT HledgerParseErrors IO a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
                    (Either HledgerParseErrors a -> ExceptT [Char] IO a)
-> (ExceptT FinalParseError IO (Either HledgerParseErrors a)
    -> ExceptT [Char] IO (Either HledgerParseErrors a))
-> ExceptT FinalParseError IO (Either HledgerParseErrors a)
-> ExceptT [Char] IO a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (FinalParseError -> [Char])
-> ExceptT FinalParseError IO (Either HledgerParseErrors a)
-> ExceptT [Char] IO (Either HledgerParseErrors a)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (FinalParseErrorBundle' HledgerParseErrorData -> [Char]
finalErrorBundlePretty (FinalParseErrorBundle' HledgerParseErrorData -> [Char])
-> (FinalParseError
    -> FinalParseErrorBundle' HledgerParseErrorData)
-> FinalParseError
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char]
-> Text
-> FinalParseError
-> FinalParseErrorBundle' HledgerParseErrorData
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
--  note this 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
--
-- - propagate account tags to postings
--
-- - maybe add forecast transactions
--
-- - propagate account tags to postings (again to affect forecast transactions)
--
-- - maybe add auto postings
--
-- - propagate account tags to postings (again to affect auto postings)
--
-- - evaluate balance assignments and balance each transaction
--
-- - maybe check balance assertions
--
-- - maybe infer costs from equity postings
--
-- - maybe infer equity postings from costs
--
-- - manye infer market prices from costs
--
-- One correctness check (parseable) has already passed when this function is called.
-- Up to four more are performed here:
--
--  - ordereddates (when enabled)
--
--  - assertions (when enabled)
--
--  - autobalanced (and with --strict, balanced ?), in the journalBalanceTransactions step.
--
-- Others (commodities, accounts..) are done later by journalStrictChecks.
--
journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal
journalFinalise :: InputOpts -> [Char] -> Text -> Journal -> ExceptT [Char] IO Journal
journalFinalise iopts :: InputOpts
iopts@InputOpts{Bool
auto_ :: InputOpts -> Bool
auto_ :: Bool
auto_,BalancingOpts
balancingopts_ :: InputOpts -> BalancingOpts
balancingopts_ :: BalancingOpts
balancingopts_,Bool
infer_costs_ :: InputOpts -> Bool
infer_costs_ :: Bool
infer_costs_,Bool
infer_equity_ :: InputOpts -> Bool
infer_equity_ :: Bool
infer_equity_,Bool
strict_ :: InputOpts -> Bool
strict_ :: Bool
strict_,Bool
posting_account_tags_ :: InputOpts -> Bool
posting_account_tags_ :: Bool
posting_account_tags_,Bool
verbose_tags_ :: InputOpts -> Bool
verbose_tags_ :: Bool
verbose_tags_,Day
_ioDay :: InputOpts -> Day
_ioDay :: Day
_ioDay} [Char]
f Text
txt Journal
pj = do
  let
    BalancingOpts{Maybe (Map Text AmountStyle)
commodity_styles_ :: BalancingOpts -> Maybe (Map Text AmountStyle)
commodity_styles_ :: Maybe (Map Text AmountStyle)
commodity_styles_, Bool
ignore_assertions_ :: BalancingOpts -> Bool
ignore_assertions_ :: Bool
ignore_assertions_} = BalancingOpts
balancingopts_
    fname :: [Char]
fname = [Char]
"journalFinalise " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
takeFileName [Char]
f
    lbl :: [Char] -> ShowS
lbl = [Char] -> [Char] -> ShowS
lbl_ [Char]
fname
    -- Some not so pleasant hacks
    -- We want to know when certain checks have been explicitly requested with the check command,
    -- but it does not run until later. For now, inspect the command line with unsafePerformIO.
    checking :: [Char] -> Bool
checking [Char]
checkname = [Char]
"check" [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
args Bool -> Bool -> Bool
&& [Char]
checkname [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
args where args :: [[Char]]
args = [[Char]]
progArgs
    -- We will check ordered dates when "check ordereddates" is used.
    checkordereddates :: Bool
checkordereddates = [Char] -> Bool
checking [Char]
"ordereddates"
    -- We will check balance assertions by default, unless -I is used, but always if -s or "check assertions" are used.
    checkassertions :: Bool
checkassertions = Bool -> Bool
not Bool
ignore_assertions_ Bool -> Bool -> Bool
|| Bool
strict_ Bool -> Bool -> Bool
|| [Char] -> Bool
checking [Char]
"assertions"

  POSIXTime
t <- IO POSIXTime -> ExceptT [Char] IO POSIXTime
forall a. IO a -> ExceptT [Char] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  Either [Char] Journal -> ExceptT [Char] IO Journal
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either [Char] Journal -> ExceptT [Char] IO Journal)
-> Either [Char] Journal -> ExceptT [Char] IO Journal
forall a b. (a -> b) -> a -> b
$
    Journal
pj{jglobalcommoditystyles=fromMaybe mempty commodity_styles_}
      Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
&   POSIXTime -> Journal -> Journal
journalSetLastReadTime POSIXTime
t                       -- save the last read time
      Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
&   ([Char], Text) -> Journal -> Journal
journalAddFile ([Char]
f, Text
txt)                        -- save the main file's info
      Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
&   Journal -> Journal
journalReverse                                 -- convert all lists to the order they were parsed
      Journal -> (Journal -> Journal) -> Journal
forall a b. a -> (a -> b) -> b
&   Journal -> Journal
journalAddAccountTypes                         -- build a map of all known account types
            -- XXX does not see conversion accounts generated by journalInferEquityFromCosts below, requiring a workaround in journalCheckAccounts. Do it later ?
      Journal
-> (Journal -> Either [Char] Journal) -> Either [Char] Journal
forall a b. a -> (a -> b) -> b
&   Journal -> Either [Char] Journal
journalStyleAmounts                            -- Infer and apply commodity styles (but don't round) - should be done early
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Bool -> Maybe DateSpan -> Journal -> Journal
journalAddForecast Bool
verbose_tags_ (InputOpts -> Journal -> Maybe DateSpan
forecastPeriod InputOpts
iopts Journal
pj)   -- Add forecast transactions if enabled
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (if Bool
posting_account_tags_ then Journal -> Journal
journalPostingsAddAccountTags else Journal -> Journal
forall a. a -> a
id)     -- Propagate account tags to postings - unless printing a beancount journal
      Either [Char] Journal
-> (Journal -> Either [Char] Journal) -> Either [Char] Journal
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Bool -> Journal -> Either [Char] Journal
journalTagCostsAndEquityAndMaybeInferCosts Bool
verbose_tags_ Bool
False   -- Tag equity conversion postings and redundant costs, to help journalBalanceTransactions ignore them.
      Either [Char] Journal
-> (Journal -> Either [Char] Journal) -> Either [Char] Journal
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (if Bool
auto_ Bool -> Bool -> Bool
&& Bool -> Bool
not ([TransactionModifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TransactionModifier] -> Bool) -> [TransactionModifier] -> Bool
forall a b. (a -> b) -> a -> b
$ Journal -> [TransactionModifier]
jtxnmodifiers Journal
pj)
            then Bool -> Day -> BalancingOpts -> Journal -> Either [Char] Journal
journalAddAutoPostings Bool
verbose_tags_ Day
_ioDay BalancingOpts
balancingopts_  -- Add auto postings if enabled, and account tags if needed. Does preliminary transaction balancing.
            else Journal -> Either [Char] Journal
forall a. a -> Either [Char] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
      -- XXX how to force debug output here ?
       -- >>= Right . dbg0With (concatMap (T.unpack.showTransaction).jtxns)
       -- >>= \j -> deepseq (concatMap (T.unpack.showTransaction).jtxns $ j) (return j)
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Journal -> [Char]) -> Journal -> Journal
forall a. Show a => (a -> [Char]) -> a -> a
dbg9With ([Char] -> ShowS
lbl [Char]
"amounts after styling, forecasting, auto-posting"ShowS -> (Journal -> [Char]) -> Journal -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Journal -> [Char]
showJournalAmountsDebug)
      Either [Char] Journal
-> (Journal -> Either [Char] Journal) -> Either [Char] Journal
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Journal
j -> if Bool
checkordereddates then Journal -> Either [Char] ()
journalCheckOrdereddates Journal
j Either [Char] () -> Journal -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Journal
j else Journal -> Either [Char] Journal
forall a b. b -> Either a b
Right Journal
j)  -- check ordereddates before assertions. The outer parentheses are needed.
      Either [Char] Journal
-> (Journal -> Either [Char] Journal) -> Either [Char] Journal
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
balancingopts_{ignore_assertions_=not checkassertions}  -- infer balance assignments and missing amounts, and maybe check balance assertions.
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Journal -> [Char]) -> Journal -> Journal
forall a. Show a => (a -> [Char]) -> a -> a
dbg9With ([Char] -> ShowS
lbl [Char]
"amounts after transaction-balancing"ShowS -> (Journal -> [Char]) -> Journal -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Journal -> [Char]
showJournalAmountsDebug)
      -- <&> dbg9With (("journalFinalise amounts after styling, forecasting, auto postings, transaction balancing"<>).showJournalAmountsDebug)
      Either [Char] Journal
-> (Journal -> Either [Char] Journal) -> Either [Char] Journal
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Journal -> Either [Char] Journal
journalInferCommodityStyles                    -- infer commodity styles once more now that all posting amounts are present
      -- >>= Right . dbg0With (pshow.journalCommodityStyles)
      Either [Char] Journal
-> (Journal -> Either [Char] Journal) -> Either [Char] Journal
forall a b.
Either [Char] a -> (a -> Either [Char] b) -> Either [Char] b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (if Bool
infer_costs_  then Bool -> Bool -> Journal -> Either [Char] Journal
journalTagCostsAndEquityAndMaybeInferCosts Bool
verbose_tags_ Bool
True else Journal -> Either [Char] Journal
forall a. a -> Either [Char] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)  -- With --infer-costs, infer costs from equity postings where possible
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (if Bool
infer_equity_ then Bool -> Journal -> Journal
journalInferEquityFromCosts Bool
verbose_tags_ else Journal -> Journal
forall a. a -> a
id)          -- With --infer-equity, infer equity postings from costs where possible
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Journal -> [Char]) -> Journal -> Journal
forall a. Show a => (a -> [Char]) -> a -> a
dbg9With ([Char] -> ShowS
lbl [Char]
"amounts after equity-inferring"ShowS -> (Journal -> [Char]) -> Journal -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Journal -> [Char]
showJournalAmountsDebug)
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalInferMarketPricesFromTransactions       -- infer market prices from commodity-exchanging transactions
      -- <&> traceOrLogAt 6 fname  -- debug logging
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Char] -> Journal -> Journal
dbgJournalAcctDeclOrder ([Char]
fname [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
": acct decls           : ")
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Journal -> Journal
journalRenumberAccountDeclarations
      Either [Char] Journal
-> (Journal -> Journal) -> Either [Char] Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Char] -> Journal -> Journal
dbgJournalAcctDeclOrder ([Char]
fname [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
": acct decls renumbered: ")

-- | Apply any auto posting rules to generate extra postings on this journal's transactions.
-- With a true first argument, adds visible tags to generated postings and modified transactions.
journalAddAutoPostings :: Bool -> Day -> BalancingOpts -> Journal -> Either String Journal
journalAddAutoPostings :: Bool -> Day -> BalancingOpts -> Journal -> Either [Char] Journal
journalAddAutoPostings Bool
verbosetags Day
d BalancingOpts
bopts =
    -- Balance all transactions without checking balance assertions,
    BalancingOpts -> Journal -> Either [Char] Journal
journalBalanceTransactions BalancingOpts
bopts{ignore_assertions_=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.)
    (Journal -> Either [Char] Journal)
-> (Journal -> Either [Char] Journal)
-> Journal
-> Either [Char] Journal
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Bool -> Day -> Journal -> Either [Char] Journal
journalModifyTransactions Bool
verbosetags 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 :: Bool -> Maybe DateSpan -> Journal -> Journal
journalAddForecast :: Bool -> Maybe DateSpan -> Journal -> Journal
journalAddForecast Bool
_ Maybe DateSpan
Nothing Journal
j = Journal
j
journalAddForecast Bool
verbosetags (Just DateSpan
forecastspan) Journal
j = Journal
j{jtxns = jtxns j ++ forecasttxns}
  where
    {-# HLINT ignore "Move concatMap out" #-}
    forecasttxns :: [Transaction]
forecasttxns =
        (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map (Transaction -> Transaction
txnTieKnot (Transaction -> Transaction)
-> (Transaction -> Transaction) -> Transaction -> Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Posting -> Posting) -> Transaction -> Transaction
transactionTransformPostings (Map Text AmountStyle -> Posting -> Posting
forall a. HasAmounts a => Map Text AmountStyle -> a -> a
styleAmounts (Map Text AmountStyle -> Posting -> Posting)
-> Map Text AmountStyle -> Posting -> Posting
forall a b. (a -> b) -> a -> b
$ Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j))
      ([Transaction] -> [Transaction])
-> ([PeriodicTransaction] -> [Transaction])
-> [PeriodicTransaction]
-> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter (DateSpan -> Day -> Bool
spanContainsDate DateSpan
forecastspan (Day -> Bool) -> (Transaction -> Day) -> Transaction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Day
tdate)
      ([Transaction] -> [Transaction])
-> ([PeriodicTransaction] -> [Transaction])
-> [PeriodicTransaction]
-> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeriodicTransaction -> [Transaction])
-> [PeriodicTransaction] -> [Transaction]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\PeriodicTransaction
pt -> Bool -> PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction Bool
verbosetags PeriodicTransaction
pt DateSpan
forecastspan)
      ([PeriodicTransaction] -> [Transaction])
-> [PeriodicTransaction] -> [Transaction]
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 = (Journal -> Journal)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jparsedefaultyear=Just y})

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

dp :: String -> TextParser m ()
dp :: forall (m :: * -> *). [Char] -> TextParser m ()
dp = TextParser m () -> [Char] -> TextParser m ()
forall a b. a -> b -> a
const (TextParser m () -> [Char] -> TextParser m ())
-> TextParser m () -> [Char] -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ () -> TextParser m ()
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- no-op
-- dp = dbgparse 1  -- trace parse state at this --debug level

-- | 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 :: Maybe Char
jparsedecimalmark :: Journal -> Maybe Char
jparsedecimalmark} <- StateT Journal (ParsecT HledgerParseErrorData Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
  let mdecmarkStyle :: Maybe AmountStyle
mdecmarkStyle = (\Char
c -> AmountStyle -> Maybe AmountStyle
forall a. a -> Maybe a
Just (AmountStyle -> Maybe AmountStyle)
-> AmountStyle -> Maybe AmountStyle
forall a b. (a -> b) -> a -> b
$ AmountStyle
amountstyle{asdecimalmark=Just c}) (Char -> Maybe AmountStyle) -> Maybe Char -> Maybe AmountStyle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Char
jparsedecimalmark
  Maybe AmountStyle -> JournalParser m (Maybe AmountStyle)
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AmountStyle
mdecmarkStyle

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

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

-- | 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 = ((Text, AmountStyle) -> AmountStyle)
-> Maybe (Text, AmountStyle) -> Maybe AmountStyle
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, AmountStyle) -> AmountStyle
forall a b. (a, b) -> b
snd (Maybe (Text, AmountStyle) -> Maybe AmountStyle)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Maybe (Text, AmountStyle))
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe AmountStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  Journal
  (ParsecT HledgerParseErrorData Text m)
  (Maybe (Text, AmountStyle))
forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle

-- | 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
jdeclaredcommodities :: Map Text Commodity
jdeclaredcommodities :: Journal -> Map Text Commodity
jdeclaredcommodities} <- StateT Journal (ParsecT HledgerParseErrorData Text m) Journal
forall s (m :: * -> *). MonadState s m => m s
get
  let mspecificStyle :: Maybe AmountStyle
mspecificStyle = Text -> Map Text Commodity -> Maybe Commodity
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
commodity Map Text Commodity
jdeclaredcommodities Maybe Commodity
-> (Commodity -> Maybe AmountStyle) -> Maybe AmountStyle
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Commodity -> Maybe AmountStyle
cformat
  Maybe AmountStyle
mdefaultStyle <- ((Text, AmountStyle) -> AmountStyle)
-> Maybe (Text, AmountStyle) -> Maybe AmountStyle
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, AmountStyle) -> AmountStyle
forall a b. (a, b) -> b
snd (Maybe (Text, AmountStyle) -> Maybe AmountStyle)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Maybe (Text, AmountStyle))
-> JournalParser m (Maybe AmountStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  Journal
  (ParsecT HledgerParseErrorData Text m)
  (Maybe (Text, AmountStyle))
forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle
  Maybe AmountStyle -> JournalParser m (Maybe AmountStyle)
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AmountStyle -> JournalParser m (Maybe AmountStyle))
-> Maybe AmountStyle -> JournalParser m (Maybe AmountStyle)
forall a b. (a -> b) -> a -> b
$ [AmountStyle] -> Maybe AmountStyle
forall a. [a] -> Maybe a
listToMaybe ([AmountStyle] -> Maybe AmountStyle)
-> [AmountStyle] -> Maybe AmountStyle
forall a b. (a -> b) -> a -> b
$ [Maybe AmountStyle] -> [AmountStyle]
forall a. [Maybe a] -> [a]
catMaybes [Maybe AmountStyle
mspecificStyle, Maybe AmountStyle
mdefaultStyle]

addDeclaredAccountTags :: AccountName -> [Tag] -> JournalParser m ()
addDeclaredAccountTags :: forall (m :: * -> *). Text -> [Tag] -> JournalParser m ()
addDeclaredAccountTags Text
acct [Tag]
atags =
  (Journal -> Journal)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (\Journal
j -> Journal
j{jdeclaredaccounttags = M.insertWith (flip union) acct atags (jdeclaredaccounttags j)})

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

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

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

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

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

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

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

-- 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=fs++[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') <- TextParser m a
-> ParsecT HledgerParseErrorData Text m (Tokens Text, a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match TextParser m a
p
  (Text, a) -> TextParser m (Text, a)
forall a. a -> ParsecT HledgerParseErrorData Text m a
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 =
  [TextParser m Status] -> TextParser m Status
forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice'
    [ ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Char
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*' ParsecT HledgerParseErrorData Text m Char
-> TextParser m Status -> TextParser m Status
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Status -> TextParser m Status
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Cleared
    , ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Char
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'!' ParsecT HledgerParseErrorData Text m Char
-> TextParser m Status -> TextParser m Status
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Status -> TextParser m Status
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Pending
    , Status -> TextParser m Status
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Unmarked
    ]

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

--- *** 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 <- JournalParser m (Maybe Integer)
forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
  ParsecT HledgerParseErrorData Text m Day -> JournalParser m Day
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m Day -> JournalParser m Day)
-> ParsecT HledgerParseErrorData Text m Day -> JournalParser m Day
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> ParsecT HledgerParseErrorData Text m Day
forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear

datep' :: Maybe Year -> TextParser m Day
datep' :: forall (m :: * -> *). Maybe Integer -> TextParser m Day
datep' Maybe Integer
mYear = do
    Int
startOffset <- ParsecT HledgerParseErrorData Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Either Integer Int
d1 <- TextParser m (Either Integer Int)
forall (m :: * -> *). TextParser m (Either Integer Int)
yearorintp TextParser m (Either Integer Int)
-> [Char] -> TextParser m (Either Integer Int)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"year or month"
    Char
sep <- TextParser m Char
forall (m :: * -> *). TextParser m Char
datesepchar TextParser m Char -> [Char] -> TextParser m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"date separator"
    Int
d2 <- ParsecT HledgerParseErrorData Text m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT HledgerParseErrorData Text m Int
-> [Char] -> ParsecT HledgerParseErrorData Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"month or day"
    case Either Integer Int
d1 of
      Left Integer
y  -> Int
-> Integer
-> Char
-> Int
-> ParsecT HledgerParseErrorData Text m Day
forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
y Char
sep Int
d2
      Right Int
m -> Int
-> Maybe Integer
-> Int
-> Int
-> ParsecT HledgerParseErrorData Text m Day
forall (m :: * -> *).
Int -> Maybe Integer -> Int -> Int -> TextParser m Day
partialDate Int
startOffset Maybe Integer
mYear Int
m Int
d2
    ParsecT HledgerParseErrorData Text m Day
-> [Char] -> ParsecT HledgerParseErrorData Text m Day
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"full or partial date"
  where
    fullDate :: Int -> Year -> Char -> Month -> TextParser m Day
    fullDate :: forall (m :: * -> *).
Int -> Integer -> Char -> Int -> TextParser m Day
fullDate Int
startOffset Integer
year Char
sep Int
month = do
      Char
sep2 <- (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isDateSepChar ParsecT HledgerParseErrorData Text m Char
-> [Char] -> ParsecT HledgerParseErrorData Text m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"date separator"
      Int
day <- ParsecT HledgerParseErrorData Text m Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT HledgerParseErrorData Text m Int
-> [Char] -> ParsecT HledgerParseErrorData Text m Int
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"day"
      Int
endOffset <- ParsecT HledgerParseErrorData Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      Bool
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
sep Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
sep2) (ParsecT HledgerParseErrorData Text m ()
 -> ParsecT HledgerParseErrorData Text m ())
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a b. (a -> b) -> a -> b
$ 
        HledgerParseErrorData -> ParsecT HledgerParseErrorData Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData -> ParsecT HledgerParseErrorData Text m ())
-> HledgerParseErrorData -> ParsecT HledgerParseErrorData Text m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset ([Char] -> HledgerParseErrorData)
-> [Char] -> HledgerParseErrorData
forall a b. (a -> b) -> a -> b
$
          [Char]
"This date has different separators, please use consistent separators."
      case Integer -> Int -> Int -> Maybe Day
fromGregorianValid Integer
year Int
month Int
day of
        Maybe Day
Nothing -> 
          HledgerParseErrorData -> TextParser m Day
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData -> TextParser m Day)
-> HledgerParseErrorData -> TextParser m Day
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset ([Char] -> HledgerParseErrorData)
-> [Char] -> HledgerParseErrorData
forall a b. (a -> b) -> a -> b
$
            [Char]
"This is not a valid date, please fix it."
        Just Day
date -> Day -> TextParser m Day
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> TextParser m Day) -> Day -> TextParser m Day
forall a b. (a -> b) -> a -> b
$! Day
date

    partialDate :: Int -> Maybe Year -> Month -> MonthDay -> TextParser m Day
    partialDate :: forall (m :: * -> *).
Int -> Maybe Integer -> Int -> Int -> TextParser m Day
partialDate Int
startOffset Maybe Integer
myr Int
month Int
day = do
      Int
endOffset <- ParsecT HledgerParseErrorData Text m Int
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 -> 
              HledgerParseErrorData -> TextParser m Day
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData -> TextParser m Day)
-> HledgerParseErrorData -> TextParser m Day
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset ([Char] -> HledgerParseErrorData)
-> [Char] -> HledgerParseErrorData
forall a b. (a -> b) -> a -> b
$
                [Char]
"This is not a valid date, please fix it."
            Just Day
date -> Day -> TextParser m Day
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Day -> TextParser m Day) -> Day -> TextParser m Day
forall a b. (a -> b) -> a -> b
$! Day
date

        Maybe Integer
Nothing ->
          HledgerParseErrorData -> TextParser m Day
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData -> TextParser m Day)
-> HledgerParseErrorData -> TextParser m Day
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Char] -> HledgerParseErrorData
parseErrorAtRegion Int
startOffset Int
endOffset ([Char] -> HledgerParseErrorData)
-> [Char] -> HledgerParseErrorData
forall a b. (a -> b) -> a -> b
$
            [Char]
"This partial date can not be parsed because the current year is unknown.\n"
            [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"Please make it a full date, or add a default year directive."

{-# 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 <- JournalParser m (Maybe Integer)
forall (m :: * -> *). JournalParser m (Maybe Integer)
getYear
  ParsecT HledgerParseErrorData Text m LocalTime
-> JournalParser m LocalTime
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m LocalTime
 -> JournalParser m LocalTime)
-> ParsecT HledgerParseErrorData Text m LocalTime
-> JournalParser m LocalTime
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> ParsecT HledgerParseErrorData Text m LocalTime
forall (m :: * -> *). Maybe Integer -> TextParser m LocalTime
datetimep' Maybe Integer
mYear

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

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

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

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

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

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

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

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

-- | 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 <- Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"digit") Char -> Bool
Token Text -> Bool
isDigit
    let n :: Integer
n = Text -> Integer
readDecimal Text
yearOrMonth
    Either Integer Int -> TextParser m (Either Integer Int)
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Integer Int -> TextParser m (Either Integer Int))
-> Either Integer Int -> TextParser m (Either Integer Int)
forall a b. (a -> b) -> a -> b
$ if Text -> Int
T.length Text
yearOrMonth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 then Integer -> Either Integer Int
forall a b. a -> Either a b
Left Integer
n else Int -> Either Integer Int
forall a b. b -> Either a b
Right (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)

--- *** 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  <- JournalParser m Text
forall (m :: * -> *). JournalParser m Text
getParentAccount
  [AccountAlias]
als     <- StateT
  Journal (ParsecT HledgerParseErrorData Text m) [AccountAlias]
forall (m :: * -> *). MonadState Journal m => m [AccountAlias]
getAccountAliases
  -- off1    <- getOffset
  Text
a       <- ParsecT HledgerParseErrorData Text m Text -> JournalParser m Text
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
accountnamep
  -- off2    <- getOffset
  -- XXX or accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function)
  case [AccountAlias] -> Text -> Either [Char] Text
accountNameApplyAliases [AccountAlias]
als (Text -> Either [Char] Text) -> Text -> Either [Char] Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
joinAccountNames Text
parent Text
a of
    Right Text
a' -> Text -> JournalParser m Text
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> JournalParser m Text) -> Text -> JournalParser m Text
forall a b. (a -> b) -> a -> b
$! Text
a'
    -- 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   -> [Char] -> JournalParser m Text
forall {a}. [Char] -> a
error' [Char]
err  -- PARTIAL:
      where
        err :: [Char]
err = [Char]
"problem in account alias applied to "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Text -> [Char]
T.unpack Text
a[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
": "[Char] -> ShowS
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 = TextParser m Text
forall (m :: * -> *). TextParser m Text
singlespacedtext1p

-- | Parse a single line of possibly empty text enclosed in double quotes.
doublequotedtextp :: TextParser m Text
doublequotedtextp :: forall (m :: * -> *). TextParser m Text
doublequotedtextp = ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"') (ParsecT HledgerParseErrorData Text m Text
 -> ParsecT HledgerParseErrorData Text m Text)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a b. (a -> b) -> a -> b
$
  Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing ((Token Text -> Bool)
 -> ParsecT HledgerParseErrorData Text m (Tokens Text))
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isNewline Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'

-- | 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 = Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSameLineCommentStart Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isNewline Char
Token Text
c)

-- | 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 = Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isSameLineCommentStart Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isNewline Char
Token Text
c)

-- | 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 = (Char -> Bool) -> TextParser m Text
forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p (Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | 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 = (Char -> Bool) -> TextParser m Text
forall (m :: * -> *). (Char -> Bool) -> TextParser m Text
singlespacedtextsatisfying1p (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSameLineCommentStart)

-- | 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 <- TextParser m Text
ParsecT HledgerParseErrorData Text m (Tokens Text)
partp
  [Text]
otherParts <- TextParser m Text -> ParsecT HledgerParseErrorData Text m [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (TextParser m Text -> ParsecT HledgerParseErrorData Text m [Text])
-> TextParser m Text -> ParsecT HledgerParseErrorData Text m [Text]
forall a b. (a -> b) -> a -> b
$ TextParser m Text -> TextParser m Text
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (TextParser m Text -> TextParser m Text)
-> TextParser m Text -> TextParser m Text
forall a b. (a -> b) -> a -> b
$ TextParser m ()
forall (m :: * -> *). TextParser m ()
singlespacep TextParser m () -> TextParser m Text -> TextParser m Text
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TextParser m Text
ParsecT HledgerParseErrorData Text m (Tokens Text)
partp
  Text -> TextParser m Text
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> TextParser m Text) -> Text -> TextParser m Text
forall a b. (a -> b) -> a -> b
$! [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
firstPart Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
otherParts
  where
    partp :: ParsecT HledgerParseErrorData Text m (Tokens Text)
partp = Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
f Char
Token Text
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
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 = ParsecT HledgerParseErrorData Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m ()
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT HledgerParseErrorData Text m Char
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT HledgerParseErrorData s m Char
spacenonewline

--- *** amounts

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

-- | Parse a single-commodity amount, applying the default commodity if there is no commodity symbol;
-- optionally followed by, in any order:
-- a Ledger-style cost, Ledger-style valuation expression, and/or Ledger-style cost basis, which is one or more of
-- lot cost, lot date, and/or lot note (we loosely call this triple the lot's cost basis).
-- The cost basis makes it a lot rather than just an amount. Both cost basis info and valuation expression
-- are discarded for now.
-- The main amount's sign is significant; here are the possibilities and their interpretation.
-- Also imagine an optional VALUATIONEXPR added to any of these (omitted for clarity):
-- @
--
--   AMT                         -- acquiring an amount
--   AMT COST                    -- acquiring an amount at some cost
--   AMT COST COSTBASIS          -- acquiring a lot at some cost, saving its cost basis
--   AMT COSTBASIS COST          -- like the above
--   AMT COSTBASIS               -- like the above with cost same as the cost basis
--
--  -AMT                         -- releasing an amount
--  -AMT SELLPRICE               -- releasing an amount at some selling price
--  -AMT SELLPRICE COSTBASISSEL  -- releasing a lot at some selling price, selecting it by its cost basis
--  -AMT COSTBASISSEL SELLPRICE  -- like the above
--  -AMT COSTBASISSEL            -- like the above with selling price same as the selected lot's cost basis amount
--
-- COST/SELLPRICE can be @ UNITAMT, @@ TOTALAMT, (@) UNITAMT, or (@@) TOTALAMT. The () are ignored.
-- COSTBASIS    is one or more of {LOTCOST}, [LOTDATE], (LOTNOTE), in any order, with LOTCOST defaulting to COST.
-- COSTBASISSEL is one or more of {LOTCOST}, [LOTDATE], (LOTNOTE), in any order.
-- {LOTCOST} can be {UNITAMT}, {{TOTALAMT}}, {=UNITAMT}, or {{=TOTALAMT}}. The = is ignored.
-- VALUATIONEXPR can be ((VALUE AMOUNT)) or ((VALUE FUNCTION)).
--
-- @
-- Ledger amount syntax is really complex.
-- Rule of thumb: curly braces, parentheses, and/or square brackets
-- in an amount means a Ledger-style cost basis is involved.
--
-- To parse an amount's numeric quantity 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.
--    (This means we handle files with any supported decimal mark without configuration,
--    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 = Bool -> JournalParser m Amount
forall (m :: * -> *). Bool -> JournalParser m Amount
amountp' Bool
False

-- An amount with optional cost, valuation, and/or cost basis, as described above.
-- A flag indicates whether we are parsing a multiplier amount;
-- if not, a commodity-less amount will have the default commodity applied to it.
amountp' :: Bool -> JournalParser m Amount
amountp' :: forall (m :: * -> *). Bool -> JournalParser m Amount
amountp' Bool
mult =
  -- dbg "amountp'" $ 
  [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a.
[Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" (StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a b. (a -> b) -> a -> b
$ do
  let spaces :: StateT Journal (ParsecT HledgerParseErrorData Text m) ()
spaces = ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Amount
amt <- Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall (m :: * -> *). Bool -> JournalParser m Amount
simpleamountp Bool
mult StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces
  (Maybe AmountCost
mcost, Maybe ()
_valuationexpr, Maybe ()
_mlotcost, Maybe ()
_mlotdate, Maybe ()
_mlotnote) <- Permutation
  (StateT Journal (ParsecT HledgerParseErrorData Text m))
  (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ())
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ())
forall (m :: * -> *) a. Alternative m => Permutation m a -> m a
runPermutation (Permutation
   (StateT Journal (ParsecT HledgerParseErrorData Text m))
   (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ())
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text m)
      (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m))
     (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ())
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ())
forall a b. (a -> b) -> a -> b
$
    -- costp, valuationexprp, lotnotep all parse things beginning with parenthesis, try needed
    (,,,,) (Maybe AmountCost
 -> Maybe ()
 -> Maybe ()
 -> Maybe ()
 -> Maybe ()
 -> (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m))
     (Maybe AmountCost)
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m))
     (Maybe ()
      -> Maybe ()
      -> Maybe ()
      -> Maybe ()
      -> (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AmountCost
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe AmountCost)
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m))
     (Maybe AmountCost)
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Maybe AmountCost
forall a. Maybe a
Nothing (AmountCost -> Maybe AmountCost
forall a. a -> Maybe a
Just (AmountCost -> Maybe AmountCost)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe AmountCost)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
forall (m :: * -> *). Amount -> JournalParser m AmountCost
costp Amount
amt) StateT
  Journal (ParsecT HledgerParseErrorData Text m) (Maybe AmountCost)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe AmountCost)
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces)
          Permutation
  (StateT Journal (ParsecT HledgerParseErrorData Text m))
  (Maybe ()
   -> Maybe ()
   -> Maybe ()
   -> Maybe ()
   -> (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) (Maybe ())
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m))
     (Maybe ()
      -> Maybe ()
      -> Maybe ()
      -> (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
forall a b.
Permutation
  (StateT Journal (ParsecT HledgerParseErrorData Text m)) (a -> b)
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) a
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) (Maybe ())
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Maybe ()
forall a. Maybe a
Nothing (() -> Maybe ()
forall a. a -> Maybe a
Just (() -> Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
valuationexprp StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces)  -- XXX no try needed here ?
          Permutation
  (StateT Journal (ParsecT HledgerParseErrorData Text m))
  (Maybe ()
   -> Maybe ()
   -> Maybe ()
   -> (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) (Maybe ())
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m))
     (Maybe ()
      -> Maybe ()
      -> (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
forall a b.
Permutation
  (StateT Journal (ParsecT HledgerParseErrorData Text m)) (a -> b)
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) a
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) (Maybe ())
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Maybe ()
forall a. Maybe a
Nothing (() -> Maybe ()
forall a. a -> Maybe a
Just (() -> Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
lotcostp StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces)
          Permutation
  (StateT Journal (ParsecT HledgerParseErrorData Text m))
  (Maybe ()
   -> Maybe ()
   -> (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) (Maybe ())
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m))
     (Maybe ()
      -> (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
forall a b.
Permutation
  (StateT Journal (ParsecT HledgerParseErrorData Text m)) (a -> b)
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) a
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) (Maybe ())
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Maybe ()
forall a. Maybe a
Nothing (() -> Maybe ()
forall a. a -> Maybe a
Just (() -> Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
lotdatep StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces)
          Permutation
  (StateT Journal (ParsecT HledgerParseErrorData Text m))
  (Maybe ()
   -> (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ()))
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) (Maybe ())
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m))
     (Maybe AmountCost, Maybe (), Maybe (), Maybe (), Maybe ())
forall a b.
Permutation
  (StateT Journal (ParsecT HledgerParseErrorData Text m)) (a -> b)
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) a
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
-> Permutation
     (StateT Journal (ParsecT HledgerParseErrorData Text m)) (Maybe ())
forall (m :: * -> *) a.
Alternative m =>
a -> m a -> Permutation m a
toPermutationWithDefault Maybe ()
forall a. Maybe a
Nothing (() -> Maybe ()
forall a. a -> Maybe a
Just (() -> Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
lotnotep StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe ())
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces)
  Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Amount
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount)
-> Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a b. (a -> b) -> a -> b
$ Amount
amt { acost = mcost }

-- An amount with optional cost, but no cost basis.
amountnobasisp :: JournalParser m Amount
amountnobasisp :: forall (m :: * -> *). JournalParser m Amount
amountnobasisp =
  -- dbg "amountnobasisp" $ 
  [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a.
[Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" (StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a b. (a -> b) -> a -> b
$ do
  let spaces :: StateT Journal (ParsecT HledgerParseErrorData Text m) ()
spaces = ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Amount
amt <- Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall (m :: * -> *). Bool -> JournalParser m Amount
simpleamountp Bool
False
  StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces
  Maybe AmountCost
mprice <- StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe AmountCost)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe AmountCost))
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe AmountCost)
forall a b. (a -> b) -> a -> b
$ Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
forall (m :: * -> *). Amount -> JournalParser m AmountCost
costp Amount
amt StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *). JournalParser m ()
spaces
  Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Amount
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount)
-> Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a b. (a -> b) -> a -> b
$ Amount
amt { acost = mprice }

-- An amount with no cost or cost basis.
-- A flag indicates whether we are parsing a multiplier amount;
-- if not, a commodity-less amount will have the default commodity applied to it.
simpleamountp :: Bool -> JournalParser m Amount
simpleamountp :: forall (m :: * -> *). Bool -> JournalParser m Amount
simpleamountp Bool
mult = 
  -- dbg "simpleamountp" $
  do
  Quantity -> Quantity
sign <- ParsecT HledgerParseErrorData Text m (Quantity -> Quantity)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Quantity -> Quantity)
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m (Quantity -> Quantity)
forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
  (Quantity -> Quantity) -> JournalParser m Amount
forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
leftsymbolamountp Quantity -> Quantity
sign JournalParser m Amount
-> JournalParser m Amount -> JournalParser m Amount
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Quantity -> Quantity) -> JournalParser m Amount
forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
rightornosymbolamountp Quantity -> Quantity
sign

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

  -- An amount with commodity symbol on the right or no commodity symbol.
  -- A no-symbol amount will have the default commodity applied to it
  -- unless we are parsing a multiplier amount (*AMT).
  rightornosymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount
  rightornosymbolamountp :: forall (m :: * -> *).
(Quantity -> Quantity) -> JournalParser m Amount
rightornosymbolamountp Quantity -> Quantity
sign = [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a.
[Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"amount" (StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a b. (a -> b) -> a -> b
$ do
    Int
offBeforeNum <- StateT Journal (ParsecT HledgerParseErrorData Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Either AmbiguousNumber RawNumber
ambiguousRawNum <- ParsecT
  HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Either AmbiguousNumber RawNumber)
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT
  HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
    Maybe Integer
mExponent <- ParsecT HledgerParseErrorData Text m (Maybe Integer)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Integer)
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m (Maybe Integer)
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe Integer))
-> ParsecT HledgerParseErrorData Text m (Maybe Integer)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m Integer
-> ParsecT HledgerParseErrorData Text m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT HledgerParseErrorData Text m Integer
 -> ParsecT HledgerParseErrorData Text m (Maybe Integer))
-> ParsecT HledgerParseErrorData Text m Integer
-> ParsecT HledgerParseErrorData Text m (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m Integer
-> ParsecT HledgerParseErrorData Text m Integer
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT HledgerParseErrorData Text m Integer
forall (m :: * -> *). TextParser m Integer
exponentp
    Int
offAfterNum <- StateT Journal (ParsecT HledgerParseErrorData Text m) Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    let numRegion :: (Int, Int)
numRegion = (Int
offBeforeNum, Int
offAfterNum)
    Maybe (Bool, Text)
mSpaceAndCommodity <- ParsecT HledgerParseErrorData Text m (Maybe (Bool, Text))
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe (Bool, Text))
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT HledgerParseErrorData Text m (Maybe (Bool, Text))
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text m)
      (Maybe (Bool, Text)))
-> ParsecT HledgerParseErrorData Text m (Maybe (Bool, Text))
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe (Bool, Text))
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m (Bool, Text)
-> ParsecT HledgerParseErrorData Text m (Maybe (Bool, Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT HledgerParseErrorData Text m (Bool, Text)
 -> ParsecT HledgerParseErrorData Text m (Maybe (Bool, Text)))
-> ParsecT HledgerParseErrorData Text m (Bool, Text)
-> ParsecT HledgerParseErrorData Text m (Maybe (Bool, Text))
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m (Bool, Text)
-> ParsecT HledgerParseErrorData Text m (Bool, Text)
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT HledgerParseErrorData Text m (Bool, Text)
 -> ParsecT HledgerParseErrorData Text m (Bool, Text))
-> ParsecT HledgerParseErrorData Text m (Bool, Text)
-> ParsecT HledgerParseErrorData Text m (Bool, Text)
forall a b. (a -> b) -> a -> b
$ (,) (Bool -> Text -> (Bool, Text))
-> ParsecT HledgerParseErrorData Text m Bool
-> ParsecT HledgerParseErrorData Text m (Text -> (Bool, Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT HledgerParseErrorData Text m Bool
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m Bool
skipNonNewlineSpaces' ParsecT HledgerParseErrorData Text m (Text -> (Bool, Text))
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m (Bool, Text)
forall a b.
ParsecT HledgerParseErrorData Text m (a -> b)
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *). TextParser m Text
commoditysymbolp
    case Maybe (Bool, Text)
mSpaceAndCommodity of
      -- right symbol amount
      Just (Bool
commodityspaced, Text
c) -> do
        Maybe AmountStyle
mdecmarkStyle <- JournalParser m (Maybe AmountStyle)
forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle
        Maybe AmountStyle
mcommodityStyle <- Text -> JournalParser m (Maybe AmountStyle)
forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
c
        -- XXX amounts of this commodity in periodic transaction rules and auto posting rules ? #1461
        let msuggestedStyle :: Maybe AmountStyle
msuggestedStyle = Maybe AmountStyle
mdecmarkStyle Maybe AmountStyle -> Maybe AmountStyle -> Maybe AmountStyle
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mcommodityStyle
        (Quantity
q,AmountPrecision
prec,Maybe Char
mdec,Maybe DigitGroupStyle
mgrps) <- ParsecT
  HledgerParseErrorData
  Text
  m
  (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
   HledgerParseErrorData
   Text
   m
   (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text m)
      (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
     m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
        let s :: AmountStyle
s = AmountStyle
amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps}
        Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Amount
nullamt{acommodity=c, aquantity=sign q, astyle=s, acost=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   <- JournalParser m (Maybe AmountStyle)
forall (m :: * -> *). JournalParser m (Maybe AmountStyle)
getDecimalMarkStyle   -- a decimal-mark CSV rule
        Maybe AmountStyle
mcommodityStyle <- Text -> JournalParser m (Maybe AmountStyle)
forall (m :: * -> *). Text -> JournalParser m (Maybe AmountStyle)
getAmountStyle Text
""     -- a commodity directive for the no-symbol commodity
        Maybe AmountStyle
mdefaultStyle   <- JournalParser m (Maybe AmountStyle)
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 Maybe AmountStyle -> Maybe AmountStyle -> Maybe AmountStyle
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mcommodityStyle Maybe AmountStyle -> Maybe AmountStyle -> Maybe AmountStyle
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe AmountStyle
mdefaultStyle
        (Quantity
q,AmountPrecision
prec,Maybe Char
mdec,Maybe DigitGroupStyle
mgrps) <- ParsecT
  HledgerParseErrorData
  Text
  m
  (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ParsecT
   HledgerParseErrorData
   Text
   m
   (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
 -> StateT
      Journal
      (ParsecT HledgerParseErrorData Text m)
      (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> StateT
     Journal
     (ParsecT HledgerParseErrorData Text m)
     (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
(Int, Int)
-> Maybe AmountStyle
-> Either AmbiguousNumber RawNumber
-> Maybe Integer
-> TextParser
     m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
interpretNumber (Int, Int)
numRegion Maybe AmountStyle
msuggestedStyle Either AmbiguousNumber RawNumber
ambiguousRawNum Maybe Integer
mExponent
        -- 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 <- JournalParser m (Maybe (Text, AmountStyle))
forall (m :: * -> *). JournalParser m (Maybe (Text, AmountStyle))
getDefaultCommodityAndStyle
        let (Text
c,AmountStyle
s) = case (Bool
mult, Maybe (Text, AmountStyle)
defcs) of
              (Bool
False, Just (Text
defc,AmountStyle
defs)) -> (Text
defc, AmountStyle
defs{asprecision=max (asprecision defs) prec})
              (Bool, Maybe (Text, AmountStyle))
_ -> (Text
"", AmountStyle
amountstyle{asprecision=prec, asdecimalmark=mdec, asdigitgroups=mgrps})
        Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Amount
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Amount
nullamt{acommodity=c, aquantity=sign q, astyle=s, acost=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 = (AmbiguousNumber -> RawNumber)
-> (RawNumber -> RawNumber)
-> Either AmbiguousNumber RawNumber
-> RawNumber
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber Maybe AmountStyle
msuggestedStyle) RawNumber -> RawNumber
forall a. a -> a
id Either AmbiguousNumber RawNumber
ambiguousNum
    in  case RawNumber
-> Maybe Integer
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
          Left [Char]
errMsg -> HledgerParseErrorData
-> TextParser
     m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData
 -> TextParser
      m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle))
-> HledgerParseErrorData
-> TextParser
     m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$
                           (Int -> Int -> [Char] -> HledgerParseErrorData)
-> (Int, Int) -> [Char] -> HledgerParseErrorData
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) -> (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
-> TextParser
     m (Quantity, AmountPrecision, Maybe Char, Maybe DigitGroupStyle)
forall a. a -> ParsecT HledgerParseErrorData Text m a
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 = Parsec HledgerParseErrorData Text Amount
-> [Char] -> Text -> Either HledgerParseErrors Amount
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
runParser (StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
-> Journal -> Parsec HledgerParseErrorData Text Amount
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
forall (m :: * -> *). JournalParser m Amount
amountp StateT Journal (ParsecT HledgerParseErrorData Text Identity) Amount
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
-> StateT
     Journal (ParsecT HledgerParseErrorData Text Identity) Amount
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) b
-> StateT Journal (ParsecT HledgerParseErrorData Text Identity) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT Journal (ParsecT HledgerParseErrorData Text Identity) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
nulljournal) [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  -> [Char] -> Amount
forall {a}. [Char] -> a
error' ([Char] -> Amount) -> [Char] -> Amount
forall a b. (a -> b) -> a -> b
$ HledgerParseErrors -> [Char]
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 = (Amount -> MixedAmount)
-> Either HledgerParseErrors Amount
-> Either HledgerParseErrors MixedAmount
forall a b.
(a -> b)
-> Either HledgerParseErrors a -> Either HledgerParseErrors b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Amount -> MixedAmount
mixedAmount (Either HledgerParseErrors Amount
 -> Either HledgerParseErrors MixedAmount)
-> ([Char] -> Either HledgerParseErrors Amount)
-> [Char]
-> Either HledgerParseErrors 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 (Amount -> MixedAmount)
-> ([Char] -> Amount) -> [Char] -> 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 = ((Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT HledgerParseErrorData Text m Char
-> (a -> a) -> ParsecT HledgerParseErrorData Text m (a -> a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a -> a
forall a. Num a => a -> a
negate ParsecT HledgerParseErrorData Text m (a -> a)
-> ParsecT HledgerParseErrorData Text m (a -> a)
-> ParsecT HledgerParseErrorData Text m (a -> a)
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+' ParsecT HledgerParseErrorData Text m Char
-> (a -> a) -> ParsecT HledgerParseErrorData Text m (a -> a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a -> a
forall a. a -> a
id) ParsecT HledgerParseErrorData Text m (a -> a)
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m (a -> a)
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces) ParsecT HledgerParseErrorData Text m (a -> a)
-> ParsecT HledgerParseErrorData Text m (a -> a)
-> ParsecT HledgerParseErrorData Text m (a -> a)
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> ParsecT HledgerParseErrorData Text m (a -> a)
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id

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

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

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

-- | Ledger-style cost notation:
-- @ UNITAMT, @@ TOTALAMT, (@) UNITAMT, or (@@) TOTALAMT. The () are ignored.
costp :: Amount -> JournalParser m AmountCost
costp :: forall (m :: * -> *). Amount -> JournalParser m AmountCost
costp Amount
baseAmt =
  -- dbg "costp" $
  [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
forall a.
[Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"transaction price" (StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) AmountCost)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
forall a b. (a -> b) -> a -> b
$ do
  -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Virtual-posting-costs
  Bool
parenthesised <- Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'(' StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'@'
  Bool
totalCost <- Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'@' StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
parenthesised (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')'

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

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

  AmountCost
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AmountCost
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) AmountCost)
-> AmountCost
-> StateT Journal (ParsecT HledgerParseErrorData Text m) AmountCost
forall a b. (a -> b) -> a -> b
$ if Bool
totalCost
            then Amount -> AmountCost
TotalCost Amount
priceAmount{aquantity=amtsign * aquantity priceAmount}
            else Amount -> AmountCost
UnitCost  Amount
priceAmount

-- | A valuation function or value can be written in double parentheses after an amount.
valuationexprp :: JournalParser m ()
valuationexprp :: forall (m :: * -> *). JournalParser m ()
valuationexprp =
  -- dbg "valuationexprp" $
  [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
[Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"valuation expression" (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"(("
  Text
_ <- Text -> Text
T.strip (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) [Char])
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
forall a b. (a -> b) -> a -> b
$ [Token Text]
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
')',Char
'\n'])  -- XXX other line endings ?
  Tokens Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"))"
  () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

balanceassertionp :: JournalParser m BalanceAssertion
balanceassertionp :: forall (m :: * -> *). JournalParser m BalanceAssertion
balanceassertionp = do
  SourcePos
sourcepos <- StateT Journal (ParsecT HledgerParseErrorData Text m) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  Bool
istotal <- (Maybe Char -> Bool)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b.
(a -> b)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char))
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Char)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  Bool
isinclusive <- (Maybe Char -> Bool)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b.
(a -> b)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char))
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
forall a.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Char)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*'
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  -- this amount can have a cost, but not a cost basis.
  -- balance assertions ignore it, but balance assignments will use it
  Amount
a <- JournalParser m Amount
forall (m :: * -> *). JournalParser m Amount
amountnobasisp JournalParser m Amount -> [Char] -> JournalParser m Amount
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> [Char]
"amount (for a balance assertion or assignment)"
  BalanceAssertion -> JournalParser m BalanceAssertion
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
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 lot cost,
-- {UNITCOST} or {{TOTALCOST}} or {=FIXEDUNITCOST} or {{=FIXEDTOTALCOST}},
-- and discard it.
lotcostp :: JournalParser m ()
lotcostp :: forall (m :: * -> *). JournalParser m ()
lotcostp =
  -- dbg "lotcostp" $
  [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
[Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"ledger-style lot cost" (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ do
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{'
  Bool
doublebrace <- Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'{' StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b.
StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Bool
_fixed <- (Maybe Char -> Bool)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b.
(a -> b)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (StateT Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool)
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Bool
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
 -> StateT
      Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char))
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Amount
_a <- Bool -> JournalParser m Amount
forall (m :: * -> *). Bool -> JournalParser m Amount
simpleamountp Bool
False
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'
  Bool
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
doublebrace) (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'}'

-- Parse a Ledger-style [LOTDATE], and discard it.
lotdatep :: JournalParser m ()
lotdatep :: forall (m :: * -> *). JournalParser m ()
lotdatep =
  -- dbg "lotdatep" $
  [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
[Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"ledger-style lot date" (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ do
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'['
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Day
_d <- JournalParser m Day
forall (m :: * -> *). JournalParser m Day
datep
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']'
  () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Parse a Ledger-style (LOT NOTE), and discard it.
lotnotep :: JournalParser m ()
lotnotep :: forall (m :: * -> *). JournalParser m ()
lotnotep =
  -- dbg "lotnotep" $
  [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
[Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
-> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"ledger-style lot note" (StateT Journal (ParsecT HledgerParseErrorData Text m) ()
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) ())
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a b. (a -> b) -> a -> b
$ do
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'('
  ParsecT HledgerParseErrorData Text m ()
-> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Text
_note <- Text -> Text
stripEnd (Text -> Text) -> ([Char] -> Text) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text)
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (StateT Journal (ParsecT HledgerParseErrorData Text m) Char
 -> StateT Journal (ParsecT HledgerParseErrorData Text m) [Char])
-> StateT Journal (ParsecT HledgerParseErrorData Text m) Char
-> StateT Journal (ParsecT HledgerParseErrorData Text m) [Char]
forall a b. (a -> b) -> a -> b
$ [Token Text]
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
')',Char
'\n'])  -- XXX other line endings ?
  Token Text
-> StateT
     Journal (ParsecT HledgerParseErrorData Text m) (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')'
  () -> StateT Journal (ParsecT HledgerParseErrorData Text m) ()
forall a.
a -> StateT Journal (ParsecT HledgerParseErrorData Text m) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | 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 = [Char]
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a.
[Char]
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"number" (ParsecT
   HledgerParseErrorData
   Text
   m
   (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
 -> ParsecT
      HledgerParseErrorData
      Text
      m
      (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle))
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
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 <- TextParser m (Quantity -> Quantity)
forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp
    RawNumber
rawNum <- (AmbiguousNumber -> RawNumber)
-> (RawNumber -> RawNumber)
-> Either AmbiguousNumber RawNumber
-> RawNumber
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber Maybe AmountStyle
suggestedStyle) RawNumber -> RawNumber
forall a. a -> a
id (Either AmbiguousNumber RawNumber -> RawNumber)
-> ParsecT
     HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
-> ParsecT HledgerParseErrorData Text m RawNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
rawnumberp
    Maybe Integer
mExp <- ParsecT HledgerParseErrorData Text m Integer
-> ParsecT HledgerParseErrorData Text m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT HledgerParseErrorData Text m Integer
 -> ParsecT HledgerParseErrorData Text m (Maybe Integer))
-> ParsecT HledgerParseErrorData Text m Integer
-> ParsecT HledgerParseErrorData Text m (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m Integer
-> ParsecT HledgerParseErrorData Text m Integer
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT HledgerParseErrorData Text m Integer
 -> ParsecT HledgerParseErrorData Text m Integer)
-> ParsecT HledgerParseErrorData Text m Integer
-> ParsecT HledgerParseErrorData Text m Integer
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m Integer
forall (m :: * -> *). TextParser m Integer
exponentp
    [Char] -> Maybe AmountStyle -> Maybe AmountStyle
forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"numberp suggestedStyle" Maybe AmountStyle
suggestedStyle Maybe AmountStyle
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a b. a -> b -> b
`seq` () -> ParsecT HledgerParseErrorData Text m ()
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    case [Char]
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a. Show a => [Char] -> a -> a
dbg7 [Char]
"numberp quantity,precision,mdecimalpoint,mgrps"
           (Either [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
 -> Either
      [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle))
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a b. (a -> b) -> a -> b
$ RawNumber
-> Maybe Integer
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
fromRawNumber RawNumber
rawNum Maybe Integer
mExp of
      Left [Char]
errMsg -> [Char]
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a. [Char] -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail [Char]
errMsg
      Right (Quantity
q, Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g) -> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> ParsecT
     HledgerParseErrorData
     Text
     m
     (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Quantity -> Quantity
sign Quantity
q, Word8
p, Maybe Char
d, Maybe DigitGroupStyle
g)

exponentp :: TextParser m Integer
exponentp :: forall (m :: * -> *). TextParser m Integer
exponentp = Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char' Char
Token Text
'e' ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m (Integer -> Integer)
-> ParsecT HledgerParseErrorData Text m (Integer -> Integer)
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT HledgerParseErrorData Text m (Integer -> Integer)
forall a (m :: * -> *). Num a => TextParser m (a -> a)
signp ParsecT HledgerParseErrorData Text m (Integer -> Integer)
-> ParsecT HledgerParseErrorData Text m Integer
-> ParsecT HledgerParseErrorData Text m Integer
forall a b.
ParsecT HledgerParseErrorData Text m (a -> b)
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT HledgerParseErrorData Text m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT HledgerParseErrorData Text m Integer
-> [Char] -> ParsecT HledgerParseErrorData Text m Integer
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
_) =
    [Char]
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a b. a -> Either a b
Left [Char]
"invalid number: digit separators and exponents may not be used together"
fromRawNumber RawNumber
raw Maybe Integer
mExp = do
    (Quantity
quantity, Word8
precision) <- Integer -> DigitGrp -> DigitGrp -> Either [Char] (Quantity, Word8)
toQuantity (Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 Maybe Integer
mExp) (RawNumber -> DigitGrp
digitGroup RawNumber
raw) (RawNumber -> DigitGrp
decimalGroup RawNumber
raw)
    (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Either
     [Char] (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return (Quantity
quantity, Word8
precision, RawNumber -> Maybe Char
mDecPt RawNumber
raw, RawNumber -> Maybe DigitGroupStyle
digitGroupStyle RawNumber
raw)
  where
    toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either String (Quantity, Word8)
    toQuantity :: Integer -> DigitGrp -> DigitGrp -> Either [Char] (Quantity, Word8)
toQuantity Integer
e DigitGrp
preDecimalGrp DigitGrp
postDecimalGrp
      | Integer
precision Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0   = (Quantity, Word8) -> Either [Char] (Quantity, Word8)
forall a b. b -> Either a b
Right (Word8 -> Integer -> Quantity
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
0 (Integer
digitGrpNum Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(-Integer
precision)), Word8
0)
      | Integer
precision Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
256 = (Quantity, Word8) -> Either [Char] (Quantity, Word8)
forall a b. b -> Either a b
Right (Word8 -> Integer -> Quantity
forall i. Word8 -> i -> DecimalRaw i
Decimal Word8
precision8 Integer
digitGrpNum, Word8
precision8)
      | Bool
otherwise = [Char] -> Either [Char] (Quantity, Word8)
forall a b. a -> Either a b
Left [Char]
"invalid number: numbers with more than 255 decimal places are currently not supported"
      where
        digitGrpNum :: Integer
digitGrpNum = DigitGrp -> Integer
digitGroupNumber (DigitGrp -> Integer) -> DigitGrp -> Integer
forall a b. (a -> b) -> a -> b
$ DigitGrp
preDecimalGrp DigitGrp -> DigitGrp -> DigitGrp
forall a. Semigroup a => a -> a -> a
<> DigitGrp
postDecimalGrp
        precision :: Integer
precision   = Word -> Integer
forall a. Integral a => a -> Integer
toInteger (DigitGrp -> Word
digitGroupLength DigitGrp
postDecimalGrp) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
e
        precision8 :: Word8
precision8  = Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
precision :: Word8

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

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

disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber
disambiguateNumber Maybe AmountStyle
msuggestedStyle (AmbiguousNumber DigitGrp
grp1 Char
sep DigitGrp
grp2) =
  -- If 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
&&
     Bool -> (AmountStyle -> Bool) -> Maybe AmountStyle -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Char
sep Char -> AmountStyle -> Bool
`isValidDecimalBy`) Maybe AmountStyle
msuggestedStyle
  then DigitGrp -> Maybe (Char, DigitGrp) -> RawNumber
NoSeparators DigitGrp
grp1 ((Char, DigitGrp) -> Maybe (Char, DigitGrp)
forall a. a -> Maybe a
Just (Char
sep, DigitGrp
grp2))
  else Char -> [DigitGrp] -> Maybe (Char, DigitGrp) -> RawNumber
WithSeparators Char
sep [DigitGrp
grp1, DigitGrp
grp2] Maybe (Char, DigitGrp)
forall a. Maybe a
Nothing
  where
    isValidDecimalBy :: Char -> AmountStyle -> Bool
    isValidDecimalBy :: Char -> AmountStyle -> Bool
isValidDecimalBy Char
c = \case
      AmountStyle{asdecimalmark :: AmountStyle -> Maybe Char
asdecimalmark = Just Char
d} -> Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c
      AmountStyle{asdigitgroups :: AmountStyle -> Maybe DigitGroupStyle
asdigitgroups = Just (DigitGroups Char
g [Word8]
_)} -> Char
g Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
c
      AmountStyle{asprecision :: AmountStyle -> AmountPrecision
asprecision = Precision Word8
0} -> Bool
False
      AmountStyle
_ -> Bool
True

-- | 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 = [Char]
-> ParsecT
     HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
-> ParsecT
     HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
forall a.
[Char]
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label [Char]
"number" (ParsecT
   HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
 -> ParsecT
      HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber))
-> ParsecT
     HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
-> ParsecT
     HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
forall a b. (a -> b) -> a -> b
$ do
  Either AmbiguousNumber RawNumber
rawNumber <- (RawNumber -> Either AmbiguousNumber RawNumber)
-> ParsecT HledgerParseErrorData Text m RawNumber
-> ParsecT
     HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
forall a b.
(a -> b)
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RawNumber -> Either AmbiguousNumber RawNumber
forall a b. b -> Either a b
Right ParsecT HledgerParseErrorData Text m RawNumber
forall (m :: * -> *). TextParser m RawNumber
leadingDecimalPt ParsecT
  HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
-> ParsecT
     HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
-> ParsecT
     HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  HledgerParseErrorData Text m (Either AmbiguousNumber RawNumber)
forall (m :: * -> *).
TextParser m (Either AmbiguousNumber RawNumber)
leadingDigits

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

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

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

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

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

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

    let digitGroups :: [DigitGrp]
digitGroups = DigitGrp
grp1 DigitGrp -> [DigitGrp] -> [DigitGrp]
forall a. a -> [a] -> [a]
: DigitGrp
grp2 DigitGrp -> [DigitGrp] -> [DigitGrp]
forall a. a -> [a] -> [a]
: [DigitGrp]
grps
    (RawNumber -> Either AmbiguousNumber RawNumber)
-> ParsecT HledgerParseErrorData Text m RawNumber
-> TextParser m (Either AmbiguousNumber RawNumber)
forall a b.
(a -> b)
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RawNumber -> Either AmbiguousNumber RawNumber
forall a b. b -> Either a b
Right (Char
-> [DigitGrp] -> ParsecT HledgerParseErrorData Text m RawNumber
forall (m :: * -> *). Char -> [DigitGrp] -> TextParser m RawNumber
withDecimalPt Char
sep [DigitGrp]
digitGroups)
      TextParser m (Either AmbiguousNumber RawNumber)
-> TextParser m (Either AmbiguousNumber RawNumber)
-> TextParser m (Either AmbiguousNumber RawNumber)
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Either AmbiguousNumber RawNumber
-> TextParser m (Either AmbiguousNumber RawNumber)
forall a. a -> ParsecT HledgerParseErrorData Text m 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 <- (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Token Text -> Bool)
 -> ParsecT HledgerParseErrorData Text m (Token Text))
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Token Text)
forall a b. (a -> b) -> a -> b
$ \Token Text
c -> Char -> Bool
isDecimalMark Char
Token Text
c Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
digitSep
    DigitGrp
decDigitGrp <- DigitGrp
-> ParsecT HledgerParseErrorData Text m DigitGrp
-> ParsecT HledgerParseErrorData Text m DigitGrp
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option DigitGrp
forall a. Monoid a => a
mempty ParsecT HledgerParseErrorData Text m DigitGrp
forall (m :: * -> *). TextParser m DigitGrp
digitgroupp

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

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

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

isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar :: Char -> Bool
isDigitSeparatorChar Char
c = Char -> Bool
isDecimalMark Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigitSeparatorSpaceChar Char
c

-- | Kinds of unicode space character we accept as digit group marks.
-- See also https://en.wikipedia.org/wiki/Decimal_separator#Digit_grouping .
isDigitSeparatorSpaceChar :: Char -> Bool
isDigitSeparatorSpaceChar :: Char -> Bool
isDigitSeparatorSpaceChar Char
c =
     Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '  -- space
  Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '  -- no-break space
  Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '  -- en space
  Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '  -- em space
  Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '  -- punctuation space
  Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '  -- thin space
  Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '  -- narrow no-break space
  Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '  -- medium mathematical space

-- | 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]
(Int -> RawNumber -> ShowS)
-> (RawNumber -> [Char])
-> ([RawNumber] -> ShowS)
-> Show RawNumber
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawNumber -> ShowS
showsPrec :: Int -> RawNumber -> ShowS
$cshow :: RawNumber -> [Char]
show :: RawNumber -> [Char]
$cshowList :: [RawNumber] -> ShowS
showList :: [RawNumber] -> ShowS
Show, RawNumber -> RawNumber -> Bool
(RawNumber -> RawNumber -> Bool)
-> (RawNumber -> RawNumber -> Bool) -> Eq RawNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawNumber -> RawNumber -> Bool
== :: RawNumber -> RawNumber -> Bool
$c/= :: RawNumber -> RawNumber -> Bool
/= :: 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]
(Int -> AmbiguousNumber -> ShowS)
-> (AmbiguousNumber -> [Char])
-> ([AmbiguousNumber] -> ShowS)
-> Show AmbiguousNumber
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AmbiguousNumber -> ShowS
showsPrec :: Int -> AmbiguousNumber -> ShowS
$cshow :: AmbiguousNumber -> [Char]
show :: AmbiguousNumber -> [Char]
$cshowList :: [AmbiguousNumber] -> ShowS
showList :: [AmbiguousNumber] -> ShowS
Show, AmbiguousNumber -> AmbiguousNumber -> Bool
(AmbiguousNumber -> AmbiguousNumber -> Bool)
-> (AmbiguousNumber -> AmbiguousNumber -> Bool)
-> Eq AmbiguousNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AmbiguousNumber -> AmbiguousNumber -> Bool
== :: AmbiguousNumber -> AmbiguousNumber -> Bool
$c/= :: AmbiguousNumber -> AmbiguousNumber -> Bool
/= :: 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
(DigitGrp -> DigitGrp -> Bool)
-> (DigitGrp -> DigitGrp -> Bool) -> Eq DigitGrp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DigitGrp -> DigitGrp -> Bool
== :: DigitGrp -> DigitGrp -> Bool
$c/= :: DigitGrp -> DigitGrp -> Bool
/= :: 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]
"\"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
padding [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
numStr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
    where numStr :: [Char]
numStr = Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
n
          padding :: [Char]
padding = Integer -> Char -> [Char]
forall i a. Integral i => i -> a -> [a]
genericReplicate (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
len Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
numStr)) Char
'0'

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

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

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

--- *** comments

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

    trailingSpaces :: ParsecT HledgerParseErrorData Text m ()
trailingSpaces = ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m ()
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
    anyLine :: ParsecT HledgerParseErrorData Text m ()
anyLine = ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT HledgerParseErrorData Text m Char
 -> ParsecT HledgerParseErrorData Text m ())
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m ()
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
Token Text
'\n') ParsecT HledgerParseErrorData Text m (Tokens Text)
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Char
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
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. See also emptyorcommentlinep2.
emptyorcommentlinep :: TextParser m ()
emptyorcommentlinep :: forall (m :: * -> *). TextParser m ()
emptyorcommentlinep = do
  [Char] -> TextParser m ()
forall (m :: * -> *). [Char] -> TextParser m ()
dp [Char]
"emptyorcommentlinep"
  TextParser m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  TextParser m ()
forall (m :: * -> *). TextParser m ()
skiplinecommentp TextParser m () -> TextParser m () -> TextParser m ()
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT HledgerParseErrorData Text m Char -> TextParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  where
    skiplinecommentp :: TextParser m ()
    skiplinecommentp :: forall (m :: * -> *). TextParser m ()
skiplinecommentp = do
      (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isLineCommentStart
      ParsecT HledgerParseErrorData Text m (Tokens Text)
-> TextParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT HledgerParseErrorData Text m (Tokens Text)
 -> TextParser m ())
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
-> TextParser m ()
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\n')
      ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
      () -> TextParser m ()
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{-# INLINABLE emptyorcommentlinep #-}

-- | A newer comment line parser.
-- Parses a line which is empty, all blanks, or whose first non-blank character is one of those provided.
emptyorcommentlinep2 :: [Char] -> TextParser m ()
emptyorcommentlinep2 :: forall (m :: * -> *). [Char] -> TextParser m ()
emptyorcommentlinep2 [Char]
cs =
  [Char]
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a.
[Char]
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label ([Char]
"empty line or comment line beginning with "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
cs) (ParsecT HledgerParseErrorData Text m ()
 -> ParsecT HledgerParseErrorData Text m ())
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). [Char] -> TextParser m ()
dp [Char]
"emptyorcommentlinep2"
    ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
    ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT HledgerParseErrorData Text m (Tokens Text)
-> ParsecT HledgerParseErrorData Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT HledgerParseErrorData Text m (Tokens Text)
commentp
    where
      commentp :: ParsecT HledgerParseErrorData Text m (Tokens Text)
commentp = do
        [ParsecT HledgerParseErrorData Text m [Char]]
-> ParsecT HledgerParseErrorData Text m [Char]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((Char -> ParsecT HledgerParseErrorData Text m [Char])
-> [Char] -> [ParsecT HledgerParseErrorData Text m [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some(ParsecT HledgerParseErrorData Text m Char
 -> ParsecT HledgerParseErrorData Text m [Char])
-> (Char -> ParsecT HledgerParseErrorData Text m Char)
-> Char
-> ParsecT HledgerParseErrorData Text m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> ParsecT HledgerParseErrorData Text m Char
Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char) [Char]
cs)
        Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
Token Text
'\n') ParsecT HledgerParseErrorData Text m (Tokens Text)
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

-- | 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

-- | Parse a comment following a journal item, possibly continued on multiple lines,
-- and return the comment text.
--
-- >>> 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 =
  (Text, ()) -> Text
forall a b. (a, b) -> a
fst ((Text, ()) -> Text)
-> ParsecT HledgerParseErrorData Text m (Text, ())
-> ParsecT HledgerParseErrorData Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextParser m () -> ParsecT HledgerParseErrorData Text m (Text, ())
forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentpWith (ParsecT HledgerParseErrorData Text m (Tokens Text)
-> TextParser m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT HledgerParseErrorData Text m (Tokens Text)
 -> TextParser m ())
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
-> TextParser m ()
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\n'))  -- XXX support \r\n ?

{-# INLINABLE followingcommentp #-}

-- | Parse a following comment, possibly continued on multiple lines,
-- using the provided line parser to parse each line.
-- This returns the comment text, and the combined results from the line parser.
--
-- Following comments begin with a semicolon and extend to the end of the line.
-- They can optionally be continued on the next lines,
-- where each next line begins with an indent and another semicolon.
-- (This parser expects to see these semicolons and indents.)
--
-- Like Ledger, we sometimes allow data to be embedded in comments.
-- account directive comments and transaction comments can contain tags,
-- and posting comments can contain tags or bracketed posting dates.
-- This helper lets us handle these variations. 
-- The line parser should consume all input up until the next newline.
-- See followingcommentp for some tests.
--
followingcommentpWith :: (Monoid a, Show a) => TextParser m a -> TextParser m (Text, a)
followingcommentpWith :: forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentpWith TextParser m a
contentp = do
  ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  -- there can be 0 or 1 sameLine
  [(Text, a)]
sameLine <- ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). TextParser m ()
headerp ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m [(Text, a)]
-> ParsecT HledgerParseErrorData Text m [(Text, a)]
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (((Text, a) -> [(Text, a)] -> [(Text, a)]
forall a. a -> [a] -> [a]
:[]) ((Text, a) -> [(Text, a)])
-> TextParser m (Text, a)
-> ParsecT HledgerParseErrorData Text m [(Text, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextParser m a -> TextParser m (Text, a)
forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' TextParser m a
contentp) ParsecT HledgerParseErrorData Text m [(Text, a)]
-> ParsecT HledgerParseErrorData Text m [(Text, a)]
-> ParsecT HledgerParseErrorData Text m [(Text, a)]
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [(Text, a)] -> ParsecT HledgerParseErrorData Text m [(Text, a)]
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  ()
_ <- ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). TextParser m ()
eolof
  -- there can be 0 or more nextLines
  [(Text, a)]
nextLines <- TextParser m (Text, a)
-> ParsecT HledgerParseErrorData Text m [(Text, a)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (TextParser m (Text, a)
 -> ParsecT HledgerParseErrorData Text m [(Text, a)])
-> TextParser m (Text, a)
-> ParsecT HledgerParseErrorData Text m [(Text, a)]
forall a b. (a -> b) -> a -> b
$
    ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces1 ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). TextParser m ()
headerp) ParsecT HledgerParseErrorData Text m ()
-> TextParser m (Text, a) -> TextParser m (Text, a)
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TextParser m a -> TextParser m (Text, a)
forall (m :: * -> *) a. TextParser m a -> TextParser m (Text, a)
match' TextParser m a
contentp TextParser m (Text, a)
-> ParsecT HledgerParseErrorData Text m ()
-> TextParser m (Text, a)
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT HledgerParseErrorData Text m ()
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' | [(Text, a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, a)]
sameLine Bool -> Bool -> Bool
&& Bool -> Bool
not ([(Text, a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, a)]
nextLines) = [(Text
"",a
forall a. Monoid a => a
mempty)]
              | Bool
otherwise = [(Text, a)]
sameLine
    ([Text]
texts, [a]
contents) = [(Text, a)] -> ([Text], [a])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Text, a)] -> ([Text], [a])) -> [(Text, a)] -> ([Text], [a])
forall a b. (a -> b) -> a -> b
$ [(Text, a)]
sameLine' [(Text, a)] -> [(Text, a)] -> [(Text, a)]
forall a. [a] -> [a] -> [a]
++ [(Text, a)]
nextLines
    strippedCommentText :: Text
strippedCommentText = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip [Text]
texts
    commentContent :: a
commentContent = [a] -> a
forall a. Monoid a => [a] -> a
mconcat [a]
contents
  (Text, a) -> TextParser m (Text, a)
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
strippedCommentText, a
commentContent)

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

{-# INLINABLE followingcommentpWith #-}


-- Parse the tags from a single comment line, eg for use with followingcommentpWith.
-- XXX what part of a comment line ? leading whitespace / semicolon or not ?
commentlinetagsp :: TextParser m [Tag]
commentlinetagsp :: forall (m :: * -> *). TextParser m [Tag]
commentlinetagsp = do
  -- XXX sketchy
  Text
tagName <- ([Text] -> Text
forall a. HasCallStack => [a] -> a
last ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSpace) (Text -> Text)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  Text -> TextParser m [Tag]
forall (m :: * -> *). Text -> TextParser m [Tag]
atColon Text
tagName TextParser m [Tag] -> TextParser m [Tag] -> TextParser m [Tag]
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Tag] -> TextParser m [Tag]
forall a. a -> ParsecT HledgerParseErrorData Text m 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 = Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':' ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m [Tag]
-> ParsecT HledgerParseErrorData Text m [Tag]
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
      if Text -> Bool
T.null Text
name
        then ParsecT HledgerParseErrorData Text m [Tag]
forall (m :: * -> *). TextParser m [Tag]
commentlinetagsp
        else do
          ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
          Text
val <- TextParser m Text
forall (m :: * -> *). TextParser m Text
tagValue
          let tag :: Tag
tag = (Text
name, Text
val)
          (Tag
tagTag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
:) ([Tag] -> [Tag])
-> ParsecT HledgerParseErrorData Text m [Tag]
-> ParsecT HledgerParseErrorData Text m [Tag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT HledgerParseErrorData Text m [Tag]
forall (m :: * -> *). TextParser m [Tag]
commentlinetagsp

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

{-# INLINABLE commentlinetagsp #-}


-- | 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 = TextParser m [Tag] -> TextParser m (Text, [Tag])
forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentpWith TextParser m [Tag]
forall (m :: * -> *). TextParser m [Tag]
commentlinetagsp
{-# INLINABLE transactioncommentp #-}


-- | 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)) <-
    TextParser m ([Tag], [DateTag])
-> TextParser m (Text, ([Tag], [DateTag]))
forall a (m :: * -> *).
(Monoid a, Show a) =>
TextParser m a -> TextParser m (Text, a)
followingcommentpWith (Maybe Integer -> TextParser m ([Tag], [DateTag])
forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear)
  let mdate :: Maybe Day
mdate  = DateTag -> Day
forall a b. (a, b) -> b
snd (DateTag -> Day) -> Maybe DateTag -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DateTag -> Bool) -> [DateTag] -> Maybe DateTag
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"date") (Text -> Bool) -> (DateTag -> Text) -> DateTag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DateTag -> Text
forall a b. (a, b) -> a
fst) [DateTag]
dateTags
      mdate2 :: Maybe Day
mdate2 = DateTag -> Day
forall a b. (a, b) -> b
snd (DateTag -> Day) -> Maybe DateTag -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DateTag -> Bool) -> [DateTag] -> Maybe DateTag
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"date2")(Text -> Bool) -> (DateTag -> Text) -> DateTag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DateTag -> Text
forall a b. (a, b) -> a
fst) [DateTag]
dateTags
  (Text, [Tag], Maybe Day, Maybe Day)
-> TextParser m (Text, [Tag], Maybe Day, Maybe Day)
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
commentText, [Tag]
tags, Maybe Day
mdate, Maybe Day
mdate2)
{-# INLINABLE postingcommentp #-}


commenttagsanddatesp
  :: Maybe Year -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp :: forall (m :: * -> *).
Maybe Integer -> TextParser m ([Tag], [DateTag])
commenttagsanddatesp Maybe Integer
mYear = do
  (Text
txt, [DateTag]
dateTags) <- ParsecT HledgerParseErrorData Text m [DateTag]
-> ParsecT HledgerParseErrorData Text m (Tokens Text, [DateTag])
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match (ParsecT HledgerParseErrorData Text m [DateTag]
 -> ParsecT HledgerParseErrorData Text m (Tokens Text, [DateTag]))
-> ParsecT HledgerParseErrorData Text m [DateTag]
-> ParsecT HledgerParseErrorData Text m (Tokens Text, [DateTag])
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT HledgerParseErrorData Text m [DateTag]
forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
':'
  -- next char is either ':' or '\n' (or EOF)
  let tagName :: Text
tagName = [Text] -> Text
forall a. HasCallStack => [a] -> a
last ((Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isSpace Text
txt)
  ((([Tag], [DateTag]) -> ([Tag], [DateTag]))
-> TextParser m ([Tag], [DateTag])
-> TextParser m ([Tag], [DateTag])
forall a b.
(a -> b)
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((([Tag], [DateTag]) -> ([Tag], [DateTag]))
 -> TextParser m ([Tag], [DateTag])
 -> TextParser m ([Tag], [DateTag]))
-> (([DateTag] -> [DateTag])
    -> ([Tag], [DateTag]) -> ([Tag], [DateTag]))
-> ([DateTag] -> [DateTag])
-> TextParser m ([Tag], [DateTag])
-> TextParser m ([Tag], [DateTag])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([DateTag] -> [DateTag])
-> ([Tag], [DateTag]) -> ([Tag], [DateTag])
forall 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]
dateTags[DateTag] -> [DateTag] -> [DateTag]
forall a. [a] -> [a] -> [a]
++) (Text -> TextParser m ([Tag], [DateTag])
forall (m :: * -> *). Text -> TextParser m ([Tag], [DateTag])
atColon Text
tagName) TextParser m ([Tag], [DateTag])
-> TextParser m ([Tag], [DateTag])
-> TextParser m ([Tag], [DateTag])
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Tag], [DateTag]) -> TextParser m ([Tag], [DateTag])
forall a. a -> ParsecT HledgerParseErrorData Text m 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
      ParsecT HledgerParseErrorData Text m (Tokens Text)
-> ParsecT HledgerParseErrorData Text m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT HledgerParseErrorData Text m (Tokens Text)
 -> ParsecT HledgerParseErrorData Text m ())
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
-> ParsecT HledgerParseErrorData Text m ()
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
end Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[')
      -- if not '[' then ':' or '\n' or EOF
      TextParser m [DateTag] -> TextParser m [DateTag]
forall (m :: * -> *).
TextParser m [DateTag] -> TextParser m [DateTag]
atBracket (Char -> TextParser m [DateTag]
forall (m :: * -> *). Char -> TextParser m [DateTag]
readUpTo Char
end) TextParser m [DateTag]
-> TextParser m [DateTag] -> TextParser m [DateTag]
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [DateTag] -> TextParser m [DateTag]
forall a. a -> ParsecT HledgerParseErrorData Text m 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 <- [DateTag] -> TextParser m [DateTag] -> TextParser m [DateTag]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (TextParser m [DateTag] -> TextParser m [DateTag])
-> TextParser m [DateTag] -> TextParser m [DateTag]
forall a b. (a -> b) -> a -> b
$ TextParser m [DateTag] -> TextParser m [DateTag]
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Maybe Integer -> TextParser m [DateTag]
forall (m :: * -> *). Maybe Integer -> TextParser m [DateTag]
bracketeddatetagsp Maybe Integer
mYear)
      Char
_ <- Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'['
      [DateTag]
dateTags' <- TextParser m [DateTag]
cont
      [DateTag] -> TextParser m [DateTag]
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DateTag] -> TextParser m [DateTag])
-> [DateTag] -> TextParser m [DateTag]
forall a b. (a -> b) -> a -> b
$ [DateTag]
dateTags [DateTag] -> [DateTag] -> [DateTag]
forall a. [a] -> [a] -> [a]
++ [DateTag]
dateTags'

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

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

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

{-# INLINABLE commenttagsanddatesp #-}

-- | 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 is not a valid date...
--
-- >>> either (Left . customErrorBundlePretty) Right $ rtp (bracketeddatetagsp Nothing) "[1/31]"
-- Left ...1:2:...This partial date can not be parsed because the current year is unknown...
--
-- >>> 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"
  ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT HledgerParseErrorData Text m ()
 -> ParsecT HledgerParseErrorData Text m ())
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a b. (a -> b) -> a -> b
$ do
    Text
s <- ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead
       (ParsecT HledgerParseErrorData Text m Text
 -> ParsecT HledgerParseErrorData Text m Text)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a b. (a -> b) -> a -> b
$ ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']')
       (ParsecT HledgerParseErrorData Text m Text
 -> ParsecT HledgerParseErrorData Text m Text)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a b. (a -> b) -> a -> b
$ Maybe [Char]
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe [Char]
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isBracketedDateChar
    Bool
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
s Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDateSepChar Text
s) (ParsecT HledgerParseErrorData Text m ()
 -> ParsecT HledgerParseErrorData Text m ())
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m ()
forall a b. (a -> b) -> a -> b
$
      [Char] -> ParsecT HledgerParseErrorData Text m ()
forall a. [Char] -> ParsecT HledgerParseErrorData Text m a
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

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

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

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

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

{-# INLINABLE bracketeddatetagsp #-}

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

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

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

regexaliasp :: TextParser m AccountAlias
regexaliasp :: forall (m :: * -> *). TextParser m AccountAlias
regexaliasp = do
  -- dbgparse 0 "regexaliasp"
  (Int
off1, Int
off2, Text
re) <- ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m (Int, Int, Text)
-> ParsecT HledgerParseErrorData Text m (Int, Int, Text)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/') (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/') (ParsecT HledgerParseErrorData Text m (Int, Int, Text)
 -> ParsecT HledgerParseErrorData Text m (Int, Int, Text))
-> ParsecT HledgerParseErrorData Text m (Int, Int, Text)
-> ParsecT HledgerParseErrorData Text m (Int, Int, Text)
forall a b. (a -> b) -> a -> b
$ do
    Int
off1 <- ParsecT HledgerParseErrorData Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    Text
re <- ([Text] -> Text)
-> ParsecT HledgerParseErrorData Text m [Text]
-> ParsecT HledgerParseErrorData Text m Text
forall a b.
(a -> b)
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
T.concat (ParsecT HledgerParseErrorData Text m [Text]
 -> ParsecT HledgerParseErrorData Text m Text)
-> (ParsecT HledgerParseErrorData Text m Text
    -> ParsecT HledgerParseErrorData Text m [Text])
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT HledgerParseErrorData Text m Text
 -> ParsecT HledgerParseErrorData Text m Text)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a b. (a -> b) -> a -> b
$
             (Char -> Text
T.singleton (Char -> Text)
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token Text] -> ParsecT HledgerParseErrorData Text m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf ([Char]
"/\\\n\r" :: [Char]))               -- paranoid: don't try to read past line end
             ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Text
Tokens Text
"\\/"                                             -- allow escaping forward slashes
             ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Char -> Text -> Text)
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Char -> Text -> Text
T.cons (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\\') (Char -> Text
T.singleton (Char -> Text)
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle))  -- Otherwise leave backslashes in
    Int
off2 <- ParsecT HledgerParseErrorData Text m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
    (Int, Int, Text)
-> ParsecT HledgerParseErrorData Text m (Int, Int, Text)
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off1, Int
off2, Text
re)
  ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'='
  ParsecT HledgerParseErrorData Text m ()
forall s (m :: * -> *).
(Stream s, Token s ~ Char) =>
ParsecT HledgerParseErrorData s m ()
skipNonNewlineSpaces
  [Char]
repl <- ParsecT HledgerParseErrorData Text m Char
ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m [Char]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT HledgerParseErrorData Text m ()
forall (m :: * -> *). TextParser m ()
eolof
  case Text -> Either [Char] Regexp
toRegexCI Text
re of
    Right Regexp
r -> AccountAlias -> TextParser m AccountAlias
forall a. a -> ParsecT HledgerParseErrorData Text m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AccountAlias -> TextParser m AccountAlias)
-> AccountAlias -> TextParser m AccountAlias
forall a b. (a -> b) -> a -> b
$! Regexp -> [Char] -> AccountAlias
RegexAlias Regexp
r [Char]
repl
    Left [Char]
e  -> HledgerParseErrorData -> TextParser m AccountAlias
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (HledgerParseErrorData -> TextParser m AccountAlias)
-> HledgerParseErrorData -> TextParser m AccountAlias
forall a b. (a -> b) -> a -> b
$! Int -> Int -> [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"                  (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
-> Text -> Amount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
forall (m :: * -> *). JournalParser m Amount
amountp Text
"$47.18"     (Quantity -> Amount
usd Quantity
47.18)
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"ends with decimal mark" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
-> Text -> Amount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
forall (m :: * -> *). JournalParser m Amount
amountp Text
"$1."        (Quantity -> Amount
usd Quantity
1  Amount -> AmountPrecision -> Amount
`withPrecision` Word8 -> AmountPrecision
Precision Word8
0)
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"unit price"             (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
-> Text -> Amount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 @ €0.5"
      -- not precise enough:
      -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalmark=Just '.'
      Amount
nullamt{
         acommodity="$"
        ,aquantity=10 -- need to test internal precision with roundTo ? I think not
        ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing}
        ,acost=Just $ UnitCost $
          nullamt{
             acommodity="€"
            ,aquantity=0.5
            ,astyle=amountstyle{asprecision=Precision 1, asdecimalmark=Just '.'}
            }
        }
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"total price"            (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
-> Text -> Amount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 @@ €5"
      Amount
nullamt{
         acommodity="$"
        ,aquantity=10
        ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing}
        ,acost=Just $ TotalCost $
          nullamt{
             acommodity="€"
            ,aquantity=5
            ,astyle=amountstyle{asprecision=Precision 0, asdecimalmark=Nothing}
            }
        }
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"unit price, parenthesised" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 (@) €0.5"
   ,[Char] -> Assertion -> TestTree
testCase [Char]
"total price, parenthesised" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
-> Text -> Assertion
forall st a.
(HasCallStack, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> Assertion
assertParse StateT Journal (ParsecT HledgerParseErrorData Text IO) Amount
forall (m :: * -> *). JournalParser m Amount
amountp Text
"$10 (@@) €0.5"
   ]

  ,let p :: JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p = ParsecT
  HledgerParseErrorData
  Text
  IO
  (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> JournalParser
     IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *) a. Monad m => m a -> StateT Journal m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Maybe AmountStyle
-> ParsecT
     HledgerParseErrorData
     Text
     IO
     (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
forall (m :: * -> *).
Maybe AmountStyle
-> TextParser
     m (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
numberp Maybe AmountStyle
forall a. Maybe a
Nothing) :: JournalParser IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) in
   [Char] -> Assertion -> TestTree
testCase [Char]
"numberp" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"0"          (Quantity
0, Word8
0, Maybe Char
forall a. Maybe a
Nothing, Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1"          (Quantity
1, Word8
0, Maybe Char
forall a. Maybe a
Nothing, Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT 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, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT 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, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (DigitGroupStyle -> Maybe DigitGroupStyle)
-> DigitGroupStyle -> Maybe DigitGroupStyle
forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3])
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT 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, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',', DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (DigitGroupStyle -> Maybe DigitGroupStyle)
-> DigitGroupStyle -> Maybe DigitGroupStyle
forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
'.' [Word8
3,Word8
2])
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT 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, Maybe Char
forall a. Maybe a
Nothing, DigitGroupStyle -> Maybe DigitGroupStyle
forall a. a -> Maybe a
Just (DigitGroupStyle -> Maybe DigitGroupStyle)
-> DigitGroupStyle -> Maybe DigitGroupStyle
forall a b. (a -> b) -> a -> b
$ Char -> [Word8] -> DigitGroupStyle
DigitGroups Char
',' [Word8
3,Word8
3])  -- could be simplified to [3]
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1."         (Quantity
1, Word8
0, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
"1,"         (Quantity
1, Word8
0, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
".1"         (Quantity
0.1, Word8
1, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
p Text
",1"         (Quantity
0.1, Word8
1, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
',', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text -> [Char] -> Assertion
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]
""
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text -> [Char] -> Assertion
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]
""
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text -> [Char] -> Assertion
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]
""
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text -> [Char] -> Assertion
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]
""
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text -> [Char] -> Assertion
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]
""
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text -> [Char] -> Assertion
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]
""
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text -> [Char] -> Assertion
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]
""
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text -> [Char] -> Assertion
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]
""
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text
-> (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT 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, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'.', Maybe DigitGroupStyle
forall a. Maybe a
Nothing)
     JournalParser
  IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle)
-> Text -> [Char] -> Assertion
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" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) MixedAmount
-> Text -> MixedAmount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) MixedAmount
forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp Text
" $47.18" (Amount -> MixedAmount
mixedAmount (Amount -> MixedAmount) -> Amount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount
usd Quantity
47.18)
    ,[Char] -> Assertion -> TestTree
testCase [Char]
"empty string" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ StateT Journal (ParsecT HledgerParseErrorData Text IO) MixedAmount
-> Text -> MixedAmount -> Assertion
forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT HledgerParseErrorData Text IO) a
-> Text -> a -> Assertion
assertParseEq StateT Journal (ParsecT HledgerParseErrorData Text IO) MixedAmount
forall (m :: * -> *). JournalParser m MixedAmount
spaceandamountormissingp Text
"" MixedAmount
missingmixedamt
    -- ,testCase "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt  -- XXX should it ?
    -- ,testCase "just amount" $ assertParseError spaceandamountormissingp "$47.18" ""  -- succeeds, consuming nothing
    ]

  ]