208bcf5 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Use Verb for servant-docs

208bcf5Julian K. Arni11 years ago

servant-docs/src/Servant/Docs.hs+1−2

compare with master

unifiedsplit

@@ -41,8 +41,7 @@ module Servant.Docs

41 , ToCapture(..)

43 , -- * ADTs to represent an 'API'

44− Method(..)

45− , Endpoint, path, method, defEndpoint

44+ Endpoint, path, method, defEndpoint

46 , API, apiIntros, apiEndpoints, emptyAPI

45 , API, apiIntros, apiEndpoints, emptyAPI

47 , DocCapture(..), capSymbol, capDesc

46 , DocCapture(..), capSymbol, capDesc

48 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind

47 , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind

servant-docs/src/Servant/Docs/Internal.hs+22−124

@@ -36,7 +36,7 @@ import Data.Monoid

36import Data.Ord (comparing)

37import Data.Proxy (Proxy(Proxy))

38import Data.String.Conversions (cs)

39−import Data.Text (Text, pack, unpack)

39+import Data.Text (Text, unpack)

40import GHC.Exts (Constraint)

41import GHC.Generics

42import GHC.TypeLits

@@ -49,21 +49,6 @@ import qualified Data.Text as T

49import qualified Network.HTTP.Media as M

50import qualified Network.HTTP.Types as HTTP

52−-- | Supported HTTP request methods

53−data Method = DocDELETE -- ^ the DELETE method

54− | DocGET -- ^ the GET method

55− | DocPOST -- ^ the POST method

56− | DocPUT -- ^ the PUT method

57− deriving (Eq, Ord, Generic)

58−

59−instance Show Method where

60− show DocGET = "GET"

61− show DocPOST = "POST"

62− show DocDELETE = "DELETE"

63− show DocPUT = "PUT"

64−

65−instance Hashable Method

66−

67-- | An 'Endpoint' type that holds the 'path' and the 'method'.

52-- | An 'Endpoint' type that holds the 'path' and the 'method'.

68--

53--

69-- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'

54-- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'

@@ -75,12 +60,12 @@ instance Hashable Method

75-- GET /

60-- GET /

76-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]

61-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]

77-- GET /foo

62-- GET /foo

78−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'

63+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'

79-- POST /foo

64-- POST /foo

80-- @

65-- @

81data Endpoint = Endpoint

66data Endpoint = Endpoint

82− { _path :: [String] -- type collected

67+ { _path :: [String] -- type collected

83− , _method :: Method -- type collected

68+ , _method :: HTTP.Method -- type collected

84 } deriving (Eq, Ord, Generic)

69 } deriving (Eq, Ord, Generic)

86instance Show Endpoint where

71instance Show Endpoint where

@@ -94,7 +79,7 @@ showPath :: [String] -> String

94showPath [] = "/"

79showPath [] = "/"

95showPath ps = concatMap ('/' :) ps

80showPath ps = concatMap ('/' :) ps

97−-- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'

82+-- | An 'Endpoint' whose path is `"/"` and whose method is @GET@

98--

83--

99-- Here's how you can modify it:

84-- Here's how you can modify it:

100--

85--

@@ -103,11 +88,11 @@ showPath ps = concatMap ('/' :) ps

103-- GET /

88-- GET /

104-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]

89-- λ> 'defEndpoint' & 'path' '<>~' ["foo"]

105-- GET /foo

90-- GET /foo

106−-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'

91+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'

107-- POST /foo

92-- POST /foo

108-- @

93-- @

109defEndpoint :: Endpoint

94defEndpoint :: Endpoint

110−defEndpoint = Endpoint [] DocGET

95+defEndpoint = Endpoint [] HTTP.methodGet

111

112instance Hashable Endpoint

97instance Hashable Endpoint

113

@@ -689,124 +674,37 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)

689

674

690

675

691instance OVERLAPPABLE_

676instance OVERLAPPABLE_

