hesql (empty) → 0.0
raw patch · 11 files changed
+1035/−0 lines, 11 filesdep +HDBCdep +HDBC-postgresqldep +basesetup-changed
Dependencies added: HDBC, HDBC-postgresql, base, filepath, haskell-src, parsec
Files
- GPL +341/−0
- HESQL.hs +34/−0
- HESQL/Parser.hs +186/−0
- HESQL/Syntax.hs +143/−0
- HESQL/Translator.hs +155/−0
- HESQL/Verifier.hs +14/−0
- Makefile +17/−0
- README +95/−0
- Setup.hs +2/−0
- example/Account.hesql +27/−0
- hesql.cabal +21/−0
+ GPL view
@@ -0,0 +1,341 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS+++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) 19yy <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) 19yy name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.
+ HESQL.hs view
@@ -0,0 +1,34 @@+module Main (main) where++import System.Environment+import Language.Haskell.Pretty+import System.FilePath+import Language.Haskell.Pretty+import HESQL.Parser (hesqlModule)+import HESQL.Translator+import Control.Monad(when)+import Text.Parsec.String (parseFromFile)+import System.Exit++outputFile file = replaceExtension file ".hs"++main = do+ putStrLn "hesql 0.0"+ [file, db] <- getArgs+ when (outputFile file == file) $+ error (file ++ "has a wrong extension")+ inp <- readFile file+ mod <- parseFromFile hesqlModule file+ case mod of+ Left err -> do+ print err+ exitWith $ ExitFailure 1+ Right mod' -> do+ outp <- generateCode file db mod'+ writeFile (outputFile file) $+ prettyPrint $+ outp + ++ +
+ HESQL/Parser.hs view
@@ -0,0 +1,186 @@+module HESQL.Parser (hesqlModule) where++import HESQL.Syntax+import Text.Parsec.String+import Text.Parsec+import Text.Parsec.Language (haskellDef)+import Text.Parsec.Expr+import qualified Text.Parsec.Token as P+import Data.List (intercalate)+import Database.HDBC+import Control.Monad (forM_)+++hesqlModule :: Parser HesqlModule+hesqlModule = do+ whiteSpace+ modName <- moduleHeader+ decls <- decls+ whiteSpace+ eof+ return $ HesqlModule modName decls++decls = many decl++decl = do+ fn <- funName+ p <- many parameter+ whiteSpace+ char '='+ whiteSpace+ stmt <- sqlStatement+ return $ HesqlDecls fn p stmt++++funName = identifier+parameter = identifier++sqlStatement = + selectStatement <|>+ insertStatement <|>+ updateStatement <|>+ deleteStatement+ +++selectStatement = do+ opts <- selectVariant+ cols <- sepBy1 column (symbol ",")+ reserved "from"+ tab <- table+ wh <- optionMaybe whereCondition+ return $ SELECT opts (ExplicitColumns cols) tab+ wh Nothing Nothing++selectVariant = + select "1'" [Strict, ReturnMaybe] <|>+ select "1" [ReturnMaybe] <|> + select "'" [Strict] <|>+ select "" []++select suffix opts = + reserved ("select"++suffix) >> return opts++insertStatement = do+ reserved "insert"+ reserved "into"+ tab <- table+ spec <- insertSpec+ reserved "values"+ values <- insertValues + return $ INSERT tab spec values++updateStatement = do+ reserved "update"+ tab <- table+ reserved "set"+ updates <- updates+ wh <- optionMaybe whereCondition+ return $ UPDATE tab updates wh++deleteStatement = do+ reserved "delete"+ reserved "from"+ tab <- table+ wh <- optionMaybe whereCondition+ return $ DELETE tab wh+++updates = sepBy1 set (symbol ",")+ where set = do+ col <- columnName+ symbol "="+ e <- sqlExp + return (col, e)+ ++insertSpec = + parens $ sepBy1 identifier (symbol ",")++insertValues =+ parens $ sepBy1 sqlExp (symbol ",")++whereCondition :: Parser SqlExp+whereCondition = do+ reserved "where"+ be <- sqlExp+ return be++sqlExp = sqlCompare ++sqlCompare = buildExpressionParser table sqlTerm+ where table = [ [prefix "not" SqlNot]+ , [binary "+" SqlPlus AssocLeft, binary "-" SqlMinus AssocLeft]+ , [binary "*" SqlMult AssocLeft, binary "/" SqlDiv AssocLeft]+ , [binary "is" SqlIs AssocRight]+ , [binary "=" SqlEqual AssocLeft, binary "<" SqlLess AssocLeft, + binary ">" SqlGreater AssocLeft]+ , [binary "and" SqlAnd AssocLeft]+ , [binary "or" SqlOr AssocLeft]+ ]++sqlBoolLiteral = + kw "true" (SqlLiteral (toSql True)) <|>+ kw "true" (SqlLiteral (toSql True)) <|>+ kw "null" (SqlLiteral SqlNull)+ where kw s v = reserved s >> return v++sqlLiteral = sqlBoolLiteral <|> + sqlStringLiteral++sqlStringLiteral =+ between (symbol "'") (symbol "'") $ do+ s <- many stringChar+ return (SqlLiteral (toSql (s :: String)))+ where stringChar = + noneOf "\\'" <|> do+ char '\\'+ char '\'' -- TODO \n etc+++ ++sqlTerm = parens sqlExp <|> sqlLiteral <|> do + n <- identifier+ funParams n <|> return (SqlColumn n)++ +funParams n = do+ args <- parens $ sepBy sqlExp (symbol ",")+ return $ SqlFunApp n args+++columnName = identifier++column = do+ col <- identifier+ return (col, Nothing)++table = identifier+ +modName = sepBy1 identifier (char '.')++moduleHeader = do+ reserved "module"+ m <- modName+ reserved "where"+ return $ intercalate "." m ++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++binary name fun assoc = Infix (do+ reservedOp name; + return $ \ e1 e2 -> SqlInfixApp e1 fun e2) + assoc++prefix name fun = Prefix (do reservedOp name; return fun)+postfix names fun = Prefix (do forM_ names reservedOp; return fun)
+ HESQL/Syntax.hs view
@@ -0,0 +1,143 @@+module HESQL.Syntax where++import Database.HDBC (SqlValue(..))+import Data.List (intercalate)++type ModuleName = String+type DeclName = String+type Vars = [String]+type TableName = String+type ColName = String+type ColAlias = String+type FunName = String++data HesqlModule = HesqlModule ModuleName [HesqlDecls] deriving (Show)+data HesqlDecls = HesqlDecls { + declName :: DeclName+ , declVars :: Vars + , declSQL :: SQL + } deriving Show++data SQL = SELECT [SelectOption] SelectColumns From + (Maybe SqlExp) (Maybe Order) (Maybe Group)+ | INSERT TableName InsertColumns [SqlExp]+ | UPDATE TableName [(ColName, SqlExp)] (Maybe SqlExp)+ | DELETE TableName (Maybe SqlExp)+ | DummySQL++instance Show SQL where+ show = sqlToString ++data SqlExp = + SqlFunApp FunName [SqlExp] | + SqlInfixApp SqlExp SqlInfixOp SqlExp |+ SqlPlaceHolder String | SqlLiteral SqlValue | SqlColumn ColName |+ SqlNot SqlExp+ deriving Show++data SqlInfixOp = SqlEqual | SqlLike | SqlLess | + SqlGreater | SqlAnd | SqlOr |+ SqlIs |+ SqlPlus | SqlMult | SqlMinus | SqlDiv+ deriving Show++infixPrio SqlEqual = 3+infixPrio SqlLike = 3+infixPrio SqlLess = 3+infixPrio SqlGreater = 3+infixPrio SqlIs = 3+infixPrio SqlAnd = 4+infixPrio SqlOr = 5+infixPrio SqlPlus = 1+infixPrio SqlMinus = 1+infixPrio SqlMult = 2+infixPrio SqlDiv = 2+++sqlToString :: SQL -> String+sqlToString DummySQL = ""+sqlToString (SELECT _ cols from wh order group) = + "select " ++ showColumns cols ++ " from " ++ showFrom from+ ++ showWhere wh+-- TODO where order group+sqlToString (INSERT tab spec vals) =+ "insert into " ++ tab ++ " " ++ + (withParens $ comaSepList spec) +++ " values " ++ + (withParens $ comaSepList $ map showSqlExp vals)++sqlToString (UPDATE tab updates wh) =+ "update " ++ tab ++ " " ++ + (comaSepList $ map updateStr updates) +++ showWhere wh+ where updateStr (col, e) = col ++ " = " ++ showSqlExp e++sqlToString (DELETE tab wh) =+ "delete from " ++ tab ++ showWhere wh+++showColumns :: SelectColumns -> String+showColumns (ExplicitColumns cols) = comaSepList $ map fst cols -- TODO Alias+showColumns _ = todo "showColumns"++showFrom table = table++showWhere Nothing = ""+showWhere (Just sqlExp) = " where " ++ showSqlExp sqlExp++showSqlExp = showSqlExp' 5++showSqlExp' p (SqlColumn n) = n+showSqlExp' p (SqlInfixApp a op b) = par (showSqlExp' p' a ++ " " ++ infixOpToString op ++ + " " ++ showSqlExp' p' b)+ where par = if p' > p then withParens else id+ p' = infixPrio op+showSqlExp' p (SqlPlaceHolder _) = "?"+showSqlExp' p (SqlFunApp f args) = f ++ (withParens $ comaSepList $ map showSqlExp args)+showSqlExp' p (SqlLiteral v) = showSqlValue v +showSqlExp' p (SqlNot e) = "not " ++ showSqlExp e++showSqlValue (SqlBool b) = show b+showSqlValue SqlNull = "null"+showSqlValue (SqlString s) = "'" ++ s ++ "'"++comaSepList = intercalate ", "+withParens s = "(" ++ s ++ ")"++ +todo s = error ("TODO " ++ s) ++data SelectOption = Strict | ReturnMaybe deriving (Show, Eq)+data SelectColumns = AllColumns | ExplicitColumns [(ColName, Maybe ColAlias)] deriving Show+-- data From = FromSubQuery SQL | FromTables [(TableName, TableAlias)] deriving Show+type From = TableName +type InsertColumns = [ColName]++type TableAlias = String++type Order = ()+type Group = ()++++infixOpToString SqlEqual = "="+infixOpToString SqlLike = "like"+infixOpToString SqlGreater = ">"+infixOpToString SqlLess = "<"+infixOpToString SqlAnd = "and"+infixOpToString SqlOr = "or"+infixOpToString SqlIs = "is"+infixOpToString SqlPlus = "+"+infixOpToString SqlMinus = "-"+infixOpToString SqlDiv = "/"+infixOpToString SqlMult = "*"+ ++isSelect (SELECT _ _ _ _ _ _) = True+isSelect _ = False++selectOpts :: SQL -> [SelectOption]+selectOpts (SELECT opts _ _ _ _ _) = opts+selectOpts _ = []++selectColumns (SELECT _ cols _ _ _ _) = cols
+ HESQL/Translator.hs view
@@ -0,0 +1,155 @@+module HESQL.Translator (generateCode) where++import Language.Haskell.Syntax+import Database.HDBC.PostgreSQL++import HESQL.Syntax +import HESQL.Verifier++import System.FilePath++++stmtRec = HsIdent "Stmts"+funarg = HsPVar . HsIdent+funargs = map funarg++srcloc = SrcLoc "<dummy>" 1 1++hsSimpleFun name vars body wheres =+ HsFunBind [HsMatch srcloc (HsIdent name) (funargs vars) body wheres]+ ++generateCode :: FilePath -> String -> HesqlModule -> IO HsModule+generateCode fn db (HesqlModule modName decls) = do+ conn <- connectPostgreSQL db+ mapM_ (verifySql conn . declSQL) decls'+ return $ HsModule srcloc (Module modName) Nothing imports hsDecls+ where imports = [HsImportDecl srcloc (Module "Database.HDBC") + False Nothing Nothing]+ hsDecls = [dataType, initFun decls'] ++ map declFun decls'+ dataType = HsDataDecl srcloc [] stmtRec [] + [HsRecDecl srcloc stmtRec recFields] []+ mkRecField decl = ([HsIdent $ stmtRecName decl], HsBangedTy (HsTyCon $ UnQual $ HsIdent"Statement"))+ recFields = map mkRecField decls+ decls' = map updateDeclSql decls+++updateDeclSql decl = decl { declSQL = substituteVarsSql (declVars decl) (declSQL decl) }++hsapp fun = HsApp (HsVar $ UnQual $ HsSymbol fun)+hsapps fun exps = foldl HsApp (HsVar $ UnQual $ HsSymbol fun) exps+hsvar v = HsVar $ UnQual $ HsSymbol v++stmtRecName decl = "stmt_" ++ declName decl++initFun decls = + hsSimpleFun "init" ["conn"] body []+ where body = HsUnGuardedRhs $ HsDo (mkStmts ++ [returnRec])+ mkStmts = map mkStmt decls+ mkStmt decl = HsGenerator srcloc (HsPVar $ HsIdent $ declName decl)+ (hsapps "prepare" [hsvar "conn", HsLit $ HsString sqlText])+ where sqlText = show $ declSQL decl+ returnRec = HsQualifier $ hsapp "return" $ HsRecConstr (UnQual $ stmtRec) fields+ fields = map mkField decls+ mkField decl = HsFieldUpdate + (UnQual $ HsIdent $ stmtRecName decl)+ (HsVar $ UnQual $ HsIdent $ declName decl)+++declFun decl = -- TODO declLOC+ hsSimpleFun (declName decl) ("h":declVars decl) body (stmtDef : maybeTupleFun)+ where body = HsUnGuardedRhs $ HsDo (bindAndExecute:result)+ bindAndExecute = HsQualifier $ hsapps "execute" [stmt, valList]+ selectFlag = isSelect $ declSQL decl+ result + | selectFlag = [resultStmt (selectOpts $ declSQL decl) stmt]+ | otherwise = []+ maybeTupleFun + | selectFlag = [tupleFun $ selectColumnLength $ selectColumns $ declSQL decl]+ | otherwise = []+ stmt = HsVar $ UnQual $ HsSymbol "stmt"+ valList = HsList $ map mkSqlVal $ placeHoldersSql $ declSQL decl+ mkSqlVal v = hsapp "toSql" (hsvar v)+ stmtDef = HsPatBind srcloc (HsPVar $ HsIdent "stmt") + (HsUnGuardedRhs $ HsApp (HsVar $ UnQual $ HsIdent $ stmtRecName decl) (hsvar "h"))+ []++resultStmt opts stmt = HsQualifier $ hsapps "fmap" [HsParen (hsapp "fmap" (hsvar "toTuple")), HsParen (hsapp (prefix++suffix) stmt)]+ where suffix + | opts == [Strict] = "'"+ | otherwise = ""+ prefix+ | ReturnMaybe `elem` opts = "fetchRow"+ | otherwise = "fetchAllRows"++ +++tupleFun n = HsFunBind [+ HsMatch srcloc (HsIdent "toTuple") [HsPList $ map HsPVar lvars]+ (HsUnGuardedRhs (HsTuple (map convVar lvars))) []+ , HsMatch srcloc (HsIdent "toTuple") [HsPWildCard]+ (HsUnGuardedRhs (hsapp "error" $ HsLit $ HsString "hesql internal error"))+ []+ ]++ where lvars = map lvar [1..n]+ lvar i = HsIdent $ "v" ++ show i+ convVar v = hsapp "fromSql" (HsVar (UnQual v))++placeHoldersSql (SELECT _ cols from wh ord grp) =+ maybe [] placeHoldersExp wh++placeHoldersSql (INSERT _ _ vals) =+ concatMap placeHoldersExp vals++placeHoldersSql (UPDATE _ updates wh) =+ concatMap (placeHoldersExp . snd) updates +++ maybe [] placeHoldersExp wh++placeHoldersExp (SqlPlaceHolder ph) = [ph]+placeHoldersExp (SqlInfixApp e1 _ e2) = placeHoldersExp e1 ++ placeHoldersExp e2+placeHoldersExp (SqlColumn _) = []+placeHoldersExp (SqlFunApp n args) = concatMap placeHoldersExp args+placeHoldersExp (SqlLiteral _) = []+placeHoldersExp (SqlNot e) = placeHoldersExp e+ + +substituteVarsExp vars (SqlInfixApp e1 op e2) = + SqlInfixApp e1' op e2'+ where e1' = substituteVarsExp vars e1+ e2' = substituteVarsExp vars e2++substituteVarsExp _ sql@(SqlPlaceHolder _) = sql+substituteVarsExp _ sql@(SqlLiteral _) = sql+substituteVarsExp vars sql@(SqlColumn col) + | col `elem` vars = SqlPlaceHolder col+ | otherwise = sql+substituteVarsExp vars (SqlNot e) = SqlNot (substituteVarsExp vars e)++substituteVarsExp vars (SqlFunApp n args) =+ SqlFunApp n (map (substituteVarsExp vars) args)++substituteVarsSql vars (SELECT opt cols from wh ord grp) =+ SELECT opt cols from + wh'+ ord grp+ where wh' :: Maybe SqlExp+ wh' = fmap (substituteVarsExp vars) wh++substituteVarsSql vars (INSERT tab spec vals) =+ INSERT tab spec $ map (substituteVarsExp vars) vals++substituteVarsSql vars (UPDATE tab updates wh) =+ UPDATE tab updates' $ fmap (substituteVarsExp vars) wh+ where updates' = map (mapSnd $ substituteVarsExp vars) updates++++mapSnd f (a, b) = (a, f b)+ ++selectColumnLength (ExplicitColumns cols) = length cols+ +
+ HESQL/Verifier.hs view
@@ -0,0 +1,14 @@+module HESQL.Verifier where++import HESQL.Syntax+import Database.HDBC++verifySql conn sql = + handleSqlError $ do+ putStrLn $ "check " ++ sqlStr + prepare conn sqlStr >>= finish+ where sqlStr = show sql++-- TODO check column names in table.+ +
+ Makefile view
@@ -0,0 +1,17 @@+all: .configured+ ./Setup build++clean: Setup+ ./Setup clean++.configured: hesql.cabal Setup+ ./Setup configure+ touch $@++Setup: Setup.hs+ ghc --make Setup.hs++install: all+ ./Setup install++.PHONY: all clean install
+ README view
@@ -0,0 +1,95 @@+hesql - Haskell's embedded SQL++hesql is a preprocessor. It reads a file (module) with+SQL-like functions and translates it to Haskell source code.+It uses HDBC.++The result of a select statement is automatically converted+to list of tuples. Also fromSql/toSql conversion are done.++The current implementation is just a proof of concept with narrow limits.+It sticks to a subset of PostgreSQL's variant of SQL. Don't expect too+much, but please send me patches to improve hesql.++An example is found under example/Account.hesql. It works with this +tables:+++CREATE TABLE Account+ (AccountID SERIAL PRIMARY KEY,+ Login TEXT NOT NULL,+ Password TEXT NOT NULL,+ RealName TEXT,+ Email TEXT NOT NULL,+ LoggedIn BOOL DEFAULT FALSE NOT NULL,+ Locked BOOL DEFAULT FALSE NOT NULL,+ LastLogout TIMESTAMP,+ LastRequest TimeStamp DEFAULT 'now' NOT NULL+ );++CREATE UNIQUE INDEX AccountIdx ON Account(Lower(Login));++There are four select variants to use HDBC's strict/lazy fetch functions+and return a list or a maybe type.++ select: lazy, list of rows+ select': strict, list of rows+ select1: lazy, maybe row+ select1': strict, maybe row++For example:++verifyLogin login' password' =+ select1' Accountid, Login, RealName, Email from Account+ where (password is null or password = md5(password')) and Lower(Login) = login'+ and not Locked++will generate code for a Haskell-Funktion with the type:++verifyLogin :: Stmts -> String -> String -> Maybe (Int, String, String, String)++(To be honest, the type is simplified by me. hesql won't write any type annotation.)++Each module will have a function++init :: Connection -> Stmts++it prepares each statement for the later use.+++TODO+ - add a separate TODO file+ - parse group by, order, having, column/table aliases, subselects+ - verify table and column names+ - resolve column names in SELECT * FROM ...+ - fix command line argument parsing+ - improve documentation+ - make backup of old .hs-File+++INSTALL+ $ make+ $ sudo make install+++USAGE+ $ createdb account+ $ psql account++ # create the account table from above++ $ cd example/+ $ hesql Account.hesql dbname=account+ $ less Account.hs+++DEPENDENCIES:++ hesql depends on + - ghc+ - postgresql+ - HDBC with PostgreSQL backend+ - haskell-src (to print the haskell code)+ - parsec (for the SQL parser)+ +
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMainWithHooks simpleUserHooks
+ example/Account.hesql view
@@ -0,0 +1,27 @@+module Account.DB where ++-- see README for the table definitions++verifyLogin login' password' =+ select1' Accountid, Login, RealName, Email from Account+ where (password is null or password = md5(password')) and Lower(Login) = login'+ and not Locked++login accountid' =+ update Account set LoggedIn = true where AccountID = accountid'++logout acountid' =+ update Account + set LoggedIn = false, + LastLogout = Now()+ where AccountID = accountid'+ ++createAccount login 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'
+ hesql.cabal view
@@ -0,0 +1,21 @@+Name: hesql+Version: 0.0+Author: Christoph Bauer <ich@christoph-bauer.net>+Maintainer: Christoph Bauer <ich@christoph-bauer.net>+Cabal-Version: >= 1.2+Build-Type: Simple+Synopsis: Haskell's embedded SQL+Category: Database+Extra-Source-Files: README, Makefile, Setup.hs, example/Account.hesql+Description: hesql rewrites SQL-function to Haskell/HDBC-functions+license: GPL+license-file: GPL++Executable hesql+ Main-is: HESQL.hs+ Build-depends: base >= 2 && < 4, HDBC, HDBC-postgresql, haskell-src,+ filepath, parsec+ Extensions: FlexibleContexts+ Ghc-Options: -funbox-strict-fields + Other-Modules: HESQL.Parser, HESQL.Translator, HESQL.Syntax,+ HESQL.Verifier