[Haskell-beginners] Code-review of "toy SQL" parser using Parsec

Andy Elvey andy.elvey at paradise.net.nz
Wed Jul 27 05:02:29 CEST 2011


Hi all -

  I'm poking around with Parsec and looking at getting this "toy SQL" 
parser up and running.
So, I'm keen to get feedback on whether I'm on the right track (or off 
on a siding to nowhere..... ;)   )
This is my first Parsec grammar, so I hope you'll be gentle...... :)

( Note - I've put the whereStmt in parens as I want that to be an 
optional statement. I'm not sure how
to denote that in Parsec.  )

Many thanks in advance -

** Start of code **
-- toysql.hs
-- This code is aimed at parsing phrases like the
-- following -
-- select * from mytable where city = "Sydney";
-- select foo, bar from mytable where var1 > 10;
-- select baz from mytable;
-- This code is released to the public domain.
-- "Share and enjoy....."  ;)

module Main where

import Text.ParserCombinators.Parsec

sqlStmt = do{ createStmt
             ; selectStmt
             ; fromStmt
             ; (whereStmt)
             ; semicolon
             }

createStmt = do{ CREATE
                ; tablename
                ; AS
                }

tablename = identifier


selectStmt = do{ SELECT
                ; varStmt
                }

varStmt = star <|> singlevar <|> varlist
star = '*'
singlevar = identifier
varlist = sepBy singlevar (char ',')

fromStmt = do{ FROM
              ; tableStmt
              }

tableStmt = singleTablestmt <|> multiTablestmt
singleTablestmt = identifier
multiTablestmt = sepBy identifier (char ',')

whereStmt = do{ WHERE
               ; condStmt
               }

condStmt = multiCondstmt <|> singleCondstmt
singleCondstmt = singleCondstmtnoparens <|> singleCondstmtwithparens

singleCondstmtnoparens = do{
                    ; singlevar
                    ; OP
                    ; value
                    }

singleCondstmtwithparens = do(
                    ;  char '('
                    ;  singleCondstmtnoparens
                    ;  char ')'

multiCondstmt = sepBy singleCondstmt ( AND <|> OR )

OP = ( '=' <|> '<' <|> '>' <|> "<=" <|> ">=" <|> "!=" )
semicolon = char ';'

parseSQL :: String -> Either ParseError [[String]]
parseSQL input = parse sqlFile "(unknown)" input

** end of code **


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20110727/1d5dc200/attachment-0001.htm>


More information about the Beginners mailing list