diff --git a/relational-query-HDBC.cabal b/relational-query-HDBC.cabal
--- a/relational-query-HDBC.cabal
+++ b/relational-query-HDBC.cabal
@@ -1,5 +1,5 @@
 name:                relational-query-HDBC
-version:             0.1.0.1
+version:             0.2.0.0
 synopsis:            HDBC instance of relational-query and typed query interface for HDBC
 description:         This package contains the HDBC instance of relational-query and
                      the typed query interface for HDBC.
@@ -43,12 +43,14 @@
 
   build-depends:         base <5
                        , containers
+                       , transformers
                        , convertible
                        , template-haskell
+                       , dlist
 
                        , names-th
                        , persistable-record
-                       , relational-query
+                       , relational-query >= 0.6.1
                        , relational-schemas
                        , HDBC >=2
                        , HDBC-session
diff --git a/src/Database/HDBC/Query/TH.hs b/src/Database/HDBC/Query/TH.hs
--- a/src/Database/HDBC/Query/TH.hs
+++ b/src/Database/HDBC/Query/TH.hs
@@ -28,24 +28,26 @@
 
 import Data.Maybe (listToMaybe, fromMaybe)
 import qualified Data.Map as Map
+import Control.Applicative ((<$>), (<*>))
 import Control.Monad (when)
 
 import Database.HDBC (IConnection, SqlValue, prepare)
 
 import Language.Haskell.TH (Q, runIO, Name, TypeQ, Dec)
 import Language.Haskell.TH.Name.CamelCase (ConName, varCamelcaseName)
-import Language.Haskell.TH.Lib.Extra (reportWarning, reportMessage)
+import Language.Haskell.TH.Lib.Extra (reportWarning, reportError, reportMessage)
 
 import Database.Record.TH (makeRecordPersistableWithSqlTypeDefault)
 import qualified Database.Record.TH as Record
-import Database.Relational.Query (Relation, Config, defaultConfig, relationalQuerySQL)
+import Database.Relational.Query (Relation, Config, verboseAsCompilerWarning, defaultConfig, relationalQuerySQL)
 import Database.Relational.Query.SQL (QuerySuffix)
 import qualified Database.Relational.Query.TH as Relational
 
 import Database.HDBC.Session (withConnectionIO)
 import Database.HDBC.Record.Persistable ()
 
-import Database.HDBC.Schema.Driver (Driver, getFields, getPrimaryKey)
+import Database.HDBC.Schema.Driver
+  (runLog, newLogChan, takeLogs, Driver, getFields, getPrimaryKey)
 
 
 -- | Generate all persistable templates against defined record like type constructor.
@@ -95,15 +97,17 @@
                    -> [ConName]   -- ^ Derivings
                    -> Q [Dec]     -- ^ Result declaration
 defineTableFromDB' connect config drv scm tbl derives = do
-  let getDBinfo =
-        withConnectionIO connect
-        (\conn ->  do
-            (cols, notNullIdxs) <- getFields drv conn scm tbl
-            primCols            <- getPrimaryKey drv conn scm tbl
-
-            return (cols, notNullIdxs, primCols) )
+  let getDBinfo = do
+        logChan  <-  newLogChan $ verboseAsCompilerWarning config
+        infoP    <-  withConnectionIO connect
+                     (\conn ->
+                       (,)
+                       <$> getFields drv conn logChan scm tbl
+                       <*> getPrimaryKey drv conn logChan scm tbl)
+        (,) infoP <$> takeLogs logChan
 
-  (cols, notNullIdxs, primaryCols) <- runIO getDBinfo
+  (((cols, notNullIdxs), primaryCols), logs) <- runIO getDBinfo
+  mapM_ (runLog reportWarning reportError) logs
   when (null primaryCols) . reportWarning
     $ "getPrimaryKey: Primary key not found for table: " ++ scm ++ "." ++ tbl
 
diff --git a/src/Database/HDBC/Schema/Driver.hs b/src/Database/HDBC/Schema/Driver.hs
--- a/src/Database/HDBC/Schema/Driver.hs
+++ b/src/Database/HDBC/Schema/Driver.hs
@@ -11,12 +11,24 @@
 -- to load database system catalog via HDBC.
 module Database.HDBC.Schema.Driver (
   TypeMap,
+
+  Log, runLog,
+  LogChan, newLogChan, takeLogs, putWarning, putError, putVerbose,
+  failWith, hoistMaybe, maybeIO,
+
   Driver(Driver, typeMap, getFieldsWithMap, getPrimaryKey),
   emptyDriver,
   getFields
   ) where
 
 import Database.HDBC (IConnection)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
+import Data.Monoid (mempty, (<>))
+import Data.DList (DList, toList)
+import Control.Applicative ((<$>), pure, (<*>))
+import Control.Monad (MonadPlus, mzero)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Maybe (MaybeT (..))
 import Language.Haskell.TH (TypeQ)
 
 
