Merge pull request #61 from MikePors/master

Improving support for polymorphic data types

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

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]

test/GenerateSpec.hs

@@ -18,13 +18,14 @@ import           Test.Hspec                (Spec, describe, hspec, it)
 import           Test.HUnit                (Assertion, assertEqual)
 
 import           Common                    (testApi)
+import           PolymorphicData           (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 +123,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 +163,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

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

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
+            }