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

Merge pull request #250 from fizruk/http-api-data

Browse source 
Use http-api-data
This commit is contained in:
Julian Arni 2015-10-08 23:16:09 +01:00
commit 3ce7c9758a
20 changed files with 78 additions and 299 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client/CHANGELOG.md
View file

@ -5,6 +5,7 @@ HEAD
* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
* Added support for `path` on `BaseUrl`.
* `client` now takes an explicit `Manager` argument.
* Use `http-api-data` instead of `Servant.Common.Text`
0.4.1
-----

1
servant-client/servant-client.cabal
View file

@ -34,6 +34,7 @@ library
, attoparsec
, bytestring
, exceptions
, http-api-data >= 0.1 && < 0.2
, http-client
, http-client-tls
, http-media

36
servant-client/src/Servant/Client.hs
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.
--
-- 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:
--
@ -105,7 +105,7 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
-- > getBook = client myApi host manager
-- > where host = BaseUrl Http "localhost" 8080
-- > -- 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
type Client (Capture capture a :> sublayout) =
@ -117,7 +117,7 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)
baseurl
manager
where p = unpack (toText val)
where p = unpack (toUrlPiece val)
-- | If you have a 'Delete' endpoint in your API, the 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
-- 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:
--
-- > newtype Referer = Referer { referrer :: Text }
-- > deriving (Eq, Show, Generic, FromText, ToText)
-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
-- >
-- > -- GET /view-my-referer
-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
@ -223,7 +223,7 @@ instance
-- > where host = BaseUrl Http "localhost" 8080
-- > -- then you can just use "viewRefer" to query that endpoint
-- > -- 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
type Client (Header sym a :> sublayout) =
@ -368,7 +368,7 @@ instance
-- of inserting a textual representation of this value in the query string.
--
-- 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:
--
@ -383,7 +383,7 @@ instance
-- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books
-- > -- '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
type Client (QueryParam sym a :> sublayout) =
@ -401,7 +401,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
where pname = cs pname'
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,
-- 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.
--
-- 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:
--
@ -431,7 +431,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- > -- 'getBooksBy []' for all books
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. 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
type Client (QueryParams sym a :> sublayout) =
@ -447,7 +447,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
where pname = cs pname'
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,
-- 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.
--
-- 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:
--
@ -513,7 +513,7 @@ instance (KnownSymbol sym, HasClient sublayout)
-- > -- then you can just use "getBooksBy" to query that endpoint.
-- > -- 'getBooksBy Nothing' for all books
-- > -- '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
type Client (MatrixParam sym a :> sublayout) =
@ -529,7 +529,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
baseurl manager
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,
-- the corresponding querying function will automatically take an
@ -543,7 +543,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- same matrix string parameter name.
--
-- 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:
--
@ -559,7 +559,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- > -- 'getBooksBy []' for all books
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. 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
type Client (MatrixParams sym a :> sublayout) =
@ -575,7 +575,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
where pname = cs pname'
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,
-- the corresponding querying function will automatically take an

7
servant-client/src/Servant/Common/Req.hs
View file

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

12
servant-mock/src/Servant/Mock.hs
View file

@ -107,7 +107,7 @@ instance (HasMock a, HasMock b) => HasMock (a :<|> b) where
instance (KnownSymbol path, HasMock rest) => HasMock (path :> rest) where
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)
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
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
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
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, HasMock rest) => HasMock (QueryFlag s :> rest) where
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
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
mock _ = \_ -> mock (Proxy :: Proxy rest)
instance (KnownSymbol s, HasMock rest) => HasMock (MatrixFlag s :> rest) where
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)
instance (Arbitrary a, AllCTRender ctypes a) => HasMock (Delete ctypes a) where

1
servant-server/CHANGELOG.md
View file

@ -3,6 +3,7 @@ HEAD
* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
* Drop `EitherT` in favor of `ExceptT`
* Use `http-api-data` instead of `Servant.Common.Text`
0.4.1
-----

1
servant-server/servant-server.cabal
View file

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

3
servant-server/src/Servant.hs
View file

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

50
servant-server/src/Servant/Server/Internal.hs
View file