@@ -24,6 +36,73 @@
 --   Type name string depends on specification of DBMS system catalogs.
 type TypeMap = [(String, TypeQ)]
 
+-- | Log string type for compile time.
+data Log
+  = Warning String
+  | Error String
+
+-- | Folding operation of 'Log' type.
+runLog :: (String -> t) -> (String -> t) -> Log -> t
+runLog wf ef = d  where
+  d (Warning m) = wf m
+  d (Error m)   = ef m
+
+-- | Channel to store compile-time warning messages.
+data LogChan =
+  LogChan
+  { chan :: IORef (DList Log)
+  , verboseAsWarning :: Bool
+  }
+
+-- | Build and return a new instance of 'LogChan'.
+newLogChan :: Bool -> IO LogChan
+newLogChan v =
+  LogChan <$> newIORef mempty <*> pure v
+
+-- | Take all logs list from channel.
+takeLogs :: LogChan -> IO [Log]
+takeLogs lchan = do
+  xs <- readIORef $ chan lchan
+  writeIORef (chan lchan) mempty
+  return $ toList xs
+
+putLog :: LogChan -> Log -> IO ()
+putLog lchan m = chan lchan `modifyIORef` (<> pure m)
+
+-- | Push a warning string into 'LogChan'.
+putWarning :: LogChan -> String -> IO ()
+putWarning lchan = putLog lchan . Warning
+
+-- | Push an error string into 'LogChan'.
+putError :: LogChan -> String -> IO ()
+putError lchan = putLog lchan . Warning
+
+-- | Push an error string into 'LogChan' and return failed context.
+failWith :: LogChan -> String -> MaybeT IO a
+failWith lchan m = do
+  lift $ putError lchan m
+  mzero
+
+hoistM :: MonadPlus m => Maybe a -> m a
+hoistM = maybe mzero return
+
+-- | Hoist from 'Maybe' context into 'MaybeT'.
+hoistMaybe :: Monad m => Maybe a -> MaybeT m a
+hoistMaybe = hoistM
+
+maybeT :: Functor f => b -> (a -> b) -> MaybeT f a -> f b
+maybeT zero f = (maybe zero f <$>) . runMaybeT
+
+-- | Run 'MaybeT' with default value.
+maybeIO :: b -> (a -> b) -> MaybeT IO a -> IO b
+maybeIO = maybeT
+
+-- | Put verbose compile-time message as warning when 'verboseAsWarning'.
+putVerbose :: LogChan -> String -> IO ()
+putVerbose lchan
+  | verboseAsWarning lchan  =  putWarning lchan . ("info: " ++)
+  | otherwise               =  const $ pure ()
+
 -- | Interface type to load database system catalog via HDBC.
 data Driver conn =
   Driver
@@ -33,12 +112,15 @@
     -- | Get column name and Haskell type pairs and not-null columns index.
   , getFieldsWithMap :: TypeMap                       --  Custom type mapping
                      -> conn                          --  Connection to query system catalog
+                     -> LogChan
                      -> String                        --  Schema name string
                      -> String                        --  Table name string
-                     -> IO ([(String, TypeQ)], [Int]) --  Action to get column name and Haskell type pairs and not-null columns index.
+                     -> IO ([(String, TypeQ)], [Int]) {-  Action to get column name and Haskell type pairs
+                                                           and not-null columns index. -}
 
     -- | Get primary key column name.
   , getPrimaryKey :: conn          --  Connection to query system catalog
+                  -> LogChan
                   -> String        --  Schema name string
                   -> String        --  Table name string
                   -> IO [String]   --  Action to get column names of primary key
@@ -46,8 +128,8 @@
 
 -- | Empty definition of 'Driver'
 emptyDriver :: IConnection conn => Driver conn
-emptyDriver =  Driver [] (\_ _ _ _ -> return ([],[])) (\_ _ _ -> return [])
+emptyDriver =  Driver [] (\_ _ _ _ _ -> return ([],[])) (\_ _ _ _ -> return [])
 
 -- | Helper function to call 'getFieldsWithMap' using 'typeMap' of 'Driver'.
-getFields :: IConnection conn => Driver conn -> conn -> String -> String -> IO ([(String, TypeQ)], [Int])
+getFields :: IConnection conn => Driver conn -> conn -> LogChan -> String -> String -> IO ([(String, TypeQ)], [Int])
 getFields drv = getFieldsWithMap drv (typeMap drv)
diff --git a/src/Database/HDBC/Schema/IBMDB2.hs b/src/Database/HDBC/Schema/IBMDB2.hs
--- a/src/Database/HDBC/Schema/IBMDB2.hs
+++ b/src/Database/HDBC/Schema/IBMDB2.hs
@@ -24,12 +24,13 @@
 import qualified Data.List as List
 import Data.Char (toUpper)
 import Data.Map (fromList)
