@@ -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 #-}
@@ -16,35 +17,26 @@
1617-- querying functions for each endpoint just from the type representing your
1718-- API.
1819module Servant.Reflex
19− ( client
20− , HasReflexClient(..)
20+ ( HasReflexClient(..)
2121 , ServantError(..)
2222 , module Servant.Common.BaseUrl
23+ , module Servant.Common.Req
2324 ) where
2425
2526#if !MIN_VERSION_base(4,8,0)
2627import Control.Applicative ((<$>))
2728#endif
28−import Control.Monad
2929import Control.Monad.Trans (liftIO)
30−import Control.Monad.Trans.Except
31−import Data.ByteString.Lazy (ByteString)
3230import Data.Default
33−import Data.List
3431import Data.Proxy
3532import Data.String.Conversions
36−import Data.Text (unpack)
3733import GHC.TypeLits
38−import Network.HTTP.Media
39−import qualified Network.HTTP.Types as H
40−import qualified Network.HTTP.Types.Header as HTTP
4134import Servant.API
4235import Servant.Common.BaseUrl
4336import Servant.Common.Req
4437import Reflex
4538import Reflex.Dom
46−import Web.HttpApiData
47−import Reflex.Dom.Xhr
39+--import Reflex.Dom.Xhr
4840
4941-- * Accessing APIs as a Client
5042
@@ -60,17 +52,18 @@ import Reflex.Dom.Xhr
6052-- > postNewBook :: Book -> ExceptT String IO Book
6153-- > (getAllBooks :<|> postNewBook) = client myApi host
6254-- > where host = BaseUrl Http "localhost" 8080
63−client :: HasReflexClient layout
64− => Proxy layout
65− -> BaseUrl
66− -> Client (Input layout) (Output layout)
67−client p baseurl = clientWithRoute p defReq baseurl
55+--client :: HasReflexClient layout
56+-- => Proxy layout
57+-- -> BaseUrl
58+-- -> Client (Input layout) (Output layout)
59+--client p baseurl = clientWithRoute p defReq baseurl
6860
6961data a ::> b = a ::> b deriving (Eq,Ord,Show,Read)
7062
7163infixr 3 ::>
7264
73−type Client ins outs = MonadWidget t m => Event t ins -> m (Event t (ins,outs))
65+--type SingleClient ins outs = MonadWidget t m => Event t ins -> m (Event t (ins,outs))
66+--type SingleClient a = MonadWidget t m => Event t (Input a) -> m (Event t (Input a,Output a))
7467
7568-- | This class lets us define how each API combinator
7669-- influences the creation of an HTTP request. It's mostly
@@ -78,11 +71,21 @@ type Client ins outs = MonadWidget t m => Event t ins -> m (Event t (ins,outs))
7871class HasReflexClient layout where
7972 type Input layout :: *
8073 type Output layout :: *
81− -- clientWithRoute :: MonadWidget t m => Proxy layout -> Req -> BaseUrl
82− -- -> Event t (Input layout) -> m (Event t (Input layout, Output layout))
83− clientWithRoute :: MonadWidget t m
84− => Proxy layout -> Req -> BaseUrl
85− -> Event t (Input layout) -> m (Event t (Input layout, Output layout))
74+ clientWithRoute
75+ :: MonadWidget t m
76+ => Proxy layout
77+ -> Req
78+ -> BaseUrl
79+ -> Event t (Input layout)
80+ -> m (Event t (Input layout, Output layout))
81+
82+class HasReflexClients layout where
83+ type Clients layout :: *
84+ clientsWithRoute
85+ :: Proxy layout
86+ -> Req
87+ -> BaseUrl
88+ -> Clients layout
8689
8790
8891-- | If you have a 'Get' endpoint in your API, the client
@@ -97,24 +100,31 @@ instance
97100 type Input (Get (ct ': cts) result) = ()
98101 type Output (Get (ct ': cts) result) = result
99102 -- type Client (Get (ct ': cts) result) = MonadWidget t m => Event t (Input layout) -> m (Event t result)
100− clientWithRoute Proxy req baseurl trigEvents = undefined -- performAJAX requestBuilder responseParser
101−-- where
102−-- requestBuilder _ = XhrRequest "GET" (showBaseUrl baseurl) def
103−-- responseParser xhrResp = undefined
103+ clientWithRoute Proxy req baseurl trigEvents =
104+ performAJAX requestBuilder responseParser trigEvents
105+ where
106+ requestBuilder _ = XhrRequest "GET" (showBaseUrl baseurl) def
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
104113
105114performAJAX
106115 :: (MonadWidget t m)
107116 => (a -> XhrRequest)
108117 -- ^ Function to build the request
109− -> (XhrResponse -> b)
118+ -> (XhrResponse -> Maybe b)
110119 -- ^ Function to parse the response
111120 -> Event t a
112121 -> m (Event t (a, b))
113−performAJAX mkRequest parseResponse req =
114− performEventAsync $ ffor req $ \a cb -> do
122+performAJAX mkRequest parseResponse req = do
123+ e <- performEventAsync $ ffor req $ \a cb -> do
115124 _ <- newXMLHttpRequest (mkRequest a) $ \response ->
116− liftIO $ cb (a, parseResponse response)
125+ liftIO $ cb $ (a,) <$> parseResponse response
117126 return ()
127+ return $ fmapMaybe id e
118128
119129
120130instance
@@ -129,7 +139,7 @@ instance
129139 performAJAX requestBuilder responseParser trigEvents
130140 where
131141 requestBuilder _ = XhrRequest "GET" (showBaseUrl baseurl) def
132− responseParser _ = ()
142+ responseParser _ = Just ()
133143
134144-- -- | Pick a 'Method' and specify where the server you want to query is. You get
135145-- -- back the full `Response`.
@@ -156,7 +166,7 @@ instance
156166-- return $ Headers { getResponse = resp
157167-- , getHeadersHList = buildHeadersTo hdrs
158168-- }
159−--
169+
160170-- | A client querying function for @a ':<|>' b@ will actually hand you
161171-- one function for querying @a@ and another one for querying @b@,
162172-- stitching them together with ':<|>', which really is just like a pair.
@@ -171,12 +181,11 @@ instance
171181-- > postNewBook :: Book -> ExceptT String IO Book
172182-- > (getAllBooks :<|> postNewBook) = client myApi host
173183-- > where host = BaseUrl Http "localhost" 8080
174−instance (HasReflexClient a, HasReflexClient b) => HasReflexClient (a :<|> b) where
175− type Input (a :<|> b) = Input a :<|> Input b
176− type Output (a :<|> b) = Output a :<|> Output b
177− clientWithRoute Proxy req baseurl (a :<|> b) = undefined
178−-- clientWithRoute (Proxy :: Proxy a) req baseurl a :<|>
179−-- clientWithRoute (Proxy :: Proxy b) req baseurl b
184+--instance (HasReflexClient a, HasReflexClient b) => HasReflexClients (a :<|> b) where
185+-- type Clients (a :<|> b) = SingleClient a :<|> SingleClient b
186+-- clientsWithRoute Proxy req baseurl (a :<|> b) =
187+-- clientWithRoute (Proxy :: Proxy a) req baseurl :<|>
188+-- clientWithRoute (Proxy :: Proxy b) req baseurl
180189
181190-- ------------------------------------------------------------------------------
182191-- -- | If you use a 'Capture' in one of your endpoints in your API,