Use http-api-data package instead of ToText/FromText

This commit is contained in:
Nickolay Kudasov 2015-10-08 00:38:47 +03:00
parent 7b60fb68d5
commit 40d2c68897
16 changed files with 73 additions and 146 deletions

View file

@ -34,6 +34,7 @@ library
, attoparsec , attoparsec
, bytestring , bytestring
, exceptions , exceptions
, http-api-data
, http-client , http-client
, http-client-tls , http-client-tls
, http-media , http-media

View file

@ -92,7 +92,7 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
-- of this value at the right place in the request path. -- of this value at the right place in the request path.
-- --
-- You can control how values for this type are turned into -- You can control how values for this type are turned into
-- text by specifying a 'ToText' instance for your type. -- text by specifying a 'ToHttpApiData' instance for your type.
-- --
-- Example: -- Example:
-- --
@ -105,7 +105,7 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
-- > getBook = client myApi host manager -- > getBook = client myApi host manager
-- > where host = BaseUrl Http "localhost" 8080 -- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "getBook" to query that endpoint -- > -- then you can just use "getBook" to query that endpoint
instance (KnownSymbol capture, ToText a, HasClient sublayout) instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
=> HasClient (Capture capture a :> sublayout) where => HasClient (Capture capture a :> sublayout) where
type Client (Capture capture a :> sublayout) = type Client (Capture capture a :> sublayout) =
@ -117,7 +117,7 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)
baseurl baseurl
manager manager
where p = unpack (toText val) where p = unpack (toUrlPiece val)
-- | If you have a 'Delete' endpoint in your API, the client -- | If you have a 'Delete' endpoint in your API, the client
-- side querying function that is created when calling 'client' -- side querying function that is created when calling 'client'
@ -205,12 +205,12 @@ instance
-- That function will take care of encoding this argument as Text -- That function will take care of encoding this argument as Text
-- in the request headers. -- in the request headers.
-- --
-- All you need is for your type to have a 'ToText' instance. -- All you need is for your type to have a 'ToHttpApiData' instance.
-- --
-- Example: -- Example:
-- --
-- > newtype Referer = Referer { referrer :: Text } -- > newtype Referer = Referer { referrer :: Text }
-- > deriving (Eq, Show, Generic, FromText, ToText) -- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
-- > -- >
-- > -- GET /view-my-referer -- > -- GET /view-my-referer
-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer -- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
@ -223,7 +223,7 @@ instance
-- > where host = BaseUrl Http "localhost" 8080 -- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "viewRefer" to query that endpoint -- > -- then you can just use "viewRefer" to query that endpoint
-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
=> HasClient (Header sym a :> sublayout) where => HasClient (Header sym a :> sublayout) where
type Client (Header sym a :> sublayout) = type Client (Header sym a :> sublayout) =
@ -368,7 +368,7 @@ instance
-- of inserting a textual representation of this value in the query string. -- of inserting a textual representation of this value in the query string.
-- --
-- You can control how values for your type are turned into -- You can control how values for your type are turned into
-- text by specifying a 'ToText' instance for your type. -- text by specifying a 'ToHttpApiData' instance for your type.
-- --
-- Example: -- Example:
-- --
@ -383,7 +383,7 @@ instance
-- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy Nothing' for all books
-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
=> HasClient (QueryParam sym a :> sublayout) where => HasClient (QueryParam sym a :> sublayout) where
type Client (QueryParam sym a :> sublayout) = type Client (QueryParam sym a :> sublayout) =
@ -401,7 +401,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
where pname = cs pname' where pname = cs pname'
pname' = symbolVal (Proxy :: Proxy sym) pname' = symbolVal (Proxy :: Proxy sym)
mparamText = fmap toText mparam mparamText = fmap toQueryParam mparam
-- | If you use a 'QueryParams' in one of your endpoints in your API, -- | If you use a 'QueryParams' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -415,7 +415,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- under the same query string parameter name. -- under the same query string parameter name.
-- --
-- You can control how values for your type are turned into -- You can control how values for your type are turned into
-- text by specifying a 'ToText' instance for your type. -- text by specifying a 'ToHttpApiData' instance for your type.
-- --
-- Example: -- Example:
-- --
@ -431,7 +431,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- > -- 'getBooksBy []' for all books -- > -- 'getBooksBy []' for all books
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
-- > -- to get all books by Asimov and Heinlein -- > -- to get all books by Asimov and Heinlein
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
=> HasClient (QueryParams sym a :> sublayout) where => HasClient (QueryParams sym a :> sublayout) where
type Client (QueryParams sym a :> sublayout) = type Client (QueryParams sym a :> sublayout) =
@ -447,7 +447,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
where pname = cs pname' where pname = cs pname'
pname' = symbolVal (Proxy :: Proxy sym) pname' = symbolVal (Proxy :: Proxy sym)
paramlist' = map (Just . toText) paramlist paramlist' = map (Just . toQueryParam) paramlist
-- | If you use a 'QueryFlag' in one of your endpoints in your API, -- | If you use a 'QueryFlag' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -498,7 +498,7 @@ instance (KnownSymbol sym, HasClient sublayout)
-- of inserting a textual representation of this value in the query string. -- of inserting a textual representation of this value in the query string.
-- --
-- You can control how values for your type are turned into -- You can control how values for your type are turned into
-- text by specifying a 'ToText' instance for your type. -- text by specifying a 'ToHttpApiData' instance for your type.
-- --
-- Example: -- Example:
-- --
@ -513,7 +513,7 @@ instance (KnownSymbol sym, HasClient sublayout)
-- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy Nothing' for all books
-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
=> HasClient (MatrixParam sym a :> sublayout) where => HasClient (MatrixParam sym a :> sublayout) where
type Client (MatrixParam sym a :> sublayout) = type Client (MatrixParam sym a :> sublayout) =
@ -529,7 +529,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
baseurl manager baseurl manager
where pname = symbolVal (Proxy :: Proxy sym) where pname = symbolVal (Proxy :: Proxy sym)
mparamText = fmap (cs . toText) mparam mparamText = fmap (cs . toQueryParam) mparam
-- | If you use a 'MatrixParams' in one of your endpoints in your API, -- | If you use a 'MatrixParams' in one of your endpoints in your API,
-- the corresponding querying function will automatically take an -- the corresponding querying function will automatically take an
@ -543,7 +543,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- same matrix string parameter name. -- same matrix string parameter name.
-- --
-- You can control how values for your type are turned into text by -- You can control how values for your type are turned into text by
-- specifying a 'ToText' instance for your type. -- specifying a 'ToHttpApiData' instance for your type.
-- --
-- Example: -- Example:
-- --
@ -559,7 +559,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- > -- 'getBooksBy []' for all books -- > -- 'getBooksBy []' for all books
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
-- > -- to get all books by Asimov and Heinlein -- > -- to get all books by Asimov and Heinlein
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
=> HasClient (MatrixParams sym a :> sublayout) where => HasClient (MatrixParams sym a :> sublayout) where
type Client (MatrixParams sym a :> sublayout) = type Client (MatrixParams sym a :> sublayout) =
@ -575,7 +575,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
where pname = cs pname' where pname = cs pname'
pname' = symbolVal (Proxy :: Proxy sym) pname' = symbolVal (Proxy :: Proxy sym)
paramlist' = map (Just . toText) paramlist paramlist' = map (Just . toQueryParam) paramlist
-- | If you use a 'MatrixFlag' in one of your endpoints in your API, -- | If you use a 'MatrixFlag' in one of your endpoints in your API,
-- the corresponding querying function will automatically take an -- the corresponding querying function will automatically take an

