specify schema as a string everywhere in the app.

This will make it easier to support semantic API versioning,
and makes code reuse easier right now.

src/Dbapi.hs

@@ -12,7 +12,6 @@ import Control.Applicative
 import Options.Applicative hiding (columns)
 
 import Data.Maybe (fromMaybe, isJust)
-import Text.Read (readMaybe)
 import Text.Regex.TDFA ((=~))
 import Data.Map (intersection, fromList, toList, Map)
 import Data.List (sort)
@@ -84,7 +83,7 @@ app conn req respond = do
         if range == Just emptyRange
         then return $ responseLBS status416 [] "HTTP Range error"
         else do
-          r <- respondWithRangedResult <$> getRows (show ver) (unpack table) qq range conn
+          r <- respondWithRangedResult <$> getRows ver (unpack table) qq range conn
           let canonical = urlEncodeVars $ sort $
                           map (join (***) BS.unpack) $
                           parseSimpleQuery $
@@ -142,7 +141,7 @@ app conn req respond = do
     path   = pathInfo req
     verb   = requestMethod req
     qq     = queryString req
-    ver    = fromMaybe 1 $ requestedVersion (requestHeaders req)
+    ver    = fromMaybe "1" $ requestedVersion (requestHeaders req)
     range  = requestedRange (requestHeaders req)
     cRange = requestedContentRange (requestHeaders req)
 
@@ -169,10 +168,10 @@ respondWithRangedResult rr =
       | (1 + to - from) < total = status206
       | otherwise               = status200
 
-requestedVersion :: RequestHeaders -> Maybe Int
+requestedVersion :: RequestHeaders -> Maybe String
 requestedVersion hdrs =
   case verStr of
-       Just [[_, ver]] -> readMaybe ver
+       Just [[_, ver]] -> Just ver
        _ -> Nothing
 
   where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String

src/PgQuery.hs

@@ -36,8 +36,9 @@ data RangedResult = RangedResult {
 } deriving (Show)
 
 type QuotedSql = (String, [SqlValue])
+type Schema = String
 
-getRows :: String -> String -> Net.Query -> Maybe R.NonnegRange -> Connection -> IO RangedResult
+getRows :: Schema -> String -> Net.Query -> Maybe R.NonnegRange -> Connection -> IO RangedResult
 getRows schema table qq range conn = do
   query <- populateSql conn
     $ globalAndLimitedCounts schema table qq <>
@@ -88,18 +89,18 @@ limitClause range =
     limit  = fromMaybe "ALL" $ show <$> (R.limit =<< range)
     offset = fromMaybe 0     $ R.offset <$> range
 
-globalAndLimitedCounts :: String -> String -> Net.Query -> QuotedSql
+globalAndLimitedCounts :: Schema -> String -> Net.Query -> QuotedSql
 globalAndLimitedCounts schema table qq =
   (" select ", [])
   <> ("(select count(1) from %I.%I ", map toSql [schema, table])
   <> whereClause qq
   <> ("), count(t), ", [])
 
-selectStarClause :: String -> String -> QuotedSql
+selectStarClause :: Schema -> String -> QuotedSql
 selectStarClause schema table =
   (" select * from %I.%I ", map toSql [schema, table])
 
-selectCountClause :: String -> String -> QuotedSql
+selectCountClause :: Schema -> String -> QuotedSql
 selectCountClause schema table =
   (" select count(1) from %I.%I ", map toSql [schema, table])
 
@@ -107,7 +108,7 @@ jsonArrayRows :: QuotedSql -> QuotedSql
 jsonArrayRows q =
   ("array_to_json(array_agg(row_to_json(t))) from (", []) <> q <> (") t", [])
 
-insert :: Int -> Text -> SqlRow -> Connection -> IO (M.Map String SqlValue)
+insert :: Schema -> Text -> SqlRow -> Connection -> IO (M.Map String SqlValue)
 insert schema table row conn = do
   sql    <- populateSql conn $ insertClause schema table row
   stmt   <- prepare conn sql
@@ -115,7 +116,7 @@ insert schema table row conn = do
   Just m <- fetchRowMap stmt
   return m
 
-upsert :: Int -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map String SqlValue)
+upsert :: Schema -> Text -> SqlRow -> Net.Query -> Connection -> IO (M.Map String SqlValue)
 upsert schema table row qq conn = do
   sql    <- populateSql conn $ upsertClause schema table row qq
   stmt   <- prepare conn (traceShow sql sql)
