Text/ParserCombinators/Parsec/examples/UserGuide/Main.hs

   1 -----------------------------------------------------------
   2 -- Daan Leijen (c) 2000, daan@cs.uu.nl
   3 -----------------------------------------------------------
   4 module Main where
   5
   6 import Text.ParserCombinators.Parsec
   7 import Text.ParserCombinators.Parsec.Expr
   8 import Text.ParserCombinators.Parsec.Token
   9 import Text.ParserCombinators.Parsec.Language
  10
  11
  12
  13 -----------------------------------------------------------
  14 --
  15 -----------------------------------------------------------
  16 run :: Show a => Parser a -> String -> IO ()
  17 run p input
  18         = case (parse p "" input) of
  19             Left err -> do{ putStr "parse error at "
  20                           ; print err
  21                           }
  22             Right x  -> print x
  23
  24
  25 runLex :: Show a => Parser a -> String -> IO ()
  26 runLex p
  27         = run (do{ whiteSpace lang
  28                  ; x <- p
  29                  ; eof
  30                  ; return x
  31                  }
  32               )
  33
  34 -----------------------------------------------------------
  35 -- Sequence and choice
  36 -----------------------------------------------------------
  37 simple  :: Parser Char
  38 simple  = letter
  39
  40 openClose :: Parser Char
  41 openClose = do{ char '('
  42               ; char ')'
  43               }
  44
  45 matching:: Parser ()
  46 matching= do{ char '('
  47             ; matching
  48             ; char ')'
  49             ; matching
  50             }
  51         <|> return ()
  52
  53
  54 -- Predictive parsing
  55 testOr  =   do{ char '('; char 'a'; char ')' }
  56         <|> do{ char '('; char 'b'; char ')' }
  57
  58 testOr1 = do{ char '('
  59             ; char 'a' <|> char 'b'
  60             ; char ')'
  61             }
  62
  63 testOr2 =   try (do{ char '('; char 'a'; char ')' })
  64         <|> do{ char '('; char 'b'; char ')' }
  65
  66
  67 -- Semantics
  68 nesting :: Parser Int
  69 nesting = do{ char '('
  70             ; n <- nesting
  71             ; char ')'
  72             ; m <- nesting
  73             ; return (max (n+1) m)
  74             }
  75         <|> return 0
  76
  77 word1   :: Parser String
  78 word1   = do{ c  <- letter
  79             ; do{ cs <- word1
  80                 ; return (c:cs)
  81                 }
  82               <|> return [c]
  83             }
  84
  85 -----------------------------------------------------------
  86 --
  87 -----------------------------------------------------------
  88
  89 word    :: Parser String
  90 word    = many1 (letter <?> "") <?> "word"
  91
  92 sentence    :: Parser [String]
  93 sentence    = do{ words <- sepBy1 word separator
  94                 ; oneOf ".?!" <?> "end of sentence"
  95                 ; return words
  96                 }
  97
  98 separator   :: Parser ()
  99 separator   = skipMany1 (space <|> char ',' <?> "")
 100
 101
 102 -----------------------------------------------------------
 103 -- Tokens
 104 -----------------------------------------------------------
 105 lang    = makeTokenParser
 106             (haskellStyle{ reservedNames = ["return","total"]})
 107
 108
 109 -----------------------------------------------------------
 110 --
 111 -----------------------------------------------------------
 112 expr    = buildExpressionParser table factor
 113         <?> "expression"
 114
 115 table   = [[op "*" (*) AssocLeft, op "/" div AssocLeft]
 116           ,[op "+" (+) AssocLeft, op "-" (-) AssocLeft]
 117           ]
 118         where
 119           op s f assoc
 120              = Infix (do{ symbol lang s; return f} <?> "operator") assoc
 121
 122 factor  =   parens lang expr
 123         <|> natural lang
 124         <?> "simple expression"
 125
 126
 127 test1   = do{ n <- natural lang
 128             ; do{ symbol lang "+"
 129                 ; m <- natural lang
 130                 ; return (n+m)
 131                 }
 132             <|> return n
 133             }
 134
 135 -----------------------------------------------------------
 136 --
 137 -----------------------------------------------------------
 138 {-
 139 receipt ::= product* total
 140 product ::= "return" price ";"
 141                   | identifier price ";"
 142 total   ::= price "total"
 143 price   ::= natural "." digit digit
 144 -}
 145
 146 receipt :: Parser Bool
 147 receipt = do{ ps <- many produkt
 148             ; p  <- total
 149             ; return (sum ps == p)
 150             }
 151
 152 produkt = do{ reserved lang "return"
 153             ; p <- price
 154             ; semi lang
 155             ; return (-p)
 156             }
 157       <|> do{ identifier lang
 158             ; p  <- price
 159             ; semi lang
 160             ; return p
 161             }
 162       <?> "product"
 163
 164 total   = do{ p <- price
 165             ; reserved lang "total"
 166             ; return p
 167             }
 168
 169 price   :: Parser Int
 170 price   = lexeme lang (
 171           do{ ds1 <- many1 digit
 172             ; char '.'
 173             ; ds2 <- count 2 digit
 174             ; return (convert 0 (ds1 ++ ds2))
 175             })
 176           <?> "price"
 177           where
 178             convert n []     = n
 179             convert n (d:ds) = convert (10*n + digitToInt d) ds
 180
 181