eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #19 from haskell-servant/jkarni/integrate-doctests

Browse source 
Cleanup, including:
This commit is contained in:
Julian Arni 2015-03-02 15:27:14 +01:00
commit 4602225f60
21 changed files with 404 additions and 171 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
.travis.yml
View file

@ -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

1
TODO.md
View file

@ -1 +0,0 @@
- Try to find a way to abstract over the format(s) instead of the current focus on JSON, maybe

11
servant.cabal
View file

@ -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

70
src/Servant/API.hs
View file

@ -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)

25
src/Servant/API/Alternative.hs
View file

@ -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 }

21
src/Servant/API/Capture.hs
View file

@ -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 }

133
src/Servant/API/ContentTypes.hs
View file

@ -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 }

14
src/Servant/API/Delete.hs
View file

@ -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 }

19
src/Servant/API/Get.hs
View file

@ -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 }

28
src/Servant/API/Header.hs
View file

@ -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 }

37
src/Servant/API/MatrixParam.hs
View file

@ -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=<author name>
-- > type MyApi = "books" :> MatrixParam "author" Text :> Get [Book]
data MatrixParam sym a
-- >>> -- /books;author=<author name>
-- >>> 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[]=<author1>;authors[]=<author2>;...
-- > type MyApi = "books" :> MatrixParams "authors" Text :> Get [Book]
data MatrixParams sym a
-- >>> -- /books;authors[]=<author1>;authors[]=<author2>;...
-- >>> 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 }

25
src/Servant/API/Patch.hs
View file

@ -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 }

25
src/Servant/API/Post.hs
View file

@ -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 }

17
src/Servant/API/Put.hs
View file

@ -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 }

36
src/Servant/API/QueryParam.hs
View file

@ -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=<author name>
-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]
data QueryParam sym a
-- >>> -- /books?author=<author name>
-- >>> 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[]=<author1>&authors[]=<author2>&...
-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]
data QueryParams sym a
-- >>> -- /books?authors[]=<author1>&authors[]=<author2>&...
-- >>> 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 }

21
src/Servant/API/ReqBody.hs
View file

@ -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 }

26
src/Servant/API/Sub.hs
View file

@ -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 }

29
src/Servant/Common/Text.hs
View file

@ -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"

3
test-docs.sh
View file

@ -1,3 +0,0 @@
#!/bin/sh
doctest -isrc -optP-include -optPdist/build/autogen/cabal_macros.h $(find src/ -name '*.hs')

16
test/Doctests.hs Normal file
View file

@ -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

14
test/Servant/Common/TextSpec.hs
View file

@ -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