View file

@ -26,10 +26,11 @@ import qualified Network.HTTP.Types.Header as HTTP
import Network.URI hiding (path) import Network.URI hiding (path)
import Servant.API.ContentTypes import Servant.API.ContentTypes
import Servant.Common.BaseUrl import Servant.Common.BaseUrl
import Servant.Common.Text
import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Client as Client
import Web.HttpApiData
data ServantError data ServantError
= FailureResponse = FailureResponse
{ responseStatus :: Status { responseStatus :: Status
@ -86,9 +87,9 @@ appendToQueryString pname pvalue req =
req { qs = qs req ++ [(pname, pvalue)] req { qs = qs req ++ [(pname, pvalue)]
} }
addHeader :: ToText a => String -> a -> Req -> Req addHeader :: ToHttpApiData a => String -> a -> Req -> Req
addHeader name val req = req { headers = headers req addHeader name val req = req { headers = headers req
++ [(name, toText val)] ++ [(name, decodeUtf8 (toHeader val))]
} }
setRQBody :: ByteString -> MediaType -> Req -> Req setRQBody :: ByteString -> MediaType -> Req -> Req

View file

@ -107,7 +107,7 @@ instance (HasMock a, HasMock b) => HasMock (a :<|> b) where
instance (KnownSymbol path, HasMock rest) => HasMock (path :> rest) where instance (KnownSymbol path, HasMock rest) => HasMock (path :> rest) where
mock _ = mock (Proxy :: Proxy rest) mock _ = mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromText a, HasMock rest) => HasMock (Capture s a :> rest) where instance (KnownSymbol s, FromHttpApiData a, HasMock rest) => HasMock (Capture s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (AllCTUnrender ctypes a, HasMock rest) => HasMock (ReqBody ctypes a :> rest) where instance (AllCTUnrender ctypes a, HasMock rest) => HasMock (ReqBody ctypes a :> rest) where
@ -125,29 +125,29 @@ instance HasMock rest => HasMock (Vault :> rest) where
instance HasMock rest => HasMock (HttpVersion :> rest) where instance HasMock rest => HasMock (HttpVersion :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromText a, HasMock rest) instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
=> HasMock (QueryParam s a :> rest) where => HasMock (QueryParam s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromText a, HasMock rest) instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
=> HasMock (QueryParams s a :> rest) where => HasMock (QueryParams s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromText a, HasMock rest) instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
=> HasMock (MatrixParam s a :> rest) where => HasMock (MatrixParam s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, FromText a, HasMock rest) instance (KnownSymbol s, FromHttpApiData a, HasMock rest)
=> HasMock (MatrixParams s a :> rest) where => HasMock (MatrixParams s a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, HasMock rest) => HasMock (MatrixFlag s :> rest) where instance (KnownSymbol s, HasMock rest) => HasMock (MatrixFlag s :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol h, FromText a, HasMock rest) => HasMock (Header h a :> rest) where instance (KnownSymbol h, FromHttpApiData a, HasMock rest) => HasMock (Header h a :> rest) where
mock _ = \_ -> mock (Proxy :: Proxy rest) mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Delete ctypes a) where instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Delete ctypes a) where

