change Raw to Raw a m instead of Raw m a

This commit is contained in:
Brandon Martin 2015-07-31 10:07:38 -06:00
parent 7a6f7dad5a
commit 3165b43165
20 changed files with 64 additions and 37 deletions

View file

@ -621,7 +621,6 @@ instance (KnownSymbol sym, HasClient sublayout)
instance HasClient Raw where instance HasClient Raw where
type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw
clientWithRoute :: Proxy (Raw m a) -> Req -> BaseUrl -> Manager -> Client (Raw m a) clientWithRoute :: Proxy (Raw m a) -> Req -> BaseUrl -> Manager -> Client (Raw m a)
clientWithRoute Proxy req baseurl manager httpMethod = do clientWithRoute Proxy req baseurl manager httpMethod = do
performRequest httpMethod req (const True) baseurl manager performRequest httpMethod req (const True) baseurl manager

View file

@ -84,8 +84,8 @@ type Api =
:<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person :<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
:<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person] :<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
:<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool :<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
:<|> "rawSuccess" :> Raw IO Application :<|> "rawSuccess" :> Raw Application IO
:<|> "rawFailure" :> Raw IO Application :<|> "rawFailure" :> Raw Application IO
:<|> "multiple" :> :<|> "multiple" :>
Capture "first" String :> Capture "first" String :>
QueryParam "second" Int :> QueryParam "second" Int :>
@ -126,9 +126,9 @@ withServer :: (BaseUrl -> IO a) -> IO a
withServer action = withWaiDaemon (return server) action withServer action = withWaiDaemon (return server) action
type FailApi = type FailApi =
"get" :> Raw IO Application "get" :> Raw Application IO
:<|> "capture" :> Capture "name" String :> Raw IO Application :<|> "capture" :> Capture "name" String :> Raw Application IO
:<|> "body" :> Raw IO Application :<|> "body" :> Raw Application IO
failApi :: Proxy FailApi failApi :: Proxy FailApi
failApi = Proxy failApi = Proxy

View file

@ -940,8 +940,8 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
symP = Proxy :: Proxy sym symP = Proxy :: Proxy sym
instance HasDocs Raw where instance HasDocs (Raw a m) where
docsFor _proxy (endpoint, action) _ = docsFor _proxy (endpoint, action) =
single endpoint action single endpoint action
-- TODO: We use 'AllMimeRender' here because we need to be able to show the -- TODO: We use 'AllMimeRender' here because we need to be able to show the

View file

@ -21,8 +21,8 @@ import qualified Network.SocketIO as SocketIO
import Chat (ServerState (..), eioServer) import Chat (ServerState (..), eioServer)
type API = "socket.io" :> Raw type API = "socket.io" :> Raw Application IO
:<|> Raw :<|> Raw Application IO
api :: Proxy API api :: Proxy API

View file

@ -15,7 +15,7 @@ import Servant
import Servant.Docs import Servant.Docs
import qualified T3 import qualified T3
type DocsAPI = T3.API :<|> Raw type DocsAPI = T3.API :<|> Raw Apllication IO
instance ToCapture (Capture "x" Int) where instance ToCapture (Capture "x" Int) where
toCapture _ = DocCapture "x" "(integer) position on the x axis" toCapture _ = DocCapture "x" "(integer) position on the x axis"

View file

@ -6,7 +6,7 @@ module T6 where
import Network.Wai import Network.Wai
import Servant import Servant
type API = "code" :> Raw type API = "code" :> Raw Application IO
api :: Proxy API api :: Proxy API
api = Proxy api = Proxy

View file

@ -75,7 +75,7 @@ searchBook (Just q) = return (mkSearch q books')
type API = "point" :> Get '[JSON] Point type API = "point" :> Get '[JSON] Point
:<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book) :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book)
type API' = API :<|> Raw type API' = API :<|> Raw Application IO
api :: Proxy API api :: Proxy API
api = Proxy api = Proxy

View file

@ -50,7 +50,7 @@ currentValue counter = liftIO $ readTVarIO counter
-- * Our API type -- * Our API type
type TestApi = "counter" :> Post Counter -- endpoint for increasing the counter type TestApi = "counter" :> Post Counter -- endpoint for increasing the counter
:<|> "counter" :> Get Counter -- endpoint to get the current value :<|> "counter" :> Get Counter -- endpoint to get the current value
:<|> Raw -- used for serving static files :<|> Raw Application IO -- used for serving static files
testApi :: Proxy TestApi testApi :: Proxy TestApi
testApi = Proxy testApi = Proxy

