From b034fa7ca90428899039e9ea7021e12f4bafbec1 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Tue, 5 Jun 2018 23:52:28 -0600 Subject: [PATCH] lib: weaken parser types --- hledger-lib/Hledger/Read/Common.hs | 20 +++++++-------- hledger-lib/Hledger/Read/JournalReader.hs | 30 +++++++++++------------ 2 files changed, 25 insertions(+), 25 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index f2b1dcf6a..c646a485f 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -334,7 +334,7 @@ codep = option "" $ try $ do skipSome spacenonewline between (char '(') (char ')') $ takeWhileP Nothing (/= ')') -descriptionp :: JournalParser m Text +descriptionp :: TextParser m Text descriptionp = takeWhileP Nothing (not . semicolonOrNewline) where semicolonOrNewline c = c == ';' || c == '\n' @@ -457,7 +457,7 @@ accountnamep = do -- | Parse whitespace then an amount, with an optional left or right -- currency symbol and optional price, or return the special -- "missing" marker amount. -spaceandamountormissingp :: Monad m => JournalParser m MixedAmount +spaceandamountormissingp :: JournalParser m MixedAmount spaceandamountormissingp = option missingmixedamt $ try $ do lift $ skipSome spacenonewline @@ -480,13 +480,13 @@ test_spaceandamountormissingp = do -- | Parse a single-commodity amount, with optional symbol on the left or -- right, optional unit or total price, and optional (ignored) -- ledger-style balance assertion or fixed lot price declaration. -amountp :: Monad m => JournalParser m Amount +amountp :: JournalParser m Amount amountp = do amount <- amountwithoutpricep price <- priceamountp pure $ amount { aprice = price } -amountwithoutpricep :: Monad m => JournalParser m Amount +amountwithoutpricep :: JournalParser m Amount amountwithoutpricep = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp @@ -533,7 +533,7 @@ skipMany' p = go False then go True else pure isNull -leftsymbolamountp :: Monad m => JournalParser m Amount +leftsymbolamountp :: JournalParser m Amount leftsymbolamountp = do sign <- lift signp m <- lift multiplierp @@ -545,7 +545,7 @@ leftsymbolamountp = do return $ Amount c (sign q) NoPrice s m "left-symbol amount" -rightsymbolamountp :: Monad m => JournalParser m Amount +rightsymbolamountp :: JournalParser m Amount rightsymbolamountp = do m <- lift multiplierp sign <- lift signp @@ -564,7 +564,7 @@ rightsymbolamountp = do return $ Amount c (sign q) NoPrice s m "right-symbol amount" -nosymbolamountp :: Monad m => JournalParser m Amount +nosymbolamountp :: JournalParser m Amount nosymbolamountp = do m <- lift multiplierp suggestedStyle <- getDefaultAmountStyle @@ -589,7 +589,7 @@ quotedcommoditysymbolp = simplecommoditysymbolp :: TextParser m CommoditySymbol simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) -priceamountp :: Monad m => JournalParser m Price +priceamountp :: JournalParser m Price priceamountp = option NoPrice $ try $ do lift (skipMany spacenonewline) char '@' @@ -600,7 +600,7 @@ priceamountp = option NoPrice $ try $ do pure $ priceConstructor priceAmount -partialbalanceassertionp :: Monad m => JournalParser m BalanceAssertion +partialbalanceassertionp :: JournalParser m BalanceAssertion partialbalanceassertionp = optional $ try $ do lift (skipMany spacenonewline) sourcepos <- genericSourcePos <$> lift getPosition @@ -620,7 +620,7 @@ partialbalanceassertionp = optional $ try $ do -- <|> return Nothing -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices -fixedlotpricep :: Monad m => JournalParser m (Maybe Amount) +fixedlotpricep :: JournalParser m (Maybe Amount) fixedlotpricep = optional $ try $ do lift (skipMany spacenonewline) char '{' diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 463c50e8a..e7f078899 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -261,14 +261,14 @@ indentedlinep = lift (skipSome spacenonewline) >> (rstrip <$> lift restofline) -- >>> Right _ <- rejp commoditydirectivep "commodity $\n format $1.00" -- >>> Right _ <- rejp commoditydirectivep "commodity $\n\n" -- a commodity with no format -- >>> Right _ <- rejp commoditydirectivep "commodity $1.00\n format $1.00" -- both, what happens ? -commoditydirectivep :: Monad m => JournalParser m () +commoditydirectivep :: JournalParser m () commoditydirectivep = try commoditydirectiveonelinep <|> commoditydirectivemultilinep -- | Parse a one-line commodity directive. -- -- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00" -- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00 ; blah\n" -commoditydirectiveonelinep :: Monad m => JournalParser m () +commoditydirectiveonelinep :: JournalParser m () commoditydirectiveonelinep = do string "commodity" lift (skipSome spacenonewline) @@ -287,7 +287,7 @@ pleaseincludedecimalpoint = "to avoid ambiguity, please include a decimal point -- | Parse a multi-line commodity directive, containing 0 or more format subdirectives. -- -- >>> Right _ <- rejp commoditydirectivemultilinep "commodity $ ; blah \n format $1.00 ; blah" -commoditydirectivemultilinep :: Monad m => JournalParser m () +commoditydirectivemultilinep :: JournalParser m () commoditydirectivemultilinep = do string "commodity" lift (skipSome spacenonewline) @@ -301,7 +301,7 @@ commoditydirectivemultilinep = do -- | Parse a format (sub)directive, throwing a parse error if its -- symbol does not match the one given. -formatdirectivep :: Monad m => CommoditySymbol -> JournalParser m AmountStyle +formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle formatdirectivep expectedsym = do string "format" lift (skipSome spacenonewline) @@ -398,7 +398,7 @@ defaultyeardirectivep = do failIfInvalidYear y setYear y' -defaultcommoditydirectivep :: Monad m => JournalParser m () +defaultcommoditydirectivep :: JournalParser m () defaultcommoditydirectivep = do char 'D' "default commodity" lift (skipSome spacenonewline) @@ -409,7 +409,7 @@ defaultcommoditydirectivep = do then parseErrorAt pos pleaseincludedecimalpoint else setDefaultCommodityAndStyle (acommodity, astyle) -marketpricedirectivep :: Monad m => JournalParser m MarketPrice +marketpricedirectivep :: JournalParser m MarketPrice marketpricedirectivep = do char 'P' "market price" lift (skipMany spacenonewline) @@ -429,7 +429,7 @@ ignoredpricecommoditydirectivep = do lift restofline return () -commodityconversiondirectivep :: Monad m => JournalParser m () +commodityconversiondirectivep :: JournalParser m () commodityconversiondirectivep = do char 'C' "commodity conversion" lift (skipSome spacenonewline) @@ -443,7 +443,7 @@ commodityconversiondirectivep = do --- ** transactions -modifiertransactionp :: MonadIO m => ErroringJournalParser m ModifierTransaction +modifiertransactionp :: JournalParser m ModifierTransaction modifiertransactionp = do char '=' "modifier transaction" lift (skipMany spacenonewline) @@ -452,17 +452,17 @@ modifiertransactionp = do return $ ModifierTransaction valueexpr postings -- | Parse a periodic transaction -periodictransactionp :: MonadIO m => ErroringJournalParser m PeriodicTransaction +periodictransactionp :: JournalParser m PeriodicTransaction periodictransactionp = do char '~' "periodic transaction" lift (skipMany spacenonewline) - periodexpr <- T.strip <$> descriptionp + periodexpr <- lift $ T.strip <$> descriptionp _ <- lift followingcommentp postings <- postingsp Nothing return $ PeriodicTransaction periodexpr postings -- | Parse a (possibly unbalanced) transaction. -transactionp :: MonadIO m => ErroringJournalParser m Transaction +transactionp :: JournalParser m Transaction transactionp = do -- ptrace "transactionp" pos <- getPosition @@ -471,7 +471,7 @@ transactionp = do lookAhead (lift spacenonewline <|> newline) "whitespace or newline" status <- lift statusp "cleared status" code <- lift codep "transaction code" - description <- T.strip <$> descriptionp + description <- lift $ T.strip <$> descriptionp (comment, tags) <- lift transactioncommentp let year = first3 $ toGregorian date postings <- postingsp (Just year) @@ -576,17 +576,17 @@ test_transactionp = do -- Parse the following whitespace-beginning lines as postings, posting -- tags, and/or comments (inferring year, if needed, from the given date). -postingsp :: MonadIO m => Maybe Year -> ErroringJournalParser m [Posting] +postingsp :: Maybe Year -> JournalParser m [Posting] postingsp mTransactionYear = many (postingp mTransactionYear) "postings" --- linebeginningwithspaces :: Monad m => JournalParser m String +-- linebeginningwithspaces :: JournalParser m String -- linebeginningwithspaces = do -- sp <- lift (skipSome spacenonewline) -- c <- nonspace -- cs <- lift restofline -- return $ sp ++ (c:cs) ++ "\n" -postingp :: MonadIO m => Maybe Year -> ErroringJournalParser m Posting +postingp :: Maybe Year -> JournalParser m Posting postingp mTransactionYear = do -- pdbg 0 "postingp" (status, account) <- try $ do