indents bug

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative ((*>), (<$>), (<*), (<|>))
import qualified Text.Parsec         as Parsec
import qualified Text.Parsec.Indent  as Indent

data Term = Term Char
    deriving (Show)

term :: Indent.IndentParser String u Term
term =
    -- Try uncommenting the next line: it shows that having `withPos` over some
    -- failing branch can mess up all of indents' internal state:
    --
    -- (Indent.withPos $ fail ":-(") <|>
    (Term <$> Parsec.letter <* Parsec.spaces)

data Function = Function Term [Term]
    deriving (Show)

function :: Indent.IndentParser String u Function
function = Indent.withPos $ do
    f    <- term
    args <- Parsec.many (Indent.indented *> term)
    return (Function f args)

test :: Either Parsec.ParseError Function
test =
    Indent.runIndent "<>" $ Parsec.runParserT function () "<>" $
        "f  \n\
        \  a\n\
        \  b"
17:5: Warning: Redundant bracket
Found:
(Term <$> Parsec.letter <* Parsec.spaces)
Why not:
Term <$> Parsec.letter <* Parsec.spaces
30:29: Warning: Redundant $
Found:
Parsec.runParserT function () "<>" $ "f \n a\n b"
Why not:
Parsec.runParserT function () "<>" "f \n a\n b"