View file

@ -43,7 +43,7 @@ type TestApi = "counter" :> Post '[JSON] Counter -- endpoint for increasing the
:<|> "counter" :> Get '[JSON] Counter -- endpoint to get the current value :<|> "counter" :> Get '[JSON] Counter -- endpoint to get the current value
type TestApi' = TestApi type TestApi' = TestApi
:<|> Raw -- used for serving static files :<|> Raw Application IO -- used for serving static files
-- this proxy only targets the proper endpoints of our API, -- this proxy only targets the proper endpoints of our API,
-- not the static file serving bit -- not the static file serving bit

View file

@ -24,7 +24,7 @@ type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] String :> Post '[JSON]
:<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool
type TopLevelRawAPI = "something" :> Get '[JSON] Int type TopLevelRawAPI = "something" :> Get '[JSON] Int
:<|> Raw :<|> Raw () IO
type HeaderHandlingAPI = "something" :> Header "Foo" String type HeaderHandlingAPI = "something" :> Header "Foo" String
:> Get '[JSON] Int :> Get '[JSON] Int

View file

@ -62,6 +62,7 @@ import Network.HTTP.Types.Status
import Network.Wai import Network.Wai
import Servant import Servant
import Servant.API.ContentTypes import Servant.API.ContentTypes
import Servant.Server.Internal (ToRawApplication)
import Test.QuickCheck.Arbitrary (Arbitrary (..), vector) import Test.QuickCheck.Arbitrary (Arbitrary (..), vector)
import Test.QuickCheck.Gen (Gen, generate) import Test.QuickCheck.Gen (Gen, generate)
@ -165,10 +166,10 @@ instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Post ctypes a) where
instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Put ctypes a) where instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Put ctypes a) where
mock _ = mockArbitrary mock _ = mockArbitrary
instance HasMock Raw where instance HasMock (Raw Application m) where
mock _ = \_req respond -> do mock _ = Raw (\req respond -> do
bdy <- genBody bdy <- genBody
respond $ responseLBS status200 [] bdy respond $ responseLBS status200 [] bdy)
where genBody = pack <$> generate (vector 100 :: Gen [Char]) where genBody = pack <$> generate (vector 100 :: Gen [Char])

View file

@ -677,8 +677,8 @@ class ToRawApplication a where
instance ToRawApplication Application where instance ToRawApplication Application where
toRawApplication = id toRawApplication = id
instance ToRawApplication a => HasServer (Raw m a) where instance ToRawApplication a => HasServer (Raw a m) where
type ServerT (Raw m a) n = Raw n a type ServerT (Raw a m) n = Raw a n
route Proxy rawApplication = LeafRouter $ \ request respond -> do route Proxy rawApplication = LeafRouter $ \ request respond -> do
r <- rawApplication r <- rawApplication

View file

@ -49,6 +49,9 @@ instance C.Category (:~>) where
id = Nat id id = Nat id
Nat f . Nat g = Nat (f . g) Nat f . Nat g = Nat (f . g)
instance Enter (Raw a m) (m :~> n) (Raw a n) where
enter _ (Raw a) = Raw a
instance Enter (m a) (m :~> n) (n a) where instance Enter (m a) (m :~> n) (n a) where
enter (Nat f) = f enter (Nat f) = f

View file

@ -38,10 +38,10 @@ import Filesystem.Path.CurrentOS (decodeString)
-- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectory' -- behind a /\/static\// prefix. In that case, remember to put the 'serveDirectory'
-- handler in the last position, because /servant/ will try to match the handlers -- handler in the last position, because /servant/ will try to match the handlers
-- in order. -- in order.
serveDirectoryWith :: StaticSettings -> Server (Raw m Application) serveDirectoryWith :: StaticSettings -> Server (Raw Application m)
serveDirectoryWith settings = Raw (staticApp settings) serveDirectoryWith settings = Raw (staticApp settings)
serveDirectory :: FilePath -> Server (Raw m Application) serveDirectory :: FilePath -> Server (Raw Application m)
serveDirectory = serveDirectoryWith . defaultFileServerSettings . serveDirectory = serveDirectoryWith . defaultFileServerSettings .
#if MIN_VERSION_wai_app_static(3,1,0) #if MIN_VERSION_wai_app_static(3,1,0)
id . id .