@@ -126,26 +127,26 @@ upsert schema table row qq conn = do
 placeholders :: String -> SqlRow -> String
 placeholders symbol = intercalate ", " . map (const symbol) . getRow
 
-insertClause :: Int -> Text -> SqlRow -> QuotedSql
+insertClause :: Schema -> Text -> SqlRow -> QuotedSql
 insertClause schema table row =
     ("insert into %I.%I (" ++ placeholders "%I" row ++ ")",
-     map toSql $ (pack . show $ schema) : table : sqlRowColumns row)
+     map toSql $ (pack schema) : table : sqlRowColumns row)
   <> (" values (" ++ placeholders "?" row ++ ") returning *", sqlRowValues row)
 
 
-insertClauseViaSelect :: Int -> Text -> SqlRow -> QuotedSql
+insertClauseViaSelect :: Schema -> Text -> SqlRow -> QuotedSql
 insertClauseViaSelect schema table row =
     ("insert into %I.%I (" ++ placeholders "%I" row ++ ")",
-     map toSql $ (pack . show $ schema) : table : sqlRowColumns row)
+     map toSql $ (pack schema) : table : sqlRowColumns row)
   <> (" select " ++ placeholders "?" row, sqlRowValues row)
 
-updateClause :: Int -> Text -> SqlRow -> QuotedSql
+updateClause :: Schema -> Text -> SqlRow -> QuotedSql
 updateClause schema table row =
     ("update %I.%I set (" ++ placeholders "%I" row ++ ")",
-     map toSql $ (pack . show $ schema) : table : sqlRowColumns row)
+     map toSql $ (pack schema) : table : sqlRowColumns row)
   <> (" = (" ++ placeholders "?" row ++ ")", [])
 
-upsertClause :: Int -> Text -> SqlRow -> Net.Query -> QuotedSql
+upsertClause :: Schema -> Text -> SqlRow -> Net.Query -> QuotedSql
 upsertClause schema table row qq =
   ("with upsert as (", []) <> updateClause schema table row
   <> whereClause qq

src/PgStructure.hs

@@ -88,7 +88,7 @@ tables s conn = do
         (toBool (fromSql insertable))
     mkTable _ = Nothing
 
-columns :: Int -> String -> Connection -> IO [Column]
+columns :: String -> String -> Connection -> IO [Column]
 columns s t conn = do
   r <- quickQuery conn
         "select table_schema, table_name, column_name, ordinal_position,\
@@ -96,7 +96,7 @@ columns s t conn = do
         \       character_maximum_length, numeric_precision\
         \  from information_schema.columns\
         \ where table_schema = ?\
-        \   and table_name = ?" [toSql (show s), toSql t]
+        \   and table_name = ?" [toSql s, toSql t]
   return $ mapMaybe mkColumn r
 
   where
@@ -115,10 +115,10 @@ columns s t conn = do
 namedColumnHash :: [Column] -> HashMap String Column
 namedColumnHash = fromList . (Prelude.zip =<< Prelude.map colName)
 
-printTables :: Int -> Connection -> IO BL.ByteString
-printTables schema conn = JSON.encode <$> tables (show schema) conn
+printTables :: String -> Connection -> IO BL.ByteString
+printTables schema conn = JSON.encode <$> tables schema conn
 
-printColumns :: Int -> String -> Connection -> IO BL.ByteString
+printColumns :: String -> String -> Connection -> IO BL.ByteString
 printColumns schema table conn =
   JSON.encode <$> (TableOptions <$> cols <*> pkey)
   where
@@ -127,7 +127,7 @@ printColumns schema table conn =
     pkey :: IO [String]
     pkey = primaryKeyColumns schema table conn
 
-primaryKeyColumns :: Int -> String -> Connection -> IO [String]
+primaryKeyColumns :: String -> String -> Connection -> IO [String]
 primaryKeyColumns s t conn = do
   r <- quickQuery conn
         "select kc.column_name \
@@ -139,5 +139,5 @@ primaryKeyColumns s t conn = do
         \  and kc.table_name = tc.table_name and kc.table_schema = tc.table_schema \
         \  and kc.constraint_name = tc.constraint_name \
         \  and kc.table_schema = ? \
-        \  and kc.table_name  = ?" [toSql (show s), toSql t]
+        \  and kc.table_name  = ?" [toSql s, toSql t]
   return $ map fromSql (concat r)