parsec3-tut.hs

-- Parsec 3 tutorial code --

-- module Main where -- this isn't necessary

import Text.Parsec
import Text.Parsec.String (Parser) -- type Parser = Parsec String ()
import Text.Parsec.Expr
import qualified Text.Parsec.Token as P
import Text.Parsec.Language (haskellStyle)
import Data.Char
-- import Control.Monad.Identity -- for the Identity monad

simple :: Parser Char
simple = letter

run :: Show a => Parser a -> String -> IO ()
run p input =
    case (parse p "" input) of
        Left err -> do putStr "parse error at "
                       print err
        Right x  -> print x

openClose :: Parser Char
openClose = do char '('
               char ')'

{- -- parens is defined in Text.Parsec.Token
parens :: Parser ()
parens = do char '('
            parens
            char ')'
            parens
        <|> return ()
-}

testOr :: Parser String
testOr = string "(a)"
     <|> string "(b)"

testOr1 :: Parser Char
testOr1 = do char '('
             char 'a' <|> char 'b'
             char ')'

testOr2 :: Parser String
testOr2 = try (string "(a)") 
      <|> string "(b)"

testOr3 :: Parser String
testOr3 = do try (string "(a")
             char ')'
             return "(a)"
      <|> string "(b)"

nesting :: Parser Int
nesting = do char '('
             n <- nesting
             char ')'
             m <- nesting
             return (max (n+1) m)
         <|> return 0

{-
word :: Parser String
word = do{ c <- letter
         ; do{ cs <- word
             ; return (c:cs) 
             }
           <|> return [c]
         }
-}

{-
word :: Parser String
word = do c <- letter
          do cs <- word
             return (c:cs) 
           <|> return [c]       -- <|> indentation is confusing here, but it works
-}

--word :: Parser String
--word = many1 letter

{-
sentence :: Parser [String]
sentence = do words <- sepBy1 word separator
              oneOf ".?!"
              return words

separator :: Parser ()
separator = skipMany1 (space <|> char ',')
-}


word :: Parser String
word = many1 letter <?> "word"

separator :: Parser ()
separator = skipMany1 (space <|> char ',' <?> "")

sentence :: Parser [String]
sentence = do words <- sepBy1 word separator
              oneOf ".?!" <?> "end of sentence"
              return words

{- 
expr :: Parser Integer
expr = buildExpressionParser table factor <?> "expression"

table = [[op "*" (*) AssocLeft, op "/" div AssocLeft]
        ,[op "+" (+) AssocLeft, op "-" (-) AssocLeft]
        ]
        where op s f assoc 
                  = Infix (do{ string s; return f}) assoc

factor = do char '('
            x <- expr
            char ')'
            return x
        <|> number
        <?> "simple expression"
-}

number :: Parser Integer
number = do ds <- many1 digit
            return (read ds)
        <?> "number"
{-
lexer :: P.TokenParser ()
lexer = P.makeTokenParser (haskellStyle 
                           { P.reservedOpNames = ["*", "/", "+", "-"]}
                          )
-}

whiteSpace = P.whiteSpace lexer
lexeme     = P.lexeme lexer
symbol     = P.symbol lexer
natural    = P.natural lexer
parens     = P.parens lexer
semi       = P.semi lexer
identifier = P.identifier lexer
reserved   = P.reserved lexer
reservedOp = P.reservedOp lexer

--expr :: Parser Integer
expr = buildExpressionParser table factor <?> "expression"

-- for evaluating expressions
--table :: Integral a => OperatorTable String () Identity a
table = [[op "*" (*) AssocLeft, op "/" div AssocLeft]
        ,[op "+" (+) AssocLeft, op "-" (-) AssocLeft]
        ]
      where op s f assoc
               = Infix (do{ reservedOp s; return f} <?> "operator") assoc

factor = parens expr
         <|> natural
         <?> "simple expression"


{- -- for recognizing expressions and outputting text
   -- this section is not in the tutorial
strIn op = (\x y -> x ++ " " ++ op ++ " " ++ y)
mulStr = strIn "*"
divStr = strIn "/"
addStr = strIn "+"
subStr = strIn "-"

table = [[op "*" mulStr AssocLeft, op "/" divStr AssocLeft]
        ,[op "+" addStr AssocLeft, op "-" subStr AssocLeft]
        ]
      where op s f assoc
               = Infix (do{ reservedOp s; return f} <?> "operator") assoc

factor = parens expr
         <|> lexeme (many1 digit) -- natural
         <?> "simple expression"
-}

runLex :: Show a => Parser a -> String -> IO ()
runLex p input
    = run (do  whiteSpace
               x <-p
               eof
               return x
          ) input

price :: Parser Int -- price in cents
price = lexeme (do ds1 <- many1 digit
                   char '.'
                   ds2 <- count 2 digit
                   return (convert 0 (ds1 ++ ds2))
               )
        <?> "price"
        where
            convert n []     = n
            convert n (d:ds) = convert (10*n + digitToInt d) ds

{-
receipt :: Parser Bool
receipt = do ps <- many produkt
             p <- total
             return (sum ps == p)

produkt = do symbol "return"
             p <- price
             semi
             return (-p)
      <|> do identifier
             p <- price
             semi
             return p
      <?> "product"
-}

{-
total = do p <- price
           symbol "total"
           return p

produkt = do try (symbol "return")
             p <- price
             semi
             return (-p)
      <|> do identifier
             p <- price
             semi
             return p
      <?> "product"
 -}            

lexer :: P.TokenParser ()
lexer = P.makeTokenParser (haskellStyle
                               { P.reservedNames = ["return", "total"]
                               , P.reservedOpNames = ["*","/","+","-"]
                               }
                          )

receipt :: Parser Bool
receipt = do ps <- many produkt
             p <- total
             return (sum ps == p)

produkt = do reserved "return"
             p <- price
             semi
             return (-p)
      <|> do identifier
             p <- price
             semi
             return p
      <?> "produkt"

total = do p<- price
           reserved "total"
           return p

Nice :)