diff --git a/.travis.yml b/.travis.yml index dfcfca37..b3b77290 100644 --- a/.travis.yml +++ b/.travis.yml @@ -7,14 +7,12 @@ script: - cabal configure --enable-tests --enable-library-coverage && cabal build && cabal test - cabal check - cabal sdist - - cabal install doctest - - ./test-docs.sh after_script: - | if [ "$TRAVIS_PULL_REQUEST" -eq "$TRAVIS_PULL_REQUEST" ] 2>/dev/null || [ "$TRAVIS_BRANCH" == "master" ] ; then cabal install hpc-coveralls - hpc-coveralls --exclude-dir=test spec + hpc-coveralls --exclude-dir=test spec doctests fi diff --git a/TODO.md b/TODO.md deleted file mode 100644 index 17d50623..00000000 --- a/TODO.md +++ /dev/null @@ -1 +0,0 @@ -- Try to find a way to abstract over the format(s) instead of the current focus on JSON, maybe diff --git a/servant.cabal b/servant.cabal index b8af4b65..7b144eff 100644 --- a/servant.cabal +++ b/servant.cabal @@ -97,3 +97,14 @@ test-suite spec , string-conversions , text , url + +test-suite doctests + build-depends: base + , servant + , doctest + , filemanip + type: exitcode-stdio-1.0 + main-is: test/Doctests.hs + buildable: True + default-language: Haskell2010 + ghc-options: -threaded diff --git a/src/Servant/API.hs b/src/Servant/API.hs index f5969df3..b9fc7db7 100644 --- a/src/Servant/API.hs +++ b/src/Servant/API.hs @@ -1,60 +1,70 @@ module Servant.API ( -- * Combinators - -- | Type-level combinator for expressing subrouting: @':>'@ module Servant.API.Sub, - -- | Type-level combinator for alternative endpoints: @':<|>'@ + -- | Type-level combinator for expressing subrouting: @':>'@ module Servant.API.Alternative, + -- | Type-level combinator for alternative endpoints: @':<|>'@ -- * Accessing information from the request - -- | Capturing parts of the url path as parsed values: @'Capture'@ module Servant.API.Capture, - -- | Retrieving specific headers from the request + -- | Capturing parts of the url path as parsed values: @'Capture'@ module Servant.API.Header, - -- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@ + -- | Retrieving specific headers from the request module Servant.API.QueryParam, - -- | Accessing the request body as a JSON-encoded type: @'ReqBody'@ + -- | Retrieving parameters from the query string of the 'URI': @'QueryParam'@ module Servant.API.ReqBody, - -- | Retrieving matrix parameters from the 'URI' segment: @'MatrixParam'@ + -- | Accessing the request body as a JSON-encoded type: @'ReqBody'@ module Servant.API.MatrixParam, + -- | Retrieving matrix parameters from the 'URI' segment: @'MatrixParam'@ -- * Actual endpoints, distinguished by HTTP method - -- | GET requests module Servant.API.Get, - -- | POST requests + -- | @GET@ requests module Servant.API.Post, - -- | DELETE requests + -- | @POST@ requests module Servant.API.Delete, - -- | PUT requests + -- | @DELETE@ requests module Servant.API.Put, - -- | PATCH requests + -- | @PUT@ requests module Servant.API.Patch, + -- | @PATCH@ requests -- * Content Types module Servant.API.ContentTypes, + -- | Serializing and deserializing types based on @Accept@ and + -- @Content-Type@ headers. -- * Untyped endpoints - -- | Plugging in a wai 'Network.Wai.Application', serving directories module Servant.API.Raw, + -- | Plugging in a wai 'Network.Wai.Application', serving directories + + -- * FromText and ToText + module Servant.Common.Text, + -- | Classes and instances for types that can be converted to and from @Text@ -- * Utilities - -- | Type-safe internal URIs module Servant.Utils.Links, + -- | Type-safe internal URIs ) where -import Servant.API.Alternative ( (:<|>)(..) ) -import Servant.API.Capture ( Capture ) -import Servant.API.ContentTypes ( JSON , PlainText, OctetStream - , MimeRender(..) , MimeUnrender(..)) -import Servant.API.Delete ( Delete ) -import Servant.API.Get ( Get ) -import Servant.API.Header ( Header ) -import Servant.API.Post ( Post ) -import Servant.API.Put ( Put ) -import Servant.API.Patch ( Patch ) -import Servant.API.QueryParam ( QueryFlag, QueryParams, QueryParam ) -import Servant.API.MatrixParam ( MatrixFlag, MatrixParams, MatrixParam ) -import Servant.API.Raw ( Raw ) -import Servant.API.ReqBody ( ReqBody ) -import Servant.API.Sub ( (:>)(..) ) -import Servant.Utils.Links ( safeLink, URI(..), IsElem, IsElem', HasLink(..) ) +import Servant.Common.Text (FromText(..), ToText(..)) +import Servant.API.Alternative ((:<|>) (..)) +import Servant.API.Capture (Capture) +import Servant.API.ContentTypes (JSON, MimeRender (..), + MimeUnrender (..), OctetStream, + PlainText) +import Servant.API.Delete (Delete) +import Servant.API.Get (Get) +import Servant.API.Header (Header) +import Servant.API.MatrixParam (MatrixFlag, MatrixParam, + MatrixParams) +import Servant.API.Patch (Patch) +import Servant.API.Post (Post) +import Servant.API.Put (Put) +import Servant.API.QueryParam (QueryFlag, QueryParam, QueryParams) +import Servant.API.Raw (Raw) +import Servant.API.ReqBody (ReqBody) +import Servant.API.Sub ((:>)) +import Servant.Utils.Links (HasLink (..), IsElem, IsElem', + URI (..), safeLink) diff --git a/src/Servant/API/Alternative.hs b/src/Servant/API/Alternative.hs index 708aeee0..9483f174 100644 --- a/src/Servant/API/Alternative.hs +++ b/src/Servant/API/Alternative.hs @@ -1,11 +1,28 @@ -{-# LANGUAGE TypeOperators #-} -module Servant.API.Alternative where +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeOperators #-} +module Servant.API.Alternative ((:<|>)(..)) where +import Data.Monoid (Monoid (..)) +import Data.Typeable (Typeable) -- | Union of two APIs, first takes precedence in case of overlap. -- -- Example: -- --- > type MyApi = "books" :> Get [Book] -- GET /books --- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books +-- >>> :{ +--type MyApi = "books" :> Get '[JSON] [Book] -- GET /books +-- :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] () -- POST /books +-- :} data a :<|> b = a :<|> b + deriving (Typeable, Eq, Show) infixr 8 :<|> + +instance (Monoid a, Monoid b) => Monoid (a :<|> b) where + mempty = mempty :<|> mempty + (a :<|> b) `mappend` (a' :<|> b') = (a `mappend` a') :<|> (b `mappend` b') + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/Capture.hs b/src/Servant/API/Capture.hs index 54b71f5b..26e56048 100644 --- a/src/Servant/API/Capture.hs +++ b/src/Servant/API/Capture.hs @@ -1,10 +1,21 @@ -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE PolyKinds #-} module Servant.API.Capture (Capture) where +import Data.Typeable (Typeable) +import GHC.TypeLits (Symbol) -- | Capture a value from the request path under a certain type @a@. -- -- Example: --- --- > -- GET /books/:isbn --- > type MyApi = "books" :> Capture "isbn" Text :> Get Book -data Capture sym a +-- >>> -- GET /books/:isbn +-- >>> type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book +data Capture (sym :: Symbol) a + deriving (Typeable) + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/ContentTypes.hs b/src/Servant/API/ContentTypes.hs index 2036a32a..d8e075af 100644 --- a/src/Servant/API/ContentTypes.hs +++ b/src/Servant/API/ContentTypes.hs @@ -9,7 +9,57 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -module Servant.API.ContentTypes where + +-- | A collection of basic Content-Types (also known as Internet Media +-- Types, or MIME types). Additionally, this module provides classes that +-- encapsulate how to serialize or deserialize values to or from +-- a particular Content-Type. +-- +-- Content-Types are used in `ReqBody` and the method combinators: +-- +-- >>> type MyEndpoint = ReqBody '[JSON, PlainText] Book :> Get '[JSON, PlainText] :> Book +-- +-- Meaning the endpoint accepts requests of Content-Type @application/json@ +-- or @text/plain;charset-utf8@, and returns data in either one of those +-- formats (depending on the @Accept@ header). +-- +-- If you would like to support Content-Types beyond those provided here, +-- then: +-- +-- (1) Declare a new data type with no constructors (e.g. @data HTML@). +-- (2) Make an instance of it for `Accept`. +-- (3) If you want to be able to serialize data *into* that +-- Content-Type, make an instance of it for `MimeRender`. +-- (4) If you want to be able to deserialize data *from* that +-- Content-Type, make an instance of it for `MimeUnrender`. +-- +-- Note that roles are reversed in @servant-server@ and @servant-client@: +-- to be able to serve (or even typecheck) a @Get '[JSON, XML] MyData@, +-- you'll need to have the appropriate `MimeRender` instances in scope, +-- whereas to query that endpoint with @servant-client@, you'll need +-- a `MimeUnrender` instance in scope. +module Servant.API.ContentTypes + ( + -- * Provided Content-Types + JSON + , PlainText + , FormUrlEncoded + , OctetStream + + -- * Building your own Content-Type + , Accept(..) + , MimeRender(..) + , MimeUnrender(..) + + -- * Internal + , AcceptHeader(..) + , AllCTRender(..) + , AllCTUnrender(..) + , FromFormUrlEncoded(..) + , ToFormUrlEncoded(..) + , IsNonEmpty + , eitherDecodeLenient + ) where import Control.Applicative ((<*)) import Control.Arrow (left) @@ -48,8 +98,12 @@ data OctetStream deriving Typeable -- -- Example: -- --- > instance Accept HTML where --- > contentType _ = "text" // "html" +-- >>> import Network.HTTP.Media ((//), (/:)) +-- >>> data HTML +-- >>> :{ +--instance Accept HTML where +-- contentType _ = "text" // "html" /: ("charset", "utf-8") +-- :} -- class Accept ctype where contentType :: Proxy ctype -> M.MediaType @@ -93,7 +147,7 @@ newtype AcceptHeader = AcceptHeader BS.ByteString class Accept ctype => MimeRender ctype a where toByteString :: Proxy ctype -> a -> ByteString -class AllCTRender list a where +class AllCTRender (list :: [*]) a where -- If the Accept header can be matched, returns (Just) a tuple of the -- Content-Type and response (serialization of @a@ into the appropriate -- mimetype). @@ -113,20 +167,28 @@ instance ( AllMimeRender ctyps a, IsNonEmpty ctyps -- | Instantiate this class to register a way of deserializing a type based -- on the request's @Content-Type@ header. -- --- > data MyContentType = MyContentType String --- > --- > instance Accept MyContentType where --- > contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8") --- > --- > instance Show a => MimeUnrender MyContentType where --- > fromByteString _ bs = MyContentType $ unpack bs --- > --- > type MyAPI = "path" :> ReqBody '[MyContentType] :> Get '[JSON] Int +-- >>> import Network.HTTP.Media hiding (Accept) +-- >>> import qualified Data.ByteString.Lazy.Char8 as BSC +-- >>> data MyContentType = MyContentType String +-- +-- >>> :{ +--instance Accept MyContentType where +-- contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8") +-- :} +-- +-- >>> :{ +--instance Read a => MimeUnrender MyContentType a where +-- fromByteString _ bs = case BSC.take 12 bs of +-- "MyContentType" -> return . read . BSC.unpack $ BSC.drop 12 bs +-- _ -> Left "didn't start with the magic incantation" +-- :} +-- +-- >>> type MyAPI = "path" :> ReqBody '[MyContentType] Int :> Get '[JSON] Int -- class Accept ctype => MimeUnrender ctype a where fromByteString :: Proxy ctype -> ByteString -> Either String a -class (IsNonEmpty list) => AllCTUnrender list a where +class (IsNonEmpty list) => AllCTUnrender (list :: [*]) a where handleCTypeH :: Proxy list -> ByteString -- Content-Type header -> ByteString -- Request body @@ -144,8 +206,8 @@ instance ( AllMimeUnrender ctyps a, IsNonEmpty ctyps -------------------------------------------------------------------------- -- Check that all elements of list are instances of MimeRender -------------------------------------------------------------------------- -class AllMimeRender ls a where - allMimeRender :: Proxy ls +class AllMimeRender (list :: [*]) a where + allMimeRender :: Proxy list -> a -- value to serialize -> [(M.MediaType, ByteString)] -- content-types/response pairs @@ -168,8 +230,10 @@ instance AllMimeRender '[] a where -------------------------------------------------------------------------- -- Check that all elements of list are instances of MimeUnrender -------------------------------------------------------------------------- -class AllMimeUnrender ls a where - allMimeUnrender :: Proxy ls -> ByteString -> [(M.MediaType, Either String a)] +class AllMimeUnrender (list :: [*]) a where + allMimeUnrender :: Proxy list + -> ByteString + -> [(M.MediaType, Either String a)] instance AllMimeUnrender '[] a where allMimeUnrender _ _ = [] @@ -182,7 +246,7 @@ instance ( MimeUnrender ctyp a where pctyp = Proxy :: Proxy ctyp pctyps = Proxy :: Proxy ctyps -type family IsNonEmpty (ls::[*]) :: Constraint where +type family IsNonEmpty (list :: [*]) :: Constraint where IsNonEmpty (x ': xs) = () @@ -193,9 +257,9 @@ type family IsNonEmpty (ls::[*]) :: Constraint where instance ToJSON a => MimeRender JSON a where toByteString _ = encode --- | `encodeFormUrlEncoded . toFormUrlEncoded` --- Note that the `fromByteString p (toByteString p x) == Right x` law only --- holds if every element of x is non-null (i.e., not `("", "")`) +-- | @encodeFormUrlEncoded . toFormUrlEncoded@ +-- Note that the @fromByteString p (toByteString p x) == Right x@ law only +-- holds if every element of x is non-null (i.e., not @("", "")@) instance ToFormUrlEncoded a => MimeRender FormUrlEncoded a where toByteString _ = encodeFormUrlEncoded . toFormUrlEncoded @@ -203,11 +267,11 @@ instance ToFormUrlEncoded a => MimeRender FormUrlEncoded a where instance MimeRender PlainText TextL.Text where toByteString _ = TextL.encodeUtf8 --- | `fromStrict . TextS.encodeUtf8` +-- | @fromStrict . TextS.encodeUtf8@ instance MimeRender PlainText TextS.Text where toByteString _ = fromStrict . TextS.encodeUtf8 --- | `id` +-- | @id@ instance MimeRender OctetStream ByteString where toByteString _ = id @@ -230,25 +294,25 @@ eitherDecodeLenient input = do instance FromJSON a => MimeUnrender JSON a where fromByteString _ = eitherDecodeLenient --- | `decodeFormUrlEncoded >=> fromFormUrlEncoded` --- Note that the `fromByteString p (toByteString p x) == Right x` law only --- holds if every element of x is non-null (i.e., not `("", "")`) +-- | @decodeFormUrlEncoded >=> fromFormUrlEncoded@ +-- Note that the @fromByteString p (toByteString p x) == Right x@ law only +-- holds if every element of x is non-null (i.e., not @("", "")@) instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where fromByteString _ = decodeFormUrlEncoded >=> fromFormUrlEncoded --- | `left show . TextL.decodeUtf8'` +-- | @left show . TextL.decodeUtf8'@ instance MimeUnrender PlainText TextL.Text where fromByteString _ = left show . TextL.decodeUtf8' --- | `left show . TextS.decodeUtf8' . toStrict` +-- | @left show . TextS.decodeUtf8' . toStrict@ instance MimeUnrender PlainText TextS.Text where fromByteString _ = left show . TextS.decodeUtf8' . toStrict --- | `Right . id` +-- | @Right . id@ instance MimeUnrender OctetStream ByteString where fromByteString _ = Right . id --- | `Right . toStrict` +-- | @Right . toStrict@ instance MimeUnrender OctetStream BS.ByteString where fromByteString _ = Right . toStrict @@ -296,3 +360,10 @@ decodeFormUrlEncoded q = do unescape :: TextS.Text -> TextS.Text unescape = cs . unEscapeString . cs . TextS.intercalate "%20" . TextS.splitOn "+" mapM parsePair xs + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/Delete.hs b/src/Servant/API/Delete.hs index 394b11c9..5c0eb7b7 100644 --- a/src/Servant/API/Delete.hs +++ b/src/Servant/API/Delete.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} -module Servant.API.Delete where +module Servant.API.Delete (Delete) where import Data.Typeable ( Typeable ) @@ -7,7 +7,15 @@ import Data.Typeable ( Typeable ) -- -- Example: -- --- > -- DELETE /books/:isbn --- > type MyApi = "books" :> Capture "isbn" Text :> Delete +-- >>> -- DELETE /books/:isbn +-- >>> type MyApi = "books" :> Capture "isbn" Text :> Delete data Delete deriving Typeable + + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/Get.hs b/src/Servant/API/Get.hs index 8f04fdb5..bd4288df 100644 --- a/src/Servant/API/Get.hs +++ b/src/Servant/API/Get.hs @@ -1,14 +1,21 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE KindSignatures #-} -module Servant.API.Get where +{-# LANGUAGE KindSignatures #-} +module Servant.API.Get (Get) where -import Data.Typeable ( Typeable ) +import Data.Typeable (Typeable) -- | Endpoint for simple GET requests. Serves the result as JSON. -- -- Example: -- --- > type MyApi = "books" :> Get '[JSON] [Book] -data Get (contentTypes::[*]) a +-- >>> type MyApi = "books" :> Get '[JSON] [Book] +data Get (contentTypes :: [*]) a deriving Typeable + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/Header.hs b/src/Servant/API/Header.hs index 06344524..5c4826d7 100644 --- a/src/Servant/API/Header.hs +++ b/src/Servant/API/Header.hs @@ -1,13 +1,25 @@ -{-# LANGUAGE PolyKinds #-} -module Servant.API.Header where +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE PolyKinds #-} +module Servant.API.Header (Header) where +import Data.Typeable (Typeable) +import GHC.TypeLits (Symbol) -- | Extract the given header's value as a value of type @a@. -- -- Example: -- --- > newtype Referer = Referer Text --- > deriving (Eq, Show, FromText, ToText) --- > --- > -- GET /view-my-referer --- > type MyApi = "view-my-referer" :> Header "from" Referer :> Get Referer -data Header sym a +-- >>> newtype Referer = Referer Text deriving (Eq, Show) +-- >>> +-- >>> -- GET /view-my-referer +-- >>> type MyApi = "view-my-referer" :> Header "from" Referer :> Get '[JSON] Referer +data Header (sym :: Symbol) a + deriving Typeable + +-- $setup +-- >>> import Servant.API +-- >>> import Servant.Common.Text +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/MatrixParam.hs b/src/Servant/API/MatrixParam.hs index 5e826571..59c0d045 100644 --- a/src/Servant/API/MatrixParam.hs +++ b/src/Servant/API/MatrixParam.hs @@ -1,14 +1,19 @@ -{-# LANGUAGE PolyKinds #-} -module Servant.API.MatrixParam where +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE PolyKinds #-} +module Servant.API.MatrixParam (MatrixFlag, MatrixParam, MatrixParams) where +import Data.Typeable (Typeable) +import GHC.TypeLits (Symbol) -- | Lookup the value associated to the @sym@ matrix string parameter -- and try to extract it as a value of type @a@. -- -- Example: -- --- > -- /books;author= --- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book] -data MatrixParam sym a +-- >>> -- /books;author= +-- >>> type MyApi = "books" :> MatrixParam "author" Text :> Get '[JSON] [Book] +data MatrixParam (sym :: Symbol) a + deriving (Typeable) -- | Lookup the values associated to the @sym@ matrix string parameter -- and try to extract it as a value of type @[a]@. This is typically @@ -19,9 +24,10 @@ data MatrixParam sym a -- -- Example: -- --- > -- /books;authors[]=;authors[]=;... --- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book] -data MatrixParams sym a +-- >>> -- /books;authors[]=;authors[]=;... +-- >>> type MyApi = "books" :> MatrixParams "authors" Text :> Get '[JSON] [Book] +data MatrixParams (sym :: Symbol) a + deriving (Typeable) -- | Lookup a potentially value-less matrix string parameter -- with boolean semantics. If the param @sym@ is there without any value, @@ -30,6 +36,15 @@ data MatrixParams sym a -- -- Example: -- --- > -- /books;published --- > type MyApi = "books" :> MatrixFlag "published" :> Get [Book] -data MatrixFlag sym +-- >>> -- /books;published +-- >>> type MyApi = "books" :> MatrixFlag "published" :> Get '[JSON] [Book] +data MatrixFlag (sym :: Symbol) + deriving (Typeable) + + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/Patch.hs b/src/Servant/API/Patch.hs index b2584f96..4a33f97a 100644 --- a/src/Servant/API/Patch.hs +++ b/src/Servant/API/Patch.hs @@ -1,9 +1,9 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE KindSignatures #-} -module Servant.API.Patch where +{-# LANGUAGE KindSignatures #-} +module Servant.API.Patch (Patch) where -import Data.Typeable ( Typeable ) +import Data.Typeable (Typeable) -- | Endpoint for PATCH requests. The type variable represents the type of the -- response body (not the request body, use 'Servant.API.ReqBody.ReqBody' for @@ -13,9 +13,16 @@ import Data.Typeable ( Typeable ) -- -- Example: -- --- > -- PATCH /books --- > -- with a JSON encoded Book as the request body --- > -- returning the just-created Book --- > type MyApi = "books" :> ReqBody Book :> Patch '[JSON] Book -data Patch (contentTypes::[*]) a +-- >>> -- PATCH /books +-- >>> -- with a JSON encoded Book as the request body +-- >>> -- returning the just-created Book +-- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Patch '[JSON] Book +data Patch (contentTypes :: [*]) a deriving Typeable + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/Post.hs b/src/Servant/API/Post.hs index 4ba32d71..3b1a616d 100644 --- a/src/Servant/API/Post.hs +++ b/src/Servant/API/Post.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE KindSignatures #-} -module Servant.API.Post where +{-# LANGUAGE KindSignatures #-} +module Servant.API.Post (Post) where -import Data.Typeable ( Typeable ) +import Data.Typeable (Typeable) -- | Endpoint for POST requests. The type variable represents the type of the -- response body (not the request body, use 'Servant.API.ReqBody.ReqBody' for @@ -11,9 +11,16 @@ import Data.Typeable ( Typeable ) -- -- Example: -- --- > -- POST /books --- > -- with a JSON encoded Book as the request body --- > -- returning the just-created Book --- > type MyApi = "books" :> ReqBody Book :> Post '[JSON] Book -data Post (contentTypes::[*]) a +-- >>> -- POST /books +-- >>> -- with a JSON encoded Book as the request body +-- >>> -- returning the just-created Book +-- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book +data Post (contentTypes :: [*]) a deriving Typeable + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/Put.hs b/src/Servant/API/Put.hs index 3166998d..144a22fc 100644 --- a/src/Servant/API/Put.hs +++ b/src/Servant/API/Put.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE KindSignatures #-} -module Servant.API.Put where +module Servant.API.Put (Put) where import Data.Typeable ( Typeable ) @@ -10,8 +10,15 @@ import Data.Typeable ( Typeable ) -- -- Example: -- --- > -- PUT /books/:isbn --- > -- with a Book as request body, returning the updated Book --- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put '[JSON] Book -data Put (contentTypes::[*]) a +-- >>> -- PUT /books/:isbn +-- >>> -- with a Book as request body, returning the updated Book +-- >>> type MyApi = "books" :> Capture "isbn" Text :> ReqBody '[JSON] Book :> Put '[JSON] Book +data Put (contentTypes :: [*]) a deriving Typeable + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/QueryParam.hs b/src/Servant/API/QueryParam.hs index d8a93233..14e8ce43 100644 --- a/src/Servant/API/QueryParam.hs +++ b/src/Servant/API/QueryParam.hs @@ -1,14 +1,20 @@ -{-# LANGUAGE PolyKinds #-} -module Servant.API.QueryParam where +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE PolyKinds #-} +module Servant.API.QueryParam (QueryFlag, QueryParam, QueryParams) where +import Data.Typeable (Typeable) +import GHC.TypeLits (Symbol) -- | Lookup the value associated to the @sym@ query string parameter -- and try to extract it as a value of type @a@. -- -- Example: -- --- > -- /books?author= --- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book] -data QueryParam sym a +-- >>> -- /books?author= +-- >>> type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book] +data QueryParam (sym :: Symbol) a + deriving Typeable -- | Lookup the values associated to the @sym@ query string parameter -- and try to extract it as a value of type @[a]@. This is typically @@ -19,9 +25,10 @@ data QueryParam sym a -- -- Example: -- --- > -- /books?authors[]=&authors[]=&... --- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book] -data QueryParams sym a +-- >>> -- /books?authors[]=&authors[]=&... +-- >>> type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book] +data QueryParams (sym :: Symbol) a + deriving Typeable -- | Lookup a potentially value-less query string parameter -- with boolean semantics. If the param @sym@ is there without any value, @@ -30,6 +37,13 @@ data QueryParams sym a -- -- Example: -- --- > -- /books?published --- > type MyApi = "books" :> QueryFlag "published" :> Get [Book] -data QueryFlag sym +-- >>> -- /books?published +-- >>> type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book] +data QueryFlag (sym :: Symbol) + +-- $setup +-- >>> import Servant.API +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/ReqBody.hs b/src/Servant/API/ReqBody.hs index ecf5b4d9..29e6f5f2 100644 --- a/src/Servant/API/ReqBody.hs +++ b/src/Servant/API/ReqBody.hs @@ -1,11 +1,22 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE PolyKinds #-} module Servant.API.ReqBody where +import Data.Typeable (Typeable) -- | Extract the request body as a value of type @a@. -- -- Example: -- --- > -- POST /books --- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post Book -data ReqBody (contentTypes::[*]) a +-- >>> -- POST /books +-- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book +data ReqBody (contentTypes :: [*]) a + deriving (Typeable) + +-- $setup +-- >>> import Servant.API +-- >>> import Servant.Common.Text +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data Book +-- >>> instance ToJSON Book where { toJSON = undefined } diff --git a/src/Servant/API/Sub.hs b/src/Servant/API/Sub.hs index 2d32dff2..48f570a7 100644 --- a/src/Servant/API/Sub.hs +++ b/src/Servant/API/Sub.hs @@ -1,16 +1,26 @@ -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeOperators #-} -module Servant.API.Sub where +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +module Servant.API.Sub ((:>)) where -import Data.Proxy ( Proxy ) +import Data.Typeable (Typeable) -- | The contained API (second argument) can be found under @("/" ++ path)@ -- (path being the first argument). -- -- Example: -- --- > -- GET /hello/world --- > -- returning a JSON encoded World value --- > type MyApi = "hello" :> "world" :> Get World -data (path :: k) :> a = Proxy path :> a +-- >>> -- GET /hello/world +-- >>> -- returning a JSON encoded World value +-- >>> type MyApi = "hello" :> "world" :> Get '[JSON] World +data (path :: k) :> a + deriving (Typeable) infixr 9 :> + +-- $setup +-- >>> import Servant.API +-- >>> import Servant.Common.Text +-- >>> import Data.Aeson +-- >>> import Data.Text +-- >>> data World +-- >>> instance ToJSON World where { toJSON = undefined } diff --git a/src/Servant/Common/Text.hs b/src/Servant/Common/Text.hs index 4df9f6f5..cc8cb15d 100644 --- a/src/Servant/Common/Text.hs +++ b/src/Servant/Common/Text.hs @@ -1,16 +1,16 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} module Servant.Common.Text ( FromText(..) , ToText(..) ) where -import Data.String.Conversions ( cs ) -import Data.Int ( Int8, Int16, Int32, Int64 ) -import Data.Text ( Text ) -import Data.Text.Read ( rational, signed, decimal, Reader ) -import Data.Word ( Word, Word8, Word16, Word32, Word64 ) +import Data.Int (Int16, Int32, Int64, Int8) +import Data.String.Conversions (cs) +import Data.Text (Text) +import Data.Text.Read (Reader, decimal, rational, signed) +import Data.Word (Word, Word16, Word32, Word64, Word8) -- | For getting values from url captures and query string parameters -- Instances should obey: @@ -37,17 +37,22 @@ instance ToText String where toText = cs -- | --- > fromText "true" = Just True --- > fromText "false" = Just False --- > fromText _ = Nothing +-- >>> fromText ("true"::Text) :: Maybe Bool +-- Just True +-- >>> fromText ("false"::Text) :: Maybe Bool +-- Just False +-- >>> fromText ("anything else"::Text) :: Maybe Bool +-- Nothing instance FromText Bool where fromText "true" = Just True fromText "false" = Just False fromText _ = Nothing -- | --- > toText True = "true" --- > toText False = "false" +-- >>> toText True +-- "true" +-- >>> toText False +-- "false" instance ToText Bool where toText True = "true" toText False = "false" diff --git a/test-docs.sh b/test-docs.sh deleted file mode 100755 index 9c1cc982..00000000 --- a/test-docs.sh +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/sh - -doctest -isrc -optP-include -optPdist/build/autogen/cabal_macros.h $(find src/ -name '*.hs') diff --git a/test/Doctests.hs b/test/Doctests.hs new file mode 100644 index 00000000..059292c0 --- /dev/null +++ b/test/Doctests.hs @@ -0,0 +1,16 @@ +module Main where + +import System.FilePath.Find +import Test.DocTest + +main :: IO () +main = do + files <- find always (extension ==? ".hs") "src" + doctest $ [ "-isrc" + , "-optP-include" + , "-optPdist/build/autogen/cabal_macros.h" + , "-XOverloadedStrings" + , "-XFlexibleInstances" + , "-XMultiParamTypeClasses" + ] ++ files + diff --git a/test/Servant/Common/TextSpec.hs b/test/Servant/Common/TextSpec.hs index ec8e2c5a..d5c98b1f 100644 --- a/test/Servant/Common/TextSpec.hs +++ b/test/Servant/Common/TextSpec.hs @@ -1,12 +1,12 @@ module Servant.Common.TextSpec where -import Servant.Common.Text -import Test.Hspec -import Test.QuickCheck -import Test.QuickCheck.Instances () -import Data.Int ( Int8, Int16, Int32, Int64 ) -import Data.Text ( Text ) -import Data.Word ( Word, Word8, Word16, Word32, Word64 ) +import Data.Int (Int16, Int32, Int64, Int8) +import Data.Text (Text) +import Data.Word (Word, Word16, Word32, Word64, Word8) +import Servant.Common.Text +import Test.Hspec +import Test.QuickCheck +import Test.QuickCheck.Instances () spec :: Spec spec = describe "Servant.Common.Text" $ do