@ -32,7 +32,7 @@ import Data.String (fromString)
import Data.String.Conversions (cs, (<>), ConvertibleStrings)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text.Encoding (encodeUtf8)
import Data.Typeable
import GHC.TypeLits (KnownSymbol, symbolVal)
import Network.HTTP.Types hiding (Header, ResponseHeaders)
@ -53,13 +53,15 @@ import Servant.API.ContentTypes (AcceptHeader (..),
AllCTUnrender (..))
import Servant.API.ResponseHeaders (Headers, getResponse, GetHeaders,
getHeaders)
import Servant.Common.Text (FromText, fromText)
import Servant.Server.Internal.PathInfo
import Servant.Server.Internal.Router
import Servant.Server.Internal.RoutingApplication
import Servant.Server.Internal.ServantErr
import Web.HttpApiData (FromHttpApiData)
import Web.HttpApiData.Internal (parseUrlPieceMaybe, parseHeaderMaybe, parseQueryParamMaybe)
class HasServer layout where
type ServerT layout (m :: * -> *) :: *
@ -89,8 +91,8 @@ instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
where pa = Proxy :: Proxy a
pb = Proxy :: Proxy b
captured :: FromText a => proxy (Capture sym a) -> Text -> Maybe a
captured _ = fromText
captured :: FromHttpApiData a => proxy (Capture sym a) -> Text -> Maybe a
captured _ = parseUrlPieceMaybe
-- | If you use 'Capture' in one of the endpoints for your API,
-- 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.
--
-- 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:
--
@ -109,7 +111,7 @@ captured _ = fromText
-- > server = getBook
-- > where getBook :: Text -> ExceptT ServantErr IO Book
-- > getBook isbn = ...
instance (KnownSymbol capture, FromText a, HasServer sublayout)
instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout)
=> HasServer (Capture capture a :> sublayout) where
type ServerT (Capture capture a :> sublayout) m =
@ -282,12 +284,12 @@ instance
-- This lets servant worry about extracting it from the request and turning
-- 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:
--
-- > newtype Referer = Referer Text
-- > deriving (Eq, Show, FromText, ToText)
-- > deriving (Eq, Show, FromHttpApiData, ToText)
-- >
-- > -- GET /view-my-referer
-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
@ -296,14 +298,14 @@ instance
-- > server = viewReferer
-- > where viewReferer :: Referer -> ExceptT ServantErr IO 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
type ServerT (Header sym a :> sublayout) m =
Maybe a -> ServerT sublayout m
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)
where str = fromString $ symbolVal (Proxy :: Proxy sym)
@ -451,7 +453,7 @@ instance
-- hand you 'Nothing'.
--
-- 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:
--
@ -462,7 +464,7 @@ instance
-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
-- > getBooksBy Nothing = ...return all books...
-- > 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
type ServerT (QueryParam sym a :> sublayout) m =
@ -474,7 +476,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
case lookup paramname querytext of
Nothing -> Nothing -- param absent from the query string
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
in route (Proxy :: Proxy sublayout) (feedTo subserver param)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
@ -488,7 +490,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- the type you specify.
--
-- 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:
--
@ -498,7 +500,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- > server = getBooksBy
-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
-- > 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
type ServerT (QueryParams sym a :> sublayout) m =
@ -507,7 +509,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
route Proxy subserver = WithRequest $ \ request ->
let querytext = parseQueryText $ rawQueryString request
-- 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
parameters = filter looksLikeParam querytext
values = mapMaybe (convert . snd) parameters
@ -515,7 +517,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
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,
-- this automatically requires your server-side handler to be a function
@ -559,7 +561,7 @@ parseMatrixText = parseQueryText
-- hand you 'Nothing'.
--
-- 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:
--
@ -570,7 +572,7 @@ parseMatrixText = parseQueryText
-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]
-- > getBooksBy Nothing = ...return all books...
-- > 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
type ServerT (MatrixParam sym a :> sublayout) m =
@ -583,7 +585,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
param = case lookup paramname querytext of
Nothing -> Nothing -- param absent from the query string
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
route (Proxy :: Proxy sublayout) (feedTo subserver param)
_ -> route (Proxy :: Proxy sublayout) (feedTo subserver Nothing)
@ -599,7 +601,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- the type you specify.
--
-- 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:
--
@ -609,7 +611,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- > server = getBooksBy
-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]
-- > 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
type ServerT (MatrixParams sym a :> sublayout) m =
@ -620,7 +622,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
(first : _)
-> do let matrixtext = parseMatrixText . encodeUtf8 $ T.tail first
-- 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
parameters = filter looksLikeParam matrixtext
values = mapMaybe (convert . snd) parameters
@ -629,7 +631,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
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,
-- this automatically requires your server-side handler to be a function