-import Control.Monad (when)
+import Control.Applicative ((<$>), (<|>))
+import Control.Monad (guard)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Maybe (MaybeT)
 
 import Database.HDBC (IConnection, SqlValue)
 
-import Language.Haskell.TH.Lib.Extra (reportMessage)
-
 import Database.HDBC.Record.Query (runQuery')
 import Database.HDBC.Record.Persistable ()
 
@@ -41,7 +42,8 @@
 import qualified Database.Relational.Schema.DB2Syscat.Columns as Columns
 
 import Database.HDBC.Schema.Driver
-  (TypeMap, Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
+  (TypeMap, LogChan, putVerbose, failWith, maybeIO, hoistMaybe,
+   Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
 
 
 -- Specify type constructor and data constructor from same table name.
@@ -51,48 +53,49 @@
 logPrefix :: String -> String
 logPrefix =  ("IBMDB2: " ++)
 
-putLog :: String -> IO ()
-putLog =  reportMessage . logPrefix
+putLog :: LogChan -> String -> IO ()
+putLog lchan =  putVerbose lchan . logPrefix
 
-compileErrorIO :: String -> IO a
-compileErrorIO =  fail . logPrefix
+compileError :: LogChan -> String -> MaybeT IO a
+compileError lchan = failWith lchan . logPrefix
 
 getPrimaryKey' :: IConnection conn
-              => conn
-              -> String
-              -> String
-              -> IO [String]
-getPrimaryKey' conn scm' tbl' = do
+               => conn
+               -> LogChan
+               -> String
+               -> String
+               -> IO [String]
+getPrimaryKey' conn lchan scm' tbl' = do
   let tbl = map toUpper tbl'
       scm = map toUpper scm'
   primCols <- runQuery' conn primaryKeyQuerySQL (scm, tbl)
-  let primaryKeyCols = normalizeColumn `fmap` primCols
-  putLog $ "getPrimaryKey: primary key = " ++ show primaryKeyCols
+  let primaryKeyCols = normalizeColumn <$> primCols
+  putLog lchan $ "getPrimaryKey: primary key = " ++ show primaryKeyCols
 
   return primaryKeyCols
 
 getColumns' :: IConnection conn
-          => TypeMap
-          -> conn
-          -> String
-          -> String
-          -> IO ([(String, TypeQ)], [Int])
-getColumns' tmap conn scm' tbl' = do
+            => TypeMap
+            -> conn
+            -> LogChan
+            -> String
+            -> String
+            -> IO ([(String, TypeQ)], [Int])
+getColumns' tmap conn lchan scm' tbl' = maybeIO ([], []) id $ do
   let tbl = map toUpper tbl'
       scm = map toUpper scm'
 
-  cols <- runQuery' conn columnsQuerySQL (scm, tbl)
-  when (null cols) . compileErrorIO
-    $ "getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl
+  cols <- lift $ runQuery' conn columnsQuerySQL (scm, tbl)
+  guard (not $ null cols) <|>
+    compileError lchan ("getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl)
 
   let notNullIdxs = map fst . filter (notNull . snd) . zip [0..] $ cols
-  putLog
+  lift . putLog lchan
     $  "getFields: num of columns = " ++ show (List.length cols)
     ++ ", not null columns = " ++ show notNullIdxs
-  let getType' col = case getType (fromList tmap) col of
-        Nothing -> compileErrorIO
-                   $ "Type mapping is not defined against DB2 type: " ++ Columns.typename col
-        Just p  -> return p
+  let getType' col =
+        hoistMaybe (getType (fromList tmap) col) <|>
+        compileError lchan ("Type mapping is not defined against DB2 type: " ++ Columns.typename col)
 
   types <- mapM getType' cols
   return (types, notNullIdxs)
diff --git a/src/Database/HDBC/Schema/MySQL.hs b/src/Database/HDBC/Schema/MySQL.hs
--- a/src/Database/HDBC/Schema/MySQL.hs
+++ b/src/Database/HDBC/Schema/MySQL.hs
@@ -1,6 +1,15 @@
 {-# OPTIONS_GHC -fno-warn-orphans  #-}
 {-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+
+-- |
+-- Module      : Database.HDBC.Schema.MySQL
+-- Copyright   : 2013 Sho KURODA
+-- License     : BSD3
+--
+-- Maintainer  : krdlab@gmail.com
+-- Stability   : experimental
+-- Portability : unknown
 module Database.HDBC.Schema.MySQL
     (
       driverMySQL
@@ -9,7 +18,10 @@
 
 import           Prelude                            hiding (length)
 import           Language.Haskell.TH                (TypeQ)
-import           Language.Haskell.TH.Lib.Extra      (reportMessage)
+import           Control.Applicative                ((<$>), (<|>))
+import           Control.Monad                      (guard)
+import           Control.Monad.Trans.Class          (lift)
+import           Control.Monad.Trans.Maybe          (MaybeT)
 import qualified Data.List                          as List
 import           Data.Map                           (fromList)
 
@@ -17,6 +29,11 @@
 import           Database.HDBC.Record.Query         (runQuery')
 import           Database.HDBC.Record.Persistable   ()
 import           Database.HDBC.Schema.Driver        ( TypeMap
+                                                    , LogChan
+                                                    , putVerbose
+                                                    , failWith
+                                                    , maybeIO
+                                                    , hoistMaybe
                                                     , Driver
                                                     , getFieldsWithMap
                                                     , getPrimaryKey
@@ -38,52 +55,52 @@
 logPrefix :: String -> String
 logPrefix = ("MySQL: " ++)
 
-putLog :: String -> IO ()
-putLog = reportMessage . logPrefix
+putLog :: LogChan -> String -> IO ()
+putLog lchan = putVerbose lchan . logPrefix
 
-compileErrorIO :: String -> IO a
-compileErrorIO = fail . logPrefix
+compileError :: LogChan -> String -> MaybeT IO a
+compileError lchan = failWith lchan . logPrefix
 
 getPrimaryKey' :: IConnection conn
                => conn
+               -> LogChan
                -> String
                -> String
                -> IO [String]
-getPrimaryKey' conn scm tbl = do
+getPrimaryKey' conn lchan scm tbl = do
     primCols <- runQuery' conn primaryKeyQuerySQL (scm, tbl)
-    let primaryKeyCols = normalizeColumn `fmap` primCols
-    putLog $ "getPrimaryKey: primary key = " ++ show primaryKeyCols
+    let primaryKeyCols = normalizeColumn <$> primCols
+    putLog lchan $ "getPrimaryKey: primary key = " ++ show primaryKeyCols
     return primaryKeyCols
 
-getFields' :: IConnection conn
-           => TypeMap
-           -> conn
-           -> String
-           -> String
-           -> IO ([(String, TypeQ)], [Int])
-getFields' tmap conn scm tbl = do
-    cols <- runQuery' conn columnsQuerySQL (scm, tbl)
-    case cols of
-        [] -> compileErrorIO
-                $ "getFields: No columns found: schema = " ++ scm
-                ++ ", table = " ++ tbl
-        _  -> return ()
+getColumns' :: IConnection conn
+            => TypeMap
+            -> conn
+            -> LogChan
+            -> String
+            -> String
+            -> IO ([(String, TypeQ)], [Int])
+getColumns' tmap conn lchan scm tbl = maybeIO ([], []) id $ do
+    cols <- lift $ runQuery' conn columnsQuerySQL (scm, tbl)
+    guard (not $ null cols) <|>
+      compileError lchan
+      ("getFields: No columns found: schema = " ++ scm
+       ++ ", table = " ++ tbl)
     let notNullIdxs = map fst . filter (notNull . snd) . zip [0..] $ cols
-    putLog
+    lift . putLog lchan
       $  "getFields: num of columns = " ++ show (List.length cols)
       ++ ", not null columns = " ++ show notNullIdxs
     types <- mapM getType' cols
     return (types, notNullIdxs)
     where
         getType' col =
-            case getType (fromList tmap) col of
-                Nothing -> compileErrorIO
-                             $ "Type mapping is not defined against MySQL type: "
-                             ++ Columns.dataType col
-                Just p  -> return p
+            hoistMaybe (getType (fromList tmap) col) <|>
+            compileError lchan
+            ("Type mapping is not defined against MySQL type: "
+             ++ Columns.dataType col)
 
 -- | Driver implementation
 driverMySQL :: IConnection conn => Driver conn
 driverMySQL =
-    emptyDriver { getFieldsWithMap = getFields' }
+    emptyDriver { getFieldsWithMap = getColumns' }
                 { getPrimaryKey    = getPrimaryKey' }
diff --git a/src/Database/HDBC/Schema/Oracle.hs b/src/Database/HDBC/Schema/Oracle.hs
--- a/src/Database/HDBC/Schema/Oracle.hs
+++ b/src/Database/HDBC/Schema/Oracle.hs
@@ -1,23 +1,34 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses #-}
 
+-- |
+-- Module      : Database.HDBC.Schema.MySQL
+-- Copyright   : 2013 Shohei Yasutake
+-- License     : BSD3
+--
+-- Maintainer  : amutake.s@gmail.com
+-- Stability   : experimental
+-- Portability : unknown
 module Database.HDBC.Schema.Oracle
     ( driverOracle
     ) where
 
-import Control.Applicative ((<$>))
+import Control.Applicative ((<$>), (<|>))
+import Control.Monad (guard)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Maybe (MaybeT)
 import Data.Char (toUpper)
 import Data.Map (fromList)
 import Data.Maybe (catMaybes)
 import Language.Haskell.TH (TypeQ)
-import Language.Haskell.TH.Lib.Extra (reportMessage)
 
 import Database.HDBC (IConnection, SqlValue)
 import Database.HDBC.Record.Query (runQuery')
 import Database.HDBC.Record.Persistable ()
 import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
 import Database.HDBC.Schema.Driver
-    ( TypeMap, Driver, getFieldsWithMap, getPrimaryKey, emptyDriver
+    ( TypeMap, LogChan, putVerbose, failWith, maybeIO, hoistMaybe,
+      Driver, getFieldsWithMap, getPrimaryKey, emptyDriver
     )
 
 import Database.Relational.Schema.Oracle
@@ -34,53 +45,53 @@
 logPrefix :: String -> String
 logPrefix = ("Oracle: " ++)
 
-putLog :: String -> IO ()
-putLog = reportMessage . logPrefix
+putLog :: LogChan -> String -> IO ()
+putLog lchan = putVerbose lchan . logPrefix
 
-compileErrorIO :: String -> IO a
-compileErrorIO = fail . logPrefix
+compileError :: LogChan -> String -> MaybeT IO a
+compileError lchan = failWith lchan . logPrefix
 
 getPrimaryKey' :: IConnection conn
                => conn
+               -> LogChan
                -> String -- ^ owner name
                -> String -- ^ table name
                -> IO [String] -- ^ primary key names
-getPrimaryKey' conn owner' tbl' = do
+getPrimaryKey' conn lchan owner' tbl' = do
     let owner = map toUpper owner'
         tbl = map toUpper tbl'
     prims <- map normalizeColumn . catMaybes <$>
         runQuery' conn primaryKeyQuerySQL (owner, tbl)
-    putLog $ "getPrimaryKey: keys = " ++ show prims
+    putLog lchan $ "getPrimaryKey: keys = " ++ show prims
     return prims
 
-getFields' :: IConnection conn
-           => TypeMap
-           -> conn
-           -> String
-           -> String
-           -> IO ([(String, TypeQ)], [Int])
-getFields' tmap conn owner' tbl' = do
+getColumns' :: IConnection conn
+            => TypeMap
+            -> conn
+            -> LogChan
+            -> String
+            -> String
+            -> IO ([(String, TypeQ)], [Int])
+getColumns' tmap conn lchan owner' tbl' = maybeIO ([], []) id $ do
     let owner = map toUpper owner'
         tbl = map toUpper tbl'
-    cols <- runQuery' conn columnsQuerySQL (owner, tbl)
-    case cols of
-        [] -> compileErrorIO $
-            "getFields: No columns found: owner = " ++ owner ++ ", table = " ++ tbl
-        _ -> return ()
+    cols <- lift $ runQuery' conn columnsQuerySQL (owner, tbl)
+    guard (not $ null cols) <|>
+        compileError lchan
+        ("getFields: No columns found: owner = " ++ owner ++ ", table = " ++ tbl)
     let notNullIdxs = map fst . filter (notNull . snd) . zip [0..] $ cols
-    putLog $
+    lift . putLog lchan $
         "getFields: num of columns = " ++ show (length cols) ++
         ", not null columns = " ++ show notNullIdxs
-    let getType' col = case getType (fromList tmap) col of
-            Nothing -> compileErrorIO $
-                "Type mapping is not defined against Oracle DB type: " ++
-                show (Cols.dataType col)
-            Just p -> return p
+    let getType' col =
+          hoistMaybe (getType (fromList tmap) col) <|>
+          compileError lchan
+          ("Type mapping is not defined against Oracle DB type: " ++ show (Cols.dataType col))
     types <- mapM getType' cols
     return (types, notNullIdxs)
 
 -- | Driver for Oracle DB
 driverOracle :: IConnection conn => Driver conn
 driverOracle =
-    emptyDriver { getFieldsWithMap = getFields' }
+    emptyDriver { getFieldsWithMap = getColumns' }
                 { getPrimaryKey = getPrimaryKey' }
diff --git a/src/Database/HDBC/Schema/PostgreSQL.hs b/src/Database/HDBC/Schema/PostgreSQL.hs
--- a/src/Database/HDBC/Schema/PostgreSQL.hs
+++ b/src/Database/HDBC/Schema/PostgreSQL.hs
@@ -21,12 +21,13 @@
 
 import Data.Char (toLower)
 import Data.Map (fromList)
-import Control.Monad (when)
+import Control.Applicative ((<$>), (<|>))
+import Control.Monad (guard)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Maybe (MaybeT)
 
 import Database.HDBC (IConnection, SqlValue)
 
-import Language.Haskell.TH.Lib.Extra (reportMessage)
-
 import Database.HDBC.Record.Query (runQuery')
 import Database.HDBC.Record.Persistable ()
 
@@ -40,7 +41,8 @@
 import qualified Database.Relational.Schema.PgCatalog.PgType as Type
 
 import Database.HDBC.Schema.Driver
-  (TypeMap, Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
+  (TypeMap, LogChan, putVerbose, failWith, maybeIO, hoistMaybe,
+   Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
 
 
 $(makeRecordPersistableWithSqlTypeDefaultFromDefined
@@ -52,55 +54,56 @@
 logPrefix :: String -> String
 logPrefix =  ("PostgreSQL: " ++)
 
-putLog :: String -> IO ()
-putLog =  reportMessage . logPrefix
+putLog :: LogChan -> String -> IO ()
+putLog lchan = putVerbose lchan . logPrefix
 
-compileErrorIO :: String -> IO a
-compileErrorIO =  fail . logPrefix
+compileError :: LogChan -> String -> MaybeT IO a
+compileError lchan = failWith lchan . logPrefix
 
 getPrimaryKey' :: IConnection conn
-              => conn
-              -> String
-              -> String
-              -> IO [String]
-getPrimaryKey' conn scm' tbl' = do
+               => conn
+               -> LogChan
+               -> String
+               -> String
+               -> IO [String]
+getPrimaryKey' conn lchan scm' tbl' = do
   let scm = map toLower scm'
       tbl = map toLower tbl'
   mayKeyLen <- runQuery' conn primaryKeyLengthQuerySQL (scm, tbl)
   case mayKeyLen of
     []        -> do
-      putLog   "getPrimaryKey: Primary key not found."
+      putLog lchan   "getPrimaryKey: Primary key not found."
       return []
     [keyLen]  -> do
       primCols <- runQuery' conn (primaryKeyQuerySQL keyLen) (scm, tbl)
-      let primaryKeyCols = normalizeColumn `fmap` primCols
-      putLog $ "getPrimaryKey: primary key = " ++ show primaryKeyCols
+      let primaryKeyCols = normalizeColumn <$> primCols
+      putLog lchan $ "getPrimaryKey: primary key = " ++ show primaryKeyCols
       return primaryKeyCols
     _:_:_     -> do
-      putLog   "getPrimaryKey: Fail to detect primary key. Something wrong."
+      putLog lchan   "getPrimaryKey: Fail to detect primary key. Something wrong."
       return []
 
 getColumns' :: IConnection conn
-          => TypeMap
-          -> conn
-          -> String
-          -> String
-          -> IO ([(String, TypeQ)], [Int])
-getColumns' tmap conn scm' tbl' = do
+            => TypeMap
+            -> conn
+            -> LogChan
+            -> String
+            -> String
+            -> IO ([(String, TypeQ)], [Int])
+getColumns' tmap conn lchan scm' tbl' = maybeIO ([], []) id $ do
   let scm = map toLower scm'
       tbl = map toLower tbl'
-  cols <- runQuery' conn columnQuerySQL (scm, tbl)
-  when (null cols) . compileErrorIO
-    $ "getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl
+  cols <- lift $ runQuery' conn columnQuerySQL (scm, tbl)
+  guard (not $ null cols) <|>
+    compileError lchan ("getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl)
 
   let notNullIdxs = map fst . filter (notNull . snd) . zip [0..] $ cols
-  putLog
+  lift . putLog lchan
     $  "getFields: num of columns = " ++ show (length cols)
     ++ ", not null columns = " ++ show notNullIdxs
-  let getType' col = case getType (fromList tmap) col of
-        Nothing -> compileErrorIO
-                   $ "Type mapping is not defined against PostgreSQL type: " ++ Type.typname (snd col)
-        Just p  -> return p
+  let getType' col =
+        hoistMaybe (getType (fromList tmap) col) <|>
+        compileError lchan ("Type mapping is not defined against PostgreSQL type: " ++ Type.typname (snd col))
 
   types <- mapM getType' cols
   return (types, notNullIdxs)
diff --git a/src/Database/HDBC/Schema/SQLServer.hs b/src/Database/HDBC/Schema/SQLServer.hs
--- a/src/Database/HDBC/Schema/SQLServer.hs
+++ b/src/Database/HDBC/Schema/SQLServer.hs
@@ -17,20 +17,26 @@
 import qualified Database.Relational.Schema.SQLServerSyscat.Columns as Columns
 import qualified Database.Relational.Schema.SQLServerSyscat.Types as Types
 
+import Control.Applicative ((<$>), (<|>))
+import Control.Monad (guard)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Maybe (MaybeT)
 import Data.Map (fromList)
 import Data.Maybe (catMaybes)
 import Database.HDBC (IConnection, SqlValue)
 import Database.HDBC.Record.Query (runQuery')
 import Database.HDBC.Record.Persistable ()
-import Database.HDBC.Schema.Driver (TypeMap, Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
+import Database.HDBC.Schema.Driver
+  (TypeMap, LogChan, putVerbose, failWith, maybeIO,
+   Driver, hoistMaybe, getFieldsWithMap, getPrimaryKey, emptyDriver)
 import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
 import Database.Relational.Schema.SQLServer (columnTypeQuerySQL, getType, normalizeColumn,
                                             notNull, primaryKeyQuerySQL)
 import Database.Relational.Schema.SQLServerSyscat.Columns (Columns)
 import Database.Relational.Schema.SQLServerSyscat.Types (Types)
 import Language.Haskell.TH (TypeQ)
-import Language.Haskell.TH.Lib.Extra (reportMessage)
 
+
 $(makeRecordPersistableWithSqlTypeDefaultFromDefined
   [t| SqlValue |] ''Columns)
 
@@ -40,49 +46,51 @@
 logPrefix :: String -> String
 logPrefix = ("SQLServer: " ++)
 
-putLog :: String -> IO ()
-putLog = reportMessage . logPrefix
+putLog :: LogChan -> String -> IO ()
+putLog lchan = putVerbose lchan . logPrefix
 
-compileErrorIO :: String -> IO a
-compileErrorIO =  fail . logPrefix
+compileError :: LogChan -> String -> MaybeT IO a
+compileError lchan = failWith lchan . logPrefix
 
 getPrimaryKey' :: IConnection conn
                => conn
+               -> LogChan
                -> String
                -> String
                -> IO [String]
-getPrimaryKey' conn scm tbl = do
-    prims <- catMaybes `fmap` runQuery' conn primaryKeyQuerySQL (scm,tbl)
+getPrimaryKey' conn lchan scm tbl = do
+    prims <- catMaybes <$> runQuery' conn primaryKeyQuerySQL (scm,tbl)
     let primColumns = map normalizeColumn prims
-    putLog $ "getPrimaryKey: keys=" ++ show primColumns
+    putLog lchan $ "getPrimaryKey: keys=" ++ show primColumns
     return primColumns
 
-getFields' :: IConnection conn
-           => TypeMap
-           -> conn
-           -> String
-           -> String
-           -> IO ([(String, TypeQ)], [Int])
-getFields' tmap conn scm tbl = do
-    rows <- runQuery' conn columnTypeQuerySQL (scm, tbl)
-    case rows of
-      [] -> compileErrorIO
-            $ "getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl
-      _  -> return ()
+getColumns' :: IConnection conn
+            => TypeMap
+            -> conn
+            -> LogChan
+            -> String
+            -> String
+            -> IO ([(String, TypeQ)], [Int])
+getColumns' tmap conn lchan scm tbl = maybeIO ([], []) id $ do
+    rows <- lift $ runQuery' conn columnTypeQuerySQL (scm, tbl)
+    guard (not $ null rows) <|>
+      compileError lchan
+      ("getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl)
     let columnId ((cols,_),_) = Columns.columnId cols - 1
     let notNullIdxs = map (fromIntegral . columnId) . filter notNull $ rows
-    putLog
+    lift . putLog lchan
         $ "getFields: num of columns = " ++ show (length rows)
         ++ ", not null columns = " ++ show notNullIdxs
-    let getType' rec@((_,typs),typScms) = case getType (fromList tmap) rec of
-          Nothing -> compileErrorIO
-                     $ "Type mapping is not defined against SQLServer type: "
-                     ++ typScms ++ "." ++ Types.name typs
-          Just p  -> return p
+    let getType' rec'@((_,typs),typScms) =
+          hoistMaybe (getType (fromList tmap) rec') <|>
+          compileError lchan
+          ("Type mapping is not defined against SQLServer type: "
+           ++ typScms ++ "." ++ Types.name typs)
     types <- mapM getType' rows
     return (types, notNullIdxs)
 
+-- | Driver implementation
 driverSQLServer :: IConnection conn => Driver conn
 driverSQLServer =
-    emptyDriver { getFieldsWithMap = getFields' }
+    emptyDriver { getFieldsWithMap = getColumns' }
                 { getPrimaryKey    = getPrimaryKey' }
diff --git a/src/Database/HDBC/Schema/SQLite3.hs b/src/Database/HDBC/Schema/SQLite3.hs
--- a/src/Database/HDBC/Schema/SQLite3.hs
+++ b/src/Database/HDBC/Schema/SQLite3.hs
@@ -18,12 +18,18 @@
 import qualified Database.Relational.Schema.SQLite3Syscat.IndexList as IndexList
 import qualified Database.Relational.Schema.SQLite3Syscat.TableInfo as TableInfo
 
+import Control.Applicative ((<|>))
+import Control.Monad (guard)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Maybe (MaybeT)
 import Data.List (isPrefixOf, sort, sortBy)
 import Data.Map (fromList)
 import Database.HDBC (IConnection, SqlValue)
 import Database.HDBC.Record.Query (runQuery')
 import Database.HDBC.Record.Persistable ()
-import Database.HDBC.Schema.Driver (TypeMap, Driver, getFieldsWithMap, getPrimaryKey, emptyDriver)
+import Database.HDBC.Schema.Driver
+  (TypeMap, LogChan, putVerbose, failWith, maybeIO,
+   Driver, hoistMaybe, getFieldsWithMap, getPrimaryKey, emptyDriver)
 import Database.Record.TH (makeRecordPersistableWithSqlTypeDefaultFromDefined)
 import Database.Relational.Schema.SQLite3 (getType, indexInfoQuerySQL, indexListQuerySQL, normalizeColumn,
                                            normalizeType, notNull, tableInfoQuerySQL)
@@ -31,7 +37,6 @@
 import Database.Relational.Schema.SQLite3Syscat.IndexList (IndexList)
 import Database.Relational.Schema.SQLite3Syscat.TableInfo (TableInfo)
 import Language.Haskell.TH (TypeQ)
-import Language.Haskell.TH.Lib.Extra (reportMessage)
 
 $(makeRecordPersistableWithSqlTypeDefaultFromDefined
   [t| SqlValue |] ''TableInfo)
@@ -45,23 +50,24 @@
 logPrefix :: String -> String
 logPrefix = ("SQLite3: " ++)
 
-putLog :: String -> IO ()
-putLog = reportMessage . logPrefix
+putLog :: LogChan -> String -> IO ()
+putLog lchan = putVerbose lchan . logPrefix
 
-compileErrorIO :: String -> IO a
-compileErrorIO =  fail . logPrefix
+compileError :: LogChan -> String -> MaybeT IO a
+compileError lchan = failWith lchan . logPrefix
 
 getPrimaryKey' :: IConnection conn
                => conn
+               -> LogChan
                -> String
                -> String
                -> IO [String]
-getPrimaryKey' conn scm tbl = do
+getPrimaryKey' conn lchan scm tbl = do
     tblinfo <- runQuery' conn (tableInfoQuerySQL scm tbl) ()
-    let primColumns = map (normalizeColumn . TableInfo.name)
-                      . filter ((1 ==) . TableInfo.pk) $ tblinfo
+    let primColumns = [ normalizeColumn $ TableInfo.name ti
+                      | ti <- tblinfo, TableInfo.pk ti == 1 ]
     if length primColumns <= 1 then do
-        putLog $ "getPrimaryKey: key=" ++ show primColumns
+        putLog lchan $ "getPrimaryKey: key=" ++ show primColumns
         return primColumns
      else do
         idxlist <- runQuery' conn (indexListQuerySQL scm tbl) ()
@@ -73,35 +79,36 @@
         let idxInfo = concat . take 1 . filter isPrimaryKey $ idxInfos
         let comp x y = compare (IndexInfo.seqno x) (IndexInfo.seqno y)
         let primColumns' = map IndexInfo.name . sortBy comp $ idxInfo
-        putLog $ "getPrimaryKey: keys=" ++ show primColumns'
+        putLog lchan $ "getPrimaryKey: keys=" ++ show primColumns'
         return primColumns'
 
-getFields' :: IConnection conn
-           => TypeMap
-           -> conn
-           -> String
-           -> String
-           -> IO ([(String, TypeQ)], [Int])
-getFields' tmap conn scm tbl = do
-    rows <- runQuery' conn (tableInfoQuerySQL scm tbl) ()
-    case rows of
-      [] -> compileErrorIO
-            $ "getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl
-      _  -> return ()
+getColumns' :: IConnection conn
+            => TypeMap
+            -> conn
+            -> LogChan
+            -> String
+            -> String
+            -> IO ([(String, TypeQ)], [Int])
+getColumns' tmap conn lchan scm tbl = maybeIO ([], []) id $ do
+    rows <- lift $ runQuery' conn (tableInfoQuerySQL scm tbl) ()
+    guard (not $ null rows) <|>
+      compileError lchan
+      ("getFields: No columns found: schema = " ++ scm ++ ", table = " ++ tbl)
     let columnId = TableInfo.cid
     let notNullIdxs = map (fromIntegral . columnId) . filter notNull $ rows
-    putLog
+    lift . putLog lchan
         $ "getFields: num of columns = " ++ show (length rows)
         ++ ", not null columns = " ++ show notNullIdxs
-    let getType' ti = case getType (fromList tmap) ti of
-          Nothing -> compileErrorIO
-                     $ "Type mapping is not defined against SQLite3 type: "
-                     ++ normalizeType (TableInfo.ctype ti)
-          Just p  -> return p
+    let getType' ti =
+          hoistMaybe (getType (fromList tmap) ti) <|>
+          compileError lchan
+          ("Type mapping is not defined against SQLite3 type: "
+           ++ normalizeType (TableInfo.ctype ti))
     types <- mapM getType' rows
     return (types, notNullIdxs)
 
+-- | Driver implementation
 driverSQLite3 :: IConnection conn => Driver conn
 driverSQLite3 =
-    emptyDriver { getFieldsWithMap = getFields' }
+    emptyDriver { getFieldsWithMap = getColumns' }
                 { getPrimaryKey    = getPrimaryKey' }