From 3165b43165c5839b1cbf15fdffcd7e6d32d723fc Mon Sep 17 00:00:00 2001
From: Brandon Martin <zmbmartin@gmail.com>
Date: Fri, 31 Jul 2015 10:07:38 -0600
Subject: [PATCH] change Raw to Raw a m instead of Raw m a

---
 servant-client/src/Servant/Client.hs          |  1 -
 servant-client/test/Servant/ClientSpec.hs     | 10 +++----
 servant-docs/src/Servant/Docs/Internal.hs     |  4 +--
 .../socket-io-chat/socket-io-chat.hs          |  4 +--
 servant-examples/tutorial/T10.hs              |  2 +-
 servant-examples/tutorial/T6.hs               |  2 +-
 servant-examples/tutorial/T9.hs               |  2 +-
 servant-js/README.md                          |  2 +-
 servant-js/examples/counter.hs                |  2 +-
 servant-js/test/Servant/JSSpec.hs             |  2 +-
 servant-mock/src/Servant/Mock.hs              |  7 +++--
 servant-server/src/Servant/Server/Internal.hs |  4 +--
 .../src/Servant/Server/Internal/Enter.hs      |  3 ++
 .../src/Servant/Utils/StaticFiles.hs          |  4 +--
 .../test/Servant/Server/Internal/EnterSpec.hs | 30 +++++++++++++++++--
 servant-server/test/Servant/ServerSpec.hs     | 10 +++----
 .../test/Servant/Utils/StaticFilesSpec.hs     |  2 +-
 servant/src/Servant/API/Raw.hs                |  2 +-
 servant/src/Servant/Utils/Links.hs            |  4 +--
 servant/test/Servant/Utils/LinksSpec.hs       |  4 +--
 20 files changed, 64 insertions(+), 37 deletions(-)

diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs
index 4a26ebfe..43c7deb3 100644
--- a/servant-client/src/Servant/Client.hs
+++ b/servant-client/src/Servant/Client.hs
@@ -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
diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs
index d7a8c194..5301aff0 100644
--- a/servant-client/test/Servant/ClientSpec.hs
+++ b/servant-client/test/Servant/ClientSpec.hs
@@ -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
 
diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs
index f02d8ac5..78eb10cd 100644
--- a/servant-docs/src/Servant/Docs/Internal.hs
+++ b/servant-docs/src/Servant/Docs/Internal.hs
@@ -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
diff --git a/servant-examples/socket-io-chat/socket-io-chat.hs b/servant-examples/socket-io-chat/socket-io-chat.hs
index 1250d8fe..d5c5f4f0 100644
--- a/servant-examples/socket-io-chat/socket-io-chat.hs
+++ b/servant-examples/socket-io-chat/socket-io-chat.hs
@@ -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
diff --git a/servant-examples/tutorial/T10.hs b/servant-examples/tutorial/T10.hs
index be5da4cf..234298bb 100644
--- a/servant-examples/tutorial/T10.hs
+++ b/servant-examples/tutorial/T10.hs
@@ -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"
diff --git a/servant-examples/tutorial/T6.hs b/servant-examples/tutorial/T6.hs
index 781bf703..79021d08 100644
--- a/servant-examples/tutorial/T6.hs
+++ b/servant-examples/tutorial/T6.hs
@@ -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
diff --git a/servant-examples/tutorial/T9.hs b/servant-examples/tutorial/T9.hs
index 365f6e54..014934ef 100644
--- a/servant-examples/tutorial/T9.hs
+++ b/servant-examples/tutorial/T9.hs
@@ -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
diff --git a/servant-js/README.md b/servant-js/README.md
index 53d09880..8100f039 100644
--- a/servant-js/README.md
+++ b/servant-js/README.md
@@ -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
diff --git a/servant-js/examples/counter.hs b/servant-js/examples/counter.hs
index 5d2b80d0..e55954d5 100644
--- a/servant-js/examples/counter.hs
+++ b/servant-js/examples/counter.hs
@@ -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
diff --git a/servant-js/test/Servant/JSSpec.hs b/servant-js/test/Servant/JSSpec.hs
index 46662ea5..efbb2f5f 100644
--- a/servant-js/test/Servant/JSSpec.hs
+++ b/servant-js/test/Servant/JSSpec.hs
@@ -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
diff --git a/servant-mock/src/Servant/Mock.hs b/servant-mock/src/Servant/Mock.hs
index 1bd93a04..2a5b8484 100644
--- a/servant-mock/src/Servant/Mock.hs
+++ b/servant-mock/src/Servant/Mock.hs
@@ -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])
 
diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index 85636d0c..d920f6dc 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -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
diff --git a/servant-server/src/Servant/Server/Internal/Enter.hs b/servant-server/src/Servant/Server/Internal/Enter.hs
index 5bcebe9d..47255a2d 100644
--- a/servant-server/src/Servant/Server/Internal/Enter.hs
+++ b/servant-server/src/Servant/Server/Internal/Enter.hs
@@ -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
 
diff --git a/servant-server/src/Servant/Utils/StaticFiles.hs b/servant-server/src/Servant/Utils/StaticFiles.hs
index 302e0061..4ae2e1d7 100644
--- a/servant-server/src/Servant/Utils/StaticFiles.hs
+++ b/servant-server/src/Servant/Utils/StaticFiles.hs
@@ -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 .
diff --git a/servant-server/test/Servant/Server/Internal/EnterSpec.hs b/servant-server/test/Servant/Server/Internal/EnterSpec.hs
index 973e1f89..87cd3cea 100644
--- a/servant-server/test/Servant/Server/Internal/EnterSpec.hs
+++ b/servant-server/test/Servant/Server/Internal/EnterSpec.hs
@@ -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"
diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs
index c32a2d5c..2dbab03c 100644
--- a/servant-server/test/Servant/ServerSpec.hs
+++ b/servant-server/test/Servant/ServerSpec.hs
@@ -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"]
          }
diff --git a/servant-server/test/Servant/Utils/StaticFilesSpec.hs b/servant-server/test/Servant/Utils/StaticFilesSpec.hs
index 80a76767..c0d111ab 100644
--- a/servant-server/test/Servant/Utils/StaticFilesSpec.hs
+++ b/servant-server/test/Servant/Utils/StaticFilesSpec.hs
@@ -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
diff --git a/servant/src/Servant/API/Raw.hs b/servant/src/Servant/API/Raw.hs
index b9d74992..a4d45f66 100644
--- a/servant/src/Servant/API/Raw.hs
+++ b/servant/src/Servant/API/Raw.hs
@@ -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
diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs
index 7224ff79..dab4378a 100644
--- a/servant/src/Servant/Utils/Links.hs
+++ b/servant/src/Servant/Utils/Links.hs
@@ -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
diff --git a/servant/test/Servant/Utils/LinksSpec.hs b/servant/test/Servant/Utils/LinksSpec.hs
index 07aeb051..1c65d302 100644
--- a/servant/test/Servant/Utils/LinksSpec.hs
+++ b/servant/test/Servant/Utils/LinksSpec.hs
@@ -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"