mirror of
https://github.com/ilyakooo0/servant-reflex.git
synced 2024-09-11 07:15:29 +03:00
Add QueryParam handling, and example usage
This commit is contained in:
parent
851c1f2c0e
commit
43ad24b744
@ -8,4 +8,5 @@ import Servant.API
|
||||
-- | API spec for server, client, and docs
|
||||
type API = "getunit" :> Get '[JSON] ()
|
||||
:<|> "getint" :> Get '[JSON] Int
|
||||
:<|> "sayhi" :> QueryParam "username" String :> Get '[JSON] String
|
||||
:<|> Raw
|
||||
|
@ -3,6 +3,7 @@
|
||||
|
||||
module Main where
|
||||
|
||||
import Data.Bool
|
||||
import Data.Maybe
|
||||
import Servant.API
|
||||
import Servant.Reflex
|
||||
@ -24,7 +25,7 @@ run :: forall t m. MonadWidget t m => m ()
|
||||
run = do
|
||||
|
||||
-- Name the computed API client functions
|
||||
let (getUnit :<|> getInt :<|> doRaw) =
|
||||
let (getUnit :<|> getInt :<|> sayhi :<|> doRaw) =
|
||||
client api (Proxy :: Proxy m) (constDyn url)
|
||||
|
||||
unitBtn <- button "Get unit"
|
||||
@ -41,6 +42,15 @@ run = do
|
||||
]
|
||||
dynText r >> el "br" (return ()) >> text "Total: " >> display score
|
||||
|
||||
el "br" $ return ()
|
||||
text "Name"
|
||||
inp :: Dynamic t String <- fmap value (textInput def)
|
||||
let checkedinp = fmap (\i -> bool (Just i) Nothing (null i)) (current inp)
|
||||
sayhiClicks :: Event t () <- button "Say hi"
|
||||
resp <- fmap fst <$> sayhi checkedinp sayhiClicks
|
||||
el "br" $ return ()
|
||||
dynText =<< holdDyn "No hi yet" (fmapMaybe id resp)
|
||||
|
||||
showXhrResponse :: XhrResponse -> String
|
||||
showXhrResponse (XhrResponse stat stattxt rbmay rtmay) =
|
||||
unlines ["stat: " ++ show stat
|
||||
|
@ -9,6 +9,7 @@ module Servant.Common.Req where
|
||||
-- import Control.Monad.Catch (MonadThrow)
|
||||
-- import Control.Monad.IO.Class
|
||||
-- import Control.Monad.Trans.Except
|
||||
import Control.Applicative (liftA2)
|
||||
import Data.ByteString.Char8 hiding (pack, filter, map, null, elem)
|
||||
import qualified Data.ByteString.Lazy.Char8 as BL
|
||||
import qualified Data.Text.Encoding as TE
|
||||
@ -96,10 +97,26 @@ performRequest :: forall t m.MonadWidget t m => String -> Req t -> Dynamic t Bas
|
||||
-- -> ExceptT ServantError IO ( Int, ByteString, MediaType
|
||||
-- , [HTTP.Header], Response ByteString)
|
||||
performRequest reqMethod req _ trigger = do
|
||||
|
||||
-- Ridiculous functor-juggling! How to clean this up?
|
||||
let t :: Behavior t [Maybe String] = sequence $ reqPathParts req
|
||||
let urlParts :: Behavior t (Maybe [String]) = fmap sequence t
|
||||
let urlPath :: Behavior t (Maybe String) = (fmap.fmap) (L.intercalate "/") urlParts
|
||||
xhrReq = (fmap . fmap) (\p -> XhrRequest reqMethod p def) urlPath
|
||||
|
||||
let oneNamedPair :: String -> [String] -> String
|
||||
oneNamedPair pName ps =
|
||||
L.intercalate "&" $ map (\p -> pName ++ "=" ++ p) ps
|
||||
|
||||
t' :: [Behavior t String]
|
||||
t' = map (\(pName, pVals) -> fmap (oneNamedPair pName) pVals)
|
||||
(qParams req)
|
||||
|
||||
queryString :: Behavior t String
|
||||
queryString = fmap (L.intercalate "&") (sequence t')
|
||||
|
||||
xhrUrl = (liftA2 . liftA2) (\u q -> u ++ '?' : q) urlPath (fmap Just queryString)
|
||||
xhrReq = (fmap . fmap) (\p -> XhrRequest reqMethod p def) xhrUrl
|
||||
|
||||
performRequestAsync (fmapMaybe id $ tag xhrReq trigger)
|
||||
|
||||
-- TODO implement
|
||||
|
@ -41,15 +41,10 @@ data App = App
|
||||
--
|
||||
-- Each handler runs in the 'ExceptT ServantErr IO' monad.
|
||||
server :: Server API (Handler App App)
|
||||
server = return () :<|> return 100 :<|> serveDirectory "static"
|
||||
|
||||
-- where helloH name Nothing = helloH name (Just False)
|
||||
-- helloH name (Just False) = return . Greet $ "Hello, " <> name
|
||||
-- helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
|
||||
|
||||
-- postGreetH greet = return greet
|
||||
|
||||
-- deleteGreetH _ = return ()
|
||||
server = return () :<|> return 100 :<|> sayhi :<|> serveDirectory "static"
|
||||
where sayhi nm = case nm of
|
||||
Nothing -> return "Sorry, who are you?"
|
||||
Just n -> return $ "Hi, " <> n <> "!"
|
||||
|
||||
-- Turn the server into a WAI app. 'serve' is provided by servant,
|
||||
-- more precisely by the Servant.Server module.
|
||||
@ -59,7 +54,7 @@ test = serve testApi server
|
||||
initApp :: SnapletInit App App
|
||||
initApp = makeSnaplet "myapp" "example" Nothing $ do
|
||||
addRoutes [("", applicationToSnap test)
|
||||
-- ,("", serveDirectory "static")
|
||||
,("", serveDirectory "static")
|
||||
]
|
||||
return App
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user