10

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

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

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) ""

这里的关键是 stuffparser。那是关键字之间的东西，可以是从列列表到条件的任何内容。此函数捕获通向关键字的所有字符。但在完成之前它还需要其他东西。如果有子选择怎么办？“从栏选择 id，（从产品中选择产品）”。好吧，在那种情况下，如果它碰到那个关键字，它就会搞砸一切，解析错误并搞砸我的缩进。where 子句也可以有括号。

因此，我需要将 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，但是当我同时使用字符串生成括号和单个字符作为替代时，我最终无法对其进行类型检查。有人对如何解决这个问题有任何建议吗？

4

1 回答 1

6

是的，between可能不适用于您要查找的内容。当然，对于您的用例，我会遵循 hammar 的建议并获取现成的 SQL 解析器。（个人意见：或者，除非你真的必须这样做，否则尽量不要使用 SQL；使用字符串进行数据库查询的想法是恕我直言的历史错误）。

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

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

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

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

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)

编辑 - 带有报价支持的版本

你可以用括号做同样的事情来支持引号，

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"。干杯

于 2011-07-19T04:35:24.747 回答