git.iko.soy/typeable/servant
on master help sign in
Merge pull request #227 from zerobuzz/tosample-for-tuples

ToSample instances for tuples.

commit019fad973d0141f0f181d768f24227ea7ee84a62 authorJulian Arni <jkarni@gmail.com> dateFri 18 Sep 2015, 16:36 (11 years ago) parent81e08f399d1402
2 files changed+180−1
compare with master
unifiedsplit
servant-docs/src/Servant/Docs/Internal.hs+153 servant-docs/test/Servant/DocsSpec.hs+27−1
servant-docs/src/Servant/Docs/Internal.hs+153
@@ -919,3 +919,156 @@ instance HasDocs sublayout => HasDocs (HttpVersion :> sublayout) where
919919instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
920920 docsFor Proxy ep =
921921 docsFor (Proxy :: Proxy sublayout) ep
922+
923+
924+-- polymorphic 'ToSample' instances
925+
926+instance ( ToSample a a
927+ , ToSample b b
928+ ) => ToSample (a, b) (a, b) where
929+ toSample _ = (,)
930+ <$> toSample (Proxy :: Proxy a)
931+ <*> toSample (Proxy :: Proxy b)
932+ toSamples _ = render
933+ <$> toSamples (Proxy :: Proxy a)
934+ <*> toSamples (Proxy :: Proxy b)
935+ where render (ta, va) (tb, vb)
936+ = ("(" <> ta <>
937+ ", " <> tb <>
938+ ")"
939+ , (va, vb))
940+
941+instance ( ToSample a a
942+ , ToSample b b
943+ , ToSample c c
944+ ) => ToSample (a, b, c) (a, b, c) where
945+ toSample _ = (,,)
946+ <$> toSample (Proxy :: Proxy a)
947+ <*> toSample (Proxy :: Proxy b)
948+ <*> toSample (Proxy :: Proxy c)
949+ toSamples _ = render
950+ <$> toSamples (Proxy :: Proxy a)
951+ <*> toSamples (Proxy :: Proxy b)
952+ <*> toSamples (Proxy :: Proxy c)
953+ where render (ta, va) (tb, vb) (tc, vc)
954+ = ("(" <> ta <>
955+ ", " <> tb <>
956+ ", " <> tc <>
957+ ")"
958+ , (va, vb, vc))
959+
960+instance ( ToSample a a
961+ , ToSample b b
962+ , ToSample c c
963+ , ToSample d d
964+ ) => ToSample (a, b, c, d) (a, b, c, d) where
965+ toSample _ = (,,,)
966+ <$> toSample (Proxy :: Proxy a)
967+ <*> toSample (Proxy :: Proxy b)
968+ <*> toSample (Proxy :: Proxy c)
969+ <*> toSample (Proxy :: Proxy d)
970+ toSamples _ = render
971+ <$> toSamples (Proxy :: Proxy a)
972+ <*> toSamples (Proxy :: Proxy b)
973+ <*> toSamples (Proxy :: Proxy c)
974+ <*> toSamples (Proxy :: Proxy d)
975+ where render (ta, va) (tb, vb) (tc, vc) (td, vd)
976+ = ("(" <> ta <>
977+ ", " <> tb <>
978+ ", " <> tc <>
979+ ", " <> td <>
980+ ")"
981+ , (va, vb, vc, vd))
982+
983+instance ( ToSample a a
984+ , ToSample b b
985+ , ToSample c c
986+ , ToSample d d
987+ , ToSample e e
988+ ) => ToSample (a, b, c, d, e) (a, b, c, d, e) where
989+ toSample _ = (,,,,)
990+ <$> toSample (Proxy :: Proxy a)
991+ <*> toSample (Proxy :: Proxy b)
992+ <*> toSample (Proxy :: Proxy c)
993+ <*> toSample (Proxy :: Proxy d)
994+ <*> toSample (Proxy :: Proxy e)
995+ toSamples _ = render
996+ <$> toSamples (Proxy :: Proxy a)
997+ <*> toSamples (Proxy :: Proxy b)
998+ <*> toSamples (Proxy :: Proxy c)
999+ <*> toSamples (Proxy :: Proxy d)
1000+ <*> toSamples (Proxy :: Proxy e)
1001+ where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve)
1002+ = ("(" <> ta <>
1003+ ", " <> tb <>
1004+ ", " <> tc <>
1005+ ", " <> td <>
1006+ ", " <> te <>
1007+ ")"
1008+ , (va, vb, vc, vd, ve))
1009+
1010+instance ( ToSample a a
1011+ , ToSample b b
1012+ , ToSample c c
1013+ , ToSample d d
1014+ , ToSample e e
1015+ , ToSample f f
1016+ ) => ToSample (a, b, c, d, e, f) (a, b, c, d, e, f) where
1017+ toSample _ = (,,,,,)
1018+ <$> toSample (Proxy :: Proxy a)
1019+ <*> toSample (Proxy :: Proxy b)
1020+ <*> toSample (Proxy :: Proxy c)
1021+ <*> toSample (Proxy :: Proxy d)
1022+ <*> toSample (Proxy :: Proxy e)
1023+ <*> toSample (Proxy :: Proxy f)
1024+ toSamples _ = render
1025+ <$> toSamples (Proxy :: Proxy a)
1026+ <*> toSamples (Proxy :: Proxy b)
1027+ <*> toSamples (Proxy :: Proxy c)
1028+ <*> toSamples (Proxy :: Proxy d)
1029+ <*> toSamples (Proxy :: Proxy e)
1030+ <*> toSamples (Proxy :: Proxy f)
1031+ where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) (tf, vf)
1032+ = ("(" <> ta <>
1033+ ", " <> tb <>
1034+ ", " <> tc <>
1035+ ", " <> td <>
1036+ ", " <> te <>
1037+ ", " <> tf <>
1038+ ")"
1039+ , (va, vb, vc, vd, ve, vf))
1040+
1041+instance ( ToSample a a
1042+ , ToSample b b
1043+ , ToSample c c
1044+ , ToSample d d
1045+ , ToSample e e
1046+ , ToSample f f
1047+ , ToSample g g
1048+ ) => ToSample (a, b, c, d, e, f, g) (a, b, c, d, e, f, g) where
1049+ toSample _ = (,,,,,,)
1050+ <$> toSample (Proxy :: Proxy a)
1051+ <*> toSample (Proxy :: Proxy b)
1052+ <*> toSample (Proxy :: Proxy c)
1053+ <*> toSample (Proxy :: Proxy d)
1054+ <*> toSample (Proxy :: Proxy e)
1055+ <*> toSample (Proxy :: Proxy f)
1056+ <*> toSample (Proxy :: Proxy g)
1057+ toSamples _ = render
1058+ <$> toSamples (Proxy :: Proxy a)
1059+ <*> toSamples (Proxy :: Proxy b)
1060+ <*> toSamples (Proxy :: Proxy c)
1061+ <*> toSamples (Proxy :: Proxy d)
1062+ <*> toSamples (Proxy :: Proxy e)
1063+ <*> toSamples (Proxy :: Proxy f)
1064+ <*> toSamples (Proxy :: Proxy g)
1065+ where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) (tf, vf) (tg, vg)
1066+ = ("(" <> ta <>
1067+ ", " <> tb <>
1068+ ", " <> tc <>
1069+ ", " <> td <>
1070+ ", " <> te <>
1071+ ", " <> tf <>
1072+ ", " <> tg <>
1073+ ")"
1074+ , (va, vb, vc, vd, ve, vf, vg))
servant-docs/test/Servant/DocsSpec.hs+27−1
@@ -1,7 +1,9 @@
11{-# LANGUAGE DataKinds #-}
22{-# LANGUAGE DeriveGeneric #-}
33{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE FlexibleContexts #-}
45{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE OverloadedStrings #-}
57{-# LANGUAGE TypeOperators #-}
68{-# LANGUAGE TypeSynonymInstances #-}
79{-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -42,6 +44,21 @@ spec = describe "Servant.Docs" $ do
4244 md `shouldContain` "get an integer in Json or plain text"
4345 md `shouldContain` "Posts some Json data"
4446
47+ describe "tuple samples" $ do
48+ it "looks like expected" $ do
49+ (toSample (Proxy :: Proxy (TT, UT))) `shouldBe` Just (TT1,UT1)
50+ (toSample (Proxy :: Proxy (TT, UT, UT))) `shouldBe` Just (TT1,UT1,UT1)
51+ (toSamples (Proxy :: Proxy (TT, UT))) `shouldBe`
52+ [ ("(eins, yks)",(TT1,UT1)), ("(eins, kaks)",(TT1,UT2))
53+ , ("(zwei, yks)",(TT2,UT1)), ("(zwei, kaks)",(TT2,UT2))
54+ ]
55+ (toSamples (Proxy :: Proxy (TT, UT, UT))) `shouldBe`
56+ [ ("(eins, yks, yks)",(TT1,UT1,UT1)), ("(eins, yks, kaks)",(TT1,UT1,UT2))
57+ , ("(eins, kaks, yks)",(TT1,UT2,UT1)), ("(eins, kaks, kaks)",(TT1,UT2,UT2))
58+ , ("(zwei, yks, yks)",(TT2,UT1,UT1)), ("(zwei, yks, kaks)",(TT2,UT1,UT2))
59+ , ("(zwei, kaks, yks)",(TT2,UT2,UT1)), ("(zwei, kaks, kaks)",(TT2,UT2,UT2))
60+ ]
61+
4562 where
4663 tests md = do
4764 it "mentions supported content-types" $ do
@@ -81,7 +98,16 @@ instance ToSample Int Int where
8198instance MimeRender PlainText Int where
8299 mimeRender _ = cs . show
83100
84−
85101type TestApi1 = Get '[JSON, PlainText] Int
86102 :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
87103
104+data TT = TT1 | TT2 deriving (Show, Eq)
105+data UT = UT1 | UT2 deriving (Show, Eq)
106+
107+instance ToSample TT TT where
108+ toSample _ = Just TT1
109+ toSamples _ = [("eins", TT1), ("zwei", TT2)]
110+
111+instance ToSample UT UT where
112+ toSample _ = Just UT1
113+ toSamples _ = [("yks", UT1), ("kaks", UT2)]