@@ -5,6 +5,7 @@
55{-# LANGUAGE InstanceSigs #-}
66{-# LANGUAGE OverloadedStrings #-}
77{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE TupleSections #-}
89{-# LANGUAGE TypeFamilies #-}
910{-# LANGUAGE TypeOperators #-}
1011{-# LANGUAGE UndecidableInstances #-}
@@ -28,6 +29,7 @@ import Control.Applicative ((<$>))
2829import Control.Monad.Trans (liftIO)
2930import Data.Default
3031import Data.Proxy
32+import Data.String.Conversions
3133import GHC.TypeLits
3234import Servant.API
3335import Servant.Common.BaseUrl
@@ -102,21 +104,27 @@ instance
102104 performAJAX requestBuilder responseParser trigEvents
103105 where
104106 requestBuilder _ = XhrRequest "GET" (showBaseUrl baseurl) def
105− responseParser xhrResp = undefined
107+ responseParser xhrResp =
108+ hush . mimeUnrender (Proxy :: Proxy ct) =<<
109+ (cs <$> _xhrResponse_responseText xhrResp)
110+
111+hush (Left _) = Nothing
112+hush (Right a) = Just a
106113
107114performAJAX
108115 :: (MonadWidget t m)
109116 => (a -> XhrRequest)
110117 -- ^ Function to build the request
111− -> (XhrResponse -> b)
118+ -> (XhrResponse -> Maybe b)
112119 -- ^ Function to parse the response
113120 -> Event t a
114121 -> m (Event t (a, b))
115−performAJAX mkRequest parseResponse req =
116− performEventAsync $ ffor req $ \a cb -> do
122+performAJAX mkRequest parseResponse req = do
123+ e <- performEventAsync $ ffor req $ \a cb -> do
117124 _ <- newXMLHttpRequest (mkRequest a) $ \response ->
118− liftIO $ cb (a, parseResponse response)
125+ liftIO $ cb $ (a,) <$> parseResponse response
119126 return ()
127+ return $ fmapMaybe id e
120128
121129
122130instance
@@ -131,7 +139,7 @@ instance
131139 performAJAX requestBuilder responseParser trigEvents
132140 where
133141 requestBuilder _ = XhrRequest "GET" (showBaseUrl baseurl) def
134− responseParser _ = ()
142+ responseParser _ = Just ()
135143
136144-- -- | Pick a 'Method' and specify where the server you want to query is. You get
137145-- -- back the full `Response`.