finish swapping Raw args, add a number of instances for Raw

servant-client/src/Servant/Client.hs

@@ -618,8 +618,8 @@ instance (KnownSymbol sym, HasClient sublayout)
 
 -- | Pick a 'Method' and specify where the server you want to query is. You get
 -- back the full `Response`.
-instance HasClient Raw where
+instance HasClient (Raw m a) where
-  type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
+  type Client (Raw m a) = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
 
   clientWithRoute :: Proxy (Raw m a) -> Req -> BaseUrl -> Manager -> Client (Raw m a)
   clientWithRoute Proxy req baseurl manager httpMethod = do

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 Application IO
+  :<|> "rawSuccess" :> Raw IO Application
-  :<|> "rawFailure" :> Raw Application IO
+  :<|> "rawFailure" :> Raw IO Application
   :<|> "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 Application IO
+       "get" :> Raw IO Application
-  :<|> "capture" :> Capture "name" String :> Raw Application IO
+  :<|> "capture" :> Capture "name" String :> Raw IO Application
-  :<|> "body" :> Raw Application IO
+  :<|> "body" :> Raw IO Application
 failApi :: Proxy FailApi
 failApi = Proxy
 

servant-docs/src/Servant/Docs/Internal.hs

@@ -940,7 +940,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout)
           endpoint' = over path (\p -> p ++ [";" ++ symbolVal symP]) endpoint
           symP = Proxy :: Proxy sym
 
-instance HasDocs (Raw a m) where
+instance HasDocs (Raw m a) where
   docsFor _proxy (endpoint, action) =
     single endpoint action
 

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 Application IO        -- used for serving static files
+          :<|> Raw IO Application        -- used for serving static files
 
 testApi :: Proxy TestApi
 testApi = Proxy

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 Application IO -- used for serving static files
+          :<|> Raw IO Application -- used for serving static files
 
 -- this proxy only targets the proper endpoints of our API,
 -- not the static file serving bit

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 () IO
+                  :<|> Raw IO ()
 
 type HeaderHandlingAPI = "something" :> Header "Foo" String
                                      :> Get '[JSON] Int

servant-server/src/Servant/Server/Internal/Enter.hs

