Use accept header version to set schema

Main.hs

@@ -22,10 +22,10 @@ import qualified Data.ByteString.Char8 as BS
 import PgStructure (printTables, printColumns)
 import PgQuery     (selectWhere)
 
-import Debug.Trace
-
-traceThis :: (Show a) => a -> a
-traceThis x = trace (show x) x
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import Text.Regex.Posix ((=~))
+import Text.Read (readMaybe)
 
 data AppConfig = AppConfig {
     configDbUri :: String
@@ -52,11 +52,11 @@ app ::  AppConfig -> Application
 app config req respond = do
   r <- try $
     case path of
-      []      -> responseLBS status200 [json] <$> (printTables =<< conn)
+      []      -> responseLBS status200 [json] <$> (printTables ver =<< conn)
       [table] -> responseLBS status200 [json] <$>
                 ( if verb == methodOptions
                   then printColumns table =<< conn
-                  else selectWhere table qq =<< conn )
+                  else selectWhere (T.pack $ show ver) table qq =<< conn )
       _       -> return $ responseLBS status404 [] ""
 
   respond $ either sqlErrorHandler id r
@@ -67,6 +67,17 @@ app config req respond = do
     json = (hContentType, "application/json")
     conn = connectPostgreSQL $ configDbUri config
     qq   = queryString req
+    ver  = fromMaybe 1 $ requestedVersion (requestHeaders req)
+
+requestedVersion :: RequestHeaders -> Maybe Int
+requestedVersion hdrs =
+  case verStr of
+       Just [[_, ver]] -> readMaybe ver
+       _ -> Nothing
+
+  where verRegex = "version[ ]*=[ ]*([0-9]+)" :: String
+        accept = BS.unpack <$> lookup hAccept hdrs :: Maybe String
+        verStr = (=~ verRegex) <$> accept :: Maybe [[String]]
 
 sqlErrorHandler :: SqlError -> Response
 sqlErrorHandler e =

PgQuery.hs

@@ -16,8 +16,8 @@ import Database.HDBC.PostgreSQL
 
 import Network.HTTP.Types.URI
 
-selectWhere :: T.Text -> Query -> Connection -> IO BL.ByteString
-selectWhere table qq conn = do
+selectWhere :: T.Text -> T.Text -> Query -> Connection -> IO BL.ByteString
+selectWhere ver table qq conn = do
   s <- selectSql
   w <- whereClause conn qq
   r <- quickQuery conn (BS.unpack $ s <> w) []
@@ -29,7 +29,7 @@ selectWhere table qq conn = do
     selectSql = pgFormat conn
           "select array_to_json(array_agg(row_to_json(t)))\
           \  from (select * from %I.%I) t"
-        [toSql (T.pack "base"), toSql table]
+        [toSql ver, toSql table]
 
 
 whereClause :: Connection -> Query -> IO BS.ByteString

PgStructure.hs

@@ -97,8 +97,8 @@ columns t conn = do
 namedColumnHash :: [Column] -> HashMap String Column
 namedColumnHash = fromList . (Prelude.zip =<< Prelude.map colName)
 
-printTables :: Connection -> IO BL.ByteString
-printTables conn = JSON.encode <$> tables "base" conn
+printTables :: Int -> Connection -> IO BL.ByteString
+printTables schema conn = JSON.encode <$> tables (show schema) conn
 
 printColumns :: T.Text -> Connection -> IO BL.ByteString
 printColumns table conn = JSON.encode . namedColumnHash <$> columns table conn

dbapi.cabal

@@ -22,5 +22,6 @@ executable dbapi
                      , bytestring, aeson, network
                      , text, optparse-applicative
                      , unordered-containers
+                     , http-media, regex-posix
   -- hs-source-dirs:
   default-language:    Haskell2010