a1618c2 · typeable/servant-reflex

exec/API.hs+7−4

compare with master

unifiedsplit

@@ -18,14 +18,17 @@ instance FromJSON Question where

18 parseJSON (Object v) = Question <$> v .: "question"

19 parseJSON x = typeMismatch "Couldn't find key 'question'" x

20

21+data Answer = Answer {

22+ answer :: Text

23+ , certainty :: [Text]

21−newtype Answer = Answer { unAnswer :: Text } deriving (Show)

24+ } deriving (Show)

22

25

23instance ToJSON Answer where

26instance ToJSON Answer where

24− toJSON (Answer txt) = object ["answer" .= txt]

27+ toJSON (Answer txt crt) = object ["answer" .= txt, "certainty" .= crt]

25

28

26instance FromJSON Answer where

29instance FromJSON Answer where

27− parseJSON (Object v) = Answer <$> v .: "answer"

30+ parseJSON (Object v) = Answer <$> v .: "answer" <*> v .: "certainty"

28− parseJSON x = typeMismatch "Couldn't find key 'answer'" x

31+ parseJSON x = typeMismatch "Parse error" x

29

32

30

33

31-- | API spec for server, client, and docs

34-- | API spec for server, client, and docs

exec/Example.hs+1−1

@@ -175,7 +175,7 @@ run = mdo

175 let dQ = Right . Question <$> traceDyn "will send: " txt

176 rr <- qna dQ ev

177 el "p" $

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

178+ dynText =<< holdDyn "No Answer" (T.pack . show <$> fmapMaybe reqSuccess rr)

179

180showXhrResponse :: XhrResponse -> Text

181showXhrResponse (XhrResponse stat stattxt rbmay rtmay respHeaders) =

overrides.nix+2−2

@@ -7,7 +7,7 @@ let

7in

8reflex-platform.ghcjs.override {

9 overrides = self: super: {

10− # servant = dc (self.callPackage (c2n deps/servant/servant) {});

10+ servant = dc (self.callPackage (c2n deps/servant/servant) {});

11− # http-api-data = dc (self.callPackage (c2n deps/http-api-data) {});

11+ http-api-data = dc (self.callPackage (c2n deps/http-api-data) {});

12 };

13}

src/Servant/Common/Req.hs−14

@@ -401,21 +401,9 @@ foreign import javascript unsafe "console.log($1); $r = JSON['parse']($1);"

401

402rawDecode :: (FromJSON a) => T.Text -> Maybe a

403rawDecode bs = do

404− -- Below copied from Reflex.Dom.WebSocket.Foreign

405− -- tmp <- Just $ unsafePerformIO $ putStrLn ("bs: " ++ BS.unpack bs)

406− -- error ("bs: " ++ BS.unpack bs)

407− -- let (b, off, len) = fromByteString bs

408− -- x = return $ js_dataView off len $ jsval $ getArrayBuffer b :: _

409− -- tmp <- error (BS.unpack bs)

410−

411− -- let jsv = if BS.length bs == 0

412− -- then unsafePerformIO $ jsval . getArrayBuffer <$> create 0

413− -- else js_dataView off len $ jsval $ getArrayBuffer b

414

404

415 let jsv = T.textToJSString bs

405 let jsv = T.textToJSString bs

416

406

417− -- let jsv = _ bs

418− -- TODO pFromJSVal to avoid unsafePerformIO

419 let res = unsafePerformIO $ try $ aesonFromJSVal $ js_jsonParse $ jsval jsv

407 let res = unsafePerformIO $ try $ aesonFromJSVal $ js_jsonParse $ jsval jsv

420 case res of

408 case res of

421 Left (_e :: SomeException) -> Nothing

409 Left (_e :: SomeException) -> Nothing

@@ -429,8 +417,6 @@ rawDecode bs = do

429-- copied from http://lpaste.net/raw/353535 Thanks ncl28!

417-- copied from http://lpaste.net/raw/353535 Thanks ncl28!

430aesonFromJSVal :: JSVal -> IO (Maybe A.Value)

418aesonFromJSVal :: JSVal -> IO (Maybe A.Value)

431aesonFromJSVal r = do

419aesonFromJSVal r = do

432− putStrLn "Hello"

433− print $ jsonTypeOf r

434 case jsonTypeOf r of

420 case jsonTypeOf r of

435 JSONNull -> return (Just A.Null)

421 JSONNull -> return (Just A.Null)

436 JSONInteger -> liftM (A.Number . flip scientific 0 . (toInteger :: Int -> Integer))

422 JSONInteger -> liftM (A.Number . flip scientific 0 . (toInteger :: Int -> Integer))

testserver/Main.hs+1−1

@@ -68,7 +68,7 @@ server = return () :<|> return 100 :<|> sayhi :<|> dbl :<|> multi :<|> qna :<|>

68 liftIO $ do

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

70 T.putStrLn $ unQuestion q

71− return $ Answer $ unQuestion q

71+ return $ Answer (unQuestion q) ["Hi", "a", "test",""]

72

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

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

testserver/tr.nix+5−2

@@ -1,9 +1,9 @@

1{ reflex-platform, ... }:

2let

3

4− dontCheck = (import <nixpkgs> {}).pkgs.haskell.lib.dontCheck;

4+ dontCheck = reflex-platform.lib.dontCheck;

5 cabal2nixResult = reflex-platform.cabal2nixResult;

6− nixpkgs = (import <nixpkgs> {});

6+

7in

8reflex-platform.ghc.override {

9 overrides = self: super: {

@@ -19,6 +19,9 @@ reflex-platform.ghc.override {

19 snap-loader-dynamic = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap-loader-dynamic) {});

20 hspec-snap = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/hspec-snap) {});

21

22+ servant = dontCheck (self.callPackage (cabal2nixResult ../deps/servant/servant) {});

23+ http-api-data = dontCheck (self.callPackage (cabal2nixResult ../deps/http-api-data) {});

24+

22 # servant-foreign = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-foreign) {});

25 # servant-foreign = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-foreign) {});

23 # servant-js = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-js) {});

26 # servant-js = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-js) {});

24 # servant-docs = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-docs) {});

27 # servant-docs = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-docs) {});