Using pattern matching for routing

Main.hs

@@ -14,7 +14,6 @@ import Network.Wai
 import Network.Wai.Handler.Warp hiding (Connection)
 import Network.HTTP.Types.Status
 import Network.HTTP.Types.Header
-import Network.HTTP.Types.Method
 
 import Options.Applicative hiding (columns)
 
@@ -63,16 +62,20 @@ traceThis x = trace (show x) x
 app ::  AppConfig -> Application
 app config req respond = do
   r <- try $
-    case path of
+    case (path, verb) of
-      []      -> responseLBS status200 [json] <$> (printTables ver =<< conn)
+      ([], _) ->
-      [table] -> if range == Just emptyRange
+        responseLBS status200 [json] <$> (printTables ver =<< conn)
-                then return $ responseLBS status416 [] "HTTP Range error"
+      ([table], "OPTIONS") ->
-                else responseLBS status200 [json] <$>
+        responseLBS status200 [json] <$> (printColumns ver table =<< conn)
-                ( if verb == methodOptions
+      ([table], "GET") ->
-                  then printColumns ver table =<< conn
+        if range == Just emptyRange
-                  else
+        then return $ responseLBS status416 [] "HTTP Range error"
-                      selectWhere (T.pack $ show ver) table qq range =<< conn )
+        else responseLBS status200 [json] <$> (
-      _       -> return $ responseLBS status404 [] ""
+          selectWhere (T.pack $ show ver) table qq range =<< conn
+        )
+      (_, _) ->
+        return $ responseLBS status404 [] ""
+
 
   respond $ either sqlErrorHandler id r
 

PgQuery.hs

@@ -17,15 +17,23 @@ import Database.HDBC.PostgreSQL
 
 import Network.HTTP.Types.URI
 
+data RangedResult = RangedResult {
+  rrFrom  :: Int
+, rrTo    :: Int
+, rrTotal :: Int
+, rrBody  :: BL.ByteString
+}
+
 selectWhere :: T.Text -> T.Text -> Query -> Maybe R.NonnegRange -> Connection -> IO BL.ByteString
 selectWhere ver table qq range conn = do
   s <- selectSql
   w <- whereClause conn qq
   r <- quickQuery conn (BS.unpack $ s <> w) []
 
-  return $ case r of
+  let body = case r of
-                [[json]] -> fromSql json
+             [[json]] -> fromSql json
-                _        -> "" :: BL.ByteString
+             _        -> "" :: BL.ByteString
+  return body
 
   where
     limit = fromMaybe "ALL" $ show <$> (R.limit =<< range)