eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

change Raw to Raw a m instead of Raw m a

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client/src/Servant/Client.hs
View file

@ -621,7 +621,6 @@ instance (KnownSymbol sym, HasClient sublayout)
instance HasClient Raw where
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 req baseurl manager httpMethod = do
performRequest httpMethod req (const True) baseurl manager

10
servant-client/test/Servant/ClientSpec.hs
View file

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

4
servant-docs/src/Servant/Docs/Internal.hs
View file

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

4
servant-examples/socket-io-chat/socket-io-chat.hs
View file

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

2
servant-examples/tutorial/T10.hs
View file

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

2
servant-examples/tutorial/T6.hs
View file

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

2
servant-examples/tutorial/T9.hs
View file

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

2
servant-js/README.md
View file

@ -50,7 +50,7 @@ currentValue counter = liftIO $ readTVarIO counter
-- * Our API type
type TestApi = "counter" :> Post Counter -- endpoint for increasing the counter
:<|> "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

2
servant-js/examples/counter.hs
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
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,
-- not the static file serving bit

2
servant-js/test/Servant/JSSpec.hs
View file

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

7
servant-mock/src/Servant/Mock.hs
View file

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

4
servant-server/src/Servant/Server/Internal.hs
View file

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

3
servant-server/src/Servant/Server/Internal/Enter.hs
View file

@ -49,6 +49,9 @@ instance C.Category (:~>) where
id = Nat id
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
enter (Nat f) = f

4
servant-server/src/Servant/Utils/StaticFiles.hs
View file

@ -38,10 +38,10 @@ import Filesystem.Path.CurrentOS (decodeString)
-- 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
-- in order.
serveDirectoryWith :: StaticSettings -> Server (Raw m Application)
serveDirectoryWith :: StaticSettings -> Server (Raw Application m)
serveDirectoryWith settings = Raw (staticApp settings)
serveDirectory :: FilePath -> Server (Raw m Application)
serveDirectory :: FilePath -> Server (Raw Application m)
serveDirectory = serveDirectoryWith . defaultFileServerSettings .
#if MIN_VERSION_wai_app_static(3,1,0)
id .

30
servant-server/test/Servant/Server/Internal/EnterSpec.hs
View file

@ -10,7 +10,13 @@ import Data.Proxy
import Servant.API
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,
shouldRespondWith, with)
@ -20,6 +26,7 @@ spec = describe "module Servant.Server.Enter" $ do
type ReaderAPI = "int" :> Get '[JSON] Int
:<|> "string" :> Post '[JSON] String
:<|> "static" :> Raw Application (Reader String)
type IdentityAPI = "bool" :> Get '[JSON] Bool
@ -32,7 +39,9 @@ combinedAPI :: Proxy CombinedAPI
combinedAPI = Proxy
readerServer' :: ServerT ReaderAPI (Reader String)
readerServer' = return 1797 :<|> ask
readerServer' = return 1797
:<|> ask
:<|> serveDirectory "static"
fReader :: Reader String :~> ExceptT ServantErr IO
fReader = generalizeNat C.. (runReaderTNat "hi")
@ -46,9 +55,24 @@ combinedReaderServer' = readerServer' :<|> enter generalizeNat (return True)
combinedReaderServer :: Server CombinedAPI
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 = describe "Enter" $ do
with (return (serve readerAPI readerServer)) $ do
around_ withStaticFiles $ with (return (serve readerAPI readerServer)) $ do
it "allows running arbitrary monads" $ do
get "int" `shouldRespondWith` "1797"

10
servant-server/test/Servant/ServerSpec.hs
View file

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

2
servant-server/test/Servant/Utils/StaticFilesSpec.hs
View file

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

2
servant/src/Servant/API/Raw.hs
View file

@ -12,5 +12,5 @@ import Data.Typeable (Typeable)
-- 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
-- static files stored in a particular directory on your filesystem
newtype Raw (m :: * -> *) a = Raw a
newtype Raw a (m :: * -> *) = Raw a
deriving Typeable

4
servant/src/Servant/Utils/Links.hs
View file

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

4
servant/test/Servant/Utils/LinksSpec.hs
View file

@ -26,7 +26,7 @@ type TestApi =
:<|> "put" :> Put '[JSON] ()
:<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] ()
:<|> "delete" :> Header "ponies" String :> Delete '[JSON] ()
:<|> "raw" :> Raw
:<|> "raw" :> Raw () IO
type TestLink = "hello" :> "hi" :> Get '[JSON] 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 ("post" :> Post '[JSON] ())) `shouldBeURI` "post"
apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] ())) `shouldBeURI` "delete"
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"
apiLink (Proxy :: Proxy ("raw" :> Raw () IO)) `shouldBeURI` "raw"