From a98cff5a0bdda73aa7b2cdbc77e942ad59069e35 Mon Sep 17 00:00:00 2001 From: = <=> Date: Wed, 30 Oct 2019 15:58:37 -0600 Subject: [PATCH 1/2] Adds support for properly building decoders for polymorphic data types --- src/Servant/Elm/Internal/Generate.hs | 6 ++-- test/Common.hs | 8 +++++ test/GenerateSpec.hs | 30 +++++++++++++++-- test/elm-sources/getPolymorphicData.elm | 43 +++++++++++++++++++++++++ 4 files changed, 82 insertions(+), 5 deletions(-) create mode 100644 test/elm-sources/getPolymorphicData.elm diff --git a/src/Servant/Elm/Internal/Generate.hs b/src/Servant/Elm/Internal/Generate.hs index 4ff710a..525c262 100644 --- a/src/Servant/Elm/Internal/Generate.hs +++ b/src/Servant/Elm/Internal/Generate.hs @@ -420,7 +420,7 @@ mkLetParams opts request = , "Just" ] ) - + where elmName = elmQueryArg qarg name = qarg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment) @@ -522,6 +522,8 @@ renderDecoderName elmTypeExpr = parens ("Json.Decode.list " <> parens (renderDecoderName t)) ETyApp (ETyCon (ETCon "Maybe")) t -> parens ("Json.Decode.maybe " <> parens (renderDecoderName t)) + ETyApp x y -> + parens (renderDecoderName x <+> renderDecoderName y) ETyCon (ETCon "Int") -> "Json.Decode.int" ETyCon (ETCon "String") -> "Json.Decode.string" _ -> ("jsonDec" <> stext (T.pack (renderElm elmTypeExpr))) @@ -549,7 +551,7 @@ mkUrl opts segments = dquotes (stext (F.unPathSegment path)) F.Cap arg -> let - toStringSrc = + toStringSrc = toString opts (maybeOf (arg ^. F.argType)) in pipeRight [elmCaptureArg s, toStringSrc] diff --git a/test/Common.hs b/test/Common.hs index 4bb9521..bb8ddd2 100644 --- a/test/Common.hs +++ b/test/Common.hs @@ -15,7 +15,15 @@ data Book = Book { title :: String } +data PolymorphicData a b = PolymorphicData a b deriving (Show, Eq) +data SomeRecord = SomeRecord + { recordId :: Int + , recordName :: String + } deriving (Show, Eq) + deriveBoth defaultOptions ''Book +deriveBoth defaultOptions ''PolymorphicData +deriveBoth defaultOptions ''SomeRecord type TestApi = "one" diff --git a/test/GenerateSpec.hs b/test/GenerateSpec.hs index 9ec5610..85582d6 100644 --- a/test/GenerateSpec.hs +++ b/test/GenerateSpec.hs @@ -17,14 +17,14 @@ import Servant.Elm import Test.Hspec (Spec, describe, hspec, it) import Test.HUnit (Assertion, assertEqual) -import Common (testApi) +import Common (testApi, SomeRecord(..), PolymorphicData(..)) main :: IO () main = hspec spec spec :: Test.Hspec.Spec -spec = do +spec = describe "encoding a simple api" $ do it "does it" $ do expected <- @@ -122,6 +122,30 @@ spec = do }) (Proxy :: Proxy ("one" :> Get '[JSON] Int))) generated `itemsShouldBe` expected + it "works with polymorphic data" $ + do expected <- + mapM + (\(fpath, header) -> do + source <- T.readFile fpath + return (fpath, header, source)) + [ ( "test/elm-sources/getPolymorphicData.elm" + , "module GetPolymorphicData exposing (..)\n\n" <> + "import Http\n" <> + "import Json.Decode exposing (..)\n" <> + "import Url.Builder\n\n" <> + "type PolymorphicData a b = PolymorphicData a b\n" <> + "type SomeRecord = SomeRecord { recordId : Int, recordname : String }\n\n" <> + "jsonDecPolymorphicData : Json.Decode.Decoder a -> Json.Decode.Decoder b -> Json.Decode.Decoder (PolymorphicData a b)\n"<> + "jsonDecPolymorphicData _ _ = Debug.todo \"finish\"\n\n" <> + "jsonDecSomeRecord : Json.Decode.Decoder SomeRecord\n"<> + "jsonDecSomeRecord = Debug.todo \"finish\"\n\n\n")] + let generated = + map + (<> "\n") + (generateElmForAPIWith + defElmOptions + (Proxy :: Proxy ( "polymorphicData" :> Get '[JSON] (PolymorphicData [String] SomeRecord)))) + generated `itemsShouldBe` expected itemsShouldBe :: [Text] -> [(String, Text, Text)] -> IO () itemsShouldBe actual expected = @@ -138,7 +162,7 @@ shouldBeDiff a (fpath,header,b) = (Diff.getGroupedDiff (lines (T.unpack actual)) (lines (T.unpack expected)))) - actual expected + expected actual where actual = T.strip $ header <> a expected = T.strip b diff --git a/test/elm-sources/getPolymorphicData.elm b/test/elm-sources/getPolymorphicData.elm new file mode 100644 index 0000000..c264b33 --- /dev/null +++ b/test/elm-sources/getPolymorphicData.elm @@ -0,0 +1,43 @@ +module GetPolymorphicData exposing (..) + +import Http +import Json.Decode exposing (..) +import Url.Builder + +type PolymorphicData a b = PolymorphicData a b +type SomeRecord = SomeRecord { recordId : Int, recordname : String } + +jsonDecPolymorphicData : Json.Decode.Decoder a -> Json.Decode.Decoder b -> Json.Decode.Decoder (PolymorphicData a b) +jsonDecPolymorphicData _ _ = Debug.todo "finish" + +jsonDecSomeRecord : Json.Decode.Decoder SomeRecord +jsonDecSomeRecord = Debug.todo "finish" + + +getPolymorphicData : (Result Http.Error ((PolymorphicData (List String) SomeRecord)) -> msg) -> Cmd msg +getPolymorphicData toMsg = + let + params = + List.filterMap identity + (List.concat + []) + in + Http.request + { method = + "GET" + , headers = + [] + , url = + Url.Builder.crossOrigin "" + [ "polymorphicData" + ] + params + , body = + Http.emptyBody + , expect = + Http.expectJson toMsg ((jsonDecPolymorphicData (Json.Decode.list (Json.Decode.string))) jsonDecSomeRecord) + , timeout = + Nothing + , tracker = + Nothing + } From 0365af3a9072feab0ffb361ae98fdacf8fad4b79 Mon Sep 17 00:00:00 2001 From: = <=> Date: Wed, 30 Oct 2019 20:16:47 -0600 Subject: [PATCH 2/2] Moves polymorphic data to a separate module --- servant-elm.cabal | 1 + test/Common.hs | 8 -------- test/GenerateSpec.hs | 3 ++- test/PolymorphicData.hs | 15 +++++++++++++++ 4 files changed, 18 insertions(+), 9 deletions(-) create mode 100644 test/PolymorphicData.hs diff --git a/servant-elm.cabal b/servant-elm.cabal index c7b89bc..2760628 100644 --- a/servant-elm.cabal +++ b/servant-elm.cabal @@ -48,6 +48,7 @@ test-suite servant-elm-test hs-source-dirs: test main-is: GenerateSpec.hs other-modules: Common + , PolymorphicData build-depends: Diff , HUnit diff --git a/test/Common.hs b/test/Common.hs index bb8ddd2..4bb9521 100644 --- a/test/Common.hs +++ b/test/Common.hs @@ -15,15 +15,7 @@ data Book = Book { title :: String } -data PolymorphicData a b = PolymorphicData a b deriving (Show, Eq) -data SomeRecord = SomeRecord - { recordId :: Int - , recordName :: String - } deriving (Show, Eq) - deriveBoth defaultOptions ''Book -deriveBoth defaultOptions ''PolymorphicData -deriveBoth defaultOptions ''SomeRecord type TestApi = "one" diff --git a/test/GenerateSpec.hs b/test/GenerateSpec.hs index 85582d6..771e1fa 100644 --- a/test/GenerateSpec.hs +++ b/test/GenerateSpec.hs @@ -17,7 +17,8 @@ import Servant.Elm import Test.Hspec (Spec, describe, hspec, it) import Test.HUnit (Assertion, assertEqual) -import Common (testApi, SomeRecord(..), PolymorphicData(..)) +import Common (testApi) +import PolymorphicData (SomeRecord(..), PolymorphicData(..)) main :: IO () diff --git a/test/PolymorphicData.hs b/test/PolymorphicData.hs new file mode 100644 index 0000000..ea5fa8c --- /dev/null +++ b/test/PolymorphicData.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} + +module PolymorphicData where + +import Servant.Elm + + +data PolymorphicData a b = PolymorphicData a b deriving (Show, Eq) +data SomeRecord = SomeRecord + { recordId :: Int + , recordName :: String + } deriving (Show, Eq) + +deriveBoth defaultOptions ''PolymorphicData +deriveBoth defaultOptions ''SomeRecord