From 0548d65911e8d52688838b25906b14f1a43b690b Mon Sep 17 00:00:00 2001 From: Ruslan Talpa Date: Mon, 29 Feb 2016 13:57:34 +0200 Subject: [PATCH] main module of the executable needs to be Main, with PostgREST.Main build fails --- postgrest.cabal | 10 +++++----- src/PostgREST/App.hs | 24 ++++++++++++++++++++++-- src/PostgREST/Main.hs | 28 +++++----------------------- test/Main.hs | 6 +++--- 4 files changed, 35 insertions(+), 33 deletions(-) diff --git a/postgrest.cabal b/postgrest.cabal index 7eb0931ab..9e3e8965c 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -104,12 +104,13 @@ library , time , unordered-containers , vector - , wai - , wai-cors - , wai-extra - , wai-middleware-static , HTTP , Ranged-sets + , wai >= 3.0.1 + , wai-cors + , wai-extra + , wai-middleware-static >= 0.6.0 + , warp >= 3.1.0 Other-Modules: Paths_postgrest Exposed-Modules: PostgREST.App @@ -145,7 +146,6 @@ Test-Suite spec , PostgREST.Auth , PostgREST.Config , PostgREST.Error - , PostgREST.Main , PostgREST.Middleware , PostgREST.Parsers , PostgREST.DbStructure diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 445e6bcdd..ea31156f8 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -3,7 +3,7 @@ {-# LANGUAGE TupleSections #-} --module PostgREST.App where module PostgREST.App ( - app + handleRequest ) where import Control.Applicative @@ -17,6 +17,7 @@ import Data.Ranged.Ranges (emptyRange) import Data.String.Conversions (cs) import Data.Text (Text, replace, strip) import Data.Tree +import Data.Time.Clock.POSIX (getPOSIXTime) import Text.Parsec.Error import Text.ParserCombinators.Parsec (parse) @@ -26,13 +27,18 @@ import Network.HTTP.Types.Header import Network.HTTP.Types.Status import Network.HTTP.Types.URI (parseSimpleQuery) import Network.Wai +import Network.Wai.Middleware.RequestLogger (logStdout) + +import qualified Hasql.Pool as P import Data.Aeson import Data.Aeson.Types (emptyArray) import Data.Monoid import qualified Data.Vector as V import qualified Hasql.Transaction as H - +import qualified Hasql.Transaction as HT +import PostgREST.Error (pgErrResponse) +import PostgREST.Middleware import PostgREST.Config (AppConfig (..)) import PostgREST.Parsers import PostgREST.DbStructure @@ -58,6 +64,20 @@ import PostgREST.QueryBuilder ( callProc import Prelude +handleRequest :: AppConfig -> DbStructure -> P.Pool -> Application +handleRequest conf dbStructure pool = + let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in + + middle $ \ req respond -> do + time <- getPOSIXTime + body <- strictRequestBody req + + let handleReq = runWithClaims conf time (app dbStructure conf body) req + resp <- either pgErrResponse id <$> P.use pool + (HT.run handleReq HT.ReadCommitted HT.Write) + respond resp + + app :: DbStructure -> AppConfig -> RequestBody -> Request -> H.Transaction Response app dbStructure conf reqBody req = let diff --git a/src/PostgREST/Main.hs b/src/PostgREST/Main.hs index c3aa95563..e8240a8ee 100644 --- a/src/PostgREST/Main.hs +++ b/src/PostgREST/Main.hs @@ -1,31 +1,26 @@ {-# LANGUAGE CPP #-} -module PostgREST.Main where +module Main where -import PostgREST.App +import PostgREST.App (handleRequest) import PostgREST.Config (AppConfig (..), minimumPgVersion, prettyVersion, readOptions) import PostgREST.DbStructure -import PostgREST.Error (pgErrResponse) -import PostgREST.Middleware -import PostgREST.Types (DbStructure) import Control.Monad import Data.Monoid ((<>)) import Data.String.Conversions (cs) -import Data.Time.Clock.POSIX (getPOSIXTime) + import qualified Hasql.Query as H import qualified Hasql.Session as H -import qualified Hasql.Transaction as HT import qualified Hasql.Decoders as HD import qualified Hasql.Encoders as HE import qualified Hasql.Pool as P -import Network.Wai import Network.Wai.Handler.Warp -import Network.Wai.Middleware.RequestLogger (logStdout) + import System.IO (BufferMode (..), hSetBuffering, stderr, stdin, stdout) @@ -81,17 +76,4 @@ main = do getDbStructure (cs $ configSchema conf) let dbStructure = either (error.show) id result - runSettings appSettings $ postgrest conf dbStructure pool - -postgrest :: AppConfig -> DbStructure -> P.Pool -> Application -postgrest conf dbStructure pool = - let middle = (if configQuiet conf then id else logStdout) . defaultMiddle in - - middle $ \ req respond -> do - time <- getPOSIXTime - body <- strictRequestBody req - - let handleReq = runWithClaims conf time (app dbStructure conf body) req - resp <- either pgErrResponse id <$> P.use pool - (HT.run handleReq HT.ReadCommitted HT.Write) - respond resp + runSettings appSettings $ handleRequest conf dbStructure pool diff --git a/test/Main.hs b/test/Main.hs index cc52c0fb4..05316e250 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -6,7 +6,7 @@ import SpecHelper import qualified Hasql.Pool as P import PostgREST.DbStructure (getDbStructure) -import PostgREST.Main (postgrest) +import PostgREST.App (handleRequest) import Data.String.Conversions (cs) import qualified Feature.AuthSpec @@ -27,8 +27,8 @@ main = do result <- P.use pool $ getDbStructure "test" let dbStructure = either (error.show) id result - withApp = return $ postgrest testCfg dbStructure pool - ltdApp = return $ postgrest testLtdRowsCfg dbStructure pool + withApp = return $ handleRequest testCfg dbStructure pool + ltdApp = return $ handleRequest testLtdRowsCfg dbStructure pool hspec $ do mapM_ (beforeAll_ resetDb . before withApp) specs