cd83099 · typeable/servant-reflex

git.iko.soy/typeable/servant-reflex

on master help sign in

Merge pull request #22 from ojw/try-adding-headers-again

cd83099Greg Hale10 years ago

src/Servant/Common/Req.hs+17−14

compare with master

unifiedsplit

@@ -68,7 +68,7 @@ data Req t = Req

68 , qParams :: [(String, QueryPart t)]

69 , reqBody :: Maybe (Behavior t (Either String (BL.ByteString, String)))

70 -- , reqAccept :: [MediaType] -- TODO ?

71− , headers :: [(String, Behavior t String)]

71+ , headers :: [(String, Behavior t (Either String String))]

72 , authData :: Maybe (Behavior t (Maybe BasicAuthData))

73 }

@@ -80,10 +80,7 @@ prependToPathParts p req =

80 req { reqPathParts = p : reqPathParts req }

82addHeader :: (ToHttpApiData a, Reflex t) => String -> Behavior t (Either String a) -> Req t -> Req t

83−addHeader name val req = req { headers = headers req

83+addHeader name val req = req { headers = (name, (fmap . fmap) (unpack . toHeader) val) : headers req }

84− ++ [(name, fmap (unpack . toHeader) val)]

85−-- ++ [(name, (fmap . fmap) (decodeUtf8 . toHeader) val)]

86− }

88-- * performing requests

85-- * performing requests

@@ -140,20 +137,26 @@ performRequest reqMethod req reqHost trigger = do

140 x </> y | ("/" `L.isSuffixOf` x) || ("/" `L.isPrefixOf` y) = x ++ y

137 x </> y | ("/" `L.isSuffixOf` x) || ("/" `L.isPrefixOf` y) = x ++ y

141 | otherwise = x ++ '/':y

138 | otherwise = x ++ '/':y

142

139

143− xhrHeaders :: Behavior t [(String, String)]

140+ xhrHeaders :: Behavior t (Either String [(String, String)])

144− xhrHeaders = sequence $ ffor (headers req) $ \(hName, hVal) -> fmap (hName,) hVal

141+ xhrHeaders = (fmap sequence . sequence . fmap f . headers) req

145−

142+ where

143+ f = \(headerName, behavior) ->

144+ fmap (fmap (\rightVal -> (headerName, rightVal))) behavior

145+

146− mkConfigBody :: [(String,String)] -> (Either String (BL.ByteString, String)) -> Either String XhrRequestConfig

146+ mkConfigBody :: Either String [(String,String)] -> (Either String (BL.ByteString, String)) -> Either String XhrRequestConfig

147− mkConfigBody hs rb = case rb of

147+ mkConfigBody ehs rb = case (ehs, rb) of

148+ (_, Left e) -> Left e

148− Left e -> Left e

149+ (Left e, _) -> Left e

149− (Right (bBytes, bCT)) ->

150+ (Right hs, Right (bBytes, bCT)) ->

150 Right $ def { _xhrRequestConfig_sendData = Just (BL.unpack bBytes)

151 Right $ def { _xhrRequestConfig_sendData = Just (BL.unpack bBytes)

151 , _xhrRequestConfig_headers =

152 , _xhrRequestConfig_headers =

152− Map.insert "Content-Type" bCT (_xhrRequestConfig_headers def)}

153+ Map.insert "Content-Type" bCT (Map.fromList hs)}

153

154

154 xhrOpts :: Behavior t (Either String XhrRequestConfig)

155 xhrOpts :: Behavior t (Either String XhrRequestConfig)

155 xhrOpts = case reqBody req of

156 xhrOpts = case reqBody req of

157+ Nothing -> fmap (\ehs -> case ehs of

158+ Left e -> Left e

156− Nothing -> fmap (\h -> Right $ def { _xhrRequestConfig_headers = Map.fromList h }) xhrHeaders

159+ Right hs -> Right $ def { _xhrRequestConfig_headers = Map.fromList hs }) xhrHeaders

157 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

160 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

158

161

159 mkAuth :: Maybe BasicAuthData -> Either String XhrRequestConfig -> Either String XhrRequestConfig

162 mkAuth :: Maybe BasicAuthData -> Either String XhrRequestConfig -> Either String XhrRequestConfig

src/Servant/Reflex.hs+2−2

@@ -186,10 +186,10 @@ instance (KnownSymbol sym, ToHttpApiData a,

186 type Client t m (Header sym a :> sublayout) =

187 Behavior t (Either String a) -> Client t m sublayout

188

189− clientWithRoute Proxy q req baseurl mval =

189+ clientWithRoute Proxy q req baseurl eval =

190 clientWithRoute (Proxy :: Proxy sublayout)

191 q

192− req

192+ (Servant.Common.Req.addHeader hname eval req)

193 -- (maybe req -- TODO Need to pass the header in

194 -- (\value -> Servant.Common.Req.addHeader hname value req)

195 -- mval