Using pattern matching for routing

This commit is contained in:
Joe Nelson
2014-08-02 16:34:08 -07:00
parent ce361643fa
commit 50cd701624
2 changed files with 25 additions and 14 deletions
+14 -11
View File
@@ -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
[] -> responseLBS status200 [json] <$> (printTables ver =<< conn)
[table] -> if range == Just emptyRange
then return $ responseLBS status416 [] "HTTP Range error"
else responseLBS status200 [json] <$>
( if verb == methodOptions
then printColumns ver table =<< conn
else
selectWhere (T.pack $ show ver) table qq range =<< conn )
_ -> return $ responseLBS status404 [] ""
case (path, verb) of
([], _) ->
responseLBS status200 [json] <$> (printTables ver =<< conn)
([table], "OPTIONS") ->
responseLBS status200 [json] <$> (printColumns ver table =<< conn)
([table], "GET") ->
if range == Just emptyRange
then return $ responseLBS status416 [] "HTTP Range error"
else responseLBS status200 [json] <$> (
selectWhere (T.pack $ show ver) table qq range =<< conn
)
(_, _) ->
return $ responseLBS status404 [] ""
respond $ either sqlErrorHandler id r
+11 -3
View File
@@ -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
[[json]] -> fromSql json
_ -> "" :: BL.ByteString
let body = case r of
[[json]] -> fromSql json
_ -> "" :: BL.ByteString
return body
where
limit = fromMaybe "ALL" $ show <$> (R.limit =<< range)