├── .gitattributes ├── .gitignore ├── ANNOUNCE ├── AUTHORS ├── BUGS ├── ChangeLog ├── FIXED ├── HaskellDB-JH.tex ├── INSTALL ├── LICENSE ├── Makefile ├── NEWS ├── README ├── Setup.hs ├── TODO ├── driver-dynamic ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── DynConnect.hs ├── LICENSE ├── Setup.hs └── haskelldb-dynamic.cabal ├── driver-flat ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── FlatDB.hs ├── LICENSE ├── Setup.hs ├── haskelldb-flat.cabal └── tools │ └── flatdb-create.hs ├── driver-hdbc-odbc ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── HDBC │ │ └── ODBC.hs ├── LICENSE ├── Setup.hs └── haskelldb-hdbc-odbc.cabal ├── driver-hdbc-postgresql ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── HDBC │ │ └── PostgreSQL.hs ├── LICENSE ├── Setup.hs └── haskelldb-hdbc-postgresql.cabal ├── driver-hdbc-sqlite3 ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── HDBC │ │ └── SQLite3.hs ├── LICENSE ├── Setup.hs └── haskelldb-hdbc-sqlite3.cabal ├── driver-hdbc ├── Database │ └── HaskellDB │ │ └── HDBC.hs ├── LICENSE ├── Setup.hs └── haskelldb-hdbc.cabal ├── driver-hsql-mysql ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── HSQL │ │ └── MySQL.hs ├── LICENSE ├── Setup.hs └── haskelldb-hsql-mysql.cabal ├── driver-hsql-odbc ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── HSQL │ │ └── ODBC.hs ├── LICENSE ├── Setup.hs └── haskelldb-hsql-odbc.cabal ├── driver-hsql-oracle ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── HSQL │ │ └── Oracle.hs ├── LICENSE ├── Setup.hs └── haskelldb-hsql-oracle.cabal ├── driver-hsql-postgresql ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── HSQL │ │ └── PostgreSQL.hs ├── LICENSE ├── Setup.hs └── haskelldb-hsql-postgresql.cabal ├── driver-hsql-sqlite ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── HSQL │ │ └── SQLite.hs ├── LICENSE ├── Setup.hs └── haskelldb-hsql-sqlite.cabal ├── driver-hsql-sqlite3 ├── DBDirect.hs ├── Database │ └── HaskellDB │ │ └── HSQL │ │ └── SQLite3.hs ├── LICENSE ├── Setup.hs └── haskelldb-hsql-sqlite3.cabal ├── driver-hsql ├── Database │ └── HaskellDB │ │ └── HSQL.hs ├── LICENSE ├── Setup.hs └── haskelldb-hsql.cabal ├── driver-wx ├── Database │ └── HaskellDB │ │ └── WX.hs ├── LICENSE ├── Setup.hs └── haskelldb-wx.cabal ├── examples ├── .ghci ├── DB1 │ ├── Bool_tbl.hs │ ├── Calendartime_tbl.hs │ ├── Double_tbl.hs │ ├── Hdb_t1.hs │ ├── Hdb_t2.hs │ ├── Int_tbl.hs │ ├── Integer_tbl.hs │ └── String_tbl.hs └── Select.hs ├── haskelldb.cabal ├── haskelldb.pdf ├── leijen.pdf ├── set-version ├── src └── Database │ ├── HaskellDB.hs │ └── HaskellDB │ ├── BoundedList.hs │ ├── BoundedString.hs │ ├── DBDirect.hs │ ├── DBLayout.hs │ ├── DBSpec.hs │ ├── DBSpec │ ├── DBInfo.hs │ ├── DBSpecToDBDirect.hs │ ├── DBSpecToDatabase.hs │ ├── DatabaseToDBSpec.hs │ └── PPHelpers.hs │ ├── Database.hs │ ├── DriverAPI.hs │ ├── FieldType.hs │ ├── HDBRec.hs │ ├── Optimize.hs │ ├── PrimQuery.hs │ ├── PrintQuery.hs │ ├── Query.hs │ ├── Sql.hs │ ├── Sql │ ├── Default.hs │ ├── Generate.hs │ ├── MySQL.hs │ ├── PostgreSQL.hs │ ├── Print.hs │ └── SQLite.hs │ └── Version.hs ├── test ├── .ghci ├── DBTest.hs ├── DescDB1.hs ├── Makefile ├── README ├── RunTests.hs ├── TestCases.hs ├── old │ ├── CustomSql.hs │ ├── THField.hs │ ├── TestConnect.hs │ ├── big-test.hs │ ├── current-time.hs │ ├── custom-test.hs │ ├── date-types.hs │ ├── dbspec.hs │ ├── default-auto-inc.hs │ ├── hardcoded-layout-simple-query.hs │ ├── higher-order.hs │ ├── html-users-list.hs │ ├── insert-update-delete.hs │ ├── join-and-aggr.hs │ ├── join-without-restrict.hs │ ├── lazy.hs │ ├── max-row.hs │ ├── null-and-case.hs │ ├── quickcheck.hs │ ├── run-all-tests │ ├── same-name.hs │ ├── test-bounded.hs │ ├── test-non-ascii.hs │ ├── test-sum.hs │ ├── th-field-test.hs │ ├── top.hs │ └── transaction.hs ├── test-flat.hs ├── test-hdbc-postgresql.hs ├── test-hdbc-sqlite3.hs ├── test-hsql-mysql.hs ├── test-hsql-postgresql.hs ├── test-hsql-sqlite.hs └── test-hsql-sqlite3.hs └── unregister-all /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * eol=lf 3 | 4 | *.pdf -text diff=astextplain 5 | *.PDF -text diff=astextplain 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Boring file regexps: 2 | 3 | ### compiler and interpreter intermediate files 4 | # haskell (ghc) interfaces 5 | \.hi$ 6 | \.hi-boot$ 7 | \.o-boot$ 8 | # object files 9 | \.o$ 10 | \.o\.cmd$ 11 | # profiling haskell 12 | \.p_hi$ 13 | \.p_o$ 14 | # haskell program coverage resp. profiling info 15 | \.tix$ 16 | \.prof$ 17 | # fortran module files 18 | \.mod$ 19 | # linux kernel 20 | \.ko\.cmd$ 21 | \.mod\.c$ 22 | (^|/)\.tmp_versions($|/) 23 | # *.ko files aren't boring by default because they might 24 | # be Korean translations rather than kernel modules 25 | # \.ko$ 26 | # python, emacs, java byte code 27 | \.py[co]$ 28 | \.elc$ 29 | \.class$ 30 | # objects and libraries; lo and la are libtool things 31 | \.(obj|a|exe|so|lo|la)$ 32 | # compiled zsh configuration files 33 | \.zwc$ 34 | # Common LISP output files for CLISP and CMUCL 35 | \.(fas|fasl|sparcf|x86f)$ 36 | 37 | ### build and packaging systems 38 | # cabal intermediates 39 | \.installed-pkg-config 40 | \.setup-config 41 | # standard cabal build dir, might not be boring for everybody 42 | dist/ 43 | # autotools 44 | (^|/)autom4te\.cache($|/) 45 | (^|/)config\.(log|status)$ 46 | # microsoft web expression, visual studio metadata directories 47 | \_vti_cnf$ 48 | \_vti_pvt$ 49 | # gentoo tools 50 | \.revdep-rebuild.* 51 | # generated dependencies 52 | ^\.depend$ 53 | 54 | ### version control systems 55 | # cvs 56 | (^|/)CVS($|/) 57 | \.cvsignore$ 58 | # cvs, emacs locks 59 | ^\.# 60 | # rcs 61 | (^|/)RCS($|/) 62 | ,v$ 63 | # subversion 64 | (^|/)\.svn($|/) 65 | # mercurial 66 | (^|/)\.hg($|/) 67 | # git 68 | (^|/)\.git($|/) 69 | # bzr 70 | \.bzr$ 71 | # sccs 72 | (^|/)SCCS($|/) 73 | # darcs 74 | (^|/)_darcs($|/) 75 | (^|/)\.darcsrepo($|/) 76 | ^\.darcs-temp-mail$ 77 | -darcs-backup[[:digit:]]+$ 78 | # gnu arch 79 | (^|/)(\+|,) 80 | (^|/)vssver\.scc$ 81 | \.swp$ 82 | (^|/)MT($|/) 83 | (^|/)\{arch\}($|/) 84 | (^|/).arch-ids($|/) 85 | # bitkeeper 86 | (^|/)BitKeeper($|/) 87 | (^|/)ChangeSet($|/) 88 | 89 | ### miscellaneous 90 | # backup files 91 | ~$ 92 | \.bak$ 93 | \.BAK$ 94 | # patch originals and rejects 95 | \.orig$ 96 | \.rej$ 97 | # X server 98 | \..serverauth.* 99 | # image spam 100 | \# 101 | (^|/)Thumbs\.db$ 102 | # vi, emacs tags 103 | (^|/)(tags|TAGS)$ 104 | #(^|/)\.[^/] 105 | # core dumps 106 | (^|/|\.)core$ 107 | # partial broken files (KIO copy operations) 108 | \.part$ 109 | # waf files, see http://code.google.com/p/waf/ 110 | (^|/)\.waf-[[:digit:].]+-[[:digit:]]+($|/) 111 | (^|/)\.lock-wscript$ 112 | # mac os finder 113 | (^|/)\.DS_Store$ 114 | -------------------------------------------------------------------------------- /ANNOUNCE: -------------------------------------------------------------------------------- 1 | We are pleased to announce the second beta release of our "remake" of 2 | HaskellDB, version 0.9. 3 | HaskellDB is available for download from http://haskelldb.sourceforge.net 4 | 5 | HaskellDB is a Haskell library for expressing database queries and 6 | operations in a type safe and declarative way. HaskellDB compiles a 7 | relational algebra-like syntax into SQL, submits the operations to the 8 | database for processing, and returns the results as ordinary Haskell 9 | values. 10 | 11 | The original version of HaskellDB was written by Daan Leijen and is 12 | available at http://www.haskell.org/haskellDB/. The implementation is 13 | based on his paper which can be found at: 14 | http://www.cs.uu.nl/people/daan/download/papers/dsec.ps 15 | 16 | New in HaskellDB 0.9: 17 | - HaskellDB is no longer an auto-package, since this would turn on 18 | glasgow-exts even for programs that don't use HaskellDB. 19 | - Fixed various character escaping issues. There are still some 20 | problems with escaping for SQLite. 21 | - Exposed dbInfoToModuleFiles for creating database description 22 | modules from a DBInfo. 23 | - Added <<- operator to make creating constant records for insert 24 | easier. 25 | - Added _length query operator for getting the length of a string. 26 | - Made record implementation more general. 27 | - Lots of smaller fixes to code and documentation. 28 | 29 | The developers can be reached at haskelldb-users@lists.sourceforge.net or 30 | on #haskelldb at irc.freenode.net. 31 | 32 | / The HaskellDB development team 33 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/m4dc4p/haskelldb/a1fbc8a2eca8c70ebe382bf4c022275836d9d510/AUTHORS -------------------------------------------------------------------------------- /BUGS: -------------------------------------------------------------------------------- 1 | The HaskellDB bug tracker can be found at: 2 | 3 | http://sourceforge.net/tracker/?group_id=101095&atid=629040 4 | 5 | This is a partial list of known problems in HaskellDB: 6 | 7 | - Character escapes are not compatible with SQLite. 8 | 9 | - There is currently no boolean type in HaskellDB. Some databases 10 | implement this best using tinyint, some using boolean, and so on. The 11 | "standard" portable way of doing this seems to be using tinyint, but 12 | should this be something we decide? If we do, tinyint cannot be used for 13 | anything else 14 | 15 | - Inserting values into TIME columns in PostgreSQL does not work, 16 | since PostgreSQL doesn't like getting date and time as input to a 17 | TIME column. We're working on a general solution to date handling issues. 18 | 19 | - When using PostgreSQL with HSQL ODBC and wxHaskell, TIMESTAMP 20 | columns are treated as String fields. This seems to be a problem 21 | with the PostgreSQL ODBC driver. 22 | 23 | - wxHaskell with PostgreSQL (at least) gives "user error" when trying to 24 | get query results containing a CalendarTime value. 25 | 26 | - Since SQLite is untyped, all columns in SQLite databases are treated 27 | as having type String, even if some other type was used when the 28 | table was created. 29 | 30 | - When compiling DbDirect-generated code for tables with many columns, 31 | GHC may need the -fcontext-stackXX flag, where XX needs to be at 32 | least around the number of columns in the largest table. Chucky tried 33 | to fix this by adding it as an OPTIONS pragma at the top of every 34 | generated file, but it turns out this is not currently supported by 35 | GHC. The code remains in case the GHC team starts to support it. 36 | 37 | - When using lazyQuery with the MySQL driver and running a second 38 | query without retrieving all data from the first, you get the 39 | error "Commands out of sync; You can't run this command now". 40 | 41 | - WXHaskell _REQUIRES_ that all changes that we want committed are wrapped 42 | in transactions. We currently do not do this, it is up to the user. 43 | 44 | - There is no way to do grouping explicitly, and tricking HaskellDB 45 | into doing the right thing is not always easy. Currently, if a 46 | project contains aggregate expressions, the results are grouped 47 | by all non-aggregate fields in the project. 48 | 49 | - The wxHaskell backend doesn't work in Hugs. 50 | 51 | - MySQL does case-insensitive comparison with LIKE, PostgreSQL does 52 | case-sensititve. PostgreSQL uses ILIKE for case-insensitive 53 | matching. We need to make 'like' do the same for all backends. 54 | Reported by shapr. 55 | 56 | - The following features are currently not supported: 57 | * stored procedures 58 | * natural joins (just use restrict) 59 | * db-specific types and functions 60 | * db-specific syntax (for example, only TOP is supported to limit 61 | the number of results) 62 | * db-specific quoting rules 63 | * db-specific restrictions on column and database names 64 | * db-specific table options (such as the table type in MySQL) 65 | * getting the value inserted into an auto_increment column. 66 | 67 | - PostgreSQL does not accept inserting default values into non-null 68 | columns which do not have a set default value. 69 | 70 | - Tables in unions may get the same table alias, which Not A Good 71 | Thing. This is a problem i Sql.ppSql. 72 | 73 | - When querying a Microsoft Access database using the ODBC driver, 74 | you can get the error "The field is too small to accept the 75 | amount of data you attempted to add." if the query includes a 76 | field of type Memo. This is because HaskellDB queries 77 | use SELECT DISTINCT, which Access does not like on Memo fields 78 | for some reason. Reported by Esa Ilari Vuokko on 2004-04-27. 79 | 80 | - When getting results from a TIMESTAMP column from Microsoft Access 81 | under wxHaskell, the ODBC driver gives the error: 82 | "[Microsoft][ODBC Driver Manager] Program type out of range". 83 | The only know workaround is to hack the DBDirect-generated 84 | table layout to prented that the field has type String and use 85 | the date as a string. 86 | Reported by Esa Ilari Vuokko on 2004-04-27. 87 | 88 | - Dates before 1970 are not handled correctly. 89 | Reported by Mary on 2004-05-02. 90 | 91 | - When using HSQL ODBC with MySQL, AUTO_INCREMENT fields 92 | are reported as nullable. 93 | 94 | - When using HSQL ODBC with PostgreSQL, the result of a SUM() is 95 | reported as SqlVarChar 19, which means that it can't be treated 96 | as a number. 97 | 98 | - If a relation has two fields with the same name, only one of the values 99 | can be accessed. Reported by Jeremy Shaw on 2004-05-04. 100 | 101 | - Some aggregate expressions (_max, _min etc.) return NULL when the 102 | relation has now rows. This is not reflected in their type, which 103 | can cause runtime errors. Reported by Gregory Wright on 2004-05-10. 104 | 105 | - It is possible to set fields in an update that are not present in the 106 | table being changed. The code compiles, but fails at runtime. This bug 107 | was present in the original haskellDB and was found by Bjorn on 108 | 2004-05-11. 109 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/m4dc4p/haskelldb/a1fbc8a2eca8c70ebe382bf4c022275836d9d510/ChangeLog -------------------------------------------------------------------------------- /FIXED: -------------------------------------------------------------------------------- 1 | This is where we keep track of reported and fixed bugs and feature 2 | requests, mostly for bragging rights at the end of the project: 3 | 4 | - Krasimir Angelov reported these two bugs 2004-02-04: 5 | 6 | * "The PrimQuery imports List module instead of 7 | Data.List which make HaskellDB dependent from 8 | Haskell98 package. In the haskelldb.pkg script the 9 | Haskell98 package is not added in the dependency list. 10 | The package works well with modified PrimQuery where 11 | the List is replaced with Data.List." 12 | 13 | * "In the makefile the ghc-pkg tool is called with 14 | -g option to autogenerate library for GHCi. The 15 | trouble here is that if there already exist HShdb.o 16 | object then the tool ignores the option. The work 17 | arround which I use in HSQL is to remove HShdb.o from 18 | the GHC directory before the install phase." 19 | 20 | Bjorn fixed these bugs on 2004-02-04. 21 | 22 | - shapr reported a bug in Dbdirect 2004-02-07. For some reason DbDirect 23 | didn't generate Tables that had a Maybe type for String, it just made them 24 | String. Chucky fixed this on 2004-02-08 25 | 26 | - shapr reported a bug in Dbdirect 2004-02-11, where a Table and a Field, 27 | if they had the same name, would clash in the generated file. Chucky 28 | fixed this on 2004-02-17 29 | 30 | - viblo reported 2004-02-18 that top and topPercent produce invalid 31 | SQL. Bjorn fixed top and removed topPercent on 2004-02-22. 32 | 33 | - viblo reported 2004-02-18 that union produces invalid SQL. Bjorn 34 | fixed this on 2004-02-22. 35 | 36 | - Jeremy Shaw (stepcut), reported 2004-02-29 that dates were not 37 | formatted correctly, and were not quoted (e.g. 2004-February-27 38 | 12:0:0). Bjorn had already fixed this problem 2004-02-26. 39 | 40 | - viblo reported a memory leak of about 10k per query on 2004-02-18?. 41 | Bjorn patched HSQL 2004-02-28 to fix it. 42 | 43 | - Bjorn found 2004-02-26 that HSQL didn't handle DECIMAL fields as 44 | Doubles. Bjorn fixed that 2004-02-26. 45 | 46 | - We all thought that {odbc,mysql,postgresql}Connect should take 47 | a Database argument instead of a HSQL argument. This would allow 48 | more general type signatures in user code. Bjorn fixed that 2004-03-06. 49 | 50 | - Jeremy Shaw (stepcut), suggested on 2004-02-24 that there should 51 | be Show and Read instances for database records. This is useful 52 | for saving state in for example WASH. Bjorn fixed that 2004-03-06. 53 | 54 | - Jeremy Shaw (stepcut), submitted patches on 2004-03-06 adding SQLite 55 | support and fixing the distclean target. The were added to CVS 56 | the same day. 57 | 58 | - Shae Erisson (shapr) reported on 2004-03-22 that the HSQL driver 59 | only catches SqlErrors in connect. Should do it for each call. 60 | Bjorn fixed this in the HSQL and WX drivers on 2004-03-22. 61 | 62 | - Shae Erisson (shapr) discovered on 2004-03-24 that there is no way 63 | to use a nullable expression with many of the functions (e.g. like). 64 | Bjorn fxed this by adding fromNull on 2004-03-24. 65 | 66 | - viblo reported that using aggregate functions outside of 67 | project (e.g. in restrict) generates invalid SQL. Bjorn 68 | changed the type system to make this impossible on 2004-04-07. 69 | 70 | - Jeremy Shaw (stepcut) requested support for default values and auto 71 | increment columns on 2004-03-16. Bjorn added this on 2004-04-07. 72 | 73 | - Thomas Bevan reported on 2004-03-16 that joins without a restrict 74 | generate SQL that uses non-existing field names. This was an 75 | optimization bug that Bjorn fixed on 2004-04-08. 76 | 77 | - Bjorn found on 2004-04-07 that queries without a table created an 78 | empty query. This was an optimization bug that Bjorn fixed on 79 | 2004-04-08. 80 | 81 | - The name of the DBInfo generated by DBDirect for a database 82 | is not converted to have an intial lower case letter if the 83 | user gives a name with an uppercase letter on the command line. 84 | Reported by Tom Moertel (tmoertel) on 2004-04-27. Fixed 85 | by Chucky on 2004-04-29. 86 | -------------------------------------------------------------------------------- /HaskellDB-JH.tex: -------------------------------------------------------------------------------- 1 | % HaskellDB-JH.tex 2 | \begin{hcarentry}[new]{HaskellDB} 3 | \report{Justin Bailey}%11/10 4 | \status{active development} 5 | \makeheader 6 | 7 | Scrap your SQL strings! The HaskellDB library provides a set of 8 | combinators based on the ``relational algebra'' for expressing 9 | queries, inserts, and updates. It lets you abstract over every part of 10 | your query, from conditions, to tables, to the columns 11 | returned. HaskellDB uses the HDBC family of database drivers to talk to a 12 | wide variety of databases. 13 | 14 | \FurtherReading 15 | \url{http://trac.haskell.org/haskelldb} 16 | \end{hcarentry} 17 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | Installation with Cabal: 2 | 3 | NOTE: you may need to upgrade Cabal to get this to work. 4 | 5 | - Install the main package (haskelldb): 6 | 7 | runghc Setup.hs configure 8 | runghc Setup.hs build 9 | runghc Setup.hs install 10 | 11 | - Install the hs-plugins backend which loads drivers 12 | dynamically (requires at least the current, as of 13 | 2005-12-09, darcs version of hs-plugins). 14 | 15 | This also compiles and installs DBDirect. 16 | 17 | cd driver-dynamic 18 | runghc Setup.hs configure 19 | runghc Setup.hs build 20 | runghc Setup.hs install 21 | cd .. 22 | 23 | - Install HSQL drivers (you need driver-hsql and 24 | the backends you want to use): 25 | 26 | cd driver-hsql 27 | runghc Setup.hs configure 28 | runghc Setup.hs build 29 | runghc Setup.hs install 30 | cd .. 31 | 32 | cd driver-hsql-mysql 33 | runghc Setup.hs configure 34 | runghc Setup.hs build 35 | runghc Setup.hs install 36 | cd .. 37 | 38 | cd driver-hsql-postgresql 39 | runghc Setup.hs configure 40 | runghc Setup.hs build 41 | runghc Setup.hs install 42 | cd .. 43 | 44 | cd driver-hsql-odbc 45 | runghc Setup.hs configure 46 | runghc Setup.hs build 47 | runghc Setup.hs install 48 | cd .. 49 | 50 | cd driver-hsql-sqlite 51 | runghc Setup.hs configure 52 | runghc Setup.hs build 53 | runghc Setup.hs install 54 | cd .. 55 | 56 | - Install the WXHaskell driver: 57 | 58 | cd driver-wx 59 | runghc Setup.hs configure 60 | runghc Setup.hs build 61 | runghc Setup.hs install 62 | cd .. 63 | 64 | 65 | 66 | 67 | Requirements: 68 | 69 | - GHC 6.4 or newer 70 | 71 | - A recent verion of Cabal (newer than that which comes with GHC 6.4[.1], 72 | I'm not sure about the exact version requirement). 73 | 74 | - Hugs ??? HaskellDB used to work with Hugs, does it still? 75 | 76 | 77 | A database driver, at least one of: 78 | 79 | - HSQL (http://htoolkit.sourceforge.net/), version 1.7 or later. 80 | 81 | Use Cabal to install the HSQL backends that you want to use. 82 | 83 | * Extra requirements for Windows 84 | 85 | - Cygwin (found at www.cygwin.com) 86 | Except the default packages you will also need Make and GCC 87 | 88 | - Microsoft Data Access Components (MDAC) SDK (found at 89 | http://www.msdn.com/download) 90 | 91 | - wxHaskell (http://wxhaskell.sourceforge.net/) 92 | 93 | wxHaskell's database support requires wxWidgets built with ODBC 94 | support, which is not enabled by default. 95 | 96 | 97 | Database support: 98 | 99 | - HSQL ODBC 100 | 101 | HaskellDB should work with all ODBC drivers, assuming that the database 102 | supports the queries generated by HaskellDB. This does for exaemple 103 | currently not include the stable version of MySQL, see below. 104 | 105 | - HSQL MySQL 106 | 107 | HaskellDB only works with MySQL version >= 4.1 since earlier 108 | versions don't support nested subqueries. 109 | 110 | It is currently not possible to build HSQL's MySQL support under 111 | Windows. If you figure it out, let us know. 112 | 113 | MySQL only supports transactions on transaction-safe table types, 114 | such as InnoDB and BDB. The default table type, MyISAM, does not 115 | support transactions. See the MySQL manual for more information. 116 | 117 | MySQL 4.1 does not support intersect. 118 | 119 | - HSQL PostgreSQL 120 | 121 | Works. 122 | 123 | - HSQL SQLite 124 | 125 | Works, but since SQLite is untyped, DBDirect reports the types of 126 | all columns in SQLite databases as String, even if some other type 127 | was used when the table was created. To work around this, create the 128 | database description modules using 129 | 130 | Database.HaskellDB.DBSpec.DBSpecToDBDirect.dbInfoToModuleFiles 131 | 132 | There are some problems with escaping of certain characters 133 | (whitspace and backslash) for SQLite, sicne SQLite does not expect 134 | them to be escaped. 135 | 136 | - wxHaskell 137 | 138 | Works only with GHC. Does not work with MySQL as far as we know. 139 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: haddock haddock-clean 2 | 3 | haddock: 4 | find src/Database driver-*/Database -name '*.hs' | xargs haddock -h -o doc/api 5 | 6 | haddock-clean: 7 | -rm -f doc/api/* -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | HaskellDB 0.9: 2004-08-19 2 | 3 | - HaskellDB is no longer an auto-package, since this would turn on 4 | glasgow-exts even for programs that don't use HaskellDB. 5 | - Fixed various character escaping issues. There are still some 6 | problems with escaping for SQLite. 7 | - Exposed dbInfoToModuleFiles for creating database description 8 | modules from a DBInfo. 9 | - Added <<- operator to make creating constant records for insert 10 | easier. 11 | - Added _length query operator for getting the length of a string. 12 | - Made record implementation more general. 13 | - Lots of smaller fixes to code and documentation. 14 | 15 | HaskellDB Improved accepted to Haskell Workshop 2004: 2004-07-05 16 | 17 | The paper "HaskellDB Improved" has been accepted for publication as a 18 | Student Paper as Haskell Workshop 2004. 19 | 20 | HaskellDB 0.8: 2004-05-04 21 | 22 | - Improved compatibility with Microsoft Access 23 | - Internal restructuring of code 24 | - DBDirect generated files are now cleaner and more portable across 25 | HaskellDB versions 26 | - More test programs 27 | 28 | HaskellDB 0.7: 2004-03-31 29 | 30 | - Added functions for creating and dropping tables and databases. 31 | Too be improved in future releases. 32 | - Support for wxHaskell when using GHC. 33 | - Support for SQLite, thanks to a patch from Jeremy Shaw. 34 | - Overloaded (!) can be used for both (!) and (!.). 35 | - Compiling for Hugs does not require GHC. 36 | - Added function for converting from nullable types. Suggested by Shae Erisson. 37 | - Added case construct. 38 | - A GenericConnect is now available. Uses similar syntax to DBDirect. 39 | - Backend interface changed to make function types backend independent. 40 | - Queries now return records instead of backend specific types. 41 | 42 | HaskellDB 0.6: 2004-03-03 43 | 44 | - Bounded lists and bounded strings. 45 | - Vastly increased performance. On reasonably modern computers, I/O is now 46 | the limiting factor when doing database operations. 47 | - Transactions are now supported. 48 | - Some error messages (esp. some type errors) are easier to understand. 49 | - Better documentation. 50 | - Many, many bug fixes. 51 | 52 | HaskellDB 0.5, changes from Daan Leijen's HaskellDB: 2003-01-04 53 | 54 | - Support for both GHC and Hugs. 55 | - Redesigned type system to remove dependency on Typed Record Extensions. 56 | - Uses HSQL to access ODBC, MySQL and PostgreSQL databases. 57 | - Fixed various bugs. 58 | - Haddock documentation. 59 | - Uses standard library where possible. 60 | - Metadata functions have been added. 61 | - Dbdirect now uses metadata functions to generate database info. 62 | - Dbdirect produces files in a new format. 63 | - Proper build system (using autoconf/configure/GNU make). 64 | - Uses new notation compared to Leijen's HaskellDB. 65 | - Two old HaskellDB functions have been changed. The old insert is now 66 | insertQuery. The old insertNew is now insert. 67 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | For installation instructions, see the INSTALL file. 2 | 3 | 4 | HaskellDB is a Haskell library for expressing database queries and 5 | operations in a type safe and declarative way. HaskellDB compiles a 6 | relational algebra-like syntax into SQL, submits the operations to the 7 | database for processing, and returns the results as ordinary Haskell 8 | values. 9 | 10 | HaskellDB is written entirely in Haskell and works under both the 11 | Glasgow Haskell Compiler (GHC) and the Hugs Haskell interpreter. The 12 | library is designed to to support multiple database backends. 13 | 14 | Currently supported database backends are: 15 | * HSQL (http://htoolkit.sourceforge.net/). HSQL's bindings to ODBC, MySQL, 16 | PostgreSQL and SQLite are currently supported. 17 | * wxHaskell (http://wxhaskell.sourceforge.net/) 18 | 19 | HaskellDB is intended to be platform independent. It should be 20 | possible to use HaskellDB on any platform that has a supported Haskell 21 | implementation and that is supported by the database backend. 22 | 23 | HaskellDB was originally written by Daan Leijen and its design is 24 | described in the paper Domain Specific Embedded Compilers, Daan Leijen 25 | and Erik Meijer. 2nd USENIX Conference on Domain-Specific Languages 26 | (DSL), Austin, USA, October 1999. That version of HaskellDB was 27 | published in 1999 and has been available from 28 | http://www.haskell.org/haskellDB/ since then. 29 | 30 | The original version implements the entire HaskellDB combinator 31 | library, but has some practical drawbacks. It requires certain 32 | extensions (most notably the typed records extensions) which, in the 33 | form that are used by HaskellDB, are only available in antiquated 34 | versions of the Hugs interpreter. Furthermore, the original HaskellDB 35 | only supports a Windows-specific ADO-based database backend. 36 | 37 | The new version of HaskellDB was produced as a student project at 38 | Chalmers University of Technology in Gothenburg, Sweden. The aim of the 39 | project was to make HaskellDB a practically useful database library. 40 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | Things that need to be done, in no particular order: 2 | 3 | - Code: 4 | * Handle dates correctly. 5 | - Handle dates before 1970. 6 | - Distinguish between date / time / date & time. 7 | * Overload operators so that when they take a maybe, they always 8 | return maybe, i.e. .<. may give NULL when one of the arguments 9 | is NULL. Suggested by eivuokko. 10 | * Support like, cat etc. on nullable arguments. 11 | * Support all SQL datatypes 12 | * make SQL generation tweakable by the DB driver, since different 13 | DBs have different SQL syntax, for example TOP / LIMIT. 14 | Added by Bjorn, suggested by Shae Erisson. 15 | * Figure out some intutive way of doing grouping. 16 | * Fix semantics of lazyQuery. 17 | * Fix table alias clashes with binary relops. 18 | * Allow using queries in expressions. 19 | * Change types of aggregate expressions that can return NULL when the 20 | table is empty to reflect the nullability. 21 | * Fix typing bug where update does not check that all fields are in the 22 | table (probably by adding a subtyping relation on records). 23 | (* strictness checking. In other words: optimize the code to sort out what 24 | types and expressions are evaluated strictly, and explicitly tell the 25 | compiler that they are strict) 26 | (* maybe make it work on multi-processor systems using Concurrent Haskell?) 27 | (* try to compile with nhc98. It would be nice to support all three 28 | available Haskell compilers) 29 | (* Add features for modifying tables /Added by Bjorn, 30 | suggested by Shae Erisson) 31 | (* use template haskell to compile queries to SQL at compile time 32 | /Added by Bjorn, thanks to Anders Carlsson for inspiration ) 33 | 34 | - DbDirect 35 | * Set sensible default values for all NOT NULL columns. 36 | (* add optional command line argument for selecting which 37 | tables to generate code for) 38 | 39 | - Installation 40 | * Install targets should install DbDirect and the documentation. 41 | * Packages (separate binary packages for Hugs and GHC?)) 42 | - Source tarball 43 | - Linux binary and source RPMs (debs, ebuild?) 44 | - Windows installer (MSI?) 45 | 46 | - Build system 47 | 48 | - Database drivers 49 | 50 | * Add more drivers: 51 | - Oracle (http://cvs.sf.net/viewcvs.py/haskell-libs/libs/takusen/) 52 | 53 | * wxHaskell: 54 | - Figure out how to handle wrapping wxHaskell execute calls 55 | in transactions intelligently. 56 | - Make dbQuery lazy. 57 | - Make it work in Hugs. 58 | 59 | * SQLite: 60 | - Make SQLite report more useful types. Make HSQL parse the original 61 | create query from the meta-table? 62 | 63 | - Documentation 64 | * Haddock comments on all exported functions, classes and types 65 | * Tutorial 66 | * Example programs 67 | 68 | - Testing 69 | * Test on Windows, Solaris, Linux, Mac OS X 70 | * Test against different DB systems, at least MySQL, PostgreSQL, 71 | Oracle 72 | * Test under GHC and Hugs 73 | * Test all functions 74 | * Test all datatypes 75 | * Test NULL and NOT NULL fields 76 | 77 | - Misc 78 | * Get an allocated name in the hierarchical library namespace 79 | (Database.HaskellDB?) 80 | 81 | -------------------------------------------------------------------------------- /driver-dynamic/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.DynConnect 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-dynamic/Database/HaskellDB/DynConnect.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.DynConnect 4 | -- Copyright : Anders Hockersten 2004, chucky@dtek.chalmers.se 5 | -- Bjorn Bringert 2005-2006 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : chucky@dtek.chalmers.se 9 | -- Stability : experimental 10 | -- Portability : portable 11 | -- 12 | -- This contains functions for loading drivers dynamically 13 | -- and connecting to databases using them. 14 | ----------------------------------------------------------- 15 | 16 | module Database.HaskellDB.DynConnect ( 17 | driver, 18 | dynConnect, 19 | dynConnect_ 20 | ) where 21 | 22 | import Database.HaskellDB.Database (Database) 23 | import Database.HaskellDB.DriverAPI 24 | import Database.HaskellDB.Version 25 | 26 | import System.Plugins (loadPackageFunction) 27 | 28 | import Control.Monad.Trans (MonadIO, liftIO) 29 | import Data.Char 30 | import Data.List (isPrefixOf) 31 | 32 | driver :: DriverInterface 33 | driver = defaultdriver { 34 | connect = \opts f -> do [driver] <- getOptions ["driver"] opts 35 | dynConnect_ driver opts f 36 | } 37 | 38 | -- | Loads a driver by package and module name. 39 | dynConnect :: MonadIO m => 40 | String -- ^ Driver package 41 | -> String -- ^ Driver module 42 | -> [(String,String)] -- ^ Options to the driver 43 | -> (Database -> m a) -- ^ Database action to run 44 | -> m a 45 | dynConnect p m opts f = 46 | do 47 | res <- liftIO $ loadPackageFunction p m "driver" 48 | v <- case res of 49 | Nothing -> fail $ "Couldn't load " ++ m ++ ".driver" 50 | ++ " from package " ++ p 51 | Just v -> return v 52 | connect v opts f 53 | 54 | -- | Load a driver by a simple driver name corresponding to the 55 | -- package suffix 56 | dynConnect_ :: MonadIO m => 57 | String -- ^ Driver package suffix, e.g. "WX", "HSQL.MySQL", 58 | -- "HDBC.PostgreSQL" 59 | -> [(String,String)] -- ^ Arguments to the driver 60 | -> (Database -> m a) -- ^ Database action to run 61 | -> m a 62 | dynConnect_ d opts f = 63 | dynConnect p m opts f 64 | where p = "haskelldb-" ++ (map c d) ++ "-" ++ version 65 | m = "Database.HaskellDB." ++ d 66 | c x = if x == '.' then '-' else toLower x 67 | -------------------------------------------------------------------------------- /driver-dynamic/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-dynamic/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-dynamic/haskelldb-dynamic.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-dynamic 2 | Version: 1.0.0 3 | Cabal-version: >= 1.6 4 | Homepage: https://github.com/m4dc4p/haskelldb 5 | Build-type: Simple 6 | Copyright: The authors 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for the dynamically loaded drivers. 12 | Category: Database 13 | 14 | Library 15 | Build-depends: haskell98, mtl, haskelldb, plugins, base >= 3 && < 5 16 | Extensions: ExistentialQuantification, 17 | OverlappingInstances, 18 | UndecidableInstances, 19 | MultiParamTypeClasses 20 | Exposed-Modules: 21 | Database.HaskellDB.DynConnect 22 | 23 | Executable DBDirect-dynamic 24 | Main-is: DBDirect.hs 25 | Build-depends: haskelldb==0.11 26 | 27 | Source-repository head 28 | Type: git 29 | Location: https://github.com/m4dc4p/haskelldb 30 | -------------------------------------------------------------------------------- /driver-flat/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.FlatDB 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-flat/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-flat/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-flat/haskelldb-flat.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-flat 2 | Version: 1.0.1 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Homepage: https://github.com/m4dc4p/haskelldb 6 | Maintainer: Maintainer: haskelldb-users@lists.sourceforge.net 7 | License-file: LICENSE 8 | Copyright: Bjorn Bringert 9 | Author: Bjorn Bringert 10 | License: BSD3 11 | Synopsis: An experimental HaskellDB back-end in pure Haskell (no SQL) 12 | Description: 13 | This is a very experimental HaskellDB back-end which is written in pure Haskell 14 | and doesn't use SQL. It stores the database in a file. Using this with 15 | concurrent writes leads to data loss. This back-end does not support transactions. 16 | Category: Database 17 | 18 | Flag split-base 19 | 20 | Library 21 | Build-depends: mtl, haskelldb >= 1 && < 2 22 | if flag(split-base) 23 | Build-depends: base >= 3 && < 5, containers, old-time >= 1 && < 2, directory >= 1 && < 2 24 | else 25 | Build-depends: base < 3.0 26 | Exposed-Modules: Database.HaskellDB.FlatDB 27 | 28 | Executable DBDirect-flat 29 | Main-is: DBDirect.hs 30 | 31 | Source-repository head 32 | Type: git 33 | Location: https://github.com/m4dc4p/haskelldb 34 | -------------------------------------------------------------------------------- /driver-flat/tools/flatdb-create.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.FlatDB 2 | 3 | import System.Environment 4 | import System.IO 5 | 6 | main :: IO () 7 | main = do args <- getArgs 8 | case args of 9 | [f] -> newDB f 10 | _ -> hPutStrLn stderr "Usage: flatdb-create " -------------------------------------------------------------------------------- /driver-hdbc-odbc/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HDBC.ODBC 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-hdbc-odbc/Database/HaskellDB/HDBC/ODBC.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.HDBC.ODBC 4 | -- Copyright : HWT Group (c) 2003, Bjorn Bringert (c) 2006 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | ----------------------------------------------------------- 12 | module Database.HaskellDB.HDBC.ODBC ( 13 | odbcConnect, 14 | DriverInterface(..), driver 15 | ) where 16 | 17 | import Database.HaskellDB.Database 18 | import Database.HaskellDB.HDBC 19 | import Database.HaskellDB.DriverAPI 20 | import Database.HaskellDB.Sql.Generate (SqlGenerator) 21 | 22 | import Database.HDBC.ODBC (connectODBC) 23 | 24 | odbcConnect :: MonadIO m => SqlGenerator -> [(String,String)] -> (Database -> m a) -> m a 25 | odbcConnect gen opts = hdbcConnect gen (connectODBC conninfo) 26 | -- strangely enough, mysql+unixodbc want a semicolon terminating connstring 27 | where conninfo = foldr (\(k,v) z -> k ++ "=" ++ v ++ ";" ++ z) [] opts 28 | 29 | options :: [(String, String)] 30 | options = 31 | [] 32 | 33 | odbcConnectOpts :: MonadIO m => [(String,String)] -> (Database -> m a) -> m a 34 | odbcConnectOpts opts f = 35 | do gen <- getGenerator opts 36 | let opts' = filter ((/="generator") . fst) opts 37 | odbcConnect gen opts' f 38 | 39 | -- | This driver passes its options through to HDBC. 40 | driver :: DriverInterface 41 | driver = defaultdriver { connect = odbcConnectOpts, requiredOptions = options } 42 | -------------------------------------------------------------------------------- /driver-hdbc-odbc/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hdbc-odbc/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hdbc-odbc/haskelldb-hdbc-odbc.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hdbc-odbc 2 | Version: 2.1.2 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Copyright: The authors 6 | Homepage: https://github.com/m4dc4p/haskelldb 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for the HDBC ODBC driver. 12 | Description: HaskellDB requires this driver if HDBC will be used to connect to an ODBC database. 13 | Category: Database 14 | 15 | Library 16 | Build-depends: 17 | mtl >= 1 && < 3, 18 | haskelldb >= 2 && < 3, 19 | haskelldb-hdbc >= 2 && < 3, 20 | HDBC >= 2 && < 3, 21 | HDBC-odbc >= 2 && < 3, 22 | base >= 3 && < 5 23 | 24 | Exposed-Modules: 25 | Database.HaskellDB.HDBC.ODBC 26 | 27 | Executable DBDirect-hdbc-odbc 28 | Main-is: DBDirect.hs 29 | 30 | Source-repository head 31 | Type: git 32 | Location: https://github.com/m4dc4p/haskelldb 33 | -------------------------------------------------------------------------------- /driver-hdbc-postgresql/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HDBC.PostgreSQL 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-hdbc-postgresql/Database/HaskellDB/HDBC/PostgreSQL.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.HDBC.PostgreSQL 4 | -- Copyright : HWT Group (c) 2003, Bjorn Bringert (c) 2005 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | ----------------------------------------------------------- 12 | module Database.HaskellDB.HDBC.PostgreSQL ( 13 | postgresqlConnect, 14 | DriverInterface(..), 15 | driver 16 | ) where 17 | 18 | import Database.HaskellDB.Database 19 | import Database.HaskellDB.HDBC 20 | import Database.HaskellDB.DriverAPI 21 | import Database.HaskellDB.Sql.PostgreSQL 22 | 23 | import Database.HDBC.PostgreSQL (connectPostgreSQL) 24 | 25 | postgresqlConnect :: MonadIO m => [(String,String)] -> (Database -> m a) -> m a 26 | postgresqlConnect opts = hdbcConnect generator (connectPostgreSQL conninfo) 27 | where conninfo = unwords [ k ++ "=" ++ v | (k,v) <- opts] 28 | 29 | -- | This driver passes its options through to HDBC. 30 | -- HDBC refers to 31 | -- 32 | -- for the meaning of the options. 33 | driver :: DriverInterface 34 | driver = defaultdriver { connect = postgresqlConnect 35 | , requiredOptions = [] } 36 | -------------------------------------------------------------------------------- /driver-hdbc-postgresql/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hdbc-postgresql/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hdbc-postgresql/haskelldb-hdbc-postgresql.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hdbc-postgresql 2 | Version: 2.1.2 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Homepage: https://github.com/m4dc4p/haskelldb 6 | Copyright: The authors 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for the HDBC PostgreSQL driver. 12 | Description: HaskellDB requires this driver if HDBC will be used to connect to a PostgreSQL database. 13 | Category: Database 14 | 15 | Library 16 | Build-depends: 17 | mtl >= 1 && < 3, 18 | haskelldb >= 2 && < 3, 19 | haskelldb-hdbc >= 2 && < 3, 20 | HDBC >= 2 && < 3, 21 | HDBC-postgresql >= 2 && < 3, 22 | base >= 3 && < 5 23 | 24 | Exposed-Modules: 25 | Database.HaskellDB.HDBC.PostgreSQL 26 | ghc-options: -fwarn-incomplete-patterns 27 | 28 | -- Note: Extra library and include directories must be passed on commandline: 29 | -- cabal install --extra-include-dirs="F:\Program Files\PostgreSQL\8.4\include" --extra-include-dirs="F:\Program Files\PostgreSQL\8.4\include\server" --extra-lib-dirs="F:\Program Files\PostgreSQL\8.4\bin" 30 | Executable DBDirect-hdbc-postgresql 31 | Main-is: DBDirect.hs 32 | Include-dirs: . 33 | Extra-Libraries: pq 34 | 35 | Source-repository head 36 | Type: git 37 | Location: https://github.com/m4dc4p/haskelldb 38 | 39 | -------------------------------------------------------------------------------- /driver-hdbc-sqlite3/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HDBC.SQLite3 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-hdbc-sqlite3/Database/HaskellDB/HDBC/SQLite3.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.HDBC.SQLite3 4 | -- Copyright : HWT Group 2003, 5 | -- Bjorn Bringert 2005-2006 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : haskelldb-users@lists.sourceforge.net 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | -- Interface to the HDBC sqlite3 back-end. 13 | -- 14 | ----------------------------------------------------------- 15 | module Database.HaskellDB.HDBC.SQLite3 ( 16 | SQLiteOptions(..), sqliteConnect, 17 | DriverInterface(..), driver 18 | ) where 19 | 20 | import Database.HaskellDB.Database 21 | import Database.HaskellDB.HDBC 22 | import Database.HaskellDB.DriverAPI 23 | import Database.HaskellDB.Sql.SQLite as SQLite 24 | import Database.HDBC.Sqlite3 (connectSqlite3) 25 | 26 | import System.IO 27 | 28 | data SQLiteOptions = SQLiteOptions { 29 | filepath :: FilePath 30 | } 31 | 32 | sqliteConnect :: MonadIO m => FilePath -> (Database -> m a) -> m a 33 | sqliteConnect path = hdbcConnect SQLite.generator (connectSqlite3 path) 34 | 35 | options :: [(String, String)] 36 | options = 37 | ("filepath", "File path") : 38 | [] 39 | 40 | sqliteConnectOpts :: MonadIO m => [(String,String)] -> (Database -> m a) -> m a 41 | sqliteConnectOpts opts f = 42 | do 43 | [a] <- getAnnotatedOptions options opts 44 | sqliteConnect a f 45 | 46 | -- | This driver requires the following options: 47 | -- "filepath" 48 | driver :: DriverInterface 49 | driver = defaultdriver {connect = sqliteConnectOpts, requiredOptions = options} 50 | -------------------------------------------------------------------------------- /driver-hdbc-sqlite3/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hdbc-sqlite3/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hdbc-sqlite3/haskelldb-hdbc-sqlite3.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hdbc-sqlite3 2 | Version: 2.1.2 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Copyright: The authors 6 | Homepage: https://github.com/m4dc4p/haskelldb 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for the HDBC SQLite driver. 12 | Description: HaskellDB requires this driver if HDBC will be used to connect to a SQLlite3 database. 13 | Category: Database 14 | 15 | Library 16 | Build-depends: 17 | mtl >= 1 && < 3, 18 | haskelldb >= 2 && < 3, 19 | haskelldb-hdbc >= 2 && < 3, 20 | HDBC >= 2 && < 3, HDBC-sqlite3 >= 2 && < 3, 21 | base >= 3 && < 5 22 | 23 | Extensions: ExistentialQuantification, 24 | OverlappingInstances, 25 | UndecidableInstances, 26 | MultiParamTypeClasses 27 | Exposed-Modules: 28 | Database.HaskellDB.HDBC.SQLite3 29 | 30 | Executable DBDirect-hdbc-sqlite3 31 | Main-is: DBDirect.hs 32 | 33 | Source-repository head 34 | Type: git 35 | Location: https://github.com/m4dc4p/haskelldb 36 | -------------------------------------------------------------------------------- /driver-hdbc/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hdbc/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hdbc/haskelldb-hdbc.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hdbc 2 | Version: 2.2.4 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Copyright: The authors 6 | Homepage: https://github.com/m4dc4p/haskelldb 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for HDBC. 12 | Description: HaskellDB requires this driver to work with any of HDBC's drivers. 13 | Category: Database 14 | 15 | Library 16 | Build-depends: mtl >= 1 && < 3, haskelldb >= 2.2 && < 3, HDBC >= 2 && < 3, convertible >= 1.0.1 && < 2 17 | Build-depends: base >= 3 && < 5, containers >= 0.2 && < 1, old-time >= 1 && < 2 18 | Extensions: ExistentialQuantification, 19 | OverlappingInstances, 20 | UndecidableInstances, 21 | MultiParamTypeClasses 22 | Exposed-Modules: 23 | Database.HaskellDB.HDBC 24 | ghc-options: -fwarn-incomplete-patterns 25 | 26 | Source-repository head 27 | Type: git 28 | Location: https://github.com/m4dc4p/haskelldb 29 | -------------------------------------------------------------------------------- /driver-hsql-mysql/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.MySQL 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-hsql-mysql/Database/HaskellDB/HSQL/MySQL.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.HSQL.MySQL 4 | -- Copyright : HWT Group 2003, 5 | -- Bjorn Bringert 2006 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : haskelldb-users@lists.sourceforge.net 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | ----------------------------------------------------------- 13 | module Database.HaskellDB.HSQL.MySQL (MySQLOptions(..), mysqlConnect, 14 | DriverInterface(..), driver) where 15 | 16 | import Database.HaskellDB.Database 17 | import Database.HaskellDB.HSQL 18 | import Database.HaskellDB.DriverAPI 19 | import Database.HaskellDB.Sql.MySQL (generator) 20 | import qualified Database.HSQL.MySQL as MySQL (connect) 21 | 22 | data MySQLOptions = MySQLOptions { 23 | server :: String, -- ^ server name 24 | db :: String, -- ^ database name 25 | uid :: String, -- ^ user id 26 | pwd :: String -- ^ password 27 | } 28 | 29 | mysqlConnect :: MonadIO m => MySQLOptions -> (Database -> m a) -> m a 30 | mysqlConnect opts = 31 | hsqlConnect generator (MySQL.connect (server opts) (db opts) (uid opts) (pwd opts)) 32 | 33 | options :: [(String, String)] 34 | options = 35 | ("server", "Server") : 36 | ("db", "Database") : 37 | ("uid", "User") : 38 | ("pwd", "Password") : 39 | [] 40 | 41 | mysqlConnectOpts :: MonadIO m => [(String,String)] -> (Database -> m a) -> m a 42 | mysqlConnectOpts opts f = 43 | do 44 | [a,b,c,d] <- getAnnotatedOptions options opts 45 | mysqlConnect (MySQLOptions {server = a, db = b, 46 | uid = c, pwd = d}) f 47 | 48 | -- | This driver requires the following options: 49 | -- "server", "db", "uid", "pwd" 50 | driver :: DriverInterface 51 | driver = defaultdriver { connect = mysqlConnectOpts, requiredOptions = options } 52 | -------------------------------------------------------------------------------- /driver-hsql-mysql/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hsql-mysql/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hsql-mysql/haskelldb-hsql-mysql.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hsql-mysql 2 | Version: 1.0.0 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Homepage: https://github.com/m4dc4p/haskelldb 6 | Copyright: The authors 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for the HSQL MySQL driver. 12 | Category: Database 13 | 14 | Library 15 | Build-depends: base >= 3 && < 5, mtl, haskelldb==0.11, haskelldb-hsql==0.11, hsql, hsql-mysql 16 | Exposed-Modules: 17 | Database.HaskellDB.HSQL.MySQL 18 | 19 | Executable DBDirect-hsql-mysql 20 | Main-is: DBDirect.hs 21 | 22 | Source-repository head 23 | Type: git 24 | Location: https://github.com/m4dc4p/haskelldb 25 | -------------------------------------------------------------------------------- /driver-hsql-odbc/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.ODBC 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-hsql-odbc/Database/HaskellDB/HSQL/ODBC.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.HSQL.ODBC 4 | -- Copyright : HWT Group 2003, 5 | -- Bjorn Bringert 2006 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : haskelldb-users@lists.sourceforge.net 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | ----------------------------------------------------------- 13 | 14 | module Database.HaskellDB.HSQL.ODBC ( 15 | ODBCOptions(..), 16 | odbcConnect, 17 | odbcDriverConnect, 18 | DriverInterface(..), 19 | driver 20 | ) where 21 | 22 | import Database.HaskellDB.Database 23 | import Database.HaskellDB.HSQL 24 | import Database.HaskellDB.DriverAPI 25 | import Database.HaskellDB.Sql.Generate (SqlGenerator) 26 | import qualified Database.HSQL.ODBC as ODBC (connect, driverConnect) 27 | 28 | data ODBCOptions = ODBCOptions { 29 | dsn :: String, -- ^ name binding in ODBC 30 | uid :: String, -- ^ user id 31 | pwd :: String -- ^ password 32 | } 33 | 34 | odbcConnect :: MonadIO m => SqlGenerator -> ODBCOptions -> (Database -> m a) -> m a 35 | odbcConnect gen opts = 36 | hsqlConnect gen (ODBC.connect (dsn opts) (uid opts) (pwd opts)) 37 | 38 | -- | DSN-less connection. 39 | odbcDriverConnect :: MonadIO m => SqlGenerator -> String -> (Database -> m a) -> m a 40 | odbcDriverConnect gen opts = 41 | hsqlConnect gen (ODBC.driverConnect opts) 42 | 43 | options :: [(String, String)] 44 | options = 45 | ("dsn", "Data Source Name") : 46 | ("uid", "User") : 47 | ("pwd", "Password") : 48 | [] 49 | 50 | odbcConnectOpts :: MonadIO m => [(String,String)] -> (Database -> m a) -> m a 51 | odbcConnectOpts opts f = 52 | do 53 | [a,b,c] <- getAnnotatedOptions options opts 54 | g <- getGenerator opts 55 | odbcConnect g (ODBCOptions {dsn = a, 56 | uid = b, 57 | pwd = c}) f 58 | 59 | -- | This driver requires the following options: 60 | -- "dsn", "uid", "pwd" 61 | driver :: DriverInterface 62 | driver = defaultdriver { connect = odbcConnectOpts, requiredOptions = options } 63 | -------------------------------------------------------------------------------- /driver-hsql-odbc/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hsql-odbc/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hsql-odbc/haskelldb-hsql-odbc.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hsql-odbc 2 | Version: 1.0.0 3 | Cabal-version: >= 1.6 4 | Homepage: https://github.com/m4dc4p/haskelldb 5 | Build-type: Simple 6 | Copyright: The authors 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-File: LICENSE 11 | Synopsis: HaskellDB support for the HSQL ODBC driver. 12 | Category: Database 13 | 14 | Library 15 | Build-depends: base >=3 && < 5, mtl, haskelldb==0.11, haskelldb-hsql==0.11, hsql, hsql-odbc 16 | Exposed-Modules: 17 | Database.HaskellDB.HSQL.ODBC 18 | 19 | Executable DBDirect-hsql-odbc 20 | Main-is: DBDirect.hs 21 | 22 | Source-repository head 23 | Type: git 24 | Location: https://github.com/m4dc4p/haskelldb 25 | -------------------------------------------------------------------------------- /driver-hsql-oracle/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.Oracle 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-hsql-oracle/Database/HaskellDB/HSQL/Oracle.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.HSQL.Oracle 4 | -- Copyright : HWT Group 2003, 5 | -- Bjorn Bringert 2006, 6 | -- Henning Thielemann 2008 7 | -- License : BSD-style 8 | -- 9 | -- Maintainer : haskelldb-users@lists.sourceforge.net 10 | -- Stability : experimental 11 | -- Portability : non-portable 12 | -- 13 | ----------------------------------------------------------- 14 | 15 | module Database.HaskellDB.HSQL.Oracle ( 16 | OracleOptions(..), 17 | oracleConnect, 18 | DriverInterface(..), 19 | driver 20 | ) where 21 | 22 | import Database.HaskellDB.Database 23 | import Database.HaskellDB.HSQL 24 | import Database.HaskellDB.DriverAPI 25 | import Database.HaskellDB.Sql.Generate (SqlGenerator) 26 | import qualified Database.HSQL.Oracle as Oracle 27 | import qualified Database.HSQL as HSQL 28 | import Database.HSQL.Types (connTables) 29 | import Control.Exception (bracket) 30 | 31 | 32 | data OracleOptions = 33 | OracleOptions { 34 | dsn :: String, -- ^ name binding in Oracle 35 | uid :: String, -- ^ user id 36 | pwd :: String -- ^ password 37 | } 38 | 39 | oracleConnect :: 40 | MonadIO m => 41 | SqlGenerator -> OracleOptions -> (Database -> m a) -> m a 42 | oracleConnect gen opts = 43 | hsqlConnect gen (Oracle.connect (dsn opts) (uid opts) (pwd opts)) 44 | {- 45 | HSQL's connTables asks for COREDB_SYSTEM, 46 | but newer Oracle versions (e.g. 10g) do not have it. 47 | Instead they provide a USER_TABLES. 48 | This should clearly be fixed in HSQL not here. 49 | 50 | let connector = Oracle.connect (dsn opts) (uid opts) (pwd opts) 51 | getTables = 52 | bracket connector HSQL.disconnect $ \c -> 53 | -- inTransaction c $ \c -> 54 | retrieveTables c 55 | in hsqlConnect gen 56 | (fmap (\c -> c {connTables = getTables}) connector) 57 | 58 | retrieveTables :: HSQL.Connection -> IO [String] 59 | retrieveTables c = 60 | HSQL.query c "select table_name from user_tables" >>= 61 | HSQL.collectRows (flip HSQL.getFieldValue "TABLE_NAME") 62 | -} 63 | 64 | options :: [(String, String)] 65 | options = 66 | ("dsn", "Data Source Name") : 67 | ("uid", "User") : 68 | ("pwd", "Password") : 69 | [] 70 | 71 | oracleConnectOpts :: 72 | MonadIO m => 73 | [(String,String)] -> (Database -> m a) -> m a 74 | oracleConnectOpts opts f = 75 | do 76 | [a,b,c] <- getAnnotatedOptions options opts 77 | g <- getGenerator opts 78 | oracleConnect g 79 | (OracleOptions 80 | {dsn = a, 81 | uid = b, 82 | pwd = c}) f 83 | 84 | -- | This driver requires the following options: 85 | -- "dsn", "uid", "pwd" 86 | driver :: DriverInterface 87 | driver = defaultdriver { connect = oracleConnectOpts, requiredOptions = options } 88 | -------------------------------------------------------------------------------- /driver-hsql-oracle/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hsql-oracle/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hsql-oracle/haskelldb-hsql-oracle.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hsql-oracle 2 | Version: 1.0.0 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Copyright: The authors 6 | Homepage: https://github.com/m4dc4p/haskelldb 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw, Henning Thielemann 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for the HSQL Oracle driver. 12 | Category: Database 13 | 14 | Library 15 | Build-depends: base >= 3 && < 5, mtl, haskelldb==0.11, haskelldb-hsql==0.11, hsql, hsql-oracle 16 | Exposed-Modules: 17 | Database.HaskellDB.HSQL.Oracle 18 | 19 | Executable DBDirect-hsql-oracle 20 | Main-is: DBDirect.hs 21 | 22 | Source-repository head 23 | Type: git 24 | Location: https://github.com/m4dc4p/haskelldb 25 | -------------------------------------------------------------------------------- /driver-hsql-postgresql/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.PostgreSQL 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-hsql-postgresql/Database/HaskellDB/HSQL/PostgreSQL.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.HSQL.PostgreSQL 4 | -- Copyright : HWT Group 2003, 5 | -- Bjorn Bringert 2006 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : haskelldb-users@lists.sourceforge.net 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | ----------------------------------------------------------- 13 | module Database.HaskellDB.HSQL.PostgreSQL ( 14 | PostgreSQLOptions(..), postgresqlConnect, 15 | DriverInterface(..), driver 16 | ) where 17 | 18 | import Database.HaskellDB.Database 19 | import Database.HaskellDB.HSQL 20 | import Database.HaskellDB.DriverAPI 21 | import Database.HaskellDB.Sql.PostgreSQL 22 | import qualified Database.HSQL.PostgreSQL as PostgreSQL (connect) 23 | 24 | data PostgreSQLOptions = PostgreSQLOptions { 25 | server :: String, -- ^ server name 26 | db :: String, -- ^ database name 27 | uid :: String, -- ^ user id 28 | pwd :: String -- ^ password 29 | } 30 | 31 | postgresqlConnect :: MonadIO m => PostgreSQLOptions -> (Database -> m a) -> m a 32 | postgresqlConnect opts = 33 | hsqlConnect generator (PostgreSQL.connect (server opts) (db opts) (uid opts) (pwd opts)) 34 | 35 | options :: [(String, String)] 36 | options = 37 | ("server", "Server") : 38 | ("db", "Database") : 39 | ("uid", "User") : 40 | ("pwd", "Password") : 41 | [] 42 | 43 | postgresqlConnectOpts :: MonadIO m => [(String,String)] -> (Database -> m a) -> m a 44 | postgresqlConnectOpts opts f = 45 | do 46 | [a,b,c,d] <- getAnnotatedOptions options opts 47 | postgresqlConnect (PostgreSQLOptions {server = a, db = b, 48 | uid = c, pwd = d}) f 49 | 50 | -- | This driver requires the following options: 51 | -- "server", "db", "uid", "pwd" 52 | driver :: DriverInterface 53 | driver = defaultdriver { connect = postgresqlConnectOpts, requiredOptions = options } 54 | -------------------------------------------------------------------------------- /driver-hsql-postgresql/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hsql-postgresql/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hsql-postgresql/haskelldb-hsql-postgresql.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hsql-postgresql 2 | Version: 1.0.0 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Copyright: The authors 6 | Homepage: https://github.com/m4dc4p/haskelldb 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for the HSQL PostgreSQL driver. 12 | Category: Database 13 | 14 | Library 15 | Build-depends: base >= 3 && < 5, mtl, haskelldb==0.11, haskelldb-hsql==0.11, hsql, hsql-postgresql 16 | Exposed-Modules: 17 | Database.HaskellDB.HSQL.PostgreSQL 18 | 19 | Executable DBDirect-hsql-postgresql 20 | Main-is: DBDirect.hs 21 | 22 | Source-repository head 23 | Type: git 24 | Location: https://github.com/m4dc4p/haskelldb 25 | -------------------------------------------------------------------------------- /driver-hsql-sqlite/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.SQLite 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-hsql-sqlite/Database/HaskellDB/HSQL/SQLite.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.HSQL.SQLite 4 | -- Copyright : HWT Group 2003, 5 | -- Bjorn Bringert 2006 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : haskelldb-users@lists.sourceforge.net 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | -- Interface to SQLite 2 13 | -- databases. 14 | -- 15 | ----------------------------------------------------------- 16 | module Database.HaskellDB.HSQL.SQLite ( 17 | SQLiteOptions(..), sqliteConnect, 18 | DriverInterface(..), driver 19 | ) where 20 | 21 | import Database.HaskellDB.Database 22 | import Database.HaskellDB.HSQL 23 | import Database.HaskellDB.DriverAPI 24 | import Database.HaskellDB.Sql.SQLite as SQLite 25 | 26 | import qualified Database.HSQL.SQLite2 as SQLite2 (connect) 27 | import System.IO 28 | 29 | data SQLiteOptions = SQLiteOptions { 30 | filepath :: FilePath, -- ^ database file 31 | mode :: IOMode -- ^ access mode 32 | } 33 | 34 | sqliteConnect :: MonadIO m => SQLiteOptions -> (Database -> m a) -> m a 35 | sqliteConnect opts = 36 | hsqlConnect SQLite.generator (SQLite2.connect (filepath opts) (mode opts)) 37 | 38 | options :: [(String, String)] 39 | options = 40 | ("filepath", "File path") : 41 | ("mode", "r/w/a/rw for read/(over)write/append/random access") : 42 | [] 43 | 44 | sqliteConnectOpts :: MonadIO m => [(String,String)] -> (Database -> m a) -> m a 45 | sqliteConnectOpts opts f = 46 | do 47 | [a,b] <- getAnnotatedOptions options opts 48 | m <- readIOMode b 49 | sqliteConnect (SQLiteOptions {filepath = a, 50 | mode = m}) f 51 | 52 | readIOMode :: Monad m => String -> m IOMode 53 | readIOMode s = 54 | case s of 55 | "r" -> return ReadMode 56 | "w" -> return WriteMode 57 | "a" -> return AppendMode 58 | "rw" -> return ReadWriteMode 59 | _ -> case reads s of 60 | [(x,"")] -> return x 61 | _ -> fail $ "Bad IO mode: " ++ s 62 | 63 | -- | This driver requires the following options: 64 | -- "filepath", "mode" 65 | -- The possible values of the "mode" option are "r", "w", "rw" 66 | driver :: DriverInterface 67 | driver = defaultdriver {connect = sqliteConnectOpts, requiredOptions = options} 68 | -------------------------------------------------------------------------------- /driver-hsql-sqlite/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hsql-sqlite/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hsql-sqlite/haskelldb-hsql-sqlite.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hsql-sqlite 2 | Version: 1.0.0 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Homepage: https://github.com/m4dc4p/haskelldb 6 | Copyright: The authors 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for the HSQL SQLite driver. 12 | Category: Database 13 | 14 | Library 15 | Build-depends: base >= 3 && < 5, mtl, haskelldb==0.11, haskelldb-hsql==0.11, hsql, hsql-sqlite 16 | Exposed-Modules: 17 | Database.HaskellDB.HSQL.SQLite 18 | 19 | Executable DBDirect-hsql-sqlite 20 | Main-is: DBDirect.hs 21 | 22 | Source-repository head 23 | Type: git 24 | Location: https://github.com/m4dc4p/haskelldb 25 | -------------------------------------------------------------------------------- /driver-hsql-sqlite3/DBDirect.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.SQLite3 2 | import Database.HaskellDB.DBDirect 3 | 4 | main :: IO () 5 | main = dbdirect driver 6 | -------------------------------------------------------------------------------- /driver-hsql-sqlite3/Database/HaskellDB/HSQL/SQLite3.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.HSQL.SQLite3 4 | -- Copyright : HWT Group 2003, 5 | -- Bjorn Bringert 2006 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : haskelldb-users@lists.sourceforge.net 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | -- Interface to SQLite 3 13 | -- databases. 14 | -- 15 | ----------------------------------------------------------- 16 | module Database.HaskellDB.HSQL.SQLite3 ( 17 | SQLiteOptions(..), sqliteConnect, 18 | DriverInterface(..), driver 19 | ) where 20 | 21 | import Database.HaskellDB.Database 22 | import Database.HaskellDB.HSQL 23 | import Database.HaskellDB.DriverAPI 24 | import Database.HaskellDB.Sql.SQLite as SQLite 25 | import qualified Database.HSQL.SQLite3 as SQLite3 (connect) 26 | import System.IO 27 | 28 | data SQLiteOptions = SQLiteOptions { 29 | filepath :: FilePath, -- ^ database file 30 | mode :: IOMode -- ^ access mode 31 | } 32 | 33 | sqliteConnect :: MonadIO m => SQLiteOptions -> (Database -> m a) -> m a 34 | sqliteConnect opts = 35 | hsqlConnect SQLite.generator (SQLite3.connect (filepath opts) (mode opts)) 36 | 37 | options :: [(String, String)] 38 | options = 39 | ("filepath", "File path") : 40 | ("mode", "r/w/a/rw for read/(over)write/append/random access") : 41 | [] 42 | 43 | sqliteConnectOpts :: MonadIO m => [(String,String)] -> (Database -> m a) -> m a 44 | sqliteConnectOpts opts f = 45 | do 46 | [a,b] <- getAnnotatedOptions options opts 47 | m <- readIOMode b 48 | sqliteConnect (SQLiteOptions {filepath = a, 49 | mode = m}) f 50 | 51 | readIOMode :: Monad m => String -> m IOMode 52 | readIOMode s = 53 | case s of 54 | "r" -> return ReadMode 55 | "w" -> return WriteMode 56 | "a" -> return AppendMode 57 | "rw" -> return ReadWriteMode 58 | _ -> case reads s of 59 | [(x,"")] -> return x 60 | _ -> fail $ "Bad IO mode: " ++ s 61 | 62 | -- | This driver requires the following options: 63 | -- "filepath", "mode" 64 | -- The possible values of the "mode" option are "r", "w", "rw" 65 | driver :: DriverInterface 66 | driver = defaultdriver {connect = sqliteConnectOpts, requiredOptions = options} 67 | -------------------------------------------------------------------------------- /driver-hsql-sqlite3/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hsql-sqlite3/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hsql-sqlite3/haskelldb-hsql-sqlite3.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hsql-sqlite3 2 | Version: 1.0.0 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Copyright: The authors 6 | Homepage: https://github.com/m4dc4p/haskelldb 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for the HSQL SQLite3 driver. 12 | Category: Database 13 | 14 | Library 15 | Build-depends: base >= 3 && < 5, mtl, haskelldb==0.11, haskelldb-hsql==0.11, hsql, hsql-sqlite3 16 | Exposed-Modules: 17 | Database.HaskellDB.HSQL.SQLite3 18 | 19 | Executable DBDirect-hsql-sqlite3 20 | Main-is: DBDirect.hs 21 | 22 | Source-repository head 23 | Type: git 24 | Location: https://github.com/m4dc4p/haskelldb 25 | -------------------------------------------------------------------------------- /driver-hsql/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-hsql/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-hsql/haskelldb-hsql.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-hsql 2 | Version: 1.0.0 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Homepage: https://github.com/m4dc4p/haskelldb 6 | Copyright: The authors 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: HaskellDB support for HSQL. 12 | Category: Database 13 | 14 | Flag split-base 15 | 16 | Library 17 | Build-depends: mtl, haskelldb==0.11, hsql 18 | if flag(split-base) 19 | Build-depends: base >= 3.0 && < 5, old-time 20 | else 21 | Build-depends: base < 3.0 22 | Exposed-Modules: 23 | Database.HaskellDB.HSQL 24 | 25 | Source-repository head 26 | Type: git 27 | Location: https://github.com/m4dc4p/haskelldb 28 | -------------------------------------------------------------------------------- /driver-wx/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 1999 Daan Leijen, daan@cs.uu.nl 2 | Copyright (c) 2003-2004 The HaskellDB development team 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are 7 | met: 8 | 9 | * Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above 13 | copyright notice, this list of conditions and the following 14 | disclaimer in the documentation and/or other materials provided 15 | with the distribution. 16 | 17 | * Neither the names of the copyright holders nor the names of the 18 | contributors may be used to endorse or promote products derived 19 | from this software without specific prior written permission. 20 | 21 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | -------------------------------------------------------------------------------- /driver-wx/Setup.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runghc 2 | 3 | import Distribution.Simple 4 | main = defaultMain 5 | -------------------------------------------------------------------------------- /driver-wx/haskelldb-wx.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb-wx 2 | Version: 1.0.0 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Copyright: The authors 6 | Homepage: https://github.com/m4dc4p/haskelldb 7 | Maintainer: haskelldb-users@lists.sourceforge.net 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw 9 | License: BSD3 10 | License-file: LICENSE 11 | Category: Database 12 | Synopsis: HaskellDB support for WXHaskell. 13 | 14 | build-depends: haskell98, base >= 3 && < 5, mtl, haskelldb==0.11, wxcore 15 | 16 | Library 17 | Extensions: CPP, 18 | ExistentialQuantification, 19 | OverlappingInstances, 20 | UndecidableInstances, 21 | MultiParamTypeClasses 22 | Exposed-Modules: 23 | Database.HaskellDB.WX 24 | 25 | Source-repository head 26 | Type: git 27 | Location: https://github.com/m4dc4p/haskelldb 28 | -------------------------------------------------------------------------------- /examples/.ghci: -------------------------------------------------------------------------------- 1 | -- Print SQL for a query 2 | let pSQL query = return $ "Database.HaskellDB.PrintQuery.ppSql " ++ query 3 | :def pSQL pSQL 4 | 5 | :l Select.hs 6 | -------------------------------------------------------------------------------- /examples/DB1/Bool_tbl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls, TypeSynonymInstances #-} 2 | {-# OPTIONS_GHC -fcontext-stack44 #-} 3 | --------------------------------------------------------------------------- 4 | -- Generated by DB/Direct 5 | --------------------------------------------------------------------------- 6 | module DB1.Bool_tbl where 7 | 8 | import Database.HaskellDB.DBLayout 9 | 10 | --------------------------------------------------------------------------- 11 | -- Table type 12 | --------------------------------------------------------------------------- 13 | 14 | type Bool_tbl = 15 | (RecCons F01 (Expr (Maybe Bool)) 16 | (RecCons F02 (Expr Bool) 17 | (RecCons F03 (Expr (Maybe Bool)) 18 | (RecCons F04 (Expr Bool) RecNil)))) 19 | 20 | --------------------------------------------------------------------------- 21 | -- Table 22 | --------------------------------------------------------------------------- 23 | bool_tbl :: Table Bool_tbl 24 | bool_tbl = baseTable "bool_tbl" $ 25 | hdbMakeEntry F01 # 26 | hdbMakeEntry F02 # 27 | hdbMakeEntry F03 # 28 | hdbMakeEntry F04 29 | 30 | --------------------------------------------------------------------------- 31 | -- Fields 32 | --------------------------------------------------------------------------- 33 | --------------------------------------------------------------------------- 34 | -- F01 Field 35 | --------------------------------------------------------------------------- 36 | 37 | data F01 = F01 38 | 39 | instance FieldTag F01 where fieldName _ = "f01" 40 | 41 | f01 :: Attr F01 (Maybe Bool) 42 | f01 = mkAttr F01 43 | 44 | --------------------------------------------------------------------------- 45 | -- F02 Field 46 | --------------------------------------------------------------------------- 47 | 48 | data F02 = F02 49 | 50 | instance FieldTag F02 where fieldName _ = "f02" 51 | 52 | f02 :: Attr F02 Bool 53 | f02 = mkAttr F02 54 | 55 | --------------------------------------------------------------------------- 56 | -- F03 Field 57 | --------------------------------------------------------------------------- 58 | 59 | data F03 = F03 60 | 61 | instance FieldTag F03 where fieldName _ = "f03" 62 | 63 | f03 :: Attr F03 (Maybe Bool) 64 | f03 = mkAttr F03 65 | 66 | --------------------------------------------------------------------------- 67 | -- F04 Field 68 | --------------------------------------------------------------------------- 69 | 70 | data F04 = F04 71 | 72 | instance FieldTag F04 where fieldName _ = "f04" 73 | 74 | f04 :: Attr F04 Bool 75 | f04 = mkAttr F04 76 | -------------------------------------------------------------------------------- /examples/DB1/Calendartime_tbl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls, TypeSynonymInstances #-} 2 | {-# OPTIONS_GHC -fcontext-stack44 #-} 3 | --------------------------------------------------------------------------- 4 | -- Generated by DB/Direct 5 | --------------------------------------------------------------------------- 6 | module DB1.Calendartime_tbl where 7 | 8 | import Database.HaskellDB.DBLayout 9 | 10 | --------------------------------------------------------------------------- 11 | -- Table type 12 | --------------------------------------------------------------------------- 13 | 14 | type Calendartime_tbl = 15 | (RecCons F01 (Expr (Maybe CalendarTime)) 16 | (RecCons F02 (Expr CalendarTime) 17 | (RecCons F03 (Expr (Maybe CalendarTime)) 18 | (RecCons F04 (Expr CalendarTime) RecNil)))) 19 | 20 | --------------------------------------------------------------------------- 21 | -- Table 22 | --------------------------------------------------------------------------- 23 | calendartime_tbl :: Table Calendartime_tbl 24 | calendartime_tbl = baseTable "calendartime_tbl" $ 25 | hdbMakeEntry F01 # 26 | hdbMakeEntry F02 # 27 | hdbMakeEntry F03 # 28 | hdbMakeEntry F04 29 | 30 | --------------------------------------------------------------------------- 31 | -- Fields 32 | --------------------------------------------------------------------------- 33 | --------------------------------------------------------------------------- 34 | -- F01 Field 35 | --------------------------------------------------------------------------- 36 | 37 | data F01 = F01 38 | 39 | instance FieldTag F01 where fieldName _ = "f01" 40 | 41 | f01 :: Attr F01 (Maybe CalendarTime) 42 | f01 = mkAttr F01 43 | 44 | --------------------------------------------------------------------------- 45 | -- F02 Field 46 | --------------------------------------------------------------------------- 47 | 48 | data F02 = F02 49 | 50 | instance FieldTag F02 where fieldName _ = "f02" 51 | 52 | f02 :: Attr F02 CalendarTime 53 | f02 = mkAttr F02 54 | 55 | --------------------------------------------------------------------------- 56 | -- F03 Field 57 | --------------------------------------------------------------------------- 58 | 59 | data F03 = F03 60 | 61 | instance FieldTag F03 where fieldName _ = "f03" 62 | 63 | f03 :: Attr F03 (Maybe CalendarTime) 64 | f03 = mkAttr F03 65 | 66 | --------------------------------------------------------------------------- 67 | -- F04 Field 68 | --------------------------------------------------------------------------- 69 | 70 | data F04 = F04 71 | 72 | instance FieldTag F04 where fieldName _ = "f04" 73 | 74 | f04 :: Attr F04 CalendarTime 75 | f04 = mkAttr F04 76 | -------------------------------------------------------------------------------- /examples/DB1/Double_tbl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls, TypeSynonymInstances #-} 2 | {-# OPTIONS_GHC -fcontext-stack44 #-} 3 | --------------------------------------------------------------------------- 4 | -- Generated by DB/Direct 5 | --------------------------------------------------------------------------- 6 | module DB1.Double_tbl where 7 | 8 | import Database.HaskellDB.DBLayout 9 | 10 | --------------------------------------------------------------------------- 11 | -- Table type 12 | --------------------------------------------------------------------------- 13 | 14 | type Double_tbl = 15 | (RecCons F01 (Expr (Maybe Double)) 16 | (RecCons F02 (Expr Double) 17 | (RecCons F03 (Expr (Maybe Double)) 18 | (RecCons F04 (Expr Double) RecNil)))) 19 | 20 | --------------------------------------------------------------------------- 21 | -- Table 22 | --------------------------------------------------------------------------- 23 | double_tbl :: Table Double_tbl 24 | double_tbl = baseTable "double_tbl" $ 25 | hdbMakeEntry F01 # 26 | hdbMakeEntry F02 # 27 | hdbMakeEntry F03 # 28 | hdbMakeEntry F04 29 | 30 | --------------------------------------------------------------------------- 31 | -- Fields 32 | --------------------------------------------------------------------------- 33 | --------------------------------------------------------------------------- 34 | -- F01 Field 35 | --------------------------------------------------------------------------- 36 | 37 | data F01 = F01 38 | 39 | instance FieldTag F01 where fieldName _ = "f01" 40 | 41 | f01 :: Attr F01 (Maybe Double) 42 | f01 = mkAttr F01 43 | 44 | --------------------------------------------------------------------------- 45 | -- F02 Field 46 | --------------------------------------------------------------------------- 47 | 48 | data F02 = F02 49 | 50 | instance FieldTag F02 where fieldName _ = "f02" 51 | 52 | f02 :: Attr F02 Double 53 | f02 = mkAttr F02 54 | 55 | --------------------------------------------------------------------------- 56 | -- F03 Field 57 | --------------------------------------------------------------------------- 58 | 59 | data F03 = F03 60 | 61 | instance FieldTag F03 where fieldName _ = "f03" 62 | 63 | f03 :: Attr F03 (Maybe Double) 64 | f03 = mkAttr F03 65 | 66 | --------------------------------------------------------------------------- 67 | -- F04 Field 68 | --------------------------------------------------------------------------- 69 | 70 | data F04 = F04 71 | 72 | instance FieldTag F04 where fieldName _ = "f04" 73 | 74 | f04 :: Attr F04 Double 75 | f04 = mkAttr F04 76 | -------------------------------------------------------------------------------- /examples/DB1/Int_tbl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls, TypeSynonymInstances #-} 2 | {-# OPTIONS_GHC -fcontext-stack44 #-} 3 | --------------------------------------------------------------------------- 4 | -- Generated by DB/Direct 5 | --------------------------------------------------------------------------- 6 | module DB1.Int_tbl where 7 | 8 | import Database.HaskellDB.DBLayout 9 | 10 | --------------------------------------------------------------------------- 11 | -- Table type 12 | --------------------------------------------------------------------------- 13 | 14 | type Int_tbl = 15 | (RecCons F01 (Expr (Maybe Int)) 16 | (RecCons F02 (Expr Int) 17 | (RecCons F03 (Expr (Maybe Int)) 18 | (RecCons F04 (Expr Int) RecNil)))) 19 | 20 | --------------------------------------------------------------------------- 21 | -- Table 22 | --------------------------------------------------------------------------- 23 | int_tbl :: Table Int_tbl 24 | int_tbl = baseTable "int_tbl" $ 25 | hdbMakeEntry F01 # 26 | hdbMakeEntry F02 # 27 | hdbMakeEntry F03 # 28 | hdbMakeEntry F04 29 | 30 | --------------------------------------------------------------------------- 31 | -- Fields 32 | --------------------------------------------------------------------------- 33 | --------------------------------------------------------------------------- 34 | -- F01 Field 35 | --------------------------------------------------------------------------- 36 | 37 | data F01 = F01 38 | 39 | instance FieldTag F01 where fieldName _ = "f01" 40 | 41 | f01 :: Attr F01 (Maybe Int) 42 | f01 = mkAttr F01 43 | 44 | --------------------------------------------------------------------------- 45 | -- F02 Field 46 | --------------------------------------------------------------------------- 47 | 48 | data F02 = F02 49 | 50 | instance FieldTag F02 where fieldName _ = "f02" 51 | 52 | f02 :: Attr F02 Int 53 | f02 = mkAttr F02 54 | 55 | --------------------------------------------------------------------------- 56 | -- F03 Field 57 | --------------------------------------------------------------------------- 58 | 59 | data F03 = F03 60 | 61 | instance FieldTag F03 where fieldName _ = "f03" 62 | 63 | f03 :: Attr F03 (Maybe Int) 64 | f03 = mkAttr F03 65 | 66 | --------------------------------------------------------------------------- 67 | -- F04 Field 68 | --------------------------------------------------------------------------- 69 | 70 | data F04 = F04 71 | 72 | instance FieldTag F04 where fieldName _ = "f04" 73 | 74 | f04 :: Attr F04 Int 75 | f04 = mkAttr F04 76 | -------------------------------------------------------------------------------- /examples/DB1/Integer_tbl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls, TypeSynonymInstances #-} 2 | {-# OPTIONS_GHC -fcontext-stack44 #-} 3 | --------------------------------------------------------------------------- 4 | -- Generated by DB/Direct 5 | --------------------------------------------------------------------------- 6 | module DB1.Integer_tbl where 7 | 8 | import Database.HaskellDB.DBLayout 9 | 10 | --------------------------------------------------------------------------- 11 | -- Table type 12 | --------------------------------------------------------------------------- 13 | 14 | type Integer_tbl = 15 | (RecCons F01 (Expr (Maybe Integer)) 16 | (RecCons F02 (Expr Integer) 17 | (RecCons F03 (Expr (Maybe Integer)) 18 | (RecCons F04 (Expr Integer) RecNil)))) 19 | 20 | --------------------------------------------------------------------------- 21 | -- Table 22 | --------------------------------------------------------------------------- 23 | integer_tbl :: Table Integer_tbl 24 | integer_tbl = baseTable "integer_tbl" $ 25 | hdbMakeEntry F01 # 26 | hdbMakeEntry F02 # 27 | hdbMakeEntry F03 # 28 | hdbMakeEntry F04 29 | 30 | --------------------------------------------------------------------------- 31 | -- Fields 32 | --------------------------------------------------------------------------- 33 | --------------------------------------------------------------------------- 34 | -- F01 Field 35 | --------------------------------------------------------------------------- 36 | 37 | data F01 = F01 38 | 39 | instance FieldTag F01 where fieldName _ = "f01" 40 | 41 | f01 :: Attr F01 (Maybe Integer) 42 | f01 = mkAttr F01 43 | 44 | --------------------------------------------------------------------------- 45 | -- F02 Field 46 | --------------------------------------------------------------------------- 47 | 48 | data F02 = F02 49 | 50 | instance FieldTag F02 where fieldName _ = "f02" 51 | 52 | f02 :: Attr F02 Integer 53 | f02 = mkAttr F02 54 | 55 | --------------------------------------------------------------------------- 56 | -- F03 Field 57 | --------------------------------------------------------------------------- 58 | 59 | data F03 = F03 60 | 61 | instance FieldTag F03 where fieldName _ = "f03" 62 | 63 | f03 :: Attr F03 (Maybe Integer) 64 | f03 = mkAttr F03 65 | 66 | --------------------------------------------------------------------------- 67 | -- F04 Field 68 | --------------------------------------------------------------------------- 69 | 70 | data F04 = F04 71 | 72 | instance FieldTag F04 where fieldName _ = "f04" 73 | 74 | f04 :: Attr F04 Integer 75 | f04 = mkAttr F04 76 | -------------------------------------------------------------------------------- /examples/DB1/String_tbl.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls, TypeSynonymInstances #-} 2 | {-# OPTIONS_GHC -fcontext-stack44 #-} 3 | --------------------------------------------------------------------------- 4 | -- Generated by DB/Direct 5 | --------------------------------------------------------------------------- 6 | module DB1.String_tbl where 7 | 8 | import Database.HaskellDB.DBLayout 9 | 10 | --------------------------------------------------------------------------- 11 | -- Table type 12 | --------------------------------------------------------------------------- 13 | 14 | type String_tbl = 15 | (RecCons F01 (Expr (Maybe String)) 16 | (RecCons F02 (Expr String) 17 | (RecCons F03 (Expr (Maybe String)) 18 | (RecCons F04 (Expr String) RecNil)))) 19 | 20 | --------------------------------------------------------------------------- 21 | -- Table 22 | --------------------------------------------------------------------------- 23 | string_tbl :: Table String_tbl 24 | string_tbl = baseTable "string_tbl" $ 25 | hdbMakeEntry F01 # 26 | hdbMakeEntry F02 # 27 | hdbMakeEntry F03 # 28 | hdbMakeEntry F04 29 | 30 | --------------------------------------------------------------------------- 31 | -- Fields 32 | --------------------------------------------------------------------------- 33 | --------------------------------------------------------------------------- 34 | -- F01 Field 35 | --------------------------------------------------------------------------- 36 | 37 | data F01 = F01 38 | 39 | instance FieldTag F01 where fieldName _ = "f01" 40 | 41 | f01 :: Attr F01 (Maybe String) 42 | f01 = mkAttr F01 43 | 44 | --------------------------------------------------------------------------- 45 | -- F02 Field 46 | --------------------------------------------------------------------------- 47 | 48 | data F02 = F02 49 | 50 | instance FieldTag F02 where fieldName _ = "f02" 51 | 52 | f02 :: Attr F02 String 53 | f02 = mkAttr F02 54 | 55 | --------------------------------------------------------------------------- 56 | -- F03 Field 57 | --------------------------------------------------------------------------- 58 | 59 | data F03 = F03 60 | 61 | instance FieldTag F03 where fieldName _ = "f03" 62 | 63 | f03 :: Attr F03 (Maybe String) 64 | f03 = mkAttr F03 65 | 66 | --------------------------------------------------------------------------- 67 | -- F04 Field 68 | --------------------------------------------------------------------------- 69 | 70 | data F04 = F04 71 | 72 | instance FieldTag F04 where fieldName _ = "f04" 73 | 74 | f04 :: Attr F04 String 75 | f04 = mkAttr F04 76 | -------------------------------------------------------------------------------- /examples/Select.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Load this module in GHCi and use the ":pSQL" command 3 | to evaluate the queries. 4 | -} 5 | module Select 6 | 7 | where 8 | 9 | -- import HaskellDB operators and 10 | -- functions. 11 | import Database.HaskellDB 12 | 13 | -- Import table type and definition directly. 14 | import DB1.Int_tbl (Int_tbl, int_tbl) 15 | import DB1.String_tbl (String_tbl, string_tbl) 16 | 17 | -- Import Hdb_t1 directly so we can use its columns 18 | -- as labels in projections easily. 19 | import DB1.Hdb_t1 (t1f01, t1f02, t1f05, t1f06 20 | , t1f09, t1f10, t1f13, t1f14, t1f21, t1f22) 21 | 22 | -- Import columns on tables with a qualified name. 23 | import qualified DB1.Int_tbl as Int_tbl 24 | import qualified DB1.String_tbl as String_tbl 25 | 26 | import DB1.String_tbl (String_tbl, string_tbl) 27 | import qualified DB1.String_tbl as String_tbl 28 | 29 | -- Select query examples 30 | 31 | -- | Demonstrates use of aggregate count() function 32 | -- in a projection. 33 | demoCount = do 34 | t1 <- table int_tbl 35 | t2 <- table int_tbl 36 | order [asc t1 Int_tbl.f02] 37 | project $ Int_tbl.f02 << count(t1 ! Int_tbl.f02) 38 | # Int_tbl.f01 << (t2 ! Int_tbl.f01) 39 | 40 | -- | Demonstrate using the 'unique' operator. This query 41 | -- will be grouped by all the columns in the projection. 42 | uniqueUsage = do 43 | t1 <- table int_tbl 44 | t2 <- project $ Int_tbl.f01 << t1 ! Int_tbl.f01 45 | unique 46 | return t2 47 | 48 | -- | Shows the use of the copyAll operator. 49 | -- This query projects all the columns in string_tbl. 50 | copyAllUsage = do 51 | t2 <- table string_tbl 52 | project $ copyAll t2 53 | 54 | -- | Shows usage of the copy operator. This 55 | -- query projects columns from int_tbl and string_tbl. Note 56 | -- that copy will NOT rename columns, so you can get column 57 | -- collisions if you are not careful. 58 | copyUsage = do 59 | t2 <- table string_tbl 60 | t1 <- table int_tbl 61 | project $ copy Int_tbl.f01 t1 62 | # copy String_tbl.f02 t2 63 | 64 | -- | Select all columns from Int_tbl 65 | select1 = do 66 | intTbl <- table int_tbl 67 | project $ copyAll intTbl 68 | 69 | -- | Select some columns from Int_tbl 70 | -- and some from String_tbl. No restriction is 71 | -- specified between the two tables, so 72 | -- this will be a cross join. 73 | select2 = do 74 | intTbl <- table int_tbl 75 | strTbl <- table string_tbl 76 | project $ t1f05 << intTbl ! Int_tbl.f01 77 | # t1f02 << strTbl ! String_tbl.f02 78 | # t1f05 << intTbl ! Int_tbl.f03 79 | # t1f02 << strTbl ! String_tbl.f04 80 | 81 | -- | Select values from Int_tbl and 82 | -- cast them to text. 83 | select3 = do 84 | intTbl <- table int_tbl 85 | project $ t1f02 << cast "text" (intTbl ! Int_tbl.f01) 86 | 87 | -- | Select values from Int_tbl and String_tbl, cast 88 | -- the int values to text, and join them to related 89 | -- values on String_tbl. Finally, project two columns 90 | -- from the join. 91 | select4 = do 92 | intTbl <- table int_tbl 93 | strTbl <- table string_tbl 94 | restrict $ cast "text" (intTbl ! Int_tbl.f01) .==. 95 | strTbl ! String_tbl.f01 96 | project $ t1f05 << intTbl ! Int_tbl.f01 97 | # t1f06 << intTbl ! Int_tbl.f02 98 | # t1f01 << strTbl ! String_tbl.f01 99 | # t1f02 << strTbl ! String_tbl.f02 100 | -------------------------------------------------------------------------------- /haskelldb.cabal: -------------------------------------------------------------------------------- 1 | Name: haskelldb 2 | Version: 2.2.4 3 | Cabal-version: >= 1.6 4 | Build-type: Simple 5 | Homepage: https://github.com/m4dc4p/haskelldb 6 | Copyright: The authors 7 | Maintainer: "Justin Bailey" 8 | Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw, Justin Bailey 9 | License: BSD3 10 | License-file: LICENSE 11 | Synopsis: A library of combinators for generating and executing SQL statements. 12 | Description: This library allows you to build SQL SELECT, INSERT, UPDATE, and DELETE 13 | statements using operations based on the relational algebra. 14 | Category: Database 15 | 16 | Library 17 | Build-depends: mtl >= 1.1 && < 3, 18 | base >= 3 && < 5, 19 | pretty >= 1 && < 2, 20 | old-time >= 1 && < 2, 21 | old-locale >= 1 && < 2, 22 | directory >= 1 && < 2, 23 | containers >= 0.3 && < 1, 24 | time >= 1.0 25 | Extensions: 26 | EmptyDataDecls, 27 | DeriveDataTypeable, 28 | ExistentialQuantification, 29 | OverlappingInstances, 30 | UndecidableInstances, 31 | MultiParamTypeClasses, 32 | FunctionalDependencies, 33 | TypeSynonymInstances, 34 | FlexibleInstances, 35 | FlexibleContexts, 36 | PolymorphicComponents 37 | Exposed-Modules: 38 | Database.HaskellDB, 39 | Database.HaskellDB.BoundedList, 40 | Database.HaskellDB.BoundedString, 41 | Database.HaskellDB.DBLayout, 42 | Database.HaskellDB.DBDirect, 43 | Database.HaskellDB.DBSpec, 44 | Database.HaskellDB.DBSpec.DBInfo, 45 | Database.HaskellDB.DBSpec.DBSpecToDBDirect, 46 | Database.HaskellDB.DBSpec.DBSpecToDatabase, 47 | Database.HaskellDB.DBSpec.DatabaseToDBSpec, 48 | Database.HaskellDB.DBSpec.PPHelpers, 49 | Database.HaskellDB.Database, 50 | Database.HaskellDB.FieldType, 51 | Database.HaskellDB.Optimize, 52 | Database.HaskellDB.PrimQuery, 53 | Database.HaskellDB.PrintQuery, 54 | Database.HaskellDB.Query, 55 | Database.HaskellDB.HDBRec, 56 | Database.HaskellDB.Sql, 57 | Database.HaskellDB.Sql.Generate, 58 | Database.HaskellDB.Sql.Default, 59 | Database.HaskellDB.Sql.Print, 60 | Database.HaskellDB.Sql.MySQL, 61 | Database.HaskellDB.Sql.PostgreSQL, 62 | Database.HaskellDB.Sql.SQLite, 63 | Database.HaskellDB.Version, 64 | Database.HaskellDB.DriverAPI 65 | Hs-source-dirs: src 66 | 67 | Source-repository head 68 | Type: git 69 | Location: https://github.com/m4dc4p/haskelldb 70 | -------------------------------------------------------------------------------- /haskelldb.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/m4dc4p/haskelldb/a1fbc8a2eca8c70ebe382bf4c022275836d9d510/haskelldb.pdf -------------------------------------------------------------------------------- /leijen.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/m4dc4p/haskelldb/a1fbc8a2eca8c70ebe382bf4c022275836d9d510/leijen.pdf -------------------------------------------------------------------------------- /set-version: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | NEW_VERSION=$1 4 | 5 | if [ -z "$NEW_VERSION" ]; then 6 | echo "Usage: set-version " 7 | exit 2 8 | fi 9 | 10 | echo "Setting version to: $NEW_VERSION" 11 | 12 | find haskelldb.cabal driver-* -name '*.cabal' | xargs perl -i -pe "s/^Version:.*/Version: $NEW_VERSION/i" 13 | 14 | perl -i -pe "s/^version\s*=.*/version = \"$NEW_VERSION\"/i" src/Database/HaskellDB/Version.hs 15 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/DBDirect.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.DBDirect 4 | -- Copyright : Daan Leijen (c) 1999, daan@cs.uu.nl 5 | -- HWT Group (c) 2003, 6 | -- Bjorn Bringert (c) 2005-2006, bjorn@bringert.net 7 | -- License : BSD-style 8 | -- 9 | -- Maintainer : haskelldb-users@lists.sourceforge.net 10 | -- Stability : experimental 11 | -- Portability : portable 12 | -- 13 | -- DBDirect generates a Haskell module from a database. 14 | -- It first reads the system catalog of the database into 15 | -- a 'Catalog' data type. After that it pretty prints that 16 | -- data structure in an appropiate Haskell module which 17 | -- can be used to perform queries on the database. 18 | -- 19 | ----------------------------------------------------------- 20 | 21 | module Database.HaskellDB.DBDirect (dbdirect) where 22 | 23 | import Database.HaskellDB (Database, ) 24 | import Database.HaskellDB.DriverAPI (DriverInterface, connect, requiredOptions, ) 25 | import Database.HaskellDB.DBSpec (dbToDBSpec, dbname) 26 | import Database.HaskellDB.DBSpec.DBSpecToDBDirect (dbInfoToModuleFiles, ) 27 | 28 | import qualified Database.HaskellDB.DBSpec.PPHelpers as PP 29 | 30 | import System.Console.GetOpt (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo, ) 31 | import System.Environment (getArgs, getProgName, ) 32 | import System.Exit (exitFailure, ) 33 | import System.IO (hPutStrLn, stderr, ) 34 | 35 | import Control.Monad.Error () -- Monad instance for Either 36 | import Control.Monad (when, ) 37 | import Data.List (intersperse, ) 38 | 39 | 40 | createModules :: String -> String -> Bool -> PP.MakeIdentifiers -> Database -> IO () 41 | createModules m dbName useBStrT mkIdent db = 42 | do 43 | putStrLn "Getting database info..." 44 | spec <- dbToDBSpec useBStrT mkIdent m db 45 | putStrLn "Writing modules..." 46 | dbInfoToModuleFiles "." m (spec {dbname = dbName}) 47 | 48 | 49 | data Flags = 50 | Flags { 51 | optHelp :: Bool, 52 | optBoundedStrings :: Bool, 53 | optIdentifierStyle :: PP.MakeIdentifiers 54 | } 55 | 56 | options :: [OptDescr (Flags -> Either String Flags)] 57 | options = 58 | Option ['h'] ["help"] 59 | (NoArg (\flags -> Right $ flags{optHelp = True})) 60 | "show options" : 61 | Option ['b'] ["bounded-strings"] 62 | (NoArg (\flags -> Right $ flags{optBoundedStrings = True})) 63 | "use bounded string types" : 64 | Option [] ["identifier-style"] 65 | (ReqArg (\str flags -> 66 | case str of 67 | "preserve" -> Right $ flags{optIdentifierStyle = PP.mkIdentPreserving} 68 | "camel-case" -> Right $ flags{optIdentifierStyle = PP.mkIdentCamelCase} 69 | _ -> Left $ "unknown identifier style: " ++ str) 70 | "type") 71 | " is one of [preserve, camel-case]" : 72 | [] 73 | 74 | parseOptions :: 75 | [Flags -> Either String Flags] -> Either String Flags 76 | parseOptions = 77 | foldr (=<<) 78 | (Right $ 79 | Flags {optHelp = False, 80 | optBoundedStrings = False, 81 | optIdentifierStyle = PP.mkIdentPreserving}) 82 | 83 | exitWithError :: String -> IO a 84 | exitWithError msg = 85 | hPutStrLn stderr msg >> 86 | hPutStrLn stderr "Try --help option to get detailed info." >> 87 | exitFailure 88 | 89 | dbdirect :: DriverInterface -> IO () 90 | dbdirect driver = 91 | do putStrLn "DB/Direct: Daan Leijen (c) 1999, HWT (c) 2003-2004," 92 | putStrLn " Bjorn Bringert (c) 2005-2007, Henning Thielemann (c) 2008" 93 | putStrLn "" 94 | 95 | argv <- getArgs 96 | let (opts, modAndDrvOpts, errors) = getOpt RequireOrder options argv 97 | when (not (null errors)) 98 | (ioError . userError . concat $ errors) 99 | 100 | flags <- 101 | case parseOptions opts of 102 | Left errMsg -> exitWithError errMsg 103 | Right flags -> return flags 104 | 105 | when (optHelp flags) 106 | (showHelp driver >> exitFailure) 107 | 108 | case modAndDrvOpts of 109 | [] -> exitWithError "Missing module and driver options" 110 | [_] -> exitWithError "Missing driver options" 111 | [moduleName,dbname,drvOpts] -> 112 | do putStrLn "Connecting to database..." 113 | connect driver 114 | (splitOptions drvOpts) 115 | (createModules moduleName dbname 116 | (optBoundedStrings flags) 117 | (optIdentifierStyle flags)) 118 | putStrLn "Done!" 119 | (_:_:restArgs) -> 120 | exitWithError ("Unnecessary arguments: " ++ show restArgs) 121 | 122 | 123 | 124 | splitOptions :: String -> [(String,String)] 125 | splitOptions = map (split2 '=') . split ',' 126 | 127 | split :: Char -> String -> [String] 128 | split _ [] = [] 129 | split g xs = y : split g ys 130 | where (y,ys) = split2 g xs 131 | 132 | split2 :: Char -> String -> (String,String) 133 | split2 g xs = (ys, drop 1 zs) 134 | where (ys,zs) = break (==g) xs 135 | 136 | -- | Shows usage information 137 | showHelp :: DriverInterface -> IO () 138 | showHelp driver = 139 | do p <- getProgName 140 | let header = 141 | "Usage: " ++ p ++ " [dbdirect-options] \n" 142 | footer = unlines $ 143 | "" : 144 | "NOTE: You will probably have to specify the db name in both and . This is because the driver options are specific to each database." : 145 | "" : 146 | "module: Module name without an extension" : 147 | ("driver-options: " ++ 148 | (concat . intersperse "," . 149 | map (\(name,descr) -> name++"=<"++descr++">") . 150 | requiredOptions) driver) : 151 | [] 152 | hPutStrLn stderr $ (usageInfo header options ++ footer) 153 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/DBLayout.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : DBLayout 4 | -- Copyright : HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Exports every function needed by DBDirect generated 12 | -- files 13 | -- 14 | -- 15 | ----------------------------------------------------------- 16 | 17 | module Database.HaskellDB.DBLayout 18 | (module Database.HaskellDB.BoundedString 19 | , module Database.HaskellDB.DBSpec 20 | , CalendarTime, LocalTime 21 | , Expr, Table, Attr, baseTable 22 | , RecCons, RecNil, FieldTag, fieldName 23 | , hdbMakeEntry, mkAttr, ( # ) 24 | , emptyTable) 25 | 26 | where 27 | 28 | import Database.HaskellDB.HDBRec(Record, RecCons, RecNil, FieldTag 29 | , fieldName, ( # )) 30 | 31 | import Database.HaskellDB.BoundedString 32 | import System.Time (CalendarTime) 33 | import Data.Time.LocalTime (LocalTime) 34 | import Database.HaskellDB.Query (Expr, Table, Attr(..) 35 | , baseTable, attribute, (<<), emptyTable) 36 | import Database.HaskellDB.DBSpec 37 | import Database.HaskellDB.FieldType (FieldType(..)) 38 | 39 | -- | Constructs a table entry from a field tag 40 | hdbMakeEntry :: FieldTag f => 41 | f -- ^ Field tag 42 | -> Record (RecCons f (Expr a) RecNil) 43 | hdbMakeEntry f = undefined << attribute (fieldName f) 44 | 45 | -- | Make an 'Attr' for a field. 46 | mkAttr :: FieldTag f => 47 | f -- ^ Field tag 48 | -> Attr f a 49 | mkAttr = Attr . fieldName -------------------------------------------------------------------------------- /src/Database/HaskellDB/DBSpec.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : DBSpec 4 | -- Copyright : HWT Group (c) 2004, haskelldb-users@lists.sourceforge.net 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- DBSpec is the new and improved way of specifying databases. 12 | -- It is designed to be able to describe a database in such a 13 | -- way that it can easily be converted to a DBDirect-spec OR 14 | -- directly into a database 15 | -- 16 | -- 17 | ----------------------------------------------------------- 18 | 19 | module Database.HaskellDB.DBSpec 20 | (DBInfo(..),TInfo(..),CInfo(..),DBOptions(..), 21 | FieldDesc, FieldType(..), 22 | makeDBSpec,makeTInfo, 23 | makeCInfo,constructNonClashingDBInfo,ppDBInfo,ppTInfo,ppCInfo, 24 | ppDBOptions,dbInfoToDoc,finalizeSpec,dbToDBSpec,dbSpecToDatabase) 25 | where 26 | 27 | import Database.HaskellDB.FieldType 28 | import Database.HaskellDB.DBSpec.DBInfo 29 | import Database.HaskellDB.DBSpec.DatabaseToDBSpec 30 | import Database.HaskellDB.DBSpec.DBSpecToDatabase 31 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/DBSpec/DBSpecToDatabase.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : DBSpecToDatabase 4 | -- Copyright : HWT Group (c) 2004, haskelldb-users@lists.sourceforge.net 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Connects to a database and generates stuff in it according 12 | -- to what's inside the DBSpec. 13 | -- 14 | -- 15 | ----------------------------------------------------------- 16 | module Database.HaskellDB.DBSpec.DBSpecToDatabase 17 | (dbSpecToDatabase,tInfoToTable) 18 | where 19 | 20 | import Database.HaskellDB.Database 21 | import Database.HaskellDB.FieldType 22 | import Database.HaskellDB.DBSpec.DBInfo 23 | 24 | -- | Converts a DBInfo to a real life Database, note that the database must 25 | -- exist for this to work 26 | dbSpecToDatabase :: Database -- ^ A Database 27 | -> DBInfo -- ^ The DBInfo to generate from 28 | -> IO () 29 | dbSpecToDatabase db = mapM_ (tInfoToTable db) . tbls 30 | 31 | -- | Create a database table specified by a 'TInfo'. 32 | tInfoToTable :: Database -> TInfo -> IO () 33 | tInfoToTable db t = createTable db (tname t) (tInfoCols t) 34 | 35 | tInfoCols :: TInfo -> [(String,FieldDesc)] 36 | tInfoCols t = [(cname c, descr c) | c <- cols t, cname c /= ""] 37 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/DBSpec/DatabaseToDBSpec.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : DatabaseToDBSpec 4 | -- Copyright : HWT Group (c) 2004, haskelldb-users@lists.sourceforge.net 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- Connects to a Database and generates a DBSpec specification 12 | -- from it. 13 | -- 14 | -- 15 | ----------------------------------------------------------- 16 | module Database.HaskellDB.DBSpec.DatabaseToDBSpec 17 | (dbToDBSpec) 18 | where 19 | 20 | import Database.HaskellDB.Database (Database, tables, describe, ) 21 | import Database.HaskellDB.DBSpec.DBInfo 22 | (DBInfo, makeCInfo, makeTInfo, makeDBSpec, 23 | DBOptions(DBOptions), useBString, makeIdent, ) 24 | 25 | import qualified Database.HaskellDB.DBSpec.PPHelpers as PP 26 | 27 | 28 | -- | Connects to a database and generates a specification from it 29 | dbToDBSpec :: Bool -- ^ Use bounded strings? 30 | -> PP.MakeIdentifiers -- ^ style of generated Haskell identifiers, cOLUMN_NAME vs. columnName 31 | -> String -- ^ the name our database should have 32 | -> Database -- ^ the database connection 33 | -> IO DBInfo -- ^ return a DBInfo 34 | dbToDBSpec useBStr mkIdent name dbconn 35 | = do ts <- tables dbconn 36 | descs <- mapM (describe dbconn) ts 37 | let cinfos = map (map $ uncurry makeCInfo) descs 38 | let tinfos = map (uncurry makeTInfo) (zip ts cinfos) 39 | return $ makeDBSpec name (DBOptions {useBString = useBStr, makeIdent = mkIdent }) tinfos 40 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/DBSpec/PPHelpers.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : PPHelpers 4 | -- Copyright : HWT Group (c) 2004, haskelldb-users@lists.sourceforge.net 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Various functions used when pretty printing stuff 12 | -- 13 | -- 14 | ----------------------------------------------------------- 15 | module Database.HaskellDB.DBSpec.PPHelpers where 16 | -- no explicit export, we want ALL of it 17 | 18 | import Data.Char (toLower, toUpper, isAlpha, isAlphaNum, ) 19 | import Text.PrettyPrint.HughesPJ 20 | 21 | newline = char '\n' 22 | 23 | ----------------------------------------------------------- 24 | -- Comment that looks like this 25 | ----------------------------------------------------------- 26 | ppComment txt 27 | = commentLine $$ vcat (map commentText txt) $$ commentLine 28 | where 29 | commentLine = text (replicate 75 '-') 30 | commentText s = text ("-- " ++ s) 31 | 32 | ----------------------------------------------------------- 33 | -- Create valid Names 34 | ----------------------------------------------------------- 35 | fileName name | not (elem '.' baseName) = name ++ ".hs" 36 | | otherwise = name 37 | where 38 | baseName = reverse (takeWhile (/='\\') (reverse name)) 39 | 40 | 41 | data MakeIdentifiers = 42 | MakeIdentifiers 43 | { moduleName, identifier, toType :: String -> String } 44 | 45 | mkIdentPreserving = 46 | MakeIdentifiers 47 | { 48 | moduleName = checkChars . checkUpper, 49 | identifier = checkChars . checkKeyword . checkLower, 50 | toType = checkChars . checkKeyword . checkUpper 51 | } 52 | 53 | mkIdentCamelCase = 54 | MakeIdentifiers 55 | { 56 | moduleName = checkChars . toUpperCamelCase, 57 | identifier = checkChars . checkKeyword . toLowerCamelCase, 58 | toType = checkChars . checkKeyword . toUpperCamelCase 59 | } 60 | 61 | 62 | toLowerCamelCase s@(_:_) = 63 | let (h : rest) = split ('_'==) $ dropWhile ('_'==) $ map toLower s 64 | in concat $ checkLower h : map (checkUpperDef '_') rest 65 | toLowerCamelCase [] = 66 | error "toLowerCamelCase: identifier must be non-empty" 67 | 68 | toUpperCamelCase s@(_:_) = 69 | let (h : rest) = split ('_'==) $ dropWhile ('_'==) $ map toLower s 70 | in concat $ checkUpper h : map (checkUpperDef '_') rest 71 | toUpperCamelCase [] = 72 | error "toUpperCamelCase: identifier must be non-empty" 73 | 74 | {- | 75 | Generalization of 'words' and 'lines' to any separating character set. 76 | -} 77 | split :: Eq a => (a -> Bool) -> [a] -> [[a]] 78 | split p = 79 | foldr (\ x yt@ ~(y:ys) -> (if p x then ([]:yt) else ((x:y):ys)) ) [[]] 80 | 81 | checkChars s = map replace s 82 | where 83 | replace c | isAlphaNum c = c 84 | | otherwise = '_' 85 | 86 | checkKeyword s | elem s keywords = 'x' : s 87 | | otherwise = s 88 | where 89 | keywords = [ "module", "where", "import" 90 | , "infix", "infixr", "infixl" 91 | , "type", "newtype", "data" 92 | , "deriving" 93 | , "class", "instance" 94 | , "do", "return" 95 | , "let", "in" 96 | , "case", "of" 97 | , "if", "then", "else" 98 | , "id", "zip","baseTable" 99 | ] 100 | 101 | checkUpper "" = error "Empty name from database?" 102 | checkUpper s = checkUpperDef 'X' s 103 | 104 | checkLower "" = error "Empty name from database?" 105 | checkLower s = checkLowerDef 'x' s 106 | 107 | checkUpperDef _ "" = "" 108 | checkUpperDef d s@(x:xs) 109 | | isAlpha x = toUpper x : xs 110 | | otherwise = d : s -- isDigit? 111 | 112 | checkLowerDef _ "" = "" 113 | checkLowerDef d s@(x:xs) 114 | | isAlpha x = toLower x : xs 115 | | otherwise = d : s -- isDigit? 116 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/DriverAPI.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification, Rank2Types #-} 2 | ----------------------------------------------------------- 3 | -- | 4 | -- Module : DriverAPI 5 | -- Copyright : Anders Hockersten (c), chucky@dtek.chalmers.se 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : chucky@dtek.chalmers.se 9 | -- Stability : experimental 10 | -- Portability : portable 11 | -- 12 | -- This exports an API that all drivers must conform to. It 13 | -- is used by the end user to load drivers either dynamically 14 | -- or statically. 15 | ----------------------------------------------------------- 16 | 17 | module Database.HaskellDB.DriverAPI ( 18 | DriverInterface(..), 19 | MonadIO, 20 | defaultdriver, 21 | getOptions, 22 | getAnnotatedOptions, 23 | getGenerator 24 | ) where 25 | 26 | import Database.HaskellDB.Database (Database) 27 | 28 | import Database.HaskellDB.Sql.Generate (SqlGenerator) 29 | import Database.HaskellDB.Sql.Default (defaultSqlGenerator) 30 | import Database.HaskellDB.Sql.MySQL as MySQL 31 | import Database.HaskellDB.Sql.PostgreSQL as PostgreSQL 32 | import Database.HaskellDB.Sql.SQLite as SQLite 33 | 34 | 35 | import Control.Monad (liftM) 36 | import Control.Monad.Trans (MonadIO) 37 | 38 | -- | Interface which drivers should implement. 39 | -- The 'connect' function takes some driver specific name, value pairs 40 | -- use to setup the database connection, and a database action to run. 41 | -- 'requiredOptions' lists all required options with a short description, 42 | -- that is printed as help in the DBDirect program. 43 | data DriverInterface = DriverInterface 44 | { connect :: forall m a. MonadIO m => [(String,String)] -> (Database -> m a) -> m a, 45 | requiredOptions :: [(String, String)] 46 | } 47 | 48 | -- | Default dummy driver, real drivers should overload this 49 | defaultdriver :: DriverInterface 50 | defaultdriver = 51 | DriverInterface { 52 | connect = error "DriverAPI.connect: not implemented", 53 | requiredOptions = error "DriverAPI.requiredOptions: not implemented"} 54 | 55 | -- | Can be used by drivers to get option values from the given 56 | -- list of name, value pairs. 57 | getOptions ::Monad m => [String] -- ^ names of options to get 58 | -> [(String,String)] -- ^ options given 59 | -> m [String] -- ^ a list of the same length as the first argument 60 | -- with the values of each option. Fails in the given 61 | -- monad if any options is not found. 62 | getOptions [] _ = return [] 63 | getOptions (x:xs) ys = 64 | case lookup x ys of 65 | Nothing -> fail $ "Missing field " ++ x 66 | Just v -> liftM (v:) $ getOptions xs ys 67 | 68 | -- | Can be used by drivers to get option values from the given 69 | -- list of name, value pairs. 70 | -- It is intended for use with the 'requiredOptions' value of the driver. 71 | getAnnotatedOptions :: Monad m => 72 | [(String,String)] -- ^ names and descriptions of options to get 73 | -> [(String,String)] -- ^ options given 74 | -> m [String] -- ^ a list of the same length as the first argument 75 | -- with the values of each option. Fails in the given 76 | -- monad if any options is not found. 77 | getAnnotatedOptions opts = getOptions (map fst opts) 78 | 79 | -- | Gets an 'SqlGenerator' from the "generator" option in the given list. 80 | -- Currently available generators: "mysql", "postgresql", "sqlite", "default" 81 | getGenerator :: Monad m => 82 | [(String,String)] -- ^ options given 83 | -> m SqlGenerator -- ^ An SQL generator. If there was no 84 | -- "generator" option, the default is used. 85 | -- Fails if the generator is unknown 86 | getGenerator opts = maybe (return defaultSqlGenerator) f $ lookup "generator" opts 87 | where f n = maybe (fail msg) return $ lookup n generators 88 | where msg = "Unknown SqlGenerator: " ++ n 89 | 90 | generators :: [(String,SqlGenerator)] 91 | generators = [("mysql", MySQL.generator), 92 | ("postgresql", PostgreSQL.generator), 93 | ("sqlite", SQLite.generator), 94 | ("default", defaultSqlGenerator)] 95 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/FieldType.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts, UndecidableInstances, TypeSynonymInstances, FlexibleInstances 2 | , MultiParamTypeClasses, StandaloneDeriving #-} 3 | ----------------------------------------------------------- 4 | -- | 5 | -- Module : FieldType 6 | -- Copyright : HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net 7 | -- License : BSD-style 8 | -- 9 | -- Maintainer : haskelldb-users@lists.sourceforge.net 10 | -- Stability : experimental 11 | -- Portability : non-portable 12 | -- 13 | -- Defines the types of database columns, and functions 14 | -- for converting these between HSQL and internal formats 15 | -- 16 | -- 17 | ----------------------------------------------------------- 18 | module Database.HaskellDB.FieldType 19 | (FieldDesc, FieldType(..), toHaskellType, ExprType(..) 20 | , ExprTypes(..), queryFields) where 21 | 22 | import Data.Dynamic 23 | import System.Time 24 | import Data.Time.LocalTime 25 | 26 | import Database.HaskellDB.HDBRec (RecCons(..), Record, RecNil(..), ShowLabels) 27 | import Database.HaskellDB.BoundedString 28 | import Database.HaskellDB.BoundedList (listBound, Size) 29 | import Database.HaskellDB.Query (Expr, Rel, runQueryRel, Query, labels) 30 | 31 | -- | The type and @nullable@ flag of a database column 32 | type FieldDesc = (FieldType, Bool) 33 | 34 | -- | A database column type 35 | data FieldType = 36 | StringT 37 | | IntT 38 | | IntegerT 39 | | DoubleT 40 | | BoolT 41 | | CalendarTimeT 42 | | LocalTimeT 43 | | BStrT Int 44 | deriving (Eq,Ord,Show,Read) 45 | 46 | -- | Class which retrieves a field description from a given type. 47 | -- Instances are provided for most concrete types. Instances 48 | -- for Maybe automatically make the field nullable, and instances 49 | -- for all (Expr a) types where a has an ExprType instance allows 50 | -- type information to be recovered from a given column expression. 51 | class ExprType e where 52 | fromHaskellType :: e -> FieldDesc 53 | 54 | -- | Class which returns a list of field descriptions. Gets the 55 | -- descriptions of all columns in a Record/query. Most useful when 56 | -- the columns associated with each field in a (Rel r) type must be 57 | -- recovered. Note that this occurs at the type level only and no 58 | -- values are inspected. 59 | class ExprTypes r where 60 | fromHaskellTypes :: r -> [FieldDesc] 61 | 62 | toHaskellType :: FieldType -> String 63 | toHaskellType StringT = "String" 64 | toHaskellType IntT = "Int" 65 | toHaskellType IntegerT = "Integer" 66 | toHaskellType DoubleT = "Double" 67 | toHaskellType BoolT = "Bool" 68 | toHaskellType CalendarTimeT = "CalendarTime" 69 | toHaskellType LocalTimeT = "LocalTime" 70 | toHaskellType (BStrT a) = "BStr" ++ show a 71 | 72 | -- | Given a query, returns a list of the field names and their 73 | -- types used by the query. Useful for recovering field information 74 | -- once a query has been built up. 75 | queryFields :: (ShowLabels r, ExprTypes r) => Query (Rel r) -> [(String, FieldDesc)] 76 | queryFields def = zip (labels query) types 77 | where 78 | query = unRel . snd . runQueryRel $ def 79 | types = fromHaskellTypes query 80 | unRel :: (Rel r) -> r 81 | unRel r = undefined -- Only used to get to type-level information. 82 | 83 | deriving instance Typeable CalendarTime -- not available in standard libraries 84 | 85 | instance (ExprType a) => ExprType (Maybe a) where 86 | fromHaskellType ~(Just e) = ((fst . fromHaskellType $ e), True) 87 | 88 | instance (ExprType a) => ExprType (Expr a) where 89 | fromHaskellType e = 90 | let unExpr :: Expr a -> a 91 | unExpr _ = undefined 92 | in fromHaskellType . unExpr $ e 93 | 94 | instance (ExprType a) => ExprType (Rel a) where 95 | fromHaskellType e = 96 | let unRel :: Rel a -> a 97 | unRel _ = undefined 98 | in fromHaskellType . unRel $ e 99 | 100 | instance ExprType Bool where 101 | fromHaskellType _ = (BoolT, False) 102 | 103 | instance ExprType String where 104 | fromHaskellType _ = (StringT, False) 105 | 106 | instance ExprType Int where 107 | fromHaskellType _ = (IntT, False) 108 | 109 | instance ExprType Integer where 110 | fromHaskellType _ = (IntegerT, False) 111 | 112 | instance ExprType Double where 113 | fromHaskellType _ = (DoubleT, False) 114 | 115 | instance ExprType CalendarTime where 116 | fromHaskellType _ = (CalendarTimeT, False) 117 | 118 | instance ExprType LocalTime where 119 | fromHaskellType _ = (LocalTimeT, False) 120 | 121 | instance (Size n) => ExprType (BoundedString n) where 122 | fromHaskellType b = (BStrT (listBound b), False) 123 | 124 | instance ExprTypes RecNil where 125 | fromHaskellTypes _ = [] 126 | 127 | instance (ExprType e, ExprTypes r) => ExprTypes (RecCons f e r) where 128 | fromHaskellTypes ~f@(RecCons e r) = 129 | let getFieldType :: RecCons f a r -> a 130 | getFieldType = undefined 131 | in (fromHaskellType . getFieldType $ f) : fromHaskellTypes r 132 | 133 | instance (ExprTypes r) => ExprTypes (Record r) where 134 | fromHaskellTypes r = fromHaskellTypes (r RecNil) 135 | 136 | instance (ExprTypes r) => ExprTypes (Rel r) where 137 | fromHaskellTypes r = 138 | let unRel :: Rel a -> a 139 | unRel _ = undefined 140 | in fromHaskellTypes . unRel $ r 141 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/PrintQuery.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : PrintQuery.hs 4 | -- Copyright : haskelldb-users@lists.sourceforge.net 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : non portable 10 | -- Author : Justin Bailey (jgbailey AT gmail DOT com) 11 | -- Pretty printing for Query, PrimQuery, and SqlSelect values. 12 | -- Useful for debugging the library. 13 | -- 14 | ----------------------------------------------------------- 15 | module Database.HaskellDB.PrintQuery 16 | (ppQuery, ppQueryUnOpt 17 | , ppSelect, ppSelectUnOpt, ppSqlSelect, ppPrim 18 | , Database.HaskellDB.PrintQuery.ppSql, Database.HaskellDB.PrintQuery.ppSqlUnOpt) 19 | 20 | where 21 | 22 | import Prelude hiding ((<>)) 23 | import Database.HaskellDB.PrimQuery 24 | import Database.HaskellDB.Sql 25 | import Database.HaskellDB.Query (Query, runQuery, Rel) 26 | import Database.HaskellDB.Optimize (optimize) 27 | import Database.HaskellDB.Sql.Generate (sqlQuery) 28 | import Database.HaskellDB.Sql.Default (defaultSqlGenerator) 29 | import Database.HaskellDB.Sql.Print as Sql (ppSql) 30 | import Text.PrettyPrint.HughesPJ 31 | 32 | -- | Take a query, turn it into a SqlSelect and print it. 33 | ppSql :: Query (Rel r) -> Doc 34 | ppSql qry = Sql.ppSql . sqlQuery defaultSqlGenerator . optimize $ runQuery qry 35 | 36 | -- | Take a query, turn it into a SqlSelect and print it. 37 | ppSqlUnOpt :: Query (Rel r) -> Doc 38 | ppSqlUnOpt qry = Sql.ppSql . sqlQuery defaultSqlGenerator $ runQuery qry 39 | 40 | -- | Take a query, turn it into a SqlSelect and print it. 41 | ppSelect :: Query (Rel r) -> Doc 42 | ppSelect qry = ppPQ (sqlQuery defaultSqlGenerator) optimize (runQuery $ qry) 43 | 44 | -- | Take a query, turn it into a SqlSelect and print it, with optimizations. 45 | ppSelectUnOpt :: Query (Rel r) -> Doc 46 | ppSelectUnOpt qry = ppPQ (sqlQuery defaultSqlGenerator) id (runQuery $ qry) 47 | 48 | -- | Optimize the query and pretty print the primitive representation. 49 | ppQuery :: Query (Rel r) -> Doc 50 | ppQuery qry = ppPrimF optimize (runQuery $ qry) 51 | 52 | -- | Pretty print the primitive representation of an unoptimized query. 53 | ppQueryUnOpt :: Query (Rel r) -> Doc 54 | ppQueryUnOpt qry = ppPrimF id (runQuery $ qry) 55 | 56 | -- | Pretty print a PrimQuery value. 57 | ppPrim :: PrimQuery -> Doc 58 | ppPrim = ppPrimF id 59 | 60 | -- | Transform a PrimQuery according to the function given, then 61 | -- pretty print it. 62 | ppPrimF :: (PrimQuery -> PrimQuery) -- ^ Transformation function to apply to PrimQuery first. 63 | -> PrimQuery -- ^ PrimQuery to print. 64 | -> Doc 65 | ppPrimF f qry = ppPrimF' (f qry) 66 | where 67 | ppPrimF' (BaseTable tableName scheme) = 68 | hang (text "BaseTable" <> colon <+> text tableName) 69 | nesting 70 | (brackets (fsep $ punctuate comma (map text scheme))) 71 | ppPrimF' (Project assoc primQuery) = 72 | hang (text "Project") 73 | nesting (brackets (ppAssoc assoc) $+$ 74 | parens (ppPrimF' primQuery)) 75 | ppPrimF' (Restrict primExpr primQuery) = 76 | hang (text "Restrict") 77 | nesting 78 | (ppExpr primExpr $+$ ppPrimF' primQuery) 79 | ppPrimF' (Group assoc primQuery) = 80 | hang (text "Group") 81 | nesting 82 | (brackets (ppAssoc assoc) $+$ 83 | parens (ppPrimF' primQuery)) 84 | ppPrimF' (Binary relOp primQueryL primQueryR) = 85 | hang (text "Binary:" <+> text (show relOp)) 86 | nesting 87 | (parens (ppPrimF' primQueryL) $+$ 88 | parens (ppPrimF' primQueryR)) 89 | ppPrimF' (Special specialOp primQuery) = 90 | hang (text "Special:" <+> text (show specialOp)) 91 | nesting 92 | (parens (ppPrimF' primQuery)) 93 | ppPrimF' Empty = text "Empty" 94 | 95 | -- | Pretty print an Assoc list (i.e. columns and expression). 96 | ppAssoc :: Assoc -> Doc 97 | ppAssoc assoc = fsep . punctuate comma . map (\(a, e) -> text a <> colon <+> ppExpr e) $ assoc 98 | 99 | -- | Pretty print an PrimExpr value. 100 | ppExpr :: PrimExpr -> Doc 101 | ppExpr = text . show 102 | 103 | ppPQ :: (PrimQuery -> SqlSelect) -- ^ Function to turn primitive query into a SqlSelect. 104 | -> (PrimQuery -> PrimQuery) -- ^ Transformation to apply to query, if any. 105 | -> PrimQuery -- ^ The primitive query to transform and print. 106 | -> Doc 107 | ppPQ select trans prim = ppSqlSelect . select . trans $ prim 108 | 109 | ppSqlSelect :: SqlSelect -> Doc 110 | ppSqlSelect (SqlBin string sqlSelectL sqlSelectR) = 111 | hang (text "SqlBin:" <+> text string) nesting 112 | (parens (ppSqlSelect sqlSelectL) $+$ 113 | parens (ppSqlSelect sqlSelectR)) 114 | ppSqlSelect (SqlTable sqlTable) = text "SqlTable:" <+> text sqlTable 115 | ppSqlSelect SqlEmpty = text "SqlEmpty" 116 | ppSqlSelect (SqlSelect options attrs tables criteria groupby orderby extra) = 117 | hang (text "SqlSelect") nesting $ 118 | hang (text "attrs:") nesting (brackets . fsep . punctuate comma . map ppAttr $ attrs) $+$ 119 | text "criteria:" <+> (brackets . fsep . punctuate comma . map ppSqlExpr $ criteria) $+$ 120 | hang (text "tables:") nesting (brackets . fsep . punctuate comma . map ppTable $ tables) $+$ 121 | maybe (text "groupby: empty") ppGroupBy groupby $+$ 122 | hang (text "orderby:") nesting (brackets . fsep . punctuate comma . map ppOrder $ orderby) $+$ 123 | text "extras:" <+> (brackets . fsep. punctuate comma . map text $ extra) $+$ 124 | text "options:" <+> (brackets . fsep . punctuate comma . map text $ options) 125 | 126 | ppGroupBy All = text "groupby: all" 127 | ppGroupBy (Columns cs) = hang (text "groupby:") nesting (brackets . fsep . punctuate comma . map ppAttr $ cs) 128 | 129 | ppTable :: (SqlTable, SqlSelect) -> Doc 130 | ppTable (tbl, select) = 131 | if null tbl 132 | then ppSqlSelect select 133 | else hang (text tbl <> colon) nesting (ppSqlSelect select) 134 | 135 | ppAttr :: (SqlColumn, SqlExpr) -> Doc 136 | ppAttr (col, expr) = text col <> colon <+> ppSqlExpr expr 137 | 138 | ppOrder :: (SqlExpr, SqlOrder) -> Doc 139 | ppOrder (expr, order) = parens (ppSqlExpr expr) <+> text (show order) 140 | 141 | ppSqlExpr :: SqlExpr -> Doc 142 | ppSqlExpr sql = text $ show sql 143 | 144 | -- | Nesting level. 145 | nesting :: Int 146 | nesting = 2 -------------------------------------------------------------------------------- /src/Database/HaskellDB/Sql/Generate.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.Sql.Generate 4 | -- Copyright : Daan Leijen (c) 1999, daan@cs.uu.nl 5 | -- HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : haskelldb-users@lists.sourceforge.net 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | -- The type of SQL generators. 13 | -- 14 | ----------------------------------------------------------- 15 | module Database.HaskellDB.Sql.Generate (SqlGenerator(..)) where 16 | 17 | import Database.HaskellDB.PrimQuery 18 | import Database.HaskellDB.FieldType 19 | import Database.HaskellDB.Sql 20 | 21 | 22 | data SqlGenerator = SqlGenerator 23 | { 24 | sqlQuery :: PrimQuery -> SqlSelect, 25 | sqlUpdate :: TableName -> [PrimExpr] -> Assoc -> SqlUpdate, 26 | sqlDelete :: TableName -> [PrimExpr] -> SqlDelete, 27 | sqlInsert :: TableName -> Assoc -> SqlInsert, 28 | sqlInsertQuery :: TableName -> PrimQuery -> SqlInsert, 29 | sqlCreateDB :: String -> SqlCreate, 30 | sqlCreateTable :: TableName -> [(Attribute,FieldDesc)] -> SqlCreate, 31 | sqlDropDB :: String -> SqlDrop, 32 | sqlDropTable :: TableName -> SqlDrop, 33 | 34 | sqlEmpty :: SqlSelect, 35 | sqlTable :: TableName -> Scheme -> SqlSelect, 36 | sqlProject :: Assoc -> SqlSelect -> SqlSelect, 37 | -- | Ensures non-aggregate expressions in the select are included in 38 | -- group by clause. 39 | sqlGroup :: Assoc -> SqlSelect -> SqlSelect, 40 | sqlRestrict :: PrimExpr -> SqlSelect -> SqlSelect, 41 | sqlBinary :: RelOp -> SqlSelect -> SqlSelect -> SqlSelect, 42 | sqlSpecial :: SpecialOp -> SqlSelect -> SqlSelect, 43 | 44 | sqlExpr :: PrimExpr -> SqlExpr, 45 | sqlLiteral :: Literal -> String, 46 | sqlType :: FieldType -> SqlType, 47 | -- | Turn a string into a quoted string. Quote characters 48 | -- and any escaping are handled by this function. 49 | sqlQuote :: String -> String 50 | } 51 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/Sql/MySQL.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.Sql.MySQL 4 | -- Copyright : Bjorn Bringert 2006 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- SQL generation for MySQL. 12 | -- 13 | ----------------------------------------------------------- 14 | module Database.HaskellDB.Sql.MySQL (generator) where 15 | 16 | import Database.HaskellDB.Sql 17 | import Database.HaskellDB.Sql.Default 18 | import Database.HaskellDB.Sql.Generate 19 | import Database.HaskellDB.PrimQuery 20 | 21 | generator :: SqlGenerator 22 | generator = (mkSqlGenerator generator) { 23 | sqlBinary = mySqlBinary 24 | } 25 | 26 | mySqlBinary :: RelOp -> SqlSelect -> SqlSelect -> SqlSelect 27 | mySqlBinary Difference = mySqlDifference 28 | mySqlBinary op = defaultSqlBinary generator op 29 | 30 | {- Hack around the lack of "EXCEPT" in MySql -} 31 | mySqlDifference :: SqlSelect -> SqlSelect -> SqlSelect 32 | mySqlDifference sel1 sel2 33 | = (toSqlSelect sel1) { criteria = [PrefixSqlExpr "NOT" $ ExistsSqlExpr existsSql] } 34 | where existsSql = (toSqlSelect ((toSqlSelect sel2) { attrs = zipWith mkAttr names renames })) 35 | { criteria = zipWith mkCond names renames } 36 | names = map fst $ attrs sel2 -- attrs sel1 should be the same, but it turned out to 37 | -- be undefined in the case I tried 38 | renames = map (++"_local") names 39 | mkAttr name rename = (rename, ColumnSqlExpr name) 40 | mkCond name rename = BinSqlExpr "=" (ColumnSqlExpr name) (ColumnSqlExpr rename) -------------------------------------------------------------------------------- /src/Database/HaskellDB/Sql/PostgreSQL.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.Sql.PostgreSQL 4 | -- Copyright : Bjorn Bringert 2006 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- SQL generation for PostgreSQL. 12 | -- 13 | ----------------------------------------------------------- 14 | module Database.HaskellDB.Sql.PostgreSQL (generator) where 15 | 16 | import Database.HaskellDB.Sql 17 | import Database.HaskellDB.Sql.Default 18 | import Database.HaskellDB.Sql.Generate 19 | import Database.HaskellDB.FieldType 20 | import Database.HaskellDB.PrimQuery 21 | import System.Locale 22 | import System.Time 23 | import Control.Arrow 24 | 25 | 26 | generator :: SqlGenerator 27 | generator = (mkSqlGenerator generator) { sqlSpecial = postgresqlSpecial 28 | , sqlType = postgresqlType 29 | , sqlLiteral = postgresqlLiteral 30 | , sqlExpr = postgresqlExpr 31 | , sqlTable = postgresqlTable 32 | , sqlInsert = postgresqlInsert 33 | , sqlDelete = postgresqlDelete 34 | , sqlUpdate = postgresqlUpdate 35 | } 36 | 37 | postgresqlUpdate :: TableName -> [PrimExpr] -> Assoc -> SqlUpdate 38 | postgresqlUpdate name exprs = defaultSqlUpdate generator name exprs . map (first quote) 39 | 40 | postgresqlTable :: TableName -> Scheme -> SqlSelect 41 | postgresqlTable tablename scheme = defaultSqlTable generator (quote tablename) (map quote scheme) 42 | 43 | postgresqlDelete :: TableName -> [PrimExpr] -> SqlDelete 44 | postgresqlDelete = defaultSqlDelete generator . quote 45 | 46 | postgresqlInsert :: TableName -> Assoc -> SqlInsert 47 | postgresqlInsert n = defaultSqlInsert generator (quote n) . map (first quote) 48 | 49 | postgresqlSpecial :: SpecialOp -> SqlSelect -> SqlSelect 50 | postgresqlSpecial op q = defaultSqlSpecial generator op q 51 | 52 | -- Postgres > 7.1 wants a timezone with calendar time. 53 | postgresqlLiteral :: Literal -> String 54 | postgresqlLiteral (DateLit d) = defaultSqlQuote generator (formatCalendarTime defaultTimeLocale fmt d) 55 | where fmt = iso8601DateFormat (Just "%H:%M:%S %Z") 56 | postgresqlLiteral (StringLit l) = "E" ++ (defaultSqlLiteral generator (StringLit l)) 57 | postgresqlLiteral l = defaultSqlLiteral generator l 58 | 59 | postgresqlType :: FieldType -> SqlType 60 | postgresqlType BoolT = SqlType "boolean" 61 | postgresqlType t = defaultSqlType generator t 62 | 63 | postgresqlExpr :: PrimExpr -> SqlExpr 64 | postgresqlExpr (BinExpr OpMod e1 e2) = 65 | let e1S = defaultSqlExpr generator e1 66 | e2S = defaultSqlExpr generator e2 67 | in BinSqlExpr "%" e1S e2S 68 | postgresqlExpr (AttrExpr n) = defaultSqlExpr generator $ AttrExpr $ quote n 69 | postgresqlExpr e = defaultSqlExpr generator e 70 | 71 | quote :: String -> String 72 | quote x@('"':_) = x 73 | quote x = case break (=='.') x of 74 | (l,[]) -> q l 75 | (l,r) -> q l ++ "." ++ q (drop 1 r) 76 | where q w = "\"" ++ w ++ "\"" 77 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/Sql/Print.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.Sql.Print 4 | -- Copyright : Daan Leijen (c) 1999, daan@cs.uu.nl 5 | -- HWT Group (c) 2003, haskelldb-users@lists.sourceforge.net 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : haskelldb-users@lists.sourceforge.net 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | -- Pretty-print SQL 13 | -- 14 | ----------------------------------------------------------- 15 | module Database.HaskellDB.Sql.Print ( 16 | ppSql, 17 | ppUpdate, 18 | ppDelete, 19 | ppInsert, 20 | ppCreate, 21 | ppDrop, 22 | ppSqlExpr 23 | ) where 24 | 25 | import Prelude hiding ((<>)) 26 | import Database.HaskellDB.Sql 27 | 28 | import Data.List (intersperse) 29 | import Text.PrettyPrint.HughesPJ 30 | 31 | 32 | -- * SELECT 33 | 34 | -- | Pretty prints a 'SqlSelect' 35 | ppSql :: SqlSelect -> Doc 36 | ppSql (SqlSelect options attrs tables criteria groupby orderby extra) 37 | = text "SELECT" 38 | <+> hsep (map text options) 39 | <+> ppAttrs attrs 40 | $$ ppTables tables 41 | $$ ppWhere criteria 42 | $$ maybe empty ppGroupBy groupby 43 | $$ ppOrderBy orderby 44 | $$ hsep (map text extra) 45 | ppSql (SqlBin op q1 q2) = parens (ppSql q1) $$ text op $$ parens (ppSql q2) 46 | ppSql (SqlTable name) = text name 47 | ppSql (SqlEmpty) = text "" 48 | 49 | ppAttrs :: [(SqlColumn,SqlExpr)] -> Doc 50 | ppAttrs [] = text "*" 51 | ppAttrs xs = commaV nameAs xs 52 | where 53 | -- | Print a name-value binding, or just the name if 54 | -- name and value are the same. 55 | nameAs :: (SqlColumn,SqlExpr) -> Doc 56 | nameAs (name, ColumnSqlExpr c) | name == c = text name 57 | nameAs (name,expr) = ppAs name (ppSqlExpr expr) 58 | 59 | -- FIXME: table aliases start from 1 in every select, which means that 60 | -- with binary RelOps we can get table alias clashes. 61 | ppTables :: [(SqlTable,SqlSelect)] -> Doc 62 | ppTables [] = empty 63 | ppTables ts = text "FROM" <+> commaV ppTable (zipWith tableAlias [1..] ts) 64 | where 65 | tableAlias :: Int -> (SqlTable,SqlSelect) -> (SqlTable,SqlSelect) 66 | tableAlias i (_,sql) = ("T" ++ show i,sql) 67 | 68 | ppTable :: (SqlTable,SqlSelect) -> Doc 69 | ppTable (alias,(SqlTable name)) = ppAs alias (text name) 70 | ppTable (alias,sql) = ppAs alias (parens (ppSql sql)) 71 | 72 | ppWhere :: [SqlExpr] -> Doc 73 | ppWhere [] = empty 74 | ppWhere es = text "WHERE" 75 | <+> hsep (intersperse (text "AND") 76 | (map (parens . ppSqlExpr) es)) 77 | 78 | ppGroupBy :: Mark -> Doc 79 | ppGroupBy All = error "Should not ever print GroupBy all." 80 | ppGroupBy (Columns es) = text "GROUP BY" <+> ppGroupAttrs es 81 | where 82 | ppGroupAttrs :: [(SqlColumn, SqlExpr)] -> Doc 83 | ppGroupAttrs cs = commaV nameOrExpr cs 84 | nameOrExpr :: (SqlColumn, SqlExpr) -> Doc 85 | nameOrExpr (_, ColumnSqlExpr col) = text col 86 | nameOrExpr (_, expr) = parens (ppSqlExpr expr) 87 | 88 | ppOrderBy :: [(SqlExpr,SqlOrder)] -> Doc 89 | ppOrderBy [] = empty 90 | ppOrderBy ord = text "ORDER BY" <+> commaV ppOrd ord 91 | where 92 | ppOrd (e,o) = ppSqlExpr e <+> ppSqlOrder o 93 | ppSqlOrder :: SqlOrder -> Doc 94 | ppSqlOrder SqlAsc = text "ASC" 95 | ppSqlOrder SqlDesc = text "DESC" 96 | 97 | ppAs :: String -> Doc -> Doc 98 | ppAs alias expr | null alias = expr 99 | | otherwise = expr <+> (hsep . map text) ["as",alias] 100 | 101 | 102 | -- * UPDATE 103 | 104 | -- | Pretty prints a 'SqlUpdate' 105 | ppUpdate :: SqlUpdate -> Doc 106 | ppUpdate (SqlUpdate name assigns criteria) 107 | = text "UPDATE" <+> text name 108 | $$ text "SET" <+> commaV ppAssign assigns 109 | $$ ppWhere criteria 110 | where 111 | ppAssign (c,e) = text c <+> equals <+> ppSqlExpr e 112 | 113 | 114 | -- * DELETE 115 | 116 | -- | Pretty prints a 'SqlDelete' 117 | ppDelete :: SqlDelete -> Doc 118 | ppDelete (SqlDelete name criteria) = 119 | text "DELETE FROM" <+> text name $$ ppWhere criteria 120 | 121 | 122 | -- * INSERT 123 | 124 | ppInsert :: SqlInsert -> Doc 125 | 126 | ppInsert (SqlInsert table names values) 127 | = text "INSERT INTO" <+> text table 128 | <+> parens (commaV text names) 129 | $$ text "VALUES" <+> parens (commaV ppSqlExpr values) 130 | 131 | ppInsert (SqlInsertQuery table names select) 132 | = text "INSERT INTO" <+> text table 133 | <+> parens (commaV text names) 134 | $$ ppSql select 135 | 136 | 137 | -- * CREATE 138 | 139 | -- | Pretty prints a 'SqlCreate'. 140 | ppCreate :: SqlCreate -> Doc 141 | ppCreate (SqlCreateDB name) = text "CREATE DATABASE" <+> text name 142 | ppCreate (SqlCreateTable name xs) 143 | = text "CREATE TABLE" <+> text name 144 | <+> parens (commaV ppF xs) 145 | where 146 | ppF (fname,t) = text fname <+> ppSqlTypeNull t 147 | 148 | ppSqlTypeNull :: (SqlType,Bool) -> Doc 149 | ppSqlTypeNull (t,nullable) = ppSqlType t <+> text (if nullable then " null" else " not null") 150 | 151 | ppSqlType :: SqlType -> Doc 152 | ppSqlType (SqlType t) = text t 153 | ppSqlType (SqlType1 t x) = text t <> parens (int x) 154 | ppSqlType (SqlType2 t x y) = text t <> parens (commaH int [x,y]) 155 | 156 | 157 | -- * DROP 158 | 159 | -- | Pretty prints a 'SqlDrop'. 160 | ppDrop :: SqlDrop -> Doc 161 | ppDrop (SqlDropDB name) = text "DROP DATABASE" <+> text name 162 | ppDrop (SqlDropTable name) = text "DROP TABLE" <+> text name 163 | 164 | 165 | -- * Expressions 166 | 167 | -- | Pretty prints a 'SqlExpr' 168 | ppSqlExpr :: SqlExpr -> Doc 169 | ppSqlExpr e = 170 | case e of 171 | ColumnSqlExpr c -> text c 172 | ParensSqlExpr e -> parens (ppSqlExpr e) 173 | BinSqlExpr op e1 e2 -> ppSqlExpr e1 <+> text op <+> ppSqlExpr e2 174 | PrefixSqlExpr op e -> text op <+> ppSqlExpr e 175 | PostfixSqlExpr op e -> ppSqlExpr e <+> text op 176 | FunSqlExpr f es -> text f <> parens (commaH ppSqlExpr es) 177 | AggrFunSqlExpr f es -> text f <> parens (commaH ppSqlExpr es) 178 | ConstSqlExpr c -> text c 179 | CaseSqlExpr cs el -> text "CASE" <+> vcat (map ppWhen cs) 180 | <+> text "ELSE" <+> ppSqlExpr el <+> text "END" 181 | where ppWhen (w,t) = text "WHEN" <+> ppSqlExpr w 182 | <+> text "THEN" <+> ppSqlExpr t 183 | ListSqlExpr es -> parens (commaH ppSqlExpr es) 184 | ExistsSqlExpr s -> text "EXISTS" <+> parens (ppSql s) 185 | ParamSqlExpr n v -> ppSqlExpr v 186 | PlaceHolderSqlExpr -> text "?" 187 | CastSqlExpr typ expr -> text "CAST" <> parens (ppSqlExpr expr <+> text "AS" <+> text typ) 188 | 189 | 190 | commaH :: (a -> Doc) -> [a] -> Doc 191 | commaH f = hcat . punctuate comma . map f 192 | 193 | commaV :: (a -> Doc) -> [a] -> Doc 194 | commaV f = vcat . punctuate comma . map f 195 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/Sql/SQLite.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Database.HaskellDB.Sql.SQLite 4 | -- Copyright : Bjorn Bringert 2006 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : haskelldb-users@lists.sourceforge.net 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- SQL generation for SQLite. 12 | -- See for documentation. 13 | -- 14 | ----------------------------------------------------------- 15 | module Database.HaskellDB.Sql.SQLite (generator) where 16 | 17 | import Database.HaskellDB.Sql.Default 18 | import Database.HaskellDB.Sql.Generate 19 | import Database.HaskellDB.PrimQuery 20 | 21 | generator :: SqlGenerator 22 | generator = (mkSqlGenerator generator) 23 | { 24 | sqlLiteral = literal 25 | } 26 | 27 | literal :: Literal -> String 28 | literal (StringLit s) = quote s 29 | literal DefaultLit = "NULL" 30 | literal (BoolLit True) = "1" 31 | literal (BoolLit False) = "0" 32 | literal l = defaultSqlLiteral generator l 33 | 34 | {- 35 | From http://www.sqlite.org/lang_expr.html 36 | 37 | "A string constant is formed by enclosing the string in single quotes ('). 38 | A single quote within the string can be encoded by putting two single quotes 39 | in a row - as in Pascal. C-style escapes using the backslash character 40 | are not supported because they are not standard SQL." 41 | -} 42 | quote :: String -> String 43 | quote s = "'" ++ concatMap escape s ++ "'" 44 | 45 | escape :: Char -> String 46 | escape '\'' = "''" 47 | escape c = [c] 48 | -------------------------------------------------------------------------------- /src/Database/HaskellDB/Version.hs: -------------------------------------------------------------------------------- 1 | module Database.HaskellDB.Version where 2 | 3 | -- FIXME: get this from preprocessing 4 | version:: String 5 | version = "0.10" -------------------------------------------------------------------------------- /test/.ghci: -------------------------------------------------------------------------------- 1 | :set -fprint-evld-with-show 2 | :set stop :list 3 | :set -i..\src -i..\driver-hdbc -i..\driver-hdbc-postgresql 4 | 5 | let sl _ = return ":steplocal" 6 | :def sl sl 7 | 8 | let s _ = return ":step" 9 | :def s s 10 | 11 | let sm _ = return ":stepmodule" 12 | :def sm sm 13 | 14 | -- Run one of the query tests in TestCases. Just give 15 | -- the name of the function. 16 | let xqt test = return $ "Test.HUnit.Text.runTestTT (" ++ test ++ " undefined undefined)" 17 | :def xqt xqt 18 | 19 | -- Print SQL for a query 20 | let pSQL query = return $ "Database.HaskellDB.PrintQuery.ppSql " ++ query 21 | :def pSQL pSQL 22 | 23 | -- Print unoptimized SQL for a query 24 | let pSQLU query = return $ "Database.HaskellDB.PrintQuery.ppSqlUnOpt " ++ query 25 | :def pSQLU pSQLU 26 | 27 | -- Print intermediate SqlSelect, after optimization, for a query. 28 | let pSelect query = return $ "Database.HaskellDB.PrintQuery.ppSelect " ++ query 29 | :def pSelect pSelect 30 | 31 | -- Print intermediate SqlSelect, unoptimized, for a query. 32 | let pSelectU query = return $ "Database.HaskellDB.PrintQuery.ppSelectUnOpt " ++ query 33 | :def pSelectU pSelectU 34 | 35 | -- Print the PrimQuery data structure for a query, after optimization. 36 | let pQuery query = return $ "Database.HaskellDB.PrintQuery.ppQuery " ++ query 37 | :def pQuery pQuery 38 | 39 | -- Print the PrimQuery data structure for a query, no optimization. 40 | let pQueryU query = return $ "Database.HaskellDB.PrintQuery.ppQueryUnOpt " ++ query 41 | :def pQueryU pQueryU 42 | 43 | :add Database.HaskellDB.PrintQuery 44 | :add *TestCases 45 | :m *TestCases 46 | 47 | -------------------------------------------------------------------------------- /test/DBTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# OPTIONS_GHC -fglasgow-exts #-} 3 | module DBTest where 4 | 5 | import Database.HaskellDB 6 | import Database.HaskellDB.Database 7 | import Database.HaskellDB.DBLayout 8 | import Database.HaskellDB.DBSpec.DBSpecToDatabase 9 | 10 | import Control.Exception (bracket_) 11 | 12 | import Test.HUnit 13 | 14 | data Conn = Conn { 15 | dbLabel :: String, 16 | dbConn :: forall a. (Database -> IO a) -> IO a 17 | } 18 | 19 | type DBTest = DBInfo -> Conn -> Test 20 | 21 | dbtests :: [DBTest] -> DBTest 22 | dbtests fs dbi c = TestList $ map (\f -> f dbi c) fs 23 | 24 | dbtest :: String -> (Database -> Assertion) -> DBTest 25 | dbtest l f dbi c = TestLabel l $ testWithDB f dbi c 26 | 27 | label :: String -> DBTest -> DBTest 28 | label l f dbi c = TestLabel l (f dbi c) 29 | 30 | testWithDB :: (Database -> Assertion) -> DBInfo -> Conn -> Test 31 | testWithDB f dbi c = TestCase $ withDB (withTables f dbi) c 32 | 33 | withDB :: (Database -> IO a) -> Conn -> IO a 34 | withDB f db = dbConn db f 35 | 36 | withTables :: (Database -> IO a) -> DBInfo -> Database -> IO a 37 | withTables f dbi db = bracket_ create (return ()) (f db) 38 | where create = do mapM_ (dropIfExists db . tname) ts 39 | mapM_ (tInfoToTable db) ts 40 | 41 | drop = mapM_ (dropIfExists db . tname) ts 42 | ts = tbls dbi 43 | 44 | 45 | dropIfExists :: Database -> String -> IO () 46 | dropIfExists db t = do ts <- tables db 47 | if t `elem` ts then dropTable db t else return () 48 | -------------------------------------------------------------------------------- /test/DescDB1.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Database.HaskellDB.DBLayout 4 | import Database.HaskellDB.DBSpec.DBSpecToDBDirect 5 | import Database.HaskellDB.DBSpec.PPHelpers (mkIdentPreserving) 6 | 7 | tables = [ 8 | string_tbl, 9 | int_tbl, 10 | integer_tbl, 11 | double_tbl, 12 | bool_tbl, 13 | calendartime_tbl, 14 | t1, 15 | t2 16 | ] 17 | 18 | string_tbl = TInfo {tname = "string_tbl", 19 | cols = [ 20 | CInfo {cname = "f01", descr = (StringT, True )}, 21 | CInfo {cname = "f02", descr = (StringT, False)}, 22 | CInfo {cname = "f03", descr = (StringT, True )}, 23 | CInfo {cname = "f04", descr = (StringT, False)} 24 | ]} 25 | 26 | int_tbl = TInfo {tname = "int_tbl", 27 | cols = [ 28 | CInfo {cname = "f01", descr = (IntT, True )}, 29 | CInfo {cname = "f02", descr = (IntT, False)}, 30 | CInfo {cname = "f03", descr = (IntT, True )}, 31 | CInfo {cname = "f04", descr = (IntT, False)} 32 | ]} 33 | 34 | 35 | integer_tbl = TInfo {tname = "integer_tbl", 36 | cols = [ 37 | CInfo {cname = "f01", descr = (IntegerT, True )}, 38 | CInfo {cname = "f02", descr = (IntegerT, False)}, 39 | CInfo {cname = "f03", descr = (IntegerT, True )}, 40 | CInfo {cname = "f04", descr = (IntegerT, False)} 41 | ]} 42 | 43 | double_tbl = TInfo {tname = "double_tbl", 44 | cols = [ 45 | CInfo {cname = "f01", descr = (DoubleT, True )}, 46 | CInfo {cname = "f02", descr = (DoubleT, False)}, 47 | CInfo {cname = "f03", descr = (DoubleT, True )}, 48 | CInfo {cname = "f04", descr = (DoubleT, False)} 49 | ]} 50 | 51 | bool_tbl = TInfo {tname = "bool_tbl", 52 | cols = [ 53 | CInfo {cname = "f01", descr = (BoolT, True )}, 54 | CInfo {cname = "f02", descr = (BoolT, False)}, 55 | CInfo {cname = "f03", descr = (BoolT, True )}, 56 | CInfo {cname = "f04", descr = (BoolT, False)} 57 | ]} 58 | 59 | calendartime_tbl = TInfo {tname = "calendartime_tbl", 60 | cols = [ 61 | CInfo {cname = "f01", descr = (CalendarTimeT, True )}, 62 | CInfo {cname = "f02", descr = (CalendarTimeT, False)}, 63 | CInfo {cname = "f03", descr = (CalendarTimeT, True )}, 64 | CInfo {cname = "f04", descr = (CalendarTimeT, False)} 65 | ]} 66 | 67 | 68 | t1 = TInfo {tname = "hdb_t1", 69 | cols = [CInfo {cname = "t1f01", descr = (StringT, True )}, 70 | CInfo {cname = "t1f02", descr = (StringT, False)}, 71 | CInfo {cname = "t1f03", descr = (StringT, True )}, 72 | CInfo {cname = "t1f04", descr = (StringT, False)}, 73 | 74 | CInfo {cname = "t1f05", descr = (IntT, True )}, 75 | CInfo {cname = "t1f06", descr = (IntT, False)}, 76 | CInfo {cname = "t1f07", descr = (IntT, True )}, 77 | CInfo {cname = "t1f08", descr = (IntT, False)}, 78 | 79 | CInfo {cname = "t1f09", descr = (IntegerT, True )}, 80 | CInfo {cname = "t1f10", descr = (IntegerT, False)}, 81 | CInfo {cname = "t1f11", descr = (IntegerT, True )}, 82 | CInfo {cname = "t1f12", descr = (IntegerT, False)}, 83 | 84 | CInfo {cname = "t1f13", descr = (DoubleT, True )}, 85 | CInfo {cname = "t1f14", descr = (DoubleT, False)}, 86 | CInfo {cname = "t1f15", descr = (DoubleT, True )}, 87 | CInfo {cname = "t1f16", descr = (DoubleT, False)}, 88 | 89 | -- Disabled for now, since booleans don't really work anywhere 90 | -- CInfo {cname = "t1f17", descr = (BoolT, True )}, 91 | -- CInfo {cname = "t1f18", descr = (BoolT, False)}, 92 | -- CInfo {cname = "t1f19", descr = (BoolT, True )}, 93 | -- CInfo {cname = "t1f20", descr = (BoolT, False)}, 94 | 95 | CInfo {cname = "t1f21", descr = (CalendarTimeT, True )}, 96 | CInfo {cname = "t1f22", descr = (CalendarTimeT, False)}, 97 | CInfo {cname = "t1f23", descr = (CalendarTimeT, True )}, 98 | CInfo {cname = "t1f24", descr = (CalendarTimeT, False)} 99 | ]} 100 | 101 | t2 = TInfo {tname = "hdb_t2", 102 | cols = [CInfo {cname = "t2f01", descr = (StringT, True )}, 103 | CInfo {cname = "t2f02", descr = (StringT, False)}, 104 | CInfo {cname = "t2f03", descr = (StringT, True )}, 105 | CInfo {cname = "t2f04", descr = (StringT, False)}, 106 | 107 | CInfo {cname = "t2f05", descr = (IntT, True )}, 108 | CInfo {cname = "t2f06", descr = (IntT, False)}, 109 | CInfo {cname = "t2f07", descr = (IntT, True )}, 110 | CInfo {cname = "t2f08", descr = (IntT, False)}, 111 | 112 | CInfo {cname = "t2f09", descr = (IntegerT, True )}, 113 | CInfo {cname = "t2f10", descr = (IntegerT, False)}, 114 | CInfo {cname = "t2f11", descr = (IntegerT, True )}, 115 | CInfo {cname = "t2f12", descr = (IntegerT, False)}, 116 | 117 | CInfo {cname = "t2f13", descr = (DoubleT, True )}, 118 | CInfo {cname = "t2f14", descr = (DoubleT, False)}, 119 | CInfo {cname = "t2f15", descr = (DoubleT, True )}, 120 | CInfo {cname = "t2f16", descr = (DoubleT, False)}, 121 | 122 | -- Disabled for now, since booleans don't really work anywhere 123 | -- CInfo {cname = "t2f17", descr = (BoolT, True )}, 124 | -- CInfo {cname = "t2f18", descr = (BoolT, False)}, 125 | -- CInfo {cname = "t2f19", descr = (BoolT, True )}, 126 | -- CInfo {cname = "t2f20", descr = (BoolT, False)}, 127 | 128 | CInfo {cname = "t2f21", descr = (CalendarTimeT, True )}, 129 | CInfo {cname = "t2f22", descr = (CalendarTimeT, False)}, 130 | CInfo {cname = "t2f23", descr = (CalendarTimeT, True )}, 131 | CInfo {cname = "t2f24", descr = (CalendarTimeT, False)} 132 | ]} 133 | 134 | 135 | createModules :: IO () 136 | createModules = dbInfoToModuleFiles "." "DB1" hdb_test_db 137 | where hdb_test_db = 138 | DBInfo {dbname = "hdb_test_db" 139 | , opts = DBOptions {useBString = False, makeIdent = mkIdentPreserving} 140 | , tbls = tables} 141 | 142 | 143 | 144 | 145 | main :: IO () 146 | main = createModules 147 | -------------------------------------------------------------------------------- /test/Makefile: -------------------------------------------------------------------------------- 1 | GHC = ghc 2 | GHCFLAGS = -fglasgow-exts -fcontext-stack64 3 | 4 | DRIVERS = \ 5 | flat \ 6 | hdbc-postgresql \ 7 | hdbc-sqlite3 \ 8 | hsql-mysql \ 9 | hsql-postgresql \ 10 | hsql-sqlite \ 11 | hsql-sqlite3 12 | 13 | .PHONY: runtests tests dbmodules clean 14 | 15 | runtests: tests 16 | @for d in $(DRIVERS); do echo "----------------------------------------------------------------"; echo "Testing $$d..."; if [ -x ./test-$$d ]; then ./test-$$d; else echo "test-$$d not found"; fi; done 17 | 18 | tests: dbmodules 19 | -@for d in $(DRIVERS); do echo "Compiling test-$$d..."; $(GHC) $(GHCFLAGS) -package haskelldb-$$d -v0 --make -o test-$$d test-$$d.hs; done 20 | 21 | dbmodules: createmodules 22 | ./createmodules 23 | 24 | createmodules: DescDB1.hs 25 | $(GHC) $(GHCFLAGS) --make -o $@ $< 26 | 27 | clean: 28 | -rm -f *.hi *.o DB1/*.hi DB1/*.hi 29 | -rm -f createmodules 30 | -for d in $(DRIVERS); do rm test-$$d; done 31 | 32 | genclean: clean 33 | -rm -rf DB1 DB1.hs 34 | -------------------------------------------------------------------------------- /test/README: -------------------------------------------------------------------------------- 1 | To run these tests, make sure haskelldb is installed with the database 2 | driver you want to use. Then, in the test/ directory: 3 | 4 | ghc --make DescDB1.hs 5 | ./DescDB1 6 | 7 | Install Test.Hunit and Text.Regex: 8 | 9 | cabal install HUnit 10 | cabal install regex-compat 11 | 12 | To test against postgres, using HDBC: 13 | 14 | ghc --make test-hdbc-postgresql.hs 15 | ./test-hdbc-postgresql -h -d -u -p 16 | 17 | And similarly for the other database and driver combinations. -------------------------------------------------------------------------------- /test/RunTests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module RunTests (Conn(..), dbTestMain) where 3 | 4 | import DBTest 5 | import TestCases 6 | 7 | import Test.HUnit 8 | 9 | import Control.Exception 10 | import Control.Monad 11 | import Prelude hiding (catch) 12 | import System.Environment 13 | import System.Exit 14 | import System.IO 15 | 16 | dbOK :: Conn -> IO Bool 17 | dbOK db = catch (withDB (\_ -> return True) db) f 18 | where 19 | f :: SomeException -> IO Bool 20 | f e = do hPutStrLn stderr $ "Problem with " ++ dbLabel db ++ ":" 21 | hPutStrLn stderr $ show e 22 | return False 23 | 24 | dbTestMain :: Conn -> IO () 25 | dbTestMain db = 26 | do ok <- dbOK db 27 | if ok then do c <- runTestTT (tests db) 28 | if errors c > 0 || failures c > 0 29 | then exitFailure 30 | else exitWith ExitSuccess 31 | else exitFailure 32 | -------------------------------------------------------------------------------- /test/old/CustomSql.hs: -------------------------------------------------------------------------------- 1 | module CustomSql where 2 | 3 | import Database.HaskellDB 4 | import Database.HaskellDB.DBLayout 5 | import Database.HaskellDB.Query 6 | import Database.HaskellDB.PrimQuery 7 | import System.Time 8 | 9 | -- 10 | -- Fields for getting results of a given type 11 | -- 12 | 13 | data Timefield = Timefield 14 | instance FieldTag Timefield where fieldName _ = "timefield" 15 | timefield = mkAttr Timefield :: Attr Timefield CalendarTime 16 | 17 | data Intfield = Intfield 18 | instance FieldTag Intfield where fieldName _ = "intfield" 19 | intfield = mkAttr Intfield :: Attr Intfield Int 20 | 21 | data Boolfield = Boolfield 22 | instance FieldTag Boolfield where fieldName _ = "boolfield" 23 | boolfield = mkAttr Boolfield :: Attr Boolfield Bool 24 | 25 | -- 26 | -- Utilities 27 | -- 28 | 29 | binop :: String -> Expr a -> Expr b -> Expr c 30 | binop op (Expr e1) (Expr e2) = Expr (BinExpr (OpOther op) e1 e2) 31 | 32 | -- 33 | -- Custom sql operators 34 | -- 35 | 36 | now :: Expr CalendarTime 37 | now = Expr (ConstExpr (OtherLit "NOW()")) 38 | 39 | last_insert_id :: Expr Int 40 | last_insert_id = Expr (ConstExpr (OtherLit "LAST_INSERT_ID()")) 41 | 42 | ilike :: Expr String -> Expr String -> Expr Bool 43 | ilike = binop "ILIKE" 44 | 45 | 46 | -------------------------------------------------------------------------------- /test/old/THField.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------- 2 | -- | 3 | -- Module : Query 4 | -- Copyright : HWT Group (c) 2003, dp03-7@mdstud.chalmers.se 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : dp03-7@mdstud.chalmers.se 8 | -- Stability : experimental 9 | -- Portability : non-portable (requires Template Haskell) 10 | -- 11 | -- Provides a Template Haskell function that declares 12 | -- a HaskellDB field. 13 | -- 14 | -- $Revision: 1.2 $ 15 | ----------------------------------------------------------- 16 | module THField (field, module Database.HaskellDB.DBLayout) where 17 | 18 | import Database.HaskellDB.DBLayout 19 | import Language.Haskell.THSyntax 20 | 21 | -- | Declare a field. 22 | field :: String -- ^ Haskell identifier for the field (e.g. "xid") 23 | -> String -- ^ Actual field name (e.g. "id") 24 | -> String -- ^ Name of the field label type (e.g. "Id") 25 | -> Bool -- ^ Whether the field is nullable 26 | -> String -- ^ Name of the value type of the field (e.g. "Int") 27 | -> Q [Dec] 28 | field attrName fieldName tagName nullable typeName 29 | = return $ mkField attrName fieldName tagName nullable typeName 30 | 31 | mkField :: String -> String -> String -> Bool -> String -> [Dec] 32 | mkField attrName fieldName tagName nullable typeName = 33 | [ 34 | mkTag tagName, 35 | mkFieldTagInstance tagName fieldName, 36 | mkAttrSig attrName tagName nullable typeName, 37 | mkAttrVal attrName tagName 38 | ] 39 | 40 | mkTag tagName = DataD [] tagName [] [NormalC tagName []] [] 41 | 42 | mkFieldTagInstance tagName fieldName = 43 | InstanceD [] (AppT (ConT "FieldTag") (ConT tagName)) 44 | [FunD "fieldName" 45 | [Clause [WildP] (NormalB (LitE (StringL fieldName))) []]] 46 | 47 | mkAttrSig attrName tagName nullable typeName 48 | = SigD attrName (AppT (AppT 49 | (ConT "Attr") 50 | (ConT tagName)) (mkType nullable typeName)) 51 | 52 | mkType nullable typeName = if nullable then AppT (ConT "Maybe") t else t 53 | where t = ConT typeName 54 | 55 | mkAttrVal attrName tagName = 56 | ValD (VarP attrName) (NormalB 57 | (AppE (VarE "mkAttr") 58 | (ConE tagName))) [] 59 | 60 | -------------------------------------------------------------------------------- /test/old/TestConnect.hs: -------------------------------------------------------------------------------- 1 | module TestConnect where 2 | 3 | import Database.HaskellDB 4 | import Database.HaskellDB.GenericConnect 5 | import System.Environment 6 | 7 | connect :: [String] -> (Database -> IO a) -> IO a 8 | connect (driver:args) = genericConnect driver args 9 | connect _ = error "No driver argument supplied" 10 | 11 | argConnect :: (Database -> IO a) -> IO a 12 | argConnect f = do 13 | args <- getArgs 14 | connect args f -------------------------------------------------------------------------------- /test/old/current-time.hs: -------------------------------------------------------------------------------- 1 | -- Nasty hack, demonstatrates how to use HaskellDB's internals to 2 | -- access non-standard database features. 3 | 4 | import Database.HaskellDB 5 | import Database.HaskellDB.DBLayout 6 | import Database.HaskellDB.Database 7 | import Database.HaskellDB.Query 8 | import Database.HaskellDB.PrimQuery 9 | import Database.HaskellDB.Sql hiding (tables) 10 | 11 | import TestConnect 12 | 13 | import Data.Maybe 14 | import System.Time 15 | 16 | now :: Expr CalendarTime 17 | now = Expr (ConstExpr (OtherLit "NOW()")) 18 | 19 | data Timefield = Timefield 20 | instance FieldTag Timefield where fieldName _ = "timefield" 21 | timefield = mkAttr Timefield :: Attr Timefield CalendarTime 22 | 23 | q = project (timefield << now) 24 | 25 | getTime :: Database -> IO CalendarTime 26 | getTime db = do 27 | (r:_) <- query db q 28 | return (r!timefield) 29 | 30 | printTime db = do 31 | putStrLn $ show $ showSql q 32 | t <- getTime db 33 | putStrLn $ calendarTimeToString t 34 | 35 | main = argConnect printTime -------------------------------------------------------------------------------- /test/old/custom-test.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | import Database.HaskellDB.HDBRec 3 | import Database.HaskellDB.Database (GetRec) 4 | 5 | import System.Time 6 | 7 | import CustomSql 8 | import TestConnect 9 | 10 | timeQ = project (timefield << now) 11 | 12 | ilikeQ s1 s2 = project (boolfield << s1 `ilike` s2) 13 | 14 | getOneField f db q = do 15 | [r] <- query db q 16 | return (r!f) 17 | 18 | getTime = getOneField timefield 19 | 20 | getBool = getOneField boolfield 21 | 22 | 23 | printResults :: ShowRecRow r => [r] -> IO () 24 | printResults = mapM_ (putStrLn . unwords . map (($ "") . snd) . showRecRow) 25 | 26 | printSql = putStrLn . show . showSql 27 | 28 | test db = do 29 | printSql timeQ 30 | getTime db timeQ >>= putStrLn . calendarTimeToString 31 | let iq = ilikeQ (constant "apa") (constant "APA") 32 | printSql iq 33 | getBool db iq >>= putStrLn . show 34 | 35 | main = argConnect test -------------------------------------------------------------------------------- /test/old/date-types.hs: -------------------------------------------------------------------------------- 1 | import System.Time (calendarTimeToString) 2 | 3 | import Database.HaskellDB 4 | import Dp037.D3proj_time_reports hiding (xid) 5 | import Dp037.D3proj_users 6 | 7 | import TestConnect 8 | 9 | getUsers = 10 | do 11 | users <- table d3proj_users 12 | reports <- table d3proj_time_reports 13 | order [asc reports day] 14 | restrict (users!xid .==. reports!userid) 15 | project (first_name << users!first_name # 16 | last_name << users!last_name # 17 | day << reports!day # 18 | reported << reports!reported 19 | ) 20 | 21 | 22 | showReport r = rpad 20 (r!first_name ++ " " ++ r!last_name) ++ " " 23 | ++ calendarTimeToString (r!day) ++ " " 24 | ++ calendarTimeToString (r!reported) 25 | 26 | rpad :: Int -> String -> String 27 | rpad x s = s ++ replicate (x - length s) ' ' 28 | 29 | printReports db = 30 | do 31 | users <- query db getUsers 32 | mapM_ (putStrLn . showReport) users 33 | 34 | main = argConnect printReports 35 | -------------------------------------------------------------------------------- /test/old/dbspec.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Database.HaskellDB 4 | import Database.HaskellDB.FieldType 5 | import Database.HaskellDB.DBSpec 6 | 7 | import System.Environment (getArgs) 8 | 9 | test = DBInfo {dbname = "ctest", opts = testopts, tbls = [testtbl1,testtbl2]} 10 | 11 | testopts = DBOptions {useBString = False} 12 | 13 | testtbl1 = TInfo {tname = "ctesttbl1", cols = [testcol11,testcol12]} 14 | testtbl2 = TInfo {tname = "ctesttbl2", cols = [testcol21,testcol22]} 15 | 16 | testcol11 = CInfo {cname = "ctestcol11", descr = (IntT,False)} 17 | testcol12 = CInfo {cname = "ctestcol12", descr = (BStrT 8,True)} 18 | 19 | testcol21 = CInfo {cname = "ctestcol21", descr = (BStrT 6,False)} 20 | testcol22 = CInfo {cname = "ctestcol22", descr = (IntT,True)} 21 | 22 | main = do 23 | args <- getArgs 24 | let db = genericConnect (head args) (tail args) 25 | db (\a -> dbSpecToDatabase a test) 26 | -------------------------------------------------------------------------------- /test/old/default-auto-inc.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | import Database.HaskellDB.HDBRec 3 | import Database.HaskellDB.Query 4 | import Database.HaskellDB.PrimQuery 5 | 6 | import TestConnect 7 | 8 | import Dp037.Test_default_auto 9 | 10 | 11 | {- 12 | MySQL: 13 | 14 | CREATE TABLE test_default_auto ( 15 | auto_col int NOT NULL auto_increment PRIMARY KEY, 16 | def1 int NOT NULL default '23', 17 | def2 int default '45', 18 | nodef1 int NOT NULL, 19 | nodef2 int NULL 20 | ) 21 | 22 | PostgreSQL: 23 | 24 | CREATE TABLE test_default_auto ( 25 | auto_col serial, 26 | def1 int NOT NULL default '23', 27 | def2 int default '45', 28 | nodef1 int NOT NULL, 29 | nodef2 int NULL 30 | ) 31 | -} 32 | 33 | 34 | showResults rs = mapM_ (putStrLn . unwords . map (($ "") . snd) . showRecRow) rs 35 | 36 | showTable db = query db (table test_default_auto) >>= showResults 37 | 38 | last_insert_id :: Expr Int 39 | last_insert_id = Expr (ConstExpr (OtherLit "last_insert_id()")) 40 | 41 | lid_q = project (def1 << last_insert_id) 42 | 43 | test db = do 44 | putStrLn "Before:" 45 | showTable db 46 | insert db test_default_auto (auto_col << _default # 47 | def1 << _default # 48 | def2 << _default # 49 | -- PostgreSQL make DEFAULT == NULL, 50 | -- so _default doesn't work for 51 | -- nodef1 52 | nodef1 << _default # 53 | nodef2 << _default) 54 | putStrLn "After:" 55 | showTable db 56 | putStrLn $ show $ showSql lid_q 57 | (r:_) <- query db lid_q 58 | putStrLn $ "New id: " ++ show (r!def1) 59 | 60 | main = argConnect test -------------------------------------------------------------------------------- /test/old/hardcoded-layout-simple-query.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | import Database.HaskellDB.DBLayout 3 | 4 | import TestConnect 5 | 6 | import Random 7 | 8 | 9 | -- create table test_tb1 (c11 int not null, c12 int null); 10 | 11 | --------------------------------------------------------------------------- 12 | -- Tables 13 | --------------------------------------------------------------------------- 14 | ------------------------------------- 15 | -- Table test_tb1 16 | ------------------------------------- 17 | test_tb1 :: Table 18 | (RecCons C11 (Expr Int) 19 | (RecCons C12 (Expr (Maybe Int)) RecNil)) 20 | test_tb1 = baseTable "test_tb1" $ 21 | hdbMakeEntry C11 # 22 | hdbMakeEntry C12 23 | 24 | --------------------------------------------------------------------------- 25 | -- Fields 26 | --------------------------------------------------------------------------- 27 | 28 | ------------------------------------- 29 | -- C11 Field 30 | ------------------------------------- 31 | 32 | data C11 = C11 33 | instance FieldTag C11 where fieldName _ = "c11" 34 | 35 | c11 :: Attr C11 Int 36 | c11 = mkAttr C11 37 | 38 | ------------------------------------- 39 | -- C12 Field 40 | ------------------------------------- 41 | 42 | data C12 = C12 43 | instance FieldTag C12 where fieldName _ = "c12" 44 | 45 | c12 :: Attr C12 (Maybe Int) 46 | c12 = mkAttr C12 47 | 48 | 49 | -- 50 | -- A simple query 51 | -- 52 | 53 | q = do 54 | tb1 <- table test_tb1 55 | project (c11 << tb1!c11 # c12 << tb1!c12) 56 | 57 | newRec x y = c11 << constant x # c12 << constant y 58 | 59 | printResults rs = mapM_ (\row -> putStrLn (show (row!c11) ++ " " ++ show (row!c12))) rs 60 | 61 | -- 62 | -- Testing db layout functions 63 | -- 64 | 65 | listTables db = tables db >>= putStr . unlines 66 | 67 | -- run 'describe' 68 | describeTable table db = describe db table >>= putStr . unlines . map show 69 | 70 | bigTest db = do 71 | putStrLn "Tables:" 72 | listTables db 73 | cols <- describe db "test_tb1" 74 | putStrLn "Columns in test_tb1" 75 | putStrLn (unlines (map show cols)) 76 | putStrLn "Contents of test_tb1" 77 | res <- query db q 78 | printResults res 79 | (x::Int) <- randomIO 80 | (y::Int) <- randomIO 81 | let my = if even y then Just y else Nothing 82 | -- insertNew db test_tb1 (newRec x my) 83 | -- insert db test_tb1 (project (newRec x my)) 84 | -- putStrLn $ "Contents of test_tb1 after inserting " ++ show (x,my) 85 | 86 | putStrLn "Contents of test_tb1" 87 | res <- query db q 88 | printResults res 89 | 90 | main = argConnect bigTest 91 | 92 | -------------------------------------------------------------------------------- /test/old/higher-order.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | 3 | import TestConnect 4 | 5 | import Dp037.D3proj_time_reports hiding (xid) 6 | import qualified Dp037.D3proj_time_reports 7 | import Dp037.D3proj_users 8 | 9 | onReportsUsers f 10 | = do 11 | reports <- table d3proj_time_reports 12 | users <- table d3proj_users 13 | restrict (reports!userid .==. users!xid) 14 | r <- project (userid << users!xid 15 | # first_name << users!first_name 16 | # last_name << users!last_name 17 | # email << users!email 18 | # day << reports!day 19 | # hours << reports!hours 20 | # activity << reports!activity 21 | # reported << reports!reported) 22 | f r 23 | 24 | q1 r = do 25 | restrict (r!userid .==. constant "d00bring") 26 | return r 27 | 28 | {- 29 | -- shouldn't work, and with the new type system restrictions on 30 | -- where aggregate functions can be used, it doesn't 31 | q2 r = do 32 | u <- project (userid << r!userid # hours << r!hours) 33 | restrict (_sum (u!hours) .>. constant 100.0) 34 | return 35 | -} 36 | 37 | q3 r = do 38 | u <- project (userid << r!userid # hours << _sum(r!hours)) 39 | restrict (u!hours .>. constant 12.0) 40 | return u 41 | 42 | test db = 43 | do 44 | rs1 <- query db $ onReportsUsers q1 45 | mapM_ (putStrLn . showRow) rs1 46 | -- putStrLn $ show $ showQ $ onReportsUsers q2 47 | -- putStrLn $ show $ showOpt $ onReportsUsers q2 48 | -- putStrLn $ show $ showSql $ onReportsUsers q2 49 | -- rs2 <- query db $ onReportsUsers q2 50 | -- mapM_ (putStrLn . showRow) rs2 51 | putStrLn $ show $ showQ $ onReportsUsers q3 52 | putStrLn $ show $ showOpt $ onReportsUsers q3 53 | putStrLn $ show $ showSql $ onReportsUsers q3 54 | rs3 <- query db $ onReportsUsers q3 55 | putStrLn ">100:" 56 | mapM_ (putStrLn . showRow) rs3 57 | 58 | 59 | showRow r = r!userid ++ ": " ++ show (r!hours) 60 | 61 | main = argConnect test 62 | -------------------------------------------------------------------------------- /test/old/html-users-list.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | 3 | import TestConnect 4 | 5 | import Dp037.D3proj_users 6 | 7 | getUsers = 8 | do 9 | users <- table d3proj_users 10 | order [asc users last_name, asc users first_name] 11 | project (first_name << users!first_name # 12 | last_name << users!last_name # 13 | email << users!email) 14 | 15 | 16 | showUser u = "
  • " ++ u!first_name ++ " " ++ u!last_name 17 | ++ " (" ++ obfuscate (u!email) 18 | ++ ")
    • " 19 | 20 | obfuscate addr = name ++ " AT " ++ safeTail domain 21 | where 22 | (name,domain) = break (=='@') addr 23 | safeTail [] = [] 24 | safeTail (_:xs) = xs 25 | 26 | printUserList db = 27 | do 28 | users <- query db getUsers 29 | putStrLn "
      " 30 | mapM_ (putStrLn . showUser) users 31 | putStrLn "
    " 32 | 33 | main = argConnect printUserList 34 | -------------------------------------------------------------------------------- /test/old/insert-update-delete.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | import Dp037.Test_tb1 3 | 4 | import TestConnect 5 | 6 | printTable db = 7 | do 8 | t <- query db (table test_tb1) 9 | mapM_ (putStrLn . showRow) t 10 | 11 | showRow r = lpad 10 (show (r!c11)) ++ lpad 10 (showNullable (r!c12)) 12 | 13 | showNullable :: Show a => Maybe a -> String 14 | showNullable = maybe "NULL" show 15 | 16 | lpad :: Int -> String -> String 17 | lpad x s = replicate (x - length s) ' ' ++ s 18 | 19 | 20 | testInsert db = 21 | do 22 | insert db test_tb1 (c11 << constant 157 # c12 << constant (Just 56)) 23 | insert db test_tb1 (c11 << constant (-567) # c12 << constant Nothing) 24 | 25 | testUpdate db = 26 | do 27 | update db test_tb1 (\r -> r!c11 .==. constant 157) (setC12 (Just 18)) 28 | where 29 | setC12 x r = c12 << constant x 30 | testDelete db = 31 | do 32 | delete db test_tb1 (\r -> r!c11 .==. constant 157 .||. isNull (r!c12)) 33 | 34 | test db = 35 | do 36 | putStrLn "Before insert:" 37 | printTable db 38 | testInsert db 39 | putStrLn "After insert:" 40 | printTable db 41 | testUpdate db 42 | putStrLn "After update:" 43 | printTable db 44 | testDelete db 45 | putStrLn "After delete:" 46 | printTable db 47 | 48 | main = argConnect test 49 | -------------------------------------------------------------------------------- /test/old/join-and-aggr.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad (unless) 2 | 3 | import Database.HaskellDB 4 | import Database.HaskellDB.Query (runQuery) -- for debugging 5 | 6 | import TestConnect 7 | 8 | import Dp037.D3proj_time_reports hiding (xid) 9 | import qualified Dp037.D3proj_time_reports 10 | import Dp037.D3proj_users 11 | 12 | {- 13 | 14 | Tables: 15 | 16 | CREATE TABLE d3proj_time_reports ( 17 | id int NOT NULL, 18 | userid varchar(8) NOT NULL, 19 | day date NOT NULL, 20 | hours float NOT NULL, 21 | activity text NOT NULL, 22 | reported timestamp NOT NULL, 23 | PRIMARY KEY (id) 24 | ) 25 | 26 | CREATE TABLE d3proj_users ( 27 | id varchar(8) NOT NULL, 28 | first_name varchar(255) NOT NULL, 29 | last_name varchar(255) NOT NULL, 30 | email varchar(255) NOT NULL, 31 | PRIMARY KEY (id) 32 | ) 33 | 34 | -} 35 | 36 | reports user 37 | = do 38 | reports <- table d3proj_time_reports 39 | users <- table d3proj_users 40 | restrict (reports!userid .==. users!xid .&&. reports!userid .==. constant user) 41 | project (first_name << users!first_name 42 | # last_name << users!last_name 43 | # activity << reports!activity) 44 | 45 | avgWorkChunks 46 | = do 47 | reports <- table d3proj_time_reports 48 | users <- table d3proj_users 49 | restrict (reports!userid .==. users!xid) 50 | r <- project (first_name << users!first_name 51 | # last_name << users!last_name 52 | # hours << avg (reports!hours)) 53 | order [asc r hours] 54 | return r 55 | 56 | floatTest 57 | = do 58 | reports <- table d3proj_time_reports 59 | project (hours << reports!hours) 60 | 61 | doFloatTest db 62 | = do 63 | result <- query db floatTest 64 | mapM_ (putStrLn . (\r -> show (r!hours))) result 65 | 66 | 67 | actToString r = r!first_name ++ " " ++ r!last_name ++ ": " ++ r!activity 68 | 69 | printActivity username db 70 | = do 71 | result <- query db (reports username) 72 | -- fs <- describe db "d3proj_users" 73 | -- putStrLn $ unlines $ map show fs 74 | mapM_ (putStrLn . actToString) result 75 | 76 | printAvgWorkChunks db 77 | = do 78 | result <- query db avgWorkChunks 79 | mapM_ (putStrLn . showRow) result 80 | where showRow r = r!first_name ++ " " ++ r!last_name ++ ": " ++ show (r!hours) ++ " h" 81 | 82 | main = do 83 | -- putStrLn $ show $ runQuery avgWorkChunks 84 | -- putStrLn $ show $ showQ avgWorkChunks 85 | -- putStrLn $ show $ showOpt avgWorkChunks 86 | putStrLn $ show $ showSql avgWorkChunks 87 | -- putStrLn $ show $ showOpt floatTest 88 | argConnect printAvgWorkChunks 89 | -------------------------------------------------------------------------------- /test/old/join-without-restrict.hs: -------------------------------------------------------------------------------- 1 | -- demonstrates an old bug with joins without a restrict 2 | 3 | import Database.HaskellDB 4 | import Database.HaskellDB.Sql 5 | import Database.HaskellDB.Query 6 | import Database.HaskellDB.Optimize 7 | import Database.HaskellDB.HDBRec 8 | import Database.HaskellDB.PrimQuery 9 | 10 | import TestConnect 11 | 12 | import Dp037.D3proj_time_reports hiding (xid) 13 | import qualified Dp037.D3proj_time_reports 14 | import Dp037.D3proj_users 15 | 16 | -- join and project, but no restrict 17 | q1 = do 18 | reports <- table d3proj_time_reports 19 | users <- table d3proj_users 20 | project (userid << reports!userid 21 | # first_name << users!first_name 22 | # last_name << users!last_name 23 | # activity << reports!activity) 24 | 25 | 26 | -- has restrict, but does not join on any fields 27 | q2 = do 28 | r <- q1 29 | restrict (r!userid .==. constant "d00bring") 30 | return r 31 | 32 | showRow :: ShowRecRow r => r -> String 33 | showRow = unwords . map (($ "") . snd) . showRecRow 34 | 35 | showUnoptSql = ppSql . toSql . runQuery 36 | 37 | testQuery db q = do 38 | putStrLn "-- PrimQuery:" 39 | putStrLn $ show $ showQ q 40 | putStrLn "-- Optimized PrimQuery:" 41 | putStrLn $ show $ showOpt q 42 | putStrLn "-- SQL:" 43 | putStrLn $ show $ showUnoptSql q 44 | putStrLn "-- Optimized SQL:" 45 | putStrLn $ show $ showSql q 46 | rs <- query db q 47 | mapM_ (putStrLn . showRow) rs 48 | 49 | test db = do 50 | testQuery db q1 51 | testQuery db q2 52 | 53 | main = argConnect test 54 | -------------------------------------------------------------------------------- /test/old/lazy.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | 3 | import TestConnect 4 | 5 | import Dp037.Lazy_test 6 | 7 | {- 8 | Uses table created with: 9 | CREATE TABLE lazy_test (doc_id INT NOT NULL, body TEXT NOT NULL); 10 | -} 11 | 12 | docSize = 1000 13 | numRecords = 10000 14 | getRecords = 10 15 | lazy = False 16 | 17 | addDoc db bdy di = 18 | insert db lazy_test (doc_id << constant di # body << constant bdy) 19 | 20 | doc_body = replicate docSize 'x' 21 | 22 | insertData db = mapM (addDoc db doc_body) [1..numRecords] 23 | 24 | deleteData db = delete db lazy_test (\_ -> constant True) 25 | 26 | countN db n = 27 | do 28 | rs <- (if lazy then lazyQuery else strictQuery) db (table lazy_test) 29 | return (length (take n rs)) 30 | 31 | test db = 32 | do 33 | putStrLn $ "Deleting data..." 34 | deleteData db 35 | putStrLn $ "Adding " ++ show numRecords ++ " records..." 36 | insertData db 37 | putStrLn $ "Counting " ++ show getRecords ++ " " 38 | ++ (if lazy then "lazy" else "strict") ++ " results ..." 39 | n <- countN db getRecords 40 | putStrLn $ "n = " ++ show n 41 | putStrLn $ "Deleting data..." 42 | deleteData db 43 | 44 | main = argConnect test 45 | -------------------------------------------------------------------------------- /test/old/max-row.hs: -------------------------------------------------------------------------------- 1 | -- Gets the activity from the row with the highest id. 2 | 3 | import Database.HaskellDB 4 | 5 | import TestConnect 6 | 7 | import Dp037.D3proj_time_reports 8 | 9 | q = do 10 | t <- table d3proj_time_reports 11 | t' <- table d3proj_time_reports 12 | r <- project (xid << _max (t'!xid)) 13 | restrict (t!xid .==. r!xid) 14 | project (activity << t!activity) 15 | 16 | test db = do 17 | print $ showSql q 18 | rs <- query db q 19 | mapM_ print rs 20 | 21 | main = argConnect test -------------------------------------------------------------------------------- /test/old/null-and-case.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | 3 | import TestConnect 4 | 5 | import Dp037.Hdb_test_t1 6 | 7 | q1 = do 8 | t <- table hdb_test_t1 9 | restrict (fromNull (constant "") (t!t1f01) `like` constant "foo") 10 | return t 11 | 12 | test db = 13 | do 14 | putStrLn $ show $ showSql q1 15 | rs <- query db q1 16 | mapM_ (putStrLn . showRow) rs 17 | 18 | showRow r = show (r!t1f01) 19 | 20 | main = argConnect test 21 | -------------------------------------------------------------------------------- /test/old/quickcheck.hs: -------------------------------------------------------------------------------- 1 | import Debug.QuickCheck 2 | 3 | import Database.HaskellDB 4 | import Database.HaskellDB.Database 5 | 6 | import Dp037.D3proj_time_reports 7 | 8 | import TestConnect 9 | 10 | {- 11 | 12 | Possible properties: 13 | 14 | -- optimization does not change result 15 | 16 | -- lazy and strict give same results 17 | 18 | -- inserting a row and then retrieving it gives the original values 19 | 20 | -- show . read == id for records 21 | 22 | -- read . show == id for records 23 | 24 | -- read . show == id for records 25 | 26 | -- creating a table and describing it gives the orginal spec 27 | 28 | -- same operations on different databases gie the same result 29 | 30 | -} 31 | 32 | -- FIXME: allow row permutations? 33 | resultEq :: Eq r => [Row r] -> [Row r] -> Bool 34 | resultEq [] [] = True 35 | resultEq (Row x:xs) (Row y:ys) = x == y 36 | resultEq _ _ = False 37 | 38 | sameResults :: (GetRec r vr, Eq vr) => 39 | Database -> Query (Rel r) -> Query (Rel r) -> IO Bool 40 | sameResults db q1 q2 = do 41 | rs1 <- query db q1 42 | rs2 <- query db q2 43 | return $ resultEq rs1 rs2 44 | 45 | q1 = do 46 | r <- table d3proj_time_reports 47 | restrict (r!userid .==. constant "d00bring") 48 | restrict (r!hours .>. constant 0.5) 49 | return r 50 | 51 | q2 = do 52 | r <- table d3proj_time_reports 53 | restrict (r!userid .==. constant "d00bring" 54 | .&&. r!hours .>. constant 0.5) 55 | return r 56 | 57 | t db = do 58 | sameResults db q1 q2 >>= putStrLn . show 59 | 60 | main = argConnect t -------------------------------------------------------------------------------- /test/old/run-all-tests: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | #HSQL_DIR=/usr/local/lib/HSQL/Hugs/libraries 4 | HSQL_DIR=/usr/local/dp03-7/lib/HSQL/Hugs/libraries 5 | 6 | PROG="hardcoded-layout-simple-query join-and-aggr html-users-list \ 7 | current-time date-types test-non-ascii \ 8 | insert-update-delete test-bounded transaction \ 9 | higher-order big-test null-and-case \ 10 | join-without-restrict test-sum" 11 | 12 | # make sure TestConnect.hs exists 13 | make TestConnect.hs 14 | 15 | echo "Deleting old database definitions..." 16 | rm -rf Dp037* 17 | echo 18 | 19 | echo "Running DbDirect..." 20 | ../build/ghc/DBDirect "$@" Dp037 || exit 1 21 | echo 22 | 23 | echo "Running DbDirect -b..." 24 | ../build/ghc/DBDirect -b "$@" Dp037_bounded || exit 1 25 | echo 26 | 27 | # run tests with ghc 28 | for p in $PROG; do 29 | echo "GHC compiling $p" 30 | make $p || exit 1 31 | echo "GHC running: $p" 32 | ./$p "$@" || exit 1 33 | done 34 | 35 | # run tests with hugs 36 | for p in $PROG; do 37 | echo "Hugs running: $p" 38 | runhugs -98 +o -P:$HSQL_DIR -h1024K $p.hs "$@" || exit 1 39 | done -------------------------------------------------------------------------------- /test/old/same-name.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | 3 | import TestConnect 4 | 5 | import qualified Dp037.D3proj_time_reports as R 6 | import qualified Dp037.D3proj_users as U 7 | 8 | q = do 9 | reports <- table R.d3proj_time_reports 10 | users <- table U.d3proj_users 11 | project (R.xid << reports!R.xid 12 | # U.xid << users!U.xid) 13 | 14 | test db = do 15 | rs <- query db q 16 | mapM_ (\r -> print (r!R.xid, r!U.xid)) rs 17 | 18 | main = do 19 | putStrLn $ show $ showSql q 20 | argConnect test -------------------------------------------------------------------------------- /test/old/test-bounded.hs: -------------------------------------------------------------------------------- 1 | import System.Environment 2 | 3 | import TestConnect 4 | 5 | import Database.HaskellDB 6 | import Database.HaskellDB.BoundedList 7 | import Database.HaskellDB.HSQL.ODBC 8 | import Dp037_bounded.D3proj_users 9 | 10 | q n = do 11 | users <- table d3proj_users 12 | restrict (users!xid .==. constant (trunc n)) 13 | project (first_name << users!first_name # last_name << users!last_name) 14 | 15 | printName r = putStrLn (fromBounded (r!first_name) ++ " " 16 | ++ fromBounded (r!last_name)) 17 | 18 | main = do 19 | connArgs <- getArgs 20 | connect connArgs (\db -> query db (q "d00bring") >>= mapM_ printName) -------------------------------------------------------------------------------- /test/old/test-non-ascii.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | import Database.HaskellDB.Database 3 | import Database.HaskellDB.DBSpec.DBSpecToDatabase 4 | 5 | import TestConnect 6 | 7 | import Control.Exception 8 | import System.IO 9 | 10 | -- 11 | -- Database description 12 | -- 13 | 14 | import Database.HaskellDB.DBLayout 15 | 16 | 17 | dbinfo :: DBInfo 18 | dbinfo = DBInfo {dbname = "Dp037", 19 | opts = DBOptions {useBString = False}, 20 | tbls = [TInfo {tname = "test_non_ascii", 21 | cols = [CInfo {cname = "str_id", 22 | descr = (IntT, False)}, 23 | CInfo {cname = "str", 24 | descr = (StringT, False)}]}] 25 | } 26 | 27 | --------------------------------------------------------------------------- 28 | -- Table 29 | --------------------------------------------------------------------------- 30 | test_non_ascii :: Table 31 | ((RecCons Str_id (Expr Int) 32 | (RecCons Str (Expr String) RecNil))) 33 | 34 | test_non_ascii = baseTable "test_non_ascii" $ 35 | hdbMakeEntry Str_id # 36 | hdbMakeEntry Str 37 | 38 | --------------------------------------------------------------------------- 39 | -- Fields 40 | --------------------------------------------------------------------------- 41 | --------------------------------------------------------------------------- 42 | -- Str_id Field 43 | --------------------------------------------------------------------------- 44 | 45 | data Str_id = Str_id 46 | 47 | instance FieldTag Str_id where fieldName _ = "str_id" 48 | 49 | str_id :: Attr Str_id Int 50 | str_id = mkAttr Str_id 51 | 52 | --------------------------------------------------------------------------- 53 | -- Str Field 54 | --------------------------------------------------------------------------- 55 | 56 | data Str = Str 57 | 58 | instance FieldTag Str where fieldName _ = "str" 59 | 60 | str :: Attr Str String 61 | str = mkAttr Str 62 | 63 | 64 | 65 | -- 66 | -- Database creation 67 | -- 68 | 69 | printIOErrors :: IO () -> IO () 70 | printIOErrors = handleJust ioErrors (hPutStrLn stderr . show) 71 | 72 | recreateDB :: Database -> DBInfo -> IO () 73 | recreateDB db info = do 74 | dropTables db info 75 | dbSpecToDatabase db info 76 | 77 | dropTables :: Database -> DBInfo -> IO () 78 | dropTables db info = mapM_ (printIOErrors . dropTable db . tname) (tbls info) 79 | 80 | -- 81 | -- Testing 82 | -- 83 | 84 | addGet db i s = do 85 | insert db test_non_ascii (str_id << constant i 86 | # str << constant s) 87 | (r:_) <- query db $ do 88 | t <- table test_non_ascii 89 | restrict (t!str_id .==. constant i) 90 | return t 91 | return (r!str) 92 | 93 | showStr s = s ++ " (" ++ show s ++ ")" 94 | 95 | testStr db i s = do 96 | s' <- addGet db i s 97 | putStrLn $ showStr s ++ " => " ++ showStr s' 98 | 99 | test :: Database -> IO () 100 | test db = do 101 | testStr db 0 "åäöñ" 102 | testStr db 1 "'\"\\" 103 | 104 | -- 105 | -- Main function 106 | -- 107 | 108 | main = argConnect $ \db -> do 109 | recreateDB db dbinfo 110 | test db 111 | dropTables db dbinfo 112 | -------------------------------------------------------------------------------- /test/old/test-sum.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | 3 | import TestConnect 4 | 5 | import Dp037.D3proj_time_reports 6 | 7 | 8 | q = do 9 | reports <- table d3proj_time_reports 10 | project (userid << reports!userid 11 | # xid << _sum (reports!xid)) 12 | 13 | test db 14 | = do 15 | result <- query db q 16 | mapM_ (putStrLn . show) result 17 | 18 | main = do 19 | putStrLn $ show $ showSql q 20 | argConnect test 21 | -------------------------------------------------------------------------------- /test/old/th-field-test.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | 3 | import TestConnect 4 | import THField 5 | 6 | import Dp037.D3proj_time_reports 7 | 8 | $(field "_foo" "foo" "Foo" False "Int") 9 | 10 | q = do 11 | t <- table d3proj_time_reports 12 | project (_foo << count(t!userid)) 13 | 14 | test db = do 15 | rs <- query db q 16 | print rs 17 | 18 | main = argConnect test -------------------------------------------------------------------------------- /test/old/top.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | 3 | import TestConnect 4 | 5 | import Dp037.D3proj_users 6 | 7 | -- victor said that top, topPercent and union produce SQL errors 8 | 9 | opts = ODBCOptions{dsn="mysql-dp037", uid="dp037", pwd="teent333"} 10 | withDB f = odbcConnect opts f 11 | 12 | q1 = do 13 | users <- table d3proj_users 14 | top 2 15 | order [asc users xid] 16 | return users 17 | 18 | {- 19 | q2 = do 20 | users <- table d3proj_users 21 | topPercent 20 22 | return users 23 | -} 24 | 25 | q3 = do 26 | users <- table d3proj_users 27 | order [desc users xid] 28 | top 2 29 | return users 30 | 31 | pp = putStrLn . show . showSql 32 | 33 | printIds = mapM (\r -> putStrLn (r!xid)) 34 | 35 | tests db = do 36 | putStrLn "top:" 37 | pp q1 38 | rs <- query db q1 39 | printIds rs 40 | putStrLn "" 41 | -- putStrLn "topPercent:" 42 | -- pp q2 43 | -- putStrLn "" 44 | putStrLn "union:" 45 | let u = q1 `union` q3 46 | pp u 47 | rs <- query db u 48 | printIds rs 49 | putStrLn "" 50 | 51 | main = argConnect tests 52 | -------------------------------------------------------------------------------- /test/old/transaction.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB 2 | 3 | import TestConnect 4 | 5 | import Control.Exception 6 | import Dp037.Test_tb1 7 | 8 | printRecord r = putStrLn $ show (r!c11) ++ " " ++ show (r!c12) 9 | 10 | printRecords db = do 11 | rs <- query db (table test_tb1) 12 | mapM_ printRecord rs 13 | 14 | testTrans db = do 15 | insert db test_tb1 (c11 << constant 2 # c12 << constJust (-67)) 16 | fail "oops, that didn't work out" 17 | 18 | handleErr io = catchJust userErrors io 19 | (\e -> putStrLn $ "caught nasty exception: " ++ e) 20 | 21 | test db = do 22 | putStrLn "before transaction:" 23 | handleErr $ printRecords db 24 | handleErr $ transaction db (testTrans db) 25 | putStrLn "after transaction:" 26 | handleErr $ printRecords db 27 | 28 | 29 | main = argConnect test 30 | -------------------------------------------------------------------------------- /test/test-flat.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.FlatDB 2 | 3 | import RunTests 4 | 5 | opts = [("filepath","flatdb-test.db")] 6 | 7 | main = dbTestMain $ Conn { 8 | dbLabel = "flat", 9 | dbConn = connect driver opts 10 | } 11 | -------------------------------------------------------------------------------- /test/test-hdbc-postgresql.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HDBC.PostgreSQL 2 | import Database.HDBC 3 | import System.Console.GetOpt 4 | import System.Environment 5 | import System.Exit 6 | import Control.Monad 7 | 8 | import RunTests 9 | 10 | data Options = Host String 11 | | Database String 12 | | User String 13 | | Password String 14 | | Help 15 | deriving Eq 16 | 17 | opts = [Option ['h'] ["host"] (ReqArg Host "host") "Host to connect to for testing." 18 | , Option ['d'] ["dbname"] (ReqArg Database "database") "Name of database to use for testing." 19 | , Option ['u'] ["user"] (ReqArg User "username") "Username to login with." 20 | , Option ['p'] ["password"] (ReqArg Password "password") "Password to use." 21 | , Option ['?'] ["help"] (NoArg Help) "Help text." ] 22 | 23 | toConn (Host s) = ("host", s) 24 | toConn (Database s) = ("dbname", s) 25 | toConn (User s) = ("user", s) 26 | toConn (Password s) = ("password", s) 27 | toConn Help = ("", "") 28 | 29 | main = do 30 | (args, _, err) <- getArgs >>= return . getOpt RequireOrder opts 31 | when (not . null $ err) $ do { mapM_ putStrLn err; 32 | exitWith $ ExitFailure 1 } 33 | when (null args || Help `elem` args) $ do { putStrLn (usageInfo "" opts); 34 | exitWith ExitSuccess } 35 | dbTestMain $ Conn { dbLabel = "hdbc-postgresql" 36 | , dbConn = connect driver (map toConn args) } 37 | -------------------------------------------------------------------------------- /test/test-hdbc-sqlite3.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HDBC.SQLite3 2 | 3 | import RunTests 4 | 5 | opts = [("filepath","hdbc-sqlite3-test.db")] 6 | 7 | main = dbTestMain $ Conn { 8 | dbLabel = "hdbc-sqlite3", 9 | dbConn = connect driver opts 10 | } 11 | -------------------------------------------------------------------------------- /test/test-hsql-mysql.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.MySQL 2 | 3 | import RunTests 4 | 5 | opts = [] 6 | 7 | main = dbTestMain $ Conn { 8 | dbLabel = "hsql-mysql", 9 | dbConn = connect driver opts 10 | } 11 | -------------------------------------------------------------------------------- /test/test-hsql-postgresql.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.PostgreSQL 2 | 3 | import RunTests 4 | 5 | opts = [("server", "localhost"), 6 | ("db","hdb_test"), 7 | ("uid","hdb_test"), 8 | ("pwd","hdb_test_pass")] 9 | 10 | main = dbTestMain $ Conn { 11 | dbLabel = "hsql-postgresql", 12 | dbConn = connect driver opts 13 | } 14 | -------------------------------------------------------------------------------- /test/test-hsql-sqlite.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.SQLite 2 | 3 | import RunTests 4 | 5 | opts = [("filepath","hsql-sqlite-test.db"),("mode","rw")] 6 | 7 | main = dbTestMain $ Conn { 8 | dbLabel = "hsql-sqlite", 9 | dbConn = connect driver opts 10 | } 11 | -------------------------------------------------------------------------------- /test/test-hsql-sqlite3.hs: -------------------------------------------------------------------------------- 1 | import Database.HaskellDB.HSQL.SQLite3 2 | 3 | import RunTests 4 | 5 | opts = [("filepath","hsql-sqlite3-test.db"),("mode","rw")] 6 | 7 | main = dbTestMain $ Conn { 8 | dbLabel = "hsql-sqlite3", 9 | dbConn = connect driver opts 10 | } 11 | -------------------------------------------------------------------------------- /unregister-all: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | for p in `ghc-pkg list --simple-output | perl -pe 's/ /\n/g' | grep haskelldb`; do sudo ghc-pkg unregister $p; done 4 | --------------------------------------------------------------------------------