810a32b · servant-reflex

build.sh+1−1

compare with master

unifiedsplit

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

1#!/usr/bin/env bash

2

3−deps/reflex-platform/work-on ./overrides.nix ./. --run "cabal configure --ghcjs && cabal build && exec/toSite.sh"

3+deps/reflex-platform/work-on ./overrides.nix ./. --run "cabal configure --ghcjs -f Example && cabal build && exec/toSite.sh"

deps/servant-snap+1−1

Submodule changed.

exec/API.hs+1

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

40 :<|> "a" :> "b" :> QueryFlag "gusto" :> Get '[JSON] Text

41 :<|> "qna" :> ReqBody '[JSON] Question

42 :> Post '[JSON] Answer

43+ :<|> "secret" :> BasicAuth "realm" () :> Get '[JSON] Int

43 :<|> Raw

44 :<|> Raw

44

45

45type GET = Get '[JSON] ()

46type GET = Get '[JSON] ()

exec/Example.hs+22−4

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

1+{-# LANGUAGE DataKinds #-}

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE GADTs #-}

3{-# LANGUAGE GADTs #-}

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE OverloadedStrings #-}

@@ -14,6 +15,7 @@ import Control.Monad.Fix (MonadFix)

14import Data.Monoid (First(..), (<>))

15import Data.Monoid (First(..), (<>))

15import Data.Text (Text)

16import Data.Text (Text)

16import qualified Data.Text as T

17import qualified Data.Text as T

18+import qualified Data.Text.Encoding as T

17import GHC.TypeLits

19import GHC.TypeLits

18import Servant.API

20import Servant.API

19import API

21import API

@@ -43,7 +45,7 @@ runMulti :: forall t m. (SupportsServantReflex t m,

43runMulti = do

45runMulti = do

44 url <- baseUrlWidget

46 url <- baseUrlWidget

45 el "br" blank

47 el "br" blank

46− let (_ :<|> _ :<|> sayHi :<|> dbl :<|> _ :<|> _ ) =

48+ let (_ :<|> _ :<|> sayHi :<|> dbl :<|> _ :<|> _ :<|> _ :<|> _ ) =

47 clientA api (Proxy :: Proxy m) (Proxy :: Proxy []) (Proxy :: Proxy Int) url

49 clientA api (Proxy :: Proxy m) (Proxy :: Proxy []) (Proxy :: Proxy Int) url

48

50

49 num :: Dynamic t (Either Text Double) <- fmap (note "No read" . readMaybe . T.unpack) . value <$> textInput def

51 num :: Dynamic t (Either Text Double) <- fmap (note "No read" . readMaybe . T.unpack) . value <$> textInput def

@@ -66,9 +68,12 @@ runMulti = do

66 textInput def

68 textInput def

67 gust <- fmap (value) $ divClass "gusto-input" $ checkbox False def

69 gust <- fmap (value) $ divClass "gusto-input" $ checkbox False def

68 b <- button "Go"

70 b <- button "Go"

69− r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) $ grts) (constDyn [True, False]) (1 <$ b)

71+ r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) $ grts)

72+ (constDyn [True, False]) (1 <$ b)

73+