View file

@ -48,6 +48,7 @@ library
, attoparsec >= 0.12 && < 0.14 , attoparsec >= 0.12 && < 0.14
, bytestring >= 0.10 && < 0.11 , bytestring >= 0.10 && < 0.11
, containers >= 0.5 && < 0.6 , containers >= 0.5 && < 0.6
, http-api-data
, http-types >= 0.8 && < 0.9 , http-types >= 0.8 && < 0.9
, network-uri >= 2.6 && < 2.7 , network-uri >= 2.6 && < 2.7
, mtl >= 2 && < 3 , mtl >= 2 && < 3

View file

@ -5,8 +5,6 @@ module Servant (
module Servant.API, module Servant.API,
-- | For implementing servers for servant APIs. -- | For implementing servers for servant APIs.
module Servant.Server, module Servant.Server,
-- | Using your types in request paths and query string parameters
module Servant.Common.Text,
-- | Utilities on top of the servant core -- | Utilities on top of the servant core
module Servant.Utils.Links, module Servant.Utils.Links,
module Servant.Utils.StaticFiles, module Servant.Utils.StaticFiles,
@ -16,7 +14,6 @@ module Servant (
import Data.Proxy import Data.Proxy
import Servant.API import Servant.API
import Servant.Common.Text
import Servant.Server import Servant.Server
import Servant.Utils.Links import Servant.Utils.Links
import Servant.Utils.StaticFiles import Servant.Utils.StaticFiles

View file

@ -53,13 +53,15 @@ import Servant.API.ContentTypes (AcceptHeader (..),
AllCTUnrender (..)) AllCTUnrender (..))
import Servant.API.ResponseHeaders (Headers, getResponse, GetHeaders, import Servant.API.ResponseHeaders (Headers, getResponse, GetHeaders,
getHeaders) getHeaders)
import Servant.Common.Text (FromText, fromText)
import Servant.Server.Internal.PathInfo import Servant.Server.Internal.PathInfo
import Servant.Server.Internal.Router import Servant.Server.Internal.Router
import Servant.Server.Internal.RoutingApplication import Servant.Server.Internal.RoutingApplication
import Servant.Server.Internal.ServantErr import Servant.Server.Internal.ServantErr
import Web.HttpApiData (FromHttpApiData)
import Web.HttpApiData.Internal (parseUrlPieceMaybe, parseHeaderMaybe, parseQueryParamMaybe)
class HasServer layout where class HasServer layout where
type ServerT layout (m :: * -> *) :: * type ServerT layout (m :: * -> *) :: *
@ -89,8 +91,8 @@ instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
where pa = Proxy :: Proxy a where pa = Proxy :: Proxy a
pb = Proxy :: Proxy b pb = Proxy :: Proxy b
captured :: FromText a => proxy (Capture sym a) -> Text -> Maybe a captured :: FromHttpApiData a => proxy (Capture sym a) -> Text -> Maybe a
captured _ = fromText captured _ = parseUrlPieceMaybe
-- | If you use 'Capture' in one of the endpoints for your API, -- | If you use 'Capture' in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function -- this automatically requires your server-side handler to be a function
@ -99,7 +101,7 @@ captured _ = fromText
-- it into a value of the type you specify. -- it into a value of the type you specify.
-- --
-- You can control how it'll be converted from 'Text' to your type -- You can control how it'll be converted from 'Text' to your type
-- by simply providing an instance of 'FromText' for your type. -- by simply providing an instance of 'FromHttpApiData' for your type.
-- --
-- Example: -- Example:
-- --
@ -109,7 +111,7 @@ captured _ = fromText
-- > server = getBook -- > server = getBook
-- > where getBook :: Text -> ExceptT ServantErr IO Book -- > where getBook :: Text -> ExceptT ServantErr IO Book
-- > getBook isbn = ... -- > getBook isbn = ...
instance (KnownSymbol capture, FromText a, HasServer sublayout) instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
=> HasServer (Capture capture a :> sublayout) where => HasServer (Capture capture a :> sublayout) where
type ServerT (Capture capture a :> sublayout) m = type ServerT (Capture capture a :> sublayout) m =
@ -282,12 +284,12 @@ instance
-- This lets servant worry about extracting it from the request and turning -- This lets servant worry about extracting it from the request and turning
-- it into a value of the type you specify. -- it into a value of the type you specify.
-- --
-- All it asks is for a 'FromText' instance. -- All it asks is for a 'FromHttpApiData' instance.
-- --
-- Example: -- Example:
-- --
-- > newtype Referer = Referer Text -- > newtype Referer = Referer Text
-- > deriving (Eq, Show, FromText, ToText) -- > deriving (Eq, Show, FromHttpApiData, ToText)
-- > -- >
-- > -- GET /view-my-referer -- > -- GET /view-my-referer
-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer -- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
@ -296,14 +298,14 @@ instance
-- > server = viewReferer -- > server = viewReferer
-- > where viewReferer :: Referer -> ExceptT ServantErr IO referer -- > where viewReferer :: Referer -> ExceptT ServantErr IO referer
-- > viewReferer referer = return referer -- > viewReferer referer = return referer
instance (KnownSymbol sym, FromText a, HasServer sublayout) instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (Header sym a :> sublayout) where => HasServer (Header sym a :> sublayout) where
type ServerT (Header sym a :> sublayout) m = type ServerT (Header sym a :> sublayout) m =
Maybe a -> ServerT sublayout m Maybe a -> ServerT sublayout m
route Proxy subserver = WithRequest $ \ request -> route Proxy subserver = WithRequest $ \ request ->
let mheader = fromText . decodeUtf8 =<< lookup str (requestHeaders request) let mheader = parseHeaderMaybe =<< lookup str (requestHeaders request)
in route (Proxy :: Proxy sublayout) (feedTo subserver mheader) in route (Proxy :: Proxy sublayout) (feedTo subserver mheader)
where str = fromString $ symbolVal (Proxy :: Proxy sym) where str = fromString $ symbolVal (Proxy :: Proxy sym)
@ -451,7 +453,7 @@ instance
-- hand you 'Nothing'. -- hand you 'Nothing'.
-- --
-- You can control how it'll be converted from 'Text' to your type -- You can control how it'll be converted from 'Text' to your type
-- by simply providing an instance of 'FromText' for your type. -- by simply providing an instance of 'FromHttpApiData' for your type.
-- --
-- Example: -- Example:
-- --
@ -462,7 +464,7 @@ instance
-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book] -- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
-- > getBooksBy Nothing = ...return all books... -- > getBooksBy Nothing = ...return all books...
-- > getBooksBy (Just author) = ...return books by the given author... -- > getBooksBy (Just author) = ...return books by the given author...
instance (KnownSymbol sym, FromText a, HasServer sublayout) instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (QueryParam sym a :> sublayout) where => HasServer (QueryParam sym a :> sublayout) where
type ServerT (QueryParam sym a :> sublayout) m = type ServerT (QueryParam sym a :> sublayout) m =
@ -474,7 +476,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
case lookup paramname querytext of case lookup paramname querytext of
Nothing -> Nothing -- param absent from the query string Nothing -> Nothing -- param absent from the query string
Just Nothing -> Nothing -- param present with no value -> Nothing Just Nothing -> Nothing -- param present with no value -> Nothing
Just (Just v) -> fromText v -- if present, we try to convert to Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to
-- the right type -- the right type
in route (Proxy :: Proxy sublayout) (feedTo subserver param) in route (Proxy :: Proxy sublayout) (feedTo subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
@ -488,7 +490,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- the type you specify. -- the type you specify.
-- --
-- You can control how the individual values are converted from 'Text' to your type -- You can control how the individual values are converted from 'Text' to your type
-- by simply providing an instance of 'FromText' for your type. -- by simply providing an instance of 'FromHttpApiData' for your type.
-- --
-- Example: -- Example:
-- --
@ -498,7 +500,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- > server = getBooksBy -- > server = getBooksBy
-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book] -- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
-- > getBooksBy authors = ...return all books by these authors... -- > getBooksBy authors = ...return all books by these authors...
instance (KnownSymbol sym, FromText a, HasServer sublayout) instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (QueryParams sym a :> sublayout) where => HasServer (QueryParams sym a :> sublayout) where
type ServerT (QueryParams sym a :> sublayout) m = type ServerT (QueryParams sym a :> sublayout) m =
@ -507,7 +509,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
route Proxy subserver = WithRequest $ \ request -> route Proxy subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request let querytext = parseQueryText $ rawQueryString request
-- if sym is "foo", we look for query string parameters -- if sym is "foo", we look for query string parameters
-- named "foo" or "foo[]" and call fromText on the -- named "foo" or "foo[]" and call parseQueryParam on the
-- corresponding values -- corresponding values
parameters = filter looksLikeParam querytext parameters = filter looksLikeParam querytext
values = mapMaybe (convert . snd) parameters values = mapMaybe (convert . snd) parameters
@ -515,7 +517,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
convert Nothing = Nothing convert Nothing = Nothing
convert (Just v) = fromText v convert (Just v) = parseQueryParamMaybe v
-- | If you use @'QueryFlag' "published"@ in one of the endpoints for your API, -- | If you use @'QueryFlag' "published"@ in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function -- this automatically requires your server-side handler to be a function
@ -559,7 +561,7 @@ parseMatrixText = parseQueryText
-- hand you 'Nothing'. -- hand you 'Nothing'.
-- --
-- You can control how it'll be converted from 'Text' to your type -- You can control how it'll be converted from 'Text' to your type
-- by simply providing an instance of 'FromText' for your type. -- by simply providing an instance of 'FromHttpApiData' for your type.
-- --
-- Example: -- Example:
-- --
@ -570,7 +572,7 @@ parseMatrixText = parseQueryText
-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book] -- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
-- > getBooksBy Nothing = ...return all books... -- > getBooksBy Nothing = ...return all books...
-- > getBooksBy (Just author) = ...return books by the given author... -- > getBooksBy (Just author) = ...return books by the given author...
instance (KnownSymbol sym, FromText a, HasServer sublayout) instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (MatrixParam sym a :> sublayout) where => HasServer (MatrixParam sym a :> sublayout) where
type ServerT (MatrixParam sym a :> sublayout) m = type ServerT (MatrixParam sym a :> sublayout) m =
@ -583,7 +585,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
param = case lookup paramname querytext of param = case lookup paramname querytext of
Nothing -> Nothing -- param absent from the query string Nothing -> Nothing -- param absent from the query string
Just Nothing -> Nothing -- param present with no value -> Nothing Just Nothing -> Nothing -- param present with no value -> Nothing
Just (Just v) -> fromText v -- if present, we try to convert to Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to
-- the right type -- the right type
route (Proxy :: Proxy sublayout) (feedTo subserver param) route (Proxy :: Proxy sublayout) (feedTo subserver param)
_ -> route (Proxy :: Proxy sublayout) (feedTo subserver Nothing) _ -> route (Proxy :: Proxy sublayout) (feedTo subserver Nothing)
@ -599,7 +601,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- the type you specify. -- the type you specify.
-- --
-- You can control how the individual values are converted from 'Text' to your type -- You can control how the individual values are converted from 'Text' to your type
-- by simply providing an instance of 'FromText' for your type. -- by simply providing an instance of 'FromHttpApiData' for your type.
-- --
-- Example: -- Example:
-- --
@ -609,7 +611,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- > server = getBooksBy -- > server = getBooksBy
-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book] -- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
-- > getBooksBy authors = ...return all books by these authors... -- > getBooksBy authors = ...return all books by these authors...
instance (KnownSymbol sym, FromText a, HasServer sublayout) instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
=> HasServer (MatrixParams sym a :> sublayout) where => HasServer (MatrixParams sym a :> sublayout) where
type ServerT (MatrixParams sym a :> sublayout) m = type ServerT (MatrixParams sym a :> sublayout) m =
@ -620,7 +622,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
(first : _) (first : _)
-> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first -> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
-- if sym is "foo", we look for matrix parameters -- if sym is "foo", we look for matrix parameters
-- named "foo" or "foo[]" and call fromText on the -- named "foo" or "foo[]" and call parseQueryParam on the
-- corresponding values -- corresponding values
parameters = filter looksLikeParam matrixtext parameters = filter looksLikeParam matrixtext
values = mapMaybe (convert . snd) parameters values = mapMaybe (convert . snd) parameters
@ -629,7 +631,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
where paramname = cs $ symbolVal (Proxy :: Proxy sym) where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]") looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
convert Nothing = Nothing convert Nothing = Nothing
convert (Just v) = fromText v convert (Just v) = parseQueryParamMaybe v
-- | If you use @'MatrixFlag' "published"@ in one of the endpoints for your API, -- | If you use @'MatrixFlag' "published"@ in one of the endpoints for your API,
-- this automatically requires your server-side handler to be a function -- this automatically requires your server-side handler to be a function

