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

Merge pull request #50 from haskell-servant/jkarni/sundry-cleanup

Browse Source 
Sundry cleanup
This commit is contained in:
Julian Arni 2015-04-22 18:10:06 +02:00
commit 6651df574a
35 changed files with 449 additions and 162 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
.travis.yml
View File

@ -1,11 +1,19 @@
language: haskell language: haskell
ghc: env:
- 7.8 - CABALVER=1.18 GHCVER=7.8.4
- CABALVER=1.22 GHCVER=7.10.1
before_install:
- travis_retry sudo add-apt-repository -y ppa:hvr/ghc
- travis_retry sudo apt-get update
- travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- travis_retry cabal update
install: install:
- ghc --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
- cabal --version - cabal --version
script: script:
- ./scripts/test-all.sh - ./scripts/test-all.sh

10
servant/README.md → README.md
View File

@ -21,8 +21,8 @@ We've written a [Getting Started](http://haskell-servant.github.io/getting-start
## Repositories and Haddocks ## Repositories and Haddocks
- The core [servant](http://github.com/haskell-servant) package - [docs](http://hackage.haskell.org/package/servant) - The core [servant](http://github.com/haskell-servant/tree/master/servant) package - [docs](http://hackage.haskell.org/package/servant)
- Implementing an HTTP server for a webservice API with [servant-server](http://github.com/haskell-servant/servant-server) - [docs](http://hackage.haskell.org/package/servant-server) - Implementing an HTTP server for a webservice API with [servant-server](http://github.com/haskell-servant/servant/tree/master/servant-server) - [docs](http://hackage.haskell.org/package/servant-server)
- (Haskell) client-side function generation with [servant-client](http://github.com/haskell-servant/servant-client) - [docs](http://hackage.haskell.org/package/servant-client) - (Haskell) client-side function generation with [servant-client](http://github.com/haskell-servant/servant/tree/master/servant-client) - [docs](http://hackage.haskell.org/package/servant-client)
- (Javascript) client-side function generation with [servant-jquery](http://github.com/haskell-servant/servant-jquery) - [docs](http://hackage.haskell.org/package/servant-jquery) - (Javascript) client-side function generation with [servant-jquery](http://github.com/haskell-servant/servant/tree/master/servant-jquery) - [docs](http://hackage.haskell.org/package/servant-jquery)
- API docs generation with [servant-docs](http://github.com/haskell-servant/servant-docs) - [docs](http://hackage.haskell.org/package/servant-docs) - API docs generation with [servant-docs](http://github.com/haskell-servant/servant/tree/master/servant-docs) - [docs](http://hackage.haskell.org/package/servant-docs)

20
scripts/shell.nix Normal file
View File

@ -0,0 +1,20 @@
# Get a Nix shell with all the packages installed
# Also a good way of running the tests for all packages
with (import <nixpkgs> {}).pkgs;
let modifiedHaskellPackages = haskellngPackages.override {
overrides = with haskell-ng.lib ; self: super: {
servant = appendConfigureFlag ( self.callPackage ../servant {} )
"--ghc-options=-Werror";
servant-server = appendConfigureFlag (self.callPackage
../servant-server {}) "--ghc-options=-Werror";
servant-client = appendConfigureFlag (self.callPackage
../servant-client {}) "--ghc-options=-Werror";
servant-jquery = appendConfigureFlag (self.callPackage
../servant-jquery {}) "--ghc-options=-Werror";
servant-docs = appendConfigureFlag (self.callPackage ../servant-docs
{}) "--ghc-options=-Werror";
};
};
in modifiedHaskellPackages.ghcWithPackages ( p : with p ; [
servant servant-server servant-client servant-jquery servant-docs
])

24
scripts/test-all.sh
View File

@ -8,21 +8,25 @@
# DESCRIPTION: Run tests for all source directories listed in $SOURCES. # DESCRIPTION: Run tests for all source directories listed in $SOURCES.
# Uses local versions of those sources. # Uses local versions of those sources.
# #
# REQUIREMENTS: bash >= 4
#=============================================================================== #===============================================================================
set -o nounset set -o nounset
set -o errexit set -o errexit
SOURCES=( servant servant-server servant-client servant-jquery servant-docs ) DIR=$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )
GHC_FLAGS="-Werror" GHC_FLAGS="-Werror"
SOURCES_TXT="$( dirname $DIR)/sources.txt"
CABAL=${CABAL:-cabal}
declare -a SOURCES
readarray -t SOURCES < "$SOURCES_TXT"
prepare_sandbox () { prepare_sandbox () {
cabal sandbox init $CABAL sandbox init
for s in ${SOURCES[@]} ; do for s in ${SOURCES[@]} ; do
cd "$s" (cd "$s" && $CABAL sandbox init --sandbox=../ && $CABAL sandbox add-source .)
cabal sandbox init --sandbox=../
cabal sandbox add-source .
cd ..
done done
} }
@ -30,10 +34,10 @@ test_each () {
for s in ${SOURCES[@]} ; do for s in ${SOURCES[@]} ; do
echo "Testing $s..." echo "Testing $s..."
cd "$s" cd "$s"
cabal install --only-dependencies --enable-tests $CABAL install --only-dependencies --enable-tests
cabal configure --enable-tests --ghc-options="$GHC_FLAGS" $CABAL configure --enable-tests --ghc-options="$GHC_FLAGS"
cabal build $CABAL build
cabal test $CABAL test
cd .. cd ..
done done
} }

24
scripts/update-defaults-nix.sh Executable file
View File

@ -0,0 +1,24 @@
#!/bin/bash -
#===============================================================================
#
# USAGE: ./update-defaults-nix.sh
#
# DESCRIPTION: Updates the default.nix files in all source dirs
#
# REQUIREMENTS: cabal2nix, bash >= 4
#===============================================================================
set -o nounset
set -o errexit
DIR=$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )
BASE_DIR="$( dirname $DIR)"
SOURCES_TXT="$BASE_DIR/sources.txt"
declare -a SOURCES
readarray -t SOURCES < "$SOURCES_TXT"
for s in ${SOURCES[@]} ; do
echo $s
(cd "$BASE_DIR/$s" && cabal2nix . > default.nix )
done

5
servant-client/README.md
View File

@ -1,8 +1,5 @@
# servant-client # servant-client
[![Build Status](https://secure.travis-ci.org/haskell-servant/servant-client.svg)](http://travis-ci.org/haskell-servant/servant-client)
[![Coverage Status](https://coveralls.io/repos/haskell-servant/servant-client/badge.svg)](https://coveralls.io/r/haskell-servant/servant-client)
![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) ![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
This library lets you automatically derive Haskell functions that let you query each endpoint of a *servant* webservice. This library lets you automatically derive Haskell functions that let you query each endpoint of a *servant* webservice.
@ -20,4 +17,4 @@ getAllBooks :: BaseUrl -> EitherT String IO [Book]
postNewBook :: Book -> BaseUrl -> EitherT String IO Book postNewBook :: Book -> BaseUrl -> EitherT String IO Book
-- 'client' allows you to produce operations to query an API from a client. -- 'client' allows you to produce operations to query an API from a client.
(getAllBooks :<|> postNewBook) = client myApi (getAllBooks :<|> postNewBook) = client myApi
``` ```

24
servant-client/default.nix Normal file
View File

@ -0,0 +1,24 @@
{ mkDerivation, aeson, attoparsec, base, bytestring, deepseq
, either, exceptions, hspec, http-client, http-client-tls
, http-media, http-types, HUnit, network, network-uri, QuickCheck
, safe, servant, servant-server, stdenv, string-conversions, text
, transformers, wai, warp
}:
mkDerivation {
pname = "servant-client";
version = "0.2.2";
src = ./.;
buildDepends = [
aeson attoparsec base bytestring either exceptions http-client
http-client-tls http-media http-types network-uri safe servant
string-conversions text transformers
];
testDepends = [
aeson base bytestring deepseq either hspec http-client http-media
http-types HUnit network QuickCheck servant servant-server text wai
warp
];
homepage = "http://haskell-servant.github.io/";
description = "automatical derivation of querying functions for servant webservices";
license = stdenv.lib.licenses.bsd3;
}

6
servant-client/servant-client.cabal
View File

@ -16,6 +16,8 @@ description:
> getAllBooks :: BaseUrl -> EitherT String IO [Book] > getAllBooks :: BaseUrl -> EitherT String IO [Book]
> postNewBook :: Book -> BaseUrl -> EitherT String IO Book > postNewBook :: Book -> BaseUrl -> EitherT String IO Book
> (getAllBooks :<|> postNewBook) = client myApi > (getAllBooks :<|> postNewBook) = client myApi
.
<https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md CHANGELOG>
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni
@ -26,10 +28,10 @@ build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
tested-with: GHC >= 7.8 tested-with: GHC >= 7.8
homepage: http://haskell-servant.github.io/ homepage: http://haskell-servant.github.io/
Bug-reports: http://github.com/haskell-servant/servant-client/issues Bug-reports: http://github.com/haskell-servant/servant/issues
source-repository head source-repository head
type: git type: git
location: http://github.com/haskell-servant/servant-client.git location: http://github.com/haskell-servant/servant.git
library library
exposed-modules: exposed-modules:

97
servant-client/src/Servant/Client.hs
View File

@ -1,12 +1,15 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE ScopedTypeVariables #-} #endif
-- | This module provides 'client' which can automatically generate -- | This module provides 'client' which can automatically generate
-- querying functions for each endpoint just from the type representing your -- querying functions for each endpoint just from the type representing your
-- API. -- API.
@ -18,21 +21,21 @@ module Servant.Client
, module Servant.Common.BaseUrl , module Servant.Common.BaseUrl
) where ) where
import Control.Monad import Control.Monad
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
import Data.List import Data.List
import Data.Proxy import Data.Proxy
import Data.String.Conversions import Data.String.Conversions
import Data.Text (unpack) import Data.Text (unpack)
import GHC.TypeLits import GHC.TypeLits
import Network.HTTP.Client (Response) import Network.HTTP.Client (Response)
import Network.HTTP.Media import Network.HTTP.Media
import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types as H
import Servant.API import Servant.API
import Servant.API.ContentTypes import Servant.API.ContentTypes
import Servant.Common.BaseUrl import Servant.Common.BaseUrl
import Servant.Common.Req import Servant.Common.Req
-- * Accessing APIs as a Client -- * Accessing APIs as a Client
@ -123,14 +126,22 @@ instance HasClient Delete where
-- side querying function that is created when calling 'client' -- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host -- will just require an argument that specifies the scheme, host
-- and port to send the request to. -- and port to send the request to.
instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
type Client' (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result type Client' (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] host performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] host
-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content -- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content
-- HTTP header. -- HTTP header.
instance HasClient (Get (ct ': cts) ()) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasClient (Get (ct ': cts) ()) where
type Client' (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () type Client' (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
performRequestNoBody H.methodGet req [204] host performRequestNoBody H.methodGet req [204] host
@ -176,7 +187,11 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- side querying function that is created when calling 'client' -- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host -- will just require an argument that specifies the scheme, host
-- and port to send the request to. -- and port to send the request to.
instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
type Client' (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a type Client' (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req uri = clientWithRoute Proxy req uri =
@ -184,7 +199,11 @@ instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content -- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content
-- HTTP header. -- HTTP header.
instance HasClient (Post (ct ': cts) ()) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasClient (Post (ct ': cts) ()) where
type Client' (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () type Client' (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
void $ performRequestNoBody H.methodPost req [204] host void $ performRequestNoBody H.methodPost req [204] host
@ -193,7 +212,11 @@ instance HasClient (Post (ct ': cts) ()) where
-- side querying function that is created when calling 'client' -- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host -- will just require an argument that specifies the scheme, host
-- and port to send the request to. -- and port to send the request to.
instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
type Client' (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a type Client' (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
@ -201,7 +224,11 @@ instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content -- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content
-- HTTP header. -- HTTP header.
instance HasClient (Put (ct ': cts) ()) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasClient (Put (ct ': cts) ()) where
type Client' (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () type Client' (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
void $ performRequestNoBody H.methodPut req [204] host void $ performRequestNoBody H.methodPut req [204] host
@ -210,7 +237,11 @@ instance HasClient (Put (ct ': cts) ()) where
-- side querying function that is created when calling 'client' -- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host -- will just require an argument that specifies the scheme, host
-- and port to send the request to. -- and port to send the request to.
instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
(MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
type Client' (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a type Client' (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
@ -218,7 +249,11 @@ instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content -- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content
-- HTTP header. -- HTTP header.
instance HasClient (Patch (ct ': cts) ()) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasClient (Patch (ct ': cts) ()) where
type Client' (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () type Client' (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
void $ performRequestNoBody H.methodPatch req [204] host void $ performRequestNoBody H.methodPatch req [204] host

5
servant-client/src/Servant/Common/Req.hs
View File

@ -1,8 +1,11 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Servant.Common.Req where module Servant.Common.Req where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative import Control.Applicative
#endif
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.Catch (MonadThrow) import Control.Monad.Catch (MonadThrow)

7
servant-client/test/Servant/ClientSpec.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -10,7 +11,9 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.ClientSpec where module Servant.ClientSpec where
import Control.Applicative #if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import qualified Control.Arrow as Arrow import qualified Control.Arrow as Arrow
import Control.Concurrent import Control.Concurrent
import Control.Exception import Control.Exception
@ -340,6 +343,6 @@ pathGen :: Gen (NonEmptyList Char)
pathGen = fmap NonEmpty path pathGen = fmap NonEmpty path
where where
path = listOf1 $ elements $ path = listOf1 $ elements $
filter (not . (`elem` "?%[]/#;")) $ filter (not . (`elem` ("?%[]/#;" :: String))) $
filter isPrint $ filter isPrint $
map chr [0..127] map chr [0..127]

3
servant-client/test/Servant/Common/BaseUrlSpec.hs
View File

@ -1,7 +1,10 @@
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.Common.BaseUrlSpec where module Servant.Common.BaseUrlSpec where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative import Control.Applicative
#endif
import Control.DeepSeq import Control.DeepSeq
import Test.Hspec import Test.Hspec
import Test.QuickCheck import Test.QuickCheck

4
servant-docs/README.md
View File

@ -1,14 +1,12 @@
# servant-docs # servant-docs
[![Build Status](https://secure.travis-ci.org/haskell-servant/servant-docs.svg)](http://travis-ci.org/haskell-servant/servant-docs)
![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) ![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
Generate API docs for your *servant* webservice. Feel free to also take a look at [servant-pandoc](https://github.com/mpickering/servant-pandoc) which uses this package to target a broad range of output formats using the excellent **pandoc**. Generate API docs for your *servant* webservice. Feel free to also take a look at [servant-pandoc](https://github.com/mpickering/servant-pandoc) which uses this package to target a broad range of output formats using the excellent **pandoc**.
## Example ## Example
See [here](https://github.com/haskell-servant/servant-docs/blob/master/example/greet.md) for the output of the following program. See [here](https://github.com/haskell-servant/servant/tree/master/servant-docs/blob/master/example/greet.md) for the output of the following program.
``` haskell ``` haskell
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}

2
servant-docs/default.nix
View File

@ -12,7 +12,7 @@ mkDerivation {
aeson base bytestring hashable http-media lens servant aeson base bytestring hashable http-media lens servant
string-conversions text unordered-containers string-conversions text unordered-containers
]; ];
testDepends = [ aeson base hspec lens servant ]; testDepends = [ aeson base hspec servant string-conversions ];
homepage = "http://haskell-servant.github.io/"; homepage = "http://haskell-servant.github.io/";
description = "generate API docs for your servant webservice"; description = "generate API docs for your servant webservice";
license = stdenv.lib.licenses.bsd3; license = stdenv.lib.licenses.bsd3;

6
servant-docs/servant-docs.cabal
View File

@ -5,6 +5,8 @@ description:
Library for generating API docs from a servant API definition. Library for generating API docs from a servant API definition.
. .
Runnable example <https://github.com/haskell-servant/servant-docs/blob/master/example/greet.hs here>. Runnable example <https://github.com/haskell-servant/servant-docs/blob/master/example/greet.hs here>.
.
<https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md CHANGELOG>
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni
@ -15,13 +17,13 @@ build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
tested-with: GHC >= 7.8 tested-with: GHC >= 7.8
homepage: http://haskell-servant.github.io/ homepage: http://haskell-servant.github.io/
Bug-reports: http://github.com/haskell-servant/servant-docs/issues Bug-reports: http://github.com/haskell-servant/servant/issues
extra-source-files: extra-source-files:
CHANGELOG.md CHANGELOG.md
README.md README.md
source-repository head source-repository head
type: git type: git
location: http://github.com/haskell-servant/servant-docs.git location: http://github.com/haskell-servant/servant.git
library library
exposed-modules: exposed-modules:

3
servant-docs/src/Servant/Docs/Internal.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
@ -13,7 +14,9 @@
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
module Servant.Docs.Internal where module Servant.Docs.Internal where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative import Control.Applicative
#endif
import Control.Lens import Control.Lens
import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Hashable import Data.Hashable

9
servant-jquery/README.md
View File

@ -1,15 +1,12 @@
# servant-jquery # servant-jquery
[![Build Status](https://secure.travis-ci.org/haskell-servant/servant-jquery.svg)](http://travis-ci.org/haskell-servant/servant-jquery)
[![Coverage Status](https://coveralls.io/repos/haskell-servant/servant-jquery/badge.svg)](https://coveralls.io/r/haskell-servant/servant-jquery)
![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) ![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
This library lets you derive automatically (JQuery based) Javascript functions that let you query each endpoint of a *servant* webservice. This library lets you derive automatically (JQuery based) Javascript functions that let you query each endpoint of a *servant* webservice.
## Example ## Example
Read more about the following example [here](https://github.com/haskell-servant/servant-jquery/tree/master/examples#examples). Read more about the following example [here](https://github.com/haskell-servant/servant/tree/master/servant-jquery/tree/master/examples#examples).
``` haskell ``` haskell
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
@ -53,7 +50,7 @@ currentValue counter = liftIO $ readTVarIO counter
-- * Our API type -- * Our API type
type TestApi = "counter" :> Post Counter -- endpoint for increasing the counter type TestApi = "counter" :> Post Counter -- endpoint for increasing the counter
:<|> "counter" :> Get Counter -- endpoint to get the current value :<|> "counter" :> Get Counter -- endpoint to get the current value
:<|> Raw -- used for serving static files :<|> Raw -- used for serving static files
testApi :: Proxy TestApi testApi :: Proxy TestApi
testApi = Proxy testApi = Proxy
@ -94,4 +91,4 @@ main = do
-- listen to requests on port 8080 -- listen to requests on port 8080
runServer cnt 8080 runServer cnt 8080
``` ```

21
servant-jquery/default.nix Normal file
View File

@ -0,0 +1,21 @@
{ mkDerivation, aeson, base, charset, filepath, hspec
, hspec-expectations, language-ecmascript, lens, servant
, servant-server, stdenv, stm, text, transformers, warp
}:
mkDerivation {
pname = "servant-jquery";
version = "0.2.2";
src = ./.;
isLibrary = true;
isExecutable = true;
buildDepends = [
aeson base charset filepath lens servant servant-server stm text
transformers warp
];
testDepends = [
base hspec hspec-expectations language-ecmascript lens servant
];
homepage = "http://haskell-servant.github.io/";
description = "Automatically derive (jquery) javascript functions to query servant webservices";
license = stdenv.lib.licenses.bsd3;
}

11
servant-jquery/servant-jquery.cabal
View File

@ -4,8 +4,11 @@ synopsis: Automatically derive (jquery) javascript functions to query
description: description:
Automatically derive jquery-based javascript functions to query servant webservices. Automatically derive jquery-based javascript functions to query servant webservices.
. .
Example <https://github.com/haskell-servant/servant-jquery/blob/master/examples/counter.hs here> that serves the generated javascript to a webpage that lets you You can find an example <https://github.com/haskell-servant/servant/blob/master/servant-jquery/examples/counter.hs here>
trigger webservice calls. which serves the generated javascript to a webpage that allows you to trigger
webservice calls.
.
<https://github.com/haskell-servant/servant/blob/master/servant-jquery/CHANGELOG.md CHANGELOG>
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Alp Mestanogullari author: Alp Mestanogullari
@ -15,13 +18,13 @@ category: Web
build-type: Simple build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
homepage: http://haskell-servant.github.io/ homepage: http://haskell-servant.github.io/
Bug-reports: http://github.com/haskell-servant/servant-jquery/issues Bug-reports: http://github.com/haskell-servant/servant/issues
extra-source-files: extra-source-files:
CHANGELOG.md CHANGELOG.md
README.md README.md
source-repository head source-repository head
type: git type: git
location: http://github.com/haskell-servant/servant-jquery.git location: http://github.com/haskell-servant/servant.git
flag example flag example
description: Build the example too description: Build the example too

19
servant-jquery/src/Servant/JQuery/Internal.hs
View File

@ -1,15 +1,18 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
module Servant.JQuery.Internal where module Servant.JQuery.Internal where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative import Control.Applicative
#endif
import Control.Lens import Control.Lens
import Data.Char (toLower) import Data.Char (toLower)
import qualified Data.CharSet as Set import qualified Data.CharSet as Set

11
servant-server/README.md
View File

@ -1,8 +1,5 @@
# servant-server # servant-server
[![Build Status](https://secure.travis-ci.org/haskell-servant/servant-server.svg)](http://travis-ci.org/haskell-servant/servant-server)
[![Coverage Status](https://coveralls.io/repos/haskell-servant/servant-server/badge.svg)](https://coveralls.io/r/haskell-servant/servant-server)
![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png) ![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
This library lets you *implement* an HTTP server with handlers for each endpoint of a servant API, handling most of the boilerplate for you. This library lets you *implement* an HTTP server with handlers for each endpoint of a servant API, handling most of the boilerplate for you.
@ -14,7 +11,7 @@ We've written a [Getting Started](http://haskell-servant.github.io/getting-start
## Repositories and Haddocks ## Repositories and Haddocks
- The core [servant](http://github.com/haskell-servant) package - [docs](http://hackage.haskell.org/package/servant) - The core [servant](http://github.com/haskell-servant) package - [docs](http://hackage.haskell.org/package/servant)
- Implementing an HTTP server for a webservice API with [servant-server](http://github.com/haskell-servant/servant-server) - [docs](http://hackage.haskell.org/package/servant-server) - Implementing an HTTP server for a webservice API with [servant-server](http://github.com/haskell-servant/servant/tree/master/servant-server) - [docs](http://hackage.haskell.org/package/servant-server)
- (Haskell) client-side function generation with [servant-client](http://github.com/haskell-servant/servant-client) - [docs](http://hackage.haskell.org/package/servant-client) - (Haskell) client-side function generation with [servant-client](http://github.com/haskell-servant/servant/tree/master/servant-client) - [docs](http://hackage.haskell.org/package/servant-client)
- (Javascript) client-side function generation with [servant-jquery](http://github.com/haskell-servant/servant-jquery) - [docs](http://hackage.haskell.org/package/servant-jquery) - (Javascript) client-side function generation with [servant-jquery](http://github.com/haskell-servant/servant/tree/master/servant-jquery) - [docs](http://hackage.haskell.org/package/servant-jquery)
- API docs generation with [servant-docs](http://github.com/haskell-servant/servant-docs) - [docs](http://hackage.haskell.org/package/servant-docs) - API docs generation with [servant-docs](http://github.com/haskell-servant/servant/tree/master/servant-docs) - [docs](http://hackage.haskell.org/package/servant-docs)

39
servant-server/default.nix
View File

@ -1,15 +1,28 @@
{ pkgs ? import <nixpkgs> { config.allowUnfree = true; } { mkDerivation, aeson, attoparsec, base, bytestring
, src ? builtins.filterSource (path: type: , bytestring-conversion, directory, either, exceptions, hspec
type != "unknown" && , hspec-wai, http-types, network, network-uri, parsec, QuickCheck
baseNameOf path != ".git" && , safe, servant, split, stdenv, string-conversions, system-filepath
baseNameOf path != "result" && , temporary, text, transformers, wai, wai-app-static, wai-extra
baseNameOf path != "dist") ./. , warp
, servant ? import ../servant {}
}: }:
pkgs.haskellPackages.buildLocalCabalWithArgs { mkDerivation {
name = "servant-server"; pname = "servant-server";
inherit src; version = "0.2.4";
args = { src = ./.;
inherit servant; isLibrary = true;
}; isExecutable = true;
buildDepends = [
aeson attoparsec base bytestring either http-types network-uri safe
servant split string-conversions system-filepath text transformers
wai wai-app-static warp
];
testDepends = [
aeson base bytestring bytestring-conversion directory either
exceptions hspec hspec-wai http-types network parsec QuickCheck
servant string-conversions temporary text transformers wai
wai-extra warp
];
homepage = "http://haskell-servant.github.io/";
description = "A family of combinators for defining webservices APIs and serving them";
license = stdenv.lib.licenses.bsd3;
} }

12
servant-server/servant-server.cabal
View File

@ -4,12 +4,16 @@ synopsis: A family of combinators for defining webservices APIs and s
description: description:
A family of combinators for defining webservices APIs and serving them A family of combinators for defining webservices APIs and serving them
. .
You can learn about the basics in <http://haskell-servant.github.io/getting-started/ the getting started> guide. You can learn about the basics in <http://haskell-servant.github.io/getting-started/ the getting started>
guide.
. .
<https://github.com/haskell-servant/servant-server/blob/master/example/greet.hs Here>'s a runnable example, with comments, that defines a dummy API and <https://github.com/haskell-servant/servant/blob/master/servant-server/example/greet.hs Here>
implements a webserver that serves this API, using this package. is a runnable example, with comments, that defines a dummy API and implements
a webserver that serves this API, using this package.
.
<https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md CHANGELOG>
homepage: http://haskell-servant.github.io/ homepage: http://haskell-servant.github.io/
Bug-reports: http://github.com/haskell-servant/servant-server/issues Bug-reports: http://github.com/haskell-servant/servant/issues
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni author: Alp Mestanogullari, Sönke Hahn, Julian K. Arni

127
servant-server/src/Servant/Server/Internal.hs
View File

@ -1,22 +1,28 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-}
#endif
module Servant.Server.Internal where module Servant.Server.Internal where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Data.Monoid (Monoid, mappend, mempty)
#endif
import Control.Monad.Trans.Either (EitherT, runEitherT) import Control.Monad.Trans.Either (EitherT, runEitherT)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.IORef (newIORef, readIORef, writeIORef) import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (unfoldr) import Data.List (unfoldr)
import Data.Maybe (catMaybes, fromMaybe) import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid (Monoid, mappend, mempty)
import Data.String (fromString) import Data.String (fromString)
import Data.String.Conversions (cs, (<>)) import Data.String.Conversions (cs, (<>))
import Data.Text (Text) import Data.Text (Text)
@ -278,10 +284,13 @@ instance HasServer Delete where
-- If successfully returning a value, we use the type-level list, combined -- If successfully returning a value, we use the type-level list, combined
-- with the request's @Accept@ header, to encode the value for you -- with the request's @Accept@ header, to encode the value for you
-- (returning a status code of 200). If there was no @Accept@ header or it -- (returning a status code of 200). If there was no @Accept@ header or it
-- was @*/*@, we return encode using the first @Content-Type@ type on the -- was @*\/\*@, we return encode using the first @Content-Type@ type on the
-- list. -- list.
instance ( AllCTRender ctypes a instance
) => HasServer (Get ctypes a) where #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( AllCTRender ctypes a ) => HasServer (Get ctypes a) where
type ServerT' (Get ctypes a) m = m a type ServerT' (Get ctypes a) m = m a
@ -290,7 +299,7 @@ instance ( AllCTRender ctypes a
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
Just (contentT, body) -> succeedWith $ Just (contentT, body) -> succeedWith $
@ -302,8 +311,14 @@ instance ( AllCTRender ctypes a
| otherwise = respond $ failWith NotFound | otherwise = respond $ failWith NotFound
-- '()' ==> 204 No Content -- '()' ==> 204 No Content
instance HasServer (Get ctypes ()) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasServer (Get ctypes ()) where
type ServerT' (Get ctypes ()) m = m () type ServerT' (Get ctypes ()) m = m ()
route Proxy action request respond route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodGet = do | pathIsEmpty request && requestMethod request == methodGet = do
e <- runEitherT action e <- runEitherT action
@ -316,14 +331,20 @@ instance HasServer (Get ctypes ()) where
| otherwise = respond $ failWith NotFound | otherwise = respond $ failWith NotFound
-- Add response headers -- Add response headers
instance ( AllCTRender ctypes v ) => HasServer (Get ctypes (Headers h v)) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( AllCTRender ctypes v ) => HasServer (Get ctypes (Headers h v)) where
type ServerT' (Get ctypes (Headers h v)) m = m (Headers h v) type ServerT' (Get ctypes (Headers h v)) m = m (Headers h v)
route Proxy action request respond route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodGet = do | pathIsEmpty request && requestMethod request == methodGet = do
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
headers = getHeaders output headers = getHeaders output
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
@ -378,9 +399,13 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- If successfully returning a value, we use the type-level list, combined -- If successfully returning a value, we use the type-level list, combined
-- with the request's @Accept@ header, to encode the value for you -- with the request's @Accept@ header, to encode the value for you
-- (returning a status code of 201). If there was no @Accept@ header or it -- (returning a status code of 201). If there was no @Accept@ header or it
-- was @*/*@, we return encode using the first @Content-Type@ type on the -- was @*\/\*@, we return encode using the first @Content-Type@ type on the
-- list. -- list.
instance ( AllCTRender ctypes a instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( AllCTRender ctypes a
) => HasServer (Post ctypes a) where ) => HasServer (Post ctypes a) where
type ServerT' (Post ctypes a) m = m a type ServerT' (Post ctypes a) m = m a
@ -390,7 +415,7 @@ instance ( AllCTRender ctypes a
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
Just (contentT, body) -> succeedWith $ Just (contentT, body) -> succeedWith $
@ -401,8 +426,14 @@ instance ( AllCTRender ctypes a
respond $ failWith WrongMethod respond $ failWith WrongMethod
| otherwise = respond $ failWith NotFound | otherwise = respond $ failWith NotFound
instance HasServer (Post ctypes ()) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasServer (Post ctypes ()) where
type ServerT' (Post ctypes ()) m = m () type ServerT' (Post ctypes ()) m = m ()
route Proxy action request respond route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPost = do | pathIsEmpty request && requestMethod request == methodPost = do
e <- runEitherT action e <- runEitherT action
@ -415,14 +446,20 @@ instance HasServer (Post ctypes ()) where
| otherwise = respond $ failWith NotFound | otherwise = respond $ failWith NotFound
-- Add response headers -- Add response headers
instance ( AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where
type ServerT' (Post ctypes (Headers h v)) m = m (Headers h v) type ServerT' (Post ctypes (Headers h v)) m = m (Headers h v)
route Proxy action request respond route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPost = do | pathIsEmpty request && requestMethod request == methodPost = do
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
headers = getHeaders output headers = getHeaders output
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
@ -445,10 +482,13 @@ instance ( AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where
-- If successfully returning a value, we use the type-level list, combined -- If successfully returning a value, we use the type-level list, combined
-- with the request's @Accept@ header, to encode the value for you -- with the request's @Accept@ header, to encode the value for you
-- (returning a status code of 200). If there was no @Accept@ header or it -- (returning a status code of 200). If there was no @Accept@ header or it
-- was @*/*@, we return encode using the first @Content-Type@ type on the -- was @*\/\*@, we return encode using the first @Content-Type@ type on the
-- list. -- list.
instance ( AllCTRender ctypes a instance
) => HasServer (Put ctypes a) where #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( AllCTRender ctypes a) => HasServer (Put ctypes a) where
type ServerT' (Put ctypes a) m = m a type ServerT' (Put ctypes a) m = m a
@ -457,7 +497,7 @@ instance ( AllCTRender ctypes a
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
Just (contentT, body) -> succeedWith $ Just (contentT, body) -> succeedWith $
@ -468,8 +508,14 @@ instance ( AllCTRender ctypes a
respond $ failWith WrongMethod respond $ failWith WrongMethod
| otherwise = respond $ failWith NotFound | otherwise = respond $ failWith NotFound
instance HasServer (Put ctypes ()) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasServer (Put ctypes ()) where
type ServerT' (Put ctypes ()) m = m () type ServerT' (Put ctypes ()) m = m ()
route Proxy action request respond route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPut = do | pathIsEmpty request && requestMethod request == methodPut = do
e <- runEitherT action e <- runEitherT action
@ -482,14 +528,20 @@ instance HasServer (Put ctypes ()) where
| otherwise = respond $ failWith NotFound | otherwise = respond $ failWith NotFound
-- Add response headers -- Add response headers
instance ( AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where
type ServerT' (Put ctypes (Headers h v)) m = m (Headers h v) type ServerT' (Put ctypes (Headers h v)) m = m (Headers h v)
route Proxy action request respond route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPut = do | pathIsEmpty request && requestMethod request == methodPut = do
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
headers = getHeaders output headers = getHeaders output
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
@ -512,8 +564,12 @@ instance ( AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where
-- If successfully returning a value, we just require that its type has -- If successfully returning a value, we just require that its type has
-- a 'ToJSON' instance and servant takes care of encoding it for you, -- a 'ToJSON' instance and servant takes care of encoding it for you,
-- yielding status code 200 along the way. -- yielding status code 200 along the way.
instance ( AllCTRender ctypes a instance
) => HasServer (Patch ctypes a) where #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( AllCTRender ctypes a) => HasServer (Patch ctypes a) where
type ServerT' (Patch ctypes a) m = m a type ServerT' (Patch ctypes a) m = m a
route Proxy action request respond route Proxy action request respond
@ -521,7 +577,7 @@ instance ( AllCTRender ctypes a
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
Just (contentT, body) -> succeedWith $ Just (contentT, body) -> succeedWith $
@ -532,8 +588,14 @@ instance ( AllCTRender ctypes a
respond $ failWith WrongMethod respond $ failWith WrongMethod
| otherwise = respond $ failWith NotFound | otherwise = respond $ failWith NotFound
instance HasServer (Patch ctypes ()) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
HasServer (Patch ctypes ()) where
type ServerT' (Patch ctypes ()) m = m () type ServerT' (Patch ctypes ()) m = m ()
route Proxy action request respond route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPatch = do | pathIsEmpty request && requestMethod request == methodPatch = do
e <- runEitherT action e <- runEitherT action
@ -546,14 +608,20 @@ instance HasServer (Patch ctypes ()) where
| otherwise = respond $ failWith NotFound | otherwise = respond $ failWith NotFound
-- Add response headers -- Add response headers
instance ( AllCTRender ctypes v ) => HasServer (Patch ctypes (Headers h v)) where instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( AllCTRender ctypes v ) => HasServer (Patch ctypes (Headers h v)) where
type ServerT' (Patch ctypes (Headers h v)) m = m (Headers h v) type ServerT' (Patch ctypes (Headers h v)) m = m (Headers h v)
route Proxy action request respond route Proxy action request respond
| pathIsEmpty request && requestMethod request == methodPatch = do | pathIsEmpty request && requestMethod request == methodPatch = do
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right outpatch -> do Right outpatch -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
headers = getHeaders outpatch headers = getHeaders outpatch
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
@ -864,3 +932,6 @@ instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout
_ -> respond $ failWith NotFound _ -> respond $ failWith NotFound
where proxyPath = Proxy :: Proxy path where proxyPath = Proxy :: Proxy path
ct_wildcard :: B.ByteString
ct_wildcard = "*" <> "/" <> "*" -- Because CPP

0
servant/servant.png → servant.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 26 KiB

After

Width:  |  Height:  |  Size: 26 KiB

30
servant/default.nix
View File

@ -1,12 +1,22 @@
{ pkgs ? import <nixpkgs> { config.allowUnfree = true; } { mkDerivation, aeson, attoparsec, base, bytestring
, src ? builtins.filterSource (path: type: , bytestring-conversion, case-insensitive, doctest, filemanip
type != "unknown" && , hspec, http-media, http-types, network-uri, parsec, QuickCheck
baseNameOf path != ".git" && , quickcheck-instances, stdenv, string-conversions, text, url
baseNameOf path != "result" &&
baseNameOf path != "dist") ./.
}: }:
pkgs.haskellPackages.buildLocalCabalWithArgs { mkDerivation {
name = "servant"; pname = "servant";
inherit src; version = "0.2.2";
args = {}; src = ./.;
buildDepends = [
aeson attoparsec base bytestring bytestring-conversion
case-insensitive http-media http-types network-uri
string-conversions text
];
testDepends = [
aeson attoparsec base bytestring doctest filemanip hspec parsec
QuickCheck quickcheck-instances string-conversions text url
];
homepage = "http://haskell-servant.github.io/";
description = "A family of combinators for defining webservices APIs";
license = stdenv.lib.licenses.bsd3;
} }

7
servant/servant.cabal
View File

@ -8,6 +8,8 @@ description:
. .
<https://github.com/haskell-servant/servant-server/blob/master/example/greet.hs Here>'s a runnable example, with comments, that defines a dummy API and <https://github.com/haskell-servant/servant-server/blob/master/example/greet.hs Here>'s a runnable example, with comments, that defines a dummy API and
implements a webserver that serves this API, using the <http://hackage.haskell.org/package/servant-server servant-server> package. implements a webserver that serves this API, using the <http://hackage.haskell.org/package/servant-server servant-server> package.
.
<https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md CHANGELOG>
homepage: http://haskell-servant.github.io/ homepage: http://haskell-servant.github.io/
Bug-reports: http://github.com/haskell-servant/servant/issues Bug-reports: http://github.com/haskell-servant/servant/issues
license: BSD3 license: BSD3
@ -53,13 +55,12 @@ library
, 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
, template-haskell >= 2.7 && < 2.10
, parsec >= 3.1
, string-conversions >= 0.3 && < 0.4 , string-conversions >= 0.3 && < 0.4
, network-uri >= 2.6 , network-uri >= 2.6
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
other-extensions: ConstraintKinds other-extensions: CPP
, ConstraintKinds
, DataKinds , DataKinds
, DeriveDataTypeable , DeriveDataTypeable
, FlexibleInstances , FlexibleInstances

3
servant/src/Servant/API/Alternative.hs
View File

@ -1,8 +1,11 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Servant.API.Alternative ((:<|>)(..)) where module Servant.API.Alternative ((:<|>)(..)) where
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid (..)) import Data.Monoid (Monoid (..))
#endif
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
-- | Union of two APIs, first takes precedence in case of overlap. -- | Union of two APIs, first takes precedence in case of overlap.
-- --

3
servant/src/Servant/API/ContentTypes.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
@ -63,7 +64,9 @@ module Servant.API.ContentTypes
, eitherDecodeLenient , eitherDecodeLenient
) where ) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<*)) import Control.Applicative ((<*))
#endif
import Control.Arrow (left) import Control.Arrow (left)
import Control.Monad import Control.Monad
import Data.Aeson (FromJSON, ToJSON, Value, import Data.Aeson (FromJSON, ToJSON, Value,

17
servant/src/Servant/API/ResponseHeaders.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -6,11 +7,13 @@
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-} {-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-}
#endif
-- | This module provides facilities for adding headers to a response. -- | This module provides facilities for adding headers to a response.
-- --
@ -50,13 +53,21 @@ class AddHeader h v orig new
| h v orig -> new, new -> h, new -> v, new -> orig where | h v orig -> new, new -> h, new -> v, new -> orig where
addHeader :: v -> orig -> new addHeader :: v -> orig -> new
instance ( KnownSymbol h, ToByteString v instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-}
#endif
( KnownSymbol h, ToByteString v
) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where ) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
addHeader a (Headers resp heads) = Headers resp ((headerName, toByteString' a) : heads) addHeader a (Headers resp heads) = Headers resp ((headerName, toByteString' a) : heads)
where where
headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h) headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
instance ( KnownSymbol h, ToByteString v instance
#if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-}
#endif
( KnownSymbol h, ToByteString v
, new ~ (Headers '[Header h v] a) , new ~ (Headers '[Header h v] a)
) => AddHeader h v a new where ) => AddHeader h v a new where
addHeader a resp = Headers resp [(headerName, toByteString' a)] addHeader a resp = Headers resp [(headerName, toByteString' a)]

9
servant/src/Servant/Common/Text.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
@ -6,12 +7,18 @@ module Servant.Common.Text
, ToText(..) , ToText(..)
) where ) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
#endif
import Data.Int (Int16, Int32, Int64, Int8) import Data.Int (Int16, Int32, Int64, Int8)
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Read (Reader, decimal, rational, signed) import Data.Text.Read (Reader, decimal, rational, signed)
import Data.Word (Word, Word16, Word32, Word64, Word8) 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 -- | For getting values from url captures and query string parameters
-- Instances should obey: -- Instances should obey:

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

@ -1,13 +1,13 @@
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
-- | Type safe generation of internal links. -- | Type safe generation of internal links.
-- --
@ -104,7 +104,11 @@ module Servant.Utils.Links (
import Data.List import Data.List
import Data.Proxy ( Proxy(..) ) import Data.Proxy ( Proxy(..) )
import Data.Text (Text, unpack) import Data.Text (Text, unpack)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid ( Monoid(..), (<>) ) import Data.Monoid ( Monoid(..), (<>) )
#else
import Data.Monoid ( (<>) )
#endif
import Network.URI ( URI(..), escapeURIString, isUnreserved ) import Network.URI ( URI(..), escapeURIString, isUnreserved )
import GHC.TypeLits ( KnownSymbol, symbolVal ) import GHC.TypeLits ( KnownSymbol, symbolVal )
import GHC.Exts(Constraint) import GHC.Exts(Constraint)

3
servant/test/Servant/API/ContentTypesSpec.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
@ -5,7 +6,9 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.API.ContentTypesSpec where module Servant.API.ContentTypesSpec where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative import Control.Applicative
#endif
import Control.Arrow import Control.Arrow
import Data.Aeson import Data.Aeson
import Data.Aeson.Parser (jstring) import Data.Aeson.Parser (jstring)

7
servant/test/Servant/Common/TextSpec.hs
View File

@ -1,8 +1,13 @@
{-# LANGUAGE CPP #-}
module Servant.Common.TextSpec where module Servant.Common.TextSpec where
import Data.Int (Int16, Int32, Int64, Int8) import Data.Int (Int16, Int32, Int64, Int8)
import Data.Text (Text) import Data.Text (Text)
import Data.Word (Word, Word16, Word32, Word64, Word8) import Data.Word (Word16, Word32, Word64, Word8
#if !MIN_VERSION_base(4,8,0)
, Word
#endif
)
import Servant.Common.Text import Servant.Common.Text
import Test.Hspec import Test.Hspec
import Test.QuickCheck import Test.QuickCheck

5
sources.txt Normal file
View File

@ -0,0 +1,5 @@
servant
servant-client
servant-docs
servant-jquery
servant-server