Move toSample method out of ToSample class

toSample method conflicted with default Generics implementation.
This commit is contained in:
Nickolay Kudasov 2015-09-19 02:27:51 +03:00
parent e3f5a357e1
commit 98af812491
4 changed files with 20 additions and 22 deletions

View file

@ -54,15 +54,13 @@ instance ToParam (MatrixParam "lang" String) where
Normal Normal
instance ToSample Greet Greet where instance ToSample Greet Greet where
toSample _ = Just $ Greet "Hello, haskeller!"
toSamples _ = toSamples _ =
[ ("If you use ?capital=true", Greet "HELLO, HASKELLER") [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
, ("If you use ?capital=false", Greet "Hello, haskeller") , ("If you use ?capital=false", Greet "Hello, haskeller")
] ]
instance ToSample Int Int where instance ToSample Int Int where
toSample _ = Just 1729 toSamples _ = singleSample 1729
-- We define some introductory sections, these will appear at the top of the -- We define some introductory sections, these will appear at the top of the
-- documentation. -- documentation.

View file

@ -148,6 +148,9 @@ module Servant.Docs
, -- * Classes you need to implement for your types , -- * Classes you need to implement for your types
ToSample(..) ToSample(..)
, toSample
, noSamples
, singleSample
, sampleByteString , sampleByteString
, sampleByteStrings , sampleByteStrings
, ToParam(..) , ToParam(..)

View file

@ -374,7 +374,7 @@ class HasDocs layout where
-- > instance ToJSON Greet -- > instance ToJSON Greet
-- > -- >
-- > instance ToSample Greet Greet where -- > instance ToSample Greet Greet where
-- > toSample _ = Just g -- > toSamples _ = singleSample g
-- > -- >
-- > where g = Greet "Hello, haskeller!" -- > where g = Greet "Hello, haskeller!"
-- --
@ -383,34 +383,34 @@ class HasDocs layout where
-- some context (as 'Text') that explains when you're supposed to -- some context (as 'Text') that explains when you're supposed to
-- get the corresponding response. -- get the corresponding response.
class ToSample a b | a -> b where class ToSample a b | a -> b where
toSample :: Proxy a -> Maybe b
toSample _ = snd <$> listToMaybe samples
where samples = toSamples (Proxy :: Proxy a)
toSamples :: Proxy a -> [(Text, b)] toSamples :: Proxy a -> [(Text, b)]
default toSamples :: (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)] default toSamples :: (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]
toSamples = defaultSamples toSamples = defaultSamples
defaultSample :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> Maybe b toSample :: forall a b. ToSample a b => Proxy a -> Maybe b
defaultSample _ = to <$> gtoSample (Proxy :: Proxy (Rep a)) toSample _ = snd <$> listToMaybe (toSamples (Proxy :: Proxy a))
-- | No samples.
noSamples :: [(Text, a)]
noSamples = empty
-- | Single sample without description.
singleSample :: a -> [(Text, a)]
singleSample x = [("", x)]
defaultSamples :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)] defaultSamples :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]
defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a)) defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))
class GToSample t s where class GToSample t s where
gtoSample :: proxy t -> Maybe (s x)
gtoSample _ = snd <$> listToMaybe (Omega.runOmega (gtoSamples (Proxy :: Proxy t)))
gtoSamples :: proxy t -> Omega.Omega (Text, s x) gtoSamples :: proxy t -> Omega.Omega (Text, s x)
gtoSamples _ = maybe empty (pure . ("",)) (gtoSample (Proxy :: Proxy t))
instance GToSample U1 U1 where instance GToSample U1 U1 where
gtoSample _ = Just U1 gtoSamples _ = Omega.each (singleSample U1)
instance GToSample V1 V1 where instance GToSample V1 V1 where
gtoSample _ = Nothing gtoSamples _ = empty
instance (GToSample p p', GToSample q q') => GToSample (p :*: q) (p' :*: q') where instance (GToSample p p', GToSample q q') => GToSample (p :*: q) (p' :*: q') where
gtoSample _ = (:*:) <$> gtoSample (Proxy :: Proxy p) <*> gtoSample (Proxy :: Proxy q)
gtoSamples _ = render <$> ps <*> qs gtoSamples _ = render <$> ps <*> qs
where where
ps = gtoSamples (Proxy :: Proxy p) ps = gtoSamples (Proxy :: Proxy p)
@ -426,15 +426,12 @@ instance (GToSample p p', GToSample q q') => GToSample (p :+: q) (p' :+: q') whe
rights = second R1 <$> gtoSamples (Proxy :: Proxy q) rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
instance ToSample a b => GToSample (K1 i a) (K1 i b) where instance ToSample a b => GToSample (K1 i a) (K1 i b) where
gtoSample _ = K1 <$> toSample (Proxy :: Proxy a)
gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a)) gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))
instance (GToSample f g) => GToSample (M1 i a f) (M1 i a g) where instance (GToSample f g) => GToSample (M1 i a f) (M1 i a g) where
gtoSample _ = M1 <$> gtoSample (Proxy :: Proxy f)
gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f) gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
instance ToSample a b => ToSample (Headers ls a) b where instance ToSample a b => ToSample (Headers ls a) b where
toSample _ = toSample (Proxy :: Proxy a)
toSamples _ = toSamples (Proxy :: Proxy a) toSamples _ = toSamples (Proxy :: Proxy a)

View file

@ -24,7 +24,7 @@ instance ToCapture (Capture "y" Int) where
toCapture _ = DocCapture "y" "(integer) position on the y axis" toCapture _ = DocCapture "y" "(integer) position on the y axis"
instance ToSample T3.Position T3.Position where instance ToSample T3.Position T3.Position where
toSample _ = Just (T3.Position 3 14) toSamples _ = singleSample (T3.Position 3 14)
instance ToParam (QueryParam "name" String) where instance ToParam (QueryParam "name" String) where
toParam _ = toParam _ =
@ -43,10 +43,10 @@ ci :: T3.ClientInfo
ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"] ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
instance ToSample T3.ClientInfo T3.ClientInfo where instance ToSample T3.ClientInfo T3.ClientInfo where
toSample _ = Just ci toSamples _ = singleSample ci
instance ToSample T3.Email T3.Email where instance ToSample T3.Email T3.Email where
toSample _ = Just (T3.emailForClient ci) toSamples _ = singleSample (T3.emailForClient ci)
api :: Proxy DocsAPI api :: Proxy DocsAPI
api = Proxy api = Proxy