View file

@ -52,6 +52,7 @@ library
, bytestring == 0.10.* , bytestring == 0.10.*
, bytestring-conversion == 0.3.* , bytestring-conversion == 0.3.*
, case-insensitive >= 1.2 , case-insensitive >= 1.2
, http-api-data
, http-media >= 0.4 && < 0.7 , http-media >= 0.4 && < 0.7
, http-types == 0.8.* , http-types == 0.8.*
, text >= 1 && < 2 , text >= 1 && < 2
@ -92,7 +93,6 @@ test-suite spec
other-modules: other-modules:
Servant.API.ContentTypesSpec Servant.API.ContentTypesSpec
Servant.API.ResponseHeadersSpec Servant.API.ResponseHeadersSpec
Servant.Common.TextSpec
Servant.Utils.LinksSpec Servant.Utils.LinksSpec
build-depends: build-depends:
base == 4.* base == 4.*

View file

@ -50,9 +50,9 @@ module Servant.API (
module Servant.API.Raw, module Servant.API.Raw,
-- | Plugging in a wai 'Network.Wai.Application', serving directories -- | Plugging in a wai 'Network.Wai.Application', serving directories
-- * FromText and ToText -- * FromHttpApiData and ToHttpApiData
module Servant.Common.Text, module Web.HttpApiData,
-- | Classes and instances for types that can be converted to and from @Text@ -- | Classes and instances for types that can be converted to and from HTTP API data.
-- * Utilities -- * Utilities
module Servant.Utils.Links, module Servant.Utils.Links,
@ -88,7 +88,7 @@ import Servant.API.ResponseHeaders (AddHeader (addHeader),
getHeadersHList, getResponse) getHeadersHList, getResponse)
import Servant.API.Sub ((:>)) import Servant.API.Sub ((:>))
import Servant.API.Vault (Vault) import Servant.API.Vault (Vault)
import Servant.Common.Text (FromText (..), ToText (..)) import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))
import Servant.Utils.Links (HasLink (..), IsElem, IsElem', import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
URI (..), safeLink) URI (..), safeLink)