@@ -7,8 +7,10 @@
 {-# LANGUAGE ScopedTypeVariables    #-}
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE TypeOperators          #-}
-{-# LANGUAGE OverlappingInstances   #-}
 {-# LANGUAGE UndecidableInstances   #-}
+#if !MIN_VERSION_base(4,8,0)
+{-# LANGUAGE OverlappingInstances   #-}
+#endif
 module Servant.Server.Internal.Enter where
 
 #if !MIN_VERSION_base(4,8,0)
@@ -52,10 +54,18 @@ instance C.Category (:~>) where
     id = Nat id
     Nat f . Nat g = Nat (f . g)
 
-instance (Raw m' ~ m, Raw n' ~ n) => Enter (m a) (m' :~> n') (n a)  where
+instance
+#if MIN_VERSION_base(4,8,0)
+    {-# OVERLAPPABLE #-}
+#endif
+    (Raw m' ~ m, Raw n' ~ n) => Enter (m a) (m' :~> n') (n a)  where
         enter _ (Raw a) = Raw a
 
-instance Enter (m a) (m :~> n) (n a)  where
+instance
+#if MIN_VERSION_base(4,8,0)
+    {-# OVERLAPPING #-}
+#endif
+    Enter (m a) (m :~> n) (n a)  where
         enter (Nat f) = f
 
 -- | Like `lift`.

servant-server/test/Servant/Server/Internal/EnterSpec.hs

@@ -26,7 +26,7 @@ spec = describe "module Servant.Server.Enter" $ do
 
 type ReaderAPI = "int" :> Get '[JSON] Int
             :<|> "string" :> Post '[JSON] String
-            :<|> "static" :> Raw Application (Reader String)
+            :<|> "static" :> Raw (Reader String) Application
 
 type IdentityAPI = "bool" :> Get '[JSON] Bool
 

servant-server/test/Servant/ServerSpec.hs

@@ -118,7 +118,7 @@ captureSpec = do
         get "/notAnInt" `shouldRespondWith` 404
 
     with (return (serve
-        (Proxy :: Proxy (Capture "captured" String :> Raw Application IO))
+        (Proxy :: Proxy (Capture "captured" String :> Raw IO Application))
         (\ "captured" -> Raw (\ request_ respond ->
             respond $ responseLBS ok200 [] (cs $ show $ pathInfo request_))))) $ do
       it "strips the captured path snippet from pathInfo" $ do
@@ -502,7 +502,7 @@ headerSpec = describe "Servant.API.Header" $ do
             delete' "/" "" `shouldRespondWith` 204
 
 
-type RawApi = "foo" :> Raw Application IO
+type RawApi = "foo" :> Raw IO Application
 rawApi :: Proxy RawApi
 rawApi = Proxy
 rawApplication :: Show a => (Request -> a) -> Application

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 Application IO
+  :<|> "static" :> Raw IO Application
 
 
 api :: Proxy Api

servant/CHANGELOG.md

@@ -1,6 +1,6 @@
 HEAD
 ----
-* Change Raw from `data Raw ...` to `newtype Raw a (m :: * -> *) = Raw a ...`
+* Change Raw from `data Raw ...` to `newtype Raw (m :: * -> *) a = Raw ... a`
 * Add `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
 * Fix safeLink, so Header is not in fact required.
 * Added more instances for (:<|>)

servant/src/Servant/API/Raw.hs

@@ -1,9 +1,25 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# OPTIONS_HADDOCK not-home #-}
+
 module Servant.API.Raw where
 
+import Control.Monad (liftM)
 import Data.Typeable (Typeable)
+import Data.Data (Data)
+import Data.Foldable
+import Data.Ix (Ix(..))
+import GHC.Generics (Generic, Generic1)
+#if !MIN_VERSION_base(4,8,0)
+import Data.Monoid
+import Data.Traversable (Traversable(..))
+import Control.Applicative (liftA2, (<$>), Applicative(..))
+#else
+import Control.Applicative (liftA2)
+#endif
 -- | Endpoint for plugging in your own Wai 'Application's.
 --
 -- The given 'Application' will get the request as received by the server, potentially with
@@ -14,5 +30,116 @@ import           Data.Typeable (Typeable)
 -- static files stored in a particular directory on your filesystem
 newtype Raw (m :: * -> *) a = Raw {
     unRaw :: a
-    }
+    } deriving (Eq, Read, Show, Ord, Typeable, Ix, Bounded, Data, Generic, Generic1)
-    deriving (Eq, Show, Typeable)
+
+instance Monoid a => Monoid (Raw m a) where
+    mempty = Raw mempty
+    mappend (Raw a) (Raw b) = Raw (mappend a b)
+
+instance Functor (Raw m) where
+    fmap f (Raw x) = Raw (f x)
+
+instance Applicative (Raw m) where
+    pure = Raw
+    Raw f <*> Raw x = Raw (f x)
+
+instance Monad (Raw m) where
+    return = Raw
+    Raw m >>= k = k m
+    _ >> n = n
+
+instance Foldable (Raw m) where
+    foldMap f (Raw x) = f x
+    fold (Raw x) = x
+    foldr f z (Raw x) = f x z
+    foldl f z (Raw x) = f z x
+    foldl1 _ (Raw x) = x
+    foldr1 _ (Raw x) = x
+
+instance Traversable (Raw m) where
+    traverse f (Raw x) = Raw <$> f x
+    sequenceA (Raw x) = Raw <$> x
+    mapM f (Raw x) = liftM Raw (f x)
+    sequence (Raw x) = liftM Raw x
+
+instance Enum a => Enum (Raw m a) where
+    succ = fmap succ
+    pred = fmap pred
+    toEnum = Raw . toEnum
+    fromEnum (Raw x) = fromEnum x
+    enumFrom (Raw x) = map Raw (enumFrom x)
+    enumFromThen (Raw x) (Raw y) = map Raw (enumFromThen x y)
+    enumFromTo (Raw x) (Raw y) = map Raw (enumFromTo x y)
+    enumFromThenTo (Raw x) (Raw y) (Raw z) = map Raw (enumFromThenTo x y z)
+
+instance Num a => Num (Raw m a) where
+    (+) = liftA2 (+)
+    (-) = liftA2 (-)
+    (*) = liftA2 (*)
+    negate = fmap negate
+    abs = fmap abs
+    signum = fmap signum
+    fromInteger = Raw . fromInteger
+
+instance Real a => Real (Raw m a) where
+    toRational (Raw x) = toRational x
+
+instance Integral a => Integral (Raw m a) where
+    quot = liftA2 quot
+    rem = liftA2 rem
+    div = liftA2 div
+    mod = liftA2 mod
+    quotRem (Raw x) (Raw y) = (Raw a, Raw b) where
+        (a, b) = quotRem x y
+    divMod (Raw x) (Raw y) = (Raw a, Raw b) where
+        (a, b) = divMod x y
+    toInteger (Raw x) = toInteger x
+
+instance Fractional a => Fractional (Raw m a) where
+    (/) = liftA2 (/)
+    recip = fmap recip
+    fromRational = Raw . fromRational
+
+instance Floating a => Floating (Raw m a) where
+    pi = Raw pi
+    exp = fmap exp
+    log = fmap log
+    sqrt = fmap sqrt
+    sin = fmap sin
+    cos = fmap cos
+    tan = fmap tan
+    asin = fmap asin
+    acos = fmap acos
+    atan = fmap atan
+    sinh = fmap sinh
+    cosh = fmap cosh
+    tanh = fmap tanh
+    asinh = fmap asinh
+    acosh = fmap acosh
+    atanh = fmap atanh
+    (**) = liftA2 (**)
+    logBase = liftA2 (**)
+
+instance RealFrac a => RealFrac (Raw m a) where
+    properFraction (Raw x) = (a, Raw b) where
+        (a, b) = properFraction x
+    truncate (Raw x) = truncate x
+    round (Raw x) = round x
+    ceiling (Raw x) = ceiling x
+    floor (Raw x) = floor x
+
+instance RealFloat a => RealFloat (Raw m a) where
+    floatRadix (Raw x) = floatRadix x
+    floatDigits (Raw x) = floatDigits x
+    floatRange (Raw x) = floatRange x
+    decodeFloat (Raw x) = decodeFloat x
+    encodeFloat m n = Raw (encodeFloat m n)
+    exponent (Raw x) = exponent x
+    significand = fmap significand
+    scaleFloat n = fmap (scaleFloat n)
+    isNaN (Raw x) = isNaN x
+    isInfinite (Raw x) = isInfinite x
+    isDenormalized (Raw x) = isDenormalized x
+    isNegativeZero (Raw x) = isNegativeZero x
+    isIEEE (Raw x) = isIEEE x
+    atan2 = liftA2 atan2

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 a m) where
+instance HasLink (Raw m a) where
-    type MkLink (Raw a m) = URI
+    type MkLink (Raw m a) = URI
     toLink _ = linkURI

servant/test/Servant/API/RawSpec.hs

@@ -10,6 +10,6 @@ spec :: Spec
 spec = describe "Servant.API.Raw" $ do
   describe "unRaw" $ do
     it "unRaw returns proper value" $ do
-      let p = Raw "testing" :: Raw String IO
+      let p = Raw "testing" :: Raw IO String
       p `shouldBe` (Raw "testing")
       (unRaw p) `shouldBe` "testing"

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 () IO
+  :<|> "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 () IO)) `shouldBeURI` "raw"
+        apiLink (Proxy :: Proxy ("raw" :> Raw IO ())) `shouldBeURI` "raw"