Question

在我的工作中，我遇到了很多粗糙的SQL，我有一个明智的想法，即编写一个程序来解析sql并将其打印出来。我很快就完成了大部分工作，但我遇到了一个我不知道如何解决的问题。

所以让我们假装sql是“从1中选择foo”。我的想法是总是有一个关键字后跟数据，所以我要做的就是解析一个关键字，然后在下一个关键字之前捕获所有乱码并存储以供以后清理，如果值得的话。这是代码：

import Text.Parsec
import Text.Parsec.Combinator
import Text.Parsec.Char
import Data.Text (strip)

newtype Statement = Statement [Atom]
data Atom = Branch String [Atom] | Leaf String deriving Show

trim str = reverse $ trim' (reverse $ trim' str)
  where
    trim' (' ':xs) = trim' xs
    trim' str = str

printStatement atoms = mapM_ printAtom atoms
printAtom atom = loop 0 atom 
  where
    loop depth (Leaf str) = putStrLn $ (replicate depth ' ') ++ str
    loop depth (Branch str atoms) = do 
      putStrLn $ (replicate depth ' ') ++ str
      mapM_ (loop (depth + 2)) atoms

keywords :: [String]
keywords = [
  "select",
  "update",
  "delete",
  "from",
  "where"]

keywordparser :: Parsec String u String
keywordparser = try ((choice $ map string keywords) <?> "keywordparser")

stuffparser :: Parsec String u String
stuffparser = manyTill anyChar (eof <|> (lookAhead keywordparser >> return ()))

statementparser = do
  key <- keywordparser
  stuff <- stuffparser
  return $ Branch key [Leaf (trim stuff)]
  <?> "statementparser"

tp = parse (many statementparser) ""

这里的关键是填充程序。这是关键字之间的内容，可以是从列列表到标准的任何内容。此函数捕获导致关键字的所有字符。但它在完成之前还需要其他东西。如果有子选择怎么办？ “从栏中选择id，（从产品中选择产品）”。那么在这种情况下，如果它击中该关键字，它会搞砸一切，解析错误并搞砸了我的缩进。此外，子句也可以有括号。

所以我需要将anyChar更改为另一个组合器，一次一个地填充字符，但也试图寻找括号，如果找到它们，遍历并捕获所有这些，但如果有更多的括号，请执行直到我们完全关闭括号，然后连接它并返回它。这是我尝试过的，但我无法让它发挥作用。

stuffparser :: Parsec String u String
stuffparser = fmap concat $ manyTill somechars (eof <|> (lookAhead keywordparser >> return ()))
  where
    somechars = parens <|> fmap (\c -> [c]) anyChar
    parens= between (char '(') (char ')') somechars

这样会出错：

> tp "select asdf(qwerty) from foo where 1"
Left (line 1, column 14):
unexpected "w"
expecting ")"

但我想不出有任何重写方法可以使它有效。我已经尝试在括号部分使用manyTill，但是当我将字符串生成parens和单个字符作为替代时，我最终无法将其转换为类型检查。有没有人对如何解决这个问题有任何建议？

Answer 1

是的，between可能无法满足您的需求。当然，对于你的用例，我会遵循hammar的建议，并获得一个现成的SQL解析器。（个人意见：或者，除非你真的需要，否则尽量不要使用SQL;使用字符串进行数据库查询的想法是历史错误）。

注意：我添加了一个名为<++>的运算符，它将连接两个解析器的结果，无论它们是字符串还是字符。（底部的代码。）

首先，对于解析括号的任务：顶层将解析相关字符之间的一些东西，这正是代码所说的，

parseParen = char '(' <++> inner <++> char ')'

然后，inner函数应解析其他任何内容：非parens，可能包括另一组括号，以及后面的非paren垃圾。

parseParen = char '(' <++> inner <++> char ')' where
    inner = many (noneOf "()") <++> option "" (parseParen <++> inner)

