Softwaredesign: Eine konkrete Syntax für eine Anfragesprache
| Softwaredesign: Eine konkrete Syntax für eine Anfragesprache |
|
|
|
1module ParsedQuery(query, runLex, parseQuery)
2where
3
4import IndexExample2 (suche)
5import Query
6
7import System.IO
8
9import Text.ParserCombinators.Parsec
10import Text.ParserCombinators.Parsec.Expr
11import Text.ParserCombinators.Parsec.Language
12import qualified Text.ParserCombinators.Parsec.Token as P
13
14-- ------------------------------------------------------------
15--
16-- token parser
17
18qlex = P.makeTokenParser wordDef
19 where
20 charDef = oneOf ( ['a'..'z'] ++ ['A'..'Z'] ++ "\196\214\220\228\246\252\223" )
21 wordDef = emptyDef { identStart = charDef, identLetter = charDef }
22
23qword = P.identifier qlex
24qop = P.reservedOp qlex
25
26whiteSpace = P.whiteSpace qlex
27parens = P.parens qlex
28symbol = P.symbol qlex
29reservedOp = P.reservedOp qlex
30lexeme = P.lexeme qlex
31
32-- ------------------------------------------------------------
33--
34-- query parser
35
36query :: Parser Query
37query = buildExpressionParser qtable qfactor
38 <?> "query"
39
40qtable
41 = [ [ op '>' (\ os x y -> QBin (QFollow (length os + 1)) x y) AssocRight
42 , op '+' (\ os x y -> QBin (QContext (length os + 1)) x y) AssocRight
43 ]
44 , [ op '&' (const (QBin QAnd)) AssocLeft ]
45 , [ op '|' (const (QBin QOr)) AssocLeft ]
46 ]
47 where
48 op c f assoc
49 = Infix ( do
50 os <- lexeme (many1 (char c))
51 return (f os)
52 ) assoc
53
54qfactor :: Parser Query
55qfactor
56 = do
57 ql <- many1 qsimple
58 return ( foldr1 (QBin QPhrase) ql )
59
60qsimple :: Parser Query
61qsimple
62 = parens query
63 <|>
64 qprim
65 <?> "simple query"
66
67qprim :: Parser Query
68qprim
69 = do
70 w <- qword
71 option (QWord w) ( do
72 lexeme (many1 (char '.'))
73 return (QPrefix w)
74 )
75
76
77-----------------------------------------------------------
78
79run :: Show a => Parser a -> String -> IO ()
80run p input
81 = case (parse p "" input) of
82 Left err -> do{ putStr "parse error at "
83 ; print err
84 }
85 Right x -> print x
86
87
88runLex :: Show a => Parser a -> String -> IO ()
89runLex p
90 = run (do{ whiteSpace
91 ; x <- p
92 ; eof
93 ; return x
94 }
95 )
96
97parseQuery :: String -> Either ParseError Query
98parseQuery
99 = parse ( do
100 whiteSpace
101 res <- query
102 eof
103 return res
104 ) ""
|
| Letzte Änderung: 13.04.2012 | © Prof. Dr. Uwe Schmidt |