View file

@ -23,7 +23,6 @@ data Header (sym :: Symbol) a = Header a
-- $setup -- $setup
-- >>> import Servant.API -- >>> import Servant.API
-- >>> import Servant.Common.Text
-- >>> import Data.Aeson -- >>> import Data.Aeson
-- >>> import Data.Text -- >>> import Data.Text
-- >>> data Book -- >>> data Book

View file

@ -16,7 +16,6 @@ data ReqBody (contentTypes :: [*]) a
-- $setup -- $setup
-- >>> import Servant.API -- >>> import Servant.API
-- >>> import Servant.Common.Text
-- >>> import Data.Aeson -- >>> import Data.Aeson
-- >>> import Data.Text -- >>> import Data.Text
-- >>> data Book -- >>> data Book

View file

@ -20,7 +20,6 @@ infixr 9 :>
-- $setup -- $setup
-- >>> import Servant.API -- >>> import Servant.API
-- >>> import Servant.Common.Text
-- >>> import Data.Aeson -- >>> import Data.Aeson
-- >>> import Data.Text -- >>> import Data.Text
-- >>> data World -- >>> data World

View file

@ -113,7 +113,7 @@ import Network.URI ( URI(..), escapeURIString, isUnreserved )
import GHC.TypeLits ( KnownSymbol, symbolVal ) import GHC.TypeLits ( KnownSymbol, symbolVal )
import GHC.Exts(Constraint) import GHC.Exts(Constraint)
import Servant.Common.Text import Web.HttpApiData
import Servant.API.Capture ( Capture ) import Servant.API.Capture ( Capture )
import Servant.API.ReqBody ( ReqBody ) import Servant.API.ReqBody ( ReqBody )
import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag ) import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
@ -271,22 +271,22 @@ instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
-- QueryParam instances -- QueryParam instances
instance (KnownSymbol sym, ToText v, HasLink sub) instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
=> HasLink (QueryParam sym v :> sub) where => HasLink (QueryParam sym v :> sub) where
type MkLink (QueryParam sym v :> sub) = Maybe v -> MkLink sub type MkLink (QueryParam sym v :> sub) = Maybe v -> MkLink sub
toLink _ l mv = toLink _ l mv =
toLink (Proxy :: Proxy sub) $ toLink (Proxy :: Proxy sub) $
maybe id (addQueryParam . SingleParam k . toText) mv l maybe id (addQueryParam . SingleParam k . toQueryParam) mv l
where where
k :: String k :: String
k = symbolVal (Proxy :: Proxy sym) k = symbolVal (Proxy :: Proxy sym)
instance (KnownSymbol sym, ToText v, HasLink sub) instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
=> HasLink (QueryParams sym v :> sub) where => HasLink (QueryParams sym v :> sub) where
type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub
toLink _ l = toLink _ l =
toLink (Proxy :: Proxy sub) . toLink (Proxy :: Proxy sub) .
foldl' (\l' v -> addQueryParam (ArrayElemParam k (toText v)) l') l foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
where where
k = symbolVal (Proxy :: Proxy sym) k = symbolVal (Proxy :: Proxy sym)
@ -301,21 +301,21 @@ instance (KnownSymbol sym, HasLink sub)
k = symbolVal (Proxy :: Proxy sym) k = symbolVal (Proxy :: Proxy sym)
-- MatrixParam instances -- MatrixParam instances
instance (KnownSymbol sym, ToText v, HasLink sub) instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
=> HasLink (MatrixParam sym v :> sub) where => HasLink (MatrixParam sym v :> sub) where
type MkLink (MatrixParam sym v :> sub) = Maybe v -> MkLink sub type MkLink (MatrixParam sym v :> sub) = Maybe v -> MkLink sub
toLink _ l mv = toLink _ l mv =
toLink (Proxy :: Proxy sub) $ toLink (Proxy :: Proxy sub) $
maybe id (addMatrixParam . SingleParam k . toText) mv l maybe id (addMatrixParam . SingleParam k . toQueryParam) mv l
where where
k = symbolVal (Proxy :: Proxy sym) k = symbolVal (Proxy :: Proxy sym)
instance (KnownSymbol sym, ToText v, HasLink sub) instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
=> HasLink (MatrixParams sym v :> sub) where => HasLink (MatrixParams sym v :> sub) where
type MkLink (MatrixParams sym v :> sub) = [v] -> MkLink sub type MkLink (MatrixParams sym v :> sub) = [v] -> MkLink sub
toLink _ l = toLink _ l =
toLink (Proxy :: Proxy sub) . toLink (Proxy :: Proxy sub) .
foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toText v)) l') l foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toQueryParam v)) l') l
where where
k = symbolVal (Proxy :: Proxy sym) k = symbolVal (Proxy :: Proxy sym)
@ -334,12 +334,12 @@ instance HasLink sub => HasLink (ReqBody ct a :> sub) where
type MkLink (ReqBody ct a :> sub) = MkLink sub type MkLink (ReqBody ct a :> sub) = MkLink sub
toLink _ = toLink (Proxy :: Proxy sub) toLink _ = toLink (Proxy :: Proxy sub)
instance (ToText v, HasLink sub) instance (ToHttpApiData v, HasLink sub)
=> HasLink (Capture sym v :> sub) where => HasLink (Capture sym v :> sub) where
type MkLink (Capture sym v :> sub) = v -> MkLink sub type MkLink (Capture sym v :> sub) = v -> MkLink sub
toLink _ l v = toLink _ l v =
toLink (Proxy :: Proxy sub) $ toLink (Proxy :: Proxy sub) $
addSegment (escape . unpack $ toText v) l addSegment (escape . unpack $ toUrlPiece v) l
instance HasLink sub => HasLink (Header sym a :> sub) where instance HasLink sub => HasLink (Header sym a :> sub) where
type MkLink (Header sym a :> sub) = MkLink sub type MkLink (Header sym a :> sub) = MkLink sub

