diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/exec/Example.hs b/exec/Example.hs --- a/exec/Example.hs +++ b/exec/Example.hs @@ -21,7 +21,7 @@ import API import Data.Proxy import Text.Read (readMaybe) -import Reflex.Dom hiding (run) +import Reflex.Dom.Core hiding (run) ------------------------------------------------------------------------------ import Servant.Reflex import Servant.Reflex.Multi diff --git a/servant-reflex.cabal b/servant-reflex.cabal --- a/servant-reflex.cabal +++ b/servant-reflex.cabal @@ -1,5 +1,5 @@ Name: servant-reflex -Version: 0.3.4 +Version: 0.3.5 Synopsis: servant API generator for reflex apps Description: Generate reflex-compatible client functions from servant API descriptions License: BSD3 @@ -27,19 +27,19 @@ base >= 4.8 && < 5, bytestring >= 0.10 && < 0.11, case-insensitive >= 1.2.0.4 && < 1.3, - containers >= 0.5.6 && < 0.6, + containers >= 0.5.6 && < 0.7, data-default >= 0.5 && < 0.8, exceptions >= 0.8 && < 0.11, ghcjs-dom >= 0.2 && < 0.10, - http-api-data >= 0.3.6 && < 0.4, - http-media >= 0.6 && < 0.8, + http-api-data >= 0.3.6 && < 0.5, + http-media >= 0.6 && < 0.9, jsaddle >= 0.8 && < 0.10, mtl >= 2.2.1 && < 2.3, network-uri >= 2.6 && < 2.7, - reflex >= 0.5 && < 0.6, - reflex-dom-core == 0.4 && < 0.5, + reflex >= 0.5 && < 0.8, + reflex-dom-core >= 0.6 && < 0.7, safe >= 0.3.9 && < 0.4, - servant >= 0.8 && < 0.15, + servant >= 0.16 && < 0.18, servant-auth >= 0.2.1 && < 0.4, string-conversions >= 0.4 && < 0.5, text >= 1.2 && < 1.3, @@ -54,7 +54,15 @@ buildable: True else buildable: False - build-depends: aeson, reflex, servant-reflex, base, scientific, servant, reflex-dom, text + build-depends: + aeson, + reflex, + servant-reflex, + base, + scientific, + servant, + reflex-dom-core, + text default-language: Haskell2010 main-is: Example.hs other-modules: API diff --git a/src/Servant/Common/BaseUrl.hs b/src/Servant/Common/BaseUrl.hs --- a/src/Servant/Common/BaseUrl.hs +++ b/src/Servant/Common/BaseUrl.hs @@ -85,15 +85,14 @@ where pathWidget :: m (Dynamic t BaseUrl) pathWidget = do text "Url base path" - t <- textInput (def {_textInputConfig_attributes = - constDyn ("placeholder" =: "/a/b")}) + t <- inputElement def return $ BasePath <$> value t fullUrlWidget :: m (Dynamic t BaseUrl) fullUrlWidget = do schm <- dropdown Https (constDyn $ Https =: "https" <> Http =: "http") def - srv <- textInput def {_textInputConfig_attributes = constDyn $ "placeholder" =: "example.com"} + srv <- inputElement def text ":" - prt <- textInput def { _textInputConfig_attributes = constDyn $ "placeholder" =: "80"} + prt <- inputElement def port :: Dynamic t Int <- holdDyn 80 (fmapMaybe (readMaybe . T.unpack) $ updated (value prt)) - path <- textInput def { _textInputConfig_attributes = constDyn $ "placeholder" =: "a/b" } + path <- inputElement def return $ BaseFullUrl <$> value schm <*> value srv <*> port <*> value path diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs --- a/src/Servant/Common/Req.hs +++ b/src/Servant/Common/Req.hs @@ -19,6 +19,7 @@ import Data.Bifunctor (first) import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy.Char8 as BL +import Data.ByteString (ByteString) import qualified Data.Map as Map import Data.Maybe (catMaybes, fromMaybe) import Data.Functor.Compose @@ -244,7 +245,7 @@ , _xhrRequestConfig_user = Nothing , _xhrRequestConfig_password = Nothing , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer - , _xhrRequestConfig_sendData = "" + , _xhrRequestConfig_sendData = mempty , _xhrRequestConfig_withCredentials = False } Just rBody -> liftA2 mkConfigBody xhrHeaders rBody @@ -335,9 +336,9 @@ -type XhrPayload = T.Text +type XhrPayload = ByteString bytesToPayload :: BL.ByteString -> XhrPayload -bytesToPayload = TE.decodeUtf8 . BL.toStrict +bytesToPayload = BL.toStrict performRequestsCT diff --git a/src/Servant/Reflex.hs b/src/Servant/Reflex.hs --- a/src/Servant/Reflex.hs +++ b/src/Servant/Reflex.hs @@ -42,7 +42,7 @@ import Data.Monoid ((<>)) import qualified Data.Set as Set import qualified Data.Text.Encoding as E -import Data.CaseInsensitive (mk) +import qualified Data.CaseInsensitive as CI import Data.Functor.Identity import Data.Proxy (Proxy (..)) import qualified Data.Map as Map @@ -101,7 +101,7 @@ -- > -- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book])) -- > postNewBook :: Dynamic t (Maybe Book) -> Event t l --- -> m (Event t (l, ReqResult Book))) +-- > -> m (Event t (l, ReqResult Book))) -- > (getAllBooks :<|> postNewBook) = client myApi host -- > where host = constDyn $ BaseUrl Http "localhost" 8080 client @@ -226,22 +226,26 @@ toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a) toHeaders r = - let toBS = E.encodeUtf8 - hdrs = maybe [] - (\xhr -> fmap (\(h,v) -> (mk (toBS h), toBS v)) + let hdrs = maybe [] + (\xhr -> fmap (\(h,v) -> (CI.map E.encodeUtf8 h, E.encodeUtf8 v)) (Map.toList $ _xhrResponse_headers xhr)) (response r) in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs} + class BuildHeaderKeysTo hs where - buildHeaderKeysTo :: Proxy hs -> [T.Text] + buildHeaderKeysTo :: Proxy hs -> [CI.CI T.Text] instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[] where buildHeaderKeysTo _ = [] instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h) => BuildHeaderKeysTo ((Header h v) ': xs) where - buildHeaderKeysTo _ = T.pack (symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs) + buildHeaderKeysTo _ = + let + thisKey = CI.mk $ T.pack (symbolVal (Proxy :: Proxy h)) + in thisKey : buildHeaderKeysTo (Proxy :: Proxy xs) + -- HEADERS Verb (Content) -- -- Headers combinator not treated in fully general case,