3faa94c · haskell-servant/servant-elm

git.iko.soy/haskell-servant/servant-elm

on master help sign in

Merge pull request #61 from MikePors/master

3faa94cKostiantyn Rybnikov7 years ago

servant-elm.cabal+1

compare with master

unifiedsplit

@@ -48,6 +48,7 @@ test-suite servant-elm-test

48 hs-source-dirs: test

49 main-is: GenerateSpec.hs

50 other-modules: Common

51+ , PolymorphicData

51 build-depends:

52 build-depends:

52 Diff

53 Diff

53 , HUnit

54 , HUnit

src/Servant/Elm/Internal/Generate.hs+4−2

@@ -420,7 +420,7 @@ mkLetParams opts request =

420 , "Just"

421 ]

422 )

423−

423+

424 where

425 elmName = elmQueryArg qarg

426 name = qarg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment)

@@ -522,6 +522,8 @@ renderDecoderName elmTypeExpr =

522 parens ("Json.Decode.list " <> parens (renderDecoderName t))

523 ETyApp (ETyCon (ETCon "Maybe")) t ->

524 parens ("Json.Decode.maybe " <> parens (renderDecoderName t))

525+ ETyApp x y ->

526+ parens (renderDecoderName x <+> renderDecoderName y)

525 ETyCon (ETCon "Int") -> "Json.Decode.int"

527 ETyCon (ETCon "Int") -> "Json.Decode.int"

526 ETyCon (ETCon "String") -> "Json.Decode.string"

528 ETyCon (ETCon "String") -> "Json.Decode.string"

527 _ -> ("jsonDec" <> stext (T.pack (renderElm elmTypeExpr)))

529 _ -> ("jsonDec" <> stext (T.pack (renderElm elmTypeExpr)))

@@ -549,7 +551,7 @@ mkUrl opts segments =

549 dquotes (stext (F.unPathSegment path))

551 dquotes (stext (F.unPathSegment path))

550 F.Cap arg ->

552 F.Cap arg ->

551 let

553 let

552− toStringSrc =

554+ toStringSrc =

553 toString opts (maybeOf (arg ^. F.argType))

555 toString opts (maybeOf (arg ^. F.argType))

554 in

556 in

555 pipeRight [elmCaptureArg s, toStringSrc]

557 pipeRight [elmCaptureArg s, toStringSrc]

test/GenerateSpec.hs+27−2

@@ -18,13 +18,14 @@ import Test.Hspec (Spec, describe, hspec, it)

18import Test.HUnit (Assertion, assertEqual)

20import Common (testApi)

21+import PolymorphicData (SomeRecord(..), PolymorphicData(..))

23main :: IO ()

24main :: IO ()

24main = hspec spec

25main = hspec spec

26spec :: Test.Hspec.Spec

27spec :: Test.Hspec.Spec

27−spec = do

28+spec =

28 describe "encoding a simple api" $

29 describe "encoding a simple api" $

29 do it "does it" $

30 do it "does it" $

30 do expected <-

31 do expected <-

@@ -122,6 +123,30 @@ spec = do

122 })

123 })

123 (Proxy :: Proxy ("one" :> Get '[JSON] Int)))

124 (Proxy :: Proxy ("one" :> Get '[JSON] Int)))

124 generated `itemsShouldBe` expected

125 generated `itemsShouldBe` expected

126+ it "works with polymorphic data" $

127+ do expected <-

128+ mapM

129+ (\(fpath, header) -> do

130+ source <- T.readFile fpath

131+ return (fpath, header, source))

132+ [ ( "test/elm-sources/getPolymorphicData.elm"

133+ , "module GetPolymorphicData exposing (..)\n\n" <>

134+ "import Http\n" <>

135+ "import Json.Decode exposing (..)\n" <>

136+ "import Url.Builder\n\n" <>

137+ "type PolymorphicData a b = PolymorphicData a b\n" <>

138+ "type SomeRecord = SomeRecord { recordId : Int, recordname : String }\n\n" <>

139+ "jsonDecPolymorphicData : Json.Decode.Decoder a -> Json.Decode.Decoder b -> Json.Decode.Decoder (PolymorphicData a b)\n"<>

140+ "jsonDecPolymorphicData _ _ = Debug.todo \"finish\"\n\n" <>

141+ "jsonDecSomeRecord : Json.Decode.Decoder SomeRecord\n"<>

142+ "jsonDecSomeRecord = Debug.todo \"finish\"\n\n\n")]

143+ let generated =

144+ map

145+ (<> "\n")

146+ (generateElmForAPIWith

147+ defElmOptions

148+ (Proxy :: Proxy ( "polymorphicData" :> Get '[JSON] (PolymorphicData [String] SomeRecord))))

149+ generated `itemsShouldBe` expected

125

150

126itemsShouldBe :: [Text] -> [(String, Text, Text)] -> IO ()

151itemsShouldBe :: [Text] -> [(String, Text, Text)] -> IO ()

127itemsShouldBe actual expected =

152itemsShouldBe actual expected =

@@ -138,7 +163,7 @@ shouldBeDiff a (fpath,header,b) =

138 (Diff.getGroupedDiff

163 (Diff.getGroupedDiff

139 (lines (T.unpack actual))

164 (lines (T.unpack actual))

140 (lines (T.unpack expected))))

165 (lines (T.unpack expected))))

141− actual expected

166+ expected actual

142 where

167 where

143 actual = T.strip $ header <> a

168 actual = T.strip $ header <> a

144 expected = T.strip b

169 expected = T.strip b

test/PolymorphicData.hsnew file+15

@@ -0,0 +1,15 @@

1+{-# LANGUAGE TemplateHaskell #-}

3+module PolymorphicData where

5+import Servant.Elm

8+data PolymorphicData a b = PolymorphicData a b deriving (Show, Eq)

9+data SomeRecord = SomeRecord

10+ { recordId :: Int

11+ , recordName :: String

12+ } deriving (Show, Eq)

13+

14+deriveBoth defaultOptions ''PolymorphicData

15+deriveBoth defaultOptions ''SomeRecord

test/elm-sources/getPolymorphicData.elmnew file+43

@@ -0,0 +1,43 @@

1+module GetPolymorphicData exposing (..)

3+import Http

4+import Json.Decode exposing (..)

5+import Url.Builder

7+type PolymorphicData a b = PolymorphicData a b

8+type SomeRecord = SomeRecord { recordId : Int, recordname : String }

10+jsonDecPolymorphicData : Json.Decode.Decoder a -> Json.Decode.Decoder b -> Json.Decode.Decoder (PolymorphicData a b)

11+jsonDecPolymorphicData _ _ = Debug.todo "finish"

12+

13+jsonDecSomeRecord : Json.Decode.Decoder SomeRecord

14+jsonDecSomeRecord = Debug.todo "finish"

15+

16+

17+getPolymorphicData : (Result Http.Error ((PolymorphicData (List String) SomeRecord)) -> msg) -> Cmd msg

18+getPolymorphicData toMsg =

19+ let

20+ params =

21+ List.filterMap identity

22+ (List.concat

23+ [])

24+ in

25+ Http.request

26+ { method =

27+ "GET"

28+ , headers =

29+ []

30+ , url =

31+ Url.Builder.crossOrigin ""

32+ [ "polymorphicData"

33+ ]

34+ params

35+ , body =

36+ Http.emptyBody

37+ , expect =

38+ Http.expectJson toMsg ((jsonDecPolymorphicData (Json.Decode.list (Json.Decode.string))) jsonDecSomeRecord)

39+ , timeout =

40+ Nothing

41+ , tracker =

42+ Nothing

43+ }