74+ dynText =<< holdDyn "Waiting" (T.pack . show . catMaybes .

75+ fmap reqSuccess <$> r')

70

76

71− dynText =<< holdDyn "Waiting" (T.pack . show . catMaybes . fmap reqSuccess <$> r')

72

77

73 return ()

78 return ()

74

79

@@ -91,7 +96,8 @@ run = mdo

91 el "br" (return ())

96 el "br" (return ())

92

97

93 -- Name the computed API client functions

98 -- Name the computed API client functions

99+ let (getUnit :<|> getInt :<|> sayhi :<|> dbl

100+ :<|> multi :<|> qna :<|> secret :<|> doRaw) =

95 client api (Proxy :: Proxy m) (Proxy :: Proxy Int) url

101 client api (Proxy :: Proxy m) (Proxy :: Proxy Int) url

96

102

97 c2 = client (Proxy :: Proxy ComprehensiveAPI) (Proxy :: Proxy m) (Proxy :: Proxy ()) url -- Just make sure this compiles for now

103 c2 = client (Proxy :: Proxy ComprehensiveAPI) (Proxy :: Proxy m) (Proxy :: Proxy ()) url -- Just make sure this compiles for now

@@ -177,6 +183,18 @@ run = mdo

177 el "p" $

183 el "p" $

178 dynText =<< holdDyn "No Answer" (unAnswer <$> fmapMaybe reqSuccess rr)

184 dynText =<< holdDyn "No Answer" (unAnswer <$> fmapMaybe reqSuccess rr)

179

185

186+ divClass "demo-group" $ do

187+ un <- fmap value $ text "Username" >> textArea def

188+ pw <- fmap value $ text "Unhidden PW" >> textArea def

189+ let ba :: Dynamic t (BasicAuthData ) = BasicAuthData

190+ <$> fmap T.encodeUtf8 un

191+ <*> fmap T.encodeUtf8 pw

192+ b <- button "Get secret"

193+ r <- secret (Just <$> ba) (0 <$ b)

194+ res <- holdDyn Nothing (reqSuccess <$> r)

195+ display res

196+

197+

180showXhrResponse :: XhrResponse -> Text

198showXhrResponse :: XhrResponse -> Text

181showXhrResponse (XhrResponse stat stattxt rbmay rtmay respHeaders) =

199showXhrResponse (XhrResponse stat stattxt rbmay rtmay respHeaders) =

182 T.unlines ["stat: " <> tShow stat

200 T.unlines ["stat: " <> tShow stat

servant-reflex.cabal+1−1

@@ -42,7 +42,7 @@ library

42 reflex-dom == 0.4 && < 0.5,

43 safe >= 0.3.9 && < 0.4,

44 servant >= 0.8 && < 0.12,

45− servant-auth >= 0.2.7 && < 0.2.8,

45+ servant-auth >= 0.2.1 && < 0.3,

46 string-conversions >= 0.4 && < 0.5,

47 text >= 1.2 && < 1.3,

48 transformers >= 0.4 && < 0.6

testserver/Main.hs+11−3

@@ -2,6 +2,7 @@

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE PolyKinds #-}

5+{-# LANGUAGE TypeApplications #-}

5{-# LANGUAGE TypeFamilies #-}

6{-# LANGUAGE TypeFamilies #-}

6{-# LANGUAGE TypeOperators #-}

7{-# LANGUAGE TypeOperators #-}

7

8

@@ -47,8 +48,10 @@ data App = App

47-- that represents the API, are glued together using :<|>.

48-- that represents the API, are glued together using :<|>.

48--

49--

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

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

50−server :: Server API (Handler App App)

51+server :: Server API '[BasicAuthCheck (Handler App App) ()] (Handler App App)

52+server = return () :<|> return 100 :<|> sayhi :<|> dbl

53+ :<|> multi :<|> qna :<|> serveSecret

54+ :<|> serveDirectory "static"

52 where sayhi :: Maybe Text -> [Text] -> Bool -> Handler App App Text

55 where sayhi :: Maybe Text -> [Text] -> Bool -> Handler App App Text

53 sayhi nm greetings withGusto = case nm of

56 sayhi nm greetings withGusto = case nm of

54 Nothing -> return ("Sorry, who are you?" :: Text)

57 Nothing -> return ("Sorry, who are you?" :: Text)

@@ -69,11 +72,16 @@ server = return () :<|> return 100 :<|> sayhi :<|> dbl :<|> multi :<|> qna :<|>

69 putStrLn $ "qna got: " ++ show q

72 putStrLn $ "qna got: " ++ show q

70 T.putStrLn $ unQuestion q

73 T.putStrLn $ unQuestion q

71 return $ Answer $ unQuestion q

74 return $ Answer $ unQuestion q

75+ serveSecret _ = do

76+ req <- getRequest

77+ liftIO $ putStrLn (show req)

78+ return 101

72

79

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

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

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

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

75test :: Handler App App ()

82test :: Handler App App ()

76−test = serveSnap testApi server

83+test = serveSnapWithContext testApi

84+ (BasicAuthCheck (\_ -> return @(Handler App App) (Authorized ())) :. EmptyContext) server

77

85

78initApp :: SnapletInit App App

86initApp :: SnapletInit App App

79initApp = makeSnaplet "myapp" "example" Nothing $ do

87initApp = makeSnaplet "myapp" "example" Nothing $ do

testserver/testserver.cabal+6−6

@@ -19,13 +19,13 @@ executable back

19 main-is: Main.hs

20 -- other-modules:

21 -- other-extensions:

22− build-depends: aeson >= 0.9 && < 1.1

22+ build-depends: aeson >= 0.9 && < 1.4

23− , base >=4.8 && <4.10

23+ , base >=4.8 && <4.11

24− , snap >= 1.0 && < 1.1

24+ , snap >= 1.0 && < 1.2

25 , snap-server >= 1.0 && < 1.1

26 , snap-core >= 1.0 && < 1.1

27− , servant >= 0.8 && < 0.11

27+ , servant >= 0.8 && < 0.12

28− , servant-snap >= 0.7.2 && < 0.8

28+ , servant-snap >= 0.8 && < 0.9

29− , text >= 1.2 && < 1.3

29+ , text >= 1.0 && < 1.3

30 -- hs-source-dirs:

31 default-language: Haskell2010