Add an example

relational-query-HDBC/example/Oracle/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2013, amutake
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of amutake nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

relational-query-HDBC/example/Oracle/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

relational-query-HDBC/example/Oracle/hrr-oracle-example.cabal

@@ -0,0 +1,24 @@
+name:                hrr-oracle-example
+version:             0.1.0.0
+license:             BSD3
+license-file:        LICENSE
+author:              amutake
+maintainer:          amutake.s@gmail.com
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable hrr-oracle-example
+  main-is:           main.hs
+  other-modules:     DataSource
+  -- other-extensions:
+  build-depends:       base <5
+                     , DB-record
+                     , HDBC
+                     , HDBC-odbc
+                     , HDBC-session
+                     , relational-join
+                     , relational-query-HDBC
+                     , relational-Oracle
+                     , template-haskell
+  hs-source-dirs: src
+  default-language:    Haskell2010

relational-query-HDBC/example/Oracle/src/DataSource.hs

@@ -0,0 +1,34 @@
+module DataSource where
+
+import Control.Applicative ((<$>), (<*>))
+import System.IO.Unsafe (unsafePerformIO)
+
+import Database.HDBC.ODBC (Connection, connectODBC)
+
+data Option = Option
+    { dsn :: String
+    , uid :: String
+    , pwd :: String
+    }
+
+instance Show Option where
+    show (Option d u p) = concat
+        [ "DSN=", d, ";"
+        , "UID=", u, ";"
+        , "PWD=", p
+        ]
+
+getOption :: IO Option
+getOption = Option <$> get "DSN: " <*> get "UID: " <*> get "PWD: "
+  where
+    get str = putStr str >> getLine
+
+connect :: IO Connection
+connect = do
+    option <- getOption
+    connectODBC $ show option
+
+owner :: String
+owner = unsafePerformIO $ do
+    putStr "OWNER: "
+    getLine

relational-query-HDBC/example/Oracle/src/HrrDatatypeTest.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
+
+module HrrDatatypeTest where
+
+import Database.HDBC.Query.TH (defineTableFromDB)
+import Database.HDBC.Schema.Oracle (driverOracle)
+import Database.Record.TH (derivingShow)
+
+import DataSource (connect, owner)
+
+defineTableFromDB connect driverOracle owner "hrr_datatype_test" [derivingShow]

relational-query-HDBC/example/Oracle/src/create.sql

@@ -0,0 +1,36 @@
+/* http://otndnld.oracle.co.jp/document/products/oracle11g/111/doc_dvd/server.111/E05765-03/datatype.htm */
+create table hrr_datatype_test (
+  char_10 char(10) not null,             -- 10文字までの固定長文字列(あまりは空白が入る)
+  char_1 char(1) not null,               -- 1文字までの固定長文字列
+  varchar2_10 varchar2(10) not null,     -- 10文字までの可変長文字列(あまってもなにも入らない)
+  varchar_10 varchar(10) not null,       -- 同上(非推奨)
+  nchar_10 nchar(10) not null,           -- 10文字までのUnicode固定長文字列
+  nvarchar2_10 nvarchar2(10) not null,   -- 10文字までのUnicode可変長文字列
+  -- nvarchar_10 nvarchar(10) not null,     -- 同上(非推奨)(動かない)
+  -- long_raw long not null,                -- 2GBまでの可変長文字列(非推奨)
+  number_raw number not null,            -- (ほぼ)任意の数値
+  number_ast_1 number(*, 1) not null,    -- 任意桁、小数点以下1桁
+  number_9 number(9) not null,           -- 9桁の整数
+  number_9_2 number(9, 2) not null,      -- 9桁、小数点以下2桁
+  number_9_1 number(9, -2) not null,     -- 9桁、下二桁を丸めた整数
+  binary_float binary_float not null,    -- 32bit 浮動小数点数
+  binary_double binary_double not null,  -- 64bit 倍精度浮動小数点数
+  date_raw date not null,                -- 年（世紀を含む）、月、日、時、分および秒（真夜中から数える）
+  blob_raw blob not null,                -- 128TBまでのバイナリデータ
+  clob_raw clob not null,                -- 128TBまでの可変長文字列
+  nclob_raw nclob not null,              -- 128TBまでのUnicode可変長文字列
+  long_raw_raw long raw not null,        -- バイナリデータ(非推奨)(なぜかlong型のものと同時に定義しようとするとエラー)
+  raw_raw raw(255) not null,             -- バイナリデータ
+  rowid_raw rowid not null,              -- 行番号(string？)
+  urowid_raw urowid not null             -- グローバルな行番号？
+  -- xml xmltype not null,                  -- XML
+  -- uri uritype not null                   -- URI
+);
+
+insert into hrr_datatype_test values (
+  'abあい', 'a', 'abあい', 'abあい', 'abあい', 'abあい',
+  1234.1234, 1234.12, 1234, 1234.1234, 1234.1234, 1234.1234, 1234.1234,
+  sysdate, '123456789ABCDEF', 'abcdあいうえ', 'abcdあいうえ',
+  '1234abcd', '1234abcd', 'AAAK6mAAAAAABF8AAA', 'AAAK6mAAAAAABF8AAA'
+  -- xmltype.createxml('<test></test>'), httpuritype.createuri('http://www.example.com')
+);

relational-query-HDBC/example/Oracle/src/main.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import Database.Relational.Query (relationalQuery)
+import Database.HDBC.Session (withConnectionIO, handleSqlError')
+import Database.HDBC.Record.Query (runQuery)
+
+import DataSource
+import HrrDatatypeTest
+
+main :: IO ()
+main = handleSqlError' $ withConnectionIO connect $ \conn -> do
+    runQuery conn (relationalQuery hrrDatatypeTest) () >>= print