flip args to inTransaction

This commit is contained in:
Adam C. Baker
2014-10-10 17:32:17 -07:00
parent e4669dcb37
commit a984fe3bf9
2 changed files with 7 additions and 8 deletions
+2 -2
View File
@@ -41,8 +41,8 @@ main = do
Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String) Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String)
conn <- connectPostgreSQL' dburi conn <- connectPostgreSQL' dburi
runTLS tls settings $ gzip def $ cors corsPolicy $ runTLS tls settings . gzip def . cors corsPolicy $
inTransaction conn (app (cs $ configAnonRole conf)) inTransaction (app (cs $ configAnonRole conf)) conn
where where
describe = progDesc "create a REST API to an existing Postgres database" describe = progDesc "create a REST API to an existing Postgres database"
+5 -6
View File
@@ -10,14 +10,13 @@ import Database.HDBC.PostgreSQL (Connection)
import Network.HTTP.Types.Header (hContentType) import Network.HTTP.Types.Header (hContentType)
import Network.HTTP.Types.Status (status400) import Network.HTTP.Types.Status (status400)
import Database.HDBC.Types (SqlError(..)) import Database.HDBC.Types (SqlError(..))
import Network.Wai (Application, Request, Response, ResponseReceived, responseLBS) import Network.Wai (Application, responseLBS)
import Control.Exception (finally, catchJust) import Control.Exception (finally, catchJust)
type ResHandler = Response -> IO ResponseReceived
inTransaction :: Connection -> (Connection -> Application) -> Request -> ResHandler -> IO ResponseReceived inTransaction :: (Connection -> Application) -> (Connection -> Application)
inTransaction conn app req respond = inTransaction app conn req respond =
finally (putStrLn "begin txn" >> runRaw conn "begin" >> app conn req respond) (putStrLn "commit txn" >> runRaw conn "commit") finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit")
instance ToJSON SqlError where instance ToJSON SqlError where
toJSON t = object [ toJSON t = object [
@@ -28,7 +27,7 @@ instance ToJSON SqlError where
] ]
] ]
reportPgErrors :: Application -> Request -> ResHandler -> IO ResponseReceived reportPgErrors :: Application -> Application
reportPgErrors app req respond = reportPgErrors app req respond =
catchJust isPgException (app req respond) ( catchJust isPgException (app req respond) (
respond . responseLBS status400 [(hContentType, "application/json")] respond . responseLBS status400 [(hContentType, "application/json")]