From e5259358db9b4a89f03f0468b9d94b1f154c3aba Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 16 Sep 2015 11:35:15 +0200 Subject: [PATCH 1/3] ToSample instances for tuples. --- servant-docs/src/Servant/Docs/Internal.hs | 87 +++++++++++++++++++++++ 1 file changed, 87 insertions(+) diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index be4bfb00..728a3b7c 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -919,3 +919,90 @@ instance HasDocs sublayout => HasDocs (HttpVersion :> sublayout) where instance HasDocs sublayout => HasDocs (Vault :> sublayout) where docsFor Proxy ep = docsFor (Proxy :: Proxy sublayout) ep + + +-- polymorphic 'ToSample' instances + +instance ( ToSample a a + , ToSample b b + ) => ToSample (a, b) (a, b) where + toSample _ = (,) + <$> toSample (Proxy :: Proxy a) + <*> toSample (Proxy :: Proxy b) + toSamples _ = render + <$> toSamples (Proxy :: Proxy a) + <*> toSamples (Proxy :: Proxy b) + where render (ta, va) (tb, vb) + = ("(" <> ta <> + ", " <> tb <> + ")" + , (va, vb)) + +instance ( ToSample a a + , ToSample b b + , ToSample c c + ) => ToSample (a, b, c) (a, b, c) where + toSample _ = (,,) + <$> toSample (Proxy :: Proxy a) + <*> toSample (Proxy :: Proxy b) + <*> toSample (Proxy :: Proxy c) + toSamples _ = render + <$> toSamples (Proxy :: Proxy a) + <*> toSamples (Proxy :: Proxy b) + <*> toSamples (Proxy :: Proxy c) + where render (ta, va) (tb, vb) (tc, vc) + = ("(" <> ta <> + ", " <> tb <> + ", " <> tc <> + ")" + , (va, vb, vc)) + +instance ( ToSample a a + , ToSample b b + , ToSample c c + , ToSample d d + ) => ToSample (a, b, c, d) (a, b, c, d) where + toSample _ = (,,,) + <$> toSample (Proxy :: Proxy a) + <*> toSample (Proxy :: Proxy b) + <*> toSample (Proxy :: Proxy c) + <*> toSample (Proxy :: Proxy d) + toSamples _ = render + <$> toSamples (Proxy :: Proxy a) + <*> toSamples (Proxy :: Proxy b) + <*> toSamples (Proxy :: Proxy c) + <*> toSamples (Proxy :: Proxy d) + where render (ta, va) (tb, vb) (tc, vc) (td, vd) + = ("(" <> ta <> + ", " <> tb <> + ", " <> tc <> + ", " <> td <> + ")" + , (va, vb, vc, vd)) + +instance ( ToSample a a + , ToSample b b + , ToSample c c + , ToSample d d + , ToSample e e + ) => ToSample (a, b, c, d, e) (a, b, c, d, e) where + toSample _ = (,,,,) + <$> toSample (Proxy :: Proxy a) + <*> toSample (Proxy :: Proxy b) + <*> toSample (Proxy :: Proxy c) + <*> toSample (Proxy :: Proxy d) + <*> toSample (Proxy :: Proxy e) + toSamples _ = render + <$> toSamples (Proxy :: Proxy a) + <*> toSamples (Proxy :: Proxy b) + <*> toSamples (Proxy :: Proxy c) + <*> toSamples (Proxy :: Proxy d) + <*> toSamples (Proxy :: Proxy e) + where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) + = ("(" <> ta <> + ", " <> tb <> + ", " <> tc <> + ", " <> td <> + ", " <> te <> + ")" + , (va, vb, vc, vd, ve)) From d9df8f043e3ebec240c20a24906856f50951b63e Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 16 Sep 2015 12:42:05 +0200 Subject: [PATCH 2/3] Add tests. --- servant-docs/test/Servant/DocsSpec.hs | 28 ++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index 9da66448..b67d079f 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -1,7 +1,9 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -42,6 +44,21 @@ spec = describe "Servant.Docs" $ do md `shouldContain` "get an integer in Json or plain text" md `shouldContain` "Posts some Json data" + describe "tuple samples" $ do + it "looks like expected" $ do + (toSample (Proxy :: Proxy (TT, UT))) `shouldBe` Just (TT1,UT1) + (toSample (Proxy :: Proxy (TT, UT, UT))) `shouldBe` Just (TT1,UT1,UT1) + (toSamples (Proxy :: Proxy (TT, UT))) `shouldBe` + [ ("(eins, yks)",(TT1,UT1)), ("(eins, kaks)",(TT1,UT2)) + , ("(zwei, yks)",(TT2,UT1)), ("(zwei, kaks)",(TT2,UT2)) + ] + (toSamples (Proxy :: Proxy (TT, UT, UT))) `shouldBe` + [ ("(eins, yks, yks)",(TT1,UT1,UT1)), ("(eins, yks, kaks)",(TT1,UT1,UT2)) + , ("(eins, kaks, yks)",(TT1,UT2,UT1)), ("(eins, kaks, kaks)",(TT1,UT2,UT2)) + , ("(zwei, yks, yks)",(TT2,UT1,UT1)), ("(zwei, yks, kaks)",(TT2,UT1,UT2)) + , ("(zwei, kaks, yks)",(TT2,UT2,UT1)), ("(zwei, kaks, kaks)",(TT2,UT2,UT2)) + ] + where tests md = do it "mentions supported content-types" $ do @@ -81,7 +98,16 @@ instance ToSample Int Int where instance MimeRender PlainText Int where mimeRender _ = cs . show - type TestApi1 = Get '[JSON, PlainText] Int :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1 +data TT = TT1 | TT2 deriving (Show, Eq) +data UT = UT1 | UT2 deriving (Show, Eq) + +instance ToSample TT TT where + toSample _ = Just TT1 + toSamples _ = [("eins", TT1), ("zwei", TT2)] + +instance ToSample UT UT where + toSample _ = Just UT1 + toSamples _ = [("yks", UT1), ("kaks", UT2)] From 99d1402a06fb729bc199732e1784324299018324 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 16 Sep 2015 12:43:50 +0200 Subject: [PATCH 3/3] ToSample instances for longer tuples (up to 7). --- servant-docs/src/Servant/Docs/Internal.hs | 66 +++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 728a3b7c..e502ea61 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -1006,3 +1006,69 @@ instance ( ToSample a a ", " <> te <> ")" , (va, vb, vc, vd, ve)) + +instance ( ToSample a a + , ToSample b b + , ToSample c c + , ToSample d d + , ToSample e e + , ToSample f f + ) => ToSample (a, b, c, d, e, f) (a, b, c, d, e, f) where + toSample _ = (,,,,,) + <$> toSample (Proxy :: Proxy a) + <*> toSample (Proxy :: Proxy b) + <*> toSample (Proxy :: Proxy c) + <*> toSample (Proxy :: Proxy d) + <*> toSample (Proxy :: Proxy e) + <*> toSample (Proxy :: Proxy f) + toSamples _ = render + <$> toSamples (Proxy :: Proxy a) + <*> toSamples (Proxy :: Proxy b) + <*> toSamples (Proxy :: Proxy c) + <*> toSamples (Proxy :: Proxy d) + <*> toSamples (Proxy :: Proxy e) + <*> toSamples (Proxy :: Proxy f) + where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) (tf, vf) + = ("(" <> ta <> + ", " <> tb <> + ", " <> tc <> + ", " <> td <> + ", " <> te <> + ", " <> tf <> + ")" + , (va, vb, vc, vd, ve, vf)) + +instance ( ToSample a a + , ToSample b b + , ToSample c c + , ToSample d d + , ToSample e e + , ToSample f f + , ToSample g g + ) => ToSample (a, b, c, d, e, f, g) (a, b, c, d, e, f, g) where + toSample _ = (,,,,,,) + <$> toSample (Proxy :: Proxy a) + <*> toSample (Proxy :: Proxy b) + <*> toSample (Proxy :: Proxy c) + <*> toSample (Proxy :: Proxy d) + <*> toSample (Proxy :: Proxy e) + <*> toSample (Proxy :: Proxy f) + <*> toSample (Proxy :: Proxy g) + toSamples _ = render + <$> toSamples (Proxy :: Proxy a) + <*> toSamples (Proxy :: Proxy b) + <*> toSamples (Proxy :: Proxy c) + <*> toSamples (Proxy :: Proxy d) + <*> toSamples (Proxy :: Proxy e) + <*> toSamples (Proxy :: Proxy f) + <*> toSamples (Proxy :: Proxy g) + where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) (tf, vf) (tg, vg) + = ("(" <> ta <> + ", " <> tb <> + ", " <> tc <> + ", " <> td <> + ", " <> te <> + ", " <> tf <> + ", " <> tg <> + ")" + , (va, vb, vc, vd, ve, vf, vg))