Merge pull request #227 from zerobuzz/tosample-for-tuples
ToSample instances for tuples.
This commit is contained in:
Julian Arni
commit
019fad973d
2 changed files with 180 additions and 1 deletions
|
|
@ -919,3 +919,156 @@ instance HasDocs sublayout => HasDocs (HttpVersion :> sublayout) where
|
||||||
instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
|
instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
|
||||||
docsFor Proxy ep =
|
docsFor Proxy ep =
|
||||||
docsFor (Proxy :: Proxy sublayout) 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))
|
||||||
|
|
||||||
|
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))
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,9 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE TypeSynonymInstances #-}
|
{-# LANGUAGE TypeSynonymInstances #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# 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` "get an integer in Json or plain text"
|
||||||
md `shouldContain` "Posts some Json data"
|
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
|
where
|
||||||
tests md = do
|
tests md = do
|
||||||
it "mentions supported content-types" $ do
|
it "mentions supported content-types" $ do
|
||||||
|
|
@ -81,7 +98,16 @@ instance ToSample Int Int where
|
||||||
instance MimeRender PlainText Int where
|
instance MimeRender PlainText Int where
|
||||||
mimeRender _ = cs . show
|
mimeRender _ = cs . show
|
||||||
|
|
||||||
|
|
||||||
type TestApi1 = Get '[JSON, PlainText] Int
|
type TestApi1 = Get '[JSON, PlainText] Int
|
||||||
:<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
|
:<|> 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)]
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue