on master help sign in
Move toSample method out of ToSample class

toSample method conflicted with default Generics implementation.

commit98af812491e0972e3ecb40adb1849199cfe1d197 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateSat 19 Sep 2015, 02:27 (11 years ago) parente3f5a35
4 files changed+20−22
servant-docs/example/greet.hs+1−3 servant-docs/src/Servant/Docs.hs+3 servant-docs/src/Servant/Docs/Internal.hs+13−16 servant-examples/tutorial/T10.hs+3−3
servant-docs/example/greet.hs+1−3
@@ -54,15 +54,13 @@ instance ToParam (MatrixParam "lang" String) where
5454 Normal
5555
5656instance ToSample Greet Greet where
57− toSample _ = Just $ Greet "Hello, haskeller!"
58−
5957 toSamples _ =
6058 [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
6159 , ("If you use ?capital=false", Greet "Hello, haskeller")
6260 ]
6361
6462instance ToSample Int Int where
65− toSample _ = Just 1729
63+ toSamples _ = singleSample 1729
6664
6765-- We define some introductory sections, these will appear at the top of the
6866-- documentation.
servant-docs/src/Servant/Docs.hs+3
@@ -148,6 +148,9 @@ module Servant.Docs
148148
149149 , -- * Classes you need to implement for your types
150150 ToSample(..)
151+ , toSample
152+ , noSamples
153+ , singleSample
151154 , sampleByteString
152155 , sampleByteStrings
153156 , ToParam(..)
servant-docs/src/Servant/Docs/Internal.hs+13−16
@@ -374,7 +374,7 @@ class HasDocs layout where
374374-- > instance ToJSON Greet
375375-- >
376376-- > instance ToSample Greet Greet where
377−-- > toSample _ = Just g
377+-- > toSamples _ = singleSample g
378378-- >
379379-- > where g = Greet "Hello, haskeller!"
380380--
@@ -383,34 +383,34 @@ class HasDocs layout where
383383-- some context (as 'Text') that explains when you're supposed to
384384-- get the corresponding response.
385385class ToSample a b | a -> b where
386− toSample :: Proxy a -> Maybe b
387− toSample _ = snd <$> listToMaybe samples
388− where samples = toSamples (Proxy :: Proxy a)
389−
390386 toSamples :: Proxy a -> [(Text, b)]
391387 default toSamples :: (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]
392388 toSamples = defaultSamples
393389
394−defaultSample :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> Maybe b
395−defaultSample _ = to <$> gtoSample (Proxy :: Proxy (Rep a))
390+toSample :: forall a b. ToSample a b => Proxy a -> Maybe b
391+toSample _ = snd <$> listToMaybe (toSamples (Proxy :: Proxy a))
392+
393+-- | No samples.
394+noSamples :: [(Text, a)]
395+noSamples = empty
396+
397+-- | Single sample without description.
398+singleSample :: a -> [(Text, a)]
399+singleSample x = [("", x)]
396400
397401defaultSamples :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]
398402defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))
399403
400404class GToSample t s where
401− gtoSample :: proxy t -> Maybe (s x)
402− gtoSample _ = snd <$> listToMaybe (Omega.runOmega (gtoSamples (Proxy :: Proxy t)))
403405 gtoSamples :: proxy t -> Omega.Omega (Text, s x)
404− gtoSamples _ = maybe empty (pure . ("",)) (gtoSample (Proxy :: Proxy t))
405406
406407instance GToSample U1 U1 where
407− gtoSample _ = Just U1
408+ gtoSamples _ = Omega.each (singleSample U1)
408409
409410instance GToSample V1 V1 where
410− gtoSample _ = Nothing
411+ gtoSamples _ = empty
411412
412413instance (GToSample p p', GToSample q q') => GToSample (p :*: q) (p' :*: q') where
413− gtoSample _ = (:*:) <$> gtoSample (Proxy :: Proxy p) <*> gtoSample (Proxy :: Proxy q)
414414 gtoSamples _ = render <$> ps <*> qs
415415 where
416416 ps = gtoSamples (Proxy :: Proxy p)
@@ -426,15 +426,12 @@ instance (GToSample p p', GToSample q q') => GToSample (p :+: q) (p' :+: q') whe
426426 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
427427
428428instance ToSample a b => GToSample (K1 i a) (K1 i b) where
429− gtoSample _ = K1 <$> toSample (Proxy :: Proxy a)
430429 gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))
431430
432431instance (GToSample f g) => GToSample (M1 i a f) (M1 i a g) where
433− gtoSample _ = M1 <$> gtoSample (Proxy :: Proxy f)
434432 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
435433
436434instance ToSample a b => ToSample (Headers ls a) b where
437− toSample _ = toSample (Proxy :: Proxy a)
438435 toSamples _ = toSamples (Proxy :: Proxy a)
439436
440437
servant-examples/tutorial/T10.hs+3−3
@@ -24,7 +24,7 @@ instance ToCapture (Capture "y" Int) where
2424 toCapture _ = DocCapture "y" "(integer) position on the y axis"
2525
2626instance ToSample T3.Position T3.Position where
27− toSample _ = Just (T3.Position 3 14)
27+ toSamples _ = singleSample (T3.Position 3 14)
2828
2929instance ToParam (QueryParam "name" String) where
3030 toParam _ =
@@ -43,10 +43,10 @@ ci :: T3.ClientInfo
4343ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
4444
4545instance ToSample T3.ClientInfo T3.ClientInfo where
46− toSample _ = Just ci
46+ toSamples _ = singleSample ci
4747
4848instance ToSample T3.Email T3.Email where
49− toSample _ = Just (T3.emailForClient ci)
49+ toSamples _ = singleSample (T3.emailForClient ci)
5050
5151api :: Proxy DocsAPI
5252api = Proxy