From 8d92d66e00c41aa1240ab5190a387fb638267842 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=B6nke=20Hahn?= <soenke.hahn@zalora.com>
Date: Thu, 13 Nov 2014 15:19:14 +0800
Subject: [PATCH] refactored Servant.Docs.ToSample

---
 example/greet.hs           |  4 +---
 src/Servant/API/Get.hs     |  2 +-
 src/Servant/API/Post.hs    |  2 +-
 src/Servant/API/Put.hs     |  2 +-
 src/Servant/API/ReqBody.hs |  2 +-
 src/Servant/Docs.hs        | 13 ++++++++++---
 test/Servant/ServerSpec.hs |  2 +-
 7 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/example/greet.hs b/example/greet.hs
index c2c9976f..54226d9e 100644
--- a/example/greet.hs
+++ b/example/greet.hs
@@ -46,9 +46,7 @@ instance ToParam (QueryParam "capital" Bool) where
                   Normal
 
 instance ToSample Greet where
-  toSample Proxy = Just (encode g)
-
-    where g = Greet "Hello, haskeller!"
+  toSample = Just $ Greet "Hello, haskeller!"
 
 -- API specification
 type TestApi =
diff --git a/src/Servant/API/Get.hs b/src/Servant/API/Get.hs
index 4114b07e..c6d375b0 100644
--- a/src/Servant/API/Get.hs
+++ b/src/Servant/API/Get.hs
@@ -46,5 +46,5 @@ instance ToSample a => HasDocs (Get a) where
     single endpoint' action'
 
     where endpoint' = endpoint & method .~ DocGET
-          action' = action & response.respBody .~ toSample p
+          action' = action & response.respBody .~ sampleByteString p
           p = Proxy :: Proxy a
diff --git a/src/Servant/API/Post.hs b/src/Servant/API/Post.hs
index d8909e5b..2a4a4feb 100644
--- a/src/Servant/API/Post.hs
+++ b/src/Servant/API/Post.hs
@@ -50,7 +50,7 @@ instance ToSample a => HasDocs (Post a) where
 
     where endpoint' = endpoint & method .~ DocPOST
 
-          action' = action & response.respBody .~ toSample p
+          action' = action & response.respBody .~ sampleByteString p
                            & response.respStatus .~ 201
 
           p = Proxy :: Proxy a
diff --git a/src/Servant/API/Put.hs b/src/Servant/API/Put.hs
index 012debe2..5c71097c 100644
--- a/src/Servant/API/Put.hs
+++ b/src/Servant/API/Put.hs
@@ -49,7 +49,7 @@ instance ToSample a => HasDocs (Put a) where
 
     where endpoint' = endpoint & method .~ DocPUT
 
-          action' = action & response.respBody .~ toSample p
+          action' = action & response.respBody .~ sampleByteString p
                            & response.respStatus .~ 200
 
           p = Proxy :: Proxy a
diff --git a/src/Servant/API/ReqBody.hs b/src/Servant/API/ReqBody.hs
index b185b675..2479844a 100644
--- a/src/Servant/API/ReqBody.hs
+++ b/src/Servant/API/ReqBody.hs
@@ -48,5 +48,5 @@ instance (ToSample a, HasDocs sublayout)
 
     where sublayoutP = Proxy :: Proxy sublayout
 
-          action' = action & rqbody .~ toSample p
+          action' = action & rqbody .~ sampleByteString p
           p = Proxy :: Proxy a
diff --git a/src/Servant/Docs.hs b/src/Servant/Docs.hs
index 5998eef4..228a599e 100644
--- a/src/Servant/Docs.hs
+++ b/src/Servant/Docs.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -------------------------------------------------------------------------------
@@ -88,7 +89,10 @@ module Servant.Docs
     HasDocs(..), docs, markdown, printMarkdown
 
   , -- * Classes you need to implement for your types
-    ToSample(..), ToParam(..), ToCapture(..)
+    ToSample(..)
+  , sampleByteString
+  , ToParam(..)
+  , ToCapture(..)
 
   , -- * ADTs to represent an 'API'
     Method(..)
@@ -320,10 +324,13 @@ class HasDocs layout where
 -- >
 -- >     where g = Greet "Hello, haskeller!"
 class ToJSON a => ToSample a where
-  toSample :: Proxy a -> Maybe ByteString
+  toSample :: Maybe a
 
 instance ToSample () where
-  toSample Proxy = Just $ encode ()
+  toSample = Just ()
+
+sampleByteString :: forall a . ToSample a => Proxy a -> Maybe ByteString
+sampleByteString Proxy = fmap encode (toSample :: Maybe a)
 
 -- | The class that helps us automatically get documentation
 --   for GET parameters.
diff --git a/test/Servant/ServerSpec.hs b/test/Servant/ServerSpec.hs
index d9f952b3..cba21e9c 100644
--- a/test/Servant/ServerSpec.hs
+++ b/test/Servant/ServerSpec.hs
@@ -44,7 +44,7 @@ data Person = Person {
 instance ToJSON Person
 instance FromJSON Person
 instance ToSample Person where
-  toSample _proxy = Just $ encode alice
+  toSample = Just alice
 
 alice :: Person
 alice = Person "Alice" 42