hesql 0.1 → 0.2

raw patch · 4 files changed

+33/−16 lines, 4 files

Files

• HESQL/Parser.hs +21/−9
• HESQL/Syntax.hs +6/−1
• example/Account.hesql +5/−5
• hesql.cabal +1/−1

@@ -29,6 +29,8 @@    char '='    whiteSpace    stmt <- sqlStatement+   whiteSpace+   symbol ";"    return $ HesqlDecls fn p stmt  @@ -127,7 +129,9 @@                  , [binary "*" SqlMult AssocLeft, binary "/" SqlDiv AssocLeft]                  , [binary "is" SqlIs AssocRight]                  , [binary "=" SqlEqual AssocLeft, binary "<" SqlLess AssocLeft, -                    binary ">" SqlGreater AssocLeft]+                    binary ">" SqlGreater AssocLeft,+                    binary ">=" SqlEqualOrGreater AssocLeft,+                    binary "<=" SqlEqualOrLess AssocLeft]                  , [binary "and" SqlAnd AssocLeft]                  , [binary "or" SqlOr AssocLeft]                  ]@@ -139,7 +143,8 @@  where kw s v = reserved s >> return v  sqlLiteral = sqlBoolLiteral <|> -             sqlStringLiteral+             sqlStringLiteral <|>+             sqlNumberLiteral  sqlStringLiteral =     between (symbol "'") (symbol "'") $ do@@ -150,7 +155,13 @@              char '\\'              char '\''  -- TODO \n etc +sqlNumberLiteral = do+  n <- naturalOrFloat+  case n of +    Left i -> return $ SqlLiteral (toSql i)+    Right f -> return $ SqlLiteral (toSql f) +       sqlTerm = parens sqlExp <|> sqlLiteral <|> do @@ -181,13 +192,14 @@  lexer       = P.makeTokenParser haskellDef           -parens      = P.parens lexer-braces      = P.braces lexer-identifier  = P.identifier lexer-reserved    = P.reserved lexer-reservedOp  = P.reservedOp lexer-whiteSpace  = P.whiteSpace lexer-symbol      = P.symbol lexer+parens         = P.parens lexer+braces         = P.braces lexer+identifier     = P.identifier lexer+reserved       = P.reserved lexer+reservedOp     = P.reservedOp lexer+whiteSpace     = P.whiteSpace lexer+symbol         = P.symbol lexer+naturalOrFloat = P.naturalOrFloat lexer  binary  name fun assoc = Infix (do                                  reservedOp name; 

@@ -34,7 +34,8 @@   deriving Show  data SqlInfixOp = SqlEqual | SqlLike | SqlLess | -                  SqlGreater | SqlAnd | SqlOr |+                  SqlGreater  | SqlEqualOrGreater | SqlEqualOrLess |+                  SqlAnd | SqlOr |                   SqlIs |                   SqlPlus | SqlMult | SqlMinus | SqlDiv   deriving Show@@ -115,6 +116,8 @@ showSqlValue (SqlBool b) = show b showSqlValue SqlNull = "null" showSqlValue (SqlString s) = "'" ++ s ++ "'"+showSqlValue (SqlInteger i) = show i+showSqlValue (SqlDouble d) = show d  comaSepList = intercalate ", " withParens s = "(" ++ s ++ ")"@@ -137,6 +140,8 @@ infixOpToString SqlEqual = "=" infixOpToString SqlLike = "like" infixOpToString SqlGreater = ">"+infixOpToString SqlEqualOrGreater = ">="+infixOpToString SqlEqualOrLess = "<=" infixOpToString SqlLess = "<" infixOpToString SqlAnd = "and" infixOpToString SqlOr = "or"

@@ -5,23 +5,23 @@ verifyLogin login' password' =   select1' Accountid, Login, RealName, Email from Account      where (password is null or password  = md5(password')) and Lower(Login) = Lower(login')-           and not Locked+           and not Locked;  login accountid' =-    update Account set LoggedIn = true where AccountID = accountid'+    update Account set LoggedIn = true where AccountID = accountid';  logout accountid' =    update Account       set LoggedIn = false,           LastLogout = Now()-      where AccountID = accountid'+      where AccountID = accountid';    createAccount login password email realname =-    insert into Account (Login, Password, Email, RealName) values (login,md5(password),email,realname)+    insert into Account (Login, Password, Email, RealName) values (login,md5(password),email,realname);   activeUsers =      select Login from Account           where LoggedIn and-               now() - LastRequest < '00:05:00'+               now() - LastRequest < '00:05:00';

@@ -1,5 +1,5 @@ Name: hesql-Version: 0.1+Version: 0.2 Author: Christoph Bauer <ich@christoph-bauer.net> Maintainer: Christoph Bauer <ich@christoph-bauer.net> Cabal-Version: >= 1.2