View file

@ -10,7 +10,13 @@ import Data.Proxy
import Servant.API import Servant.API
import Servant.Server import Servant.Server
import Test.Hspec (Spec, describe, it) import Servant.Utils.StaticFiles (serveDirectory)
import Network.Wai (Application)
import Control.Exception (bracket)
import System.Directory (getCurrentDirectory, setCurrentDirectory,
createDirectory)
import System.IO.Temp (withSystemTempDirectory)
import Test.Hspec (Spec, describe, it, around_)
import Test.Hspec.Wai (get, matchStatus, post, import Test.Hspec.Wai (get, matchStatus, post,
shouldRespondWith, with) shouldRespondWith, with)
@ -20,6 +26,7 @@ spec = describe "module Servant.Server.Enter" $ do
type ReaderAPI = "int" :> Get '[JSON] Int type ReaderAPI = "int" :> Get '[JSON] Int
:<|> "string" :> Post '[JSON] String :<|> "string" :> Post '[JSON] String
:<|> "static" :> Raw Application (Reader String)
type IdentityAPI = "bool" :> Get '[JSON] Bool type IdentityAPI = "bool" :> Get '[JSON] Bool
@ -32,7 +39,9 @@ combinedAPI :: Proxy CombinedAPI
combinedAPI = Proxy combinedAPI = Proxy
readerServer' :: ServerT ReaderAPI (Reader String) readerServer' :: ServerT ReaderAPI (Reader String)
readerServer' = return 1797 :<|> ask readerServer' = return 1797
:<|> ask
:<|> serveDirectory "static"
fReader :: Reader String :~> ExceptT ServantErr IO fReader :: Reader String :~> ExceptT ServantErr IO
fReader = generalizeNat C.. (runReaderTNat "hi") fReader = generalizeNat C.. (runReaderTNat "hi")
@ -46,9 +55,24 @@ combinedReaderServer' = readerServer' :<|> enter generalizeNat (return True)
combinedReaderServer :: Server CombinedAPI combinedReaderServer :: Server CombinedAPI
combinedReaderServer = enter fReader combinedReaderServer' combinedReaderServer = enter fReader combinedReaderServer'
withStaticFiles :: IO () -> IO ()
withStaticFiles action = withSystemTempDirectory "servant-test" $ \ tmpDir ->
bracket (setup tmpDir) teardown (const action)
where
setup tmpDir = do
outer <- getCurrentDirectory
setCurrentDirectory tmpDir
createDirectory "static"
writeFile "static/foo.txt" "bar"
writeFile "static/index.html" "index"
return outer
teardown outer = do
setCurrentDirectory outer
enterSpec :: Spec enterSpec :: Spec
enterSpec = describe "Enter" $ do enterSpec = describe "Enter" $ do
with (return (serve readerAPI readerServer)) $ do around_ withStaticFiles $ with (return (serve readerAPI readerServer)) $ do
it "allows running arbitrary monads" $ do it "allows running arbitrary monads" $ do
get "int" `shouldRespondWith` "1797" get "int" `shouldRespondWith` "1797"

View file

