Switch to HDBC

Fixes #2

PgStructure.hs

@@ -1,20 +1,20 @@
-{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module PgStructure where
 
-import Control.Applicative
+import Data.Functor ( (<$>) )
+import Data.Maybe (mapMaybe)
+import Data.List (intercalate)
 
-import Data.HashMap.Strict
+import Data.HashMap.Strict hiding (map)
 
 import qualified Data.Text as T
 import qualified Data.ByteString.Lazy as BL
 
 import qualified Data.Aeson as JSON
 
-import Database.PostgreSQL.Simple
-import Database.PostgreSQL.Simple.Types
-import Database.PostgreSQL.Simple.FromRow
-import Database.PostgreSQL.Simple.SqlQQ
+import Database.HDBC hiding (colType, colNullable)
+import Database.HDBC.PostgreSQL
 
 import Data.Aeson ((.=))
 
@@ -24,9 +24,6 @@ data Table = Table {
 , tableInsertable :: Bool
 } deriving (Show)
 
-instance FromRow Table where
-  fromRow = Table <$> field <*> field <*> fmap toBool field
-
 instance JSON.ToJSON Table where
   toJSON v = JSON.object [
       "schema"     .= tableSchema v
@@ -48,12 +45,6 @@ data Column = Column {
 , colPrecision :: Maybe Int
 } deriving (Show)
 
-instance FromRow Column where
-  fromRow = Column <$> field <*> field <*> field <*> field <*>
-                       fmap toBool field <*> field <*>
-                       fmap toBool field <*>
-                       field <*> field
-
 instance JSON.ToJSON Column where
   toJSON c = JSON.object [
       "schema"    .= colSchema c
@@ -66,21 +57,43 @@ instance JSON.ToJSON Column where
     , "precision" .= colPrecision c ]
 
 tables :: String -> Connection -> IO [Table]
-tables s conn = query conn q $ Only s
-  where q = [sql|
-              select table_schema, table_name,
-                     is_insertable_into
-                from information_schema.tables
-               where table_schema = ? |]
+tables s conn = do
+  r <- quickQuery conn
+        "select table_schema, table_name,\
+        \       is_insertable_into\
+        \  from information_schema.tables\
+        \ where table_schema = ?" [toSql s]
+  return $ mapMaybe mkTable r
+
+  where
+    mkTable [schema, name, insertable] =
+      Just $ Table (fromSql schema)
+        (fromSql name)
+        (toBool (fromSql insertable))
+    mkTable _ = Nothing
 
 columns :: T.Text -> Connection -> IO [Column]
-columns t conn = query conn q $ Only t
-  where q = [sql|
-              select table_schema, table_name, column_name, ordinal_position,
-                     is_nullable, data_type, is_updatable,
-                     character_maximum_length, numeric_precision
-                from information_schema.columns
-               where table_name = ? |]
+columns t conn = do
+  r <- quickQuery conn
+        "select table_schema, table_name, column_name, ordinal_position,\
+        \       is_nullable, data_type, is_updatable,\
+        \       character_maximum_length, numeric_precision\
+        \  from information_schema.columns\
+        \ where table_name = ?" [toSql t]
+  return $ mapMaybe mkColumn r
+
+  where
+    mkColumn [schema, table, name, pos, nullable, colT, updatable, maxlen, precision] =
+      Just $ Column (fromSql schema)
+        (fromSql table)
+        (fromSql name)
+        (fromSql pos)
+        (toBool (fromSql nullable))
+        (fromSql colT)
+        (toBool (fromSql updatable))
+        (fromSql maxlen)
+        (fromSql precision)
+    mkColumn _ = Nothing
 
 namedColumnHash :: [Column] -> HashMap String Column
 namedColumnHash = fromList . (Prelude.zip =<< Prelude.map colName)
@@ -91,10 +104,24 @@ printTables conn = JSON.encode <$> tables "base" conn
 printColumns :: T.Text -> Connection -> IO BL.ByteString
 printColumns table conn = JSON.encode . namedColumnHash <$> columns table conn
 
-selectAll :: T.Text -> Connection -> IO JSON.Value
-selectAll table conn = fromOnly <$> Prelude.head <$> query conn q (Only safeName)
+selectAll :: T.Text -> Connection -> IO BL.ByteString
+selectAll table conn = do
+  sql <- prepareDynamic conn
+    "select array_to_json(array_agg(row_to_json(t)))\
+    \  from (select * from %I.%I) t" [toSql (T.pack "base"), toSql table]
+  r <- quickQuery conn sql []
+  return $ case r of
+                [[json]] -> fromSql json
+                _        -> "" :: BL.ByteString
+
+prepareDynamic :: Connection -> String -> [SqlValue] -> IO String
+prepareDynamic conn sql args = do
+  let q = (concat [ "select format('", sql, "', ", placeholders args, ")" ])
+  r <- quickQuery conn q args
+
+  return $ case r of
+                [[formatted]] -> fromSql formatted
+                _             -> ""
+
   where
-    q = [sql|
-          select array_to_json(array_agg(row_to_json(t)))
-            from (select * from ?) t; |]
-    safeName = QualifiedIdentifier (Just "base") table
+    placeholders = intercalate ", " . map (const "?::varchar")