View file

@ -1,74 +0,0 @@
{-# LANGUAGE CPP #-}
module Servant.Common.TextSpec where
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Text (Text)
import Data.Word (Word16, Word32, Word64, Word8
#if !MIN_VERSION_base(4,8,0)
, Word
#endif
)
import Servant.Common.Text
import Test.Hspec
import Test.QuickCheck
import Test.QuickCheck.Instances ()
spec :: Spec
spec = describe "Servant.Common.Text" $ do
context "FromText and ToText laws" $ do
it "holds for Text" $
property $ \x -> textLaw (x :: Text)
it "holds for String" $
property $ \x -> textLaw (x :: String)
it "holds for Bool" $
property $ \x -> textLaw (x :: Bool)
it "holds for Int" $
property $ \x -> textLaw (x :: Int)
it "holds for Int8" $
property $ \x -> textLaw (x :: Int8)
it "holds for Int16" $
property $ \x -> textLaw (x :: Int16)
it "holds for Int32" $
property $ \x -> textLaw (x :: Int32)
it "holds for Int64" $
property $ \x -> textLaw (x :: Int64)
it "holds for Word" $
property $ \x -> textLaw (x :: Word)
it "holds for Word8" $
property $ \x -> textLaw (x :: Word8)
it "holds for Word16" $
property $ \x -> textLaw (x :: Word16)
it "holds for Word32" $
property $ \x -> textLaw (x :: Word32)
it "holds for Word64" $
property $ \x -> textLaw (x :: Word64)
it "holds for Integer" $
property $ \x -> textLaw (x :: Integer)
-- The following two properties are only reasonably expected to hold up
-- to a certain precision.
--
-- http://en.wikipedia.org/wiki/Floating_point#Internal_representation
it "holds for Double" $
property $ \x -> textLaw (x :: Double)
it "holds for Float" $
property $ \x -> textLaw (x :: Float)
textLaw :: (FromText a, ToText a, Eq a) => a -> Bool
textLaw a = fromText (toText a) == Just a

View file

@ -21,4 +21,5 @@ extra-deps:
- socket-io-1.3.3 - socket-io-1.3.3
- stm-delay-0.1.1.1 - stm-delay-0.1.1.1
- control-monad-omega-0.3.1 - control-monad-omega-0.3.1
- http-api-data-0.1.0
resolver: lts-2.22 resolver: lts-2.22

View file

@ -16,4 +16,5 @@ packages:
extra-deps: extra-deps:
- engine-io-wai-1.0.2 - engine-io-wai-1.0.2
- control-monad-omega-0.3.1 - control-monad-omega-0.3.1
- http-api-data-0.1.0
resolver: nightly-2015-09-10 resolver: nightly-2015-09-10