/Database/HDBC/PostgreSQL/Parser.hs

http://github.com/hdbc/hdbc-postgresql · Haskell · 66 lines · 47 code · 14 blank · 5 comment · 0 complexity · de12530a1f67c9300024b73aaed7c4ea MD5 · raw file

  1. {- -*- mode: haskell; -*-
  2. -}
  3. {- PostgreSQL uses $1, $2, etc. instead of ? in query strings. So we have to
  4. do some basic parsing on these things to fix 'em up. -}
  5. module Database.HDBC.PostgreSQL.Parser where
  6. import Text.ParserCombinators.Parsec
  7. escapeseq :: GenParser Char st String
  8. escapeseq = (try $ string "''") <|>
  9. (try $ string "\\'")
  10. literal :: GenParser Char st [Char]
  11. literal = do _ <- char '\''
  12. s <- many (escapeseq <|> (noneOf "'" >>= (\x -> return [x])))
  13. _ <- char '\''
  14. return $ "'" ++ (concat s) ++ "'"
  15. qidentifier :: GenParser Char st [Char]
  16. qidentifier = do _ <- char '"'
  17. s <- many (noneOf "\"")
  18. _ <- char '"'
  19. return $ "\"" ++ s ++ "\""
  20. comment :: GenParser Char st [Char]
  21. comment = ccomment <|> linecomment
  22. ccomment :: GenParser Char st [Char]
  23. ccomment = do _ <- string "/*"
  24. c <- manyTill ((try ccomment) <|>
  25. (anyChar >>= (\x -> return [x])))
  26. (try (string "*/"))
  27. return $ "/*" ++ concat c ++ "*/"
  28. linecomment :: GenParser Char st [Char]
  29. linecomment = do _ <- string "--"
  30. c <- many (noneOf "\n")
  31. _ <- char '\n'
  32. return $ "--" ++ c ++ "\n"
  33. -- FIXME: handle pgsql dollar-quoted constants
  34. qmark :: (Num st, Show st) => GenParser Char st [Char]
  35. qmark = do _ <- char '?'
  36. n <- getState
  37. updateState (+1)
  38. return $ "$" ++ show n
  39. escapedQmark :: GenParser Char st [Char]
  40. escapedQmark = do _ <- try (char '\\' >> char '?')
  41. return "?"
  42. statement :: (Num st, Show st) => GenParser Char st [Char]
  43. statement =
  44. do s <- many ((try escapedQmark) <|>
  45. (try qmark) <|>
  46. (try comment) <|>
  47. (try literal) <|>
  48. (try qidentifier) <|>
  49. (anyChar >>= (\x -> return [x])))
  50. return $ concat s
  51. convertSQL :: String -> Either ParseError String
  52. convertSQL input = runParser statement (1::Integer) "" input