我会假设对于解决方案的其余部分，您想要做的是通过顶级SQL关键字来分解。（即忽略括号中的那些）。也就是说，我们将有一个行为类似的解析器，

Main> parseTest parseSqlToplevel "select asdf(select m( 2) fr(o)m w where n) from b where delete 4"
[(Select," asdf(select m( 2) fr(o)m w where n) "),(From," b "),(Where," "),(Delete," 4")]

假设我们有一个parseKw解析器，可以获得select等等。我们使用关键字后，我们需要读取直到下一个[顶级]关键字。我的解决方案的最后一个技巧是使用lookAhead组合器来确定下一个单词是否是关键字，如果是，则将其放回去。如果不是，那么我们会使用括号或其他字符，然后对其余字符进行递归。

-- consume spaces, then eat a word or parenthesis
parseOther = many space <++>
    (("" <$ lookAhead (try parseKw)) <|> -- if there's a keyword, put it back!
     option "" ((parseParen <|> many1 (noneOf "() \t")) <++> parseOther))

我的整个解决方案如下

-- overloaded operator to concatenate string results from parsers
class CharOrStr a where toStr :: a -> String
instance CharOrStr Char where toStr x = [x]
instance CharOrStr String where toStr = id
infixl 4 <++>
f <++> g = (\x y -> toStr x ++ toStr y) <$> f <*> g

data Keyword = Select | Update | Delete | From | Where deriving (Eq, Show)

parseKw =
    (Select <$ string "select") <|>
    (Update <$ string "update") <|>
    (Delete <$ string "delete") <|>
    (From <$ string "from") <|>
    (Where <$ string "where") <?>
    "keyword (select, update, delete, from, where)"

-- consume spaces, then eat a word or parenthesis
parseOther = many space <++>
    (("" <$ lookAhead (try parseKw)) <|> -- if there's a keyword, put it back!
     option "" ((parseParen <|> many1 (noneOf "() \t")) <++> parseOther))

parseSqlToplevel = many ((,) <$> parseKw <*> (space <++> parseOther)) <* eof

parseParen = char '(' <++> inner <++> char ')' where
    inner = many (noneOf "()") <++> option "" (parseParen <++> inner)

编辑 - 带引号支持的版本

你可以做与支持报价的parens相同的事情，

import Control.Applicative hiding (many, (<|>))
import Text.Parsec
import Text.Parsec.Combinator

-- overloaded operator to concatenate string results from parsers
class CharOrStr a where toStr :: a -> String
instance CharOrStr Char where toStr x = [x]
instance CharOrStr String where toStr = id
infixl 4 <++>
f <++> g = (\x y -> toStr x ++ toStr y) <$> f <*> g

data Keyword = Select | Update | Delete | From | Where deriving (Eq, Show)

parseKw =
    (Select <$ string "select") <|>
    (Update <$ string "update") <|>
    (Delete <$ string "delete") <|>
    (From <$ string "from") <|>
    (Where <$ string "where") <?>
    "keyword (select, update, delete, from, where)"

-- consume spaces, then eat a word or parenthesis
parseOther = many space <++>
    (("" <$ lookAhead (try parseKw)) <|> -- if there's a keyword, put it back!
     option "" ((parseParen <|> parseQuote <|> many1 (noneOf "'() \t")) <++> parseOther))

parseSqlToplevel = many ((,) <$> parseKw <*> (space <++> parseOther)) <* eof

parseQuote = char '\'' <++> inner <++> char '\'' where
    inner = many (noneOf "'\\") <++>
        option "" (char '\\' <++> anyChar <++> inner)

parseParen = char '(' <++> inner <++> char ')' where
    inner = many (noneOf "'()") <++>
        (parseQuote <++> inner <|> option "" (parseParen <++> inner))

我用parseTest parseSqlToplevel "select ('a(sdf'())b"试了一下。欢呼声

你如何以贪婪的方式使用parsec？

1 个答案:

编辑 - 带引号支持的版本