├── .gitignore ├── .hgtags ├── .travis.yml ├── HDBC-session ├── GNUmakefile ├── HDBC-session.cabal ├── LICENSE ├── Setup.hs └── src │ └── Database │ └── HDBC │ └── Session.hs ├── README.md ├── cabal.project ├── debian-backup ├── HDBC-session │ └── debian │ │ ├── changelog │ │ ├── compat │ │ ├── control │ │ ├── copyright │ │ ├── rules │ │ ├── source │ │ └── format │ │ └── watch ├── names-th │ └── debian │ │ ├── changelog │ │ ├── compat │ │ ├── control │ │ ├── copyright │ │ ├── rules │ │ ├── source │ │ └── format │ │ └── watch ├── persistable-record │ └── debian │ │ ├── changelog │ │ ├── compat │ │ ├── control │ │ ├── copyright │ │ ├── rules │ │ ├── source │ │ └── format │ │ └── watch ├── persistable-types-HDBC-pg │ └── debian │ │ ├── changelog │ │ ├── compat │ │ ├── control │ │ ├── copyright │ │ ├── rules │ │ ├── source │ │ └── format │ │ └── watch ├── relational-query-HDBC │ └── debian │ │ ├── changelog │ │ ├── compat │ │ ├── control │ │ ├── copyright │ │ ├── rules │ │ ├── source │ │ └── format │ │ └── watch ├── relational-query │ └── debian │ │ ├── changelog │ │ ├── compat │ │ ├── control │ │ ├── copyright │ │ ├── rules │ │ ├── source │ │ └── format │ │ └── watch ├── relational-schemas │ └── debian │ │ ├── changelog │ │ ├── compat │ │ ├── control │ │ ├── copyright │ │ ├── rules │ │ ├── source │ │ └── format │ │ └── watch ├── sql-words │ └── debian │ │ ├── changelog │ │ ├── compat │ │ ├── control │ │ ├── copyright │ │ ├── rules │ │ ├── source │ │ └── format │ │ └── watch └── text-postgresql │ └── debian │ ├── changelog │ ├── compat │ ├── control │ ├── copyright │ ├── rules │ ├── source │ └── format │ └── watch ├── devel ├── GNUmakefile └── black.css ├── doc └── slide │ ├── Haskell-Day-201609 │ ├── Birthday.hs │ ├── DataSource.hs │ ├── GNUmakefile │ ├── HRR.html │ ├── HRR.md │ ├── Person.hs │ ├── haskell-day.drop.sql │ ├── haskell-day.sql │ ├── join.hs │ └── s5 │ │ └── default │ │ ├── blank.gif │ │ ├── bodybg.gif │ │ ├── framing.css │ │ ├── iepngfix.htc │ │ ├── opera.css │ │ ├── outline.css │ │ ├── pretty.css │ │ ├── print.css │ │ ├── s5-core.css │ │ ├── slides.css │ │ └── slides.js │ ├── PostgreSQL-Unconference-201512 │ ├── Birthday.hs │ ├── DS.hs │ ├── GNUmakefile │ ├── Person.hs │ ├── Query.html │ ├── Query.md │ ├── join.hs │ ├── pgcon.drop.sql │ ├── pgcon.sql │ └── s5 │ │ └── default │ │ ├── blank.gif │ │ ├── bodybg.gif │ │ ├── framing.css │ │ ├── iepngfix.htc │ │ ├── opera.css │ │ ├── outline.css │ │ ├── pretty.css │ │ ├── print.css │ │ ├── s5-core.css │ │ ├── slides.css │ │ └── slides.js │ ├── code-reading-201601 │ ├── Birthday.hs │ ├── DS.hs │ ├── GNUmakefile │ ├── Person.hs │ ├── SourceTreeJ.html │ ├── SourceTreeJ.md │ ├── join.hs │ └── s5 │ │ └── default │ │ ├── blank.gif │ │ ├── bodybg.gif │ │ ├── framing.css │ │ ├── iepngfix.htc │ │ ├── opera.css │ │ ├── outline.css │ │ ├── pretty.css │ │ ├── print.css │ │ ├── s5-core.css │ │ ├── slides.css │ │ └── slides.js │ ├── haskell-hackathon-201412 │ ├── ArrowQuery.hs │ ├── Birthday.hs │ ├── GNUmakefile │ ├── HRR.html │ ├── HRR.md │ ├── Person.hs │ ├── arr.hs │ ├── join.hs │ ├── mytable.hs │ ├── opaleye │ │ ├── Birthday.hs │ │ ├── Person.hs │ │ └── e.hs │ └── s5 │ │ └── default │ │ ├── blank.gif │ │ ├── bodybg.gif │ │ ├── framing.css │ │ ├── iepngfix.htc │ │ ├── opera.css │ │ ├── outline.css │ │ ├── pretty.css │ │ ├── print.css │ │ ├── s5-core.css │ │ ├── slides.css │ │ └── slides.js │ └── tsukuba-201412 │ ├── Birthday.hs │ ├── DSL.html │ ├── DSL.md │ ├── GNUmakefile │ ├── Person.hs │ ├── join.hs │ ├── mytable.hs │ └── s5 │ └── default │ ├── blank.gif │ ├── bodybg.gif │ ├── framing.css │ ├── iepngfix.htc │ ├── opera.css │ ├── outline.css │ ├── pretty.css │ ├── print.css │ ├── s5-core.css │ ├── slides.css │ └── slides.js ├── examples └── HDBC │ ├── MySQL │ ├── GNUmakefile │ ├── LICENSE │ ├── Setup.hs │ ├── hrr-example-HDBC-MySQL.cabal │ ├── setup.sql │ └── src │ │ ├── Example │ │ ├── DataSource.hs │ │ └── User.hs │ │ └── Main.hs │ ├── Oracle │ ├── GNUmakefile │ ├── LICENSE │ ├── README.md │ ├── Setup.hs │ ├── hrr-example-HDBC-Oracle.cabal │ └── src │ │ ├── DataSource.hs │ │ ├── HrrDatatypeTest.hs │ │ ├── create.sql │ │ ├── drop.sql │ │ └── main.hs │ └── PostgreSQL │ ├── GNUmakefile │ ├── LICENSE │ ├── Setup.hs │ ├── example │ ├── 1 │ │ ├── Group.hs │ │ ├── Membership.hs │ │ ├── QueryArrowExample.hs │ │ ├── QueryExample.hs │ │ ├── QueryExampleO.hs │ │ ├── User.hs │ │ ├── create.sql │ │ ├── drop.sql │ │ ├── run.hs │ │ ├── runArrow.hs │ │ └── runO.hs │ ├── 2 │ │ ├── KeyTest.hs │ │ ├── create.sql │ │ ├── drop.sql │ │ └── show.hs │ ├── 3 │ │ ├── History.hs │ │ ├── SetA.hs │ │ ├── SetB.hs │ │ ├── create.sql │ │ ├── drop.sql │ │ └── query.hs │ ├── 4 │ │ ├── One.hs │ │ ├── StockGoods.hs │ │ ├── create.sql │ │ ├── drop.sql │ │ └── modifyExample.hs │ ├── PgTestDataSource.hs │ └── README │ └── hrr-example-HDBC-postgresql.cabal ├── names-th ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── names-th.cabal └── src │ └── Language │ └── Haskell │ └── TH │ ├── Lib │ └── Extra.hs │ └── Name │ └── CamelCase.hs ├── old ├── kazu.ja.md └── memo.txt ├── persistable-record ├── ChangeLog.md ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── persistable-record.cabal ├── src │ └── Database │ │ ├── Record.hs │ │ └── Record │ │ ├── FromSql.hs │ │ ├── Instances.hs │ │ ├── InternalTH.hs │ │ ├── KeyConstraint.hs │ │ ├── Persistable.hs │ │ ├── TH.hs │ │ ├── ToSql.hs │ │ └── TupleInstances.hs └── test │ ├── Model.hs │ └── nestedEq.hs ├── persistable-types-HDBC-pg ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── example │ ├── DS.hs │ ├── InetExample.hs │ ├── README │ └── inet.sh ├── persistable-types-HDBC-pg.cabal ├── src │ └── Database │ │ ├── HDBC │ │ └── PostgreSQL │ │ │ ├── Instances.hs │ │ │ └── Persistable.hs │ │ └── Relational │ │ └── HDBC │ │ ├── PostgreSQL.hs │ │ └── PostgreSQL │ │ ├── Instances.hs │ │ └── Persistable.hs └── test │ └── runTest.hs ├── relational-query-HDBC ├── ChangeLog.md ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── relational-query-HDBC.cabal ├── src │ └── Database │ │ ├── HDBC │ │ ├── Query │ │ │ └── TH.hs │ │ ├── Record.hs │ │ ├── Record │ │ │ ├── Delete.hs │ │ │ ├── Insert.hs │ │ │ ├── InsertQuery.hs │ │ │ ├── KeyUpdate.hs │ │ │ ├── Persistable.hs │ │ │ ├── Query.hs │ │ │ ├── Sequence.hs │ │ │ ├── Statement.hs │ │ │ ├── TH.hs │ │ │ └── Update.hs │ │ ├── Schema │ │ │ ├── Driver.hs │ │ │ ├── IBMDB2.hs │ │ │ ├── MySQL.hs │ │ │ ├── Oracle.hs │ │ │ ├── PostgreSQL.hs │ │ │ ├── SQLServer.hs │ │ │ └── SQLite3.hs │ │ └── SqlValueExtra.hs │ │ ├── Relational │ │ ├── HDBC.hs │ │ └── HDBC │ │ │ ├── Delete.hs │ │ │ ├── Insert.hs │ │ │ ├── InsertQuery.hs │ │ │ ├── InternalTH.hs │ │ │ ├── KeyUpdate.hs │ │ │ ├── Persistable.hs │ │ │ ├── Query.hs │ │ │ ├── Sequence.hs │ │ │ ├── SqlValueExtra.hs │ │ │ ├── Statement.hs │ │ │ ├── TH.hs │ │ │ └── Update.hs │ │ └── Schema │ │ └── HDBC │ │ ├── Driver.hs │ │ ├── IBMDB2.hs │ │ ├── MySQL.hs │ │ ├── Oracle.hs │ │ ├── PostgreSQL.hs │ │ ├── SQLServer.hs │ │ └── SQLite3.hs └── test │ └── convertibleIso.hs ├── relational-query ├── ChangeLog.md ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── cabal-test.sh ├── relational-query.cabal ├── src │ └── Database │ │ ├── Relational.hs │ │ └── Relational │ │ ├── Arrow.hs │ │ ├── Config.hs │ │ ├── Constraint.hs │ │ ├── Context.hs │ │ ├── Derives.hs │ │ ├── Effect.hs │ │ ├── Export.hs │ │ ├── Internal │ │ ├── Config.hs │ │ ├── ContextType.hs │ │ ├── Literal.hs │ │ ├── String.hs │ │ └── UntypedTable.hs │ │ ├── InternalTH │ │ ├── Base.hs │ │ └── Overloaded.hs │ │ ├── Monad │ │ ├── Aggregate.hs │ │ ├── Assign.hs │ │ ├── BaseType.hs │ │ ├── Class.hs │ │ ├── Register.hs │ │ ├── Restrict.hs │ │ ├── Simple.hs │ │ ├── Trans │ │ │ ├── Aggregating.hs │ │ │ ├── Assigning.hs │ │ │ ├── Config.hs │ │ │ ├── Join.hs │ │ │ ├── JoinState.hs │ │ │ ├── Ordering.hs │ │ │ ├── Qualify.hs │ │ │ └── Restricting.hs │ │ ├── Type.hs │ │ └── Unique.hs │ │ ├── NonStandard │ │ └── PureTimestampTZ.hs │ │ ├── OverloadedInstances.hs │ │ ├── OverloadedProjection.hs │ │ ├── Pi.hs │ │ ├── Pi │ │ └── Unsafe.hs │ │ ├── Projectable.hs │ │ ├── Projectable │ │ ├── Instances.hs │ │ └── Unsafe.hs │ │ ├── ProjectableClass.hs │ │ ├── Pure.hs │ │ ├── PureUTF8.hs │ │ ├── Record.hs │ │ ├── Relation.hs │ │ ├── SQL.hs │ │ ├── Scalar.hs │ │ ├── Sequence.hs │ │ ├── Set.hs │ │ ├── SimpleSql.hs │ │ ├── SqlSyntax.hs │ │ ├── SqlSyntax │ │ ├── Aggregate.hs │ │ ├── Fold.hs │ │ ├── Join.hs │ │ ├── Query.hs │ │ ├── Types.hs │ │ └── Updates.hs │ │ ├── TH.hs │ │ ├── Table.hs │ │ ├── TupleInstances.hs │ │ ├── Type.hs │ │ └── Typed │ │ ├── Record.hs │ │ └── Table.hs └── test │ ├── Conflict.hs │ ├── Export.hs │ ├── Lex.hs │ ├── Model.hs │ ├── exportsEq.hs │ ├── sqlsEq.hs │ └── sqlsEqArrow.hs ├── relational-record-examples ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── entity │ ├── Account.hs │ ├── Branch.hs │ ├── Business.hs │ ├── Customer.hs │ ├── Department.hs │ ├── Employee.hs │ ├── Individual.hs │ ├── Officer.hs │ ├── Product.hs │ ├── ProductType.hs │ └── Transaction.hs ├── examples.db ├── lib │ └── Database │ │ ├── Record │ │ └── TH │ │ │ └── SQLite3.hs │ │ └── Relational │ │ └── CustomSQLite3.hs ├── mains │ ├── examples.hs │ └── specializedExamples.hs ├── orf │ ├── DataSource.hs │ ├── Mixed.hs │ ├── Person.hs │ ├── Product.hs │ └── create.sql ├── relational-record-examples.cabal └── sql │ ├── 3.7.1.sh │ ├── 3.7.3.sh │ ├── 3.7.sh │ ├── 4.1.2.sh │ ├── 4.3.2.sh │ ├── 4.3.3a.sh │ ├── 4.3.3b.sh │ ├── 4.3.3c.sh │ ├── 5.1.2a.sh │ ├── 5.1.3.sh │ ├── 5.3a.sh │ ├── 6.4.1a.sh │ ├── 8.1a.sh │ ├── add.sql │ └── sql-memo ├── relational-record ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── relational-record.cabal └── src │ └── Database │ └── Relational │ └── Documentation.hs ├── relational-schemas ├── ChangeLog.md ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── relational-schemas.cabal └── src │ └── Database │ ├── Custom │ ├── IBMDB2.hs │ ├── MySQL.hs │ ├── Oracle.hs │ ├── PostgreSQL.hs │ ├── SQLServer.hs │ └── SQLite3.hs │ └── Relational │ └── Schema │ ├── DB2Syscat │ ├── Columns.hs │ └── Config.hs │ ├── IBMDB2.hs │ ├── IBMDB2 │ ├── Columns.hs │ ├── Config.hs │ ├── Keycoluse.hs │ └── Tabconst.hs │ ├── MySQL.hs │ ├── MySQL │ ├── Columns.hs │ ├── Config.hs │ ├── KeyColumnUsage.hs │ └── TableConstraints.hs │ ├── MySQLInfo │ ├── Columns.hs │ └── Config.hs │ ├── Oracle.hs │ ├── Oracle │ ├── Config.hs │ ├── ConsColumns.hs │ ├── Constraints.hs │ └── TabColumns.hs │ ├── OracleDataDictionary │ ├── Config.hs │ └── TabColumns.hs │ ├── PgCatalog │ ├── Config.hs │ ├── PgAttribute.hs │ └── PgType.hs │ ├── PostgreSQL.hs │ ├── PostgreSQL │ ├── Config.hs │ ├── PgAttribute.hs │ ├── PgClass.hs │ ├── PgConstraint.hs │ ├── PgNamespace.hs │ └── PgType.hs │ ├── SQLServer.hs │ ├── SQLServer │ ├── Columns.hs │ ├── Config.hs │ ├── IndexColumns.hs │ ├── Indexes.hs │ └── Types.hs │ ├── SQLServerSyscat │ ├── Columns.hs │ ├── Config.hs │ └── Types.hs │ ├── SQLite3.hs │ ├── SQLite3 │ ├── Config.hs │ ├── IndexInfo.hs │ ├── IndexList.hs │ └── TableInfo.hs │ └── SQLite3Syscat │ ├── Config.hs │ ├── IndexInfo.hs │ ├── IndexList.hs │ └── TableInfo.hs ├── rr-quickcheck ├── GNUmakefile ├── LICENSE ├── RDBMs │ ├── MySQL │ │ ├── main.hs │ │ ├── schema-drop.sql │ │ └── schema.sql │ └── PostgreSQL │ │ ├── main.hs │ │ └── schema.sql ├── Setup.hs ├── rr-quickcheck.cabal ├── sql │ └── tables.sql └── src │ └── Test │ └── Relational │ └── QuickCheck │ ├── Arbitrary.hs │ ├── Model.hs │ └── Tests.hs ├── sql-words ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── sql-words.cabal ├── src │ └── Language │ │ └── SQL │ │ ├── Keyword.hs │ │ └── Keyword │ │ ├── Concat.hs │ │ ├── Internal │ │ └── Type.hs │ │ └── Type.hs └── test │ └── monoidLaw.hs ├── stack └── stack.yaml.example ├── test └── HDBC │ ├── MySQL │ ├── DB │ │ └── Source.hs │ ├── Spec.hs │ └── setup.sql │ ├── SQLServer │ ├── SQLServerTest.hs │ ├── SQLServerTestDataSource.hs │ ├── TypeCheck.hs │ ├── runCreate.sh │ ├── runCreateDB.sh │ ├── runDrop.sh │ └── runDropDB.sh │ └── SQLite3 │ ├── SQLite3Test.hs │ ├── SQLite3TestDataSource.hs │ ├── runCreate.sh │ └── runDrop.sh ├── text-postgresql ├── GNUmakefile ├── LICENSE ├── Setup.hs ├── src │ ├── Data │ │ └── PostgreSQL │ │ │ └── NetworkAddress.hs │ ├── Database │ │ └── PostgreSQL │ │ │ ├── Parser.hs │ │ │ └── Printer.hs │ └── Text │ │ ├── Parser │ │ └── List.hs │ │ └── Printer │ │ └── List.hs ├── test │ └── prop.hs └── text-postgresql.cabal └── travis-CI ├── cabal-hvr-ghc-2 ├── install.sh └── script.sh ├── cabal-hvr-ghc ├── install.sh └── script.sh ├── custom-cabal ├── dirs.list ├── sh-lib └── stack ├── before-install.sh ├── install.sh ├── script.sh └── template.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | *.dyn_o 8 | *.dyn_hi 9 | .virtualenv 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | .stack-work/ 18 | .idea/ 19 | *.iml 20 | stack.yaml 21 | -------------------------------------------------------------------------------- /HDBC-session/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /HDBC-session/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /HDBC-session/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Please visit HRR project page for more information: http://khibino.github.io/haskell-relational-record/ 2 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | -- Cabal project configuration 2 | -- 3 | -- See http://cabal.readthedocs.io/en/latest/nix-local-build.html for more 4 | -- information 5 | 6 | packages: ./HDBC-session 7 | ./names-th 8 | ./persistable-record 9 | ./persistable-types-HDBC-pg 10 | ./relational-query 11 | ./relational-query-HDBC 12 | ./relational-record 13 | ./relational-record-examples 14 | ./relational-schemas 15 | ./sql-words 16 | ./text-postgresql 17 | -------------------------------------------------------------------------------- /debian-backup/HDBC-session/debian/changelog: -------------------------------------------------------------------------------- 1 | haskell-hdbc-session (0.1.0.0-1~autogen1) unstable; urgency=low 2 | 3 | * Debianization generated by cabal-debian 4 | 5 | -- Kei Hibino Thu, 17 Dec 2015 13:00:33 +0900 6 | -------------------------------------------------------------------------------- /debian-backup/HDBC-session/debian/compat: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /debian-backup/HDBC-session/debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | DEB_CABAL_PACKAGE = hdbc-session 4 | DEB_DEFAULT_COMPILER = ghc 5 | 6 | include /usr/share/cdbs/1/rules/debhelper.mk 7 | include /usr/share/cdbs/1/class/hlibrary.mk 8 | 9 | -------------------------------------------------------------------------------- /debian-backup/HDBC-session/debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (quilt) 2 | -------------------------------------------------------------------------------- /debian-backup/HDBC-session/debian/watch: -------------------------------------------------------------------------------- 1 | version=3 2 | opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ 3 | filenamemangle=s|(.*)/$|HDBC-session-$1.tar.gz|" \ 4 | http://hackage.haskell.org/package/HDBC-session \ 5 | ([\d\.]*\d)/ 6 | -------------------------------------------------------------------------------- /debian-backup/names-th/debian/changelog: -------------------------------------------------------------------------------- 1 | haskell-names-th (0.2.0.1-1~autogen1) unstable; urgency=low 2 | 3 | * Debianization generated by cabal-debian 4 | 5 | -- Kei Hibino Thu, 17 Dec 2015 13:00:22 +0900 6 | -------------------------------------------------------------------------------- /debian-backup/names-th/debian/compat: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /debian-backup/names-th/debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | DEB_CABAL_PACKAGE = names-th 4 | DEB_DEFAULT_COMPILER = ghc 5 | 6 | include /usr/share/cdbs/1/rules/debhelper.mk 7 | include /usr/share/cdbs/1/class/hlibrary.mk 8 | 9 | -------------------------------------------------------------------------------- /debian-backup/names-th/debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (quilt) 2 | -------------------------------------------------------------------------------- /debian-backup/names-th/debian/watch: -------------------------------------------------------------------------------- 1 | version=3 2 | opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ 3 | filenamemangle=s|(.*)/$|names-th-$1.tar.gz|" \ 4 | http://hackage.haskell.org/package/names-th \ 5 | ([\d\.]*\d)/ 6 | -------------------------------------------------------------------------------- /debian-backup/persistable-record/debian/changelog: -------------------------------------------------------------------------------- 1 | haskell-persistable-record (0.3.0.0-1~autogen1) unstable; urgency=low 2 | 3 | * Debianization generated by cabal-debian 4 | 5 | -- Kei Hibino Mon, 25 Jan 2016 09:36:28 +0900 6 | -------------------------------------------------------------------------------- /debian-backup/persistable-record/debian/compat: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /debian-backup/persistable-record/debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | DEB_CABAL_PACKAGE = persistable-record 4 | DEB_DEFAULT_COMPILER = ghc 5 | 6 | include /usr/share/cdbs/1/rules/debhelper.mk 7 | include /usr/share/cdbs/1/class/hlibrary.mk 8 | 9 | -------------------------------------------------------------------------------- /debian-backup/persistable-record/debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (quilt) 2 | -------------------------------------------------------------------------------- /debian-backup/persistable-record/debian/watch: -------------------------------------------------------------------------------- 1 | version=3 2 | opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ 3 | filenamemangle=s|(.*)/$|persistable-record-$1.tar.gz|" \ 4 | http://hackage.haskell.org/package/persistable-record \ 5 | ([\d\.]*\d)/ 6 | -------------------------------------------------------------------------------- /debian-backup/persistable-types-HDBC-pg/debian/changelog: -------------------------------------------------------------------------------- 1 | haskell-persistable-types-hdbc-pg (0.0.1.1-1~autogen1) unstable; urgency=low 2 | 3 | * Debianization generated by cabal-debian 4 | 5 | -- Kei Hibino Sat, 26 Dec 2015 13:34:18 +0900 6 | -------------------------------------------------------------------------------- /debian-backup/persistable-types-HDBC-pg/debian/compat: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /debian-backup/persistable-types-HDBC-pg/debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | DEB_CABAL_PACKAGE = persistable-types-hdbc-pg 4 | DEB_DEFAULT_COMPILER = ghc 5 | 6 | include /usr/share/cdbs/1/rules/debhelper.mk 7 | include /usr/share/cdbs/1/class/hlibrary.mk 8 | 9 | -------------------------------------------------------------------------------- /debian-backup/persistable-types-HDBC-pg/debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (quilt) 2 | -------------------------------------------------------------------------------- /debian-backup/persistable-types-HDBC-pg/debian/watch: -------------------------------------------------------------------------------- 1 | version=3 2 | opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ 3 | filenamemangle=s|(.*)/$|persistable-types-HDBC-pg-$1.tar.gz|" \ 4 | http://hackage.haskell.org/package/persistable-types-HDBC-pg \ 5 | ([\d\.]*\d)/ 6 | -------------------------------------------------------------------------------- /debian-backup/relational-query-HDBC/debian/changelog: -------------------------------------------------------------------------------- 1 | haskell-relational-query-hdbc (0.5.0.0-1~autogen1) unstable; urgency=low 2 | 3 | * Debianization generated by cabal-debian 4 | 5 | -- Kei Hibino Mon, 25 Jan 2016 09:36:38 +0900 6 | -------------------------------------------------------------------------------- /debian-backup/relational-query-HDBC/debian/compat: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /debian-backup/relational-query-HDBC/debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | DEB_CABAL_PACKAGE = relational-query-hdbc 4 | DEB_DEFAULT_COMPILER = ghc 5 | 6 | include /usr/share/cdbs/1/rules/debhelper.mk 7 | include /usr/share/cdbs/1/class/hlibrary.mk 8 | 9 | -------------------------------------------------------------------------------- /debian-backup/relational-query-HDBC/debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (quilt) 2 | -------------------------------------------------------------------------------- /debian-backup/relational-query-HDBC/debian/watch: -------------------------------------------------------------------------------- 1 | version=3 2 | opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ 3 | filenamemangle=s|(.*)/$|relational-query-HDBC-$1.tar.gz|" \ 4 | http://hackage.haskell.org/package/relational-query-HDBC \ 5 | ([\d\.]*\d)/ 6 | -------------------------------------------------------------------------------- /debian-backup/relational-query/debian/changelog: -------------------------------------------------------------------------------- 1 | haskell-relational-query (0.8.0.3-1~autogen1) unstable; urgency=low 2 | 3 | * Debianization generated by cabal-debian 4 | 5 | -- Kei Hibino Thu, 04 Feb 2016 00:51:57 +0900 6 | -------------------------------------------------------------------------------- /debian-backup/relational-query/debian/compat: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /debian-backup/relational-query/debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | DEB_CABAL_PACKAGE = relational-query 4 | DEB_DEFAULT_COMPILER = ghc 5 | 6 | include /usr/share/cdbs/1/rules/debhelper.mk 7 | include /usr/share/cdbs/1/class/hlibrary.mk 8 | 9 | -------------------------------------------------------------------------------- /debian-backup/relational-query/debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (quilt) 2 | -------------------------------------------------------------------------------- /debian-backup/relational-query/debian/watch: -------------------------------------------------------------------------------- 1 | version=3 2 | opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ 3 | filenamemangle=s|(.*)/$|relational-query-$1.tar.gz|" \ 4 | http://hackage.haskell.org/package/relational-query \ 5 | ([\d\.]*\d)/ 6 | -------------------------------------------------------------------------------- /debian-backup/relational-schemas/debian/changelog: -------------------------------------------------------------------------------- 1 | haskell-relational-schemas (0.1.2.2-1~autogen1) unstable; urgency=low 2 | 3 | * Debianization generated by cabal-debian 4 | 5 | -- Kei Hibino Mon, 25 Jan 2016 09:36:33 +0900 6 | -------------------------------------------------------------------------------- /debian-backup/relational-schemas/debian/compat: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /debian-backup/relational-schemas/debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | DEB_CABAL_PACKAGE = relational-schemas 4 | DEB_DEFAULT_COMPILER = ghc 5 | 6 | include /usr/share/cdbs/1/rules/debhelper.mk 7 | include /usr/share/cdbs/1/class/hlibrary.mk 8 | 9 | -------------------------------------------------------------------------------- /debian-backup/relational-schemas/debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (quilt) 2 | -------------------------------------------------------------------------------- /debian-backup/relational-schemas/debian/watch: -------------------------------------------------------------------------------- 1 | version=3 2 | opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ 3 | filenamemangle=s|(.*)/$|relational-schemas-$1.tar.gz|" \ 4 | http://hackage.haskell.org/package/relational-schemas \ 5 | ([\d\.]*\d)/ 6 | -------------------------------------------------------------------------------- /debian-backup/sql-words/debian/changelog: -------------------------------------------------------------------------------- 1 | haskell-sql-words (0.1.3.1-1~autogen1) unstable; urgency=low 2 | 3 | * Debianization generated by cabal-debian 4 | 5 | -- Kei Hibino Thu, 17 Dec 2015 13:00:24 +0900 6 | -------------------------------------------------------------------------------- /debian-backup/sql-words/debian/compat: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /debian-backup/sql-words/debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | DEB_CABAL_PACKAGE = sql-words 4 | DEB_DEFAULT_COMPILER = ghc 5 | 6 | include /usr/share/cdbs/1/rules/debhelper.mk 7 | include /usr/share/cdbs/1/class/hlibrary.mk 8 | 9 | -------------------------------------------------------------------------------- /debian-backup/sql-words/debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (quilt) 2 | -------------------------------------------------------------------------------- /debian-backup/sql-words/debian/watch: -------------------------------------------------------------------------------- 1 | version=3 2 | opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ 3 | filenamemangle=s|(.*)/$|sql-words-$1.tar.gz|" \ 4 | http://hackage.haskell.org/package/sql-words \ 5 | ([\d\.]*\d)/ 6 | -------------------------------------------------------------------------------- /debian-backup/text-postgresql/debian/changelog: -------------------------------------------------------------------------------- 1 | haskell-text-postgresql (0.0.1.0-1~autogen1) unstable; urgency=low 2 | 3 | * Debianization generated by cabal-debian 4 | 5 | -- Kei Hibino Sat, 26 Dec 2015 13:34:16 +0900 6 | -------------------------------------------------------------------------------- /debian-backup/text-postgresql/debian/compat: -------------------------------------------------------------------------------- 1 | 9 2 | -------------------------------------------------------------------------------- /debian-backup/text-postgresql/debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | 3 | DEB_CABAL_PACKAGE = text-postgresql 4 | DEB_DEFAULT_COMPILER = ghc 5 | 6 | include /usr/share/cdbs/1/rules/debhelper.mk 7 | include /usr/share/cdbs/1/class/hlibrary.mk 8 | 9 | -------------------------------------------------------------------------------- /debian-backup/text-postgresql/debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (quilt) 2 | -------------------------------------------------------------------------------- /debian-backup/text-postgresql/debian/watch: -------------------------------------------------------------------------------- 1 | version=3 2 | opts="downloadurlmangle=s|archive/([\w\d_-]+)/([\d\.]+)/|archive/$1/$2/$1-$2.tar.gz|,\ 3 | filenamemangle=s|(.*)/$|text-postgresql-$1.tar.gz|" \ 4 | http://hackage.haskell.org/package/text-postgresql \ 5 | ([\d\.]*\d)/ 6 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/Birthday.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Birthday where 4 | 5 | import DataSource (definePgConTable) 6 | 7 | $(definePgConTable "EXAMPLE" "birthday" 8 | [''Eq, ''Show]) 9 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/DataSource.hs: -------------------------------------------------------------------------------- 1 | module DataSource (definePgConTable) where 2 | 3 | import Language.Haskell.TH 4 | -- import Language.Haskell.TH.Name.CamelCase (ConName) 5 | import Database.HDBC.PostgreSQL (connectPostgreSQL) 6 | import Database.HDBC.Query.TH 7 | import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL) 8 | 9 | definePgConTable :: String -> String -> [Name] -> Q [Dec] 10 | definePgConTable = 11 | defineTableFromDB (connectPostgreSQL "dbname=haskell-day") driverPostgreSQL 12 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/GNUmakefile: -------------------------------------------------------------------------------- 1 | 2 | 3 | targets = \ 4 | HRR.html 5 | 6 | 7 | md_format = \ 8 | markdown+pandoc_title_block+pipe_tables+table_captions+escaped_line_breaks+implicit_figures+strikeout+tex_math_dollars+latex_macros+fenced_code_blocks 9 | 10 | math_opt = --latexmathml 11 | #math_opt = --jsmath 12 | #math_opt = --mathjax 13 | 14 | slide_opts = \ 15 | --self-contained --standalone --slide-level=2 \ 16 | $(math_opt) 17 | ## --incremental 18 | 19 | %.html: %.md 20 | pandoc -f $(md_format) -t s5 $(slide_opts) -o $@ $< 21 | 22 | %.tex: %.md 23 | pandoc -f $(md_format) -t beamer -s --slide-level=2 -o $@ $< 24 | 25 | 26 | %.dvi %.log %.aux: %.tex 27 | platex $< 28 | 29 | 30 | %.pdf: %.dvi 31 | dvipdfmx $(@:.pdf=.dvi) 32 | 33 | 34 | all: $(targets) 35 | 36 | clean: 37 | $(RM) $(targets) 38 | ## $(RM) *.dvi *.pdf 39 | ## $(RM) *.aux *.log *.nav *.out *.snm *.toc *.vrb 40 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/Person.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Person where 4 | 5 | import DataSource (definePgConTable) 6 | 7 | $(definePgConTable "EXAMPLE" "person" 8 | [''Eq, ''Show]) 9 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/haskell-day.drop.sql: -------------------------------------------------------------------------------- 1 | 2 | DROP TABLE EXAMPLE.person; 3 | DROP TABLE EXAMPLE.birthday; 4 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/haskell-day.sql: -------------------------------------------------------------------------------- 1 | 2 | CREATE SCHEMA IF NOT EXISTS EXAMPLE; 3 | 4 | CREATE TABLE EXAMPLE.person 5 | ( name VARCHAR(64) NOT NULL 6 | , age INTEGER NOT NULL 7 | , family VARCHAR(64) NOT NULL 8 | 9 | , PRIMARY KEY(name) 10 | ); 11 | 12 | CREATE TABLE EXAMPLE.birthday 13 | ( name VARCHAR(64) NOT NULL 14 | , day DATE NOT NULL 15 | 16 | , PRIMARY KEY(name) 17 | ); 18 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/s5/default/blank.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/Haskell-Day-201609/s5/default/blank.gif -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/s5/default/bodybg.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/Haskell-Day-201609/s5/default/bodybg.gif -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/s5/default/framing.css: -------------------------------------------------------------------------------- 1 | /* The following styles size, place, and layer the slide components. 2 | Edit these if you want to change the overall slide layout. 3 | The commented lines can be uncommented (and modified, if necessary) 4 | to help you with the rearrangement process. */ 5 | 6 | /* target = 1024x768 */ 7 | 8 | div#header, div#footer, .slide {width: 100%; top: 0; left: 0;} 9 | div#header {top: 0; height: 3em; z-index: 1;} 10 | div#footer {top: auto; bottom: 0; height: 2.5em; z-index: 5;} 11 | .slide {top: 0; width: 92%; padding: 3.5em 4% 4%; z-index: 2; list-style: none;} 12 | div#controls {left: 50%; bottom: 0; width: 50%; z-index: 100;} 13 | div#controls form {position: absolute; bottom: 0; right: 0; width: 100%; 14 | margin: 0;} 15 | #currentSlide {position: absolute; width: 10%; left: 45%; bottom: 1em; z-index: 10;} 16 | html>body #currentSlide {position: fixed;} 17 | 18 | /* 19 | div#header {background: #FCC;} 20 | div#footer {background: #CCF;} 21 | div#controls {background: #BBD;} 22 | div#currentSlide {background: #FFC;} 23 | */ 24 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/s5/default/opera.css: -------------------------------------------------------------------------------- 1 | /* DO NOT CHANGE THESE unless you really want to break Opera Show */ 2 | .slide { 3 | visibility: visible !important; 4 | position: static !important; 5 | page-break-before: always; 6 | } 7 | #slide0 {page-break-before: avoid;} 8 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/s5/default/outline.css: -------------------------------------------------------------------------------- 1 | /* don't change this unless you want the layout stuff to show up in the outline view! */ 2 | 3 | .layout div, #footer *, #controlForm * {display: none;} 4 | #footer, #controls, #controlForm, #navLinks, #toggle { 5 | display: block; visibility: visible; margin: 0; padding: 0;} 6 | #toggle {float: right; padding: 0.5em;} 7 | html>body #toggle {position: fixed; top: 0; right: 0;} 8 | 9 | /* making the outline look pretty-ish */ 10 | 11 | #slide0 h1, #slide0 h2, #slide0 h3, #slide0 h4 {border: none; margin: 0;} 12 | #slide0 h1 {padding-top: 1.5em;} 13 | .slide h1 {margin: 1.5em 0 0; padding-top: 0.25em; 14 | border-top: 1px solid #888; border-bottom: 1px solid #AAA;} 15 | #toggle {border: 1px solid; border-width: 0 0 1px 1px; background: #FFF;} 16 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/s5/default/print.css: -------------------------------------------------------------------------------- 1 | /* The following rule is necessary to have all slides appear in print! DO NOT REMOVE IT! */ .slide, ul {page-break-inside: avoid; visibility: visible !important;} h1 {page-break-after: avoid;} body {font-size: 12pt; background: white;} * {color: black;} #slide0 h1 {font-size: 200%; border: none; margin: 0.5em 0 0.25em;} #slide0 h3 {margin: 0; padding: 0;} #slide0 h4 {margin: 0 0 0.5em; padding: 0;} #slide0 {margin-bottom: 3em;} h1 {border-top: 2pt solid gray; border-bottom: 1px dotted silver;} .extra {background: transparent !important;} div.extra, pre.extra, .example {font-size: 10pt; color: #333;} ul.extra a {font-weight: bold;} p.example {display: none;} #header {display: none;} #footer h1 {margin: 0; border-bottom: 1px solid; color: gray; font-style: italic;} #footer h2, #controls {display: none;} /* The following rule keeps the layout stuff out of print. Remove at your own risk! */ .layout, .layout * {display: none !important;} -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/s5/default/s5-core.css: -------------------------------------------------------------------------------- 1 | /* Do not edit or override these styles! The system will likely break if you do. */ 2 | 3 | div#header, div#footer, div#controls, .slide {position: absolute;} 4 | html>body div#header, html>body div#footer, 5 | html>body div#controls, html>body .slide {position: fixed;} 6 | .handout {display: none;} 7 | .layout {display: block;} 8 | .slide, .hideme, .incremental {visibility: hidden;} 9 | #slide0 {visibility: visible;} 10 | -------------------------------------------------------------------------------- /doc/slide/Haskell-Day-201609/s5/default/slides.css: -------------------------------------------------------------------------------- 1 | @import url(s5-core.css); /* required to make the slide show run at all */ 2 | @import url(framing.css); /* sets basic placement and size of slide components */ 3 | @import url(pretty.css); /* stuff that makes the slides look better than blah */ -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/Birthday.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Birthday where 4 | 5 | import DS (definePgConTable) 6 | 7 | $(definePgConTable "EXAMPLE" "birthday" 8 | [''Eq, ''Show]) 9 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/DS.hs: -------------------------------------------------------------------------------- 1 | module DS (definePgConTable) where 2 | 3 | import Language.Haskell.TH 4 | -- import Language.Haskell.TH.Name.CamelCase (ConName) 5 | import Database.HDBC.PostgreSQL (connectPostgreSQL) 6 | import Database.HDBC.Query.TH 7 | import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL) 8 | 9 | definePgConTable :: String -> String -> [Name] -> Q [Dec] 10 | definePgConTable = 11 | defineTableFromDB (connectPostgreSQL "dbname=pgcon") driverPostgreSQL 12 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/GNUmakefile: -------------------------------------------------------------------------------- 1 | 2 | 3 | targets = \ 4 | Query.html 5 | 6 | 7 | md_format = \ 8 | markdown+pandoc_title_block+pipe_tables+table_captions+escaped_line_breaks+implicit_figures+strikeout+tex_math_dollars+latex_macros+fenced_code_blocks 9 | 10 | math_opt = --latexmathml 11 | #math_opt = --jsmath 12 | #math_opt = --mathjax 13 | 14 | slide_opts = \ 15 | --self-contained --standalone --slide-level=2 \ 16 | $(math_opt) 17 | ## --incremental 18 | 19 | %.html: %.md 20 | pandoc -f $(md_format) -t s5 $(slide_opts) -o $@ $< 21 | 22 | %.tex: %.md 23 | pandoc -f $(md_format) -t beamer -s --slide-level=2 -o $@ $< 24 | 25 | 26 | %.dvi %.log %.aux: %.tex 27 | platex $< 28 | 29 | 30 | %.pdf: %.dvi 31 | dvipdfmx $(@:.pdf=.dvi) 32 | 33 | 34 | all: $(targets) 35 | 36 | clean: 37 | $(RM) $(targets) 38 | ## $(RM) *.dvi *.pdf 39 | ## $(RM) *.aux *.log *.nav *.out *.snm *.toc *.vrb 40 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/Person.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Person where 4 | 5 | import DS (definePgConTable) 6 | 7 | $(definePgConTable "EXAMPLE" "person" 8 | [''Eq, ''Show]) 9 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/pgcon.drop.sql: -------------------------------------------------------------------------------- 1 | 2 | DROP TABLE EXAMPLE.person; 3 | DROP TABLE EXAMPLE.birthday; 4 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/pgcon.sql: -------------------------------------------------------------------------------- 1 | 2 | CREATE SCHEMA IF NOT EXISTS EXAMPLE; 3 | 4 | CREATE TABLE EXAMPLE.person 5 | ( name VARCHAR(64) NOT NULL 6 | , age INTEGER NOT NULL 7 | , family VARCHAR(64) NOT NULL 8 | 9 | , PRIMARY KEY(name) 10 | ); 11 | 12 | CREATE TABLE EXAMPLE.birthday 13 | ( name VARCHAR(64) NOT NULL 14 | , day DATE NOT NULL 15 | 16 | , PRIMARY KEY(name) 17 | ); 18 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/s5/default/blank.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/PostgreSQL-Unconference-201512/s5/default/blank.gif -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/s5/default/bodybg.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/PostgreSQL-Unconference-201512/s5/default/bodybg.gif -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/s5/default/framing.css: -------------------------------------------------------------------------------- 1 | /* The following styles size, place, and layer the slide components. 2 | Edit these if you want to change the overall slide layout. 3 | The commented lines can be uncommented (and modified, if necessary) 4 | to help you with the rearrangement process. */ 5 | 6 | /* target = 1024x768 */ 7 | 8 | div#header, div#footer, .slide {width: 100%; top: 0; left: 0;} 9 | div#header {top: 0; height: 3em; z-index: 1;} 10 | div#footer {top: auto; bottom: 0; height: 2.5em; z-index: 5;} 11 | .slide {top: 0; width: 92%; padding: 3.5em 4% 4%; z-index: 2; list-style: none;} 12 | div#controls {left: 50%; bottom: 0; width: 50%; z-index: 100;} 13 | div#controls form {position: absolute; bottom: 0; right: 0; width: 100%; 14 | margin: 0;} 15 | #currentSlide {position: absolute; width: 10%; left: 45%; bottom: 1em; z-index: 10;} 16 | html>body #currentSlide {position: fixed;} 17 | 18 | /* 19 | div#header {background: #FCC;} 20 | div#footer {background: #CCF;} 21 | div#controls {background: #BBD;} 22 | div#currentSlide {background: #FFC;} 23 | */ 24 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/s5/default/opera.css: -------------------------------------------------------------------------------- 1 | /* DO NOT CHANGE THESE unless you really want to break Opera Show */ 2 | .slide { 3 | visibility: visible !important; 4 | position: static !important; 5 | page-break-before: always; 6 | } 7 | #slide0 {page-break-before: avoid;} 8 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/s5/default/outline.css: -------------------------------------------------------------------------------- 1 | /* don't change this unless you want the layout stuff to show up in the outline view! */ 2 | 3 | .layout div, #footer *, #controlForm * {display: none;} 4 | #footer, #controls, #controlForm, #navLinks, #toggle { 5 | display: block; visibility: visible; margin: 0; padding: 0;} 6 | #toggle {float: right; padding: 0.5em;} 7 | html>body #toggle {position: fixed; top: 0; right: 0;} 8 | 9 | /* making the outline look pretty-ish */ 10 | 11 | #slide0 h1, #slide0 h2, #slide0 h3, #slide0 h4 {border: none; margin: 0;} 12 | #slide0 h1 {padding-top: 1.5em;} 13 | .slide h1 {margin: 1.5em 0 0; padding-top: 0.25em; 14 | border-top: 1px solid #888; border-bottom: 1px solid #AAA;} 15 | #toggle {border: 1px solid; border-width: 0 0 1px 1px; background: #FFF;} 16 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/s5/default/print.css: -------------------------------------------------------------------------------- 1 | /* The following rule is necessary to have all slides appear in print! DO NOT REMOVE IT! */ .slide, ul {page-break-inside: avoid; visibility: visible !important;} h1 {page-break-after: avoid;} body {font-size: 12pt; background: white;} * {color: black;} #slide0 h1 {font-size: 200%; border: none; margin: 0.5em 0 0.25em;} #slide0 h3 {margin: 0; padding: 0;} #slide0 h4 {margin: 0 0 0.5em; padding: 0;} #slide0 {margin-bottom: 3em;} h1 {border-top: 2pt solid gray; border-bottom: 1px dotted silver;} .extra {background: transparent !important;} div.extra, pre.extra, .example {font-size: 10pt; color: #333;} ul.extra a {font-weight: bold;} p.example {display: none;} #header {display: none;} #footer h1 {margin: 0; border-bottom: 1px solid; color: gray; font-style: italic;} #footer h2, #controls {display: none;} /* The following rule keeps the layout stuff out of print. Remove at your own risk! */ .layout, .layout * {display: none !important;} -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/s5/default/s5-core.css: -------------------------------------------------------------------------------- 1 | /* Do not edit or override these styles! The system will likely break if you do. */ 2 | 3 | div#header, div#footer, div#controls, .slide {position: absolute;} 4 | html>body div#header, html>body div#footer, 5 | html>body div#controls, html>body .slide {position: fixed;} 6 | .handout {display: none;} 7 | .layout {display: block;} 8 | .slide, .hideme, .incremental {visibility: hidden;} 9 | #slide0 {visibility: visible;} 10 | -------------------------------------------------------------------------------- /doc/slide/PostgreSQL-Unconference-201512/s5/default/slides.css: -------------------------------------------------------------------------------- 1 | @import url(s5-core.css); /* required to make the slide show run at all */ 2 | @import url(framing.css); /* sets basic placement and size of slide components */ 3 | @import url(pretty.css); /* stuff that makes the slides look better than blah */ -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/Birthday.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Birthday where 4 | 5 | import DS (definePgConTable) 6 | 7 | $(definePgConTable "EXAMPLE" "birthday" 8 | [''Eq, ''Show]) 9 | -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/DS.hs: -------------------------------------------------------------------------------- 1 | module DS (definePgConTable) where 2 | 3 | import Language.Haskell.TH 4 | -- import Language.Haskell.TH.Name.CamelCase (ConName) 5 | import Database.HDBC.PostgreSQL (connectPostgreSQL) 6 | import Database.HDBC.Query.TH 7 | import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL) 8 | 9 | definePgConTable :: String -> String -> [Name] -> Q [Dec] 10 | definePgConTable = 11 | defineTableFromDB (connectPostgreSQL "dbname=pgcon") driverPostgreSQL 12 | -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/GNUmakefile: -------------------------------------------------------------------------------- 1 | 2 | 3 | targets = \ 4 | SourceTreeJ.html \ 5 | 6 | 7 | md_format = \ 8 | markdown+pandoc_title_block+pipe_tables+table_captions+escaped_line_breaks+implicit_figures+strikeout+tex_math_dollars+latex_macros+fenced_code_blocks 9 | 10 | math_opt = --latexmathml 11 | #math_opt = --jsmath 12 | #math_opt = --mathjax 13 | 14 | slide_opts = \ 15 | $(math_opt) \ 16 | --self-contained --standalone --slide-level=2 17 | ## --standalone --slide-level=2 18 | ## --incremental 19 | 20 | %.html: %.md 21 | pandoc -f $(md_format) -t s5 $(slide_opts) -o $@ $< 22 | 23 | %.tex: %.md 24 | pandoc -f $(md_format) -t beamer -s --slide-level=2 -o $@ $< 25 | 26 | 27 | %.dvi %.log %.aux: %.tex 28 | platex $< 29 | 30 | 31 | %.pdf: %.dvi 32 | dvipdfmx $(@:.pdf=.dvi) 33 | 34 | 35 | all: $(targets) 36 | 37 | clean: 38 | $(RM) $(targets) 39 | ## $(RM) *.dvi *.pdf 40 | ## $(RM) *.aux *.log *.nav *.out *.snm *.toc *.vrb 41 | -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/Person.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Person where 4 | 5 | import DS (definePgConTable) 6 | 7 | $(definePgConTable "EXAMPLE" "person" 8 | [''Eq, ''Show]) 9 | -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/s5/default/blank.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/code-reading-201601/s5/default/blank.gif -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/s5/default/bodybg.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/code-reading-201601/s5/default/bodybg.gif -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/s5/default/framing.css: -------------------------------------------------------------------------------- 1 | /* The following styles size, place, and layer the slide components. 2 | Edit these if you want to change the overall slide layout. 3 | The commented lines can be uncommented (and modified, if necessary) 4 | to help you with the rearrangement process. */ 5 | 6 | /* target = 1024x768 */ 7 | 8 | div#header, div#footer, .slide {width: 100%; top: 0; left: 0;} 9 | div#header {top: 0; height: 3em; z-index: 1;} 10 | div#footer {top: auto; bottom: 0; height: 2.5em; z-index: 5;} 11 | .slide {top: 0; width: 92%; padding: 3.5em 4% 4%; z-index: 2; list-style: none;} 12 | div#controls {left: 50%; bottom: 0; width: 50%; z-index: 100;} 13 | div#controls form {position: absolute; bottom: 0; right: 0; width: 100%; 14 | margin: 0;} 15 | #currentSlide {position: absolute; width: 10%; left: 45%; bottom: 1em; z-index: 10;} 16 | html>body #currentSlide {position: fixed;} 17 | 18 | /* 19 | div#header {background: #FCC;} 20 | div#footer {background: #CCF;} 21 | div#controls {background: #BBD;} 22 | div#currentSlide {background: #FFC;} 23 | */ 24 | -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/s5/default/opera.css: -------------------------------------------------------------------------------- 1 | /* DO NOT CHANGE THESE unless you really want to break Opera Show */ 2 | .slide { 3 | visibility: visible !important; 4 | position: static !important; 5 | page-break-before: always; 6 | } 7 | #slide0 {page-break-before: avoid;} 8 | -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/s5/default/outline.css: -------------------------------------------------------------------------------- 1 | /* don't change this unless you want the layout stuff to show up in the outline view! */ 2 | 3 | .layout div, #footer *, #controlForm * {display: none;} 4 | #footer, #controls, #controlForm, #navLinks, #toggle { 5 | display: block; visibility: visible; margin: 0; padding: 0;} 6 | #toggle {float: right; padding: 0.5em;} 7 | html>body #toggle {position: fixed; top: 0; right: 0;} 8 | 9 | /* making the outline look pretty-ish */ 10 | 11 | #slide0 h1, #slide0 h2, #slide0 h3, #slide0 h4 {border: none; margin: 0;} 12 | #slide0 h1 {padding-top: 1.5em;} 13 | .slide h1 {margin: 1.5em 0 0; padding-top: 0.25em; 14 | border-top: 1px solid #888; border-bottom: 1px solid #AAA;} 15 | #toggle {border: 1px solid; border-width: 0 0 1px 1px; background: #FFF;} 16 | -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/s5/default/print.css: -------------------------------------------------------------------------------- 1 | /* The following rule is necessary to have all slides appear in print! DO NOT REMOVE IT! */ .slide, ul {page-break-inside: avoid; visibility: visible !important;} h1 {page-break-after: avoid;} body {font-size: 12pt; background: white;} * {color: black;} #slide0 h1 {font-size: 200%; border: none; margin: 0.5em 0 0.25em;} #slide0 h3 {margin: 0; padding: 0;} #slide0 h4 {margin: 0 0 0.5em; padding: 0;} #slide0 {margin-bottom: 3em;} h1 {border-top: 2pt solid gray; border-bottom: 1px dotted silver;} .extra {background: transparent !important;} div.extra, pre.extra, .example {font-size: 10pt; color: #333;} ul.extra a {font-weight: bold;} p.example {display: none;} #header {display: none;} #footer h1 {margin: 0; border-bottom: 1px solid; color: gray; font-style: italic;} #footer h2, #controls {display: none;} /* The following rule keeps the layout stuff out of print. Remove at your own risk! */ .layout, .layout * {display: none !important;} -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/s5/default/s5-core.css: -------------------------------------------------------------------------------- 1 | /* Do not edit or override these styles! The system will likely break if you do. */ 2 | 3 | div#header, div#footer, div#controls, .slide {position: absolute;} 4 | html>body div#header, html>body div#footer, 5 | html>body div#controls, html>body .slide {position: fixed;} 6 | .handout {display: none;} 7 | .layout {display: block;} 8 | .slide, .hideme, .incremental {visibility: hidden;} 9 | #slide0 {visibility: visible;} 10 | -------------------------------------------------------------------------------- /doc/slide/code-reading-201601/s5/default/slides.css: -------------------------------------------------------------------------------- 1 | @import url(s5-core.css); /* required to make the slide show run at all */ 2 | @import url(framing.css); /* sets basic placement and size of slide components */ 3 | @import url(pretty.css); /* stuff that makes the slides look better than blah */ -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/Birthday.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Birthday where 4 | 5 | import Data.Time 6 | import Database.Relational.Query 7 | import Database.Relational.Query.TH 8 | import Database.HDBC.Query.TH () 9 | 10 | $(defineTable defaultConfig 11 | "PUBLIC" "birthday" 12 | [ ("name" , [t| String |]) 13 | , ("day" , [t| Day |]) 14 | ] 15 | [] [0] (Just 0)) 16 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/GNUmakefile: -------------------------------------------------------------------------------- 1 | 2 | 3 | targets = \ 4 | HRR.html 5 | 6 | 7 | md_format = \ 8 | markdown+pandoc_title_block+pipe_tables+table_captions+escaped_line_breaks+implicit_figures+strikeout+tex_math_dollars+latex_macros+fenced_code_blocks 9 | 10 | math_opt = --latexmathml 11 | #math_opt = --jsmath 12 | #math_opt = --mathjax 13 | 14 | slide_opts = \ 15 | --standalone --self-contained --slide-level=2 \ 16 | $(math_opt) 17 | ## --incremental 18 | 19 | %.html: %.md 20 | pandoc -f $(md_format) -t s5 $(slide_opts) -o $@ $< 21 | 22 | %.tex: %.md 23 | pandoc -f $(md_format) -t beamer -s --slide-level=2 -o $@ $< 24 | 25 | 26 | %.dvi %.log %.aux: %.tex 27 | platex $< 28 | 29 | 30 | %.pdf: %.dvi 31 | dvipdfmx $(@:.pdf=.dvi) 32 | 33 | 34 | all: $(targets) 35 | 36 | clean: 37 | $(RM) $(targets) 38 | ## $(RM) *.dvi *.pdf 39 | ## $(RM) *.aux *.log *.nav *.out *.snm *.toc *.vrb 40 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/Person.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Person where 4 | 5 | import Data.Int 6 | import Database.Relational.Query 7 | import Database.Relational.Query.TH 8 | 9 | $(defineTable defaultConfig 10 | "PUBLIC" "person" 11 | [ ("name" , [t| String |]) 12 | , ("age" , [t| Int32 |]) 13 | , ("address", [t| String |]) 14 | ] 15 | [] [0] (Just 0)) 16 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/arr.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE Arrows #-} 3 | 4 | import Control.Arrow 5 | import ArrowQuery 6 | 7 | import Person (Person, person) 8 | import Birthday (Birthday, birthday) 9 | import qualified Person 10 | import qualified Birthday 11 | 12 | 13 | personAndJoinA :: QuerySimple () (Projection Flat (Person, Birthday)) 14 | personAndJoinA = proc () -> do 15 | p <- query -< person 16 | b <- query -< birthday 17 | wheres -< p ! Person.name' .=. b ! Birthday.name' 18 | returnA -< p >< b 19 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/mytable.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | import Data.Int 4 | 5 | import Database.Relational.Query 6 | import Database.Relational.Query.TH 7 | 8 | 9 | $(defineTable defaultConfig 10 | "PUBLIC" "my_table" 11 | [ ("person", [t| String |]) 12 | , ("family", [t| String |]) 13 | , ("age" , [t| Int32 |]) 14 | ] 15 | [] [0] (Just 0)) 16 | 17 | 18 | agesOfFamilies :: Relation () (String, Maybe Int32) 19 | agesOfFamilies = aggregateRelation $ do 20 | my <- query myTable 21 | gFam <- groupBy $ my ! family' -- Specify grouping key 22 | return $ gFam >< sum' (my ! age') -- Aggregated results 23 | 24 | agesOfFamiliesO :: Relation () (String, Maybe Int32) 25 | agesOfFamiliesO = aggregateRelation $ do 26 | my <- query myTable 27 | gFam <- groupBy $ my ! family' 28 | let s = sum' (my ! age') 29 | orderBy s Desc -- Only aggregated value is allowed to pass 30 | orderBy gFam Asc 31 | return $ gFam >< s 32 | 33 | ageRankOfFamilies :: Relation () ((Int64, String), Int32) 34 | ageRankOfFamilies = relation $ do 35 | my <- query myTable 36 | return $ 37 | rank `over` do 38 | partitionBy $ my ! family' -- Monad to build window 39 | orderBy (my ! age') Desc 40 | >< 41 | my ! family' 42 | >< 43 | my ! age' 44 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/opaleye/Birthday.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | 5 | module Birthday where 6 | 7 | import Data.Time 8 | 9 | import Opaleye 10 | import Data.Profunctor.Product.TH 11 | 12 | data Birthday' a b = Birthday { name :: a, day :: b } 13 | type Birthday = Birthday' String Day 14 | type BirthdayColumn = Birthday' (Column PGText) (Column PGDate) 15 | 16 | $(makeAdaptorAndInstance "pBirthday" ''Birthday') 17 | 18 | birthdayTable :: Table BirthdayColumn BirthdayColumn 19 | birthdayTable = Table "birthdayTable" 20 | (pBirthday Birthday { name = required "name" 21 | , day = required "day" }) 22 | 23 | birthdayQuery :: Query BirthdayColumn 24 | birthdayQuery = queryTable birthdayTable 25 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/opaleye/Person.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | 5 | module Person where 6 | 7 | import Data.Time 8 | import Data.Int 9 | 10 | import Opaleye 11 | import Data.Profunctor.Product.TH 12 | 13 | data Person' a b = Person { name :: a, age :: b } 14 | type Person = Person' String Int32 15 | type PersonColumn = Person' (Column PGText) (Column PGInt4) 16 | 17 | $(makeAdaptorAndInstance "pPerson" ''Person') 18 | 19 | personTable :: Table PersonColumn PersonColumn 20 | personTable = Table "birthdayTable" 21 | (pPerson Person { name = required "name" 22 | , age = required "age" }) 23 | 24 | personQuery :: Query PersonColumn 25 | personQuery = queryTable personTable 26 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/opaleye/e.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Arrows #-} 2 | 3 | import Control.Arrow 4 | import Opaleye 5 | 6 | import Person 7 | import Birthday 8 | import qualified Person 9 | import qualified Birthday 10 | 11 | personAndBirthday :: Query (PersonColumn, BirthdayColumn) 12 | personAndBirthday = proc () -> do 13 | p <- personQuery -< () 14 | b <- birthdayQuery -< () 15 | restrict -< Person.name p .== Birthday.name b 16 | returnA -< (p, b) 17 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/s5/default/blank.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/haskell-hackathon-201412/s5/default/blank.gif -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/s5/default/bodybg.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/haskell-hackathon-201412/s5/default/bodybg.gif -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/s5/default/framing.css: -------------------------------------------------------------------------------- 1 | /* The following styles size, place, and layer the slide components. 2 | Edit these if you want to change the overall slide layout. 3 | The commented lines can be uncommented (and modified, if necessary) 4 | to help you with the rearrangement process. */ 5 | 6 | /* target = 1024x768 */ 7 | 8 | div#header, div#footer, .slide {width: 100%; top: 0; left: 0;} 9 | div#header {top: 0; height: 3em; z-index: 1;} 10 | div#footer {top: auto; bottom: 0; height: 2.5em; z-index: 5;} 11 | .slide {top: 0; width: 92%; padding: 3.5em 4% 4%; z-index: 2; list-style: none;} 12 | div#controls {left: 50%; bottom: 0; width: 50%; z-index: 100;} 13 | div#controls form {position: absolute; bottom: 0; right: 0; width: 100%; 14 | margin: 0;} 15 | #currentSlide {position: absolute; width: 10%; left: 45%; bottom: 1em; z-index: 10;} 16 | html>body #currentSlide {position: fixed;} 17 | 18 | /* 19 | div#header {background: #FCC;} 20 | div#footer {background: #CCF;} 21 | div#controls {background: #BBD;} 22 | div#currentSlide {background: #FFC;} 23 | */ 24 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/s5/default/opera.css: -------------------------------------------------------------------------------- 1 | /* DO NOT CHANGE THESE unless you really want to break Opera Show */ 2 | .slide { 3 | visibility: visible !important; 4 | position: static !important; 5 | page-break-before: always; 6 | } 7 | #slide0 {page-break-before: avoid;} 8 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/s5/default/outline.css: -------------------------------------------------------------------------------- 1 | /* don't change this unless you want the layout stuff to show up in the outline view! */ 2 | 3 | .layout div, #footer *, #controlForm * {display: none;} 4 | #footer, #controls, #controlForm, #navLinks, #toggle { 5 | display: block; visibility: visible; margin: 0; padding: 0;} 6 | #toggle {float: right; padding: 0.5em;} 7 | html>body #toggle {position: fixed; top: 0; right: 0;} 8 | 9 | /* making the outline look pretty-ish */ 10 | 11 | #slide0 h1, #slide0 h2, #slide0 h3, #slide0 h4 {border: none; margin: 0;} 12 | #slide0 h1 {padding-top: 1.5em;} 13 | .slide h1 {margin: 1.5em 0 0; padding-top: 0.25em; 14 | border-top: 1px solid #888; border-bottom: 1px solid #AAA;} 15 | #toggle {border: 1px solid; border-width: 0 0 1px 1px; background: #FFF;} 16 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/s5/default/print.css: -------------------------------------------------------------------------------- 1 | /* The following rule is necessary to have all slides appear in print! DO NOT REMOVE IT! */ .slide, ul {page-break-inside: avoid; visibility: visible !important;} h1 {page-break-after: avoid;} body {font-size: 12pt; background: white;} * {color: black;} #slide0 h1 {font-size: 200%; border: none; margin: 0.5em 0 0.25em;} #slide0 h3 {margin: 0; padding: 0;} #slide0 h4 {margin: 0 0 0.5em; padding: 0;} #slide0 {margin-bottom: 3em;} h1 {border-top: 2pt solid gray; border-bottom: 1px dotted silver;} .extra {background: transparent !important;} div.extra, pre.extra, .example {font-size: 10pt; color: #333;} ul.extra a {font-weight: bold;} p.example {display: none;} #header {display: none;} #footer h1 {margin: 0; border-bottom: 1px solid; color: gray; font-style: italic;} #footer h2, #controls {display: none;} /* The following rule keeps the layout stuff out of print. Remove at your own risk! */ .layout, .layout * {display: none !important;} -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/s5/default/s5-core.css: -------------------------------------------------------------------------------- 1 | /* Do not edit or override these styles! The system will likely break if you do. */ 2 | 3 | div#header, div#footer, div#controls, .slide {position: absolute;} 4 | html>body div#header, html>body div#footer, 5 | html>body div#controls, html>body .slide {position: fixed;} 6 | .handout {display: none;} 7 | .layout {display: block;} 8 | .slide, .hideme, .incremental {visibility: hidden;} 9 | #slide0 {visibility: visible;} 10 | -------------------------------------------------------------------------------- /doc/slide/haskell-hackathon-201412/s5/default/slides.css: -------------------------------------------------------------------------------- 1 | @import url(s5-core.css); /* required to make the slide show run at all */ 2 | @import url(framing.css); /* sets basic placement and size of slide components */ 3 | @import url(pretty.css); /* stuff that makes the slides look better than blah */ -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/Birthday.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Birthday where 4 | 5 | import Data.Time 6 | import Database.Relational.Query 7 | import Database.Relational.Query.TH 8 | import Database.HDBC.Query.TH () 9 | 10 | $(defineTable defaultConfig 11 | "PUBLIC" "birthday" 12 | [ ("name" , [t| String |]) 13 | , ("day" , [t| Day |]) 14 | ] 15 | [] [0] (Just 0)) 16 | -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/GNUmakefile: -------------------------------------------------------------------------------- 1 | 2 | 3 | targets = \ 4 | DSL.html 5 | 6 | 7 | md_format = \ 8 | markdown+pandoc_title_block+pipe_tables+table_captions+escaped_line_breaks+implicit_figures+strikeout+tex_math_dollars+latex_macros+fenced_code_blocks 9 | 10 | math_opt = --latexmathml 11 | #math_opt = --jsmath 12 | #math_opt = --mathjax 13 | 14 | slide_opts = \ 15 | --standalone --self-contained --slide-level=2 \ 16 | $(math_opt) 17 | ## --incremental 18 | 19 | %.html: %.md 20 | pandoc -f $(md_format) -t s5 $(slide_opts) -o $@ $< 21 | 22 | %.tex: %.md 23 | pandoc -f $(md_format) -t beamer -s --slide-level=2 -o $@ $< 24 | 25 | 26 | %.dvi %.log %.aux: %.tex 27 | platex $< 28 | 29 | 30 | %.pdf: %.dvi 31 | dvipdfmx $(@:.pdf=.dvi) 32 | 33 | 34 | all: $(targets) 35 | 36 | clean: 37 | $(RM) $(targets) 38 | ## $(RM) *.dvi *.pdf 39 | ## $(RM) *.aux *.log *.nav *.out *.snm *.toc *.vrb 40 | -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/Person.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Person where 4 | 5 | import Data.Int 6 | import Database.Relational.Query 7 | import Database.Relational.Query.TH 8 | 9 | $(defineTable defaultConfig 10 | "PUBLIC" "person" 11 | [ ("name" , [t| String |]) 12 | , ("age" , [t| Int32 |]) 13 | , ("address", [t| String |]) 14 | ] 15 | [] [0] (Just 0)) 16 | -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/mytable.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | import Data.Int 4 | 5 | import Database.Relational.Query 6 | import Database.Relational.Query.TH 7 | 8 | 9 | $(defineTable defaultConfig 10 | "PUBLIC" "my_table" 11 | [ ("person", [t| String |]) 12 | , ("family", [t| String |]) 13 | , ("age" , [t| Int32 |]) 14 | ] 15 | [] [0] (Just 0)) 16 | 17 | 18 | agesOfFamilies :: Relation () (String, Maybe Int32) 19 | agesOfFamilies = aggregateRelation $ do 20 | my <- query myTable 21 | gFam <- groupBy $ my ! family' -- Specify grouping key 22 | return $ gFam >< sum' (my ! age') -- Aggregated results 23 | 24 | agesOfFamiliesO :: Relation () (String, Maybe Int32) 25 | agesOfFamiliesO = aggregateRelation $ do 26 | my <- query myTable 27 | gFam <- groupBy $ my ! family' 28 | let s = sum' (my ! age') 29 | orderBy s Desc -- Only aggregated value is allowed to pass 30 | orderBy gFam Asc 31 | return $ gFam >< s 32 | 33 | ageRankOfFamilies :: Relation () ((Int64, String), Int32) 34 | ageRankOfFamilies = relation $ do 35 | my <- query myTable 36 | return $ 37 | rank `over` do 38 | partitionBy $ my ! family' -- Monad to build window 39 | orderBy (my ! age') Desc 40 | >< 41 | my ! family' 42 | >< 43 | my ! age' 44 | -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/s5/default/blank.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/tsukuba-201412/s5/default/blank.gif -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/s5/default/bodybg.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/doc/slide/tsukuba-201412/s5/default/bodybg.gif -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/s5/default/framing.css: -------------------------------------------------------------------------------- 1 | /* The following styles size, place, and layer the slide components. 2 | Edit these if you want to change the overall slide layout. 3 | The commented lines can be uncommented (and modified, if necessary) 4 | to help you with the rearrangement process. */ 5 | 6 | /* target = 1024x768 */ 7 | 8 | div#header, div#footer, .slide {width: 100%; top: 0; left: 0;} 9 | div#header {top: 0; height: 3em; z-index: 1;} 10 | div#footer {top: auto; bottom: 0; height: 2.5em; z-index: 5;} 11 | .slide {top: 0; width: 92%; padding: 3.5em 4% 4%; z-index: 2; list-style: none;} 12 | div#controls {left: 50%; bottom: 0; width: 50%; z-index: 100;} 13 | div#controls form {position: absolute; bottom: 0; right: 0; width: 100%; 14 | margin: 0;} 15 | #currentSlide {position: absolute; width: 10%; left: 45%; bottom: 1em; z-index: 10;} 16 | html>body #currentSlide {position: fixed;} 17 | 18 | /* 19 | div#header {background: #FCC;} 20 | div#footer {background: #CCF;} 21 | div#controls {background: #BBD;} 22 | div#currentSlide {background: #FFC;} 23 | */ 24 | -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/s5/default/opera.css: -------------------------------------------------------------------------------- 1 | /* DO NOT CHANGE THESE unless you really want to break Opera Show */ 2 | .slide { 3 | visibility: visible !important; 4 | position: static !important; 5 | page-break-before: always; 6 | } 7 | #slide0 {page-break-before: avoid;} 8 | -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/s5/default/outline.css: -------------------------------------------------------------------------------- 1 | /* don't change this unless you want the layout stuff to show up in the outline view! */ 2 | 3 | .layout div, #footer *, #controlForm * {display: none;} 4 | #footer, #controls, #controlForm, #navLinks, #toggle { 5 | display: block; visibility: visible; margin: 0; padding: 0;} 6 | #toggle {float: right; padding: 0.5em;} 7 | html>body #toggle {position: fixed; top: 0; right: 0;} 8 | 9 | /* making the outline look pretty-ish */ 10 | 11 | #slide0 h1, #slide0 h2, #slide0 h3, #slide0 h4 {border: none; margin: 0;} 12 | #slide0 h1 {padding-top: 1.5em;} 13 | .slide h1 {margin: 1.5em 0 0; padding-top: 0.25em; 14 | border-top: 1px solid #888; border-bottom: 1px solid #AAA;} 15 | #toggle {border: 1px solid; border-width: 0 0 1px 1px; background: #FFF;} 16 | -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/s5/default/print.css: -------------------------------------------------------------------------------- 1 | /* The following rule is necessary to have all slides appear in print! DO NOT REMOVE IT! */ .slide, ul {page-break-inside: avoid; visibility: visible !important;} h1 {page-break-after: avoid;} body {font-size: 12pt; background: white;} * {color: black;} #slide0 h1 {font-size: 200%; border: none; margin: 0.5em 0 0.25em;} #slide0 h3 {margin: 0; padding: 0;} #slide0 h4 {margin: 0 0 0.5em; padding: 0;} #slide0 {margin-bottom: 3em;} h1 {border-top: 2pt solid gray; border-bottom: 1px dotted silver;} .extra {background: transparent !important;} div.extra, pre.extra, .example {font-size: 10pt; color: #333;} ul.extra a {font-weight: bold;} p.example {display: none;} #header {display: none;} #footer h1 {margin: 0; border-bottom: 1px solid; color: gray; font-style: italic;} #footer h2, #controls {display: none;} /* The following rule keeps the layout stuff out of print. Remove at your own risk! */ .layout, .layout * {display: none !important;} -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/s5/default/s5-core.css: -------------------------------------------------------------------------------- 1 | /* Do not edit or override these styles! The system will likely break if you do. */ 2 | 3 | div#header, div#footer, div#controls, .slide {position: absolute;} 4 | html>body div#header, html>body div#footer, 5 | html>body div#controls, html>body .slide {position: fixed;} 6 | .handout {display: none;} 7 | .layout {display: block;} 8 | .slide, .hideme, .incremental {visibility: hidden;} 9 | #slide0 {visibility: visible;} 10 | -------------------------------------------------------------------------------- /doc/slide/tsukuba-201412/s5/default/slides.css: -------------------------------------------------------------------------------- 1 | @import url(s5-core.css); /* required to make the slide show run at all */ 2 | @import url(framing.css); /* sets basic placement and size of slide components */ 3 | @import url(pretty.css); /* stuff that makes the slides look better than blah */ -------------------------------------------------------------------------------- /examples/HDBC/MySQL/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../../../devel/GNUmakefile -------------------------------------------------------------------------------- /examples/HDBC/MySQL/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, krdlab 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of krdlab nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /examples/HDBC/MySQL/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /examples/HDBC/MySQL/hrr-example-HDBC-MySQL.cabal: -------------------------------------------------------------------------------- 1 | name: hrr-example-HDBC-MySQL 2 | version: 0.1.0.0 3 | synopsis: mysql driver example 4 | -- description: 5 | license: BSD3 6 | license-file: LICENSE 7 | author: krdlab 8 | maintainer: krdlab@gmail.com 9 | -- copyright: 10 | -- category: 11 | build-type: Simple 12 | -- extra-source-files: 13 | cabal-version: >=1.10 14 | 15 | executable example 16 | hs-source-dirs: 17 | src 18 | main-is: 19 | Main.hs 20 | other-modules: 21 | Example.DataSource 22 | Example.User 23 | other-extensions: 24 | TemplateHaskell 25 | , FlexibleInstances 26 | , MultiParamTypeClasses 27 | , MonadComprehensions 28 | build-depends: 29 | base >=4.5 && <5 30 | , template-haskell >=2.7 31 | , HDBC >=2.3 32 | , HDBC-mysql >=0.6 && <0.8 33 | , HDBC-session 34 | , names-th 35 | , relational-query >= 0.10 36 | , relational-schemas 37 | , relational-query-HDBC >= 0.4 38 | , time 39 | if impl(ghc == 7.4.*) 40 | build-depends: ghc-prim == 0.2.* 41 | 42 | default-language: 43 | Haskell2010 44 | ghc-options: 45 | -Wall 46 | -------------------------------------------------------------------------------- /examples/HDBC/MySQL/setup.sql: -------------------------------------------------------------------------------- 1 | CREATE DATABASE IF NOT EXISTS TEST DEFAULT CHARACTER SET UTF8; 2 | 3 | DROP TABLE IF EXISTS TEST.user; 4 | CREATE TABLE TEST.user ( 5 | id BIGINT PRIMARY KEY 6 | , name VARCHAR(32) NOT NULL 7 | , email VARCHAR(255) NOT NULL UNIQUE 8 | , passwd_hash VARCHAR(512) NOT NULL 9 | , completed TINYINT(1) NOT NULL DEFAULT 0 10 | , deleted TINYINT(1) NOT NULL DEFAULT 0 11 | , frozen TINYINT(1) NOT NULL DEFAULT 0 12 | , memo TEXT NOT NULL 13 | , created_at DATE NOT NULL 14 | , updated_at DATE NOT NULL 15 | ); 16 | 17 | INSERT INTO TEST.user 18 | (id, name, email, passwd_hash, completed, deleted, frozen, memo, created_at, updated_at) 19 | VALUES 20 | (1, 'krdlab', 'krdlab@gmail.com', 'dummy hashed password 1', 1, 0, 0, '', '2014-02-01', '2014-02-01'), 21 | (2, 'foo', 'foo@example.com', 'dummy hashed password 2', 0, 0, 0, '', '2014-02-10', '2014-02-10'), 22 | (3, 'bar', 'bar@example.com', 'dummy hashed password 3', 1, 0, 1, 'limit exceeded', '2014-02-11', '2014-02-20') 23 | ; 24 | 25 | GRANT ALL PRIVILEGES ON TEST.user TO 'hrr-tester'@'127.0.0.1'; 26 | -------------------------------------------------------------------------------- /examples/HDBC/MySQL/src/Example/DataSource.hs: -------------------------------------------------------------------------------- 1 | module Example.DataSource 2 | ( 3 | config 4 | , connect 5 | , defineTable 6 | ) 7 | where 8 | 9 | import Language.Haskell.TH (Q, Dec, TypeQ) 10 | import Language.Haskell.TH.Syntax (Name) 11 | 12 | import Database.HDBC.Query.TH (defineTableFromDB) 13 | import Database.HDBC.Schema.Driver (typeMap) 14 | import Database.HDBC.Schema.MySQL (driverMySQL) 15 | import Database.HDBC.MySQL ( Connection 16 | , connectMySQL 17 | , MySQLConnectInfo(..) 18 | , defaultMySQLConnectInfo 19 | ) 20 | import Database.Relational.Schema.MySQLInfo.Config (config) 21 | 22 | connConfig :: MySQLConnectInfo 23 | connConfig = defaultMySQLConnectInfo { 24 | mysqlUser = "hrr-tester" 25 | , mysqlPassword = "" 26 | , mysqlDatabase = "TEST" 27 | , mysqlHost = "127.0.0.1" 28 | } 29 | 30 | connect :: IO Connection 31 | connect = connectMySQL connConfig 32 | 33 | defineTable :: [(String, TypeQ)] -> String -> String -> [Name] -> Q [Dec] 34 | defineTable tmap = defineTableFromDB connect (driverMySQL { typeMap = tmap }) 35 | -------------------------------------------------------------------------------- /examples/HDBC/MySQL/src/Example/User.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | module Example.User where 7 | 8 | import GHC.Generics (Generic) 9 | import Prelude hiding (id) 10 | import Example.DataSource (defineTable) 11 | 12 | $(defineTable 13 | [] 14 | "TEST" "user" [''Generic]) 15 | -------------------------------------------------------------------------------- /examples/HDBC/Oracle/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../../../devel/GNUmakefile -------------------------------------------------------------------------------- /examples/HDBC/Oracle/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, amutake 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of amutake nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /examples/HDBC/Oracle/README.md: -------------------------------------------------------------------------------- 1 | Setup 2 | ===== 3 | 4 | Don't forget to load environment setup script like oraenv. 5 | -------------------------------------------------------------------------------- /examples/HDBC/Oracle/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /examples/HDBC/Oracle/hrr-example-HDBC-Oracle.cabal: -------------------------------------------------------------------------------- 1 | name: hrr-example-HDBC-Oracle 2 | version: 0.1.0.0 3 | license: BSD3 4 | license-file: LICENSE 5 | author: amutake 6 | maintainer: amutake.s@gmail.com 7 | build-type: Simple 8 | cabal-version: >=1.10 9 | 10 | executable hrr-oracle-example 11 | main-is: main.hs 12 | other-modules: DataSource 13 | -- other-extensions: 14 | build-depends: base <5 15 | , persistable-record 16 | , HDBC 17 | , HDBC-odbc 18 | , HDBC-session 19 | , relational-query >=0.12.1 20 | , relational-query-HDBC 21 | , template-haskell 22 | hs-source-dirs: src 23 | default-language: Haskell2010 24 | ghc-options: -Wall 25 | -------------------------------------------------------------------------------- /examples/HDBC/Oracle/src/DataSource.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | 3 | module DataSource where 4 | 5 | import Control.Applicative ((<$>)) 6 | import Database.HDBC.ODBC (Connection, connectODBC) 7 | 8 | data Option = Option 9 | { dsn :: String 10 | , uid :: String 11 | , pwd :: String 12 | } deriving (Show, Read) 13 | 14 | data Param = Param 15 | { option :: Option 16 | , owner :: String 17 | } deriving (Show, Read) 18 | 19 | dsString :: Option -> String 20 | dsString (Option d u p) = 21 | concat 22 | [ "DSN=", d, ";" 23 | , "UID=", u, ";" 24 | , "PWD=", p 25 | ] 26 | 27 | getParam :: IO Param 28 | getParam = readIO =<< readFile "datasource.show" 29 | 30 | connect :: IO Connection 31 | connect = connectODBC . dsString . option =<< getParam 32 | 33 | getOwner :: IO String 34 | getOwner = owner <$> getParam 35 | -------------------------------------------------------------------------------- /examples/HDBC/Oracle/src/HrrDatatypeTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} 2 | 3 | module HrrDatatypeTest where 4 | 5 | import GHC.Generics (Generic) 6 | import Language.Haskell.TH (runIO) 7 | import Database.HDBC.Query.TH (defineTableFromDB) 8 | import Database.HDBC.Schema.Oracle (driverOracle) 9 | 10 | import DataSource (connect, getOwner) 11 | 12 | $(do owner <- runIO getOwner 13 | defineTableFromDB connect driverOracle owner "hrr_datatype_test" [''Show, ''Generic]) 14 | -------------------------------------------------------------------------------- /examples/HDBC/Oracle/src/drop.sql: -------------------------------------------------------------------------------- 1 | drop table hrr_datatype_test cascade constraints purge; 2 | -------------------------------------------------------------------------------- /examples/HDBC/Oracle/src/main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Database.Relational (relationalQuery) 4 | import Database.HDBC.Session (withConnectionIO, handleSqlError') 5 | import Database.HDBC.Record.Query (runQuery) 6 | 7 | import DataSource 8 | import HrrDatatypeTest 9 | 10 | main :: IO () 11 | main = handleSqlError' $ withConnectionIO connect $ \conn -> do 12 | runQuery conn (relationalQuery hrrDatatypeTest) () >>= print 13 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../../../devel/GNUmakefile -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/1/Group.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module Group where 4 | 5 | import GHC.Generics (Generic) 6 | import Prelude hiding (id) 7 | import PgTestDataSource (defineTable) 8 | 9 | $(defineTable [] 10 | "EXAMPLE1" "group" [''Show, ''Generic]) 11 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/1/Membership.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module Membership where 4 | 5 | import GHC.Generics (Generic) 6 | import PgTestDataSource (defineTable) 7 | 8 | $(defineTable [] 9 | "EXAMPLE1" "membership" [''Generic]) 10 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/1/User.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module User where 4 | 5 | import GHC.Generics (Generic) 6 | import Prelude hiding (id) 7 | import PgTestDataSource (defineTable) 8 | 9 | $(defineTable [] 10 | "EXAMPLE1" "user" [''Show, ''Generic]) 11 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/1/create.sql: -------------------------------------------------------------------------------- 1 | CREATE SCHEMA EXAMPLE1; 2 | 3 | CREATE TABLE EXAMPLE1.user ( 4 | id integer NOT NULL, 5 | name VARCHAR(128), 6 | 7 | PRIMARY KEY(id) 8 | ); 9 | 10 | CREATE TABLE EXAMPLE1.group ( 11 | id integer NOT NULL, 12 | name VARCHAR(128), 13 | 14 | PRIMARY KEY(id) 15 | ); 16 | 17 | CREATE TABLE EXAMPLE1.membership ( 18 | user_id integer NOT NULL, 19 | group_id integer NOT NULL, 20 | 21 | PRIMARY KEY(user_id, group_id) 22 | ); 23 | 24 | INSERT INTO EXAMPLE1.user (id, name) VALUES (1, 'Kei Hibino'); 25 | INSERT INTO EXAMPLE1.user (id, name) VALUES (2, 'Kazu Yamamoto'); 26 | INSERT INTO EXAMPLE1.user (id, name) VALUES (3, 'Shouhei Murayama'); 27 | INSERT INTO EXAMPLE1.user (id, name) VALUES (255, ''); 28 | 29 | INSERT INTO EXAMPLE1.group (id, name) VALUES (1, 'Haskell'); 30 | INSERT INTO EXAMPLE1.group (id, name) VALUES (2, 'C++'); 31 | INSERT INTO EXAMPLE1.group (id, name) VALUES (3, 'Java'); 32 | 33 | INSERT INTO EXAMPLE1.membership (user_id, group_id) VALUES (1, 1); 34 | INSERT INTO EXAMPLE1.membership (user_id, group_id) VALUES (2, 1); 35 | INSERT INTO EXAMPLE1.membership (user_id, group_id) VALUES (3, 1); 36 | 37 | INSERT INTO EXAMPLE1.membership (user_id, group_id) VALUES (1, 3); 38 | INSERT INTO EXAMPLE1.membership (user_id, group_id) VALUES (3, 3); 39 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/1/drop.sql: -------------------------------------------------------------------------------- 1 | DROP TABLE EXAMPLE1.membership; 2 | DROP TABLE EXAMPLE1.group; 3 | DROP TABLE EXAMPLE1.user; 4 | DROP SCHEMA IF EXISTS EXAMPLE1; 5 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/2/KeyTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module KeyTest where 4 | 5 | import GHC.Generics (Generic) 6 | import PgTestDataSource (defineTable) 7 | 8 | $(defineTable [] 9 | "EXAMPLE2" "keyTest" [''Generic]) 10 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/2/create.sql: -------------------------------------------------------------------------------- 1 | CREATE SCHEMA EXAMPLE2; 2 | 3 | CREATE TABLE EXAMPLE2.keytest ( 4 | name VARCHAR(30) NOT NULL, 5 | bar INTEGER NOT NULL, 6 | foo INTEGER NOT NULL, 7 | attr VARCHAR(30) NOT NULL, 8 | baz INTEGER NOT NULL, 9 | 10 | PRIMARY KEY(foo, name, bar) 11 | ); 12 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/2/drop.sql: -------------------------------------------------------------------------------- 1 | DROP TABLE EXAMPLE2.keytest; 2 | DROP SCHEMA IF EXISTS EXAMPLE2; 3 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/2/show.hs: -------------------------------------------------------------------------------- 1 | 2 | import KeyTest 3 | 4 | main :: IO () 5 | main = print selectKeyTest 6 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/3/History.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module History where 4 | 5 | import GHC.Generics (Generic) 6 | import Prelude hiding (seq, log) 7 | import PgTestDataSource (defineTable) 8 | 9 | $(defineTable [] 10 | "EXAMPLE3" "history" [''Show, ''Generic]) 11 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/3/SetA.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module SetA where 4 | 5 | import GHC.Generics (Generic) 6 | import Prelude hiding (seq) 7 | import PgTestDataSource (defineTable) 8 | 9 | $(defineTable [] 10 | "EXAMPLE3" "set_a" [''Show, ''Generic]) 11 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/3/SetB.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module SetB where 4 | 5 | import GHC.Generics (Generic) 6 | import Prelude hiding (seq) 7 | import PgTestDataSource (defineTable) 8 | 9 | $(defineTable [] 10 | "EXAMPLE3" "set_b" [''Show, ''Generic]) 11 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/3/create.sql: -------------------------------------------------------------------------------- 1 | CREATE SCHEMA EXAMPLE3; 2 | 3 | CREATE TABLE EXAMPLE3.set_a ( 4 | seq INTEGER NOT NULL, 5 | name VARCHAR(30) NOT NULL, 6 | 7 | PRIMARY KEY(seq) 8 | ); 9 | 10 | CREATE TABLE EXAMPLE3.set_b ( 11 | seq INTEGER NOT NULL, 12 | name VARCHAR(30) NOT NULL, 13 | 14 | PRIMARY KEY(seq) 15 | ); 16 | 17 | CREATE TABLE EXAMPLE3.history ( 18 | seq INTEGER NOT NULL, 19 | register_time TIMESTAMP NOT NULL, 20 | log VARCHAR(30) NOT NULL, 21 | 22 | PRIMARY KEY(seq) 23 | ); 24 | 25 | INSERT INTO EXAMPLE3.set_a (seq, name) VALUES (1, 'Apple'); 26 | INSERT INTO EXAMPLE3.set_a (seq, name) VALUES (2, 'Orange'); 27 | INSERT INTO EXAMPLE3.set_a (seq, name) VALUES (5, 'Banana'); 28 | INSERT INTO EXAMPLE3.set_a (seq, name) VALUES (6, 'Cherry'); 29 | 30 | INSERT INTO EXAMPLE3.set_b (seq, name) VALUES (2, 'Orange'); 31 | INSERT INTO EXAMPLE3.set_b (seq, name) VALUES (6, 'Cherry'); 32 | INSERT INTO EXAMPLE3.set_b (seq, name) VALUES (7, 'Melon'); 33 | 34 | INSERT INTO EXAMPLE3.history (seq, register_time, log) VALUES (1, '2013-03-05 17:44:02', 'start'); 35 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/3/drop.sql: -------------------------------------------------------------------------------- 1 | DROP TABLE EXAMPLE3.history; 2 | DROP TABLE EXAMPLE3.set_b; 3 | DROP TABLE EXAMPLE3.set_a; 4 | DROP SCHEMA IF EXISTS EXAMPLE3; 5 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/4/One.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module One where 4 | 5 | import GHC.Generics (Generic) 6 | import Prelude hiding (seq) 7 | import PgTestDataSource (defineTable) 8 | 9 | $(defineTable [] 10 | "EXAMPLE4" "one" [''Show, ''Generic]) 11 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/4/StockGoods.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module StockGoods where 4 | 5 | import GHC.Generics (Generic) 6 | import Prelude hiding (seq) 7 | import PgTestDataSource (defineTable) 8 | 9 | $(defineTable [] 10 | "EXAMPLE4" "stock_goods" [''Show, ''Generic]) 11 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/4/create.sql: -------------------------------------------------------------------------------- 1 | CREATE SCHEMA EXAMPLE4; 2 | 3 | CREATE TABLE EXAMPLE4.one ( 4 | seq SERIAL NOT NULL, 5 | data INTEGER NOT NULL, 6 | PRIMARY KEY (seq) 7 | ); 8 | 9 | CREATE TABLE EXAMPLE4.stock_goods ( 10 | seq INTEGER NOT NULL, 11 | name VARCHAR(30) NOT NULL, 12 | unit INTEGER NOT NULL, 13 | amount INTEGER NOT NULL, 14 | 15 | PRIMARY KEY(seq) 16 | ); 17 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/4/drop.sql: -------------------------------------------------------------------------------- 1 | DROP TABLE EXAMPLE4.stock_goods; 2 | DROP TABLE EXAMPLE4.one; 3 | DROP SCHEMA IF EXISTS EXAMPLE4; 4 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/PgTestDataSource.hs: -------------------------------------------------------------------------------- 1 | 2 | module PgTestDataSource ( 3 | connect, defineTable 4 | ) where 5 | 6 | import Language.Haskell.TH (Q, Dec, TypeQ, Name) 7 | import Database.HDBC.PostgreSQL (connectPostgreSQL, Connection) 8 | import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL) 9 | import Database.HDBC.Schema.Driver (typeMap) 10 | import Database.HDBC.Query.TH (defineTableFromDB) 11 | 12 | connect :: IO Connection 13 | connect = connectPostgreSQL "dbname=hrrtest" 14 | 15 | defineTable :: [(String, TypeQ)] -> String -> String -> [Name] -> Q [Dec] 16 | defineTable tmap = 17 | defineTableFromDB 18 | connect 19 | (driverPostgreSQL { typeMap = tmap }) 20 | -------------------------------------------------------------------------------- /examples/HDBC/PostgreSQL/example/README: -------------------------------------------------------------------------------- 1 | This example requires user access to PostgreSQL database 2 | which is named 'hrrtest' over UNIX domain socket. 3 | 4 | ## Creating 'hrrtest' 5 | 6 | % createdb hrrtest 7 | 8 | 9 | ## Example 1 case 10 | 11 | % psql hrrtest < ./1/create.sql 12 | % runghc -i1 ./1/query.hs 13 | 14 | ... 15 | 16 | 17 | ## Example 3 case 18 | 19 | % psql hrrtest < ./3/create.sql 20 | % runghc -i3 ./3/query.hs 21 | -------------------------------------------------------------------------------- /names-th/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /names-th/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /names-th/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /old/kazu.ja.md: -------------------------------------------------------------------------------- 1 | # 感想 2 | 3 | - 内包表記の | の左側に値を列挙してするにはどうするの？ 4 | 5 | 以下の一行目： 6 | 7 | SELECT e.fname, e.lname, d.name 8 | FROM LEARNINGSQL.employee e JOIN LEARNINGSQL.department d 9 | ON e.dept_id = d.dept_id 10 | 11 | - ! や ?! の使い分けは分かりにくい。.=. は a と Maybe a に対して多相になって欲しい。正規表現パッケージの ~= などを参考に実装できないか？ 12 | 13 | これを： 14 | 15 | () <- on $ e ! Employee.deptId' .=. just (d ! Department.deptId') 16 | 17 | 18 | こういうふうに： 19 | 20 | 21 | () <- on $ e ! Employee.deptId' .=. d ! Department.deptId' 22 | 23 | 24 | - フィールド名を多相にできないか？ Lens では実現できてる？ 25 | 26 | こんな感じ： 27 | 28 | () <- on $ e ! deptId' .=. d ! deptId' 29 | 30 | - query, queryMaybe は SQL と名前が違い過ぎて、意味が分からなかった。 31 | 32 | -------------------------------------------------------------------------------- /old/memo.txt: -------------------------------------------------------------------------------- 1 | A memorandum for HRR 2 | ====================== 3 | 4 | Type Casts 5 | ----------- 6 | 7 | ### PostgreSQL 8 | http://www.postgresql.org/docs/9.2/static/sql-expressions.html#SQL-SYNTAX-TYPE-CASTS 9 | 10 | > A type cast specifies a conversion from one data type to another. 11 | > PostgreSQL accepts two equivalent syntaxes for type casts: 12 | > 13 | > CAST ( AS ) 14 | > :: 15 | > 16 | > The CAST syntax conforms to SQL; the syntax with :: is historical PostgreSQL usage. 17 | 18 | ### SQL Server 2012 19 | http://msdn.microsoft.com/en-US/library/ms187928(v=sql.110).aspx 20 | 21 | > Syntax for CAST: 22 | > 23 | > CAST ( AS [ ( ) ] ) 24 | 25 | ### SQLite3 26 | http://www.sqlite.org/syntaxdiagrams.html#expr 27 | 28 | > expr: (excerption) 29 | > 30 | > CAST ( AS ) 31 | > 32 | > type-name: 33 | > 34 | > [ ...n ] [ ( ) | ( , ) ] 35 | 36 | -------------------------------------------------------------------------------- /persistable-record/ChangeLog.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | ## 0.6.0.6 4 | 5 | - fix typo. 6 | 7 | ## 0.6.0.5 8 | 9 | - apply compat interface packages of TH. 10 | 11 | ## 0.6.0.4 12 | 13 | - update documentation. 14 | 15 | ## 0.6.0.3 16 | 17 | - fix example of NameConfig customization. 18 | 19 | ## 0.6.0.2 20 | 21 | - bugfix: pass correct table name to macro for field label definition. 22 | 23 | ## 0.6.0.1 24 | 25 | - fix changelog. 26 | - fix typo. 27 | 28 | ## 0.6.0.0 29 | 30 | - divide and apply product-isomorphic interfaces. 31 | - check width of Int type and add instances. 32 | 33 | ## 0.5.1.1 34 | 35 | - update this changelog. 36 | 37 | ## 0.5.1.0 38 | 39 | - add class dependency from ToSql to PersistableWidth. 40 | 41 | ## 0.5.0.2 42 | 43 | - add tested-with 8.2.1. 44 | 45 | ## 0.5.0.1 46 | 47 | - use Haskell implementation test instead of flag test in .cabal 48 | 49 | ## 0.5.0.0 50 | 51 | - add generic instances of FromSql, ToSql and PersistableWidth. 52 | 53 | ## 0.4.1.1 54 | 55 | - Tested with GHC 8.0.2 56 | - Add a small test set. 57 | 58 | ## 0.4.1.0 59 | 60 | - Export columnName of NameConfig. 61 | 62 | ## 0.4.0.3 63 | 64 | - Drop an unreferenced definition. 65 | 66 | ## 0.4.0.2 67 | 68 | - Add tested-with. 69 | 70 | ## 0.4.0.1 71 | 72 | - Apply th-data-compat. 73 | 74 | ## 0.4.0.0 75 | 76 | - Divide PersistableValue interface to FromSql and ToSql. 77 | 78 | ## 0.3.0.0 79 | 80 | - Add symbol name configurations of templates. 81 | 82 | ## 0.2.0.0 83 | 84 | - TH quotation of derive class names. 85 | -------------------------------------------------------------------------------- /persistable-record/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /persistable-record/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /persistable-record/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /persistable-record/src/Database/Record/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | 6 | -- | 7 | -- Module : Database.Record.Instances 8 | -- Copyright : 2013 Kei Hibino 9 | -- License : BSD3 10 | -- 11 | -- Maintainer : ex8k.hibino@gmail.com 12 | -- Stability : experimental 13 | -- Portability : unknown 14 | -- 15 | -- Single column instances for example to load schema of system catalogs. 16 | module Database.Record.Instances () where 17 | 18 | import Data.Int (Int8, Int16, Int32, Int64) 19 | import Database.Record.InternalTH (knownWidthIntType) 20 | import Database.Record.TH (deriveNotNullType) 21 | 22 | $(fmap concat $ mapM deriveNotNullType $ 23 | [ [t| Bool |] 24 | , [t| Char |] 25 | , [t| String |] 26 | , [t| Int8 |] 27 | , [t| Int16 |] 28 | , [t| Int32 |] 29 | , [t| Int64 |] 30 | ] ++ 31 | [ t | Just t <- [knownWidthIntType] ]) 32 | -------------------------------------------------------------------------------- /persistable-record/src/Database/Record/TupleInstances.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} 4 | 5 | module Database.Record.TupleInstances () where 6 | 7 | import Control.Applicative ((<$>)) 8 | 9 | import Database.Record.InternalTH (defineTupleInstances) 10 | 11 | 12 | $(concat <$> mapM defineTupleInstances [2..7]) 13 | -- Generic instances of tuple types are generated from 2 to 7 in GHC.Generics. 14 | -------------------------------------------------------------------------------- /persistable-types-HDBC-pg/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /persistable-types-HDBC-pg/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /persistable-types-HDBC-pg/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /persistable-types-HDBC-pg/example/DS.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module DS (definePgTable) where 4 | 5 | import Language.Haskell.TH (Q, Dec, Name) 6 | import Database.HDBC.PostgreSQL (connectPostgreSQL) 7 | import Database.Relational.HDBC.TH (defineTableFromDB) 8 | import Database.Schema.HDBC.Driver (Driver (..)) 9 | import Database.Schema.HDBC.PostgreSQL (driverPostgreSQL) 10 | import Data.PostgreSQL.NetworkAddress 11 | 12 | addNetAddress :: Driver conn -> Driver conn 13 | addNetAddress d = 14 | d { typeMap = [ ("inet", [t| Inet |]), ("cidr", [t| Cidr |] ) ] ++ typeMap d } 15 | 16 | definePgTable :: String -> String -> [Name] -> Q [Dec] 17 | definePgTable = 18 | defineTableFromDB (connectPostgreSQL "dbname=testdb") (addNetAddress driverPostgreSQL) 19 | -------------------------------------------------------------------------------- /persistable-types-HDBC-pg/example/InetExample.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module SinglePKey where 8 | 9 | import GHC.Generics (Generic) 10 | import DS 11 | import Database.Relational.HDBC.PostgreSQL () 12 | 13 | $(definePgTable 14 | "EXAMPLE" "inet_example" 15 | [''Eq, ''Show, ''Generic]) 16 | -------------------------------------------------------------------------------- /persistable-types-HDBC-pg/example/README: -------------------------------------------------------------------------------- 1 | Add a test database to run this example. 2 | 3 | % createdb testdb 4 | -------------------------------------------------------------------------------- /persistable-types-HDBC-pg/example/inet.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | table=EXAMPLE.inet_example 4 | 5 | create() { 6 | cat < Q [Dec] -- ^ Result declarations 27 | derivePersistableInstanceFromConvertible = 28 | Internal.derivePersistableInstanceFromConvertible 29 | {-# DEPRECATED derivePersistableInstanceFromConvertible "instantiate using `recordFromSql = valueRecordFromSql convert` and `recordToSql = valueRecordToSql convert`" #-} 30 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/HDBC/Record/Update.hs: -------------------------------------------------------------------------------- 1 | module Database.HDBC.Record.Update 2 | {-# DEPRECATED "import Database.Relational.HDBC.Update" #-} ( 3 | module Database.Relational.HDBC.Update 4 | ) where 5 | 6 | import Database.Relational.HDBC.Update 7 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/HDBC/Schema/Driver.hs: -------------------------------------------------------------------------------- 1 | module Database.HDBC.Schema.Driver 2 | {-# DEPRECATED "import Database.Schema.HDBC.Driver" #-} ( 3 | module Database.Schema.HDBC.Driver 4 | ) where 5 | 6 | import Database.Schema.HDBC.Driver 7 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/HDBC/Schema/IBMDB2.hs: -------------------------------------------------------------------------------- 1 | module Database.HDBC.Schema.IBMDB2 2 | {-# DEPRECATED "import Database.Schema.HDBC.IBMDB2" #-} ( 3 | module Database.Schema.HDBC.IBMDB2 4 | ) where 5 | 6 | import Database.Schema.HDBC.IBMDB2 7 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/HDBC/Schema/MySQL.hs: -------------------------------------------------------------------------------- 1 | module Database.HDBC.Schema.MySQL 2 | {-# DEPRECATED "import Database.Schema.HDBC.MySQL" #-} ( 3 | module Database.Schema.HDBC.MySQL 4 | ) where 5 | 6 | import Database.Schema.HDBC.MySQL 7 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/HDBC/Schema/Oracle.hs: -------------------------------------------------------------------------------- 1 | module Database.HDBC.Schema.Oracle 2 | {-# DEPRECATED "import Database.Schema.HDBC.Oracle" #-} ( 3 | module Database.Schema.HDBC.Oracle 4 | ) where 5 | 6 | import Database.Schema.HDBC.Oracle 7 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/HDBC/Schema/PostgreSQL.hs: -------------------------------------------------------------------------------- 1 | module Database.HDBC.Schema.PostgreSQL 2 | {-# DEPRECATED "import Database.Schema.HDBC.PostgreSQL" #-} ( 3 | module Database.Schema.HDBC.PostgreSQL 4 | ) where 5 | 6 | import Database.Schema.HDBC.PostgreSQL 7 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/HDBC/Schema/SQLServer.hs: -------------------------------------------------------------------------------- 1 | module Database.HDBC.Schema.SQLServer 2 | {-# DEPRECATED "import Database.Schema.HDBC.SQLServer" #-} ( 3 | module Database.Schema.HDBC.SQLServer 4 | ) where 5 | 6 | import Database.Schema.HDBC.SQLServer 7 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/HDBC/Schema/SQLite3.hs: -------------------------------------------------------------------------------- 1 | module Database.HDBC.Schema.SQLite3 2 | {-# DEPRECATED "import Database.Schema.HDBC.SQLite3" #-} ( 3 | module Database.Schema.HDBC.SQLite3 4 | ) where 5 | 6 | import Database.Schema.HDBC.SQLite3 7 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/HDBC/SqlValueExtra.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | -- | 4 | -- Module : Database.HDBC.SqlValueExtra 5 | -- Copyright : 2019 Kei Hibino 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : ex8k.hibino@gmail.com 9 | -- Stability : experimental 10 | -- Portability : unknown 11 | module Database.HDBC.SqlValueExtra 12 | {-# DEPRECATED "import Database.Relational.HDBC.SqlValueExtra instead of this." #-} 13 | () where 14 | 15 | import Database.Relational.HDBC.SqlValueExtra () 16 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/Relational/HDBC.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.HDBC 3 | -- Copyright : 2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module provides merged namespace of 11 | -- typed 'Query', 'Insert', 'InsertQuery', 'Update', 'KeyUpdate' and 'Delete' 12 | -- running sequences. 13 | module Database.Relational.HDBC ( 14 | module Database.Relational.HDBC.Query, 15 | module Database.Relational.HDBC.Insert, 16 | module Database.Relational.HDBC.InsertQuery, 17 | module Database.Relational.HDBC.Update, 18 | module Database.Relational.HDBC.KeyUpdate, 19 | module Database.Relational.HDBC.Delete, 20 | module Database.Relational.HDBC.Statement 21 | ) where 22 | 23 | import Database.Relational.HDBC.Query hiding (prepare) 24 | import Database.Relational.HDBC.Insert hiding (prepare) 25 | import Database.Relational.HDBC.InsertQuery hiding (prepare) 26 | import Database.Relational.HDBC.Update hiding (prepare) 27 | import Database.Relational.HDBC.KeyUpdate hiding (prepare) 28 | import Database.Relational.HDBC.Delete hiding (prepare) 29 | import Database.Relational.HDBC.Statement 30 | 31 | {-# ANN module "HLint: ignore Use import/export shortcut" #-} 32 | -------------------------------------------------------------------------------- /relational-query-HDBC/src/Database/Relational/HDBC/Persistable.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | 7 | -- | 8 | -- Module : Database.Relational.HDBC.Persistable 9 | -- Copyright : 2013 Kei Hibino 10 | -- License : BSD3 11 | -- 12 | -- Maintainer : ex8k.hibino@gmail.com 13 | -- Stability : experimental 14 | -- Portability : unknown 15 | -- 16 | -- This module provides HDBC instance definitions of DB-record. 17 | module Database.Relational.HDBC.Persistable () where 18 | 19 | import Database.Record (PersistableType (..)) 20 | import Database.Record.Persistable (unsafePersistableSqlTypeFromNull) 21 | import Database.Relational.HDBC.InternalTH (derivePersistableInstancesFromConvertibleSqlValues) 22 | 23 | import Database.HDBC (SqlValue(SqlNull)) 24 | 25 | instance PersistableType SqlValue where 26 | persistableType = unsafePersistableSqlTypeFromNull SqlNull 27 | 28 | $(derivePersistableInstancesFromConvertibleSqlValues) 29 | -------------------------------------------------------------------------------- /relational-query/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /relational-query/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /relational-query/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /relational-query/cabal-test.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | set -x 4 | 5 | cabal clean 6 | cabal configure --enable-tests 7 | cabal build 8 | cabal test 9 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Config.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Config 3 | -- Copyright : 2013-2017 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module provides untyped components for query. 11 | module Database.Relational.Config 12 | ( -- * Configuration type for query 13 | module Database.Relational.Internal.Config, 14 | ) where 15 | 16 | import Database.Relational.Internal.Config 17 | (NameConfig (..), 18 | ProductUnitSupport (..), SchemaNameMode (..), IdentifierQuotation (..), 19 | Config (..), defaultConfig, defaultNameConfig) 20 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Context.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Context 3 | -- Copyright : 2017 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module re-export query context tag types. 11 | module Database.Relational.Context 12 | ( module Database.Relational.Internal.ContextType 13 | ) where 14 | 15 | import Database.Relational.Internal.ContextType 16 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Internal/ContextType.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls #-} 2 | 3 | -- | 4 | -- Module : Database.Relational.Internal.ContextType 5 | -- Copyright : 2013-2017 Kei Hibino 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : ex8k.hibino@gmail.com 9 | -- Stability : experimental 10 | -- Portability : unknown 11 | -- 12 | -- This module defines query context tag types. 13 | module Database.Relational.Internal.ContextType ( 14 | Flat, Aggregated, Exists, OverWindow, 15 | 16 | Set, SetList, Power, 17 | ) where 18 | 19 | -- | Type tag for flat (not-aggregated) query 20 | data Flat 21 | 22 | -- | Type tag for aggregated query 23 | data Aggregated 24 | 25 | -- | Type tag for exists predicate 26 | data Exists 27 | 28 | -- | Type tag for window function building 29 | data OverWindow 30 | 31 | 32 | -- | Type tag for normal aggregatings set 33 | data Set 34 | 35 | -- | Type tag for aggregatings GROUPING SETS 36 | data SetList 37 | 38 | -- | Type tag for aggregatings power set 39 | data Power 40 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Internal/String.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Internal.String 3 | -- Copyright : 2014-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module provides SQL string wrap interfaces. 11 | module Database.Relational.Internal.String ( 12 | StringSQL, stringSQL, showStringSQL, 13 | 14 | rowStringSQL, rowPlaceHolderStringSQL, 15 | 16 | rowConsStringSQL, listStringSQL, 17 | ) where 18 | 19 | import Language.SQL.Keyword (Keyword, word, wordShow, fold, (|*|), paren) 20 | 21 | 22 | -- | String wrap type for SQL strings. 23 | type StringSQL = Keyword 24 | 25 | -- | 'StringSQL' from 'String'. 26 | stringSQL :: String -> StringSQL 27 | stringSQL = word 28 | 29 | -- | 'StringSQL' to 'String'. 30 | showStringSQL :: StringSQL -> String 31 | showStringSQL = wordShow 32 | 33 | -- | Row String of SQL values. 34 | rowStringSQL :: [StringSQL] -> StringSQL 35 | rowStringSQL = d where 36 | d [] = error "Record: no columns. empty row is not allowed in SQL." 37 | d [c] = c 38 | d cs = paren $ fold (|*|) cs 39 | 40 | -- | Place holder row String of SQL. 41 | rowPlaceHolderStringSQL :: Int -> StringSQL 42 | rowPlaceHolderStringSQL = rowStringSQL . (`replicate` stringSQL "?") 43 | 44 | -- | List String of SQL. 45 | rowConsStringSQL :: [StringSQL] -> StringSQL 46 | rowConsStringSQL = paren . fold (|*|) 47 | 48 | -- | List String of SQL. 49 | listStringSQL :: [StringSQL] -> StringSQL 50 | listStringSQL = paren . fold (|*|) 51 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Internal/UntypedTable.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Internal.UntypedTable 3 | -- Copyright : 2013-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module defines no-phantom table type which has table metadatas. 11 | module Database.Relational.Internal.UntypedTable ( 12 | Untyped, 13 | UTable (UTable), name', width', columns', (!), 14 | ) where 15 | 16 | import Data.Array (Array, elems) 17 | import qualified Data.Array as Array 18 | 19 | import Database.Relational.Internal.String (StringSQL) 20 | 21 | 22 | type Untyped = UTable 23 | {-# DEPRECATED Untyped "use UTable" #-} 24 | 25 | -- | UTable - un-record-typed table type 26 | data UTable = UTable String Int (Array Int StringSQL) deriving Show 27 | 28 | -- | Name string of table in SQL 29 | name' :: UTable -> String 30 | name' (UTable n _ _) = n 31 | 32 | -- | Width of table 33 | width' :: UTable -> Int 34 | width' (UTable _ w _) = w 35 | 36 | -- | Column name strings in SQL 37 | columnArray :: UTable -> Array Int StringSQL 38 | columnArray (UTable _ _ c) = c 39 | 40 | -- | Column name strings in SQL 41 | columns' :: UTable -> [StringSQL] 42 | columns' = elems . columnArray 43 | 44 | -- | Column name string in SQL specified by index 45 | (!) :: UTable 46 | -> Int -- ^ Column index 47 | -> StringSQL -- ^ Column name String in SQL 48 | t ! i = columnArray t Array.! i 49 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Monad/Register.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Monad.Register 3 | -- Copyright : 2015-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module contains definitions about assignment monad type to build insert statement. 11 | module Database.Relational.Monad.Register ( 12 | -- * Monad to register target records. 13 | Register, 14 | 15 | extract, 16 | ) where 17 | 18 | import Database.Relational.Internal.Config (Config) 19 | import Database.Relational.SqlSyntax (Assignment) 20 | import Database.Relational.Typed.Table (Table) 21 | 22 | import Database.Relational.Monad.BaseType (ConfigureQuery, configureQuery) 23 | import Database.Relational.Monad.Trans.Assigning (Assignings, extractAssignments) 24 | 25 | 26 | -- | Target register monad type used from insert statement. 27 | type Register r = Assignings r ConfigureQuery 28 | 29 | -- | Run 'InsertStatement'. 30 | extract :: Assignings r ConfigureQuery a -> Config -> (a, Table r -> [Assignment]) 31 | extract = configureQuery . extractAssignments 32 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Monad/Restrict.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | 5 | -- | 6 | -- Module : Database.Relational.Monad.Restrict 7 | -- Copyright : 2013-2019 Kei Hibino 8 | -- License : BSD3 9 | -- 10 | -- Maintainer : ex8k.hibino@gmail.com 11 | -- Stability : experimental 12 | -- Portability : unknown 13 | -- 14 | -- This module contains definitions about simple restrict context monad type. 15 | module Database.Relational.Monad.Restrict ( 16 | -- * Monad to restrict target records. 17 | Restrict, RestrictedStatement, 18 | extract 19 | ) where 20 | 21 | import Database.Relational.Internal.ContextType (Flat) 22 | import Database.Relational.Internal.Config (Config) 23 | import Database.Relational.Typed.Record (Predicate, Record) 24 | 25 | import Database.Relational.Monad.Trans.Restricting 26 | (Restrictings, extractRestrict) 27 | import Database.Relational.Monad.BaseType (ConfigureQuery, configureQuery) 28 | 29 | 30 | -- | Restrict only monad type used from update statement and delete statement. 31 | type Restrict = Restrictings Flat ConfigureQuery 32 | 33 | -- | RestrictedStatement type synonym. 34 | -- Record type 'r' must be 35 | -- the same as 'Restrictings' type parameter 'r'. 36 | type RestrictedStatement r a = Record Flat r -> Restrict a 37 | 38 | -- | Run 'Restrict' to get 'QueryRestriction'. 39 | extract :: Restrict a -> Config -> (a, [Predicate Flat]) 40 | extract = configureQuery . extractRestrict 41 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Monad/Trans/Config.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | 3 | -- | 4 | -- Module : Database.Relational.Monad.Trans.Config 5 | -- Copyright : 2013-2017 Kei Hibino 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : ex8k.hibino@gmail.com 9 | -- Stability : experimental 10 | -- Portability : unknown 11 | -- 12 | -- This module defines monad transformer which requires query generate configuration. 13 | module Database.Relational.Monad.Trans.Config ( 14 | -- * Transformer into query with configuration 15 | QueryConfig, queryConfig, 16 | runQueryConfig, askQueryConfig 17 | ) where 18 | 19 | import Control.Monad.Trans.Class (lift) 20 | import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask) 21 | import Control.Applicative (Applicative) 22 | 23 | import Database.Relational.Internal.Config (Config) 24 | 25 | 26 | -- | 'ReaderT' type to require query generate configuration. 27 | newtype QueryConfig m a = 28 | QueryConfig (ReaderT Config m a) 29 | deriving (Monad, Functor, Applicative) 30 | 31 | -- | Run 'QueryConfig' to expand with configuration 32 | runQueryConfig :: QueryConfig m a -> Config -> m a 33 | runQueryConfig (QueryConfig r) = runReaderT r 34 | 35 | -- | Lift to 'QueryConfig'. 36 | queryConfig :: Monad m => m a -> QueryConfig m a 37 | queryConfig = QueryConfig . lift 38 | 39 | -- | Read configuration. 40 | askQueryConfig :: Monad m => QueryConfig m Config 41 | askQueryConfig = QueryConfig ask 42 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Monad/Type.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Monad.Type 3 | -- Copyright : 2013-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module defines core query type. 11 | module Database.Relational.Monad.Type 12 | ( -- * Core query monad 13 | QueryCore, extractCore, 14 | OrderedQuery, 15 | ) where 16 | 17 | import Database.Relational.Internal.ContextType (Flat) 18 | import Database.Relational.SqlSyntax (Duplication, JoinProduct) 19 | import Database.Relational.Typed.Record (Record, Predicate) 20 | 21 | import Database.Relational.Projectable (PlaceHolders) 22 | import Database.Relational.Monad.BaseType (ConfigureQuery) 23 | import Database.Relational.Monad.Trans.Join (QueryJoin, extractProduct) 24 | import Database.Relational.Monad.Trans.Restricting (Restrictings, extractRestrict) 25 | import Database.Relational.Monad.Trans.Ordering (Orderings) 26 | 27 | 28 | -- | Core query monad type used from flat(not-aggregated) query and aggregated query. 29 | type QueryCore = Restrictings Flat (QueryJoin ConfigureQuery) 30 | 31 | -- | Extract 'QueryCore' computation. 32 | extractCore :: QueryCore a 33 | -> ConfigureQuery (((a, [Predicate Flat]), JoinProduct), Duplication) 34 | extractCore = extractProduct . extractRestrict 35 | 36 | -- | OrderedQuery monad type with placeholder type 'p'. Record must be the same as 'Orderings' context type parameter 'c'. 37 | type OrderedQuery c m p r = Orderings c m (PlaceHolders p, Record c r) 38 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/NonStandard/PureTimestampTZ.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | 4 | module Database.Relational.NonStandard.PureTimestampTZ () where 5 | 6 | import Control.Applicative (pure) 7 | import Data.Time (UTCTime, ZonedTime) 8 | 9 | import Language.SQL.Keyword (Keyword (..)) 10 | 11 | import qualified Database.Relational.Internal.Literal as Lit 12 | 13 | import Database.Relational.ProjectableClass (LiteralSQL (..)) 14 | 15 | 16 | -- | Constant SQL terms of 'ZonedTime'. 17 | -- This generates ***NOT STANDARD*** SQL of TIMESTAMPTZ literal. 18 | instance LiteralSQL ZonedTime where 19 | showLiteral' = pure . Lit.timestamp TIMESTAMPTZ "%Y-%m-%d %H:%M:%S%z" 20 | 21 | -- | Constant SQL terms of 'UTCTime'. 22 | -- This generates ***NOT STANDARD*** SQL of TIMESTAMPTZ literal with UTC timezone. 23 | instance LiteralSQL UTCTime where 24 | showLiteral' = pure . Lit.timestamp TIMESTAMPTZ "%Y-%m-%d %H:%M:%S%z" 25 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/OverloadedInstances.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | 3 | {-# LANGUAGE CPP #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE MultiParamTypeClasses #-} 6 | {-# LANGUAGE FlexibleInstances #-} 7 | {-# LANGUAGE ScopedTypeVariables #-} 8 | {-# LANGUAGE DataKinds #-} 9 | 10 | -- | 11 | -- Module : Database.Relational.OverloadedInstances 12 | -- Copyright : 2017 Kei Hibino 13 | -- License : BSD3 14 | -- 15 | -- Maintainer : ex8k.hibino@gmail.com 16 | -- Stability : experimental 17 | -- Portability : unknown 18 | -- 19 | -- This module provides basic instances of overloaded projections like tuples.. 20 | module Database.Relational.OverloadedInstances () where 21 | 22 | import Control.Applicative ((<$>)) 23 | #if __GLASGOW_HASKELL__ >= 800 24 | import Database.Relational.OverloadedProjection (projection) 25 | #endif 26 | import Database.Relational.InternalTH.Overloaded (tupleProjection) 27 | 28 | 29 | $(concat <$> mapM tupleProjection [2 .. 7]) 30 | -- Generic instances of tuple types are generated from 2 to 7 in GHC.Generics. 31 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Pi.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Pi 3 | -- Copyright : 2013-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module defines typed projection path objects. 11 | -- Contains normal interfaces. 12 | module Database.Relational.Pi ( 13 | -- * Projection path 14 | Pi, (<.>), (), (), 15 | 16 | id', 17 | 18 | -- * Low-level API 19 | expandIndexes', expandIndexes, 20 | ) where 21 | 22 | import qualified Control.Category as Category 23 | 24 | import Database.Relational.Pi.Unsafe 25 | (Pi, (<.>), (), (), expandIndexes', expandIndexes) 26 | 27 | 28 | -- | Identity projection path. 29 | id' :: Pi a a 30 | id' = Category.id 31 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Projectable/Unsafe.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Projectable.Unsafe 3 | -- Copyright : 2017-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module provides unsafe interfaces between projected terms and SQL terms. 11 | module Database.Relational.Projectable.Unsafe ( 12 | SqlContext (..), OperatorContext, AggregatedContext, 13 | PlaceHolders (..) 14 | ) where 15 | 16 | import Database.Relational.Internal.String (StringSQL) 17 | import Database.Relational.Typed.Record (Record) 18 | 19 | -- | Interface to project SQL terms unsafely. 20 | class SqlContext c where 21 | -- | Unsafely project from SQL expression terms. 22 | unsafeProjectSqlTerms :: [StringSQL] 23 | -> Record c t 24 | 25 | -- | Constraint to restrict context of full SQL expressions. 26 | -- For example, the expression at the left of OVER clause 27 | -- is not allowed using full SQL expression. 28 | class SqlContext c => OperatorContext c 29 | 30 | -- | Constraint to restrict context of aggregated SQL context. 31 | class AggregatedContext ac 32 | 33 | 34 | -- | Placeholder parameter type which has real parameter type argument 'p'. 35 | data PlaceHolders p = PlaceHolders 36 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/PureUTF8.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | 3 | -- | 4 | -- Module : Database.Relational.PureUTF8 5 | -- Copyright : 2013-2019 Kei Hibino 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : ex8k.hibino@gmail.com 9 | -- Stability : experimental 10 | -- Portability : unknown 11 | -- 12 | -- This module defines instances to lift from haskell UTF8 byte-sequence 13 | -- to query internal record values. 14 | -- This module is not defaultly imported to be selectable instance of byte-sequences. 15 | module Database.Relational.PureUTF8 () where 16 | 17 | import Control.Applicative (pure) 18 | import Data.ByteString (ByteString) 19 | import qualified Data.ByteString.Lazy as LB 20 | import qualified Data.Text as T 21 | import qualified Data.Text.Encoding as T 22 | import qualified Data.Text.Lazy as LT 23 | import qualified Data.Text.Lazy.Encoding as LT 24 | 25 | import qualified Database.Relational.Internal.Literal as Lit 26 | 27 | import Database.Relational.ProjectableClass (LiteralSQL (..)) 28 | 29 | 30 | -- | Constant SQL terms of 'ByteString'. 31 | instance LiteralSQL ByteString where 32 | showLiteral' = pure . Lit.stringExpr . T.unpack . T.decodeUtf8 33 | 34 | -- | Constant SQL terms of 'LB.ByteString'. 35 | instance LiteralSQL LB.ByteString where 36 | showLiteral' = pure . Lit.stringExpr . LT.unpack . LT.decodeUtf8 37 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Scalar.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | 4 | -- | 5 | -- Module : Database.Relational.Scalar 6 | -- Copyright : 2013-2017 Kei Hibino 7 | -- License : BSD3 8 | -- 9 | -- Maintainer : ex8k.hibino@gmail.com 10 | -- Stability : experimental 11 | -- Portability : unknown 12 | -- 13 | -- This module defines type classes and templates for scalar queries. 14 | module Database.Relational.Scalar ( 15 | -- * Single degree constraint 16 | ScalarDegree, defineScalarDegree 17 | ) where 18 | 19 | import Language.Haskell.TH (Q, TypeQ, Dec) 20 | 21 | import Database.Record (PersistableWidth) 22 | 23 | 24 | -- | Constraint which represents scalar degree. 25 | class PersistableWidth ct => ScalarDegree ct 26 | 27 | instance ScalarDegree ct => ScalarDegree (Maybe ct) 28 | 29 | -- | 'ScalarDegree' instance templates. 30 | defineScalarDegree :: TypeQ -> Q [Dec] 31 | defineScalarDegree typeCon = do 32 | [d| instance ScalarDegree $(typeCon) |] 33 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/SqlSyntax.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.SqlSyntax 3 | -- Copyright : 2017-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module is integrated module of sql-syntax. 11 | module Database.Relational.SqlSyntax ( 12 | module Database.Relational.SqlSyntax.Types, 13 | module Database.Relational.SqlSyntax.Join, 14 | module Database.Relational.SqlSyntax.Aggregate, 15 | module Database.Relational.SqlSyntax.Query, 16 | module Database.Relational.SqlSyntax.Fold, 17 | module Database.Relational.SqlSyntax.Updates, 18 | ) where 19 | 20 | import Database.Relational.SqlSyntax.Types 21 | import Database.Relational.SqlSyntax.Join (growProduct, restrictProduct, ) 22 | import Database.Relational.SqlSyntax.Aggregate 23 | import Database.Relational.SqlSyntax.Query 24 | import Database.Relational.SqlSyntax.Fold 25 | import Database.Relational.SqlSyntax.Updates 26 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Table.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Table 3 | -- Copyright : 2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- This module defines interfaces about table metadata type. 11 | module Database.Relational.Table ( 12 | -- * Phantom typed table type 13 | Table, untype, tableName, shortName, width, tableColumns, index, table, 14 | 15 | -- * Table existence inference 16 | TableDerivable (..), 17 | 18 | -- * Deprecated 19 | name, columns, 20 | recordWidth, toSubQuery, toMaybe, 21 | ) where 22 | 23 | 24 | import Database.Relational.Typed.Table 25 | (Table, untype, tableName, shortName, width, tableColumns, index, table, 26 | TableDerivable (..),) 27 | 28 | -- required from deprecated definitions 29 | import Database.Record.Persistable (PersistableRecordWidth) 30 | import Database.Relational.Internal.String (showStringSQL) 31 | import Database.Relational.SqlSyntax (SubQuery) 32 | import Database.Relational.Typed.Table 33 | (name, columns,) 34 | import qualified Database.Relational.Typed.Table as Typed 35 | 36 | {-# DEPRECATED 37 | recordWidth, toSubQuery, toMaybe 38 | "low-level API, will be dropped in the future." #-} 39 | recordWidth :: Table r -> PersistableRecordWidth r 40 | recordWidth = Typed.recordWidth 41 | 42 | toSubQuery :: Table r -> SubQuery 43 | toSubQuery = Typed.toSubQuery 44 | 45 | toMaybe :: Table r -> Table (Maybe r) 46 | toMaybe t = table (tableName t) (map showStringSQL $ tableColumns t) 47 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/TupleInstances.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE ScopedTypeVariables #-} 6 | 7 | -- | 8 | -- Module : Database.Relational.TupleInstances 9 | -- Copyright : 2017 Kei Hibino 10 | -- License : BSD3 11 | -- 12 | -- Maintainer : ex8k.hibino@gmail.com 13 | -- Stability : experimental 14 | -- Portability : unknown 15 | -- 16 | -- This module defines ProductConstructor instances and projection path objects of tuple types. 17 | module Database.Relational.TupleInstances where 18 | 19 | import Control.Applicative ((<$>)) 20 | 21 | import Database.Record (PersistableWidth) 22 | 23 | import Database.Relational.Pi (Pi) 24 | import Database.Relational.InternalTH.Base 25 | (defineTuplePi, defineTupleShowLiteralInstance,) 26 | 27 | 28 | $(concat <$> mapM defineTuplePi [2..7]) 29 | $(concat <$> mapM defineTupleShowLiteralInstance [2..7]) 30 | -- Generic instances of tuple types are generated from 2 to 7 in GHC.Generics. 31 | 32 | -- | Projection path for fst of tuple. 33 | fst' :: (PersistableWidth a, PersistableWidth b) => Pi (a, b) a 34 | fst' = tuplePi2_0' 35 | 36 | -- | Projection path for snd of tuple. 37 | snd' :: (PersistableWidth a, PersistableWidth b) => Pi (a, b) b 38 | snd' = tuplePi2_1' 39 | -------------------------------------------------------------------------------- /relational-query/src/Database/Relational/Type.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Type 2 | {-# DEPRECATED "import from Database.Relational" #-} ( 3 | module Database.Relational.SQL, 4 | ) where 5 | 6 | import Database.Relational.SQL 7 | -------------------------------------------------------------------------------- /relational-query/test/Conflict.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | {-# LANGUAGE DataKinds #-} 7 | 8 | module Conflict where 9 | 10 | import GHC.Generics (Generic) 11 | import Data.Int (Int32) 12 | 13 | import Database.Relational (defaultConfig) 14 | import Database.Relational.TH (defineTable) 15 | 16 | 17 | -- column name conflict with Model.conflictA 18 | $(defineTable defaultConfig "TEST" "conflict_b" 19 | [ ("foo" , [t| Int32 |]) 20 | , ("bar" , [t| String |]) 21 | , ("baz" , [t| Int32 |]) ] 22 | [''Generic] [0] $ Just 0) 23 | -------------------------------------------------------------------------------- /relational-query/test/Export.hs: -------------------------------------------------------------------------------- 1 | module Export where 2 | 3 | import Data.Functor.ProductIsomorphic (pureP, (|$|), (|*|)) 4 | import Data.Int (Int32) 5 | 6 | import Model 7 | 8 | import Database.Relational 9 | 10 | 11 | onX :: Relation () (Maybe SetA, SetB) 12 | onX = relation $ do 13 | a <- queryMaybe setA 14 | b <- query setB 15 | on $ a ?! intA0' .=. just (b ! intB0') 16 | return $ (,) |$| a |*| b 17 | 18 | assignX :: Update () 19 | assignX = update $ \_proj -> do 20 | intA0' <-# value (0 :: Int32) 21 | return $ pureP () 22 | 23 | registerX :: Insert (String, Maybe String) 24 | registerX = insertValue $ do 25 | intC0' <-# value 1 26 | (ph1, ()) <- placeholder (\ph' -> strC1' <-# ph') 27 | intC2' <-# value 2 28 | (ph2, ()) <- placeholder (\ph' -> mayStrC3' <-# ph') 29 | return $ (,) |$| ph1 |*| ph2 30 | 31 | setAFromB :: Pi SetB SetA 32 | setAFromB = SetA |$| intB0' |*| strB2' |*| strB2' 33 | 34 | insertQueryX :: InsertQuery () 35 | insertQueryX = insertQuery setAFromB setA 36 | 37 | deleteX :: Delete () 38 | deleteX = delete $ \proj -> do 39 | wheres $ proj ! strA1' .=. value "A" 40 | return $ pureP () 41 | -------------------------------------------------------------------------------- /relational-query/test/exportsEq.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | import Test.QuickCheck.Simple (Test, eqTest, defaultMain) 4 | 5 | import Export (onX, assignX, registerX, insertQueryX, deleteX) 6 | 7 | import qualified Data.ByteString.Char8 as B 8 | import Data.ByteString.Short (ShortByteString, fromShort) 9 | 10 | import Database.Relational (relationalQuery) 11 | import Database.Relational.Export 12 | (inlineQuery_, inlineUpdate_, inlineInsertValue_, inlineInsertQuery_, inlineDelete_) 13 | 14 | 15 | $(inlineQuery_ 16 | (const $ return ()) 17 | (relationalQuery onX) 18 | "inlineOnX") 19 | 20 | $(inlineUpdate_ 21 | (const $ return ()) 22 | assignX 23 | "inlineAssignX") 24 | 25 | $(inlineInsertValue_ 26 | (const $ return ()) 27 | registerX 28 | "inlineRegisterX") 29 | 30 | $(inlineInsertQuery_ 31 | (const $ return ()) 32 | insertQueryX 33 | "inlineInsertQueryX") 34 | 35 | $(inlineDelete_ 36 | (const $ return ()) 37 | deleteX 38 | "inlineDeleteX") 39 | 40 | eqInline :: Show a => String -> ShortByteString -> a -> Test 41 | eqInline name inline orig = eqTest name (B.unpack $ fromShort inline) (show orig) 42 | 43 | tests :: [Test] 44 | tests = 45 | [ eqInline "onX" inlineOnX onX 46 | , eqInline "assignX" inlineAssignX assignX 47 | , eqInline "registerX" inlineRegisterX registerX 48 | , eqInline "insertQueryX" inlineInsertQueryX insertQueryX 49 | , eqInline "deleteX" inlineDeleteX deleteX 50 | ] 51 | 52 | main :: IO () 53 | main = defaultMain tests 54 | -------------------------------------------------------------------------------- /relational-record-examples/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /relational-record-examples/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Account.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Account where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | 7 | $(defineTable "examples.db" "account") 8 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Branch.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Branch where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | 7 | $(defineTable "examples.db" "branch") 8 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Business.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Business where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | 7 | $(defineTable "examples.db" "business") 8 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Customer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Customer where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | 7 | $(defineTable "examples.db" "customer") 8 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Department.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Department where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | 7 | $(defineTable "examples.db" "department") 8 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Employee.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Employee where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | 7 | $(defineTable "examples.db" "employee") 8 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Individual.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Individual where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | 7 | $(defineTable "examples.db" "individual") 8 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Officer.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Officer where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | 7 | $(defineTable "examples.db" "officer") 8 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Product.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Product where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | import Prelude hiding (product) 7 | 8 | $(defineTable "examples.db" "product") 9 | -------------------------------------------------------------------------------- /relational-record-examples/entity/ProductType.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module ProductType where 4 | 5 | import Database.Record.TH.SQLite3 (defineTable) 6 | 7 | $(defineTable "examples.db" "product_type") 8 | -------------------------------------------------------------------------------- /relational-record-examples/entity/Transaction.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric, DataKinds #-} 2 | 3 | module Transaction where 4 | 5 | import Database.Relational (Relation) 6 | import Database.Record.TH.SQLite3 (defineTable) 7 | 8 | $(defineTable "examples.db" "transaction0") 9 | 10 | type Transaction = Transaction0 11 | 12 | transaction :: Relation () Transaction 13 | transaction = transaction0 14 | -------------------------------------------------------------------------------- /relational-record-examples/examples.db: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/khibino/haskell-relational-record/28056707123ac19815843dbe97f6375ab9f67ade/relational-record-examples/examples.db -------------------------------------------------------------------------------- /relational-record-examples/lib/Database/Record/TH/SQLite3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Database.Record.TH.SQLite3 ( 4 | defineTable, 5 | ) where 6 | 7 | import GHC.Generics (Generic) 8 | import Database.Relational.HDBC.TH (defineTableFromDB) 9 | import Database.Schema.HDBC.Driver (typeMap) 10 | import Database.Schema.HDBC.SQLite3 (driverSQLite3) 11 | import Database.HDBC.Sqlite3 (connectSqlite3) 12 | import Language.Haskell.TH (Q, Dec) 13 | 14 | defineTable :: FilePath -> String -> Q [Dec] 15 | defineTable fileName tableName = 16 | defineTableFromDB 17 | (connectSqlite3 fileName) 18 | (drv { typeMap = [("FLOAT", [t|Double|]), ("INTEGER", [t|Int|])] -- overwrite the default type map with yours 19 | }) 20 | "main" -- schema name, ignored by SQLite 21 | tableName 22 | [''Show, ''Generic] 23 | where drv = driverSQLite3 24 | -------------------------------------------------------------------------------- /relational-record-examples/lib/Database/Relational/CustomSQLite3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module Database.Relational.CustomSQLite3 ( 4 | module Database.HDBC, 5 | module Database.Relational.HDBC.TH, 6 | module Database.Relational.HDBC, 7 | module Database.HDBC.Session, 8 | module Database.HDBC.Sqlite3, 9 | module Database.Record, 10 | module Database.Custom.SQLite3, 11 | 12 | runRelation, 13 | makeRelationalRecord, 14 | ) where 15 | 16 | import Language.Haskell.TH (Name, Q, Dec) 17 | 18 | import Database.HDBC hiding (execute, finish, run) 19 | import Database.Relational.HDBC.TH hiding (makeRelationalRecord) 20 | import Database.Relational.HDBC hiding (execute, finish) 21 | import Database.HDBC.Session 22 | import Database.HDBC.Sqlite3 23 | import Database.Record hiding (unique) 24 | import Database.Custom.SQLite3 25 | 26 | runRelation :: (ToSql SqlValue p, 27 | IConnection conn, 28 | FromSql SqlValue a) => 29 | conn -> Relation p a -> p -> IO [a] 30 | runRelation conn q p = runQuery conn (relationalQuery q []) p 31 | 32 | makeRelationalRecord :: Name -> Q [Dec] 33 | makeRelationalRecord = makeRelationalRecord' defaultConfig 34 | -------------------------------------------------------------------------------- /relational-record-examples/orf/DataSource.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module DataSource ( 4 | connect, convTypes, defineTable 5 | ) where 6 | 7 | import Data.Time (Day, LocalTime) 8 | import Database.HDBC.Query.TH (defineTableFromDB) 9 | import Database.HDBC.Schema.Driver (typeMap) 10 | import Database.HDBC.Schema.SQLite3 (driverSQLite3) 11 | import Database.HDBC.Sqlite3 (Connection, connectSqlite3) 12 | import Database.Record.TH (derivingShow) 13 | import Language.Haskell.TH (Q, Dec, TypeQ) 14 | import Language.Haskell.TH.Name.CamelCase (ConName) 15 | 16 | connect :: IO Connection 17 | connect = connectSqlite3 "examples.db" 18 | 19 | convTypes :: [(String, TypeQ)] 20 | convTypes = 21 | [ ("float", [t|Double|]) 22 | , ("date", [t|Day|]) 23 | , ("datetime", [t|LocalTime|]) 24 | , ("double", [t|Double|]) 25 | , ("varchar", [t|String|]) 26 | ] 27 | 28 | defineTable :: String -> Q [Dec] 29 | defineTable tableName = 30 | defineTableFromDB 31 | connect 32 | (driverSQLite3 { typeMap = convTypes }) -- overwrite the default type map with yours 33 | "main" -- schema name, ignored by SQLite 34 | tableName 35 | [derivingShow] 36 | -------------------------------------------------------------------------------- /relational-record-examples/orf/Mixed.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Mixed where 4 | 5 | import DataSource (defineTable) 6 | 7 | $(defineTable "person") 8 | $(defineTable "product") 9 | -------------------------------------------------------------------------------- /relational-record-examples/orf/Person.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Person where 4 | 5 | import DataSource (defineTable) 6 | 7 | $(defineTable "person") 8 | -------------------------------------------------------------------------------- /relational-record-examples/orf/Product.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} 2 | 3 | module Product where 4 | 5 | import DataSource (defineTable) 6 | import Prelude hiding (product) 7 | 8 | $(defineTable "product") 9 | 10 | -------------------------------------------------------------------------------- /relational-record-examples/orf/create.sql: -------------------------------------------------------------------------------- 1 | /* 2 | % sqlite3 examples.db < create.sql 3 | */ 4 | 5 | /* begin table creation */ 6 | 7 | create table person 8 | (id integer primary key autoincrement not null, 9 | name varchar(20) not null 10 | ); 11 | 12 | create table product 13 | (id integer primary key autoincrement not null, 14 | name varchar(20) not null 15 | ); 16 | -------------------------------------------------------------------------------- /relational-record-examples/sql/3.7.1.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Descending sort order 4 | 5 | sqlite3 examples.db " 6 | SELECT account_id, product_cd, open_date, avail_balance 7 | FROM account 8 | ORDER BY avail_balance DESC 9 | ;" 10 | -------------------------------------------------------------------------------- /relational-record-examples/sql/3.7.3.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Sorting via numeric placeholders 4 | 5 | sqlite3 examples.db " 6 | SELECT emp_id, title, start_date, fname, lname 7 | FROM employee 8 | ORDER BY 2,5 9 | ;" 10 | -------------------------------------------------------------------------------- /relational-record-examples/sql/3.7.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # The order by clause 4 | 5 | sqlite3 examples.db " 6 | SELECT open_emp_id, product_cd 7 | FROM account 8 | ORDER BY open_emp_id, product_cd 9 | ;" 10 | -------------------------------------------------------------------------------- /relational-record-examples/sql/4.1.2.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Using the not operator 4 | 5 | sqlite3 examples.db " 6 | SELECT * 7 | FROM employee 8 | WHERE end_date IS NULL AND (title = 'Teller' OR start_date < '2003-01-01') 9 | ;" 10 | -------------------------------------------------------------------------------- /relational-record-examples/sql/4.3.2.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Range condition with the between operator 4 | 5 | sqlite3 examples.db " 6 | SELECT emp_id, fname, lname, start_date FROM employee 7 | WHERE start_date 8 | BETWEEN date('2001-01-01') AND date('2002-12-31') 9 | ;" 10 | -------------------------------------------------------------------------------- /relational-record-examples/sql/4.3.3a.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Membership conditions 4 | 5 | sqlite3 examples.db " 6 | SELECT account_id, product_cd, cust_id, avail_balance 7 | FROM account 8 | WHERE product_cd IN ('CHK', 'SAV', 'CD', 'MM') 9 | ;" 10 | -------------------------------------------------------------------------------- /relational-record-examples/sql/4.3.3b.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Membership conditions using subqueries 4 | 5 | sqlite3 examples.db " 6 | SELECT account_id, product_cd, cust_id, avail_balance 7 | FROM account 8 | WHERE product_cd IN (SELECT product_cd FROM product 9 | WHERE product_type_cd = 'ACCOUNT') 10 | ;" 11 | 12 | -------------------------------------------------------------------------------- /relational-record-examples/sql/4.3.3c.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Membership conditions using not in 4 | 5 | sqlite3 examples.db " 6 | SELECT account_id, product_cd, cust_id, avail_balance 7 | FROM account 8 | WHERE product_cd NOT IN ('CHK', 'SAV', 'CD', 'MM') 9 | ;" 10 | 11 | -------------------------------------------------------------------------------- /relational-record-examples/sql/5.1.2a.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Inner join 4 | 5 | sqlite3 examples.db " 6 | SELECT e.fname, e.lname, d.name 7 | FROM employee e INNER JOIN department d 8 | USING (dept_id) 9 | ;" 10 | -------------------------------------------------------------------------------- /relational-record-examples/sql/5.1.3.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Complex join 4 | 5 | sqlite3 examples.db " 6 | SELECT a.account_id, a.cust_id, a.open_date, a.product_cd 7 | FROM account a INNER JOIN employee e ON a.open_emp_id = e.emp_id 8 | INNER JOIN branch b ON e.assigned_branch_id = b.branch_id 9 | WHERE e.start_date <= date('2004-01-01') AND 10 | (e.title = 'Teller' OR e.title = 'Head Teller') AND 11 | b.name = 'Woburn Branch' 12 | ;" 13 | -------------------------------------------------------------------------------- /relational-record-examples/sql/5.3a.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Self-join 4 | 5 | sqlite3 examples.db " 6 | SELECT e.fname, e.lname, e_mgr.fname mgr_fname, e_mgr.lname mgr_lname 7 | FROM employee e INNER JOIN employee e_mgr 8 | ON e.superior_emp_id = e_mgr.emp_id 9 | ;" 10 | -------------------------------------------------------------------------------- /relational-record-examples/sql/6.4.1a.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | #Sorting compound query results 4 | 5 | sqlite3 examples.db " 6 | SELECT emp_id, assigned_branch_id 7 | FROM employee 8 | WHERE title = 'Teller' 9 | UNION 10 | SELECT open_emp_id, open_branch_id 11 | FROM account 12 | WHERE product_cd = 'SAV' 13 | ORDER BY emp_id 14 | ;" 15 | -------------------------------------------------------------------------------- /relational-record-examples/sql/8.1a.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # Grouping 4 | 5 | sqlite3 examples.db " 6 | SELECT open_emp_id, COUNT(*) how_many 7 | FROM account 8 | GROUP BY open_emp_id 9 | ORDER BY open_emp_id 10 | ;" 11 | -------------------------------------------------------------------------------- /relational-record/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /relational-record/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /relational-record/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /relational-schemas/ChangeLog.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | ## 0.1.8.1 4 | 5 | - fix typo. 6 | 7 | ## 0.1.8.0 8 | 9 | - update for GHC 8.8.x. 10 | - allow more type-categories of PostgreSQL. 11 | 12 | ## 0.1.7.0 13 | 14 | - adjust sub-directory modules of each DBMS to top module name. 15 | - enable addModifyTableAliasAS flag of SQLite3 configuration. 16 | - add custom API modules for each DBMS with appropriate configuration. 17 | 18 | ## 0.1.6.2 19 | 20 | - update tested-with. 21 | 22 | ## 0.1.6.1 23 | 24 | - update version constraint. ( along with re-versioned relational-query. ) 25 | 26 | ## 0.1.6.0 27 | 28 | - apply projections with overloaded-labels to schema tables. 29 | 30 | ## 0.1.5.0 31 | 32 | - apply relational-query-0.10.0 33 | 34 | ## 0.1.4.1 35 | 36 | - apply relational-query-0.9.5 37 | 38 | ## 0.1.4.0 39 | 40 | - add tested-with 8.2.1. 41 | - switch 3rd number of version to separate from no-generic version. 42 | 43 | ## 0.1.3.3 44 | 45 | - Use Haskell implementation test instead of flag test in .cabal 46 | 47 | ## 0.1.3.2 48 | 49 | - Apply generic instances to schema queries. 50 | - Drop unused implicit imports. 51 | 52 | ## 0.1.3.1 53 | 54 | - Add tested-with. 55 | 56 | ## 0.1.3.0 57 | 58 | - Update typeMap of SQLite3 schema. 59 | 60 | ## 0.1.2.0 61 | 62 | - Get type info of network address in PostgreSQL schema. 63 | 64 | ## 0.1.1.0 65 | 66 | - Add medium-int to typeMap of MySQL schema. 67 | -------------------------------------------------------------------------------- /relational-schemas/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /relational-schemas/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /relational-schemas/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/DB2Syscat/Columns.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.DB2Syscat.Columns 2 | {-# DEPRECATED "import Database.Relational.Schema.IBMDB2.Columns instead of this module." #-} ( 3 | module Database.Relational.Schema.IBMDB2.Columns, 4 | ) where 5 | 6 | import Database.Relational.Schema.IBMDB2.Columns 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/DB2Syscat/Config.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.DB2Syscat.Config 2 | {-# DEPRECATED "import config from Database.Relational.Schema.IBMDB2 instead of this module." #-} ( 3 | config, 4 | ) where 5 | 6 | import Database.Relational.Schema.IBMDB2.Config (config) 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/IBMDB2/Config.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Schema.IBMDB2.Config 3 | -- Copyright : 2014-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | module Database.Relational.Schema.IBMDB2.Config (config) where 10 | 11 | import Database.Relational (Config (..), ProductUnitSupport (..), defaultConfig) 12 | 13 | 14 | -- | Configuration parameter against IBM DB2. 15 | config :: Config 16 | config = defaultConfig { productUnitSupport = PUNotSupported } 17 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/IBMDB2/Keycoluse.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | -- | 8 | -- Module : Database.Relational.Schema.DB2Syscat.Keycoluse 9 | -- Copyright : 2013-2019 Kei Hibino 10 | -- License : BSD3 11 | -- 12 | -- Maintainer : ex8k.hibino@gmail.com 13 | -- Stability : experimental 14 | -- Portability : unknown 15 | -- 16 | -- Generate template of SYSCAT.keycoluse system catalog table. 17 | -- Not all columns are mapped to Haskell record. 18 | -- Minimum implementation required to generate table constraints. 19 | module Database.Relational.Schema.IBMDB2.Keycoluse where 20 | 21 | import GHC.Generics (Generic) 22 | import Data.Int (Int16) 23 | import Database.Relational.TH (defineTableTypesAndRecord) 24 | 25 | import Database.Relational.Schema.IBMDB2.Config (config) 26 | 27 | 28 | -- Not all column is mapped. Minimum implementation. 29 | $(defineTableTypesAndRecord config 30 | "SYSCAT" "keycoluse" 31 | [("constname", [t| String |]), 32 | ("colname" , [t| String |]), 33 | ("colseq" , [t| Int16 |])] 34 | [''Show, ''Generic]) 35 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/IBMDB2/Tabconst.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | -- | 8 | -- Module : Database.Relational.Schema.DB2Syscat.Tabconst 9 | -- Copyright : 2013-2019 Kei Hibino 10 | -- License : BSD3 11 | -- 12 | -- Maintainer : ex8k.hibino@gmail.com 13 | -- Stability : experimental 14 | -- Portability : unknown 15 | -- 16 | -- Generate template of SYSCAT.tabconst system catalog table. 17 | -- Not all columns are mapped to Haskell record. 18 | -- Minimum implementation required to generate table constraints. 19 | module Database.Relational.Schema.IBMDB2.Tabconst where 20 | 21 | import GHC.Generics (Generic) 22 | import Database.Relational.TH (defineTableTypesAndRecord) 23 | 24 | import Database.Relational.Schema.IBMDB2.Config (config) 25 | 26 | 27 | -- Not all column is mapped. Minimum implementation. 28 | $(defineTableTypesAndRecord config 29 | "SYSCAT" "tabconst" 30 | [("constname", [t| String |]), 31 | ("tabschema", [t| String |]), 32 | ("tabname" , [t| String |]), 33 | -- 34 | ("type" , [t| String |]), 35 | ("enforced" , [t| String |])] 36 | [''Show, ''Generic]) 37 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/MySQL/Columns.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module Database.Relational.Schema.MySQL.Columns where 8 | 9 | import GHC.Generics (Generic) 10 | import Data.Int (Int16) 11 | import Database.Relational.TH (defineTableTypesAndRecord) 12 | 13 | import Database.Relational.Schema.MySQL.Config (config) 14 | 15 | 16 | $(defineTableTypesAndRecord config 17 | "INFORMATION_SCHEMA" "columns" 18 | [ ("table_schema", [t|String|]) 19 | , ("table_name", [t|String|]) 20 | , ("column_name", [t|String|]) 21 | , ("ordinal_position", [t|Int16|]) 22 | , ("column_default", [t|Maybe String|]) 23 | , ("is_nullable", [t|String|]) 24 | , ("data_type", [t|String|]) 25 | ] 26 | [''Show, ''Generic]) 27 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/MySQL/Config.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Schema.MySQL.Config 3 | -- Copyright : 2014-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | module Database.Relational.Schema.MySQL.Config (config) where 10 | 11 | import Database.Relational (Config (..), defaultConfig) 12 | 13 | 14 | -- | Configuration parameter against MySQL. 15 | config :: Config 16 | config = defaultConfig { normalizedTableName = False } 17 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/MySQL/KeyColumnUsage.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module Database.Relational.Schema.MySQL.KeyColumnUsage where 8 | 9 | import GHC.Generics (Generic) 10 | import Data.Int (Int16) 11 | import Database.Relational.TH (defineTableTypesAndRecord) 12 | 13 | import Database.Relational.Schema.MySQL.Config (config) 14 | 15 | 16 | $(defineTableTypesAndRecord config 17 | "INFORMATION_SCHEMA" "key_column_usage" 18 | [ ("constraint_name" , [t| String |]) 19 | , ("table_schema" , [t| String |]) 20 | , ("table_name" , [t| String |]) 21 | , ("column_name" , [t| String |]) 22 | , ("ordinal_position" , [t| Int16 |]) 23 | ] 24 | [''Show, ''Generic]) 25 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/MySQL/TableConstraints.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module Database.Relational.Schema.MySQL.TableConstraints where 8 | 9 | import GHC.Generics (Generic) 10 | import Database.Relational.TH (defineTableTypesAndRecord) 11 | 12 | import Database.Relational.Schema.MySQL.Config (config) 13 | 14 | 15 | $(defineTableTypesAndRecord config 16 | "INFORMATION_SCHEMA" "table_constraints" 17 | [ ("table_schema" , [t| String |]) 18 | , ("table_name" , [t| String |]) 19 | , ("constraint_name" , [t| String |]) 20 | , ("constraint_type" , [t| String |]) 21 | ] 22 | [''Show, ''Generic]) 23 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/MySQLInfo/Columns.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.MySQLInfo.Columns 2 | {-# DEPRECATED "import Database.Relational.Schema.MySQL.Columns instead of this module." #-} ( 3 | module Database.Relational.Schema.MySQL.Columns, 4 | ) where 5 | 6 | import Database.Relational.Schema.MySQL.Columns 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/MySQLInfo/Config.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.MySQLInfo.Config 2 | {-# DEPRECATED "import config from Database.Relational.Schema.MySQL instead of this module." #-} ( 3 | config, 4 | ) where 5 | 6 | import Database.Relational.Schema.MySQL.Config (config) 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/Oracle/Config.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Schema.Oracle.Config 3 | -- Copyright : 2014-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | module Database.Relational.Schema.Oracle.Config (config) where 10 | 11 | import Database.Relational (Config, defaultConfig) 12 | 13 | 14 | -- | Configuration parameter against Oracle. 15 | config :: Config 16 | config = defaultConfig 17 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/Oracle/ConsColumns.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module Database.Relational.Schema.Oracle.ConsColumns where 8 | 9 | import GHC.Generics (Generic) 10 | import Data.Int (Int32) 11 | import Database.Relational.TH (defineTableTypesAndRecord) 12 | 13 | import Database.Relational.Schema.Oracle.Config (config) 14 | 15 | 16 | $(defineTableTypesAndRecord config 17 | "SYS" "dba_cons_columns" 18 | -- Column NULL? Datatype 19 | -- ----------------------------------------- -------- ---------------------------- 20 | -- OWNER NOT NULL VARCHAR2(30) 21 | [ ("owner", [t|String|]) 22 | -- CONSTRAINT_NAME NOT NULL VARCHAR2(30) 23 | , ("constraint_name", [t|String|]) 24 | -- TABLE_NAME NOT NULL VARCHAR2(30) 25 | , ("table_name", [t|String|]) 26 | -- COLUMN_NAME VARCHAR2(4000) 27 | , ("column_name", [t|Maybe String|]) 28 | -- POSITION NUMBER 29 | , ("position", [t|Maybe Int32|]) 30 | ] [''Show, ''Generic]) 31 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/OracleDataDictionary/Config.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.OracleDataDictionary.Config 2 | {-# DEPRECATED "import config from Database.Relational.Schema.Oracle instead of this module." #-} ( 3 | config, 4 | ) where 5 | 6 | import Database.Relational.Schema.Oracle.Config (config) 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/OracleDataDictionary/TabColumns.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.OracleDataDictionary.TabColumns 2 | {-# DEPRECATED "import Database.Relational.Schema.Oracle.TabColumns instead of this module." #-} ( 3 | module Database.Relational.Schema.Oracle.TabColumns, 4 | ) where 5 | 6 | import Database.Relational.Schema.Oracle.TabColumns 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/PgCatalog/Config.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.PgCatalog.Config 2 | {-# DEPRECATED "import config from Database.Relational.Schema.PostgreSQL instead of this module." #-} ( 3 | config, 4 | ) where 5 | 6 | import Database.Relational.Schema.PostgreSQL.Config (config) 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/PgCatalog/PgAttribute.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.PgCatalog.PgAttribute 2 | {-# DEPRECATED "import Database.Relational.Schema.PostgreSQL.PgAttribute instead of this module." #-} ( 3 | module Database.Relational.Schema.PostgreSQL.PgAttribute, 4 | ) where 5 | 6 | import Database.Relational.Schema.PostgreSQL.PgAttribute 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/PgCatalog/PgType.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.PgCatalog.PgType 2 | {-# DEPRECATED "import Database.Relational.Schema.PostgreSQL.PgType instead of this module." #-} ( 3 | module Database.Relational.Schema.PostgreSQL.PgType, 4 | ) where 5 | 6 | import Database.Relational.Schema.PostgreSQL.PgType 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/PostgreSQL/Config.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Schema.PostgreSQL.Config 3 | -- Copyright : 2014-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | module Database.Relational.Schema.PostgreSQL.Config (config) where 10 | 11 | import Database.Relational (Config, defaultConfig) 12 | 13 | 14 | -- | Configuration parameter against PostgreSQL. 15 | config :: Config 16 | config = defaultConfig 17 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/PostgreSQL/PgNamespace.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | -- | 8 | -- Module : Database.Relational.Schema.PostgreSQL.PgNamespace 9 | -- Copyright : 2013-2019 Kei Hibino 10 | -- License : BSD3 11 | -- 12 | -- Maintainer : ex8k.hibino@gmail.com 13 | -- Stability : experimental 14 | -- Portability : unknown 15 | module Database.Relational.Schema.PostgreSQL.PgNamespace where 16 | 17 | import GHC.Generics (Generic) 18 | import Data.Int (Int32) 19 | import Database.Relational.TH (defineTableTypesAndRecord) 20 | 21 | import Database.Relational.Schema.PostgreSQL.Config (config) 22 | 23 | 24 | $(defineTableTypesAndRecord config 25 | "PG_CATALOG" "pg_namespace" 26 | [("oid" , [t| Int32 |]), 27 | -- nspname | name | not null 28 | ("nspname", [t| String |]) 29 | -- nspowner | oid | not null 30 | -- nspacl | aclitem[] | 31 | ] 32 | [''Show, ''Generic]) 33 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLServer/Config.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Schema.PgCatalog.Config 3 | -- Copyright : 2014-2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | module Database.Relational.Schema.SQLServer.Config (config) where 10 | 11 | import Database.Relational (Config, defaultConfig) 12 | 13 | 14 | -- | Configuration parameter against SQLServer. 15 | config :: Config 16 | config = defaultConfig 17 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLServer/IndexColumns.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module Database.Relational.Schema.SQLServer.IndexColumns where 8 | 9 | import GHC.Generics (Generic) 10 | import Data.Int (Int32) 11 | import Database.Relational.TH (defineTableTypesAndRecord) 12 | 13 | import Database.Relational.Schema.SQLServer.Config (config) 14 | 15 | 16 | $(defineTableTypesAndRecord config 17 | "sys" "index_columns" 18 | [ 19 | -- column schema type length NULL 20 | -- --------------------- ------- ------------------- -------- ------ 21 | -- object_id sys int 4 No 22 | ("object_id", [t|Int32|]), 23 | -- index_id sys int 4 No 24 | ("index_id", [t|Int32|]), 25 | -- index_column_id sys int 4 No 26 | ("column_id", [t|Int32|]), 27 | -- key_ordinal sys tinyint 1 No 28 | ("key_ordinal", [t|Int32|]), 29 | -- partition_ordinal sys tinyint 1 No 30 | --("partition_ordinal", [t|Int32|]), 31 | -- is_descending_key sys bit 1 No 32 | --("is_descending_key", [t|Bool|]), 33 | -- is_included_column sys bit 1 No 34 | ("is_included_column", [t|Bool|]) 35 | ] 36 | [''Show, ''Generic]) 37 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLServerSyscat/Columns.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.SQLServerSyscat.Columns 2 | {-# DEPRECATED "import Database.Relational.Schema.SQLServer.Columns instead of this module." #-} ( 3 | module Database.Relational.Schema.SQLServer.Columns, 4 | ) where 5 | 6 | import Database.Relational.Schema.SQLServer.Columns 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLServerSyscat/Config.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.SQLServerSyscat.Config 2 | {-# DEPRECATED "import config from Database.Relational.Schema.SQLServer instead of this module." #-} ( 3 | module Database.Relational.Schema.SQLServer.Config, 4 | ) where 5 | 6 | import Database.Relational.Schema.SQLServer.Config 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLServerSyscat/Types.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.SQLServerSyscat.Types 2 | {-# DEPRECATED "import Database.Relational.Schema.SQLServer.Types instead of this module." #-} ( 3 | module Database.Relational.Schema.SQLServer.Types, 4 | ) where 5 | 6 | import Database.Relational.Schema.SQLServer.Types 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLite3/Config.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Database.Relational.Schema.SQLite3.Config 3 | -- Copyright : 2019 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | module Database.Relational.Schema.SQLite3.Config (config) where 10 | 11 | import Database.Relational (Config (addModifyTableAliasAS), defaultConfig) 12 | 13 | 14 | -- | Configuration parameter against SQLite3. 15 | config :: Config 16 | config = defaultConfig { addModifyTableAliasAS = True } 17 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLite3/IndexInfo.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module Database.Relational.Schema.SQLite3.IndexInfo where 8 | 9 | import GHC.Generics (Generic) 10 | import Data.Int (Int64) 11 | import Database.Relational.TH (defineTableTypesAndRecord) 12 | 13 | import Database.Relational.Schema.SQLite3.Config (config) 14 | 15 | 16 | $(defineTableTypesAndRecord config 17 | "pragma" "index_info" 18 | [ 19 | -- pragma "index_info" 20 | -- column type NULL 21 | -- --------------------- ------------------- ------ 22 | -- seqno integer No 23 | ("seqno", [t|Int64|]), 24 | -- cid integer No 25 | ("cid", [t|Int64|]), 26 | -- name text No 27 | ("name", [t|String|]) 28 | ] 29 | [''Show, ''Generic]) 30 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLite3/IndexList.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module Database.Relational.Schema.SQLite3.IndexList where 8 | 9 | import GHC.Generics (Generic) 10 | import Data.Int (Int64) 11 | import Database.Relational.TH (defineTableTypesAndRecord) 12 | 13 | import Database.Relational.Schema.SQLite3.Config (config) 14 | 15 | 16 | $(defineTableTypesAndRecord config 17 | "pragma" "index_list" 18 | [ 19 | -- pragma "main.index_list" 20 | -- column type NULL 21 | -- --------------------- ------------------- ------ 22 | -- seq integer No 23 | ("seq", [t|Int64|]), 24 | -- name text No 25 | ("name", [t|String|]), 26 | -- unique integer No 27 | ("unique", [t|Int64|]) 28 | ] 29 | [''Show, ''Generic]) 30 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLite3/TableInfo.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE DataKinds #-} 5 | {-# LANGUAGE DeriveGeneric #-} 6 | 7 | module Database.Relational.Schema.SQLite3.TableInfo where 8 | 9 | import GHC.Generics (Generic) 10 | import Data.Int (Int16, Int64) 11 | import Database.Relational.TH (defineTableTypesAndRecord) 12 | 13 | import Database.Relational.Schema.SQLite3.Config (config) 14 | 15 | 16 | $(defineTableTypesAndRecord config 17 | "pragma" "table_info" 18 | [ 19 | -- View "main.sqlite_master" 20 | -- column type NULL 21 | -- --------------------- ------------------- ------ 22 | -- cid integer No 23 | ("cid", [t|Int64|]), 24 | -- name text No 25 | ("name", [t|String|]), 26 | -- type text No 27 | ("ctype", [t|String|]), 28 | -- notnull integer No 29 | ("notnull", [t|Int16|]), 30 | -- dflt_value - Yes 31 | ("dflt_value", [t|Maybe String|]), 32 | -- pk integer No 33 | ("pk", [t|Int16|]) 34 | ] 35 | [''Show, ''Generic]) 36 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLite3Syscat/Config.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.SQLite3Syscat.Config 2 | {-# DEPRECATED "import config from Database.Relational.Schema.SQLite3 instead of this module." #-} ( 3 | module Database.Relational.Schema.SQLite3.Config, 4 | ) where 5 | 6 | import Database.Relational.Schema.SQLite3.Config 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLite3Syscat/IndexInfo.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.SQLite3Syscat.IndexInfo 2 | {-# DEPRECATED "import Database.Relational.Schema.SQLite3.IndexInfo instead of this module." #-} ( 3 | module Database.Relational.Schema.SQLite3.IndexInfo, 4 | ) where 5 | 6 | import Database.Relational.Schema.SQLite3.IndexInfo 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLite3Syscat/IndexList.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.SQLite3Syscat.IndexList 2 | {-# DEPRECATED "import Database.Relational.Schema.SQLite3.IndexList instead of this module." #-} ( 3 | module Database.Relational.Schema.SQLite3.IndexList, 4 | ) where 5 | 6 | import Database.Relational.Schema.SQLite3.IndexList 7 | -------------------------------------------------------------------------------- /relational-schemas/src/Database/Relational/Schema/SQLite3Syscat/TableInfo.hs: -------------------------------------------------------------------------------- 1 | module Database.Relational.Schema.SQLite3Syscat.TableInfo 2 | {-# DEPRECATED "import Database.Relational.Schema.SQLite3.TableInfo instead of this module." #-} ( 3 | module Database.Relational.Schema.SQLite3.TableInfo, 4 | ) where 5 | 6 | import Database.Relational.Schema.SQLite3.TableInfo 7 | -------------------------------------------------------------------------------- /rr-quickcheck/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /rr-quickcheck/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /rr-quickcheck/RDBMs/MySQL/main.hs: -------------------------------------------------------------------------------- 1 | 2 | import Database.HDBC.MySQL 3 | (Connection, connectMySQL, defaultMySQLConnectInfo, MySQLConnectInfo (..)) 4 | import Test.Relational.QuickCheck.Tests 5 | import Test.QuickCheck.Simple (defaultMain) 6 | 7 | main = 8 | defaultMain . tests $ 9 | connectMySQL 10 | defaultMySQLConnectInfo 11 | { mysqlUser = "hrr-tester", mysqlDatabase = "ARBITRARY0" } 12 | -------------------------------------------------------------------------------- /rr-quickcheck/RDBMs/MySQL/schema-drop.sql: -------------------------------------------------------------------------------- 1 | DROP SCHEMA IF EXISTS ARBITRARY0; 2 | -------------------------------------------------------------------------------- /rr-quickcheck/RDBMs/MySQL/schema.sql: -------------------------------------------------------------------------------- 1 | CREATE SCHEMA ARBITRARY0; 2 | GRANT ALL ON ARBITRARY0.* TO 'hrr-tester'@'127.0.0.1'; 3 | GRANT GRANT OPTION ON ARBITRARY0.* TO 'hrr-tester'@'127.0.0.1'; 4 | -------------------------------------------------------------------------------- /rr-quickcheck/RDBMs/PostgreSQL/main.hs: -------------------------------------------------------------------------------- 1 | 2 | import Database.HDBC.PostgreSQL (connectPostgreSQL) 3 | import Test.Relational.QuickCheck.Tests (tests) 4 | import Test.QuickCheck.Simple (defaultMain) 5 | 6 | main = defaultMain . tests $ connectPostgreSQL "dbname=hrrtest" 7 | -------------------------------------------------------------------------------- /rr-quickcheck/RDBMs/PostgreSQL/schema.sql: -------------------------------------------------------------------------------- 1 | CREATE SCHEMA ARBITRARY0; 2 | -------------------------------------------------------------------------------- /rr-quickcheck/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /rr-quickcheck/sql/tables.sql: -------------------------------------------------------------------------------- 1 | CREATE TABLE ARBITRARY0.a 2 | ( a0 BIGINT NOT NULL 3 | , a1 BIGINT NOT NULL 4 | , a2 BIGINT NOT NULL 5 | ); 6 | 7 | CREATE TABLE ARBITRARY0.b 8 | ( b0 BIGINT NOT NULL 9 | , b1 BIGINT NOT NULL 10 | , b2 BIGINT NOT NULL 11 | ); 12 | -------------------------------------------------------------------------------- /rr-quickcheck/src/Test/Relational/QuickCheck/Model.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, DataKinds, DeriveGeneric #-} 2 | 3 | module Test.Relational.QuickCheck.Model ( 4 | A (..), a0', a1', a2', relA, 5 | B (..), b0', b1', b2', relB, 6 | ) where 7 | 8 | import GHC.Generics (Generic) 9 | import Data.Int (Int64) 10 | import qualified Database.Relational.Table as Table 11 | import Database.Relational (Relation, table, TableDerivable (derivedTable)) 12 | import Database.HDBC.Query.TH (makeRelationalRecord) 13 | 14 | 15 | data A = 16 | A 17 | { a0 :: Int64 18 | , a1 :: Int64 19 | , a2 :: Int64 20 | } deriving (Eq, Ord, Show, Generic) 21 | 22 | data B = 23 | B 24 | { b0 :: Int64 25 | , b1 :: Int64 26 | , b2 :: Int64 27 | } deriving (Eq, Ord, Show, Generic) 28 | 29 | 30 | $(makeRelationalRecord ''A) 31 | $(makeRelationalRecord ''B) 32 | 33 | instance TableDerivable A where 34 | derivedTable = Table.table "ARBITRARY0.A" ["a0", "a1", "a2"] 35 | 36 | relA :: Relation () A 37 | relA = table derivedTable 38 | 39 | instance TableDerivable B where 40 | derivedTable = Table.table "ARBITRARY0.B" ["b0", "b1", "b2"] 41 | 42 | relB :: Relation () B 43 | relB = table derivedTable 44 | -------------------------------------------------------------------------------- /sql-words/GNUmakefile: -------------------------------------------------------------------------------- 1 | ../devel/GNUmakefile -------------------------------------------------------------------------------- /sql-words/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013, Kei Hibino 2 | 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 met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Kei Hibino nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /sql-words/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /sql-words/src/Language/SQL/Keyword.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Language.SQL.Keyword 3 | -- Copyright : 2013 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- SQL keyword representation using Haskell data constructors. 11 | -- Integrated module. 12 | module Language.SQL.Keyword ( 13 | -- * Module which includes keyword type definition 14 | module Language.SQL.Keyword.Type, 15 | -- * Module which includes functions to concatenate keywords 16 | module Language.SQL.Keyword.Concat 17 | ) where 18 | 19 | import Language.SQL.Keyword.Type 20 | import Language.SQL.Keyword.Concat 21 | -------------------------------------------------------------------------------- /sql-words/src/Language/SQL/Keyword/Type.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Language.SQL.Keyword.Type 3 | -- Copyright : 2013 Kei Hibino 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : ex8k.hibino@gmail.com 7 | -- Stability : experimental 8 | -- Portability : unknown 9 | -- 10 | -- SQL keyword representation using Haskell data constructors. 11 | module Language.SQL.Keyword.Type ( 12 | Keyword (..), DString, 13 | 14 | word, 15 | wordShow, unwordsSQL 16 | ) where 17 | 18 | import Data.Monoid (mconcat) 19 | import Language.SQL.Keyword.Internal.Type (Keyword (..), word, wordShow, DString) 20 | 21 | 22 | -- | Concatenate keywords into 'String' like unwords 23 | unwordsSQL :: [Keyword] -> String 24 | unwordsSQL = wordShow . mconcat 25 | -------------------------------------------------------------------------------- /stack/stack.yaml.example: -------------------------------------------------------------------------------- 1 | packages: 2 | - HDBC-session/ 3 | - names-th/ 4 | - persistable-record/ 5 | - persistable-types-HDBC-pg/ 6 | - relational-query/ 7 | - relational-query-HDBC/ 8 | - relational-record/ 9 | - relational-schemas/ 10 | - sql-words/ 11 | - text-postgresql/ 12 | 13 | # - relational-record-examples/ 14 | # - examples/HDBC/MySQL/ 15 | # - examples/HDBC/Oracle/ 16 | # - examples/HDBC/PostgreSQL 17 | 18 | extra-deps: 19 | # - HDBC-odbc-2.4.0.1 20 | # - HDBC-postgresql-2.3.2.3 21 | # - HDBC-sqlite3-2.3.3.1 22 | # - quickcheck-simple-0.1.0.0 23 | resolver: lts-10 24 | -------------------------------------------------------------------------------- /test/HDBC/MySQL/DB/Source.hs: -------------------------------------------------------------------------------- 1 | module DB.Source (connect, defineTable) where 2 | 3 | import Database.HDBC.MySQL ( MySQLConnectInfo(..), defaultMySQLConnectInfo 4 | , Connection, connectMySQL 5 | ) 6 | import Database.HDBC.Query.TH (defineTableFromDB) 7 | import Database.HDBC.Schema.Driver (typeMap) 8 | import Database.HDBC.Schema.MySQL (driverMySQL) 9 | import Language.Haskell.TH (TypeQ, Q, Dec) 10 | import Language.Haskell.TH.Name.CamelCase (ConName) 11 | 12 | -- {-# ANN module "HLint: ignore Eta reduce" #-} 13 | 14 | config :: MySQLConnectInfo 15 | config = defaultMySQLConnectInfo 16 | { mysqlUser = "hrr-tester" 17 | , mysqlPassword = "" 18 | , mysqlDatabase = "TEST" 19 | , mysqlHost = "127.0.0.1" 20 | } 21 | 22 | connect :: IO Connection 23 | connect = connectMySQL config 24 | 25 | defineTable :: [(String, TypeQ)] -> String -> String -> [ConName] -> Q [Dec] 26 | defineTable tmap = 27 | defineTableFromDB connect (driverMySQL { typeMap = tmap }) 28 | 29 | -------------------------------------------------------------------------------- /test/HDBC/MySQL/setup.sql: -------------------------------------------------------------------------------- 1 | CREATE DATABASE IF NOT EXISTS TEST DEFAULT CHARACTER SET UTF8; 2 | 3 | DROP TABLE IF EXISTS TEST.test_pk1; 4 | CREATE TABLE TEST.test_pk1 (a INT, b VARCHAR(32) NOT NULL, PRIMARY KEY (a)); 5 | DROP TABLE IF EXISTS TEST.test_pk2; 6 | CREATE TABLE TEST.test_pk2 (a INT, b INT, c VARCHAR(32) NOT NULL, PRIMARY KEY (a, b)); 7 | 8 | DROP TABLE IF EXISTS TEST.test_nn1; 9 | CREATE TABLE TEST.test_nn1 (a INT, b INT, c VARCHAR(32) NOT NULL, d TEXT, e DATETIME NOT NULL, PRIMARY KEY (a)); 10 | 11 | DROP TABLE IF EXISTS TEST.user; 12 | CREATE TABLE TEST.user ( 13 | id BIGINT PRIMARY KEY 14 | , name VARCHAR(32) NOT NULL 15 | , email VARCHAR(255) NOT NULL UNIQUE 16 | , passwd_hash VARCHAR(512) NOT NULL 17 | , completed TINYINT(1) NOT NULL DEFAULT 0 18 | , deleted TINYINT(1) NOT NULL DEFAULT 0 19 | , frozen TINYINT(1) NOT NULL DEFAULT 0 20 | , memo TEXT NOT NULL 21 | , created_at DATE NOT NULL 22 | , updated_at DATE NOT NULL 23 | ); 24 | 25 | INSERT INTO TEST.user 26 | (id, name, email, passwd_hash, completed, deleted, frozen, memo, created_at, updated_at) 27 | VALUES 28 | (1, 'krdlab', 'krdlab@gmail.com', 'dummy hashed password 1', 1, 0, 0, '', '2014-02-01', '2014-02-01'), 29 | (2, 'foo', 'foo@example.com', 'dummy hashed password 2', 0, 0, 0, '', '2014-02-10', '2014-02-10'), 30 | (3, 'bar', 'bar@example.com', 'dummy hashed password 3', 1, 0, 1, 'limit exceeded', '2014-02-11', '2014-02-20') 31 | ; 32 | 33 | GRANT ALL PRIVILEGES ON TEST.* TO 'hrr-tester'@'127.0.0.1'; 34 | -------------------------------------------------------------------------------- /test/HDBC/SQLServer/SQLServerTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | 5 | module SQLServerTest where 6 | 7 | import Data.ByteString (ByteString) 8 | import Data.Text (Text) 9 | import Distribution.TestSuite (Test) 10 | import SQLServerTestDataSource (defineTable) 11 | 12 | tests :: IO [Test] 13 | tests = return [] 14 | 15 | $(defineTable 16 | [("varchar", [t| ByteString |]), 17 | ("text", [t| Text |]) 18 | ] 19 | "TEST" "test_table0" []) 20 | -------------------------------------------------------------------------------- /test/HDBC/SQLServer/SQLServerTestDataSource.hs: -------------------------------------------------------------------------------- 1 | module SQLServerTestDataSource ( 2 | connect, 3 | defineTable 4 | ) where 5 | 6 | import Database.HDBC.ODBC (Connection, connectODBC) 7 | import Database.HDBC.Query.TH (defineTableFromDB) 8 | import Database.HDBC.Schema.Driver (typeMap) 9 | import Database.HDBC.Schema.SQLServer (driverSQLServer) 10 | import Language.Haskell.TH (Q, Dec, TypeQ) 11 | import Language.Haskell.TH.Name.CamelCase (ConName) 12 | 13 | {-# ANN module "HLint: ignore Eta reduce" #-} 14 | 15 | connect :: IO Connection 16 | connect = connectODBC "DSN=testdb;UID=test;PWD=test" 17 | 18 | defineTable :: [(String, TypeQ)] -> String -> String -> [ConName] -> Q [Dec] 19 | defineTable tmap scm tbl derives = 20 | defineTableFromDB 21 | connect 22 | (driverSQLServer { typeMap = tmap }) 23 | scm tbl derives 24 | -------------------------------------------------------------------------------- /test/HDBC/SQLServer/TypeCheck.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Database.HDBC 4 | import Database.HDBC.ODBC 5 | import System.Environment 6 | import System.IO 7 | 8 | main :: IO () 9 | main = do 10 | args <- getArgs 11 | if length args > 1 then do 12 | conn <- connectODBC $ args !! 0 13 | rows <- quickQuery conn $ args !! 1 14 | mapM_ putStrLn $ map show rows 15 | else 16 | hPutStrLn stderr "query " 17 | -------------------------------------------------------------------------------- /test/HDBC/SQLite3/SQLite3Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | 5 | module SQLite3Test where 6 | 7 | import Data.Time (UTCTime) 8 | import Distribution.TestSuite (Test) 9 | import SQLite3TestDataSource (defineTable) 10 | 11 | tests :: IO [Test] 12 | tests = return [] 13 | 14 | $(defineTable 15 | [("date", [t| UTCTime |]), 16 | ("smallint", [t| Int |]), 17 | ("varchar", [t| String |]) 18 | ] 19 | "main" "test_table0" []) 20 | -------------------------------------------------------------------------------- /test/HDBC/SQLite3/SQLite3TestDataSource.hs: -------------------------------------------------------------------------------- 1 | module SQLite3TestDataSource ( 2 | connect, 3 | defineTable 4 | ) where 5 | 6 | import Database.HDBC.Query.TH (defineTableFromDB) 7 | import Database.HDBC.Schema.Driver (typeMap) 8 | import Database.HDBC.Schema.SQLite3 (driverSQLite3) 9 | import Database.HDBC.Sqlite3 (Connection, connectSqlite3) 10 | import Language.Haskell.TH (Q, Dec, TypeQ) 11 | import Language.Haskell.TH.Name.CamelCase (ConName) 12 | 13 | {-# ANN module "HLint: ignore Eta reduce" #-} 14 | 15 | connect :: IO Connection 16 | connect = connectSqlite3 "test/testdb" 17 | 18 | defineTable :: [(String, TypeQ)] -> String -> String -> [ConName] -> Q [Dec] 19 | defineTable tmap scm tbl derives = 20 | defineTableFromDB 21 | connect 22 | (driverSQLite3 { typeMap = tmap }) 23 | scm tbl derives 24 | -------------------------------------------------------------------------------- /test/HDBC/SQLite3/runCreate.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | PATH='/usr/bin:/bin' 4 | TESTDB=$1 5 | 6 | create0=' 7 | CREATE TABLE main.test_table0 ( 8 | foo smallint NOT NULL, 9 | foo_bar integer NOT NULL, 10 | par_ent integer NOT NULL, 11 | bar date, 12 | bar_baz text, 13 | baz VARCHAR(10), 14 | 15 | PRIMARY KEY(foo_bar) 16 | ); 17 | ' 18 | 19 | create1=' 20 | CREATE TABLE main.test_table1 ( 21 | foo integer NOT NULL, 22 | 23 | PRIMARY KEY (foo) 24 | ); 25 | ' 26 | 27 | create2=' 28 | CREATE TABLE main.test_table2 ( 29 | x ntext, 30 | y nvarchar (16) NOT NULL, 31 | z nchar (16) NOT NULL 32 | ); 33 | ' 34 | 35 | create3=' 36 | CREATE TABLE main.test_table3 ( 37 | name text NOT NULL, 38 | birth date NOT NULL, 39 | sex integer NOT NULL, 40 | height integer NOT NULL, 41 | 42 | PRIMARY KEY (name, sex, birth) 43 | ); 44 | ' 45 | 46 | set -x 47 | 48 | sqlite3 "$TESTDB" < PrintM t () 14 | 15 | token :: Printer t t 16 | token = tell . return 17 | 18 | list :: Printer t [t] 19 | list = mapM_ token 20 | 21 | execPrinter :: Printer t a -> a -> [t] 22 | execPrinter p = DList.toList . execWriter . p 23 | -------------------------------------------------------------------------------- /travis-CI/cabal-hvr-ghc-2/install.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | . ./travis-CI/sh-lib 6 | . ./travis-CI/custom-cabal 7 | . ./travis-CI/dirs.list 8 | 9 | set -x 10 | 11 | cabal --version 12 | echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" 13 | 14 | BENCH=${BENCH---enable-benchmarks} 15 | TEST=${TEST---enable-tests} 16 | 17 | gen_custom_cabal_config 18 | custom_retry cabal update -v 19 | sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config 20 | grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$' 21 | 22 | install_package() { 23 | rm -fv cabal.project.local 24 | echo 'packages: .' > cabal.project 25 | cat cabal.project 26 | if [ -f configure.ac ]; then autoreconf -i; fi 27 | rm -f cabal.project.freeze 28 | cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all 29 | cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all 30 | 31 | rm -rf .ghc.environment.* dist/ 32 | } 33 | 34 | if [ x"$dirs" = x ]; then 35 | install_package 36 | else 37 | for d in $dirs; do 38 | ( cd $d && install_package ) 39 | done 40 | fi 41 | -------------------------------------------------------------------------------- /travis-CI/cabal-hvr-ghc/script.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | . ./travis-CI/dirs.list 6 | 7 | set -x 8 | 9 | script_build() { 10 | if [ -f configure.ac ]; then autoreconf -i; fi 11 | cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging 12 | cabal build $CABAL_JOBS # this builds all libraries and executables (including tests/benchmarks) 13 | cabal test $CABAL_JOBS 14 | cabal check 15 | cabal sdist # tests that a source-distribution can be generated 16 | 17 | # Check that the resulting source distribution can be built & installed. 18 | # If there are no other `.tar.gz` files in `dist`, this can be even simpler: 19 | # `cabal install --force-reinstalls dist/*-*.tar.gz` 20 | SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && \ 21 | (cd dist && cabal install $CABAL_JOBS --force-reinstalls "$SRC_TGZ") 22 | } 23 | 24 | if [ x"$dirs" = x ]; then 25 | script_build 26 | else 27 | for d in $dirs; do 28 | ( cd $d && script_build ) 29 | done 30 | fi 31 | -------------------------------------------------------------------------------- /travis-CI/custom-cabal: -------------------------------------------------------------------------------- 1 | ## -*- sh -*- 2 | 3 | . ./travis-CI/sh-lib 4 | 5 | cabal_wheezy() { 6 | cabal_common 7 | cat < ${HOME}/.cabal/config 38 | ;; 39 | '') 40 | case "$GHCVER" in 41 | 7.4.*) 42 | cabal_ghc74 > ${HOME}/.cabal/config 43 | ;; 44 | 7.6.*) 45 | cabal_ghc76 > ${HOME}/.cabal/config 46 | ;; 47 | *) 48 | ;; 49 | esac 50 | ;; 51 | 52 | *) 53 | echo "Unsupported DEBIANVER, $DEBIANVER" 54 | exit 1 55 | ;; 56 | esac 57 | } 58 | -------------------------------------------------------------------------------- /travis-CI/dirs.list: -------------------------------------------------------------------------------- 1 | dirs=' 2 | names-th 3 | sql-words 4 | persistable-record 5 | relational-query 6 | relational-schemas 7 | HDBC-session 8 | relational-query-HDBC 9 | text-postgresql 10 | persistable-types-HDBC-pg 11 | ' 12 | 13 | test_pkgs=' 14 | sql-words 15 | persistable-record 16 | relational-query 17 | relational-query-HDBC 18 | text-postgresql 19 | persistable-types-HDBC-pg 20 | ' 21 | -------------------------------------------------------------------------------- /travis-CI/stack/before-install.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | . ./travis-CI/sh-lib 6 | 7 | set -x 8 | 9 | skip_no_match_branch 10 | 11 | mkdir -p ~/.local/bin 12 | custom_retry curl -L https://www.stackage.org/stack/linux-x86_64 \ 13 | | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 14 | -------------------------------------------------------------------------------- /travis-CI/stack/install.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | . ./travis-CI/sh-lib 6 | . ./travis-CI/dirs.list 7 | 8 | set -x 9 | 10 | skip_no_match_branch 11 | 12 | checkout_root=$(pwd) 13 | 14 | ( 15 | show_stack_pkgs 16 | sed "s/^resolver: .*/resolver: ${STACK_RESOLVER}/" \ 17 | < $checkout_root/travis-CI/stack/template.yaml \ 18 | ) > stack-travis.yaml 19 | 20 | cat stack-travis.yaml 21 | 22 | STACK_YAML=stack-travis.yaml stack setup 23 | STACK_YAML=stack-travis.yaml stack install --only-dependencies 24 | -------------------------------------------------------------------------------- /travis-CI/stack/script.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | . ./travis-CI/sh-lib 6 | . ./travis-CI/dirs.list 7 | 8 | set -x 9 | 10 | skip_no_match_branch 11 | 12 | STACK_YAML=stack-travis.yaml stack build 13 | STACK_YAML=stack-travis.yaml stack test 14 | -------------------------------------------------------------------------------- /travis-CI/stack/template.yaml: -------------------------------------------------------------------------------- 1 | resolver: #foo 2 | 3 | extra-deps: [] 4 | flags: {} 5 | extra-package-dbs: [] 6 | system-ghc: false 7 | install-ghc: true 8 | --------------------------------------------------------------------------------