51e6b97 · typeable/servant-reflex

git.iko.soy/typeable/servant-reflex

Remove MonadWidget, tighten imports

commit51e6b971b0a26d83055a23a0a95e2d6f86733b01 authorGreg Hale <imalsogreg@gmail.com> dateMon 29 Aug 2016, 22:20 (10 years ago) parentda0bd01

4 files changed+86−41

compare with master

unifiedsplit

exec/Example.hs+11−2 src/Servant/Common/BaseUrl.hs+16−1 src/Servant/Common/Req.hs+19−19 src/Servant/Reflex.hs+40−19

exec/Example.hs+11−2

@@ -8,7 +8,8 @@ module Main where

99import Data.Bool

1010import Data.Maybe

11−import Data.Monoid

11+import Control.Monad.Fix (MonadFix)

12+import Data.Monoid ((<>))

1213import Data.Text (Text)

1314import qualified Data.Text as T

1415import Servant.API

@@ -25,7 +26,12 @@ main :: IO ()

2526main = mainWidget run

2627

2728

28−run :: forall t m. MonadWidget t m => m ()

29+run :: forall t m. (SupportsServantReflex t m,

30+ DomBuilder t m,

31+ DomBuilderSpace m ~ GhcjsDomSpace,

32+ MonadFix m,

33+ PostBuild t m,

34+ MonadHold t m) => m ()

2935run = do

3036

3137 -- Allow user to choose the url target for the request

@@ -110,3 +116,6 @@ showRB (XhrResponseBody_Default t) = tShow t

110116showRB (XhrResponseBody_Text t) = tShow t

111117showRB (XhrResponseBody_Blob t) = "<Blob>"

112118showRB (XhrResponseBody_ArrayBuffer t) = tShow t

119+

120+note :: e -> Maybe a -> Either e a

121+note e = maybe (Left e) Right

src/Servant/Common/BaseUrl.hs+16−1

@@ -1,3 +1,4 @@

