diff --git a/servant-docs/CHANGELOG.md b/servant-docs/CHANGELOG.md index afaa18a3..dcf0bf38 100644 --- a/servant-docs/CHANGELOG.md +++ b/servant-docs/CHANGELOG.md @@ -2,6 +2,11 @@ HEAD ---- * Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators +* Support maximum samples setting with new `DocOptions` type (used by `docsWithOptions` and `docsWith`) +* Add Generic-based default implementation for `ToSample` class +* Add more `ToSamples` instances: `Bool`, `Ordering`, tuples (up to 7), `[]`, `Maybe`, `Either`, `Const`, `ZipList` and some monoids +* Move `toSample` out of `ToSample` class +* Add a few helper functions to define `toSamples` 0.4 --- diff --git a/servant-docs/example/greet.hs b/servant-docs/example/greet.hs index 1835b290..3fd25a0f 100644 --- a/servant-docs/example/greet.hs +++ b/servant-docs/example/greet.hs @@ -53,19 +53,14 @@ instance ToParam (MatrixParam "lang" String) where "Get the greeting message selected language. Default is en." Normal -instance ToSample () () where - toSample _ = Just () - 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. @@ -117,7 +112,7 @@ extra = -- -- > docs testAPI :: API docsGreet :: API -docsGreet = docsWith [intro1, intro2] extra testApi +docsGreet = docsWith defaultDocOptions [intro1, intro2] extra testApi main :: IO () main = putStrLn $ markdown docsGreet diff --git a/servant-docs/servant-docs.cabal b/servant-docs/servant-docs.cabal index e040ab26..9a238e3f 100644 --- a/servant-docs/servant-docs.cabal +++ b/servant-docs/servant-docs.cabal @@ -42,6 +42,7 @@ library , string-conversions , text , unordered-containers + , control-monad-omega == 0.3.* hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall diff --git a/servant-docs/src/Servant/Docs.hs b/servant-docs/src/Servant/Docs.hs index e12d52f9..5fe2c1ed 100644 --- a/servant-docs/src/Servant/Docs.hs +++ b/servant-docs/src/Servant/Docs.hs @@ -144,10 +144,16 @@ module Servant.Docs ( -- * 'HasDocs' class and key functions HasDocs(..), docs, markdown -- * Generating docs with extra information - , ExtraInfo(..), docsWith, docsWithIntros, extraInfo + , docsWith, docsWithIntros, docsWithOptions + , ExtraInfo(..), extraInfo + , DocOptions(..) , defaultDocOptions, maxSamples , -- * Classes you need to implement for your types ToSample(..) + , toSample + , noSamples + , singleSample + , samples , sampleByteString , sampleByteStrings , ToParam(..) diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index e502ea61..d2ca2127 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -8,6 +9,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} @@ -19,10 +21,10 @@ #endif module Servant.Docs.Internal where -#if !MIN_VERSION_base(4,8,0) import Control.Applicative -#endif -import Control.Lens hiding (List) +import Control.Arrow (second) +import Control.Lens hiding (List, to, from) +import qualified Control.Monad.Omega as Omega import Data.ByteString.Conversion (ToByteString, toByteString) import Data.ByteString.Lazy.Char8 (ByteString) import qualified Data.CaseInsensitive as CI @@ -175,6 +177,16 @@ instance Monoid (ExtraInfo a) where ExtraInfo a `mappend` ExtraInfo b = ExtraInfo $ HM.unionWith combineAction a b +-- | Documentation options. +data DocOptions = DocOptions + { _maxSamples :: Int -- ^ Maximum samples allowed. + } deriving (Show) + +-- | Default documentation options. +defaultDocOptions :: DocOptions +defaultDocOptions = DocOptions + { _maxSamples = 5 } + -- | Type of GET parameter: -- -- - Normal corresponds to @QueryParam@, i.e your usual GET parameter @@ -279,6 +291,7 @@ single :: Endpoint -> Action -> API single e a = API mempty (HM.singleton e a) -- gimme some lenses +makeLenses ''DocOptions makeLenses ''API makeLenses ''Endpoint makeLenses ''DocCapture @@ -290,8 +303,14 @@ makeLenses ''Action -- | Generate the docs for a given API that implements 'HasDocs'. This is the -- default way to create documentation. +-- +-- prop> docs == docsWithOptions defaultDocOptions docs :: HasDocs layout => Proxy layout -> API -docs p = docsFor p (defEndpoint, defAction) +docs p = docsWithOptions p defaultDocOptions + +-- | Generate the docs for a given API that implements 'HasDocs'. +docsWithOptions :: HasDocs layout => Proxy layout -> DocOptions -> API +docsWithOptions p = docsFor p (defEndpoint, defAction) -- | Closed type family, check if endpoint is exactly within API. @@ -318,7 +337,7 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint) => Proxy endpoint -> Action -> ExtraInfo layout extraInfo p action = - let api = docsFor p (defEndpoint, defAction) + let api = docsFor p (defEndpoint, defAction) defaultDocOptions -- Assume one endpoint, HasLink constraint means that we should only ever -- point at one endpoint. in ExtraInfo $ api ^. apiEndpoints & traversed .~ action @@ -335,21 +354,22 @@ extraInfo p action = -- 'extraInfo'. -- -- If you only want to add an introduction, use 'docsWithIntros'. -docsWith :: HasDocs layout => [DocIntro] -> ExtraInfo layout -> Proxy layout -> API -docsWith intros (ExtraInfo endpoints) p = - docs p & apiIntros <>~ intros - & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints +docsWith :: HasDocs layout => DocOptions -> [DocIntro] -> ExtraInfo layout -> Proxy layout -> API +docsWith opts intros (ExtraInfo endpoints) p = + docsWithOptions p opts + & apiIntros <>~ intros + & apiEndpoints %~ HM.unionWith (flip combineAction) endpoints -- | Generate the docs for a given API that implements 'HasDocs' with with any -- number of introduction(s) docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API -docsWithIntros intros = docsWith intros mempty +docsWithIntros intros = docsWith defaultDocOptions intros mempty -- | The class that abstracts away the impact of API combinators -- on documentation generation. class HasDocs layout where - docsFor :: Proxy layout -> (Endpoint, Action) -> API + docsFor :: Proxy layout -> (Endpoint, Action) -> DocOptions -> API -- | The class that lets us display a sample input or output in the supported -- content-types when generating documentation for endpoints that either: @@ -373,7 +393,7 @@ class HasDocs layout where -- > instance ToJSON Greet -- > -- > instance ToSample Greet Greet where --- > toSample _ = Just g +-- > toSamples _ = singleSample g -- > -- > where g = Greet "Hello, haskeller!" -- @@ -382,17 +402,64 @@ 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 - {-# MINIMAL (toSample | toSamples) #-} - toSample :: Proxy a -> Maybe b - toSample _ = snd <$> listToMaybe samples - where samples = toSamples (Proxy :: Proxy a) - toSamples :: Proxy a -> [(Text, b)] - toSamples _ = maybe [] (return . ("",)) s - where s = toSample (Proxy :: Proxy a) + default toSamples :: (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)] + toSamples = defaultSamples + +-- | Sample input or output (if there is at least one). +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)] + +-- | Samples without documentation. +samples :: [a] -> [(Text, a)] +samples = map ("",) + +-- | Default sample Generic-based inputs/outputs. +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)) + +-- | @'ToSample'@ for Generics. +-- +-- The use of @'Omega'@ allows for more productive sample generation. +class GToSample t s where + gtoSamples :: proxy t -> Omega.Omega (Text, s x) + +instance GToSample U1 U1 where + gtoSamples _ = Omega.each (singleSample U1) + +instance GToSample V1 V1 where + gtoSamples _ = empty + +instance (GToSample p p', GToSample q q') => GToSample (p :*: q) (p' :*: q') where + gtoSamples _ = render <$> ps <*> qs + where + ps = gtoSamples (Proxy :: Proxy p) + qs = gtoSamples (Proxy :: Proxy q) + render (ta, a) (tb, b) + | T.null ta || T.null tb = (ta <> tb, a :*: b) + | otherwise = (ta <> ", " <> tb, a :*: b) + +instance (GToSample p p', GToSample q q') => GToSample (p :+: q) (p' :+: q') where + gtoSamples _ = lefts <|> rights + where + lefts = second L1 <$> gtoSamples (Proxy :: Proxy p) + rights = second R1 <$> gtoSamples (Proxy :: Proxy q) + +instance ToSample a b => GToSample (K1 i a) (K1 i b) where + gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a)) + +instance (GToSample f g) => GToSample (M1 i a f) (M1 i a g) where + 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) @@ -661,11 +728,11 @@ instance #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) => HasDocs (Delete cts a) where - docsFor Proxy (endpoint, action) = + docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' where endpoint' = endpoint & method .~ DocDELETE - action' = action & response.respBody .~ sampleByteStrings t p + action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ supportedTypes t t = Proxy :: Proxy cts p = Proxy :: Proxy a @@ -677,12 +744,12 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Delete cts (Headers ls a)) where - docsFor Proxy (endpoint, action) = + docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' where hdrs = allHeaderToSample (Proxy :: Proxy ls) endpoint' = endpoint & method .~ DocDELETE - action' = action & response.respBody .~ sampleByteStrings t p + action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ supportedTypes t & response.respHeaders .~ hdrs t = Proxy :: Proxy cts @@ -694,11 +761,11 @@ instance #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) => HasDocs (Get cts a) where - docsFor Proxy (endpoint, action) = + docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' where endpoint' = endpoint & method .~ DocGET - action' = action & response.respBody .~ sampleByteStrings t p + action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ supportedTypes t t = Proxy :: Proxy cts p = Proxy :: Proxy a @@ -710,12 +777,12 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Get cts (Headers ls a)) where - docsFor Proxy (endpoint, action) = + docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' where hdrs = allHeaderToSample (Proxy :: Proxy ls) endpoint' = endpoint & method .~ DocGET - action' = action & response.respBody .~ sampleByteStrings t p + action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ supportedTypes t & response.respHeaders .~ hdrs t = Proxy :: Proxy cts @@ -736,11 +803,11 @@ instance #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) => HasDocs (Post cts a) where - docsFor Proxy (endpoint, action) = + docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' where endpoint' = endpoint & method .~ DocPOST - action' = action & response.respBody .~ sampleByteStrings t p + action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ supportedTypes t & response.respStatus .~ 201 t = Proxy :: Proxy cts @@ -753,12 +820,12 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Post cts (Headers ls a)) where - docsFor Proxy (endpoint, action) = + docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' where hdrs = allHeaderToSample (Proxy :: Proxy ls) endpoint' = endpoint & method .~ DocPOST - action' = action & response.respBody .~ sampleByteStrings t p + action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ supportedTypes t & response.respStatus .~ 201 & response.respHeaders .~ hdrs @@ -771,11 +838,11 @@ instance #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) => HasDocs (Put cts a) where - docsFor Proxy (endpoint, action) = + docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' where endpoint' = endpoint & method .~ DocPUT - action' = action & response.respBody .~ sampleByteStrings t p + action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ supportedTypes t & response.respStatus .~ 200 t = Proxy :: Proxy cts @@ -788,12 +855,12 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Put cts (Headers ls a)) where - docsFor Proxy (endpoint, action) = + docsFor Proxy (endpoint, action) DocOptions{..} = single endpoint' action' where hdrs = allHeaderToSample (Proxy :: Proxy ls) endpoint' = endpoint & method .~ DocPUT - action' = action & response.respBody .~ sampleByteStrings t p + action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p) & response.respTypes .~ supportedTypes t & response.respStatus .~ 200 & response.respHeaders .~ hdrs @@ -875,7 +942,7 @@ instance (KnownSymbol sym, {- ToParam (MatrixFlag sym), -} HasDocs sublayout) symP = Proxy :: Proxy sym instance HasDocs Raw where - docsFor _proxy (endpoint, action) = + docsFor _proxy (endpoint, action) _ = single endpoint action -- TODO: We use 'AllMimeRender' here because we need to be able to show the @@ -920,155 +987,33 @@ instance HasDocs sublayout => HasDocs (Vault :> sublayout) where docsFor Proxy ep = docsFor (Proxy :: Proxy sublayout) ep +-- ToSample instances for simple types +instance ToSample () () +instance ToSample Bool Bool +instance ToSample Ordering Ordering --- polymorphic 'ToSample' instances +-- polymorphic ToSample instances +instance (ToSample a a, ToSample b b) => ToSample (a, b) (a, b) +instance (ToSample a a, ToSample b b, ToSample c c) => ToSample (a, b, c) (a, b, c) +instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d) => ToSample (a, b, c, d) (a, b, c, d) +instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d, ToSample e e) => ToSample (a, b, c, d, e) (a, b, c, d, e) +instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d, ToSample e e, ToSample f f) => ToSample (a, b, c, d, e, f) (a, b, c, d, e, f) +instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d, ToSample e e, ToSample f f, ToSample g g) => ToSample (a, b, c, d, e, f, g) (a, b, c, d, e, f, g) -instance ( ToSample a a - , ToSample b b - ) => ToSample (a, b) (a, b) where - toSample _ = (,) - <$> toSample (Proxy :: Proxy a) - <*> toSample (Proxy :: Proxy b) - toSamples _ = render - <$> toSamples (Proxy :: Proxy a) - <*> toSamples (Proxy :: Proxy b) - where render (ta, va) (tb, vb) - = ("(" <> ta <> - ", " <> tb <> - ")" - , (va, vb)) +instance ToSample a a => ToSample (Maybe a) (Maybe a) +instance (ToSample a a, ToSample b b) => ToSample (Either a b) (Either a b) +instance ToSample a a => ToSample [a] [a] -instance ( ToSample a a - , ToSample b b - , ToSample c c - ) => ToSample (a, b, c) (a, b, c) where - toSample _ = (,,) - <$> toSample (Proxy :: Proxy a) - <*> toSample (Proxy :: Proxy b) - <*> toSample (Proxy :: Proxy c) - toSamples _ = render - <$> toSamples (Proxy :: Proxy a) - <*> toSamples (Proxy :: Proxy b) - <*> toSamples (Proxy :: Proxy c) - where render (ta, va) (tb, vb) (tc, vc) - = ("(" <> ta <> - ", " <> tb <> - ", " <> tc <> - ")" - , (va, vb, vc)) +-- ToSample instances for Control.Applicative types +instance ToSample a a => ToSample (Const a b) (Const a b) +instance ToSample a a => ToSample (ZipList a) (ZipList a) -instance ( ToSample a a - , ToSample b b - , ToSample c c - , ToSample d d - ) => ToSample (a, b, c, d) (a, b, c, d) where - toSample _ = (,,,) - <$> toSample (Proxy :: Proxy a) - <*> toSample (Proxy :: Proxy b) - <*> toSample (Proxy :: Proxy c) - <*> toSample (Proxy :: Proxy d) - toSamples _ = render - <$> toSamples (Proxy :: Proxy a) - <*> toSamples (Proxy :: Proxy b) - <*> toSamples (Proxy :: Proxy c) - <*> toSamples (Proxy :: Proxy d) - where render (ta, va) (tb, vb) (tc, vc) (td, vd) - = ("(" <> ta <> - ", " <> tb <> - ", " <> tc <> - ", " <> td <> - ")" - , (va, vb, vc, vd)) +-- ToSample instances for Data.Monoid newtypes +instance ToSample All All +instance ToSample Any Any +instance ToSample a a => ToSample (Sum a) (Sum a) +instance ToSample a a => ToSample (Product a) (Product a) +instance ToSample a a => ToSample (First a) (First a) +instance ToSample a a => ToSample (Last a) (Last a) +instance ToSample a a => ToSample (Dual a) (Dual a) -instance ( ToSample a a - , ToSample b b - , ToSample c c - , ToSample d d - , ToSample e e - ) => ToSample (a, b, c, d, e) (a, b, c, d, e) where - toSample _ = (,,,,) - <$> toSample (Proxy :: Proxy a) - <*> toSample (Proxy :: Proxy b) - <*> toSample (Proxy :: Proxy c) - <*> toSample (Proxy :: Proxy d) - <*> toSample (Proxy :: Proxy e) - toSamples _ = render - <$> toSamples (Proxy :: Proxy a) - <*> toSamples (Proxy :: Proxy b) - <*> toSamples (Proxy :: Proxy c) - <*> toSamples (Proxy :: Proxy d) - <*> toSamples (Proxy :: Proxy e) - where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) - = ("(" <> ta <> - ", " <> tb <> - ", " <> tc <> - ", " <> td <> - ", " <> te <> - ")" - , (va, vb, vc, vd, ve)) - -instance ( ToSample a a - , ToSample b b - , ToSample c c - , ToSample d d - , ToSample e e - , ToSample f f - ) => ToSample (a, b, c, d, e, f) (a, b, c, d, e, f) where - toSample _ = (,,,,,) - <$> toSample (Proxy :: Proxy a) - <*> toSample (Proxy :: Proxy b) - <*> toSample (Proxy :: Proxy c) - <*> toSample (Proxy :: Proxy d) - <*> toSample (Proxy :: Proxy e) - <*> toSample (Proxy :: Proxy f) - toSamples _ = render - <$> toSamples (Proxy :: Proxy a) - <*> toSamples (Proxy :: Proxy b) - <*> toSamples (Proxy :: Proxy c) - <*> toSamples (Proxy :: Proxy d) - <*> toSamples (Proxy :: Proxy e) - <*> toSamples (Proxy :: Proxy f) - where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) (tf, vf) - = ("(" <> ta <> - ", " <> tb <> - ", " <> tc <> - ", " <> td <> - ", " <> te <> - ", " <> tf <> - ")" - , (va, vb, vc, vd, ve, vf)) - -instance ( ToSample a a - , ToSample b b - , ToSample c c - , ToSample d d - , ToSample e e - , ToSample f f - , ToSample g g - ) => ToSample (a, b, c, d, e, f, g) (a, b, c, d, e, f, g) where - toSample _ = (,,,,,,) - <$> toSample (Proxy :: Proxy a) - <*> toSample (Proxy :: Proxy b) - <*> toSample (Proxy :: Proxy c) - <*> toSample (Proxy :: Proxy d) - <*> toSample (Proxy :: Proxy e) - <*> toSample (Proxy :: Proxy f) - <*> toSample (Proxy :: Proxy g) - toSamples _ = render - <$> toSamples (Proxy :: Proxy a) - <*> toSamples (Proxy :: Proxy b) - <*> toSamples (Proxy :: Proxy c) - <*> toSamples (Proxy :: Proxy d) - <*> toSamples (Proxy :: Proxy e) - <*> toSamples (Proxy :: Proxy f) - <*> toSamples (Proxy :: Proxy g) - where render (ta, va) (tb, vb) (tc, vc) (td, vd) (te, ve) (tf, vf) (tg, vg) - = ("(" <> ta <> - ", " <> tb <> - ", " <> tc <> - ", " <> td <> - ", " <> te <> - ", " <> tf <> - ", " <> tg <> - ")" - , (va, vb, vc, vd, ve, vf, vg)) diff --git a/servant-docs/test/Servant/DocsSpec.hs b/servant-docs/test/Servant/DocsSpec.hs index b67d079f..a294c3b1 100644 --- a/servant-docs/test/Servant/DocsSpec.hs +++ b/servant-docs/test/Servant/DocsSpec.hs @@ -36,7 +36,7 @@ spec = describe "Servant.Docs" $ do extraInfo (Proxy :: Proxy (ReqBody '[JSON] String :> Post '[JSON] Datatype1)) (defAction & notes <>~ [DocNote "Post data" ["Posts some Json data"]]) - md = markdown (docsWith [] extra (Proxy :: Proxy TestApi1)) + md = markdown (docsWith defaultDocOptions [] extra (Proxy :: Proxy TestApi1)) tests md it "contains the extra info provided" $ do md `shouldContain` "Get an Integer" @@ -49,14 +49,18 @@ spec = describe "Servant.Docs" $ do (toSample (Proxy :: Proxy (TT, UT))) `shouldBe` Just (TT1,UT1) (toSample (Proxy :: Proxy (TT, UT, UT))) `shouldBe` Just (TT1,UT1,UT1) (toSamples (Proxy :: Proxy (TT, UT))) `shouldBe` - [ ("(eins, yks)",(TT1,UT1)), ("(eins, kaks)",(TT1,UT2)) - , ("(zwei, yks)",(TT2,UT1)), ("(zwei, kaks)",(TT2,UT2)) + [ ("eins, yks",(TT1,UT1)), ("eins, kaks",(TT1,UT2)) + , ("zwei, yks",(TT2,UT1)), ("zwei, kaks",(TT2,UT2)) ] (toSamples (Proxy :: Proxy (TT, UT, UT))) `shouldBe` - [ ("(eins, yks, yks)",(TT1,UT1,UT1)), ("(eins, yks, kaks)",(TT1,UT1,UT2)) - , ("(eins, kaks, yks)",(TT1,UT2,UT1)), ("(eins, kaks, kaks)",(TT1,UT2,UT2)) - , ("(zwei, yks, yks)",(TT2,UT1,UT1)), ("(zwei, yks, kaks)",(TT2,UT1,UT2)) - , ("(zwei, kaks, yks)",(TT2,UT2,UT1)), ("(zwei, kaks, kaks)",(TT2,UT2,UT2)) + [ ("eins, yks, yks",(TT1,UT1,UT1)) + , ("eins, yks, kaks",(TT1,UT1,UT2)) + , ("zwei, yks, yks",(TT2,UT1,UT1)) + , ("eins, kaks, yks",(TT1,UT2,UT1)) + , ("zwei, yks, kaks",(TT2,UT1,UT2)) + , ("eins, kaks, kaks",(TT1,UT2,UT2)) + , ("zwei, kaks, yks",(TT2,UT2,UT1)) + , ("zwei, kaks, kaks",(TT2,UT2,UT2)) ] where @@ -87,13 +91,13 @@ data Datatype1 = Datatype1 { dt1field1 :: String instance ToJSON Datatype1 instance ToSample Datatype1 Datatype1 where - toSample _ = Just $ Datatype1 "field 1" 13 + toSamples _ = singleSample $ Datatype1 "field 1" 13 -instance ToSample String String where - toSample _ = Just "a string" +instance ToSample Char Char where + toSamples _ = samples ['a'..'z'] instance ToSample Int Int where - toSample _ = Just 17 + toSamples _ = singleSample 17 instance MimeRender PlainText Int where mimeRender _ = cs . show @@ -105,9 +109,7 @@ data TT = TT1 | TT2 deriving (Show, Eq) data UT = UT1 | UT2 deriving (Show, Eq) instance ToSample TT TT where - toSample _ = Just TT1 toSamples _ = [("eins", TT1), ("zwei", TT2)] instance ToSample UT UT where - toSample _ = Just UT1 toSamples _ = [("yks", UT1), ("kaks", UT2)] 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 diff --git a/stack-ghc-7.8.4.yaml b/stack-ghc-7.8.4.yaml index 3581c6a9..ce2d7269 100644 --- a/stack-ghc-7.8.4.yaml +++ b/stack-ghc-7.8.4.yaml @@ -19,4 +19,5 @@ extra-deps: - engine-io-wai-1.0.3 - socket-io-1.3.3 - stm-delay-0.1.1.1 +- control-monad-omega-0.3.1 resolver: lts-2.22 diff --git a/stack.yaml b/stack.yaml index 8e1a6e18..397ac7bc 100644 --- a/stack.yaml +++ b/stack.yaml @@ -14,4 +14,5 @@ packages: - servant-server/ extra-deps: - engine-io-wai-1.0.2 +- control-monad-omega-0.3.1 resolver: nightly-2015-09-10