From 98af812491e0972e3ecb40adb1849199cfe1d197 Mon Sep 17 00:00:00 2001
From: Nickolay Kudasov <nickolay.kudasov@gmail.com>
Date: Sat, 19 Sep 2015 02:27:51 +0300
Subject: [PATCH] Move toSample method out of ToSample class

toSample method conflicted with default Generics implementation.
---
 servant-docs/example/greet.hs             |  4 +---
 servant-docs/src/Servant/Docs.hs          |  3 +++
 servant-docs/src/Servant/Docs/Internal.hs | 29 ++++++++++-------------
 servant-examples/tutorial/T10.hs          |  6 ++---
 4 files changed, 20 insertions(+), 22 deletions(-)

diff --git a/servant-docs/example/greet.hs b/servant-docs/example/greet.hs
index dff4a397..ce54ea4e 100644
--- a/servant-docs/example/greet.hs
+++ b/servant-docs/example/greet.hs
@@ -54,15 +54,13 @@ instance ToParam (MatrixParam "lang" String) where
                   Normal
 
 instance ToSample Greet Greet where
-  toSample _ = Just $ Greet "Hello, haskeller!"
-
   toSamples _ =
     [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
     , ("If you use ?capital=false", Greet "Hello, haskeller")
     ]
 
 instance ToSample Int Int where
-  toSample _ = Just 1729
+  toSamples _ = singleSample 1729
 
 -- We define some introductory sections, these will appear at the top of the
 -- documentation.
diff --git a/servant-docs/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs
index e12d52f9..09399c02 100644
--- a/servant-docs/src/Servant/Docs.hs
+++ b/servant-docs/src/Servant/Docs.hs
@@ -148,6 +148,9 @@ module Servant.Docs
 
   , -- * Classes you need to implement for your types
     ToSample(..)
+  , toSample
+  , noSamples
+  , singleSample
   , sampleByteString
   , sampleByteStrings
   , ToParam(..)
diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs
index f69ee134..876561b8 100644
--- a/servant-docs/src/Servant/Docs/Internal.hs
+++ b/servant-docs/src/Servant/Docs/Internal.hs
@@ -374,7 +374,7 @@ class HasDocs layout where
 -- > instance ToJSON Greet
 -- >
 -- > instance ToSample Greet Greet where
--- >   toSample _ = Just g
+-- >   toSamples _ = singleSample g
 -- >
 -- >     where g = Greet "Hello, haskeller!"
 --
@@ -383,34 +383,34 @@ class HasDocs layout where
 -- some context (as 'Text') that explains when you're supposed to
 -- get the corresponding response.
 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)]
   default toSamples :: (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]
   toSamples = defaultSamples
 
-defaultSample :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> Maybe b
-defaultSample _ = to <$> gtoSample (Proxy :: Proxy (Rep a))
+toSample :: forall a b. ToSample a b => Proxy a -> Maybe b
+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 _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))
 
 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 _ = maybe empty (pure . ("",)) (gtoSample (Proxy :: Proxy t))
 
 instance GToSample U1 U1 where
-  gtoSample _ = Just U1
+  gtoSamples _ = Omega.each (singleSample U1)
 
 instance GToSample V1 V1 where
-  gtoSample _ = Nothing
+  gtoSamples _ = empty
 
 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
     where
       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)
 
 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))
 
 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)
 
 instance ToSample a b => ToSample (Headers ls a) b where
-  toSample _  = toSample (Proxy :: Proxy a)
   toSamples _ = toSamples (Proxy :: Proxy a)
 
 
diff --git a/servant-examples/tutorial/T10.hs b/servant-examples/tutorial/T10.hs
index 206e72e4..32e24728 100644
--- a/servant-examples/tutorial/T10.hs
+++ b/servant-examples/tutorial/T10.hs
@@ -24,7 +24,7 @@ instance ToCapture (Capture "y" Int) where
   toCapture _ = DocCapture "y" "(integer) position on the y axis"
 
 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
   toParam _ =
@@ -43,10 +43,10 @@ ci :: T3.ClientInfo
 ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
 
 instance ToSample T3.ClientInfo T3.ClientInfo where
-  toSample _ = Just ci
+  toSamples _ = singleSample ci
 
 instance ToSample T3.Email T3.Email where
-  toSample _ = Just (T3.emailForClient ci)
+  toSamples _ = singleSample (T3.emailForClient ci)
 
 api :: Proxy DocsAPI
 api = Proxy