@ -118,8 +118,8 @@ captureSpec = do
get "/notAnInt" `shouldRespondWith` 404 get "/notAnInt" `shouldRespondWith` 404
with (return (serve with (return (serve
(Proxy :: Proxy (Capture "captured" String :> Raw IO Application)) (Proxy :: Proxy (Capture "captured" String :> Raw Application IO))
(Raw (\ "captured" request_ respond -> (\ "captured" -> Raw (\ request_ respond ->
respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_))))) $ do respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_))))) $ do
it "strips the captured path snippet from pathInfo" $ do it "strips the captured path snippet from pathInfo" $ do
get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String])) get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
@ -502,7 +502,7 @@ headerSpec = describe "Servant.API.Header" $ do
delete' "/" "" `shouldRespondWith` 204 delete' "/" "" `shouldRespondWith` 204
type RawApi = "foo" :> Raw IO Application type RawApi = "foo" :> Raw Application IO
rawApi :: Proxy RawApi rawApi :: Proxy RawApi
rawApi = Proxy rawApi = Proxy
rawApplication :: Show a => (Request -> a) -> Application rawApplication :: Show a => (Request -> a) -> Application
@ -512,7 +512,7 @@ rawSpec :: Spec
rawSpec = do rawSpec = do
describe "Servant.API.Raw" $ do describe "Servant.API.Raw" $ do
it "runs applications" $ do it "runs applications" $ do
(flip runSession) (serve rawApi (rawApplication (const (42 :: Integer)))) $ do (flip runSession) (serve rawApi (Raw (rawApplication (const (42 :: Integer))))) $ do
response <- Network.Wai.Test.request defaultRequest{ response <- Network.Wai.Test.request defaultRequest{
pathInfo = ["foo"] pathInfo = ["foo"]
} }
@ -520,7 +520,7 @@ rawSpec = do
simpleBody response `shouldBe` "42" simpleBody response `shouldBe` "42"
it "gets the pathInfo modified" $ do it "gets the pathInfo modified" $ do
(flip runSession) (serve rawApi (rawApplication pathInfo)) $ do (flip runSession) (serve rawApi (Raw (rawApplication pathInfo))) $ do
response <- Network.Wai.Test.request defaultRequest{ response <- Network.Wai.Test.request defaultRequest{
pathInfo = ["foo", "bar"] pathInfo = ["foo", "bar"]
} }

View file

@ -27,7 +27,7 @@ import Servant.Utils.StaticFiles (serveDirectory)
type Api = type Api =
"dummy_api" :> Capture "person_name" String :> Get '[JSON] Person "dummy_api" :> Capture "person_name" String :> Get '[JSON] Person
:<|> "static" :> Raw IO Application :<|> "static" :> Raw Application IO
api :: Proxy Api api :: Proxy Api

View file

@ -12,5 +12,5 @@ import Data.Typeable (Typeable)
-- In addition to just letting you plug in your existing WAI 'Application's, -- In addition to just letting you plug in your existing WAI 'Application's,
-- this can also be used with 'Servant.Utils.StaticFiles.serveDirectory' to serve -- this can also be used with 'Servant.Utils.StaticFiles.serveDirectory' to serve
-- static files stored in a particular directory on your filesystem -- static files stored in a particular directory on your filesystem
newtype Raw (m :: * -> *) a = Raw a newtype Raw a (m :: * -> *) = Raw a
deriving Typeable deriving Typeable

View file

@ -366,6 +366,6 @@ instance HasLink (Delete y r) where
type MkLink (Delete y r) = URI type MkLink (Delete y r) = URI
toLink _ = linkURI toLink _ = linkURI
instance HasLink Raw where instance HasLink (Raw a m) where
type MkLink Raw = URI type MkLink (Raw a m) = URI
toLink _ = linkURI toLink _ = linkURI

View file

@ -26,7 +26,7 @@ type TestApi =
:<|> "put" :> Put '[JSON] () :<|> "put" :> Put '[JSON] ()
:<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] () :<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] ()
:<|> "delete" :> Header "ponies" String :> Delete '[JSON] () :<|> "delete" :> Header "ponies" String :> Delete '[JSON] ()
:<|> "raw" :> Raw :<|> "raw" :> Raw () IO
type TestLink = "hello" :> "hi" :> Get '[JSON] Bool type TestLink = "hello" :> "hi" :> Get '[JSON] Bool
type TestLink2 = "greet" :> ReqBody '[JSON] [Int] :> Post '[PlainText] Bool type TestLink2 = "greet" :> ReqBody '[JSON] [Int] :> Post '[PlainText] Bool
@ -87,4 +87,4 @@ spec = describe "Servant.Utils.Links" $ do
apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put" apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put"
apiLink (Proxy :: Proxy ("post" :> Post '[JSON] ())) `shouldBeURI` "post" apiLink (Proxy :: Proxy ("post" :> Post '[JSON] ())) `shouldBeURI` "post"
apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] ())) `shouldBeURI` "delete" apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] ())) `shouldBeURI` "delete"
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw" apiLink (Proxy :: Proxy ("raw" :> Raw () IO)) `shouldBeURI` "raw"