refactored Servant.Docs.ToSample

example/greet.hs

@@ -46,9 +46,7 @@ instance ToParam (QueryParam "capital" Bool) where
                   Normal
 
 instance ToSample Greet where
-  toSample Proxy = Just (encode g)
+  toSample = Just $ Greet "Hello, haskeller!"
-
-    where g = Greet "Hello, haskeller!"
 
 -- API specification
 type TestApi =

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

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

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

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

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.

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