mirror of
https://github.com/mrkkrp/megaparsec.git
synced 2024-12-24 00:33:22 +03:00
Minor improvements for new combinators
In particular, if input has no newline at the end, we need to treat it specially, because otherwise we will get confusing “incorrect indentation” message.
This commit is contained in:
parent
a8bd0e4b10
commit
611f2a4e7e
@ -48,7 +48,7 @@ where
|
||||
import Control.Applicative ((<|>), some, optional)
|
||||
import Control.Monad (void)
|
||||
import Data.Char (readLitChar)
|
||||
import Data.Maybe (listToMaybe, fromMaybe)
|
||||
import Data.Maybe (listToMaybe, fromMaybe, isJust)
|
||||
import Prelude hiding (negate)
|
||||
import qualified Prelude
|
||||
|
||||
@ -194,8 +194,8 @@ indentGuard spc p = do
|
||||
spc
|
||||
lvl <- indentLevel
|
||||
if p lvl
|
||||
then return lvl
|
||||
else fail ii
|
||||
then return lvl
|
||||
else fail ii
|
||||
|
||||
-- | Parse non-indented construction. This ensures that there is no
|
||||
-- indentation before actual data. Useful, for example, as a wrapper for
|
||||
@ -232,8 +232,8 @@ data IndentOpt m a b
|
||||
-- information.
|
||||
--
|
||||
-- Tokens /must not/ consume newlines after them. On the other hand, the
|
||||
-- first argument of this function /should/ consume newlines among other
|
||||
-- white space characters.
|
||||
-- first argument of this function /must/ consume newlines among other white
|
||||
-- space characters.
|
||||
--
|
||||
-- @since 4.3.0
|
||||
|
||||
@ -247,12 +247,12 @@ indentBlock sc r = do
|
||||
case a of
|
||||
IndentNone x -> return x
|
||||
IndentMany indent f p -> do
|
||||
mlvl <- lookAhead . optional . try $ C.eol *> indentGuard sc (> ref)
|
||||
mlvl <- optional . try $ C.eol *> indentGuard sc (> ref)
|
||||
case mlvl of
|
||||
Nothing -> sc *> f []
|
||||
Just lvl -> indentedItems ref (fromMaybe lvl indent) sc p >>= f
|
||||
IndentSome indent f p -> do
|
||||
lvl <- lookAhead . try $ C.eol *> indentGuard sc (> ref)
|
||||
lvl <- C.eol *> indentGuard sc (> ref)
|
||||
indentedItems ref (fromMaybe lvl indent) sc p >>= f
|
||||
|
||||
-- | Grab indented items. This is a helper for 'indentBlock', it's not a
|
||||
@ -270,7 +270,11 @@ indentedItems ref lvl sc p = go
|
||||
re pos
|
||||
| pos <= ref = return []
|
||||
| pos == lvl = (:) <$> p <*> go
|
||||
| otherwise = fail ii
|
||||
| otherwise = do
|
||||
done <- isJust <$> optional eof
|
||||
if done
|
||||
then return []
|
||||
else fail ii
|
||||
|
||||
ii :: String
|
||||
ii = "incorrect indentation"
|
||||
|
@ -94,12 +94,15 @@ mkSymbol :: Gen String
|
||||
mkSymbol = (++) <$> symbolName <*> whiteChars
|
||||
|
||||
mkIndent :: String -> Int -> Gen String
|
||||
mkIndent x n = concat <$> sequence [spc, sym, tra, eol]
|
||||
mkIndent x n = (++) <$> mkIndent' x n <*> eol
|
||||
where eol = frequency [(5, return "\n"), (1, listOf1 (return '\n'))]
|
||||
|
||||
mkIndent' :: String -> Int -> Gen String
|
||||
mkIndent' x n = concat <$> sequence [spc, sym, tra]
|
||||
where spc = frequency [(5, vectorOf n itm), (1, listOf itm)]
|
||||
tra = listOf itm
|
||||
itm = elements " \t"
|
||||
sym = return x
|
||||
eol = frequency [(5, return "\n"), (1, listOf1 (return '\n'))]
|
||||
|
||||
whiteChars :: Gen String
|
||||
whiteChars = listOf (elements "\t\n ")
|
||||
@ -207,7 +210,7 @@ prop_indentBlock mn' = forAll mkBlock $ \(l0,l1,l2,l3,l4) ->
|
||||
l1 <- mkIndent sblb ib
|
||||
l2 <- mkIndent sblc (ib + 2)
|
||||
l3 <- mkIndent sblb ib
|
||||
l4 <- mkIndent sblc (ib + 2)
|
||||
l4 <- mkIndent' sblc (ib + 2)
|
||||
return (l0,l1,l2,l3,l4)
|
||||
p = lvla
|
||||
lvla = indentBlock sc $ IndentMany mn (l sbla) lvlb <$ b sbla
|
||||
@ -219,7 +222,7 @@ prop_indentBlock mn' = forAll mkBlock $ \(l0,l1,l2,l3,l4) ->
|
||||
ib = fromMaybe 2 mn
|
||||
|
||||
prop_indentMany :: Property
|
||||
prop_indentMany = forAll (mkIndent "xxx" 0) (checkParser p r)
|
||||
prop_indentMany = forAll (mkIndent sbla 0) (checkParser p r)
|
||||
where r = Right (sbla, [])
|
||||
p = lvla
|
||||
lvla = indentBlock sc $ IndentMany Nothing (l sbla) lvlb <$ b sbla
|
||||
|
Loading…
Reference in New Issue
Block a user