692− (ToSample a, AllMimeRender (ct ': cts) a)

677+ (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status

693− => HasDocs (Delete (ct ': cts) a) where

678+ , ReflectMethod method)

694− docsFor Proxy (endpoint, action) DocOptions{..} =

695− single endpoint' action'

696−

697− where endpoint' = endpoint & method .~ DocDELETE

698− action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

699− & response.respTypes .~ allMime t

700− t = Proxy :: Proxy (ct ': cts)

701− p = Proxy :: Proxy a

702−

703−instance OVERLAPPING_

704− (ToSample a, AllMimeRender (ct ': cts) a

705− , AllHeaderSamples ls , GetHeaders (HList ls) )

706− => HasDocs (Delete (ct ': cts) (Headers ls a)) where

707− docsFor Proxy (endpoint, action) DocOptions{..} =

708− single endpoint' action'

709−

710− where hdrs = allHeaderToSample (Proxy :: Proxy ls)

711− endpoint' = endpoint & method .~ DocDELETE

712− action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

713− & response.respTypes .~ allMime t

714− & response.respHeaders .~ hdrs

715− t = Proxy :: Proxy (ct ': cts)

716− p = Proxy :: Proxy a

717−

718−instance OVERLAPPABLE_

719− (ToSample a, AllMimeRender (ct ': cts) a)

720− => HasDocs (Get (ct ': cts) a) where

721− docsFor Proxy (endpoint, action) DocOptions{..} =

722− single endpoint' action'

723−

724− where endpoint' = endpoint & method .~ DocGET

725− action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

726− & response.respTypes .~ allMime t

727− t = Proxy :: Proxy (ct ': cts)

728− p = Proxy :: Proxy a

729−

730−instance OVERLAPPING_

731− (ToSample a, AllMimeRender (ct ': cts) a

732− , AllHeaderSamples ls , GetHeaders (HList ls) )

733− => HasDocs (Get (ct ': cts) (Headers ls a)) where

734− docsFor Proxy (endpoint, action) DocOptions{..} =

735− single endpoint' action'

736−

737− where hdrs = allHeaderToSample (Proxy :: Proxy ls)

738− endpoint' = endpoint & method .~ DocGET

739− action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

740− & response.respTypes .~ allMime t

741− & response.respHeaders .~ hdrs

742− t = Proxy :: Proxy (ct ': cts)

743− p = Proxy :: Proxy a

744−

745−instance (KnownSymbol sym, HasDocs sublayout)

746− => HasDocs (Header sym a :> sublayout) where

747− docsFor Proxy (endpoint, action) =

748− docsFor sublayoutP (endpoint, action')

749−

750− where sublayoutP = Proxy :: Proxy sublayout

751− action' = over headers (|> headername) action

752− headername = pack $ symbolVal (Proxy :: Proxy sym)

753−

754−instance OVERLAPPABLE_

755− (ToSample a, AllMimeRender (ct ': cts) a)

756− => HasDocs (Post (ct ': cts) a) where

757− docsFor Proxy (endpoint, action) DocOptions{..} =

758− single endpoint' action'

759−

760− where endpoint' = endpoint & method .~ DocPOST

761− action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

762− & response.respTypes .~ allMime t

763− & response.respStatus .~ 201

764− t = Proxy :: Proxy (ct ': cts)

765− p = Proxy :: Proxy a

766−

767−instance OVERLAPPING_

768− (ToSample a, AllMimeRender (ct ': cts) a

769− , AllHeaderSamples ls , GetHeaders (HList ls) )

770− => HasDocs (Post (ct ': cts) (Headers ls a)) where

771− docsFor Proxy (endpoint, action) DocOptions{..} =

772− single endpoint' action'

773−

774− where hdrs = allHeaderToSample (Proxy :: Proxy ls)

775− endpoint' = endpoint & method .~ DocPOST

776− action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

777− & response.respTypes .~ allMime t

778− & response.respStatus .~ 201

779− & response.respHeaders .~ hdrs

780− t = Proxy :: Proxy (ct ': cts)

781− p = Proxy :: Proxy a

782−

783−instance OVERLAPPABLE_

784− (ToSample a, AllMimeRender (ct ': cts) a)

785− => HasDocs (Put (ct ': cts) a) where

679+ => HasDocs (Verb method status (ct ': cts) a) where

786 docsFor Proxy (endpoint, action) DocOptions{..} =

680 docsFor Proxy (endpoint, action) DocOptions{..} =

787 single endpoint' action'

681 single endpoint' action'

788

682

789− where endpoint' = endpoint & method .~ DocPUT

683+ where endpoint' = endpoint & method .~ method'

790 action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

684 action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

791 & response.respTypes .~ allMime t

685 & response.respTypes .~ allMime t

792− & response.respStatus .~ 200

686+ & response.respStatus .~ status

793 t = Proxy :: Proxy (ct ': cts)

687 t = Proxy :: Proxy (ct ': cts)

688+ method' = reflectMethod (Proxy :: Proxy method)

689+ status = fromInteger $ natVal (Proxy :: Proxy status)

794 p = Proxy :: Proxy a

690 p = Proxy :: Proxy a

795

691

796instance OVERLAPPING_

692instance OVERLAPPING_

797− ( ToSample a, AllMimeRender (ct ': cts) a,

693+ (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status

798− AllHeaderSamples ls , GetHeaders (HList ls) )

694+ , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))

799− => HasDocs (Put (ct ': cts) (Headers ls a)) where

695+ => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where

800 docsFor Proxy (endpoint, action) DocOptions{..} =

696 docsFor Proxy (endpoint, action) DocOptions{..} =

801 single endpoint' action'

697 single endpoint' action'

802

698

803− where hdrs = allHeaderToSample (Proxy :: Proxy ls)

804− endpoint' = endpoint & method .~ DocPUT

699+ where endpoint' = endpoint & method .~ method'

805 action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

700 action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)

806 & response.respTypes .~ allMime t

701 & response.respTypes .~ allMime t

807− & response.respStatus .~ 200

702+ & response.respStatus .~ status

808 & response.respHeaders .~ hdrs

703 & response.respHeaders .~ hdrs

809 t = Proxy :: Proxy (ct ': cts)

704 t = Proxy :: Proxy (ct ': cts)

705+ hdrs = allHeaderToSample (Proxy :: Proxy ls)

706+ method' = reflectMethod (Proxy :: Proxy method)

707+ status = fromInteger $ natVal (Proxy :: Proxy status)

810 p = Proxy :: Proxy a

708 p = Proxy :: Proxy a

811

709

812instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)

710instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)

servant-docs/test/Servant/DocsSpec.hs−1

@@ -71,7 +71,6 @@ spec = describe "Servant.Docs" $ do

72 it "mentions status codes" $ do

73 md `shouldContain` "Status code 200"

74− md `shouldContain` "Status code 201"

76 it "mentions methods" $ do

75 it "mentions methods" $ do

77 md `shouldContain` "POST"

76 md `shouldContain` "POST"