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
|
||||
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))
|
||||
|
||||
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 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)]
|
||||
|
|
|
|||
Loading…
Reference in a new issue