3
servant/CHANGELOG.md
View file

@ -3,7 +3,8 @@ HEAD
* Add `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
* Fix safeLink, so Header is not in fact required.
* Added more instances for (:<|>)
* Add more instances for (:<|>)
* Use `http-api-data` instead of `Servant.Common.Text`
0.4.2
-----

3
servant/servant.cabal
View file

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

8
servant/src/Servant/API.hs
View file

@ -50,9 +50,9 @@ module Servant.API (
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@
-- * FromHttpApiData and ToHttpApiData
module Web.HttpApiData,
-- | Classes and instances for types that can be converted to and from HTTP API data.
-- * Utilities
module Servant.Utils.Links,
@ -88,7 +88,7 @@ import Servant.API.ResponseHeaders (AddHeader (addHeader),
getHeadersHList, getResponse)
import Servant.API.Sub ((:>))
import Servant.API.Vault (Vault)
import Servant.Common.Text (FromText (..), ToText (..))
import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))
import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
URI (..), safeLink)

1
servant/src/Servant/API/Header.hs
View file

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

1
servant/src/Servant/API/ReqBody.hs
View file

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

1
servant/src/Servant/API/Sub.hs
View file

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

149
servant/src/Servant/Common/Text.hs
View file

@ -1,149 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Servant.Common.Text
( FromText(..)
, ToText(..)
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
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 (Word16, Word32, Word64, Word8
#if !MIN_VERSION_base(4,8,0)
, Word
#endif
)
-- | For getting values from url captures and query string parameters
-- Instances should obey:
-- > fromText (toText a) == Just a
class FromText a where
fromText :: Text -> Maybe a
-- | For putting values in paths and query string parameters
-- Instances should obey:
-- > fromText (toText a) == Just a
class ToText a where
toText :: a -> Text
instance FromText Text where
fromText = Just
instance ToText Text where
toText = id
instance FromText String where
fromText = Just . cs
instance ToText String where
toText = cs
-- |
-- >>> 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"
instance ToText Bool where
toText True = "true"
toText False = "false"
instance FromText Int where
fromText = runReader (signed decimal)
instance ToText Int where
toText = cs . show
instance FromText Int8 where
fromText = runReader (signed decimal)
instance ToText Int8 where
toText = cs . show
instance FromText Int16 where
fromText = runReader (signed decimal)
instance ToText Int16 where
toText = cs . show
instance FromText Int32 where
fromText = runReader (signed decimal)
instance ToText Int32 where
toText = cs . show
instance FromText Int64 where
fromText = runReader (signed decimal)
instance ToText Int64 where
toText = cs . show
instance FromText Word where
fromText = runReader decimal
instance ToText Word where
toText = cs . show
instance FromText Word8 where
fromText = runReader decimal
instance ToText Word8 where
toText = cs . show
instance FromText Word16 where
fromText = runReader decimal
instance ToText Word16 where
toText = cs . show
instance FromText Word32 where
fromText = runReader decimal
instance ToText Word32 where
toText = cs . show
instance FromText Word64 where
fromText = runReader decimal
instance ToText Word64 where
toText = cs . show
instance FromText Integer where
fromText = runReader (signed decimal)
instance ToText Integer where
toText = cs . show
instance FromText Double where
fromText x = fromRational <$> runReader rational x
instance ToText Double where
toText = cs . show
instance FromText Float where
-- Double is more practically accurate due to weird rounding when using
-- rational. We convert to double and then convert to Float.
fromText x = fromRational <$> runReader rational x
instance ToText Float where
toText = cs . show
runReader :: Reader a -> Text -> Maybe a
runReader reader t = either (const Nothing) (Just . fst) $ reader t

22
servant/src/Servant/Utils/Links.hs
View file

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

74
servant/test/Servant/Common/TextSpec.hs
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

1
stack-ghc-7.8.4.yaml
View file

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

2
stack.yaml
View file

@ -16,4 +16,4 @@ packages:
extra-deps:
- engine-io-wai-1.0.2
- control-monad-omega-0.3.1
resolver: nightly-2015-09-10
resolver: nightly-2015-10-08