cae0a3d · servant-reflex

git.iko.soy/servant-reflex

Merge branch 'master' of github.com:imalsogreg/servant-reflex

commitcae0a3df15bbfb6b90159cb8263fd3367eb92716 authorGreg Hale <imalsogreg@gmail.com> dateSun 12 Jun 2016, 10:00 (10 years ago) parentfca7824 d2112f2

6 files changed+16−7

compare with master

unifiedsplit

.gitmodules+3−3 deps/reflex-dom-contrib+1−1 exec/API.hs+1 exec/Example.hs+8−1 src/Servant/Common/Req.hs+1−1 testserver/Main.hs+2−1

.gitmodules+3−3

@@ -1,6 +1,3 @@

1−[submodule "deps/reflex-dom-contrib"]

2− path = deps/reflex-dom-contrib

3− url = git@github.com:reflex-frp/reflex-dom-contrib.git

41[submodule "deps/servant-snap"]

52 path = deps/servant-snap

63 url = https://github.com/haskell-servant/servant-snap

@@ -16,3 +13,6 @@

1613[submodule "deps/servant"]

1714 path = deps/servant

1815 url = https://github.com/haskell-servant/servant

16+[submodule "deps/reflex-dom-contrib"]

17+ path = deps/reflex-dom-contrib

18+ url = https://github.com/reflex-frp/reflex-dom-contrib

deps/reflex-dom-contrib+1−1

Submodule changed.

exec/API.hs+1

@@ -14,6 +14,7 @@ type API = "getunit" :> Get '[JSON] ()

1414 :> Get '[JSON] String

1515 :<|> "double" :> ReqBody '[JSON] Double

1616 :> Post '[JSON] Double

17+ :<|> "a" :> "b" :> QueryFlag "gusto" :> Get '[JSON] String

1718 :<|> Raw

1819

1920type GET = Get '[JSON] ()

exec/Example.hs+8−1

@@ -30,7 +30,7 @@ run = do

3030 el "br" (return ())

3131

3232 -- Name the computed API client functions

33− let (getUnit :<|> getInt :<|> sayhi :<|> dbl :<|> doRaw) =

3434 client api (Proxy :: Proxy m) url

3535

3636 elClass "div" "demo-group" $ do

@@ -80,6 +80,13 @@ run = do

8080 el "br" (return ())

8181 display =<< holdDyn "No number yet" (fmap show $ fmapMaybe reqSuccess dblResp)

8282

83+ elClass "div" "demo-group" $ do

84+ text "Multi-part path"

85+ b <- (current . value) <$> checkbox False def

86+ mpGo <- button "Test"

87+ multiResp <- multi b mpGo

88+ dynText =<< holdDyn "No res yet" (fmap show $ fmapMaybe reqSuccess $ multiResp)

89+

8390showXhrResponse :: XhrResponse -> String

8491showXhrResponse (XhrResponse stat stattxt rbmay rtmay) =

8592 unlines ["stat: " ++ show stat

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

@@ -99,7 +99,7 @@ performRequest reqMethod req reqHost trigger = do

9999

100100 -- Ridiculous functor-juggling! How to clean this up?

101101 let t :: Behavior t [Either String String]

102− t = sequence $ reqPathParts req

102+ t = sequence $ L.reverse $ reqPathParts req

103103

104104 baseUrl :: Behavior t (Either String String)

105105 baseUrl = Right . showBaseUrl <$> current reqHost

testserver/Main.hs+2−1

@@ -44,7 +44,7 @@ data App = App

4444--

4545-- Each handler runs in the 'ExceptT ServantErr IO' monad.

4646server :: Server API (Handler App App)

47−server = return () :<|> return 100 :<|> sayhi :<|> dbl :<|> serveDirectory "static"

4848 where sayhi nm greetings withGusto = case nm of

4949 Nothing -> return ("Sorry, who are you?" :: String)

5050 Just n -> do

@@ -56,6 +56,7 @@ server = return () :<|> return 100 :<|> sayhi :<|> dbl :<|> serveDirectory "stat

5656 ++ ", and " ++ L.last greetings ++ ", "

5757 return . modifier $ greetPart ++ n

5858 dbl x = return $ x * 2

59+ multi = return . bool "Box unchecked" "Box Checked"

5960

6061-- Turn the server into a WAI app. 'serve' is provided by servant,

6162-- more precisely by the Servant.Server module.