1+{-# LANGUAGE ConstraintKinds #-}

12{-# LANGUAGE DeriveDataTypeable #-}

23{-# LANGUAGE DeriveGeneric #-}

34{-# LANGUAGE FlexibleContexts #-}

@@ -13,9 +14,14 @@ module Servant.Common.BaseUrl (

1314 -- * functions

1415 , baseUrlWidget

1516 , showBaseUrl

17+

18+ -- * constraints

19+ , SupportsServantReflex

1620) where

1721

1822import Control.Monad (join)

23+import Control.Monad.IO.Class (MonadIO)

24+import Control.Monad.Fix (MonadFix)

1925import Data.Monoid ((<>))

2026import Data.Text (Text)

2127import qualified Data.Text as T

@@ -24,6 +30,9 @@ import Reflex

2430import Reflex.Dom

2531import Text.Read

2632

33+

34+type SupportsServantReflex t m = (Reflex t, TriggerEvent t m, PerformEvent t m, HasWebView (Performable m), MonadIO (Performable m))

35+

2736-- | URI scheme to use

2837data Scheme =

2938 Http -- ^ http://

@@ -58,7 +67,13 @@ showBaseUrl (BaseFullUrl urlscheme host port path) =

5867 (Https, 443) -> ""

5968 _ -> ":" <> T.pack (show port)

6069

61−baseUrlWidget :: forall t m .MonadWidget t m => m (Dynamic t BaseUrl)

70+baseUrlWidget :: forall t m .(SupportsServantReflex t m,

71+ DomBuilderSpace m ~ GhcjsDomSpace,

72+ MonadFix m,

73+ PostBuild t m,

74+ MonadHold t m,

75+ DomBuilder t m)

76+ => m (Dynamic t BaseUrl)

6277baseUrlWidget = elClass "div" "base-url" $ do

6378 urlWidget <- dropdown (0 :: Int) (constDyn $ 0 =: "BasePath" <> 1 =: "BaseUrlFull") def

6479 let bUrlWidget = ffor (value urlWidget) $ \i -> case i of

src/Servant/Common/Req.hs+19−19

@@ -9,20 +9,19 @@

99module Servant.Common.Req where

1010

1111-------------------------------------------------------------------------------

12−import Control.Applicative (liftA2, liftA3)

12+import Control.Applicative (liftA2, liftA3)

1313import qualified Data.ByteString.Lazy.Char8 as BL

14−import qualified Data.Map as Map

15−import Data.Maybe

16−import Data.Monoid

17−import Data.Proxy (Proxy(..))

18−import Data.Text (Text)

19−import qualified Data.Text as T

20−import qualified Data.Text.Encoding as TE

21−import Reflex

14+import qualified Data.Map as Map

15+import Data.Maybe (catMaybes)

16+import Data.Monoid ((<>))

17+import Data.Proxy (Proxy(..))

18+import Data.Text (Text)

19+import qualified Data.Text as T

20+import qualified Data.Text.Encoding as TE

2221import Reflex.Dom

23−import Servant.Common.BaseUrl

24−import Servant.API.ContentTypes

25−import Web.HttpApiData

22+import Servant.Common.BaseUrl (BaseUrl, showBaseUrl, SupportsServantReflex)

23+import Servant.API.ContentTypes (MimeUnrender(..), NoContent(..))

24+import Web.HttpApiData (ToHttpApiData(..))

2625-------------------------------------------------------------------------------

2726import Servant.API.BasicAuth

2827

@@ -90,14 +89,12 @@ displayHttpRequest :: Text -> Text

9089displayHttpRequest httpmethod = "HTTP " <> httpmethod <> " request"

9190

9291-- | This function actually performs the request.

93−performRequest :: forall t m.MonadWidget t m

92+performRequest :: forall t m.(SupportsServantReflex t m)

9493 => Text

9594 -> Req t

9695 -> Dynamic t BaseUrl

9796 -> Event t ()

9897 -> m (Event t XhrResponse, Event t Text)

99− -- -> ExceptT ServantError IO ( Int, ByteString, MediaType

100− -- , [HTTP.Header], Response ByteString)

10198performRequest reqMeth req reqHost trigger = do

10299

103100 let t :: Dynamic t [Either Text Text]

@@ -210,15 +207,18 @@ bytesToPayload :: BL.ByteString -> XhrPayload

210207bytesToPayload = T.pack . BL.unpack

211208#endif

212209

213−performRequestNoBody ::

214− forall t m .MonadWidget t m => Text -> Req t -> Dynamic t BaseUrl

215− -> Event t () -> m (Event t (ReqResult NoContent))

210+performRequestNoBody :: forall t m .(SupportsServantReflex t m)

211+ => Text

212+ -> Req t

213+ -> Dynamic t BaseUrl

214+ -> Event t () -> m (Event t (ReqResult NoContent))

216215performRequestNoBody reqMeth req reqHost trigger = do

217216 (resp, badReq) <- performRequest reqMeth req reqHost trigger

218217 return $ leftmost [ fmap (ResponseSuccess NoContent) resp, fmap RequestFailure badReq]

219218

220219

221−performRequestCT :: (MonadWidget t m, MimeUnrender ct a)

220+performRequestCT :: (SupportsServantReflex t m,

221+ MimeUnrender ct a)

222222 => Proxy ct -> Text -> Req t -> Dynamic t BaseUrl

223223 -> Event t () -> m (Event t (ReqResult a))

224224performRequestCT ct reqMeth req reqHost trigger = do

src/Servant/Reflex.hs+40−19

@@ -23,22 +23,43 @@ module Servant.Reflex

2323 , module Servant.Common.BaseUrl

2424 ) where

2525

26+-------------------------------------------------------------------------------

2627import Control.Applicative

28+import Data.Monoid ((<>))

2729import qualified Data.Set as Set

2830import qualified Data.Text.Encoding as E

2931import Data.CaseInsensitive (mk)

30−import Data.Proxy

31−import Data.String.Conversions

32+import Data.Proxy (Proxy (..))

3233import qualified Data.Map as Map

3334import Data.Text (Text)

3435import qualified Data.Text as T

35−import Data.Text.Encoding

36−import GHC.TypeLits

37−import Servant.API

38−import Servant.Common.BaseUrl

39−import Servant.Common.Req

40−import Reflex

41−import Reflex.Dom

36+import GHC.TypeLits (KnownSymbol, symbolVal)

37+import Servant.API ((:<|>)(..),(:>), BasicAuth,

38+ BasicAuthData, BuildHeadersTo(..),

39+ Capture, contentType, Header,

40+ Headers(..), HttpVersion, IsSecure,

41+ MimeRender(..), MimeUnrender,

42+ NoContent, QueryFlag, QueryParam,

43+ QueryParams, Raw, ReflectMethod(..),

44+ RemoteHost, ReqBody,

45+ ToHttpApiData(..), Vault, Verb)

46+import Servant.Common.BaseUrl (BaseUrl, baseUrlWidget, showBaseUrl,

47+ SupportsServantReflex)

48+import Servant.Common.Req (Req, ReqResult(..), QParam(..),

49+ QueryPart(..), addHeader, authData,

50+ defReq, prependToPathParts,

51+ performRequestCT,

52+ performRequestNoBody,

53+ qParamToQueryPart, reqBody,

54+ reqSuccess, reqFailure,

55+ reqMethod, respHeaders, response,

56+ qParams)

57+import Reflex.Dom (Dynamic, Event, Reflex,

58+ XhrRequest(..),

59+ XhrResponseHeaders(..),

60+ XhrResponse(..), ffor, fmapMaybe,

61+ leftmost, performRequestAsync,

62+ tagPromptlyDyn )

4263

4364-- * Accessing APIs as a Client

4465

@@ -78,13 +99,13 @@ instance (HasClient t m a, HasClient t m b) => HasClient t m (a :<|> b) where

7899-- >

79100-- > myApi :: Proxy MyApi = Proxy

80101-- >

81−-- > getBook :: MonadWidget t m

102+-- > getBook :: SupportsServantReflex t m

82103-- => Dynamic t BaseUrl

83104-- -> Dynamic t (Maybe Text)

84105-- -> Event t ()

85106-- -> m (Event t (Either XhrError (Text, Book)))

86107-- > getBook = client myApi (constDyn host)

87−instance (MonadWidget t m, ToHttpApiData a, HasClient t m sublayout)

108+instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout)

88109 => HasClient t m (Capture capture a :> sublayout) where

89110

90111 type Client t m (Capture capture a :> sublayout) =

@@ -101,7 +122,7 @@ instance (MonadWidget t m, ToHttpApiData a, HasClient t m sublayout)

101122-- VERB (Returning content) --

102123instance {-# OVERLAPPABLE #-}

103124 -- Note [Non-Empty Content Types]

104− (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), MonadWidget t m

125+ (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m

105126 ) => HasClient t m (Verb method status cts' a) where

106127 type Client t m (Verb method status cts' a) =

107128 Event t () -> m (Event t (ReqResult a))

@@ -109,12 +130,12 @@ instance {-# OVERLAPPABLE #-}

109130 -- ExceptT ServantError IO a

110131 clientWithRoute Proxy _ req baseurl =

111132 performRequestCT (Proxy :: Proxy ct) method req' baseurl

112− where method = decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

133+ where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

113134 req' = req { reqMethod = method }

114135

115136-- -- VERB (No content) --

116137instance {-# OVERLAPPING #-}

117− (ReflectMethod method, MonadWidget t m) =>

138+ (ReflectMethod method, SupportsServantReflex t m) =>

118139 HasClient t m (Verb method status cts NoContent) where

119140 type Client t m (Verb method status cts NoContent) =

120141 Event t () -> m (Event t (ReqResult NoContent))

@@ -122,7 +143,7 @@ instance {-# OVERLAPPING #-}

122143 -- ExceptT ServantError IO NoContent

123144 clientWithRoute Proxy _ req baseurl =

124145 performRequestNoBody method req baseurl

125− where method = decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

146+ where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

126147

127148toHeaders :: BuildHeadersTo ls => ReqResult a -> ReqResult (Headers ls a)

128149toHeaders r =

@@ -152,7 +173,7 @@ instance {-# OVERLAPPABLE #-}

152173 -- Note [Non-Empty Content Types]

153174 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,

154175 ReflectMethod method, cts' ~ (ct ': cts),

155− MonadWidget t m

176+ SupportsServantReflex t m

156177 ) => HasClient t m (Verb method status cts' (Headers ls a)) where

157178 type Client t m (Verb method status cts' (Headers ls a)) =

158179 Event t () -> m (Event t (ReqResult (Headers ls a)))

@@ -167,7 +188,7 @@ instance {-# OVERLAPPABLE #-}

167188-- HEADERS Verb (No content) --

168189instance {-# OVERLAPPABLE #-}

169190 ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,

170− MonadWidget t m

191+ SupportsServantReflex t m

171192 ) => HasClient t m (Verb method status cts (Headers ls NoContent)) where

172193 type Client t m (Verb method status cts (Headers ls NoContent))

173194 = Event t () -> m (Event t (ReqResult (Headers ls NoContent)))

@@ -194,7 +215,7 @@ instance {-# OVERLAPPABLE #-}

194215-- > -- then you can just use "viewRefer" to query that endpoint

195216-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments

196217instance (KnownSymbol sym, ToHttpApiData a,

197− HasClient t m sublayout, MonadWidget t m)

218+ HasClient t m sublayout, SupportsServantReflex t m)

198219 => HasClient t m (Header sym a :> sublayout) where

199220

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

@@ -346,7 +367,7 @@ instance (KnownSymbol sym, HasClient t m sublayout, Reflex t)

346367-- | Pick a 'Method' and specify where the server you want to query is. You get

347368-- back the full `Response`.

348369-- TODO redo

349−instance (MonadWidget t m) => HasClient t m Raw where

370+instance SupportsServantReflex t m => HasClient t m Raw where

350371 type Client t m Raw = Dynamic t (Either Text (XhrRequest ()))

351372 -> Event t ()

352373 -> m (Event t (ReqResult ()))