Merge remote-tracking branch 'origin/master' into client-ghcjs-wip

.ghci

@@ -1 +0,0 @@
-:set -itest -isrc -packagehspec2

.gitignore

@@ -25,3 +25,7 @@ Setup
 .stack-work
 shell.nix
 default.nix
+doc/_build
+doc/venv
+doc/tutorial/static/api.js
+doc/tutorial/static/jq.js

.travis.yml

@@ -34,7 +34,7 @@ install:
 script:
   - if [ "$GHCJS" = "true" ];
       then ./.travis-ghcjs.sh ;
-      else ./.travis-ghc.sh ;
+      else ./travis.sh ;
     fi
   - export CASHER_TIME_OUT=500
 

CONTRIBUTING.md

@@ -0,0 +1,86 @@
+# Contributing Guidelines
+
+Contributions are very welcome! To hack on the github version, clone the
+repository. You can use `cabal`:
+
+```shell
+./scripts/start-sandbox.sh # Initialize the sandbox and add-source the packages
+./scripts/test-all.sh      # Run all the tests
+```
+
+`stack`:
+
+```shell
+stack build    # Install and build packages
+stack test     # Run all the tests
+```
+
+Or `nix`:
+```shell
+./scripts/generate-nix-files.sh   # Get up-to-date shell.nix files
+```
+
+
+## General
+
+Some things we like:
+
+- Explicit imports
+- Upper and lower bounds for packages
+- Few dependencies
+- -Werror-compatible (for both 7.8 and 7.10)
+
+Though we aren't sticklers for style, the `.stylish-haskell.yaml` and `HLint.hs`
+files in the repository provide a good baseline for consistency.
+
+Please include a description of the changes in your PR in the `CHANGELOG.md` of
+the packages you've changed. And of course, write tests!
+
+## PR process
+
+We try to give timely reviews to PRs that pass CI. If CI for your PR fails, we
+may close the PR if it has been open for too long (though you should feel free
+to reopen when the issues have been fixed).
+
+We require two +1 from the maintainers of the repo. If you feel like there has
+not been a timely response to a PR, you can ping the Maintainers group (with
+`@haskell-servant/maintainers`).
+
+## New combinators
+
+We encourage people to experiment with new combinators and instances - it is
+one of the most powerful ways of using `servant`, and a wonderful way of
+getting to know it better. If you do write a new combinator, we would love to
+know about it! Either hop on #servant on freenode and let us know, or open an
+issue with the `news` tag (which we will close when we read it).
+
+As for adding them to the main repo: maintaining combinators can be expensive,
+since official combinators must have instances for all classes (and new classes
+come along fairly frequently). We therefore have to be quite selective about
+those that we accept. If you're considering writing a new combinator, open an
+issue to discuss it first! (You could release your combinator as a separate
+package, of course.)
+
+
+## New classes
+
+The main benefit of having a new class and package in the main servant repo is
+that we get to see via CI whether changes to other packages break the build.
+Open an issue to discuss whether a package should be added to the main repo. If
+we decide that it can, you can still keep maintainership over it.
+
+Whether or not you want your package to be in the repo, create an issue with
+the `news` label if you make a new package so we can know about it!
+
+## Release policy
+
+We are currently moving to a more aggresive release policy, so that you can get
+what you contribute from Hackage fairly soon. However, note that prior to major
+releases it may take some time in between releases.
+
+## Reporting security issues
+
+Please email haskell-servant-maintainers AT googlegroups DOT com. This group is
+private, and accessible only to known maintainers. We will then discuss how to
+proceed. Please do not make the issue public before we inform you that we have
+a patch ready.

README.md

@@ -17,29 +17,4 @@ list](https://groups.google.com/forum/#!forum/haskell-servant).
 
 ## Contributing
 
-Contributions are very welcome! To hack on the github version, clone the
+See `CONTRIBUTING.md`
-repository. You can use `cabal`:
-
-```shell
-./scripts/start-sandbox.sh # Initialize the sandbox and add-source the packages
-./scripts/test-all.sh      # Run all the tests
-```
-
-`stack`:
-
-```shell
-stack build    # Install and build packages
-stack test     # Run all the tests
-```
-
-Or `nix`:
-```shell
-./scripts/generate-nix-files.sh   # Get up-to-date shell.nix files
-```
-
-Though we aren't sticklers for style, the `.stylish-haskell.yaml` and `HLint.hs`
-files in the repository provide a good baseline for consistency.
-
-Please include a description of the changes in your PR in the `CHANGELOG.md` of
-the packages you've changed. And of course, write tests!
-

doc/Makefile

@@ -0,0 +1,216 @@
+# Makefile for Sphinx documentation
+#
+
+# You can set these variables from the command line.
+SPHINXOPTS    =
+SPHINXBUILD   = sphinx-build
+PAPER         =
+BUILDDIR      = _build
+
+# User-friendly check for sphinx-build
+ifeq ($(shell which $(SPHINXBUILD) >/dev/null 2>&1; echo $$?), 1)
+$(error The '$(SPHINXBUILD)' command was not found. Make sure you have Sphinx installed, then set the SPHINXBUILD environment variable to point to the full path of the '$(SPHINXBUILD)' executable. Alternatively you can add the directory with the executable to your PATH. If you don't have Sphinx installed, grab it from http://sphinx-doc.org/)
+endif
+
+# Internal variables.
+PAPEROPT_a4     = -D latex_paper_size=a4
+PAPEROPT_letter = -D latex_paper_size=letter
+ALLSPHINXOPTS   = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) .
+# the i18n builder cannot share the environment and doctrees with the others
+I18NSPHINXOPTS  = $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) .
+
+.PHONY: help
+help:
+	@echo "Please use \`make <target>' where <target> is one of"
+	@echo "  html       to make standalone HTML files"
+	@echo "  dirhtml    to make HTML files named index.html in directories"
+	@echo "  singlehtml to make a single large HTML file"
+	@echo "  pickle     to make pickle files"
+	@echo "  json       to make JSON files"
+	@echo "  htmlhelp   to make HTML files and a HTML help project"
+	@echo "  qthelp     to make HTML files and a qthelp project"
+	@echo "  applehelp  to make an Apple Help Book"
+	@echo "  devhelp    to make HTML files and a Devhelp project"
+	@echo "  epub       to make an epub"
+	@echo "  latex      to make LaTeX files, you can set PAPER=a4 or PAPER=letter"
+	@echo "  latexpdf   to make LaTeX files and run them through pdflatex"
+	@echo "  latexpdfja to make LaTeX files and run them through platex/dvipdfmx"
+	@echo "  text       to make text files"
+	@echo "  man        to make manual pages"
+	@echo "  texinfo    to make Texinfo files"
+	@echo "  info       to make Texinfo files and run them through makeinfo"
+	@echo "  gettext    to make PO message catalogs"
+	@echo "  changes    to make an overview of all changed/added/deprecated items"
+	@echo "  xml        to make Docutils-native XML files"
+	@echo "  pseudoxml  to make pseudoxml-XML files for display purposes"
+	@echo "  linkcheck  to check all external links for integrity"
+	@echo "  doctest    to run all doctests embedded in the documentation (if enabled)"
+	@echo "  coverage   to run coverage check of the documentation (if enabled)"
+
+.PHONY: clean
+clean:
+	rm -rf $(BUILDDIR)/*
+
+.PHONY: html
+html:
+	$(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html
+	@echo
+	@echo "Build finished. The HTML pages are in $(BUILDDIR)/html."
+
+.PHONY: dirhtml
+dirhtml:
+	$(SPHINXBUILD) -b dirhtml $(ALLSPHINXOPTS) $(BUILDDIR)/dirhtml
+	@echo
+	@echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml."
+
+.PHONY: singlehtml
+singlehtml:
+	$(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml
+	@echo
+	@echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml."
+
+.PHONY: pickle
+pickle:
+	$(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle
+	@echo
+	@echo "Build finished; now you can process the pickle files."
+
+.PHONY: json
+json:
+	$(SPHINXBUILD) -b json $(ALLSPHINXOPTS) $(BUILDDIR)/json
+	@echo
+	@echo "Build finished; now you can process the JSON files."
+
+.PHONY: htmlhelp
+htmlhelp:
+	$(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp
+	@echo
+	@echo "Build finished; now you can run HTML Help Workshop with the" \
+	      ".hhp project file in $(BUILDDIR)/htmlhelp."
+
+.PHONY: qthelp
+qthelp:
+	$(SPHINXBUILD) -b qthelp $(ALLSPHINXOPTS) $(BUILDDIR)/qthelp
+	@echo
+	@echo "Build finished; now you can run "qcollectiongenerator" with the" \
+	      ".qhcp project file in $(BUILDDIR)/qthelp, like this:"
+	@echo "# qcollectiongenerator $(BUILDDIR)/qthelp/generics-eot.qhcp"
+	@echo "To view the help file:"
+	@echo "# assistant -collectionFile $(BUILDDIR)/qthelp/generics-eot.qhc"
+
+.PHONY: applehelp
+applehelp:
+	$(SPHINXBUILD) -b applehelp $(ALLSPHINXOPTS) $(BUILDDIR)/applehelp
+	@echo
+	@echo "Build finished. The help book is in $(BUILDDIR)/applehelp."
+	@echo "N.B. You won't be able to view it unless you put it in" \
+	      "~/Library/Documentation/Help or install it in your application" \
+	      "bundle."
+
+.PHONY: devhelp
+devhelp:
+	$(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp
+	@echo
+	@echo "Build finished."
+	@echo "To view the help file:"
+	@echo "# mkdir -p $$HOME/.local/share/devhelp/generics-eot"
+	@echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/generics-eot"
+	@echo "# devhelp"
+
+.PHONY: epub
+epub:
+	$(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub
+	@echo
+	@echo "Build finished. The epub file is in $(BUILDDIR)/epub."
+
+.PHONY: latex
+latex:
+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
+	@echo
+	@echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex."
+	@echo "Run \`make' in that directory to run these through (pdf)latex" \
+	      "(use \`make latexpdf' here to do that automatically)."
+
+.PHONY: latexpdf
+latexpdf:
+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
+	@echo "Running LaTeX files through pdflatex..."
+	$(MAKE) -C $(BUILDDIR)/latex all-pdf
+	@echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."
+
+.PHONY: latexpdfja
+latexpdfja:
+	$(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
+	@echo "Running LaTeX files through platex and dvipdfmx..."
+	$(MAKE) -C $(BUILDDIR)/latex all-pdf-ja
+	@echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."
+
+.PHONY: text
+text:
+	$(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text
+	@echo
+	@echo "Build finished. The text files are in $(BUILDDIR)/text."
+
+.PHONY: man
+man:
+	$(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man
+	@echo
+	@echo "Build finished. The manual pages are in $(BUILDDIR)/man."
+
+.PHONY: texinfo
+texinfo:
+	$(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
+	@echo
+	@echo "Build finished. The Texinfo files are in $(BUILDDIR)/texinfo."
+	@echo "Run \`make' in that directory to run these through makeinfo" \
+	      "(use \`make info' here to do that automatically)."
+
+.PHONY: info
+info:
+	$(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
+	@echo "Running Texinfo files through makeinfo..."
+	make -C $(BUILDDIR)/texinfo info
+	@echo "makeinfo finished; the Info files are in $(BUILDDIR)/texinfo."
+
+.PHONY: gettext
+gettext:
+	$(SPHINXBUILD) -b gettext $(I18NSPHINXOPTS) $(BUILDDIR)/locale
+	@echo
+	@echo "Build finished. The message catalogs are in $(BUILDDIR)/locale."
+
+.PHONY: changes
+changes:
+	$(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes
+	@echo
+	@echo "The overview file is in $(BUILDDIR)/changes."
+
+.PHONY: linkcheck
+linkcheck:
+	$(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck
+	@echo
+	@echo "Link check complete; look for any errors in the above output " \
+	      "or in $(BUILDDIR)/linkcheck/output.txt."
+
+.PHONY: doctest
+doctest:
+	$(SPHINXBUILD) -b doctest $(ALLSPHINXOPTS) $(BUILDDIR)/doctest
+	@echo "Testing of doctests in the sources finished, look at the " \
+	      "results in $(BUILDDIR)/doctest/output.txt."
+
+.PHONY: coverage
+coverage:
+	$(SPHINXBUILD) -b coverage $(ALLSPHINXOPTS) $(BUILDDIR)/coverage
+	@echo "Testing of coverage in the sources finished, look at the " \
+	      "results in $(BUILDDIR)/coverage/python.txt."
+
+.PHONY: xml
+xml:
+	$(SPHINXBUILD) -b xml $(ALLSPHINXOPTS) $(BUILDDIR)/xml
+	@echo
+	@echo "Build finished. The XML files are in $(BUILDDIR)/xml."
+
+.PHONY: pseudoxml
+pseudoxml:
+	$(SPHINXBUILD) -b pseudoxml $(ALLSPHINXOPTS) $(BUILDDIR)/pseudoxml
+	@echo
+	@echo "Build finished. The pseudo-XML files are in $(BUILDDIR)/pseudoxml."

doc/building-the-docs

@@ -0,0 +1,8 @@
+To build the docs locally:
+
+$ virtualenv venv
+$ . ./venv/bin/activate
+$ pip install -r requirements.txt
+$ make html
+
+Docs will be built in _build/html/index.html .

doc/conf.py

@@ -0,0 +1,294 @@
+# -*- coding: utf-8 -*-
+#
+# servant documentation build configuration file, created by
+# sphinx-quickstart on Mon Nov 23 13:24:36 2015.
+#
+# This file is execfile()d with the current directory set to its
+# containing dir.
+#
+# Note that not all possible configuration values are present in this
+# autogenerated file.
+#
+# All configuration values have a default; values that are commented out
+# serve to show the default.
+
+import sys
+import os
+import shlex
+from recommonmark.parser import CommonMarkParser
+
+# If extensions (or modules to document with autodoc) are in another directory,
+# add these directories to sys.path here. If the directory is relative to the
+# documentation root, use os.path.abspath to make it absolute, like shown here.
+#sys.path.insert(0, os.path.abspath('.'))
+
+# -- General configuration ------------------------------------------------
+
+# If your documentation needs a minimal Sphinx version, state it here.
+#needs_sphinx = '1.0'
+
+# Add any Sphinx extension module names here, as strings. They can be
+# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom
+# ones.
+extensions = []
+
+# Add any paths that contain templates here, relative to this directory.
+templates_path = ['_templates']
+
+# The suffix(es) of source filenames.
+# You can specify multiple suffix as a list of string:
+source_suffix = ['.md', '.rst', '.lhs']
+
+# The encoding of source files.
+#source_encoding = 'utf-8-sig'
+
+# The master toctree document.
+master_doc = 'index'
+
+# General information about the project.
+project = u'servant'
+copyright = u'2016, Servant Contributors'
+author = u'Servant Contributors'
+
+# The version info for the project you're documenting, acts as replacement for
+# |version| and |release|, also used in various other places throughout the
+# built documents.
+#
+# The short X.Y version.
+# version = 'latest'
+# The full version, including alpha/beta/rc tags.
+# release = 'latest'
+
+# The language for content autogenerated by Sphinx. Refer to documentation
+# for a list of supported languages.
+#
+# This is also used if you do content translation via gettext catalogs.
+# Usually you set "language" from the command line for these cases.
+language = None
+
+# There are two options for replacing |today|: either, you set today to some
+# non-false value, then it is used:
+#today = ''
+# Else, today_fmt is used as the format for a strftime call.
+#today_fmt = '%B %d, %Y'
+
+# List of patterns, relative to source directory, that match files and
+# directories to ignore when looking for source files.
+exclude_patterns = ['_build', 'venv']
+
+# The reST default role (used for this markup: `text`) to use for all
+# documents.
+#default_role = None
+
+# If true, '()' will be appended to :func: etc. cross-reference text.
+#add_function_parentheses = True
+
+# If true, the current module name will be prepended to all description
+# unit titles (such as .. function::).
+#add_module_names = True
+
+# If true, sectionauthor and moduleauthor directives will be shown in the
+# output. They are ignored by default.
+#show_authors = False
+
+# The name of the Pygments (syntax highlighting) style to use.
+pygments_style = 'sphinx'
+
+def setup(app):
+    from sphinx.highlighting import lexers
+    from pygments.lexers import HaskellLexer
+    lexers['haskell ignore'] = HaskellLexer(stripnl=False)
+
+# A list of ignored prefixes for module index sorting.
+#modindex_common_prefix = []
+
+# If true, keep warnings as "system message" paragraphs in the built documents.
+#keep_warnings = False
+
+# If true, `todo` and `todoList` produce output, else they produce nothing.
+todo_include_todos = False
+
+
+# -- Options for HTML output ----------------------------------------------
+
+# The theme to use for HTML and HTML Help pages.  See the documentation for
+# a list of builtin themes.
+html_theme = 'sphinx_rtd_theme'
+
+# Theme options are theme-specific and customize the look and feel of a theme
+# further.  For a list of options available for each theme, see the
+# documentation.
+#html_theme_options = {}
+
+# Add any paths that contain custom themes here, relative to this directory.
+#html_theme_path = []
+
+# The name for this set of Sphinx documents.  If None, it defaults to
+# "<project> v<release> documentation".
+#html_title = None
+
+# A shorter title for the navigation bar.  Default is the same as html_title.
+#html_short_title = None
+
+# The name of an image file (relative to this directory) to place at the top
+# of the sidebar.
+#html_logo = None
+
+# The name of an image file (within the static path) to use as favicon of the
+# docs.  This file should be a Windows icon file (.ico) being 16x16 or 32x32
+# pixels large.
+#html_favicon = None
+
+# Add any paths that contain custom static files (such as style sheets) here,
+# relative to this directory. They are copied after the builtin static files,
+# so a file named "default.css" will overwrite the builtin "default.css".
+html_static_path = ['_static']
+
+# Add any extra paths that contain custom files (such as robots.txt or
+# .htaccess) here, relative to this directory. These files are copied
+# directly to the root of the documentation.
+#html_extra_path = []
+
+# If not '', a 'Last updated on:' timestamp is inserted at every page bottom,
+# using the given strftime format.
+#html_last_updated_fmt = '%b %d, %Y'
+
+# If true, SmartyPants will be used to convert quotes and dashes to
+# typographically correct entities.
+#html_use_smartypants = True
+
+# Custom sidebar templates, maps document names to template names.
+#html_sidebars = {}
+
+# Additional templates that should be rendered to pages, maps page names to
+# template names.
+#html_additional_pages = {}
+
+# If false, no module index is generated.
+#html_domain_indices = True
+
+# If false, no index is generated.
+#html_use_index = True
+
+# If true, the index is split into individual pages for each letter.
+#html_split_index = False
+
+# If true, links to the reST sources are added to the pages.
+#html_show_sourcelink = True
+
+# If true, "Created using Sphinx" is shown in the HTML footer. Default is True.
+#html_show_sphinx = True
+
+# If true, "(C) Copyright ..." is shown in the HTML footer. Default is True.
+#html_show_copyright = True
+
+# If true, an OpenSearch description file will be output, and all pages will
+# contain a <link> tag referring to it.  The value of this option must be the
+# base URL from which the finished HTML is served.
+#html_use_opensearch = ''
+
+# This is the file name suffix for HTML files (e.g. ".xhtml").
+#html_file_suffix = None
+
+# Language to be used for generating the HTML full-text search index.
+# Sphinx supports the following languages:
+#   'da', 'de', 'en', 'es', 'fi', 'fr', 'hu', 'it', 'ja'
+#   'nl', 'no', 'pt', 'ro', 'ru', 'sv', 'tr'
+#html_search_language = 'en'
+
+# A dictionary with options for the search language support, empty by default.
+# Now only 'ja' uses this config value
+#html_search_options = {'type': 'default'}
+
+# The name of a javascript file (relative to the configuration directory) that
+# implements a search results scorer. If empty, the default will be used.
+#html_search_scorer = 'scorer.js'
+
+# Output file base name for HTML help builder.
+htmlhelp_basename = 'servantdoc'
+
+# -- Options for LaTeX output ---------------------------------------------
+
+latex_elements = {
+# The paper size ('letterpaper' or 'a4paper').
+#'papersize': 'letterpaper',
+
+# The font size ('10pt', '11pt' or '12pt').
+#'pointsize': '10pt',
+
+# Additional stuff for the LaTeX preamble.
+#'preamble': '',
+
+# Latex figure (float) alignment
+#'figure_align': 'htbp',
+}
+
+# Grouping the document tree into LaTeX files. List of tuples
+# (source start file, target name, title,
+#  author, documentclass [howto, manual, or own class]).
+latex_documents = [
+    (master_doc, 'servant.tex', u'servant Documentation',
+     u'Servant Contributors', 'manual'),
+]
+
+# The name of an image file (relative to this directory) to place at the top of
+# the title page.
+#latex_logo = None
+
+# For "manual" documents, if this is true, then toplevel headings are parts,
+# not chapters.
+#latex_use_parts = False
+
+# If true, show page references after internal links.
+#latex_show_pagerefs = False
+
+# If true, show URL addresses after external links.
+#latex_show_urls = False
+
+# Documents to append as an appendix to all manuals.
+#latex_appendices = []
+
+# If false, no module index is generated.
+#latex_domain_indices = True
+
+
+# -- Options for manual page output ---------------------------------------
+
+# One entry per manual page. List of tuples
+# (source start file, name, description, authors, manual section).
+man_pages = [
+    (master_doc, 'servant', u'servant Documentation',
+     [author], 1)
+]
+
+# If true, show URL addresses after external links.
+#man_show_urls = False
+
+
+# -- Options for Texinfo output -------------------------------------------
+
+# Grouping the document tree into Texinfo files. List of tuples
+# (source start file, target name, title, author,
+#  dir menu entry, description, category)
+texinfo_documents = [
+  (master_doc, 'servant', u'servant Documentation',
+   author, 'servant', 'One line description of project.',
+   'Miscellaneous'),
+]
+
+# Documents to append as an appendix to all manuals.
+#texinfo_appendices = []
+
+# If false, no module index is generated.
+#texinfo_domain_indices = True
+
+# How to display URL addresses: 'footnote', 'no', or 'inline'.
+#texinfo_show_urls = 'footnote'
+
+# If true, do not generate a @detailmenu in the "Top" node's menu.
+#texinfo_no_detailmenu = False
+
+source_parsers = {
+    '.md': CommonMarkParser,
+    '.lhs': CommonMarkParser,
+}

doc/index.rst

@@ -0,0 +1,22 @@
+servant – A Type-Level Web DSL
+==============================
+
+.. image:: https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png
+
+**servant** is a set of packages for declaring web APIs at the type-level and
+then using those API specifications to:
+
+- write servers (this part of **servant** can be considered a web framework),
+- obtain client functions (in haskell),
+- generate client functions for other programming languages,
+- generate documentation for your web applications
+- and more...
+
+All in a type-safe manner.
+
+.. toctree::
+  :maxdepth: 2
+
+  introduction.rst
+  tutorial/index.rst
+  links.rst

doc/introduction.rst

@@ -0,0 +1,40 @@
+Introduction
+------------
+
+**servant** has the following guiding principles:
+
+- concision
+
+   This is a pretty wide-ranging principle. You should be able to get nice
+   documentation for your web servers, and client libraries, without repeating
+   yourself. You should not have to manually serialize and deserialize your
+   resources, but only declare how to do those things *once per type*. If a
+   bunch of your handlers take the same query parameters, you shouldn't have to
+   repeat that logic for each handler, but instead just "apply" it to all of
+   them at once. Your handlers shouldn't be where composition goes to die. And
+   so on.
+
+- flexibility
+
+   If we haven't thought of your use case, it should still be easily
+   achievable. If you want to use templating library X, go ahead. Forms? Do
+   them however you want, but without difficulty. We're not opinionated.
+
+- separation of concerns
+
+   Your handlers and your HTTP logic should be separate. True to the philosphy
+   at the core of HTTP and REST, with **servant** your handlers return normal
+   Haskell datatypes - that's the resource. And then from a description of your
+   API, **servant** handles the *presentation* (i.e., the Content-Types). But
+   that's just one example.
+
+- type safety
+
+   Want to be sure your API meets a specification? Your compiler can check
+   that for you. Links you can be sure exist? You got it.
+
+To stick true to these principles, we do things a little differently than you
+might expect. The core idea is *reifying the description of your API*. Once
+reified, everything follows. We think we might be the first web framework to
+reify API descriptions in an extensible way. We're pretty sure we're the first
+to reify it as *types*.

doc/links.rst

@@ -0,0 +1,34 @@
+
+Helpful Links
+-------------
+
+- the central documentation (this site):
+  `haskell-servant.readthedocs.org <http://haskell-servant.readthedocs.org/>`_
+
+- the github repo:
+  `github.com/haskell-servant/servant <https://github.com/haskell-servant/servant>`_
+
+- the issue tracker (Feel free to create issues and submit PRs!):
+  `https://github.com/haskell-servant/servant/issues <https://github.com/haskell-servant/servant/issues>`_
+
+- the irc channel:
+  ``#servant`` on freenode
+
+- the mailing list:
+  `groups.google.com/forum/#!forum/haskell-servant <https://groups.google.com/forum/#!forum/haskell-servant>`_
+
+- blog posts and videos and slides of some talks on servant:
+  `haskell-servant.github.io <http://haskell-servant.github.io>`_
+
+- the servant packages on hackage:
+
+  - `hackage.haskell.org/package/servant <http://hackage.haskell.org/package/servant>`_
+  - `hackage.haskell.org/package/servant-server <http://hackage.haskell.org/package/servant-server>`_
+  - `hackage.haskell.org/package/servant-client <http://hackage.haskell.org/package/servant-client>`_
+  - `hackage.haskell.org/package/servant-blaze <http://hackage.haskell.org/package/servant-blaze>`_
+  - `hackage.haskell.org/package/servant-lucid <http://hackage.haskell.org/package/servant-lucid>`_
+  - `hackage.haskell.org/package/servant-cassava <http://hackage.haskell.org/package/servant-cassava>`_
+  - `hackage.haskell.org/package/servant-docs <http://hackage.haskell.org/package/servant-docs>`_
+  - `hackage.haskell.org/package/servant-foreign <http://hackage.haskell.org/package/servant-foreign>`_
+  - `hackage.haskell.org/package/servant-js <http://hackage.haskell.org/package/servant-js>`_
+  - `hackage.haskell.org/package/servant-mock <http://hackage.haskell.org/package/servant-mock>`_

doc/requirements.txt

@@ -0,0 +1,25 @@
+alabaster==0.7.7
+argh==0.26.1
+Babel==2.2.0
+backports-abc==0.4
+backports.ssl-match-hostname==3.5.0.1
+certifi==2015.11.20.1
+CommonMark==0.5.4
+docutils==0.12
+Jinja2==2.8
+livereload==2.4.1
+MarkupSafe==0.23
+pathtools==0.1.2
+Pygments==2.1.1
+pytz==2015.7
+PyYAML==3.11
+recommonmark==0.4.0
+singledispatch==3.4.0.3
+six==1.10.0
+snowballstemmer==1.2.1
+Sphinx==1.3.4
+sphinx-autobuild==0.5.2
+sphinx-rtd-theme==0.1.9
+tornado==4.3
+watchdog==0.8.3
+wheel==0.26.0

doc/tutorial/.ghci

@@ -0,0 +1 @@
+:set -pgmL markdown-unlit -Wall -Werror -fno-warn-missing-methods -fno-warn-name-shadowing -itest

doc/tutorial/ApiType.lhs

@@ -0,0 +1,339 @@
+# A web API as a type
+
+The source for this tutorial section is a literate haskell file, so first we
+need to have some language extensions and imports:
+
+``` haskell
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+
+module ApiType where
+
+import Data.Text
+import Servant.API
+```
+
+Consider the following informal specification of an API:
+
+ > The endpoint at `/users` expects a GET request with query string parameter
+ > `sortby` whose value can be one of `age` or `name` and returns a
+ > list/array of JSON objects describing users, with fields `age`, `name`,
+ > `email`, `registration_date`".
+
+You *should* be able to formalize that. And then use the formalized version to
+get you much of the way towards writing a web app. And all the way towards
+getting some client libraries, and documentation, and more.
+
+How would we describe it with **servant**? An endpoint description is a good old
+Haskell **type**:
+
+``` haskell
+type UserAPI = "users" :> QueryParam "sortby" SortBy :> Get '[JSON] [User]
+
+data SortBy = Age | Name
+
+data User = User {
+  name :: String,
+  age :: Int
+}
+```
+
+Let's break that down:
+
+- `"users"` says that our endpoint will be accessible under `/users`;
+- `QueryParam "sortby" SortBy`, where `SortBy` is defined by `data SortBy = Age | Name`,
+    says that the endpoint has a query string parameter named `sortby`
+    whose value will be extracted as a value of type `SortBy`.
+- `Get '[JSON] [User]` says that the endpoint will be accessible through HTTP
+   GET requests, returning a list of users encoded as JSON. You will see
+   later how you can make use of this to make your data available under different
+   formats, the choice being made depending on the [Accept
+   header](http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html) specified in
+   the client's request.
+- The `:>` operator that separates the various "combinators" just lets you
+  sequence static path fragments, URL captures and other combinators. The
+  ordering only matters for static path fragments and URL captures. `"users" :>
+  "list-all" :> Get '[JSON] [User]`, equivalent to `/users/list-all`, is
+  obviously not the same as `"list-all" :> "users" :> Get '[JSON] [User]`, which
+  is equivalent to `/list-all/users`. This means that sometimes `:>` is somehow
+  equivalent to `/`, but sometimes it just lets you chain another combinator.
+
+We can also describe APIs with multiple endpoints by using the `:<|>`
+combinators. Here's an example:
+
+``` haskell
+type UserAPI2 = "users" :> "list-all" :> Get '[JSON] [User]
+           :<|> "list-all" :> "users" :> Get '[JSON] [User]
+```
+
+**servant** provides a fair amount of combinators out-of-the-box, but you can
+always write your own when you need it. Here's a quick overview of the most
+often needed the combinators that **servant** comes with.
+
+## Combinators
+
+### Static strings
+
+As you've already seen, you can use type-level strings (enabled with the
+`DataKinds` language extension) for static path fragments. Chaining
+them amounts to `/`-separating them in a URL.
+
+``` haskell
+type UserAPI3 = "users" :> "list-all" :> "now" :> Get '[JSON] [User]
+              -- describes an endpoint reachable at:
+              -- /users/list-all/now
+```
+
+### `Delete`, `Get`, `Patch`, `Post` and `Put`
+
+The `Get` combinator is defined in terms of the more general `Verb`:
+``` haskell ignore
+data Verb method (statusCode :: Nat) (contentType :: [*]) a
+type Get = Verb 'GET 200
+```
+
+There are other predefined type synonyms for other common HTTP methods,
+such as e.g.:
+``` haskell ignore
+type Delete = Verb 'DELETE 200
+type Patch  = Verb 'PATCH 200
+type Post   = Verb 'POST 200
+type Put    = Verb 'PUT 200
+```
+
+There are also variants that do not return a 200 status code, such
+as for example:
+``` haskell ignore
+type PostCreated  = Verb 'POST 201
+type PostAccepted = Verb 'POST 202
+```
+
+An endpoint always ends with a variant of the `Verb` combinator
+(unless you write your own combinators). Examples:
+
+``` haskell
+type UserAPI4 = "users" :> Get '[JSON] [User]
+           :<|> "admins" :> Get '[JSON] [User]
+```
+
+### `Capture`
+
+URL captures are segments of the path of a URL that are variable and whose actual value is
+captured and passed to the request handlers. In many web frameworks, you'll see
+it written as in `/users/:userid`, with that leading `:` denoting that `userid`
+is just some kind of variable name or placeholder. For instance, if `userid` is
+supposed to range over all integers greater or equal to 1, our endpoint will
+match requests made to `/users/1`, `/users/143` and so on.
+
+The `Capture` combinator in **servant** takes a (type-level) string representing
+the "name of the variable" and a type, which indicates the type we want to
+decode the "captured value" to.
+
+``` haskell ignore
+data Capture (s :: Symbol) a
+-- s :: Symbol just says that 's' must be a type-level string.
+```
+
+In some web frameworks, you use regexes for captures. We use a
+[`FromHttpApiData`](https://hackage.haskell.org/package/http-api-data/docs/Web-HttpApiData.html#t:FromHttpApiData)
+class, which the captured value must be an instance of.
+
+Examples:
+
+``` haskell
+type UserAPI5 = "user" :> Capture "userid" Integer :> Get '[JSON] User
+                -- equivalent to 'GET /user/:userid'
+                -- except that we explicitly say that "userid"
+                -- must be an integer
+
+           :<|> "user" :> Capture "userid" Integer :> DeleteNoContent '[JSON] NoContent
+                -- equivalent to 'DELETE /user/:userid'
+```
+
+In the second case, `DeleteNoContent` specifies a 204 response code,
+`JSON` specifies the content types on which the handler will match,
+and `NoContent` says that the response will always be empty.
+
+### `QueryParam`, `QueryParams`, `QueryFlag`
+
+`QueryParam`, `QueryParams` and `QueryFlag` are about parameters in the query string,
+i.e., those parameters that come after the question mark
+(`?`) in URLs, like `sortby` in `/users?sortby=age`, whose value is
+set to `age`. `QueryParams` lets you specify that the query parameter
+is actually a list of values, which can be specified using
+`?param=value1&param=value2`. This represents a list of values
+composed of `value1` and `value2`. `QueryFlag` lets you specify a
+boolean-like query parameter where a client isn't forced to specify a
+value. The absence or presence of the parameter's name in the query
+string determines whether the parameter is considered to have the
+value `True` or `False`. For instance, `/users?active` would list only
+active users whereas `/users` would list them all.
+
+Here are the corresponding data type declarations:
+
+``` haskell ignore
+data QueryParam (sym :: Symbol) a
+data QueryParams (sym :: Symbol) a
+data QueryFlag (sym :: Symbol)
+```
+
+Examples:
+
+``` haskell
+type UserAPI6 = "users" :> QueryParam "sortby" SortBy :> Get '[JSON] [User]
+                -- equivalent to 'GET /users?sortby={age, name}'
+
+```
+
+Again, your handlers don't have to deserialize these things (into, for example,
+a `SortBy`). **servant** takes care of it.
+
+### `ReqBody`
+
+Each HTTP request can carry some additional data that the server can use in its
+*body*, and this data can be encoded in any format -- as long as the server
+understands it. This can be used for example for an endpoint for creating new
+users: instead of passing each field of the user as a separate query string
+parameter or something dirty like that, we can group all the data into a JSON
+object. This has the advantage of supporting nested objects.
+
+**servant**'s `ReqBody` combinator takes a list of content types in which the
+data encoded in the request body can be represented and the type of that data.
+And, as you might have guessed, you don't have to check the content type
+header, and do the deserialization yourself. We do it for you. And return `Bad
+Request` or `Unsupported Content Type` as appropriate.
+
+Here's the data type declaration for it:
+
+``` haskell ignore
+data ReqBody (contentTypes :: [*]) a
+```
+
+Examples:
+
+``` haskell
+type UserAPI7 = "users" :> ReqBody '[JSON] User :> Post '[JSON] User
+                -- - equivalent to 'POST /users' with a JSON object
+                --   describing a User in the request body
+                -- - returns a User encoded in JSON
+
+           :<|> "users" :> Capture "userid" Integer
+                        :> ReqBody '[JSON] User
+                        :> Put '[JSON] User
+                -- - equivalent to 'PUT /users/:userid' with a JSON
+                --   object describing a User in the request body
+                -- - returns a User encoded in JSON
+```
+
+### Request `Header`s
+
+Request headers are used for various purposes, from caching to carrying
+auth-related data. They consist of a header name and an associated value. An
+example would be `Accept: application/json`.
+
+The `Header` combinator in **servant** takes a type-level string for the header
+name and the type to which we want to decode the header's value (from some
+textual representation), as illustrated below:
+
+``` haskell ignore
+data Header (sym :: Symbol) a
+```
+
+Here's an example where we declare that an endpoint makes use of the
+`User-Agent` header which specifies the name of the software/library used by
+the client to send the request.
+
+``` haskell
+type UserAPI8 = "users" :> Header "User-Agent" Text :> Get '[JSON] [User]
+```
+
+### Content types
+
+So far, whenever we have used a combinator that carries a list of content
+types, we've always specified `'[JSON]`. However, **servant** lets you use several
+content types, and also lets you define your own content types.
+
+Four content types are provided out-of-the-box by the core **servant** package:
+`JSON`, `PlainText`, `FormUrlEncoded` and `OctetStream`. If for some obscure
+reason you wanted one of your endpoints to make your user data available under
+those 4 formats, you would write the API type as below:
+
+``` haskell
+type UserAPI9 = "users" :> Get '[JSON, PlainText, FormUrlEncoded, OctetStream] [User]
+```
+
+(There are other packages that provide other content types. For example
+**servant-lucid** and **servant-blaze** allow to generate html pages (using
+**lucid** and **blaze-html**) and both come with a content type for html.)
+
+We will further explain how these content types and your data types can play
+together in the [section about serving an API](Server.html).
+
+### Response `Headers`
+
+Just like an HTTP request, the response generated by a webserver can carry
+headers too. **servant** provides a `Headers` combinator that carries a list of
+`Header` types and can be used by simply wrapping the "return type" of an endpoint
+with it.
+
+``` haskell ignore
+data Headers (ls :: [*]) a
+```
+
+If you want to describe an endpoint that returns a "User-Count" header in each
+response, you could write it as below:
+
+``` haskell
+type UserAPI10 = "users" :> Get '[JSON] (Headers '[Header "User-Count" Integer] [User])
+```
+
+### Basic Authentication
+
+Once you've established the basic routes and semantics of your API, it's time
+to consider protecting parts of it. Authentication and authorization are broad
+and nuanced topics; as servant began to explore this space we started small
+with one of HTTP's earliest authentication schemes: [Basic
+Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication).
+
+When protecting endpoints with basic authentication, we need to specify two items:
+
+1. The **realm** of authentication as per the Basic Authentictaion spec.
+2. The datatype returned by the server after authentication is verified. This
+    is usually a `User` or `Customer` type datatype.
+
+With those two items in mind, *servant* provides the following combinator:
+
+``` haskell ignore
+data BasicAuth (realm :: Symbol) (userData :: *)
+```
+
+Which is used like so:
+
+``` haskell
+type ProtectedAPI12
+     = UserAPI                             -- this is public
+ :<|> BasicAuth "my-real" User :> UserAPI2 -- this is protected by auth
+```
+
+### Interoperability with `wai`: `Raw`
+
+Finally, we also include a combinator named `Raw` that provides an escape hatch
+to the underlying low-level web library `wai`. It can be used when
+you want to plug a [wai `Application`](http://hackage.haskell.org/package/wai)
+into your webservice:
+
+``` haskell
+type UserAPI11 = "users" :> Get '[JSON] [User]
+                 -- a /users endpoint
+
+            :<|> Raw
+                 -- requests to anything else than /users
+                 -- go here, where the server will try to
+                 -- find a file with the right name
+                 -- at the right path
+```
+
+One example for this is if you want to serve a directory of static files along
+with the rest of your API. But you can plug in everything that is an
+`Application`, e.g. a whole web application written in any of the web
+frameworks that support `wai`.

doc/tutorial/Authentication.lhs

@@ -0,0 +1,427 @@
+# Authentication in Servant
+
+Once you've established the basic routes and semantics of your API, it's time
+to consider protecting parts of it. Authentication and authorization are broad
+and nuanced topics; as servant began to explore this space we started small
+with one of HTTP's earliest authentication schemes: [Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication).
+
+Servant `0.5` shipped with out-of-the-box support for Basic Authentication.
+However, we recognize that every web application is its own beautiful snowflake
+and are offering experimental support for generalized or ad-hoc authentication.
+
+In this tutorial we'll build two APIs. One protecting certain routes with Basic
+Authentication and another protecting the same routes with a custom, in-house
+authentication scheme.
+
+## Basic Authentication
+
+When protecting endpoints with basic authentication, we need to specify two
+items:
+
+1. The **realm** of authentication as per the Basic Authentication spec.
+2. The datatype returned by the server after authentication is verified. This
+is usually a `User` or `Customer` datatype.
+
+With those two items in mind, *servant* provides the following combinator:
+
+``` haskell ignore
+data BasicAuth (realm :: Symbol) (userData :: *)
+```
+
+You can use this combinator to protect an API as follows:
+
+```haskell
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+module Authentication where
+
+import Control.Monad.Trans.Except       (ExceptT, throwE)
+import Data.Aeson                       (ToJSON)
+import Data.ByteString                  (ByteString)
+import Data.Map                         (Map, fromList)
+import Data.Monoid                      ((<>))
+import qualified Data.Map            as Map
+import Data.Proxy                       (Proxy (Proxy))
+import Data.Text                        (Text)
+import GHC.Generics                     (Generic)
+import Network.Wai                      (Request, requestHeaders)
+import Network.Wai.Handler.Warp         (run)
+import Servant.API                      ((:<|>) ((:<|>)), (:>), BasicAuth,
+                                          Get, JSON)
+import Servant.API.BasicAuth            (BasicAuthData (BasicAuthData))
+import Servant.API.Experimental.Auth    (AuthProtect)
+import Servant.Server                   (BasicAuthCheck (BasicAuthCheck),
+                                         BasicAuthResult( Authorized
+                                                        , Unauthorized
+                                                        ),
+                                         Context ((:.), EmptyContext),
+                                         err401, err403, errBody, Server,
+                                         ServantErr, serveWithContext)
+import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,
+                                         mkAuthHandler)
+import Servant.Server.Experimental.Auth()
+
+-- | private data that needs protection
+newtype PrivateData = PrivateData { ssshhh :: Text }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON PrivateData
+
+-- | public data that anyone can use.
+newtype PublicData = PublicData { somedata :: Text }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON PublicData
+
+-- | A user we'll grab from the database when we authenticate someone
+newtype User = User { userName :: Text }
+  deriving (Eq, Show)
+
+-- | a type to wrap our public api
+type PublicAPI = Get '[JSON] [PublicData]
+
+-- | a type to wrap our private api
+type PrivateAPI = Get '[JSON] PrivateData
+
+-- | our API
+type BasicAPI = "public"  :> PublicAPI
+           :<|> "private" :> BasicAuth "foo-realm" User :> PrivateAPI
+
+-- | a value holding a proxy of our API type
+basicAuthApi :: Proxy BasicAPI
+basicAuthApi = Proxy
+```
+
+You can see that we've prefixed our public API with "public" and our private
+API with "private." Additionally, the private parts of our API use the
+`BasicAuth` combinator to protect them under a Basic Authentication scheme (the
+realm for this authentication is `"foo-realm"`).
+
+Unfortunately we're not done. When someone makes a request to our `"private"`
+API, we're going to need to provide to servant the logic for validifying
+usernames and passwords. This adds a certain conceptual wrinkle in servant's
+design that we'll briefly discuss. If you want the **TL;DR**: we supply a lookup
+function to servant's new `Context` primitive.
+
+Until now, all of servant's API combinators extracted information from a request
+or dictated the structure of a response (e.g. a `Capture` param is pulled from
+the request path). Now consider an API resource protected by basic
+authentication. Once the required `WWW-Authenticate` header is checked, we need
+to verify the username and password. But how? One solution would be to force an
+API author to provide a function of type `BasicAuthData -> ExceptT ServantErr IO User`
+and servant should use this function to authenticate a request. Unfortunately
+this didn't work prior to `0.5` because all of servant's machinery was
+engineered around the idea that each combinator can extract information from
+only the request. We cannot extract the function
+`BasicAuthData -> ExceptT ServantErr IO User` from a request! Are we doomed?
+
+Servant `0.5` introduced `Context` to handle this. The type machinery is beyond
+the scope of this tutorial, but the idea is simple: provide some data to the
+`serve` function, and that data is propagated to the functions that handle each
+combinator. Using `Context`, we can supply a function of type
+`BasicAuthData -> ExceptT ServantErr IO User` to the `BasicAuth` combinator
+handler. This will allow the handler to check authentication and return a `User`
+to downstream handlers if successful.
+
+In practice we wrap `BasicAuthData -> ExceptT ServantErr IO` into a slightly
+different function to better capture the semantics of basic authentication:
+
+``` haskell ignore
+-- | The result of authentication/authorization
+data BasicAuthResult usr
+  = Unauthorized
+  | BadPassword
+  | NoSuchUser
+  | Authorized usr
+  deriving (Eq, Show, Read, Generic, Typeable, Functor)
+
+-- | Datatype wrapping a function used to check authentication.
+newtype BasicAuthCheck usr = BasicAuthCheck
+  { unBasicAuthCheck :: BasicAuthData
+                     -> IO (BasicAuthResult usr)
+  }
+  deriving (Generic, Typeable, Functor)
+```
+
+We now use this datatype to supply servant with a method to authenticate
+requests. In this simple example the only valid username and password is
+`"servant"` and `"server"`, respectively, but in a real, production application
+you might do some database lookup here.
+
+```haskell
+-- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password.
+authCheck :: BasicAuthCheck User
+authCheck =
+  let check (BasicAuthData username password) =
+        if username == "servant" && password == "server"
+        then return (Authorized (User "servant"))
+        else return Unauthorized
+  in BasicAuthCheck check
+```
+
+And now we create the `Context` used by servant to find `BasicAuthCheck`:
+
+```haskell
+-- | We need to supply our handlers with the right Context. In this case,
+-- Basic Authentication requires a Context Entry with the 'BasicAuthCheck' value
+-- tagged with "foo-tag" This context is then supplied to 'server' and threaded 
+-- to the BasicAuth HasServer handlers.
+basicAuthServerContext :: Context (BasicAuthCheck User ': '[])
+basicAuthServerContext = authCheck :. EmptyContext
+```
+
+We're now ready to write our `server` method that will tie everything together:
+
+```haskell
+-- | an implementation of our server. Here is where we pass all the handlers to our endpoints.
+-- In particular, for the BasicAuth protected handler, we need to supply a function
+-- that takes 'User' as an argument.
+basicAuthServer :: Server BasicAPI
+basicAuthServer =
+  let publicAPIHandler = return [PublicData "foo", PublicData "bar"]
+      privateAPIHandler (user :: User) = return (PrivateData (userName user))
+  in publicAPIHandler :<|> privateAPIHandler
+```
+
+Finally, our main method and a sample session working with our server:
+
+```haskell
+-- | hello, server!
+basicAuthMain :: IO ()
+basicAuthMain = run 8080 (serveWithContext basicAuthApi
+                                           basicAuthServerContext
+                                           basicAuthServer
+                         )
+
+{- Sample session
+
+$ curl -XGET localhost:8080/public
+[{"somedata":"foo"},{"somedata":"bar"}
+
+$ curl -iXGET localhost:8080/private
+HTTP/1.1 401 Unauthorized
+transfer-encoding: chunked
+Date: Thu, 07 Jan 2016 22:36:38 GMT
+Server: Warp/3.1.8
+WWW-Authenticate: Basic realm="foo-realm"
+
+$ curl -iXGET localhost:8080/private -H "Authorization: Basic c2VydmFudDpzZXJ2ZXI="
+HTTP/1.1 200 OK
+transfer-encoding: chunked
+Date: Thu, 07 Jan 2016 22:37:58 GMT
+Server: Warp/3.1.8
+Content-Type: application/json
+{"ssshhh":"servant"}
+-}
+```
+
+## Generalized Authentication
+
+Sometimes your server's authentication scheme doesn't quite fit with the
+standards (or perhaps servant hasn't rolled-out support for that new, fancy
+authentication scheme). For such a scenario, servant `0.5` provides easy and
+simple experimental support to roll your own authentication.
+
+Why experimental? We worked on the design for authentication for a long time. We
+really struggled to find a nice, type-safe niche in the design space. In fact,
+`Context` came out of this work, and while it really fit for schemes like Basic
+and JWT, it wasn't enough to fully support something like OAuth or HMAC, which
+have flows, roles, and other fancy ceremonies. Further, we weren't sure *how*
+people will use auth.
+
+So, in typical startup fashion, we developed an MVP of 'generalized auth' and
+released it in an experimental module, with the hope of getting feedback from you!
+So, if you're reading this or using generalized auth support, please give us
+your feedback!
+
+### What is Generalized Authentication?
+
+**TL;DR**: you throw a tagged `AuthProtect` combinator in front of the endpoints
+you want protected and then supply a function `Request -> ExceptT IO ServantErr user`
+which we run anytime a request matches a protected endpoint. It precisely solves
+the "I just need to protect these endpoints with a function that does some
+complicated business logic" and nothing more. Behind the scenes we use a type
+family instance (`AuthServerData`) and `Context` to accomplish this.
+
+### Generalized Authentication in Action
+
+Let's implement a trivial authentication scheme. We will protect our API by
+looking for a cookie named `"servant-auth-cookie"`. This cookie's value will
+contain a key from which we can lookup a `User`.
+
+```haskell
+-- | A user type that we "fetch from the database" after
+-- performing authentication
+newtype Account = Account { unAccount :: Text }
+
+-- | A (pure) database mapping keys to users.
+database :: Map ByteString Account
+database = fromList [ ("key1", Account "Anne Briggs")
+                    , ("key2", Account "Bruce Cockburn")
+                    , ("key3", Account "Ghédalia Tazartès")
+                    ]
+
+-- | A method that, when given a password, will return a Account.
+-- This is our bespoke (and bad) authentication logic.
+lookupAccount :: ByteString -> ExceptT ServantErr IO Account
+lookupAccount key = case Map.lookup key database of
+  Nothing -> throwE (err403 { errBody = "Invalid Cookie" })
+  Just usr -> return usr
+```
+
+For generalized authentication, servant exposes the `AuthHandler` type,
+which is used to wrap the `Request -> ExceptT IO ServantErr user` logic. Let's
+create a value of type `AuthHandler Request Account` using the above `lookupAccount`
+method:
+
+```haskell
+-- | The auth handler wraps a function from Request -> ExceptT ServantErr IO Account
+-- we look for a Cookie and pass the value of the cookie to `lookupAccount`.
+authHandler :: AuthHandler Request Account
+authHandler =
+  let handler req = case lookup "servant-auth-cookie" (requestHeaders req) of
+        Nothing -> throwE (err401 { errBody = "Missing auth header" })
+        Just authCookieKey -> lookupAccount authCookieKey
+  in mkAuthHandler handler
+```
+
+Let's now protect our API with our new, bespoke authentication scheme. We'll
+re-use the endpoints from our Basic Authentication example.
+
+```haskell
+-- | Our API, with auth-protection
+type AuthGenAPI = "private" :> AuthProtect "cookie-auth" :> PrivateAPI
+             :<|> "public"  :> PublicAPI
+
+-- | A value holding our type-level API
+genAuthAPI :: Proxy AuthGenAPI
+genAuthAPI = Proxy
+```
+
+Now we need to bring everything together for the server. We have the
+`AuthHandler Request Account` value and an `AuthProtected` endpoint. To bind these
+together, we need to provide a [Type Family](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/type-families.html)
+instance that tells the `HasServer` instance that our `Context` will supply a
+`Account` (via `AuthHandler Request Account`) and that downstream combinators will
+have access to this `Account` value (or an error will be thrown if authentication
+fails).
+
+```haskell
+
+-- | We need to specify the data returned after authentication
+type instance AuthServerData (AuthProtect "cookie-auth") = Account
+```
+
+Note that we specify the type-level tag `"cookie-auth"` when defining the type
+family instance. This allows us to have multiple authentication schemes
+protecting a single API.
+
+We now construct the `Context` for our server, allowing us to instantiate a
+value of type `Server AuthGenAPI`, in addition to the server value:
+
+```haskell
+-- | The context that will be made available to request handlers. We supply the 
+-- "cookie-auth"-tagged request handler defined above, so that the 'HasServer' instance
+-- of 'AuthProtect' can extract the handler and run it on the request.
+genAuthServerContext :: Context (AuthHandler Request Account ': '[])
+genAuthServerContext = authHandler :. EmptyContext
+
+-- | Our API, where we provide all the author-supplied handlers for each end
+-- point. Note that 'privateDataFunc' is a function that takes 'Account' as an
+-- argument. We dont' worry about the authentication instrumentation here,
+-- that is taken care of by supplying context
+genAuthServer :: Server AuthGenAPI
+genAuthServer =
+  let privateDataFunc (Account name) =
+          return (PrivateData ("this is a secret: " <> name))
+      publicData = return [PublicData "this is a public piece of data"]
+  in  privateDataFunc :<|> publicData
+```
+
+We're now ready to start our server (and provide a sample session)!
+
+```haskell
+-- | run our server
+genAuthMain :: IO ()
+genAuthMain = run 8080 (serveWithContext genAuthAPI genAuthServerContext genAuthServer)
+
+{- Sample Session:
+
+$ curl -XGET localhost:8080/private
+Missing auth header
+
+$ curl -XGET localhost:8080/private -H "servant-auth-cookie: key3"
+[{"ssshhh":"this is a secret: Ghédalia Tazartès"}]
+
+$ curl -XGET localhost:8080/private -H "servant-auth-cookie: bad-key"
+Invalid Cookie
+
+$ curl -XGET localhost:8080/public
+[{"somedata":"this is a public piece of data"}]
+-}
+```
+
+### Recap
+
+Creating a generalized, ad-hoc authentication scheme was fairly straight
+forward:
+
+1. use the `AuthProtect` combinator to protect your API.
+2. choose a application-specific data type used by your server when
+authentication is successful (in our case this was `User`).
+3. Create a value of `AuthHandler Request User` which encapsulates the
+authentication logic (`Request -> ExceptT IO ServantErr User`). This function
+will be executed everytime a request matches a protected route.
+4. Provide an instance of the `AuthServerData` type family, specifying your
+application-specific data type returned when authentication is successful (in
+our case this was `User`).
+
+Caveats:
+
+1. The module `Servant.Server.Experimental.Auth` contains an orphan `HasServer`
+instance for the `AuthProtect` combinator. You may be get orphan instance
+warnings when using this.
+2. Generalized authentication requires the `UndecidableInstances` extension.
+
+## Client-side Authentication
+
+### Basic Authentication
+
+As of `0.5`, *servant-client* comes with support for basic authentication!
+Endpoints protected by Basic Authentication will require a value of type
+`BasicAuthData` to complete the request.
+
+### Generalized Authentication
+
+Servant `0.5` also shipped with support for generalized authentication. Similar
+to the server-side support, clients need to supply an instance of the
+`AuthClientData` type family specifying the datatype the client will use to
+marshal an unauthenticated request into an authenticated request. Generally,
+this will look like:
+
+```haskell ignore
+-- | The datatype we'll use to authenticate a request. If we were wrapping
+-- something like OAuth, this might be a Bearer token.
+type instance AuthClientData (AuthProtect "cookie-auth") = String
+
+-- | A method to authenticate a request
+authenticateReq :: String -> Req -> Req
+authenticateReq s req = SCR.addHeader "my-bespoke-header" s req
+```
+
+Now, if the client method for our protected endpoint was `getProtected`, then
+we could perform authenticated requests as follows:
+
+```haskell ignore
+-- | one could curry this to make it simpler to work with.
+result = runExceptT (getProtected (mkAuthenticateReq "secret" authenticateReq))
+```

doc/tutorial/Client.lhs

@@ -0,0 +1,150 @@
+# Querying an API
+
+While defining handlers that serve an API has a lot to it, querying an API is simpler: we do not care about what happens inside the webserver, we just need to know how to talk to it and get a response back. Except that we usually have to write the querying functions by hand because the structure of the API isn't a first class citizen and can't be inspected to generate a bunch of client-side functions.
+
+**servant** however has a way to inspect APIs, because APIs are just Haskell types and (GHC) Haskell lets us do quite a few things with types. In the same way that we look at an API type to deduce the types the handlers should have, we can inspect the structure of the API to *derive* Haskell functions that take one argument for each occurence of `Capture`, `ReqBody`, `QueryParam`
+and friends. By *derive*, we mean that there's no code generation involved, the functions are defined just by the structure of the API type.
+
+The source for this tutorial section is a literate haskell file, so first we
+need to have some language extensions and imports:
+
+``` haskell
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Client where
+
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
+import Data.Aeson
+import Data.Proxy
+import GHC.Generics
+import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
+import Servant.API
+import Servant.Client
+```
+
+Also, we need examples for some domain specific data types:
+
+``` haskell
+data Position = Position
+  { x :: Int
+  , y :: Int
+  } deriving (Show, Generic)
+
+instance FromJSON Position
+
+newtype HelloMessage = HelloMessage { msg :: String }
+  deriving (Show, Generic)
+
+instance FromJSON HelloMessage
+
+data ClientInfo = ClientInfo
+  { clientName :: String
+  , clientEmail :: String
+  , clientAge :: Int
+  , clientInterestedIn :: [String]
+  } deriving Generic
+
+instance ToJSON ClientInfo
+
+data Email = Email
+  { from :: String
+  , to :: String
+  , subject :: String
+  , body :: String
+  } deriving (Show, Generic)
+
+instance FromJSON Email
+```
+
+Enough chitchat, let's see an example. Consider the following API type from the previous section:
+
+``` haskell
+type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
+      :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
+      :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email
+```
+
+What we are going to get with **servant-client** here is 3 functions, one to query each endpoint:
+
+``` haskell
+position :: Int -- ^ value for "x"
+         -> Int -- ^ value for "y"
+         -> Manager -- ^ the HTTP client to use
+         -> BaseUrl -- ^ the URL at which the API can be found
+         -> ExceptT ServantError IO Position
+
+hello :: Maybe String -- ^ an optional value for "name"
+      -> Manager -- ^ the HTTP client to use
+      -> BaseUrl -- ^ the URL at which the API can be found
+      -> ExceptT ServantError IO HelloMessage
+
+marketing :: ClientInfo -- ^ value for the request body
+          -> Manager -- ^ the HTTP client to use
+          -> BaseUrl -- ^ the URL at which the API can be found
+          -> ExceptT ServantError IO Email
+```
+
+Each function makes available as an argument any value that the response may
+depend on, as evidenced in the API type. How do we get these functions? By calling
+the function `client`. It takes one argument:
+
+- a `Proxy` to your API,
+
+``` haskell
+api :: Proxy API
+api = Proxy
+
+position :<|> hello :<|> marketing = client api
+```
+
+As you can see in the code above, we just "pattern match our way" to these functions. If we try to derive less or more functions than there are endpoints in the API, we obviously get an error. The `BaseUrl` value there is just:
+
+``` haskell ignore
+-- | URI scheme to use
+data Scheme =
+    Http  -- ^ http://
+  | Https -- ^ https://
+  deriving
+
+-- | Simple data type to represent the target of HTTP requests
+--   for servant's automatically-generated clients.
+data BaseUrl = BaseUrl
+  { baseUrlScheme :: Scheme -- ^ URI scheme to use
+  , baseUrlHost :: String   -- ^ host (eg "haskell.org")
+  , baseUrlPort :: Int      -- ^ port (eg 80)
+  }
+```
+
+That's it. Let's now write some code that uses our client functions.
+
+``` haskell
+queries :: Manager -> BaseUrl -> ExceptT ServantError IO (Position, HelloMessage, Email)
+queries manager baseurl = do
+  pos <- position 10 10 manager baseurl
+  message <- hello (Just "servant") manager baseurl
+  em  <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]) manager baseurl
+  return (pos, message, em)
+
+run :: IO ()
+run = do
+  manager <- newManager defaultManagerSettings
+  res <- runExceptT (queries manager (BaseUrl Http "localhost" 8081 ""))
+  case res of
+    Left err -> putStrLn $ "Error: " ++ show err
+    Right (pos, message, em) -> do
+      print pos
+      print message
+      print em
+```
+
+Here's the output of the above code running against the appropriate server:
+
+``` bash
+Position {x = 10, y = 10}
+HelloMessage {msg = "Hello, servant"}
+Email {from = "great@company.com", to = "alp@foo.com", subject = "Hey Alp, we miss you!", body = "Hi Alp,\n\nSince you've recently turned 26, have you checked out our latest haskell, mathematics products? Give us a visit!"}
+```
+
+The types of the arguments for the functions are the same as for (server-side) request handlers. You now know how to use **servant-client**!

doc/tutorial/Docs.lhs

@@ -0,0 +1,234 @@
+# Documenting an API
+
+The source for this tutorial section is a literate haskell file, so first we
+need to have some language extensions and imports:
+
+``` haskell
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Docs where
+
+import Data.ByteString.Lazy (ByteString)
+import Data.Proxy
+import Data.Text.Lazy.Encoding (encodeUtf8)
+import Data.Text.Lazy (pack)
+import Network.HTTP.Types
+import Network.Wai
+import Servant.API
+import Servant.Docs
+import Servant.Server
+```
+
+And we'll import some things from one of our earlier modules
+([Serving an API](Server.html)):
+
+``` haskell
+import Server (Email(..), ClientInfo(..), Position(..), HelloMessage(..),
+  server3, emailForClient)
+```
+
+Like client function generation, documentation generation amounts to inspecting the API type and extracting all the data we need to then present it in some format to users of your API.
+
+This time however, we have to assist **servant**. While it is able to deduce a lot of things about our API, it can't magically come up with descriptions of the various pieces of our APIs that are human-friendly and explain what's going on "at the business-logic level". A good example to study for documentation generation is our webservice with the `/position`, `/hello` and `/marketing` endpoints from earlier:
+
+``` haskell
+type ExampleAPI = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
+      :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
+      :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email
+
+exampleAPI :: Proxy ExampleAPI
+exampleAPI = Proxy
+```
+
+While **servant** can see e.g. that there are 3 endpoints and that the response bodies will be in JSON, it doesn't know what influence the captures, parameters, request bodies and other combinators have on the webservice. This is where some manual work is required.
+
+For every capture, request body, response body, query param, we have to give some explanations about how it influences the response, what values are possible and the likes. Here's how it looks like for the parameters we have above.
+
+``` haskell
+instance ToCapture (Capture "x" Int) where
+  toCapture _ =
+    DocCapture "x"                                -- name
+               "(integer) position on the x axis" -- description
+
+instance ToCapture (Capture "y" Int) where
+  toCapture _ =
+    DocCapture "y"                                -- name
+               "(integer) position on the y axis" -- description
+
+instance ToSample Position where
+  toSamples _ = singleSample (Position 3 14) -- example of output
+
+instance ToParam (QueryParam "name" String) where
+  toParam _ =
+    DocQueryParam "name"                     -- name
+                  ["Alp", "John Doe", "..."] -- example of values (not necessarily exhaustive)
+                  "Name of the person to say hello to." -- description
+                  Normal -- Normal, List or Flag
+
+instance ToSample HelloMessage where
+  toSamples _ =
+    [ ("When a value is provided for 'name'", HelloMessage "Hello, Alp")
+    , ("When 'name' is not specified", HelloMessage "Hello, anonymous coward")
+    ]
+    -- mutliple examples to display this time
+
+ci :: ClientInfo
+ci = ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
+
+instance ToSample ClientInfo where
+  toSamples _ = singleSample ci
+
+instance ToSample Email where
+  toSamples _ = singleSample (emailForClient ci)
+```
+
+Types that are used as request or response bodies have to instantiate the `ToSample` typeclass which lets you specify one or more examples of values. `Capture`s and `QueryParam`s have to instantiate their respective `ToCapture` and `ToParam` classes and provide a name and some information about the concrete meaning of that argument, as illustrated in the code above.
+
+With all of this, we can derive docs for our API.
+
+``` haskell
+apiDocs :: API
+apiDocs = docs exampleAPI
+```
+
+`API` is a type provided by **servant-docs** that stores all the information one needs about a web API in order to generate documentation in some format. Out of the box, **servant-docs** only provides a pretty documentation printer that outputs [Markdown](http://en.wikipedia.org/wiki/Markdown), but the [**servant-pandoc**](http://hackage.haskell.org/package/servant-pandoc) package can be used to target many useful formats.
+
+**servant**'s markdown pretty printer is a function named `markdown`.
+
+``` haskell ignore
+markdown :: API -> String
+```
+
+That lets us see what our API docs look down in markdown, by looking at `markdown apiDocs`.
+
+````````` text
+## Welcome
+
+This is our super webservice's API.
+
+Enjoy!
+
+## GET /hello
+
+#### GET Parameters:
+
+- name
+     - **Values**: *Alp, John Doe, ...*
+     - **Description**: Name of the person to say hello to.
+
+
+#### Response:
+
+- Status code 200
+- Headers: []
+
+- Supported content types are:
+
+    - `application/json`
+
+- When a value is provided for 'name'
+
+  ```javascript
+  {"msg":"Hello, Alp"}
+  ```
+
+- When 'name' is not specified
+
+  ```javascript
+  {"msg":"Hello, anonymous coward"}
+  ```
+
+## POST /marketing
+
+#### Request:
+
+- Supported content types are:
+
+    - `application/json`
+
+- Example: `application/json`
+
+  ```javascript
+  {"email":"alp@foo.com","interested_in":["haskell","mathematics"],"age":26,"name":"Alp"}
+  ```
+
+#### Response:
+
+- Status code 201
+- Headers: []
+
+- Supported content types are:
+
+    - `application/json`
+
+- Response body as below.
+
+  ```javascript
+  {"subject":"Hey Alp, we miss you!","body":"Hi Alp,\n\nSince you've recently turned 26, have you checked out our latest haskell, mathematics products? Give us a visit!","to":"alp@foo.com","from":"great@company.com"}
+  ```
+
+## GET /position/:x/:y
+
+#### Captures:
+
+- *x*: (integer) position on the x axis
+- *y*: (integer) position on the y axis
+
+#### Response:
+
+- Status code 200
+- Headers: []
+
+- Supported content types are:
+
+    - `application/json`
+
+- Response body as below.
+
+  ```javascript
+  {"x":3,"y":14}
+  ```
+
+`````````
+
+However, we can also add one or more introduction sections to the document. We just need to tweak the way we generate `apiDocs`. We will also convert the content to a lazy `ByteString` since this is what **wai** expects for `Raw` endpoints.
+
+``` haskell
+docsBS :: ByteString
+docsBS = encodeUtf8
+       . pack
+       . markdown
+       $ docsWithIntros [intro] exampleAPI
+
+  where intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"]
+```
+
+`docsWithIntros` just takes an additional parameter, a list of `DocIntro`s that must be displayed before any endpoint docs.
+
+We can now serve the API *and* the API docs with a simple server.
+
+``` haskell
+type DocsAPI = ExampleAPI :<|> Raw
+
+api :: Proxy DocsAPI
+api = Proxy
+
+server :: Server DocsAPI
+server = Server.server3 :<|> serveDocs
+
+  where serveDocs _ respond =
+          respond $ responseLBS ok200 [plain] docsBS
+
+        plain = ("Content-Type", "text/plain")
+
+app :: Application
+app = serve api server
+```
+
+And if you spin up this server and request anything else than `/position`, `/hello` and `/marketing`, you will see the API docs in markdown. This is because `serveDocs` is attempted if the 3 other endpoints don't match and systematically succeeds since its definition is to just return some fixed bytestring with the `text/plain` content type.

doc/tutorial/Javascript.lhs

@@ -0,0 +1,228 @@
+# Generating Javascript functions to query an API
+
+We will now see how **servant** lets you turn an API type into javascript
+functions that you can call to query a webservice.
+
+For this, we will consider a simple page divided in two parts. At the top, we
+will have a search box that lets us search in a list of Haskell books by
+author/title with a list of results that gets updated every time we enter or
+remove a character, while at the bottom we will be able to see the classical
+[probabilistic method to approximate
+pi](http://en.wikipedia.org/wiki/Approximations_of_%CF%80#Summing_a_circle.27s_area),
+using a webservice to get random points. Finally, we will serve an HTML file
+along with a couple of Javascript files, among which one that's automatically
+generated from the API type and which will provide ready-to-use functions to
+query your API.
+
+The source for this tutorial section is a literate haskell file, so first we
+need to have some language extensions and imports:
+
+``` haskell
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Javascript where
+
+import Control.Monad.IO.Class
+import Data.Aeson
+import Data.Proxy
+import Data.Text as T (Text)
+import Data.Text.IO as T (writeFile, readFile)
+import GHC.Generics
+import Language.Javascript.JQuery
+import Network.Wai
+import Network.Wai.Handler.Warp
+import qualified Data.Text as T
+import Servant
+import Servant.JS
+import System.Random
+```
+
+Now let's have the API type(s) and the accompanying datatypes.
+
+``` haskell
+type API = "point" :> Get '[JSON] Point
+      :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book)
+
+type API' = API :<|> Raw
+
+data Point = Point
+  { x :: Double
+  , y :: Double
+  } deriving Generic
+
+instance ToJSON Point
+
+data Search a = Search
+  { query   :: Text
+  , results :: [a]
+  } deriving Generic
+
+mkSearch :: Text -> [a] -> Search a
+mkSearch = Search
+
+instance ToJSON a => ToJSON (Search a)
+
+data Book = Book
+  { author :: Text
+  , title  :: Text
+  , year   :: Int
+  } deriving Generic
+
+instance ToJSON Book
+
+book :: Text -> Text -> Int -> Book
+book = Book
+```
+
+We need a "book database". For the purpose of this guide, let's restrict
+ourselves to the following books.
+
+``` haskell
+books :: [Book]
+books =
+  [ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000
+  , book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008
+  , book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011
+  , book "Graham Hutton" "Programming in Haskell" 2007
+  , book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013
+  , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
+  ]
+```
+
+Now, given an optional search string `q`, we want to perform a case insensitive
+search in that list of books. We're obviously not going to try and implement
+the best possible algorithm, this is out of scope for this tutorial. The
+following simple linear scan will do, given how small our list is.
+
+``` haskell
+searchBook :: Monad m => Maybe Text -> m (Search Book)
+searchBook Nothing  = return (mkSearch "" books)
+searchBook (Just q) = return (mkSearch q books')
+
+  where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b)
+                            || q' `T.isInfixOf` T.toLower (title b)
+                        )
+                        books
+        q' = T.toLower q
+```
+
+We also need an endpoint that generates random points `(x, y)` with `-1 <= x,y
+<= 1`. The code below uses
+[random](http://hackage.haskell.org/package/random)'s `System.Random`.
+
+``` haskell
+randomPoint :: MonadIO m => m Point
+randomPoint = liftIO . getStdRandom $ \g ->
+  let (rx, g')  = randomR (-1, 1) g
+      (ry, g'') = randomR (-1, 1) g'
+  in (Point rx ry, g'')
+```
+
+If we add static file serving, our server is now complete.
+
+``` haskell
+api :: Proxy API
+api = Proxy
+
+api' :: Proxy API'
+api' = Proxy
+
+server :: Server API
+server = randomPoint
+    :<|> searchBook
+
+server' :: Server API'
+server' = server
+     :<|> serveDirectory "static"
+
+app :: Application
+app = serve api' server'
+
+main :: IO ()
+main = run 8000 app
+```
+
+Why two different API types, proxies and servers though? Simply because we
+don't want to generate javascript functions for the `Raw` part of our API type,
+so we need a `Proxy` for our API type `API'` without its `Raw` endpoint.
+
+Very similarly to how one can derive haskell functions, we can derive the
+javascript with just a simple function call to `jsForAPI` from
+`Servant.JQuery`.
+
+``` haskell
+apiJS :: Text
+apiJS = jsForAPI api vanillaJS
+```
+
+This `Text` contains 2 Javascript functions, 'getPoint' and 'getBooks':
+
+``` javascript
+var getPoint = function(onSuccess, onError)
+{
+  var xhr = new XMLHttpRequest();
+  xhr.open('GET', '/point', true);
+  xhr.setRequestHeader("Accept","application/json");
+  xhr.onreadystatechange = function (e) {
+    if (xhr.readyState == 4) {
+      if (xhr.status == 204 || xhr.status == 205) {
+        onSuccess();
+      } else if (xhr.status >= 200 && xhr.status < 300) {
+        var value = JSON.parse(xhr.responseText);
+        onSuccess(value);
+      } else {
+        var value = JSON.parse(xhr.responseText);
+        onError(value);
+      }
+    }
+  }
+  xhr.send(null);
+}
+
+var getBooks = function(q, onSuccess, onError)
+{
+  var xhr = new XMLHttpRequest();
+  xhr.open('GET', '/books' + '?q=' + encodeURIComponent(q), true);
+  xhr.setRequestHeader("Accept","application/json");
+  xhr.onreadystatechange = function (e) {
+    if (xhr.readyState == 4) {
+      if (xhr.status == 204 || xhr.status == 205) {
+        onSuccess();
+      } else if (xhr.status >= 200 && xhr.status < 300) {
+        var value = JSON.parse(xhr.responseText);
+        onSuccess(value);
+      } else {
+        var value = JSON.parse(xhr.responseText);
+        onError(value);
+      }
+    }
+  }
+  xhr.send(null);
+}
+```
+
+We created a directory `static` that contains two static files: `index.html`,
+which is the entrypoint to our little web application; and `ui.js`, which
+contains some hand-written javascript. This javascript code assumes the two
+generated functions `getPoint` and `getBooks` in scope. Therefore we need to
+write the generated javascript into a file:
+
+``` haskell
+writeJSFiles :: IO ()
+writeJSFiles = do
+  T.writeFile "static/api.js" apiJS
+  jq <- T.readFile =<< Language.Javascript.JQuery.file
+  T.writeFile "static/jq.js" jq
+```
+
+(We're also writing the jquery library into a file, as it's also used by
+`ui.js`.) `static/api.js` will be included in `index.html` and the two
+generated functions will therefore be available in `ui.js`.
+
+And we're good to go. You can start the `main` function of this file and go to
+`http://localhost:8000/`. Start typing in the name of one of the authors in our
+database or part of a book title, and check out how long it takes to
+approximate pi using the method mentioned above.

doc/tutorial/LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2015, Alp Mestanogullari
+Copyright (c) 2016, Servant Contributors
 
 All rights reserved.
 
@@ -13,7 +13,7 @@ modification, are permitted provided that the following conditions are met:
       disclaimer in the documentation and/or other materials provided
       with the distribution.
 
-    * Neither the name of Alp Mestanogullari nor the names of other
+    * Neither the name of Servant Contributors nor the names of other
       contributors may be used to endorse or promote products derived
       from this software without specific prior written permission.
 

doc/tutorial/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

doc/tutorial/index.rst

@@ -0,0 +1,24 @@
+Tutorial
+========
+
+This is an introductory tutorial to **servant**.
+
+.. note::
+   This tutorial is for the latest version of servant.  The tutorial for
+   servant-0.4 can be viewed
+   `here <https://haskell-servant.github.io/tutorial/>`_.
+
+(Any comments, issues or feedback about the tutorial can be handled
+through
+`servant's issue tracker <http://github.com/haskell-servant/servant/issues>`_.)
+
+
+.. toctree::
+  :maxdepth: 1
+
+  ApiType.lhs
+  Server.lhs
+  Client.lhs
+  Javascript.lhs
+  Docs.lhs
+  Authentication.lhs

doc/tutorial/static/index.html

@@ -3,11 +3,11 @@
   <head>
     <meta name="viewport" content="width=device-width, initial-scale=1">
     <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
-    <title>Tutorial - 9 - servant-jquery</title>
+    <title>servant-js Example</title>
   </head>
   <body>
   <h1>Books</h1>
-  <input type="search" name="q" id="q" placeholder="Search author or book title..." />
+  <input type="search" name="q" id="q" placeholder="Search author or book title..." autocomplete="off"/>
   <div>
     <p>Results for <strong id="query">""</strong></p>
     <ul id="results">
@@ -23,4 +23,4 @@
   <script type="text/javascript" src="/api.js"></script>
   <script type="text/javascript" src="/ui.js"></script>
 
-  </body>
+  </body>

doc/tutorial/static/ui.js

@@ -58,4 +58,3 @@ function refresh()
 }
 
 window.setInterval(refresh, 200);
-

doc/tutorial/test/JavascriptSpec.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module JavascriptSpec where
+
+import           Data.List
+import           Data.String
+import           Data.String.Conversions
+import           Test.Hspec
+import           Test.Hspec.Wai
+
+import           Javascript
+
+spec :: Spec
+spec = do
+  describe "apiJS" $ do
+    it "is contained verbatim in Javascript.lhs" $ do
+      code <- readFile "Javascript.lhs"
+      cs apiJS `shouldSatisfy` (`isInfixOf` code)
+
+  describe "writeJSFiles" $ do
+    it "[not a test] write apiJS to static/api.js" $ do
+      writeJSFiles
+
+  describe "app" $ with (return app) $ do
+    context "/api.js" $ do
+      it "delivers apiJS" $ do
+        get "/api.js" `shouldRespondWith` (fromString (cs apiJS))
+
+    context "/" $ do
+      it "delivers something" $ do
+        get "" `shouldRespondWith` 200
+        get "/" `shouldRespondWith` 200

doc/tutorial/test/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

doc/tutorial/tinc.yaml

@@ -0,0 +1,13 @@
+dependencies:
+  - name: servant
+    path: ../../servant
+  - name: servant-server
+    path: ../../servant-server
+  - name: servant-client
+    path: ../../servant-client
+  - name: servant-js
+    path: ../../servant-js
+  - name: servant-docs
+    path: ../../servant-docs
+  - name: servant-foreign
+    path: ../../servant-foreign

doc/tutorial/tutorial.cabal

@@ -0,0 +1,65 @@
+name:                tutorial
+version:             0.6
+synopsis:            The servant tutorial
+homepage:            http://haskell-servant.github.io/
+license:             BSD3
+license-file:        LICENSE
+author:              Servant Contributors
+maintainer:          haskell-servant-maintainers@googlegroups.com
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     ApiType
+                     , Authentication
+                     , Client
+                     , Docs
+                     , Javascript
+                     , Server
+  build-depends:       base == 4.*
+                     , base-compat
+                     , text
+                     , aeson
+                     , aeson-compat
+                     , blaze-html
+                     , directory
+                     , blaze-markup
+                     , containers
+                     , servant == 0.6.*
+                     , servant-server == 0.6.*
+                     , servant-client == 0.6.*
+                     , servant-docs == 0.6.*
+                     , servant-js == 0.6.*
+                     , warp
+                     , http-media
+                     , lucid
+                     , time
+                     , string-conversions
+                     , bytestring
+                     , attoparsec
+                     , mtl
+                     , random
+                     , js-jquery
+                     , wai
+                     , http-types
+                     , transformers
+                     , markdown-unlit >= 0.4
+                     , http-client
+  default-language:    Haskell2010
+  ghc-options:         -Wall -Werror -pgmL markdown-unlit
+  -- to silence aeson-0.10 warnings:
+  ghc-options:         -fno-warn-missing-methods
+  ghc-options:         -fno-warn-name-shadowing
+
+test-suite spec
+  type: exitcode-stdio-1.0
+  ghc-options:
+    -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures
+  default-language: Haskell2010
+  hs-source-dirs: test
+  main-is: Spec.hs
+  build-depends: base == 4.*
+               , tutorial
+               , hspec
+               , hspec-wai
+               , string-conversions

scripts/README.md

@@ -0,0 +1,8 @@
+The release process works roughly like this:
+
+``` bash
+./scripts/bump-versions.sh <type-of-bump>
+git commit
+./scripts/upload.hs
+git tag <version> && git push --tags
+```

scripts/bump-versions.sh

@@ -56,10 +56,7 @@ done
 
 if $DRY_RUN ; then
    echo "Would have bumped position ${POSITION} on these packages:"
-   ( cd "$ROOT" && bumper --dry-run -"$POSITION" $(join , "${SOURCES[@]}") )
+   ( cd "$ROOT" && bumper --dry-run -"$POSITION" $(join , $SOURCES tutorial) )
 else
-   ( cd "$ROOT" && bumper -"$POSITION" $(join , "${SOURCES[@]}") )
+   ( cd "$ROOT" && bumper -"$POSITION" $(join , $SOURCES tutorial) )
 fi
-
-# Trailing newline, bumper does not ship with its own.
-echo

scripts/upload.hs

@@ -0,0 +1,14 @@
+#!/usr/bin/env stack
+{- stack
+--resolver lts-3.10
+--install-ghc runghc
+-}
+
+import           Data.Foldable
+import           System.Process
+
+main :: IO ()
+main = do
+  sources <- words <$> readFile "sources.txt"
+  forM_ sources $ \ source -> do
+    callCommand ("stack upload " ++ source)

scripts/upload.sh

@@ -1,52 +0,0 @@
-#!/usr/bin/env bash
-#===============================================================================
-#
-#          FILE: upload.sh
-#
-#         USAGE: ./upload.sh <USER> <PASSWORD>
-#
-#   DESCRIPTION: Uploads all servant packages to Hackage
-#
-#  REQUIREMENTS: cabal, bash >= 4
-#        AUTHOR: Julian K. Arni
-#       CREATED: 05.06.2015 13:05
-#===============================================================================
-
-set -o nounset
-set -o errexit
-
-DIR=$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )
-. "$DIR"/lib/common.sh
-
-usage () {
-    echo " upload.sh <USER> <PASSWORD>"
-    echo "    Uploads all servant packages to Hackage"
-    exit 0
-}
-
-
-upload_package () {
-    local package="$1"
-    local user="$2"
-    local pass="$3"
-    local cabalFile="$package.cabal"
-    pushd "$package"
-    local version=$(grep -i '^version:' $cabalFile | awk '{ print $2 }')
-    local sdist="dist/${package}-${version}.tar.gz"
-    cabal sdist
-    echo "User is: $user"
-    cabal upload --user="$user" --password="$pass" "$sdist"
-    popd
-}
-
-
-if [ $# -ne 2 ] ; then
-    echo "expecting two arguments."
-    usage
-fi
-
-versions_equal
-
-for s in ${SOURCES[@]} ; do
-    upload_package "$s" "$1" "$2"
-done

servant-blaze/LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2015, Julian K. Arni
+Copyright (c) 2015-2016, Servant Contributors
 
 All rights reserved.
 

servant-blaze/include/overlapping-compat.h

@@ -0,0 +1,8 @@
+#if __GLASGOW_HASKELL__ >= 710
+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
+#define OVERLAPPING_  {-# OVERLAPPING #-}
+#else
+{-# LANGUAGE OverlappingInstances #-}
+#define OVERLAPPABLE_
+#define OVERLAPPING_
+#endif

servant-blaze/servant-blaze.cabal

@@ -2,18 +2,18 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                servant-blaze
-version:             0.5
+version:             0.6
 synopsis:            Blaze-html support for servant
 -- description:
 homepage:            http://haskell-servant.github.io/
 license:             BSD3
 license-file:        LICENSE
-author:              Julian K. Arni
+author:              Servant Contributors
-maintainer:          jkarni@gmail.com
+maintainer:          haskell-servant-maintainers@googlegroups.com
--- copyright:
+copyright:           2015-2016 Servant Contributors
 category:            Web
 build-type:          Simple
--- extra-source-files:
+extra-source-files:  include/*.h
 cabal-version:       >=1.10
 bug-reports:         http://github.com/haskell-servant/servant/issues
 source-repository head
@@ -25,8 +25,9 @@ library
   -- other-modules:
   -- other-extensions:
   build-depends:       base >=4.7 && <5
-                     , servant == 0.5.*
+                     , servant == 0.6.*
                      , http-media
                      , blaze-html
   hs-source-dirs:      src
   default-language:    Haskell2010
+  include-dirs: include

servant-blaze/src/Servant/HTML/Blaze.hs

@@ -3,10 +3,8 @@
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
-#if !MIN_VERSION_base(4,8,0)
-{-# LANGUAGE OverlappingInstances  #-}
-#endif
 
+#include "overlapping-compat.h"
 -- | An @HTML@ empty data type with `MimeRender` instances for @blaze-html@'s
 -- `ToMarkup` class and `Html` datatype.
 -- You should only need to import this module for it's instances and the
@@ -29,17 +27,9 @@ data HTML deriving Typeable
 instance Accept HTML where
     contentType _ = "text" M.// "html" M./: ("charset", "utf-8")
 
-instance
+instance OVERLAPPABLE_ ToMarkup a => MimeRender HTML a where
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPABLE #-}
-#endif
-         ToMarkup a => MimeRender HTML a where
     mimeRender _ = renderHtml . toHtml
 
-instance
+instance OVERLAPPING_ MimeRender HTML Html where
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-         MimeRender HTML Html where
     mimeRender _ = renderHtml
 

servant-cassava/LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2015, Julian K. Arni
+Copyright (c) 2015-2016, Servant Contributors
 
 All rights reserved.
 

servant-cassava/include/overlapping-compat.h

@@ -0,0 +1,8 @@
+#if __GLASGOW_HASKELL__ >= 710
+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
+#define OVERLAPPING_  {-# OVERLAPPING #-}
+#else
+{-# LANGUAGE OverlappingInstances #-}
+#define OVERLAPPABLE_
+#define OVERLAPPING_
+#endif

servant-cassava/servant-cassava.cabal

@@ -2,18 +2,18 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                servant-cassava
-version:             0.4.4.2
+version:             0.6
 synopsis:            Servant CSV content-type for cassava
 -- description:
 homepage:            http://haskell-servant.github.io/
 license:             BSD3
 license-file:        LICENSE
-author:              Julian K. Arni
+author:              Servant Contributors
-maintainer:          jkarni@gmail.com
+maintainer:          haskell-servant-maintainers@googlegroups.com
--- copyright:
+copyright:           2015-2016 Servant Contributors
 -- category:
 build-type:          Simple
--- extra-source-files:
+extra-source-files:  include/*.h
 cabal-version:       >=1.10
 
 library
@@ -22,8 +22,9 @@ library
   -- other-extensions:
   build-depends:       base >=4.6 && <5
                      , cassava >0.4 && <0.5
-                     , servant ==0.5.*
+                     , servant == 0.6.*
                      , http-media
                      , vector
   hs-source-dirs:      src
   default-language:    Haskell2010
+  include-dirs: include

servant-client/CHANGELOG.md

@@ -1,13 +1,21 @@
-HEAD
+0.6
-----
+---
+
+* `client` no longer takes `BaseUrl` and `Manager` arguments. Instead, each function returned by `client` requires these two arguments.
+
+0.5
+---
 
 * Use the `text` package instead of `String`.
 * 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`
-* Client functions now consider any 2xx succesful.
+* Client functions now consider any 2xx successful.
 * Remove matrix params.
+* Added support for Basic authentication
+* Add generalized authentication support via the `AuthClientData` type family and
+  `AuthenticateReq` data type
 
 0.4.1
 -----

servant-client/LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2014, Zalora South East Asia Pte Ltd
+Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors
 
 All rights reserved.
 

servant-client/include/overlapping-compat.h

@@ -0,0 +1,8 @@
+#if __GLASGOW_HASKELL__ >= 710
+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
+#define OVERLAPPING_  {-# OVERLAPPING #-}
+#else
+{-# LANGUAGE OverlappingInstances #-}
+#define OVERLAPPABLE_
+#define OVERLAPPING_
+#endif

servant-client/servant-client.cabal

@@ -1,5 +1,5 @@
 name:                servant-client
-version:             0.5
+version:             0.6
 synopsis: automatical derivation of querying functions for servant webservices
 description:
   This library lets you derive automatically Haskell functions that
@@ -10,11 +10,12 @@ description:
   <https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md CHANGELOG>
 license:             BSD3
 license-file:        LICENSE
-author:              Alp Mestanogullari, Sönke Hahn, Julian K. Arni
+author:              Servant Contributors
-maintainer:          alpmestan@gmail.com
+maintainer:          haskell-servant-maintainers@googlegroups.com
-copyright:           2014 Zalora South East Asia Pte Ltd
+copyright:           2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors
 category:            Web
 build-type:          Simple
+extra-source-files:  include/*.h
 cabal-version:       >=1.10
 tested-with:         GHC >= 7.8
 homepage:            http://haskell-servant.github.io/
@@ -26,7 +27,9 @@ source-repository head
 library
   exposed-modules:
     Servant.Client
+    Servant.Client.Experimental.Auth
     Servant.Common.BaseUrl
+    Servant.Common.BasicAuth
     Servant.Common.Req
   other-modules:
     Servant.Client.PerformRequest
@@ -41,7 +44,9 @@ library
       base >=4.7 && <5
     , aeson
     , attoparsec
+    , base64-bytestring
     , bytestring
+    , case-insensitive
     , exceptions
     , http-api-data >= 0.1  && < 0.3
     , http-client
@@ -50,7 +55,7 @@ library
     , http-types
     , network-uri >= 2.6
     , safe
-    , servant == 0.5.*
+    , servant == 0.6.*
     , string-conversions
     , text
     , transformers
@@ -59,10 +64,10 @@ library
     build-depends:
         ghcjs-base
       , ghcjs-prim
-      , case-insensitive
   hs-source-dirs: src
   default-language: Haskell2010
   ghc-options: -Wall
+  include-dirs: include
 
 test-suite spec
   type: exitcode-stdio-1.0
@@ -88,6 +93,7 @@ test-suite spec
     , transformers
     , transformers-compat
     , aeson
+    , base64-bytestring
     , bytestring
     , deepseq
     , hspec >= 2.2.1 && < 2.3
@@ -97,8 +103,8 @@ test-suite spec
     , HUnit
     , network >= 2.6
     , QuickCheck >= 2.7
-    , servant == 0.5.*
+    , servant == 0.6.*
-    , servant-server == 0.5.*
+    , servant-server == 0.6.*
     , text
     , wai
     , warp
@@ -114,3 +120,4 @@ test-suite spec
         ghcjs-base
       , ghcjs-prim
       , case-insensitive
+  include-dirs: include

servant-client/src/Servant/Client.hs

@@ -4,19 +4,23 @@
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE InstanceSigs         #-}
 {-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE PolyKinds            #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE UndecidableInstances #-}
-#if !MIN_VERSION_base(4,8,0)
+
-{-# LANGUAGE OverlappingInstances #-}
+#include "overlapping-compat.h"
-#endif
 -- | This module provides 'client' which can automatically generate
 -- querying functions for each endpoint just from the type representing your
 -- API.
 module Servant.Client
-  ( client
+  ( AuthClientData
+  , AuthenticateReq(..)
+  , client
   , HasClient(..)
+  , ClientM
+  , mkAuthenticateReq
   , ServantError(..)
   , module Servant.Common.BaseUrl
   ) where
@@ -24,20 +28,20 @@ module Servant.Client
 #if !MIN_VERSION_base(4,8,0)
 import           Control.Applicative        ((<$>))
 #endif
-import           Control.Monad
-import           Control.Monad.Trans.Except
 import           Data.ByteString.Lazy       (ByteString)
 import           Data.List
 import           Data.Proxy
 import           Data.String.Conversions
 import           Data.Text                  (unpack)
 import           GHC.TypeLits
-import           Network.HTTP.Client        (Response, Manager)
+import           Network.HTTP.Client        (Manager, Response)
 import           Network.HTTP.Media
 import qualified Network.HTTP.Types         as H
 import qualified Network.HTTP.Types.Header  as HTTP
 import           Servant.API
+import           Servant.Client.Experimental.Auth
 import           Servant.Common.BaseUrl
+import           Servant.Common.BasicAuth
 import           Servant.Common.Req
 import           Servant.Client.PerformRequest (ServantError(..))
 
@@ -46,24 +50,23 @@ import           Servant.Client.PerformRequest (ServantError(..))
 -- | 'client' allows you to produce operations to query an API from a client.
 --
 -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
--- >         :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
+-- >         :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books
 -- >
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > getAllBooks :: ExceptT String IO [Book]
+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
--- > postNewBook :: Book -> ExceptT String IO Book
+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
--- > (getAllBooks :<|> postNewBook) = client myApi host manager
+-- > (getAllBooks :<|> postNewBook) = client myApi
--- >   where host = BaseUrl Http "localhost" 8080
+client :: HasClient layout => Proxy layout -> Client layout
-client :: HasClient layout => Proxy layout -> BaseUrl -> Manager -> Client layout
+client p = clientWithRoute p defReq
-client p baseurl = clientWithRoute p defReq baseurl
 
 -- | This class lets us define how each API combinator
 -- influences the creation of an HTTP request. It's mostly
 -- an internal class, you can just use 'client'.
 class HasClient layout where
   type Client layout :: *
-  clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Manager -> Client layout
+  clientWithRoute :: Proxy layout -> Req -> Client layout
 
 
 -- | A client querying function for @a ':<|>' b@ will actually hand you
@@ -76,15 +79,14 @@ class HasClient layout where
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > getAllBooks :: ExceptT String IO [Book]
+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
--- > postNewBook :: Book -> ExceptT String IO Book
+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
--- > (getAllBooks :<|> postNewBook) = client myApi host manager
+-- > (getAllBooks :<|> postNewBook) = client myApi
--- >   where host = BaseUrl Http "localhost" 8080
 instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
   type Client (a :<|> b) = Client a :<|> Client b
-  clientWithRoute Proxy req baseurl manager =
+  clientWithRoute Proxy req =
-    clientWithRoute (Proxy :: Proxy a) req baseurl manager :<|>
+    clientWithRoute (Proxy :: Proxy a) req :<|>
-    clientWithRoute (Proxy :: Proxy b) req baseurl manager
+    clientWithRoute (Proxy :: Proxy b) req
 
 -- | If you use a 'Capture' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
@@ -102,9 +104,8 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > getBook :: Text -> ExceptT String IO Book
+-- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book
--- > getBook = client myApi host manager
+-- > getBook = client myApi
--- >   where host = BaseUrl Http "localhost" 8080
 -- > -- then you can just use "getBook" to query that endpoint
 instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
       => HasClient (Capture capture a :> sublayout) where
@@ -112,88 +113,55 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
   type Client (Capture capture a :> sublayout) =
     a -> Client sublayout
 
-  clientWithRoute Proxy req baseurl manager val =
+  clientWithRoute Proxy req val =
     clientWithRoute (Proxy :: Proxy sublayout)
                     (appendToPath p req)
-                    baseurl
-                    manager
 
     where p = unpack (toUrlPiece val)
 
--- | If you have a 'Delete' endpoint in your API, the client
+instance OVERLAPPABLE_
--- side querying function that is created when calling 'client'
+  -- Note [Non-Empty Content Types]
--- will just require an argument that specifies the scheme, host
+  (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
--- and port to send the request to.
+  ) => HasClient (Verb method status cts' a) where
-instance
+  type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a
-#if MIN_VERSION_base(4,8,0)
+  clientWithRoute Proxy req manager baseurl =
-         {-# OVERLAPPABLE #-}
+    snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl
-#endif
+      where method = reflectMethod (Proxy :: Proxy method)
-  (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where
-  type Client (Delete cts' a) = ExceptT ServantError IO a
-  clientWithRoute Proxy req baseurl manager =
-    snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl manager
 
-instance
+instance OVERLAPPING_
-#if MIN_VERSION_base(4,8,0)
+  (ReflectMethod method) => HasClient (Verb method status cts NoContent) where
-         {-# OVERLAPPING #-}
+  type Client (Verb method status cts NoContent)
-#endif
+    = Manager -> BaseUrl -> ClientM NoContent
-  HasClient (Delete cts ()) where
+  clientWithRoute Proxy req manager baseurl =
-  type Client (Delete cts ()) = ExceptT ServantError IO ()
+    performRequestNoBody method req manager baseurl >> return NoContent
-  clientWithRoute Proxy req baseurl manager =
+      where method = reflectMethod (Proxy :: Proxy method)
-    void $ performRequestNoBody H.methodDelete req baseurl manager
 
--- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the
+instance OVERLAPPING_
--- corresponding headers.
+  -- Note [Non-Empty Content Types]
-instance
+  ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
-#if MIN_VERSION_base(4,8,0)
+  ) => HasClient (Verb method status cts' (Headers ls a)) where
-         {-# OVERLAPPING #-}
+  type Client (Verb method status cts' (Headers ls a))
-#endif
+    = Manager -> BaseUrl -> ClientM (Headers ls a)
-  ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)
+  clientWithRoute Proxy req manager baseurl = do
-  ) => HasClient (Delete cts' (Headers ls a)) where
+    let method = reflectMethod (Proxy :: Proxy method)
-  type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
+    (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl
-  clientWithRoute Proxy req baseurl manager = do
-    (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl manager
     return $ Headers { getResponse = resp
                      , getHeadersHList = buildHeadersTo hdrs
                      }
 
--- | If you have a 'Get' endpoint in your API, the client
+instance OVERLAPPING_
--- side querying function that is created when calling 'client'
+  ( BuildHeadersTo ls, ReflectMethod method
--- will just require an argument that specifies the scheme, host
+  ) => HasClient (Verb method status cts (Headers ls NoContent)) where
--- and port to send the request to.
+  type Client (Verb method status cts (Headers ls NoContent))
-instance
+    = Manager -> BaseUrl -> ClientM (Headers ls NoContent)
-#if MIN_VERSION_base(4,8,0)
+  clientWithRoute Proxy req manager baseurl = do
-         {-# OVERLAPPABLE #-}
+    let method = reflectMethod (Proxy :: Proxy method)
-#endif
+    hdrs <- performRequestNoBody method req manager baseurl
-  (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
+    return $ Headers { getResponse = NoContent
-  type Client (Get (ct ': cts) result) = ExceptT ServantError IO result
-  clientWithRoute Proxy req baseurl manager =
-    snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl manager
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  HasClient (Get (ct ': cts) ()) where
-  type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()
-  clientWithRoute Proxy req baseurl manager =
-    performRequestNoBody H.methodGet req baseurl manager
-
--- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the
--- corresponding headers.
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  ( MimeUnrender ct a, BuildHeadersTo ls
-  ) => HasClient (Get (ct ': cts) (Headers ls a)) where
-  type Client (Get (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
-  clientWithRoute Proxy req baseurl manager = do
-    (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl manager
-    return $ Headers { getResponse = resp
                      , getHeadersHList = buildHeadersTo hdrs
                      }
 
+
 -- | If you use a 'Header' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
 -- an additional argument of the type specified by your 'Header',
@@ -207,7 +175,7 @@ instance
 -- Example:
 --
 -- > newtype Referer = Referer { referrer :: Text }
--- >   deriving (Eq, Show, Generic, FromText, ToHttpApiData)
+-- >   deriving (Eq, Show, Generic, ToHttpApiData)
 -- >
 -- >            -- GET /view-my-referer
 -- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
@@ -215,9 +183,8 @@ instance
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > viewReferer :: Maybe Referer -> ExceptT String IO Book
+-- > viewReferer :: Maybe Referer -> Manager -> BaseUrl -> ClientM Book
--- > viewReferer = client myApi host
+-- > viewReferer = client myApi
--- >   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, ToHttpApiData a, HasClient sublayout)
@@ -226,127 +193,25 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
   type Client (Header sym a :> sublayout) =
     Maybe a -> Client sublayout
 
-  clientWithRoute Proxy req baseurl manager mval =
+  clientWithRoute Proxy req mval =
     clientWithRoute (Proxy :: Proxy sublayout)
                     (maybe req
                            (\value -> Servant.Common.Req.addHeader hname value req)
                            mval
                     )
-                    baseurl
-                    manager
 
     where hname = symbolVal (Proxy :: Proxy sym)
 
--- | If you have a 'Post' endpoint in your API, the client
+-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
--- side querying function that is created when calling 'client'
+-- functions.
--- will just require an argument that specifies the scheme, host
+instance HasClient sublayout
--- and port to send the request to.
+  => HasClient (HttpVersion :> sublayout) 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) = ExceptT ServantError IO a
-  clientWithRoute Proxy req baseurl manager =
-    snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl manager
 
-instance
+  type Client (HttpVersion :> sublayout) =
-#if MIN_VERSION_base(4,8,0)
+    Client sublayout
-         {-# OVERLAPPING #-}
-#endif
-  HasClient (Post (ct ': cts) ()) where
-  type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()
-  clientWithRoute Proxy req baseurl manager =
-    void $ performRequestNoBody H.methodPost req baseurl manager
 
--- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the
+  clientWithRoute Proxy =
--- corresponding headers.
+    clientWithRoute (Proxy :: Proxy sublayout)
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  ( MimeUnrender ct a, BuildHeadersTo ls
-  ) => HasClient (Post (ct ': cts) (Headers ls a)) where
-  type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
-  clientWithRoute Proxy req baseurl manager = do
-    (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl manager
-    return $ Headers { getResponse = resp
-                     , getHeadersHList = buildHeadersTo hdrs
-                     }
-
--- | If you have a 'Put' endpoint in your API, the client
--- side querying function that is created when calling 'client'
--- will just require an argument that specifies the scheme, host
--- and port to send the request to.
-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) = ExceptT ServantError IO a
-  clientWithRoute Proxy req baseurl manager =
-    snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl manager
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  HasClient (Put (ct ': cts) ()) where
-  type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()
-  clientWithRoute Proxy req baseurl manager =
-    void $ performRequestNoBody H.methodPut req baseurl manager
-
--- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the
--- corresponding headers.
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  ( MimeUnrender ct a, BuildHeadersTo ls
-  ) => HasClient (Put (ct ': cts) (Headers ls a)) where
-  type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
-  clientWithRoute Proxy req baseurl manager= do
-    (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl manager
-    return $ Headers { getResponse = resp
-                     , getHeadersHList = buildHeadersTo hdrs
-                     }
-
--- | If you have a 'Patch' endpoint in your API, the client
--- side querying function that is created when calling 'client'
--- will just require an argument that specifies the scheme, host
--- and port to send the request to.
-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) = ExceptT ServantError IO a
-  clientWithRoute Proxy req baseurl manager =
-    snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl manager
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  HasClient (Patch (ct ': cts) ()) where
-  type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()
-  clientWithRoute Proxy req baseurl manager =
-    void $ performRequestNoBody H.methodPatch req baseurl manager
-
--- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the
--- corresponding headers.
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  ( MimeUnrender ct a, BuildHeadersTo ls
-  ) => HasClient (Patch (ct ': cts) (Headers ls a)) where
-  type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
-  clientWithRoute Proxy req baseurl manager = do
-    (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl manager
-    return $ Headers { getResponse = resp
-                     , getHeadersHList = buildHeadersTo hdrs
-                     }
 
 -- | If you use a 'QueryParam' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
@@ -368,9 +233,8 @@ instance
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
+-- > getBooksBy :: Maybe Text -> Manager -> BaseUrl -> ClientM [Book]
--- > getBooksBy = client myApi host
+-- > getBooksBy = client myApi
--- >   where host = BaseUrl Http "localhost" 8080
 -- > -- 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
@@ -381,14 +245,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
     Maybe a -> Client sublayout
 
   -- if mparam = Nothing, we don't add it to the query string
-  clientWithRoute Proxy req baseurl manager mparam =
+  clientWithRoute Proxy req mparam =
     clientWithRoute (Proxy :: Proxy sublayout)
                     (maybe req
                            (flip (appendToQueryString pname) req . Just)
                            mparamText
                     )
-                    baseurl
-                    manager
 
     where pname  = cs pname'
           pname' = symbolVal (Proxy :: Proxy sym)
@@ -415,9 +277,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > getBooksBy :: [Text] -> ExceptT String IO [Book]
+-- > getBooksBy :: [Text] -> Manager -> BaseUrl -> ClientM [Book]
--- > getBooksBy = client myApi host
+-- > getBooksBy = client myApi
--- >   where host = BaseUrl Http "localhost" 8080
 -- > -- then you can just use "getBooksBy" to query that endpoint.
 -- > -- 'getBooksBy []' for all books
 -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
@@ -428,13 +289,12 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
   type Client (QueryParams sym a :> sublayout) =
     [a] -> Client sublayout
 
-  clientWithRoute Proxy req baseurl manager paramlist =
+  clientWithRoute Proxy req paramlist =
     clientWithRoute (Proxy :: Proxy sublayout)
                     (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
                             req
                             paramlist'
                     )
-                    baseurl manager
 
     where pname  = cs pname'
           pname' = symbolVal (Proxy :: Proxy sym)
@@ -456,9 +316,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > getBooks :: Bool -> ExceptT String IO [Book]
+-- > getBooks :: Bool -> Manager -> BaseUrl -> ClientM [Book]
--- > getBooks = client myApi host
+-- > getBooks = client myApi
--- >   where host = BaseUrl Http "localhost" 8080
 -- > -- then you can just use "getBooks" to query that endpoint.
 -- > -- 'getBooksBy False' for all books
 -- > -- 'getBooksBy True' to only get _already published_ books
@@ -468,13 +327,12 @@ instance (KnownSymbol sym, HasClient sublayout)
   type Client (QueryFlag sym :> sublayout) =
     Bool -> Client sublayout
 
-  clientWithRoute Proxy req baseurl manager flag =
+  clientWithRoute Proxy req flag =
     clientWithRoute (Proxy :: Proxy sublayout)
                     (if flag
                        then appendToQueryString paramname Nothing req
                        else req
                     )
-                    baseurl manager
 
     where paramname = cs $ symbolVal (Proxy :: Proxy sym)
 
@@ -482,11 +340,12 @@ instance (KnownSymbol sym, HasClient sublayout)
 -- | Pick a 'Method' and specify where the server you want to query is. You get
 -- back the full `Response`.
 instance HasClient Raw where
-  type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
+  type Client Raw
+    = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
 
-  clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw
+  clientWithRoute :: Proxy Raw -> Req -> Client Raw
-  clientWithRoute Proxy req baseurl manager httpMethod = do
+  clientWithRoute Proxy req httpMethod = do
-    performRequest httpMethod req baseurl manager
+    performRequest httpMethod req
 
 -- | If you use a 'ReqBody' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take
@@ -503,9 +362,8 @@ instance HasClient Raw where
 -- > myApi :: Proxy MyApi
 -- > myApi = Proxy
 -- >
--- > addBook :: Book -> ExceptT String IO Book
+-- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book
--- > addBook = client myApi host manager
+-- > addBook = client myApi
--- >   where host = BaseUrl Http "localhost" 8080
 -- > -- then you can just use "addBook" to query that endpoint
 instance (MimeRender ct a, HasClient sublayout)
       => HasClient (ReqBody (ct ': cts) a :> sublayout) where
@@ -513,40 +371,77 @@ instance (MimeRender ct a, HasClient sublayout)
   type Client (ReqBody (ct ': cts) a :> sublayout) =
     a -> Client sublayout
 
-  clientWithRoute Proxy req baseurl manager body =
+  clientWithRoute Proxy req body =
     clientWithRoute (Proxy :: Proxy sublayout)
                     (let ctProxy = Proxy :: Proxy ct
                      in setRQBody (mimeRender ctProxy body)
                                   (contentType ctProxy)
                                   req
                     )
-                    baseurl manager
 
 -- | Make the querying function append @path@ to the request path.
 instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
   type Client (path :> sublayout) = Client sublayout
 
-  clientWithRoute Proxy req baseurl manager =
+  clientWithRoute Proxy req =
      clientWithRoute (Proxy :: Proxy sublayout)
                      (appendToPath p req)
-                     baseurl manager
 
     where p = symbolVal (Proxy :: Proxy path)
 
 instance HasClient api => HasClient (Vault :> api) where
   type Client (Vault :> api) = Client api
 
-  clientWithRoute Proxy req baseurl manager =
+  clientWithRoute Proxy req =
-    clientWithRoute (Proxy :: Proxy api) req baseurl manager
+    clientWithRoute (Proxy :: Proxy api) req
 
 instance HasClient api => HasClient (RemoteHost :> api) where
   type Client (RemoteHost :> api) = Client api
 
-  clientWithRoute Proxy req baseurl manager =
+  clientWithRoute Proxy req =
-    clientWithRoute (Proxy :: Proxy api) req baseurl manager
+    clientWithRoute (Proxy :: Proxy api) req
 
 instance HasClient api => HasClient (IsSecure :> api) where
   type Client (IsSecure :> api) = Client api
 
-  clientWithRoute Proxy req baseurl manager =
+  clientWithRoute Proxy req =
-    clientWithRoute (Proxy :: Proxy api) req baseurl manager
+    clientWithRoute (Proxy :: Proxy api) req
+
+instance HasClient subapi =>
+  HasClient (WithNamedContext name context subapi) where
+
+  type Client (WithNamedContext name context subapi) = Client subapi
+  clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
+
+instance ( HasClient api
+         ) => HasClient (AuthProtect tag :> api) where
+  type Client (AuthProtect tag :> api)
+    = AuthenticateReq (AuthProtect tag) -> Client api
+
+  clientWithRoute Proxy req (AuthenticateReq (val,func)) =
+    clientWithRoute (Proxy :: Proxy api) (func val req)
+
+-- * Basic Authentication
+
+instance HasClient api => HasClient (BasicAuth realm usr :> api) where
+  type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api
+
+  clientWithRoute Proxy req val =
+    clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req)
+
+
+{- Note [Non-Empty Content Types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Rather than have
+
+   instance (..., cts' ~ (ct ': cts)) => ... cts' ...
+
+It may seem to make more sense to have:
+
+   instance (...) => ... (ct ': cts) ...
+
+But this means that if another instance exists that does *not* require
+non-empty lists, but is otherwise more specific, no instance will be overall
+more specific. This in turn generally means adding yet another instance (one
+for empty and one for non-empty lists).
+-}

servant-client/src/Servant/Client/Experimental/Auth.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TypeFamilies      #-}
+
+-- | Authentication for clients
+
+module Servant.Client.Experimental.Auth (
+    AuthenticateReq(AuthenticateReq, unAuthReq)
+  , AuthClientData
+  , mkAuthenticateReq
+  ) where
+
+import Servant.Common.Req (Req)
+
+-- | For a resource protected by authentication (e.g. AuthProtect), we need
+-- to provide the client with some data used to add authentication data
+-- to a request
+--
+-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
+type family AuthClientData a :: *
+
+-- | For better type inference and to avoid usage of a data family, we newtype
+-- wrap the combination of some 'AuthClientData' and a function to add authentication
+-- data to a request
+--
+-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
+newtype AuthenticateReq a =
+  AuthenticateReq { unAuthReq :: (AuthClientData a, AuthClientData a -> Req -> Req) }
+
+-- | Handy helper to avoid wrapping datatypes in tuples everywhere.
+--
+-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
+mkAuthenticateReq :: AuthClientData a
+                  -> (AuthClientData a -> Req -> Req)
+                  -> AuthenticateReq a
+mkAuthenticateReq val func = AuthenticateReq (val, func)

servant-client/src/Servant/Common/BasicAuth.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TypeFamilies      #-}
+
+-- | Basic Authentication for clients
+
+module Servant.Common.BasicAuth (
+    basicAuthReq
+  ) where
+
+import Data.ByteString.Base64 (encode)
+import Data.Monoid ((<>))
+import Data.Text.Encoding (decodeUtf8)
+import Servant.Common.Req (addHeader, Req)
+import Servant.API.BasicAuth (BasicAuthData(BasicAuthData))
+
+-- | Authenticate a request using Basic Authentication
+basicAuthReq :: BasicAuthData -> Req -> Req
+basicAuthReq (BasicAuthData user pass) req =
+    let authText = decodeUtf8 ("Basic " <> encode (user <> ":" <> pass))
+    in addHeader "Authorization" authText req

servant-client/src/Servant/Common/Req.hs

@@ -18,6 +18,7 @@ import Data.String.Conversions
 import Data.Proxy
 import Data.Text (Text)
 import Data.Text.Encoding
+import Data.Typeable
 import Network.HTTP.Client hiding (Proxy, path)
 import Network.HTTP.Media
 import Network.HTTP.Types
@@ -30,6 +31,8 @@ import Web.HttpApiData
 
 import qualified Network.HTTP.Client as Client
 
+import Web.HttpApiData
+
 data Req = Req
   { reqPath   :: String
   , qs        :: QueryText
@@ -96,18 +99,19 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
 displayHttpRequest :: Method -> String
 displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
 
+type ClientM = ExceptT ServantError IO
 
-performRequest :: Method -> Req -> BaseUrl -> Manager
+performRequest :: Method -> Req -> Manager -> BaseUrl
-               -> ExceptT ServantError IO ( Int, ByteString, MediaType
+               -> ClientM ( Int, ByteString, MediaType
-                                          , [HTTP.Header], Response ByteString)
+                          , [HTTP.Header], Response ByteString)
-performRequest reqMethod req reqHost manager = do
+performRequest reqMethod req manager reqHost = do
   partialRequest <- liftIO $ reqToRequest req reqHost
 
   let request = partialRequest { Client.method = reqMethod
                                , checkStatus = \ _status _headers _cookies -> Nothing
                                }
 
-  eResponse <- liftIO $ performHttpRequest manager request
+  eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager
   case eResponse of
     Left err ->
       throwE . ConnectionError $ SomeException err
@@ -115,7 +119,7 @@ performRequest reqMethod req reqHost manager = do
     Right response -> do
       let status = Client.responseStatus response
           body = Client.responseBody response
-          hrds = Client.responseHeaders response
+          hdrs = Client.responseHeaders response
           status_code = statusCode status
       ct <- case lookup "Content-Type" $ Client.responseHeaders response of
                  Nothing -> pure $ "application"//"octet-stream"
@@ -124,20 +128,28 @@ performRequest reqMethod req reqHost manager = do
                    Just t' -> pure t'
       unless (status_code >= 200 && status_code < 300) $
         throwE $ FailureResponse status ct body
-      return (status_code, body, ct, hrds, response)
+      return (status_code, body, ct, hdrs, response)
 
 
 performRequestCT :: MimeUnrender ct result =>
-  Proxy ct -> Method -> Req -> BaseUrl -> Manager -> ExceptT ServantError IO ([HTTP.Header], result)
+  Proxy ct -> Method -> Req -> Manager -> BaseUrl
-performRequestCT ct reqMethod req reqHost manager = do
+    -> ClientM ([HTTP.Header], result)
+performRequestCT ct reqMethod req manager reqHost = do
   let acceptCT = contentType ct
-  (_status, respBody, respCT, hrds, _response) <-
+  (_status, respBody, respCT, hdrs, _response) <-
-    performRequest reqMethod (req { reqAccept = [acceptCT] }) reqHost manager
+    performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost
   unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody
   case mimeUnrender ct respBody of
     Left err -> throwE $ DecodeFailure err respCT respBody
-    Right val -> return (hrds, val)
+    Right val -> return (hdrs, val)
 
-performRequestNoBody :: Method -> Req -> BaseUrl -> Manager -> ExceptT ServantError IO ()
+performRequestNoBody :: Method -> Req -> Manager -> BaseUrl
-performRequestNoBody reqMethod req reqHost manager =
+  -> ClientM [HTTP.Header]
-  void $ performRequest reqMethod req reqHost manager
+performRequestNoBody reqMethod req manager reqHost = do
+  (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost
+  return hdrs
+
+catchConnectionError :: IO a -> IO (Either ServantError a)
+catchConnectionError action =
+  catch (Right <$> action) $ \e ->
+    pure . Left . ConnectionError $ SomeException (e :: HttpException)

servant-client/stack-ghcjs.yaml

@@ -7,15 +7,15 @@ packages:
   - location: ../servant-server
     extra-dep: true
 
-resolver: lts-3.10
+resolver: lts-5.11
 
-compiler: ghcjs-0.2.0.20151029_ghc-7.10.2
+compiler: ghcjs-0.2.0.20160315_ghc-7.10.2
 compiler-check: match-exact
 setup-info:
- ghcjs:
+  ghcjs:
-  source:
+    source:
-   ghcjs-0.2.0.20151029_ghc-7.10.2:
+      ghcjs-0.2.0.20160315_ghc-7.10.2:
-    url: "https://github.com/nrolland/ghcjs/releases/download/v0.2.0.20151029/ghcjs-0.2.0.20151029.tar.gz"
+        url: "https://github.com/nrolland/ghcjs/releases/download/v.0.2.0.20160315/ghcjs-0.2.0.20160315.tar.gz"
 
 extra-deps:
   - hspec-expectations-0.7.2

servant-client/test/Servant/Client/TestServer.hs

@@ -4,7 +4,7 @@ module Servant.Client.TestServer (
   buildTestServer,
   TestServer(..),
   withServer,
-)where
+) where
 
 #ifdef __GHCJS__
 import           Servant.Client.TestServer.GHCJS

servant-client/test/Servant/ClientSpec.hs

@@ -6,40 +6,36 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GADTs                  #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
-#if !MIN_VERSION_base(4,8,0)
-{-# LANGUAGE OverlappingInstances   #-}
-#endif
 {-# LANGUAGE OverloadedStrings      #-}
 {-# LANGUAGE PolyKinds              #-}
 {-# LANGUAGE RecordWildCards        #-}
-{-# LANGUAGE ScopedTypeVariables    #-}
 {-# LANGUAGE StandaloneDeriving     #-}
+{-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE TypeOperators          #-}
 {-# LANGUAGE UndecidableInstances   #-}
 {-# OPTIONS_GHC -fcontext-stack=100 #-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Servant.ClientSpec where
 
 #if !MIN_VERSION_base(4,8,0)
-import           Control.Applicative        ((<$>), pure)
+import           Control.Applicative        ((<$>))
 #endif
 import           Control.Arrow              (left)
 import           Control.Monad.Trans.Except (runExceptT, throwE)
 import           Data.Aeson
+import qualified Data.ByteString.Lazy       as BS
 import           Data.Char                  (chr, isPrint)
 import           Data.Foldable              (forM_)
 import           Data.Monoid                hiding (getLast)
 import           Data.Proxy
 import qualified Data.Text                  as T
 import           GHC.Generics               (Generic)
-import           GHC.TypeLits
 import qualified Network.HTTP.Client        as C
 import           Network.HTTP.Media
-import           Network.HTTP.Types         (Status (..), badRequest400,
+import qualified Network.HTTP.Types as HTTP
-                                             methodGet, ok200, status400)
+import           Network.Wai                (Application, responseLBS)
-import           Network.Wai                (responseLBS)
+import qualified Network.Wai as Wai
 import           System.IO.Unsafe           (unsafePerformIO)
 import           Test.HUnit
 import           Test.Hspec
@@ -49,14 +45,16 @@ import           Test.QuickCheck
 import           Servant.API
 import           Servant.Client
 import           Servant.Client.TestServer
+import qualified Servant.Common.Req as SCR
 import           Servant.Server
+import           Servant.Server.Experimental.Auth
 
 spec :: Spec
-spec = do
+spec = describe "Servant.Client" $ do
-  runIO buildTestServer
-  describe "Servant.Client" $ do
     sucessSpec
     failSpec
+    basicAuthSpec
+    genAuthSpec
     errorSpec
 
 -- | Run a test-server (identified by name) while performing the given action.
@@ -129,7 +127,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]
 
 type Api =
        "get" :> Get '[JSON] Person
-  :<|> "deleteEmpty" :> Delete '[] ()
+  :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent
   :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
   :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
   :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
@@ -142,16 +140,44 @@ type Api =
             QueryParam "second" Int :>
             QueryFlag "third" :>
             ReqBody '[JSON] [(String, [Rational])] :>
-            Post '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
+            Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])
   :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)
-  :<|> "deleteContentType" :> Delete '[JSON] ()
+  :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent
 api :: Proxy Api
 api = Proxy
 
+getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person
+getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
+getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person
+getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person
+getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person
+getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]
+getQueryFlag :: Bool -> C.Manager -> BaseUrl -> SCR.ClientM Bool
+getRawSuccess :: HTTP.Method -> C.Manager -> BaseUrl
+  -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
+getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl
+  -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
+getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl
+  -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])
+getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool)
+getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent
+getGet
+  :<|> getDeleteEmpty
+  :<|> getCapture
+  :<|> getBody
+  :<|> getQueryParam
+  :<|> getQueryParams
+  :<|> getQueryFlag
+  :<|> getRawSuccess
+  :<|> getRawFailure
+  :<|> getMultiple
+  :<|> getRespHeaders
+  :<|> getDeleteContentType = client api
+
 server :: TestServer
 server = TestServer "server" $ serve api (
        return alice
-  :<|> return ()
+  :<|> return NoContent
   :<|> (\ name -> return $ Person name 0)
   :<|> return
   :<|> (\ name -> case name of
@@ -160,11 +186,11 @@ server = TestServer "server" $ serve api (
                    Nothing -> throwE $ ServantErr 400 "missing parameter" "" [])
   :<|> (\ names -> return (zipWith Person names [0..]))
   :<|> return
-  :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
+  :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")
-  :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
+  :<|> (\ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure")
   :<|> (\ a b c d -> return (a, b, c, d))
   :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
-  :<|> return ()
+  :<|> return NoContent
  )
 
 type FailApi =
@@ -177,10 +203,56 @@ failApi = Proxy
 
 failServer :: TestServer
 failServer = TestServer "failServer" $ serve failApi (
-       (\ _request respond -> respond $ responseLBS ok200 [] "")
+       (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "")
-  :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
+  :<|> (\ _capture _request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "")
-  :<|> (\ _request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
+  :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
-  )
+ )
+
+-- * basic auth stuff
+
+type BasicAuthAPI =
+       BasicAuth "foo-realm" () :> "private" :> "basic" :> Get '[JSON] Person
+
+basicAuthAPI :: Proxy BasicAuthAPI
+basicAuthAPI = Proxy
+
+basicAuthHandler :: BasicAuthCheck ()
+basicAuthHandler =
+  let check (BasicAuthData username password) =
+        if username == "servant" && password == "server"
+        then return (Authorized ())
+        else return Unauthorized
+  in BasicAuthCheck check
+
+basicServerContext :: Context '[ BasicAuthCheck () ]
+basicServerContext = basicAuthHandler :. EmptyContext
+
+basicAuthServer :: Application
+basicAuthServer = serveWithContext basicAuthAPI basicServerContext (const (return alice))
+
+-- * general auth stuff
+
+type GenAuthAPI =
+  AuthProtect "auth-tag" :> "private" :> "auth" :> Get '[JSON] Person
+
+genAuthAPI :: Proxy GenAuthAPI
+genAuthAPI = Proxy
+
+type instance AuthServerData (AuthProtect "auth-tag") = ()
+type instance AuthClientData (AuthProtect "auth-tag") = ()
+
+genAuthHandler :: AuthHandler Wai.Request ()
+genAuthHandler =
+  let handler req = case lookup "AuthHeader" (Wai.requestHeaders req) of
+        Nothing -> throwE (err401 { errBody = "Missing auth header" })
+        Just _ -> return ()
+  in mkAuthHandler handler
+
+genAuthServerContext :: Context '[ AuthHandler Wai.Request () ]
+genAuthServerContext = genAuthHandler :. EmptyContext
+
+genAuthServer :: Application
+genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice))
 
 {-# NOINLINE manager #-}
 manager :: C.Manager
@@ -190,76 +262,64 @@ sucessSpec :: Spec
 sucessSpec = around (withTestServer "server") $ do
 
     it "Servant.API.Get" $ \baseUrl -> do
-      let getGet = getNth (Proxy :: Proxy 0) $ client api baseUrl manager
+      (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice
-      (left show <$> runExceptT getGet) `shouldReturn` Right alice
 
     describe "Servant.API.Delete" $ do
       it "allows empty content type" $ \baseUrl -> do
-        let getDeleteEmpty = getNth (Proxy :: Proxy 1) $ client api baseUrl manager
+        (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent
-        (left show <$> runExceptT getDeleteEmpty) `shouldReturn` Right ()
 
       it "allows content type" $ \baseUrl -> do
-        let getDeleteContentType = getLast $ client api baseUrl manager
+        (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent
-        (left show <$> runExceptT getDeleteContentType) `shouldReturn` Right ()
 
     it "Servant.API.Capture" $ \baseUrl -> do
-      let getCapture = getNth (Proxy :: Proxy 2) $ client api baseUrl manager
+      (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)
-      (left show <$> runExceptT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
 
     it "Servant.API.ReqBody" $ \baseUrl -> do
       let p = Person "Clara" 42
-          getBody = getNth (Proxy :: Proxy 3) $ client api baseUrl manager
+      (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p
-      (left show <$> runExceptT (getBody p)) `shouldReturn` Right p
 
     it "Servant.API.QueryParam" $ \baseUrl -> do
-      let getQueryParam = getNth (Proxy :: Proxy 4) $ client api baseUrl manager
+      left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice
-      left show <$> runExceptT (getQueryParam (Just "alice")) `shouldReturn` Right alice
+      Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl)
-      Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob"))
+      responseStatus `shouldBe` HTTP.Status 400 "bob not found"
-      responseStatus `shouldBe` Status 400 "bob not found"
 
     it "Servant.API.QueryParam.QueryParams" $ \baseUrl -> do
-      let getQueryParams = getNth (Proxy :: Proxy 5) $ client api baseUrl manager
+      (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right []
-      (left show <$> runExceptT (getQueryParams [])) `shouldReturn` Right []
+      (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl))
-      (left show <$> runExceptT (getQueryParams ["alice", "bob"]))
         `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
 
     context "Servant.API.QueryParam.QueryFlag" $
       forM_ [False, True] $ \ flag -> it (show flag) $ \baseUrl -> do
-        let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api baseUrl manager
+        (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag
-        (left show <$> runExceptT (getQueryFlag flag)) `shouldReturn` Right flag
 
     it "Servant.API.Raw on success" $ \baseUrl -> do
-      let getRawSuccess = getNth (Proxy :: Proxy 7) $ client api baseUrl manager
+      res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl)
-      res <- runExceptT (getRawSuccess methodGet)
       case res of
         Left e -> assertFailure $ show e
         Right (code, body, ct, _, response) -> do
           (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
           C.responseBody response `shouldBe` body
-          C.responseStatus response `shouldBe` ok200
+          C.responseStatus response `shouldBe` HTTP.ok200
 
     it "Servant.API.Raw should return a Left in case of failure" $ \baseUrl -> do
-      let getRawFailure = getNth (Proxy :: Proxy 8) $ client api baseUrl manager
+      res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl)
-      res <- runExceptT (getRawFailure methodGet)
       case res of
         Right _ -> assertFailure "expected Left, but got Right"
         Left e -> do
-          Servant.Client.responseStatus e `shouldBe` status400
+          Servant.Client.responseStatus e `shouldBe` HTTP.status400
           Servant.Client.responseBody e `shouldBe` "rawFailure"
 
     it "Returns headers appropriately" $ \baseUrl -> do
-      let getRespHeaders = getNth (Proxy :: Proxy 10) $ client api baseUrl manager
+      res <- runExceptT (getRespHeaders manager baseUrl)
-      res <- runExceptT getRespHeaders
       case res of
         Left e -> assertFailure $ show e
         Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
 
-    modifyMaxSuccess (const 2) $ do
+    modifyMaxSuccess (const 20) $ do
       it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \baseUrl ->
-        let getMultiple = getNth (Proxy :: Proxy 9) $ client api baseUrl manager
+        property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
-        in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
           ioProperty $ do
-            result <- left show <$> runExceptT (getMultiple cap num flag body)
+            result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl)
             return $
               result === Right (cap, num, flag, body)
 
@@ -284,47 +344,81 @@ errorSpec =
     describe "error status codes" $
       it "reports error statuses correctly" $ \baseUrl -> do
         let delete :<|> get :<|> post :<|> put =
-              client errorApi baseUrl manager
+              client errorApi
-            actions = [delete, get, post, put]
+            actions = map (\ f -> f manager baseUrl) [delete, get, post, put]
         forM_ actions $ \ clientAction -> do
           Left FailureResponse{..} <- runExceptT clientAction
-          responseStatus `shouldBe` Status 500 "error message"
+          responseStatus `shouldBe` HTTP.Status 500 "error message"
+
+basicAuthSpec :: Spec
+basicAuthSpec = around (withTestServer "basicAuthServer") $ do
+  context "Authentication works when requests are properly authenticated" $ do
+
+    it "Authenticates a BasicAuth protected server appropriately" $ \baseUrl -> do
+      let getBasic = client basicAuthAPI
+      let basicAuthData = BasicAuthData "servant" "server"
+      (left show <$> runExceptT (getBasic basicAuthData manager baseUrl)) `shouldReturn` Right alice
+
+  context "Authentication is rejected when requests are not authenticated properly" $ do
+
+    it "Authenticates a BasicAuth protected server appropriately" $ \baseUrl -> do
+      let getBasic = client basicAuthAPI
+      let basicAuthData = BasicAuthData "not" "password"
+      Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl)
+      responseStatus `shouldBe` HTTP.Status 403 "Forbidden"
+
+genAuthSpec :: Spec
+genAuthSpec = around (withTestServer "genAuthServer") $ do
+  context "Authentication works when requests are properly authenticated" $ do
+
+    it "Authenticates a AuthProtect protected server appropriately" $ \baseUrl -> do
+      let getProtected = client genAuthAPI
+      let authRequest = mkAuthenticateReq () (\_ req ->  SCR.addHeader "AuthHeader" ("cool" :: String) req)
+      (left show <$> runExceptT (getProtected authRequest manager baseUrl)) `shouldReturn` Right alice
+
+  context "Authentication is rejected when requests are not authenticated properly" $ do
+
+    it "Authenticates a AuthProtect protected server appropriately" $ \baseUrl -> do
+      let getProtected = client genAuthAPI
+      let authRequest = mkAuthenticateReq () (\_ req ->  SCR.addHeader "Wrong" ("header" :: String) req)
+      Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl)
+      responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
 
 failSpec :: Spec
 failSpec = around (withTestServer "failServer") $ do
 
     context "client returns errors appropriately" $ do
       it "reports FailureResponse" $ \baseUrl -> do
-        let (_ :<|> getDeleteEmpty :<|> _) = client api baseUrl manager
+        let (_ :<|> getDeleteEmpty :<|> _) = client api
-        Left res <- runExceptT getDeleteEmpty
+        Left res <- runExceptT (getDeleteEmpty manager baseUrl)
         case res of
-          FailureResponse (Status 404 "Not Found") _ _ -> return ()
+          FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()
           _ -> fail $ "expected 404 response, but got " <> show res
 
       it "reports DecodeFailure" $ \baseUrl -> do
-        let (_ :<|> _ :<|> getCapture :<|> _) = client api baseUrl manager
+        let (_ :<|> _ :<|> getCapture :<|> _) = client api
-        Left res <- runExceptT (getCapture "foo")
+        Left res <- runExceptT (getCapture "foo" manager baseUrl)
         case res of
           DecodeFailure _ ("application/json") _ -> return ()
           _ -> fail $ "expected DecodeFailure, but got " <> show res
 
       it "reports ConnectionError" $ \_ -> do
-        let (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager
+        let (getGetWrongHost :<|> _) = client api
-        Left res <- runExceptT getGetWrongHost
+        Left res <- runExceptT (getGetWrongHost manager (BaseUrl Http "127.0.0.1" 19872 ""))
         case res of
           ConnectionError _ -> return ()
           _ -> fail $ "expected ConnectionError, but got " <> show res
 
       it "reports UnsupportedContentType" $ \baseUrl -> do
-        let (getGet :<|> _ ) = client api baseUrl manager
+        let (getGet :<|> _ ) = client api
-        Left res <- runExceptT getGet
+        Left res <- runExceptT (getGet manager baseUrl)
         case res of
           UnsupportedContentType ("application/octet-stream") _ -> return ()
           _ -> fail $ "expected UnsupportedContentType, but got " <> show res
 
       it "reports InvalidContentTypeHeader" $ \baseUrl -> do
-        let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api baseUrl manager
+        let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
-        Left res <- runExceptT (getBody alice)
+        Left res <- runExceptT (getBody alice manager baseUrl)
         case res of
           InvalidContentTypeHeader "fooooo" _ -> return ()
           _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
@@ -339,37 +433,3 @@ pathGen = fmap NonEmpty path
     filter (not . (`elem` ("?%[]/#;" :: String))) $
     filter isPrint $
     map chr [0..127]
-
-class GetNth (n :: Nat) a b | n a -> b where
-    getNth :: Proxy n -> a -> b
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  GetNth 0 (x :<|> y) x where
-      getNth _ (x :<|> _) = x
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where
-      getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x
-
-class GetLast a b | a -> b where
-    getLast :: a -> b
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  (GetLast b c) => GetLast (a :<|> b) c where
-      getLast (_ :<|> b) = getLast b
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-  GetLast a a where
-      getLast a = a

servant-docs/.ghci

@@ -0,0 +1 @@
+:set -itest -isrc -Iinclude

servant-docs/CHANGELOG.md

@@ -1,4 +1,4 @@
-HEAD
+0.5
 ----
 
 * Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
@@ -9,6 +9,7 @@ HEAD
 * Move `toSample` out of `ToSample` class
 * Add a few helper functions to define `toSamples`
 * Remove matrix params.
+* Added support for Basic authentication
 
 0.4
 ---

servant-docs/LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2014, Zalora South East Asia Pte Ltd
+Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors
 
 All rights reserved.
 

servant-docs/include/overlapping-compat.h

@@ -0,0 +1,8 @@
+#if __GLASGOW_HASKELL__ >= 710
+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
+#define OVERLAPPING_  {-# OVERLAPPING #-}
+#else
+{-# LANGUAGE OverlappingInstances #-}
+#define OVERLAPPABLE_
+#define OVERLAPPING_
+#endif

servant-docs/servant-docs.cabal

@@ -1,5 +1,5 @@
 name:                servant-docs
-version:             0.5
+version:             0.6
 synopsis:            generate API docs for your servant webservice
 description:
   Library for generating API docs from a servant API definition.
@@ -9,9 +9,9 @@ description:
   <https://github.com/haskell-servant/servant/blob/master/servant-docs/CHANGELOG.md CHANGELOG>
 license:             BSD3
 license-file:        LICENSE
-author:              Alp Mestanogullari, Sönke Hahn, Julian K. Arni
+author:              Servant Contributors
-maintainer:          alpmestan@gmail.com
+maintainer:          haskell-servant-maintainers@googlegroups.com
-copyright:           2014-2015 Zalora South East Asia Pte Ltd
+copyright:           2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors
 category:            Web
 build-type:          Simple
 cabal-version:       >=1.10
@@ -19,6 +19,7 @@ tested-with:         GHC >= 7.8
 homepage:            http://haskell-servant.github.io/
 Bug-reports:         http://github.com/haskell-servant/servant/issues
 extra-source-files:
+  include/*.h
   CHANGELOG.md
   README.md
 source-repository head
@@ -41,7 +42,7 @@ library
     , http-media >= 0.6
     , http-types >= 0.7
     , lens
-    , servant == 0.5.*
+    , servant == 0.6.*
     , string-conversions
     , text
     , unordered-containers
@@ -49,6 +50,7 @@ library
   hs-source-dirs: src
   default-language: Haskell2010
   ghc-options: -Wall
+  include-dirs: include
 
 executable greet-docs
   main-is: greet.hs

servant-docs/src/Servant/Docs.hs

@@ -41,8 +41,7 @@ module Servant.Docs
   , ToCapture(..)
 
   , -- * ADTs to represent an 'API'
-    Method(..)
+    Endpoint, path, method, defEndpoint
-  , Endpoint, path, method, defEndpoint
   , API, apiIntros, apiEndpoints, emptyAPI
   , DocCapture(..), capSymbol, capDesc
   , DocQueryParam(..), ParamKind(..), paramName, paramValues, paramDesc, paramKind

servant-docs/src/Servant/Docs/Internal.hs

@@ -16,18 +16,18 @@
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE TypeOperators          #-}
 {-# LANGUAGE UndecidableInstances   #-}
-#if !MIN_VERSION_base(4,8,0)
+
-{-# LANGUAGE OverlappingInstances   #-}
+#include "overlapping-compat.h"
-#endif
 module Servant.Docs.Internal where
 
 import           Control.Applicative
 import           Control.Arrow              (second)
-import           Control.Lens               (makeLenses, over, traversed, (%~),
+import           Control.Lens               (makeLenses, mapped, over, traversed, view, (%~),
                                              (&), (.~), (<>~), (^.), (|>))
 import qualified Control.Monad.Omega        as Omega
 import           Data.ByteString.Conversion (ToByteString, toByteString)
 import           Data.ByteString.Lazy.Char8 (ByteString)
+import qualified Data.ByteString.Char8      as BSC
 import qualified Data.CaseInsensitive       as CI
 import           Data.Hashable              (Hashable)
 import           Data.HashMap.Strict        (HashMap)
@@ -37,7 +37,7 @@ import           Data.Monoid
 import           Data.Ord                   (comparing)
 import           Data.Proxy                 (Proxy(Proxy))
 import           Data.String.Conversions    (cs)
-import           Data.Text                  (Text, pack, unpack)
+import           Data.Text                  (Text, unpack)
 import           GHC.Exts                   (Constraint)
 import           GHC.Generics
 import           GHC.TypeLits
@@ -50,21 +50,6 @@ import qualified Data.Text                  as T
 import qualified Network.HTTP.Media         as M
 import qualified Network.HTTP.Types         as HTTP
 
--- | Supported HTTP request methods
-data Method = DocDELETE -- ^ the DELETE method
-            | DocGET    -- ^ the GET method
-            | DocPOST   -- ^ the POST method
-            | DocPUT    -- ^ the PUT method
-  deriving (Eq, Ord, Generic)
-
-instance Show Method where
-  show DocGET = "GET"
-  show DocPOST = "POST"
-  show DocDELETE = "DELETE"
-  show DocPUT = "PUT"
-
-instance Hashable Method
-
 -- | An 'Endpoint' type that holds the 'path' and the 'method'.
 --
 -- Gets used as the key in the 'API' hashmap. Modify 'defEndpoint'
@@ -76,12 +61,12 @@ instance Hashable Method
 -- GET /
 -- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
 -- GET /foo
--- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
 -- POST /foo
 -- @
 data Endpoint = Endpoint
-  { _path   :: [String] -- type collected
+  { _path   :: [String]      -- type collected
-  , _method :: Method   -- type collected
+  , _method :: HTTP.Method   -- type collected
   } deriving (Eq, Ord, Generic)
 
 instance Show Endpoint where
@@ -95,7 +80,7 @@ showPath :: [String] -> String
 showPath [] = "/"
 showPath ps = concatMap ('/' :) ps
 
--- | An 'Endpoint' whose path is `"/"` and whose method is 'DocGET'
+-- | An 'Endpoint' whose path is `"/"` and whose method is @GET@
 --
 -- Here's how you can modify it:
 --
@@ -104,11 +89,11 @@ showPath ps = concatMap ('/' :) ps
 -- GET /
 -- λ> 'defEndpoint' & 'path' '<>~' ["foo"]
 -- GET /foo
--- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'DocPOST'
+-- λ> 'defEndpoint' & 'path' '<>~' ["foo"] & 'method' '.~' 'HTTP.methodPost'
 -- POST /foo
 -- @
 defEndpoint :: Endpoint
-defEndpoint = Endpoint [] DocGET
+defEndpoint = Endpoint [] HTTP.methodGet
 
 instance Hashable Endpoint
 
@@ -155,6 +140,12 @@ data DocIntro = DocIntro
   , _introBody  :: [String] -- ^ Each String is a paragraph.
   } deriving (Eq, Show)
 
+-- | A type to represent Authentication information about an endpoint.
+data DocAuthentication = DocAuthentication
+  { _authIntro        :: String
+  , _authDataRequired :: String
+  } deriving (Eq, Ord, Show)
+
 instance Ord DocIntro where
     compare = comparing _introTitle
 
@@ -245,7 +236,8 @@ defResponse = Response
 -- You can tweak an 'Action' (like the default 'defAction') with these lenses
 -- to transform an action and add some information to it.
 data Action = Action
-  { _captures :: [DocCapture]                -- type collected + user supplied info
+  { _authInfo :: [DocAuthentication]         -- user supplied info
+  , _captures :: [DocCapture]                -- type collected + user supplied info
   , _headers  :: [Text]                      -- type collected
   , _params   :: [DocQueryParam]             -- type collected + user supplied info
   , _notes    :: [DocNote]                   -- user supplied
@@ -262,8 +254,8 @@ data Action = Action
 -- 'combineAction' to mush two together taking the response, body and content
 -- types from the very left.
 combineAction :: Action -> Action -> Action
-Action c h p n m ts body resp `combineAction` Action c' h' p' n' m' _ _ _ =
+Action a c h p n m ts body resp `combineAction` Action a' c' h' p' n' m' _ _ _ =
-        Action (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
+        Action (a <> a') (c <> c') (h <> h') (p <> p') (n <> n') (m <> m') ts body resp
 
 -- Default 'Action'. Has no 'captures', no GET 'params', expects
 -- no request body ('rqbody') and the typical response is 'defResponse'.
@@ -283,6 +275,7 @@ defAction =
          []
          []
          []
+         []
          defResponse
 
 -- | Create an API that's comprised of a single endpoint.
@@ -292,6 +285,7 @@ single :: Endpoint -> Action -> API
 single e a = API mempty (HM.singleton e a)
 
 -- gimme some lenses
+makeLenses ''DocAuthentication
 makeLenses ''DocOptions
 makeLenses ''API
 makeLenses ''Endpoint
@@ -469,7 +463,7 @@ instance AllHeaderSamples '[] where
 
 instance (ToByteString l, AllHeaderSamples ls, ToSample l, KnownSymbol h)
     => AllHeaderSamples (Header h l ': ls) where
-    allHeaderToSample _ = (mkHeader (toSample (Proxy :: Proxy l))) :
+    allHeaderToSample _ = mkHeader (toSample (Proxy :: Proxy l)) :
                           allHeaderToSample (Proxy :: Proxy ls)
       where headerName = CI.mk . cs $ symbolVal (Proxy :: Proxy h)
             mkHeader (Just x) = (headerName, cs $ toByteString x)
@@ -477,8 +471,8 @@ instance (ToByteString l, AllHeaderSamples ls, ToSample l, KnownSymbol h)
 
 -- | Synthesise a sample value of a type, encoded in the specified media types.
 sampleByteString
-    :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
+    :: forall ct cts a. (ToSample a, AllMimeRender (ct ': cts) a)
-    => Proxy ctypes
+    => Proxy (ct ': cts)
     -> Proxy a
     -> [(M.MediaType, ByteString)]
 sampleByteString ctypes@Proxy Proxy =
@@ -487,8 +481,8 @@ sampleByteString ctypes@Proxy Proxy =
 -- | Synthesise a list of sample values of a particular type, encoded in the
 -- specified media types.
 sampleByteStrings
-    :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
+    :: forall ct cts a. (ToSample a, AllMimeRender (ct ': cts) a)
-    => Proxy ctypes
+    => Proxy (ct ': cts)
     -> Proxy a
     -> [(Text, M.MediaType, ByteString)]
 sampleByteStrings ctypes@Proxy Proxy =
@@ -519,6 +513,10 @@ class ToParam t where
 class ToCapture c where
   toCapture :: Proxy c -> DocCapture
 
+-- | The class that helps us get documentation for authenticated endpoints
+class ToAuthInfo a where
+      toAuthInfo :: Proxy a -> DocAuthentication
+
 -- | Generate documentation in Markdown format for
 --   the given 'API'.
 markdown :: API -> String
@@ -531,6 +529,7 @@ markdown api = unlines $
           str :
           "" :
           notesStr (action ^. notes) ++
+          authStr (action ^. authInfo) ++
           capturesStr (action ^. captures) ++
           headersStr (action ^. headers) ++
           paramsStr (action ^. params) ++
@@ -538,7 +537,7 @@ markdown api = unlines $
           responseStr (action ^. response) ++
           []
 
-          where str = "## " ++ show (endpoint^.method)
+          where str = "## " ++ BSC.unpack (endpoint^.method)
                     ++ " " ++ showPath (endpoint^.path)
 
         introsStr :: [DocIntro] -> [String]
@@ -563,6 +562,20 @@ markdown api = unlines $
             "" :
             []
 
+
+        authStr :: [DocAuthentication] -> [String]
+        authStr auths =
+          let authIntros = mapped %~ view authIntro $ auths
+              clientInfos = mapped %~ view authDataRequired $ auths
+          in "#### Authentication":
+              "":
+              unlines authIntros :
+              "":
+              "Clients must supply the following data" :
+              unlines clientInfos :
+              "" :
+              []
+
         capturesStr :: [DocCapture] -> [String]
         capturesStr [] = []
         capturesStr l =
@@ -661,10 +674,7 @@ markdown api = unlines $
 
 -- | The generated docs for @a ':<|>' b@ just appends the docs
 --   for @a@ with the docs for @b@.
-instance
+instance OVERLAPPABLE_
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPABLE #-}
-#endif
          (HasDocs layout1, HasDocs layout2)
       => HasDocs (layout1 :<|> layout2) where
 
@@ -692,70 +702,38 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
           symP = Proxy :: Proxy sym
 
 
-instance
+instance OVERLAPPABLE_
-#if MIN_VERSION_base(4,8,0)
+        (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
-         {-# OVERLAPPABLe #-}
+        , ReflectMethod method)
-#endif
+    => HasDocs (Verb method status (ct ': cts) a) where
-        (ToSample a, IsNonEmpty cts, AllMimeRender cts a)
-    => HasDocs (Delete cts a) where
   docsFor Proxy (endpoint, action) DocOptions{..} =
     single endpoint' action'
 
-    where endpoint' = endpoint & method .~ DocDELETE
+    where endpoint' = endpoint & method .~ method'
           action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
                            & response.respTypes .~ allMime t
-          t = Proxy :: Proxy cts
+                           & response.respStatus .~ status
+          t = Proxy :: Proxy (ct ': cts)
+          method' = reflectMethod (Proxy :: Proxy method)
+          status = fromInteger $ natVal (Proxy :: Proxy status)
           p = Proxy :: Proxy a
 
-instance
+instance OVERLAPPING_
-#if MIN_VERSION_base(4,8,0)
+        (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
-         {-# OVERLAPPING #-}
+        , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
-#endif
+    => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where
-        (ToSample a, IsNonEmpty cts, AllMimeRender cts a
-         , AllHeaderSamples ls , GetHeaders (HList ls) )
-    => HasDocs (Delete cts (Headers ls a)) where
   docsFor Proxy (endpoint, action) DocOptions{..} =
     single endpoint' action'
 
-    where hdrs = allHeaderToSample (Proxy :: Proxy ls)
+    where endpoint' = endpoint & method .~ method'
-          endpoint' = endpoint & method .~ DocDELETE
           action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
                            & response.respTypes .~ allMime t
+                           & response.respStatus .~ status
                            & response.respHeaders .~ hdrs
-          t = Proxy :: Proxy cts
+          t = Proxy :: Proxy (ct ': cts)
-          p = Proxy :: Proxy a
+          hdrs = allHeaderToSample (Proxy :: Proxy ls)
-
+          method' = reflectMethod (Proxy :: Proxy method)
-instance
+          status = fromInteger $ natVal (Proxy :: Proxy status)
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPABLe #-}
-#endif
-        (ToSample a, IsNonEmpty cts, AllMimeRender cts a)
-    => HasDocs (Get cts a) where
-  docsFor Proxy (endpoint, action) DocOptions{..} =
-    single endpoint' action'
-
-    where endpoint' = endpoint & method .~ DocGET
-          action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
-                           & response.respTypes .~ allMime t
-          t = Proxy :: Proxy cts
-          p = Proxy :: Proxy a
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-        (ToSample a, IsNonEmpty cts, AllMimeRender cts a
-         , AllHeaderSamples ls , GetHeaders (HList ls) )
-    => HasDocs (Get cts (Headers ls a)) where
-  docsFor Proxy (endpoint, action) DocOptions{..} =
-    single endpoint' action'
-
-    where hdrs = allHeaderToSample (Proxy :: Proxy ls)
-          endpoint' = endpoint & method .~ DocGET
-          action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
-                           & response.respTypes .~ allMime t
-                           & response.respHeaders .~ hdrs
-          t = Proxy :: Proxy cts
           p = Proxy :: Proxy a
 
 instance (KnownSymbol sym, HasDocs sublayout)
@@ -765,77 +743,7 @@ instance (KnownSymbol sym, HasDocs sublayout)
 
     where sublayoutP = Proxy :: Proxy sublayout
           action' = over headers (|> headername) action
-          headername = pack $ symbolVal (Proxy :: Proxy sym)
+          headername = T.pack $ symbolVal (Proxy :: Proxy sym)
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPABLE #-}
-#endif
-        (ToSample a, IsNonEmpty cts, AllMimeRender cts a)
-    => HasDocs (Post cts a) where
-  docsFor Proxy (endpoint, action) DocOptions{..} =
-    single endpoint' action'
-
-    where endpoint' = endpoint & method .~ DocPOST
-          action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
-                           & response.respTypes .~ allMime t
-                           & response.respStatus .~ 201
-          t = Proxy :: Proxy cts
-          p = Proxy :: Proxy a
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-         (ToSample a, IsNonEmpty cts, AllMimeRender cts a
-         , AllHeaderSamples ls , GetHeaders (HList ls) )
-    => HasDocs (Post cts (Headers ls a)) where
-  docsFor Proxy (endpoint, action) DocOptions{..} =
-    single endpoint' action'
-
-    where hdrs = allHeaderToSample (Proxy :: Proxy ls)
-          endpoint' = endpoint & method .~ DocPOST
-          action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
-                           & response.respTypes .~ allMime t
-                           & response.respStatus .~ 201
-                           & response.respHeaders .~ hdrs
-          t = Proxy :: Proxy cts
-          p = Proxy :: Proxy a
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPABLE #-}
-#endif
-        (ToSample a, IsNonEmpty cts, AllMimeRender cts a)
-    => HasDocs (Put cts a) where
-  docsFor Proxy (endpoint, action) DocOptions{..} =
-    single endpoint' action'
-
-    where endpoint' = endpoint & method .~ DocPUT
-          action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
-                           & response.respTypes .~ allMime t
-                           & response.respStatus .~ 200
-          t = Proxy :: Proxy cts
-          p = Proxy :: Proxy a
-
-instance
-#if MIN_VERSION_base(4,8,0)
-         {-# OVERLAPPING #-}
-#endif
-        ( ToSample a, IsNonEmpty cts, AllMimeRender cts a,
-          AllHeaderSamples ls , GetHeaders (HList ls) )
-    => HasDocs (Put cts (Headers ls a)) where
-  docsFor Proxy (endpoint, action) DocOptions{..} =
-    single endpoint' action'
-
-    where hdrs = allHeaderToSample (Proxy :: Proxy ls)
-          endpoint' = endpoint & method .~ DocPUT
-          action' = action & response.respBody .~ take _maxSamples (sampleByteStrings t p)
-                           & response.respTypes .~ allMime t
-                           & response.respStatus .~ 200
-                           & response.respHeaders .~ hdrs
-          t = Proxy :: Proxy cts
-          p = Proxy :: Proxy a
 
 instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
       => HasDocs (QueryParam sym a :> sublayout) where
@@ -877,8 +785,8 @@ instance HasDocs Raw where
 -- example data. However, there's no reason to believe that the instances of
 -- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
 -- both are even defined) for any particular type.
-instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout)
+instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs sublayout)
-      => HasDocs (ReqBody cts a :> sublayout) where
+      => HasDocs (ReqBody (ct ': cts) a :> sublayout) where
 
   docsFor Proxy (endpoint, action) =
     docsFor sublayoutP (endpoint, action')
@@ -886,7 +794,7 @@ instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout)
     where sublayoutP = Proxy :: Proxy sublayout
           action' = action & rqbody .~ sampleByteString t p
                            & rqtypes .~ allMime t
-          t = Proxy :: Proxy cts
+          t = Proxy :: Proxy (ct ': cts)
           p = Proxy :: Proxy a
 
 instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where
@@ -914,6 +822,16 @@ instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
   docsFor Proxy ep =
     docsFor (Proxy :: Proxy sublayout) ep
 
+instance HasDocs sublayout => HasDocs (WithNamedContext name context sublayout) where
+  docsFor Proxy = docsFor (Proxy :: Proxy sublayout)
+
+instance (ToAuthInfo (BasicAuth realm usr), HasDocs sublayout) => HasDocs (BasicAuth realm usr :> sublayout) where
+  docsFor Proxy (endpoint, action) =
+    docsFor (Proxy :: Proxy sublayout) (endpoint, action')
+      where
+        authProxy = Proxy :: Proxy (BasicAuth realm usr)
+        action' = over authInfo (|> toAuthInfo authProxy) action
+
 -- ToSample instances for simple types
 instance ToSample ()
 instance ToSample Bool

servant-docs/test/Servant/DocsSpec.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TypeOperators         #-}
@@ -18,8 +18,25 @@ import           GHC.Generics
 import           Test.Hspec
 
 import           Servant.API
+import           Servant.API.Internal.Test.ComprehensiveAPI
 import           Servant.Docs.Internal
 
+-- * comprehensive api
+
+-- This declaration simply checks that all instances are in place.
+_ = docs comprehensiveAPI
+
+instance ToParam (QueryParam "foo" Int) where
+  toParam = error "unused"
+instance ToParam (QueryParams "foo" Int) where
+  toParam = error "unused"
+instance ToParam (QueryFlag "foo") where
+  toParam = error "unused"
+instance ToCapture (Capture "foo" Int) where
+  toCapture = error "unused"
+
+-- * specs
+
 spec :: Spec
 spec = describe "Servant.Docs" $ do
 
@@ -63,6 +80,7 @@ spec = describe "Servant.Docs" $ do
          , ("zwei, kaks, kaks",(TT2,UT2,UT2))
          ]
 
+
  where
    tests md = do
     it "mentions supported content-types" $ do
@@ -71,17 +89,20 @@ spec = describe "Servant.Docs" $ do
 
     it "mentions status codes" $ do
       md `shouldContain` "Status code 200"
-      md `shouldContain` "Status code 201"
 
-    it "mentions methods" $ do
+    it "has methods as section headers" $ do
-      md `shouldContain` "POST"
+      md `shouldContain` "## POST"
-      md `shouldContain` "GET"
+      md `shouldContain` "## GET"
+
+    it "mentions headers" $ do
+      md `shouldContain` "- This endpoint is sensitive to the value of the **X-Test** HTTP header."
 
     it "contains response samples" $
       md `shouldContain` "{\"dt1field1\":\"field 1\",\"dt1field2\":13}"
     it "contains request body samples" $
       md `shouldContain` "17"
 
+
 -- * APIs
 
 data Datatype1 = Datatype1 { dt1field1 :: String
@@ -104,6 +125,7 @@ instance MimeRender PlainText Int where
 
 type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
            :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
+           :<|> Header "X-Test" Int :> Put '[JSON] Int
 
 data TT = TT1 | TT2 deriving (Show, Eq)
 data UT = UT1 | UT2 deriving (Show, Eq)

servant-examples/Setup.hs

@@ -1,2 +0,0 @@
-import           Distribution.Simple
-main = defaultMain

servant-examples/auth-combinator/auth-combinator.hs

@@ -1,80 +0,0 @@
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE TypeOperators       #-}
-
-import           Data.Aeson
-import           Data.ByteString          (ByteString)
-import           Data.Text                (Text)
-import           GHC.Generics
-import           Network.Wai
-import           Network.Wai.Handler.Warp
-import           Servant
-import           Servant.Server.Internal
-
--- Pretty much stolen/adapted from
--- https://github.com/haskell-servant/HaskellSGMeetup2015/blob/master/examples/authentication-combinator/AuthenticationCombinator.hs
-
-type DBLookup = ByteString -> IO Bool
-
-isGoodCookie :: DBLookup
-isGoodCookie = return . (== "good password")
-
-data AuthProtected
-
-instance HasServer rest => HasServer (AuthProtected :> rest) where
-  type ServerT (AuthProtected :> rest) m = ServerT rest m
-
-  route Proxy subserver = WithRequest $ \ request ->
-    route (Proxy :: Proxy rest) $ addAcceptCheck subserver $ cookieCheck request
-      where
-        cookieCheck req = case lookup "Cookie" (requestHeaders req) of
-            Nothing -> return $ FailFatal err401 { errBody = "Missing auth header" }
-            Just v  -> do
-              authGranted <- isGoodCookie v
-              if authGranted
-                then return $ Route ()
-                else return $ FailFatal err403 { errBody = "Invalid cookie" }
-
-type PrivateAPI = Get '[JSON] [PrivateData]
-
-type PublicAPI = Get '[JSON] [PublicData]
-
-type API = "private" :> AuthProtected :> PrivateAPI
-      :<|> PublicAPI
-
-newtype PrivateData = PrivateData { ssshhh :: Text }
-  deriving (Eq, Show, Generic)
-
-instance ToJSON PrivateData
-
-newtype PublicData = PublicData { somedata :: Text }
-  deriving (Eq, Show, Generic)
-
-instance ToJSON PublicData
-
-api :: Proxy API
-api = Proxy
-
-server :: Server API
-server = return prvdata :<|> return pubdata
-
-  where prvdata = [PrivateData "this is a secret"]
-        pubdata = [PublicData "this is a public piece of data"]
-
-main :: IO ()
-main = run 8080 (serve api server)
-
-{- Sample session:
-$ curl http://localhost:8080/
-[{"somedata":"this is a public piece of data"}]
-$ curl http://localhost:8080/private
-Missing auth header.
-$ curl -H "Cookie: good password" http://localhost:8080/private
-[{"ssshhh":"this is a secret"}]
-$ curl -H "Cookie: bad password" http://localhost:8080/private
-Invalid cookie.
--}

servant-examples/hackage/hackage.hs

@@ -1,90 +0,0 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeOperators     #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
-import           Control.Applicative
-import           Control.Monad
-import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Except
-import           Data.Aeson
-import           Data.Monoid
-import           Data.Proxy
-import           Data.Text                  (Text)
-import           GHC.Generics
-import           Network.HTTP.Client        (Manager, defaultManagerSettings,
-                                             newManager)
-import           System.IO.Unsafe           (unsafePerformIO)
-import           Servant.API
-import           Servant.Client
-
-import qualified Data.Text                  as T
-import qualified Data.Text.IO               as T
-
-type HackageAPI =
-       "users" :> Get '[JSON] [UserSummary]
-  :<|> "user" :> Capture "username" Username :> Get '[JSON] UserDetailed
-  :<|> "packages" :> Get '[JSON] [Package]
-
-type Username = Text
-
-data UserSummary = UserSummary
-  { summaryUsername :: Username
-  , summaryUserid   :: Int
-  } deriving (Eq, Show)
-
-instance FromJSON UserSummary where
-  parseJSON (Object o) =
-    UserSummary <$> o .: "username"
-                <*> o .: "userid"
-
-  parseJSON _ = mzero
-
-type Group = Text
-
-data UserDetailed = UserDetailed
-  { username :: Username
-  , userid   :: Int
-  , groups   :: [Group]
-  } deriving (Eq, Show, Generic)
-
-instance FromJSON UserDetailed
-
-newtype Package = Package { packageName :: Text }
-  deriving (Eq, Show, Generic)
-
-instance FromJSON Package
-
-hackageAPI :: Proxy HackageAPI
-hackageAPI = Proxy
-
-
-{-# NOINLINE manager #-}
-manager :: Manager
-manager = unsafePerformIO $ newManager defaultManagerSettings
-
-getUsers :: ExceptT ServantError IO [UserSummary]
-getUser :: Username -> ExceptT ServantError IO UserDetailed
-getPackages :: ExceptT ServantError IO [Package]
-getUsers :<|> getUser :<|> getPackages =
-    client hackageAPI (BaseUrl Http "hackage.haskell.org" 80 "") manager
-
-main :: IO ()
-main = print =<< uselessNumbers
-
-uselessNumbers :: IO (Either ServantError ())
-uselessNumbers = runExceptT $ do
-  users <- getUsers
-  liftIO . putStrLn $ show (length users) ++ " users"
-
-  user <- liftIO $ do
-    putStrLn "Enter a valid hackage username"
-    T.getLine
-  userDetailed <- getUser user
-  liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
-
-  packages <- getPackages
-  let monadPackages = filter (isMonadPackage . packageName) packages
-  liftIO . putStrLn $ show (length monadPackages) ++ " monad packages"
-
-  where isMonadPackage = T.isInfixOf "monad"

servant-examples/servant-examples.cabal

@@ -1,130 +0,0 @@
-name:                servant-examples
-version:             0.5
-synopsis:            Example programs for servant
-description:         Example programs for servant,
-                     showcasing solutions to common needs.
-homepage:            http://haskell-servant.github.io/
-license:             BSD3
-license-file:        LICENSE
-author:              Alp Mestanogullari
-maintainer:          alpmestan@gmail.com
--- copyright:
-category:            Web
-build-type:          Simple
-cabal-version:       >=1.10
-bug-reports:         http://github.com/haskell-servant/servant/issues
-source-repository head
-  type: git
-  location: http://github.com/haskell-servant/servant.git
-
-executable tutorial
-  main-is: tutorial.hs
-  other-modules: T1, T2, T3, T4, T5, T6, T7, T8, T9, T10
-  ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-unused-imports
-  build-depends:
-      aeson >= 0.8
-    , base >= 4.7 && < 5
-    , bytestring
-    , directory
-    , http-types
-    , js-jquery
-    , lucid
-    , random
-    , servant == 0.5.*
-    , servant-docs == 0.5.*
-    , servant-js == 0.5.*
-    , servant-lucid == 0.5.*
-    , servant-server == 0.5.*
-    , text
-    , time
-    , transformers
-    , transformers-compat
-    , wai
-    , warp
-  hs-source-dirs: tutorial
-  default-language: Haskell2010
-
-executable t8-main
-  main-is: t8-main.hs
-  other-modules: T3, T8
-  hs-source-dirs: tutorial
-  default-language: Haskell2010
-  ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
-  build-depends:
-      aeson
-    , base >= 4.7 && < 5
-    , http-client > 0.4 && < 0.5
-    , servant == 0.5.*
-    , servant-client == 0.5.*
-    , servant-server == 0.5.*
-    , transformers
-    , transformers-compat
-    , wai
-
-executable hackage
-  main-is:             hackage.hs
-  build-depends:
-      aeson >= 0.8
-    , base >=4.7 && < 5
-    , http-client > 0.4 && < 0.5
-    , servant == 0.5.*
-    , servant-client == 0.5.*
-    , text
-    , transformers
-    , transformers-compat
-  hs-source-dirs:      hackage
-  default-language:    Haskell2010
-
-executable wai-middleware
-  main-is: wai-middleware.hs
-  build-depends:
-      aeson >= 0.8
-    , base >= 4.7 && < 5
-    , servant == 0.5.*
-    , servant-server == 0.5.*
-    , text
-    , wai
-    , wai-extra
-    , warp
-  hs-source-dirs: wai-middleware
-  default-language: Haskell2010
-
-executable auth-combinator
-  main-is: auth-combinator.hs
-  ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
-  build-depends:
-      aeson >= 0.8
-    , base >= 4.7 && < 5
-    , bytestring
-    , http-types
-    , servant == 0.5.*
-    , servant-server == 0.5.*
-    , text
-    , wai
-    , warp
-  hs-source-dirs: auth-combinator
-  default-language: Haskell2010
-
-executable socket-io-chat
-  main-is: socket-io-chat.hs
-  ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
-  other-modules: Chat
-  build-depends:
-      aeson >= 0.8
-    , base >= 4.7 && < 5
-    , bytestring
-    , http-types
-    , servant == 0.5.*
-    , servant-server == 0.5.*
-    , socket-io
-    , engine-io
-    , engine-io-wai
-    , text
-    , wai
-    , warp
-    , transformers
-    , stm
-    , mtl
-  ghc-options: -Wall -O2 -threaded
-  hs-source-dirs: socket-io-chat
-  default-language: Haskell2010

servant-examples/socket-io-chat/Chat.hs

@@ -1,109 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE RankNTypes #-}
-
-module Chat (eioServer, ServerState (..)) where
-
-import Prelude hiding (mapM_)
-
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative ((<$>), pure)
-#endif
-import Control.Monad.State.Class (MonadState)
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.IO.Class (liftIO)
-import Data.Aeson ((.=))
-import Data.Foldable (mapM_)
-
-import qualified Control.Concurrent.STM as STM
-import qualified Data.Aeson as Aeson
-import qualified Data.Text as Text
-import qualified Network.SocketIO as SocketIO
-
-
-data AddUser = AddUser Text.Text
-
-instance Aeson.FromJSON AddUser where
-  parseJSON = Aeson.withText "AddUser" $ pure . AddUser
-
-
-data NumConnected = NumConnected !Int
-
-instance Aeson.ToJSON NumConnected where
-  toJSON (NumConnected n) = Aeson.object [ "numUsers" .= n]
-
-
-data NewMessage = NewMessage Text.Text
-
-instance Aeson.FromJSON NewMessage where
-  parseJSON = Aeson.withText "NewMessage" $ pure . NewMessage
-
-
-data Said = Said Text.Text Text.Text
-
-instance Aeson.ToJSON Said where
-  toJSON (Said username message) = Aeson.object
-    [ "username" .= username
-    , "message" .= message
-    ]
-
-data UserName = UserName Text.Text
-
-instance Aeson.ToJSON UserName where
-  toJSON (UserName un) = Aeson.object [ "username" .= un ]
-
-
-data UserJoined = UserJoined Text.Text Int
-
-instance Aeson.ToJSON UserJoined where
-  toJSON (UserJoined un n) = Aeson.object
-    [ "username" .= un
-    , "numUsers" .= n
-    ]
-
-
---------------------------------------------------------------------------------
-data ServerState = ServerState { ssNConnected :: STM.TVar Int }
-
---server :: ServerState -> StateT SocketIO.RoutingTable Snap.Snap ()
-eioServer :: forall (m :: * -> *). (MonadState SocketIO.RoutingTable m, MonadIO m) => ServerState -> m ()
-eioServer state = do
-  userNameMVar <- liftIO STM.newEmptyTMVarIO
-  let forUserName m = liftIO (STM.atomically (STM.tryReadTMVar userNameMVar)) >>= mapM_ m
-
-  SocketIO.on "new message" $ \(NewMessage message) ->
-    forUserName $ \userName ->
-      SocketIO.broadcast "new message" (Said userName message)
-
-  SocketIO.on "add user" $ \(AddUser userName) -> do
-    n <- liftIO $ STM.atomically $ do
-      n <- (+ 1) <$> STM.readTVar (ssNConnected state)
-      STM.putTMVar userNameMVar userName
-      STM.writeTVar (ssNConnected state) n
-      return n
-
-    SocketIO.emit "login" (NumConnected n)
-    SocketIO.broadcast "user joined" (UserJoined userName n)
-
-  SocketIO.appendDisconnectHandler $ do
-    (n, mUserName) <- liftIO $ STM.atomically $ do
-      n <- (+ (-1)) <$> STM.readTVar (ssNConnected state)
-      mUserName <- STM.tryReadTMVar userNameMVar
-      STM.writeTVar (ssNConnected state) n
-      return (n, mUserName)
-
-    case mUserName of
-      Nothing -> return ()
-      Just userName ->
-        SocketIO.broadcast "user left" (UserJoined userName n)
-
-  SocketIO.on "typing" $
-    forUserName $ \userName ->
-      SocketIO.broadcast "typing" (UserName userName)
-
-  SocketIO.on "stop typing" $
-    forUserName $ \userName ->
-      SocketIO.broadcast "stop typing" (UserName userName)
-

servant-examples/socket-io-chat/resources/index.html

@@ -1,28 +0,0 @@
-<!doctype html>
-<html lang="en">
-<head>
-  <meta charset="UTF-8">
-  <title>Socket.IO Chat Example</title>
-  <link rel="stylesheet" href="style.css">
-</head>
-<body>
-  <ul class="pages">
-    <li class="chat page">
-      <div class="chatArea">
-        <ul class="messages"></ul>
-      </div>
-      <input class="inputMessage" placeholder="Type here..."/>
-    </li>
-    <li class="login page">
-      <div class="form">
-        <h3 class="title">What's your nickname?</h3>
-        <input class="usernameInput" type="text" maxlength="14" />
-      </div>
-    </li>
-  </ul>
-
-  <script src="https://cdn.socket.io/socket.io-1.2.1.js"></script>
-  <script src="https://code.jquery.com/jquery-1.10.2.min.js"></script>
-  <script src="/main.js"></script>
-</body>
-</html>

servant-examples/socket-io-chat/resources/main.js

@@ -1,274 +0,0 @@
-$(function() {
-  var FADE_TIME = 150; // ms
-  var TYPING_TIMER_LENGTH = 400; // ms
-  var COLORS = [
-    '#e21400', '#91580f', '#f8a700', '#f78b00',
-    '#58dc00', '#287b00', '#a8f07a', '#4ae8c4',
-    '#3b88eb', '#3824aa', '#a700ff', '#d300e7'
-  ];
-
-  // Initialize varibles
-  var $window = $(window);
-  var $usernameInput = $('.usernameInput'); // Input for username
-  var $messages = $('.messages'); // Messages area
-  var $inputMessage = $('.inputMessage'); // Input message input box
-
-  var $loginPage = $('.login.page'); // The login page
-  var $chatPage = $('.chat.page'); // The chatroom page
-
-  // Prompt for setting a username
-  var username;
-  var connected = false;
-  var typing = false;
-  var lastTypingTime;
-  var $currentInput = $usernameInput.focus();
-
-  var socket = io();
-
-  function addParticipantsMessage (data) {
-    var message = '';
-    if (data.numUsers === 1) {
-      message += "there's 1 participant";
-    } else {
-      message += "there're " + data.numUsers + " participants";
-    }
-    log(message);
-  }
-
-  // Sets the client's username
-  function setUsername () {
-    username = cleanInput($usernameInput.val().trim());
-
-    // If the username is valid
-    if (username) {
-      $loginPage.fadeOut();
-      $chatPage.show();
-      $loginPage.off('click');
-      $currentInput = $inputMessage.focus();
-
-      // Tell the server your username
-      socket.emit('add user', username);
-    }
-  }
-
-  // Sends a chat message
-  function sendMessage () {
-    var message = $inputMessage.val();
-    // Prevent markup from being injected into the message
-    message = cleanInput(message);
-    // if there is a non-empty message and a socket connection
-    if (message && connected) {
-      $inputMessage.val('');
-      addChatMessage({
-        username: username,
-        message: message
-      });
-      // tell server to execute 'new message' and send along one parameter
-      socket.emit('new message', message);
-    }
-  }
-
-  // Log a message
-  function log (message, options) {
-    var $el = $('<li>').addClass('log').text(message);
-    addMessageElement($el, options);
-  }
-
-  // Adds the visual chat message to the message list
-  function addChatMessage (data, options) {
-    // Don't fade the message in if there is an 'X was typing'
-    var $typingMessages = getTypingMessages(data);
-    options = options || {};
-    if ($typingMessages.length !== 0) {
-      options.fade = false;
-      $typingMessages.remove();
-    }
-
-    var $usernameDiv = $('<span class="username"/>')
-      .text(data.username)
-      .css('color', getUsernameColor(data.username));
-    var $messageBodyDiv = $('<span class="messageBody">')
-      .text(data.message);
-
-    var typingClass = data.typing ? 'typing' : '';
-    var $messageDiv = $('<li class="message"/>')
-      .data('username', data.username)
-      .addClass(typingClass)
-      .append($usernameDiv, $messageBodyDiv);
-
-    addMessageElement($messageDiv, options);
-  }
-
-  // Adds the visual chat typing message
-  function addChatTyping (data) {
-    data.typing = true;
-    data.message = 'is typing';
-    addChatMessage(data);
-  }
-
-  // Removes the visual chat typing message
-  function removeChatTyping (data) {
-    getTypingMessages(data).fadeOut(function () {
-      $(this).remove();
-    });
-  }
-
-  // Adds a message element to the messages and scrolls to the bottom
-  // el - The element to add as a message
-  // options.fade - If the element should fade-in (default = true)
-  // options.prepend - If the element should prepend
-  //   all other messages (default = false)
-  function addMessageElement (el, options) {
-    var $el = $(el);
-
-    // Setup default options
-    if (!options) {
-      options = {};
-    }
-    if (typeof options.fade === 'undefined') {
-      options.fade = true;
-    }
-    if (typeof options.prepend === 'undefined') {
-      options.prepend = false;
-    }
-
-    // Apply options
-    if (options.fade) {
-      $el.hide().fadeIn(FADE_TIME);
-    }
-    if (options.prepend) {
-      $messages.prepend($el);
-    } else {
-      $messages.append($el);
-    }
-    $messages[0].scrollTop = $messages[0].scrollHeight;
-  }
-
-  // Prevents input from having injected markup
-  function cleanInput (input) {
-    return $('<div/>').text(input).text();
-  }
-
-  // Updates the typing event
-  function updateTyping () {
-    if (connected) {
-      if (!typing) {
-        typing = true;
-        socket.emit('typing');
-      }
-      lastTypingTime = (new Date()).getTime();
-
-      setTimeout(function () {
-        var typingTimer = (new Date()).getTime();
-        var timeDiff = typingTimer - lastTypingTime;
-        if (timeDiff >= TYPING_TIMER_LENGTH && typing) {
-          socket.emit('stop typing');
-          typing = false;
-        }
-      }, TYPING_TIMER_LENGTH);
-    }
-  }
-
-  // Gets the 'X is typing' messages of a user
-  function getTypingMessages (data) {
-    return $('.typing.message').filter(function (i) {
-      return $(this).data('username') === data.username;
-    });
-  }
-
-  // Gets the color of a username through our hash function
-  function getUsernameColor (username) {
-    // Compute hash code
-    var hash = 7;
-    for (var i = 0; i < username.length; i++) {
-       hash = username.charCodeAt(i) + (hash << 5) - hash;
-    }
-    // Calculate color
-    var index = Math.abs(hash % COLORS.length);
-    return COLORS[index];
-  }
-
-  // Keyboard events
-
-  $window.keydown(function (event) {
-    // Auto-focus the current input when a key is typed
-    if (!(event.ctrlKey || event.metaKey || event.altKey)) {
-      $currentInput.focus();
-    }
-    // When the client hits ENTER on their keyboard
-    if (event.which === 13) {
-      if (username) {
-        sendMessage();
-        socket.emit('stop typing');
-        typing = false;
-      } else {
-        setUsername();
-      }
-    }
-  });
-
-  $inputMessage.on('input', function() {
-    updateTyping();
-  });
-
-  // Click events
-
-  // Focus input when clicking anywhere on login page
-  $loginPage.click(function () {
-    $currentInput.focus();
-  });
-
-  // Focus input when clicking on the message input's border
-  $inputMessage.click(function () {
-    $inputMessage.focus();
-  });
-
-  // Socket events
-  socket.on('connected', function (data) {
-    console.log('connected:', data);
-  });
-
-  // Socket events
-  socket.on('changes', function (data) {
-    console.log('changes:', data);
-  });
-
-  // Whenever the server emits 'login', log the login message
-  socket.on('login', function (data) {
-    connected = true;
-    // Display the welcome message
-    var message = "Welcome to Socket.IO Chat &mdash; ";
-    log(message, {
-      prepend: true
-    });
-    addParticipantsMessage(data);
-  });
-
-  // Whenever the server emits 'new message', update the chat body
-  socket.on('new message', function (data) {
-    addChatMessage(data);
-  });
-
-  // Whenever the server emits 'user joined', log it in the chat body
-  socket.on('user joined', function (data) {
-    log(data.username + ' joined');
-    addParticipantsMessage(data);
-  });
-
-  // Whenever the server emits 'user left', log it in the chat body
-  socket.on('user left', function (data) {
-    log(data.username + ' left');
-    addParticipantsMessage(data);
-    removeChatTyping(data);
-  });
-
-  // Whenever the server emits 'typing', show the typing message
-  socket.on('typing', function (data) {
-    addChatTyping(data);
-  });
-
-  // Whenever the server emits 'stop typing', kill the typing message
-  socket.on('stop typing', function (data) {
-    removeChatTyping(data);
-  });
-});

servant-examples/socket-io-chat/resources/style.css

@@ -1,150 +0,0 @@
-/* Fix user-agent */
-
-* {
-  box-sizing: border-box;
-}
-
-html {
-  font-weight: 300;
-  -webkit-font-smoothing: antialiased;
-}
-
-html, input {
-  font-family:
-    "HelveticaNeue-Light",
-    "Helvetica Neue Light",
-    "Helvetica Neue",
-    Helvetica,
-    Arial,
-    "Lucida Grande",
-    sans-serif;
-}
-
-html, body {
-  height: 100%;
-  margin: 0;
-  padding: 0;
-}
-
-ul {
-  list-style: none;
-  word-wrap: break-word;
-}
-
-/* Pages */
-
-.pages {
-  height: 100%;
-  margin: 0;
-  padding: 0;
-  width: 100%;
-}
-
-.page {
-  height: 100%;
-  position: absolute;
-  width: 100%;
-}
-
-/* Login Page */
-
-.login.page {
-  background-color: #000;
-}
-
-.login.page .form {
-  height: 100px;
-  margin-top: -100px;
-  position: absolute;
-
-  text-align: center;
-  top: 50%;
-  width: 100%;
-}
-
-.login.page .form .usernameInput {
-  background-color: transparent;
-  border: none;
-  border-bottom: 2px solid #fff;
-  outline: none;
-  padding-bottom: 15px;
-  text-align: center;
-  width: 400px;
-}
-
-.login.page .title {
-  font-size: 200%;
-}
-
-.login.page .usernameInput {
-  font-size: 200%;
-  letter-spacing: 3px;
-}
-
-.login.page .title, .login.page .usernameInput {
-  color: #fff;
-  font-weight: 100;
-}
-
-/* Chat page */
-
-.chat.page {
-  display: none;
-}
-
-/* Font */
-
-.messages {
-  font-size: 150%;
-}
-
-.inputMessage {
-  font-size: 100%;
-}
-
-.log {
-  color: gray;
-  font-size: 70%;
-  margin: 5px;
-  text-align: center;
-}
-
-/* Messages */
-
-.chatArea {
-  height: 100%;
-  padding-bottom: 60px;
-}
-
-.messages {
-  height: 100%;
-  margin: 0;
-  overflow-y: scroll;
-  padding: 10px 20px 10px 20px;
-}
-
-.message.typing .messageBody {
-  color: gray;
-}
-
-.username {
-  float: left;
-  font-weight: 700;
-  overflow: hidden;
-  padding-right: 15px;
-  text-align: right;
-}
-
-/* Input */
-
-.inputMessage {
-  border: 10px solid #000;
-  bottom: 0;
-  height: 60px;
-  left: 0;
-  outline: none;
-  padding-left: 10px;
-  position: absolute;
-  right: 0;
-  width: 100%;
-}

servant-examples/socket-io-chat/socket-io-chat.hs

@@ -1,54 +0,0 @@
-{-# LANGUAGE CPP               #-}
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeOperators     #-}
-
-
-import           Data.Monoid              ((<>))
-#if !MIN_VERSION_base(4,8,0)
-import           Control.Applicative      ((<$>))
-#endif
-import           Network.EngineIO.Wai
-import           Network.Wai
-import           Network.Wai.Handler.Warp (run)
-import           Servant
-
-
-import qualified Control.Concurrent.STM   as STM
-import qualified Network.SocketIO         as SocketIO
-
-
-import           Chat                     (ServerState (..), eioServer)
-
-
-type API = "socket.io" :> Raw
-    :<|> Raw
-
-
-api :: Proxy API
-api = Proxy
-
-
-server :: WaiMonad () -> Server API
-server sHandler = socketIOHandler
-    :<|> serveDirectory "socket-io-chat/resources"
-
-    where
-        socketIOHandler req respond = toWaiApplication sHandler req respond
-
-
-app :: WaiMonad () -> Application
-app sHandler = serve api $ server sHandler
-
-port :: Int
-port = 3001
-
-
-main :: IO ()
-main = do
-    state <- ServerState <$> STM.newTVarIO 0
-    sHandler <- SocketIO.initialize waiAPI (eioServer state)
-    putStrLn $ "Running on " <> show port
-    run port $ app sHandler
-
-

servant-examples/tinc.yaml

@@ -1,15 +0,0 @@
-dependencies:
-  - name: servant
-    path: ../servant
-  - name: servant-server
-    path: ../servant-server
-  - name: servant-client
-    path: ../servant-client
-  - name: servant-js
-    path: ../servant-js
-  - name: servant-lucid
-    path: ../servant-lucid
-  - name: servant-docs
-    path: ../servant-docs
-  - name: servant-foreign
-    path: ../servant-foreign

servant-examples/tutorial/T1.hs

@@ -1,45 +0,0 @@
-{-# LANGUAGE CPP           #-}
-{-# LANGUAGE DataKinds     #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TypeFamilies  #-}
-{-# LANGUAGE TypeOperators #-}
-module T1 where
-
-import           Data.Aeson
-import           Data.Time.Calendar
-import           GHC.Generics
-import           Network.Wai
-import           Servant
-
-data User = User
-  { name              :: String
-  , age               :: Int
-  , email             :: String
-  , registration_date :: Day
-  } deriving (Eq, Show, Generic)
-
-#if !MIN_VERSION_aeson(0,10,0)
--- orphan ToJSON instance for Day. necessary to derive one for User
-instance ToJSON Day where
-  -- display a day in YYYY-mm-dd format
-  toJSON d = toJSON (showGregorian d)
-#endif
-
-instance ToJSON User
-
-type UserAPI = "users" :> Get '[JSON] [User]
-
-users :: [User]
-users =
-  [ User "Isaac Newton"    372 "isaac@newton.co.uk" (fromGregorian 1683  3 1)
-  , User "Albert Einstein" 136 "ae@mc2.org"         (fromGregorian 1905 12 1)
-  ]
-
-userAPI :: Proxy UserAPI
-userAPI = Proxy
-
-server :: Server UserAPI
-server = return users
-
-app :: Application
-app = serve userAPI server

servant-examples/tutorial/T10.hs

@@ -1,71 +0,0 @@
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeOperators         #-}
-module T10 where
-
-import           Data.ByteString.Lazy    (ByteString)
-import           Data.Text.Lazy          (pack)
-import           Data.Text.Lazy.Encoding (encodeUtf8)
-import           Network.HTTP.Types
-import           Network.Wai
-import           Servant
-import           Servant.Docs
-import qualified T3
-
-type DocsAPI = T3.API :<|> Raw
-
-instance ToCapture (Capture "x" Int) where
-  toCapture _ = DocCapture "x" "(integer) position on the x axis"
-
-instance ToCapture (Capture "y" Int) where
-  toCapture _ = DocCapture "y" "(integer) position on the y axis"
-
-instance ToSample T3.Position where
-  toSamples _ = singleSample (T3.Position 3 14)
-
-instance ToParam (QueryParam "name" String) where
-  toParam _ =
-    DocQueryParam "name"
-                  ["Alp", "John Doe", "..."]
-                  "Name of the person to say hello to."
-                  Normal
-
-instance ToSample T3.HelloMessage where
-  toSamples _ =
-    [ ("When a value is provided for 'name'", T3.HelloMessage "Hello, Alp")
-    , ("When 'name' is not specified", T3.HelloMessage "Hello, anonymous coward")
-    ]
-
-ci :: T3.ClientInfo
-ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
-
-instance ToSample T3.ClientInfo where
-  toSamples _ = singleSample ci
-
-instance ToSample T3.Email where
-  toSamples _ = singleSample (T3.emailForClient ci)
-
-api :: Proxy DocsAPI
-api = Proxy
-
-docsBS :: ByteString
-docsBS = encodeUtf8
-       . pack
-       . markdown
-       $ docsWithIntros [intro] T3.api
-
-  where intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"]
-
-server :: Server DocsAPI
-server = T3.server :<|> serveDocs
-
-  where serveDocs _ respond =
-          respond $ responseLBS ok200 [plain] docsBS
-
-        plain = ("Content-Type", "text/plain")
-
-app :: Application
-app = serve api server

servant-examples/tutorial/T2.hs

@@ -1,52 +0,0 @@
-{-# LANGUAGE CPP           #-}
-{-# LANGUAGE DataKinds     #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TypeFamilies  #-}
-{-# LANGUAGE TypeOperators #-}
-module T2 where
-
-import           Data.Aeson
-import           Data.Time.Calendar
-import           GHC.Generics
-import           Network.Wai
-import           Servant
-
-data User = User
-  { name              :: String
-  , age               :: Int
-  , email             :: String
-  , registration_date :: Day
-  } deriving (Eq, Show, Generic)
-
-#if !MIN_VERSION_aeson(0,10,0)
--- orphan ToJSON instance for Day. necessary to derive one for User
-instance ToJSON Day where
-  -- display a day in YYYY-mm-dd format
-  toJSON d = toJSON (showGregorian d)
-#endif
-
-instance ToJSON User
-
-type UserAPI = "users" :> Get '[JSON] [User]
-          :<|> "albert" :> Get '[JSON] User
-          :<|> "isaac" :> Get '[JSON] User
-
-isaac :: User
-isaac = User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1)
-
-albert :: User
-albert = User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1)
-
-users :: [User]
-users = [isaac, albert]
-
-userAPI :: Proxy UserAPI
-userAPI = Proxy
-
-server :: Server UserAPI
-server = return users
-    :<|> return albert
-    :<|> return isaac
-
-app :: Application
-app = serve userAPI server

servant-examples/tutorial/T3.hs

@@ -1,84 +0,0 @@
-{-# LANGUAGE DataKinds     #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TypeFamilies  #-}
-{-# LANGUAGE TypeOperators #-}
-module T3 where
-
-import           Control.Monad.Trans.Except
-import           Data.Aeson
-import           Data.List
-import           GHC.Generics
-import           Network.Wai
-import           Servant
-
-data Position = Position
-  { x :: Int
-  , y :: Int
-  } deriving (Show, Generic)
-
-instance FromJSON Position
-instance ToJSON Position
-
-newtype HelloMessage = HelloMessage { msg :: String }
-  deriving (Show, Generic)
-
-instance FromJSON HelloMessage
-instance ToJSON HelloMessage
-
-data ClientInfo = ClientInfo
-  { name          :: String
-  , email         :: String
-  , age           :: Int
-  , interested_in :: [String]
-  } deriving (Show, Generic)
-
-instance FromJSON ClientInfo
-instance ToJSON ClientInfo
-
-data Email = Email
-  { from    :: String
-  , to      :: String
-  , subject :: String
-  , body    :: String
-  } deriving (Show, Generic)
-
-instance FromJSON Email
-instance ToJSON Email
-
-emailForClient :: ClientInfo -> Email
-emailForClient c = Email from' to' subject' body'
-
-  where from'    = "great@company.com"
-        to'      = email c
-        subject' = "Hey " ++ name c ++ ", we miss you!"
-        body'    = "Hi " ++ name c ++ ",\n\n"
-                ++ "Since you've recently turned " ++ show (age c)
-                ++ ", have you checked out our latest "
-                ++ intercalate ", " (interested_in c)
-                ++ " products? Give us a visit!"
-
-type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
-      :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
-      :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email
-
-api :: Proxy API
-api = Proxy
-
-server :: Server API
-server = position
-    :<|> hello
-    :<|> marketing
-
-  where position :: Int -> Int -> ExceptT ServantErr IO Position
-        position x y = return (Position x y)
-
-        hello :: Maybe String -> ExceptT ServantErr IO HelloMessage
-        hello mname = return . HelloMessage $ case mname of
-          Nothing -> "Hello, anonymous coward"
-          Just n  -> "Hello, " ++ n
-
-        marketing :: ClientInfo -> ExceptT ServantErr IO Email
-        marketing clientinfo = return (emailForClient clientinfo)
-
-app :: Application
-app = serve api server

servant-examples/tutorial/T4.hs

@@ -1,63 +0,0 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies      #-}
-{-# LANGUAGE TypeOperators     #-}
-module T4 where
-
-import           Data.Aeson
-import           Data.Foldable      (foldMap)
-import           GHC.Generics
-import           Lucid
-import           Network.Wai
-import           Servant
-import           Servant.HTML.Lucid
-
-data Person = Person
-  { firstName :: String
-  , lastName  :: String
-  , age       :: Int
-  } deriving Generic -- for the JSON instance
-
--- JSON serialization
-instance ToJSON Person
-
--- HTML serialization of a single person
-instance ToHtml Person where
-  toHtml person =
-    tr_ $ do
-      td_ (toHtml $ firstName person)
-      td_ (toHtml $ lastName person)
-      td_ (toHtml . show $ age person)
-
-  toHtmlRaw = toHtml
-
--- HTML serialization of a list of persons
-instance ToHtml [Person] where
-  toHtml persons = table_ $ do
-    tr_ $ do
-      th_ "first name"
-      th_ "last name"
-      th_ "age"
-
-    foldMap toHtml persons
-
-  toHtmlRaw = toHtml
-
-persons :: [Person]
-persons =
-  [ Person "Isaac"  "Newton"   372
-  , Person "Albert" "Einstein" 136
-  ]
-
-type PersonAPI = "persons" :> Get '[JSON, HTML] [Person]
-
-personAPI :: Proxy PersonAPI
-personAPI = Proxy
-
-server :: Server PersonAPI
-server = return persons
-
-app :: Application
-app = serve personAPI server

servant-examples/tutorial/T5.hs

@@ -1,37 +0,0 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies      #-}
-{-# LANGUAGE TypeOperators     #-}
-module T5 where
-
-import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Except
-import           Data.Aeson
-import           GHC.Generics
-import           Network.Wai
-import           Servant
-import           System.Directory
-
-type IOAPI = "myfile.txt" :> Get '[JSON] FileContent
-
-ioAPI :: Proxy IOAPI
-ioAPI = Proxy
-
-newtype FileContent = FileContent
-  { content :: String }
-  deriving Generic
-
-instance ToJSON FileContent
-
-server :: Server IOAPI
-server = do
-  exists <- liftIO (doesFileExist "myfile.txt")
-  if exists
-    then liftIO (readFile "myfile.txt") >>= return . FileContent
-    else throwE custom404Err
-
-  where custom404Err = err404 { errBody = "myfile.txt just isn't there, please leave this server alone." }
-
-app :: Application
-app = serve ioAPI server

servant-examples/tutorial/T6.hs

@@ -1,18 +0,0 @@
-{-# LANGUAGE DataKinds     #-}
-{-# LANGUAGE TypeFamilies  #-}
-{-# LANGUAGE TypeOperators #-}
-module T6 where
-
-import           Network.Wai
-import           Servant
-
-type API = "code" :> Raw
-
-api :: Proxy API
-api = Proxy
-
-server :: Server API
-server = serveDirectory "tutorial"
-
-app :: Application
-app = serve api server

servant-examples/tutorial/T7.hs

@@ -1,33 +0,0 @@
-{-# LANGUAGE DataKinds     #-}
-{-# LANGUAGE TypeFamilies  #-}
-{-# LANGUAGE TypeOperators #-}
-module T7 where
-
-import           Control.Monad.Trans.Except
-import           Control.Monad.Trans.Reader
-import           Network.Wai
-import           Servant
-
-type ReaderAPI = "a" :> Get '[JSON] Int
-            :<|> "b" :> Get '[JSON] String
-
-readerAPI :: Proxy ReaderAPI
-readerAPI = Proxy
-
-readerServerT :: ServerT ReaderAPI (Reader String)
-readerServerT = a :<|> b
-
-  where a :: Reader String Int
-        a = return 1797
-
-        b :: Reader String String
-        b = ask
-
-readerServer :: Server ReaderAPI
-readerServer = enter readerToEither readerServerT
-
-  where readerToEither :: Reader String :~> ExceptT ServantErr IO
-        readerToEither = Nat $ \r -> return (runReader r "hi")
-
-app :: Application
-app = serve readerAPI readerServer

servant-examples/tutorial/T8.hs

@@ -1,49 +0,0 @@
-{-# LANGUAGE DataKinds     #-}
-{-# LANGUAGE TypeFamilies  #-}
-{-# LANGUAGE TypeOperators #-}
-module T8 where
-
-import           Control.Monad.Trans.Except
-import           Network.HTTP.Client        (Manager, defaultManagerSettings,
-                                             newManager)
-import           Servant
-import           Servant.Client
-import           System.IO.Unsafe           (unsafePerformIO)
-
-import           T3
-
-position :: Int -- ^ value for "x"
-         -> Int -- ^ value for "y"
-         -> ExceptT ServantError IO Position
-
-hello :: Maybe String -- ^ an optional value for "name"
-      -> ExceptT ServantError IO HelloMessage
-
-marketing :: ClientInfo -- ^ value for the request body
-          -> ExceptT ServantError IO Email
-
-position :<|> hello :<|> marketing = client api baseUrl manager
-
-baseUrl :: BaseUrl
-baseUrl = BaseUrl Http "localhost" 8081 ""
-
-{-# NOINLINE manager #-}
-manager :: Manager
-manager = unsafePerformIO $ newManager defaultManagerSettings
-
-queries :: ExceptT ServantError IO (Position, HelloMessage, Email)
-queries = do
-  pos <- position 10 10
-  msg <- hello (Just "servant")
-  em  <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])
-  return (pos, msg, em)
-
-run :: IO ()
-run = do
-  res <- runExceptT queries
-  case res of
-    Left err -> putStrLn $ "Error: " ++ show err
-    Right (pos, msg, em) -> do
-      print pos
-      print msg
-      print em

servant-examples/tutorial/T9.hs

@@ -1,105 +0,0 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies      #-}
-{-# LANGUAGE TypeOperators     #-}
-module T9 where
-
-import           Control.Applicative
-import           Control.Monad.IO.Class
-import           Data.Aeson
-import           Data.Text                  (Text)
-import           GHC.Generics
-import           Network.Wai
-import           Servant
-import           Servant.JS
-import           System.Random
-
-import qualified Data.Text                  as T
-import qualified Data.Text.IO               as TIO
-import qualified Language.Javascript.JQuery as JQ
-
-data Point = Point
-  { x :: Double
-  , y :: Double
-  } deriving Generic
-
-instance ToJSON Point
-
-randomPoint :: MonadIO m => m Point
-randomPoint = liftIO . getStdRandom $ \g ->
-  let (rx, g')  = randomR (-1, 1) g
-      (ry, g'') = randomR (-1, 1) g'
-  in (Point rx ry, g'')
-
-data Search a = Search
-  { query   :: Text
-  , results :: [a]
-  } deriving Generic
-
-mkSearch :: Text -> [a] -> Search a
-mkSearch = Search
-
-instance ToJSON a => ToJSON (Search a)
-
-data Book = Book
-  { author :: Text
-  , title  :: Text
-  , year   :: Int
-  } deriving Generic
-
-instance ToJSON Book
-
-book :: Text -> Text -> Int -> Book
-book = Book
-
-books :: [Book]
-books =
-  [ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000
-  , book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008
-  , book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011
-  , book "Graham Hutton" "Programming in Haskell" 2007
-  , book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013
-  , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
-  ]
-
-searchBook :: Monad m => Maybe Text -> m (Search Book)
-searchBook Nothing  = return (mkSearch "" books)
-searchBook (Just q) = return (mkSearch q books')
-
-  where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b)
-                            || q' `T.isInfixOf` T.toLower (title b)
-                        )
-                        books
-        q' = T.toLower q
-
-type API = "point" :> Get '[JSON] Point
-      :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book)
-
-type API' = API :<|> Raw
-
-api :: Proxy API
-api = Proxy
-
-api' :: Proxy API'
-api' = Proxy
-
-server :: Server API
-server = randomPoint
-    :<|> searchBook
-
-server' :: Server API'
-server' = server
-     :<|> serveDirectory "tutorial/t9"
-
-apiJS :: Text
-apiJS = jsForAPI api jquery
-
-writeJSFiles :: IO ()
-writeJSFiles = do
-  TIO.writeFile "tutorial/t9/api.js" apiJS
-  jq <- TIO.readFile =<< JQ.file
-  TIO.writeFile "tutorial/t9/jq.js" jq
-
-app :: Application
-app = serve api' server'

servant-examples/tutorial/t8-main.hs

@@ -1,4 +0,0 @@
-import           T8
-
-main :: IO ()
-main = run

servant-examples/tutorial/tutorial.hs

@@ -1,39 +0,0 @@
-import           Network.Wai
-import           Network.Wai.Handler.Warp
-import           System.Environment
-
-import qualified T1
-import qualified T10
-import qualified T2
-import qualified T3
-import qualified T4
-import qualified T5
-import qualified T6
-import qualified T7
-import qualified T9
-
-app :: String -> (Application -> IO ()) -> IO ()
-app n f = case n of
-  "1" -> f T1.app
-  "2" -> f T2.app
-  "3" -> f T3.app
-  "4" -> f T4.app
-  "5" -> f T5.app
-  "6" -> f T6.app
-  "7" -> f T7.app
-  "8" -> f T3.app
-  "9" -> T9.writeJSFiles >> f T9.app
-  "10" -> f T10.app
-  _   -> usage
-
-main :: IO ()
-main = do
-  args <- getArgs
-  case args of
-    [n] -> app n (run 8081)
-    _   -> usage
-
-usage :: IO ()
-usage = do
-  putStrLn "Usage:\t tutorial N"
-  putStrLn "\t\twhere N is the number of the example you want to run."

servant-examples/wai-middleware/wai-middleware.hs

@@ -1,51 +0,0 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE OverloadedStrings #-}
-import           Data.Aeson
-import           Data.Text
-import           GHC.Generics
-import           Network.Wai
-import           Network.Wai.Handler.Warp
-import           Network.Wai.Middleware.RequestLogger
-import           Servant
-
-data Product = Product
-  { name              :: Text
-  , brand             :: Text
-  , current_price_eur :: Double
-  , available         :: Bool
-  } deriving (Eq, Show, Generic)
-
-instance ToJSON Product
-
-products :: [Product]
-products = [p1, p2]
-
-  where p1 = Product "Haskell laptop sticker"
-                     "GHC Industries"
-                     2.50
-                     True
-
-        p2 = Product "Foldable USB drive"
-                     "Well-Typed"
-                     13.99
-                     False
-
-type SimpleAPI = Get '[JSON] [Product]
-
-simpleAPI :: Proxy SimpleAPI
-simpleAPI = Proxy
-
-server :: Server SimpleAPI
-server = return products
-
--- logStdout :: Middleware
--- i.e, logStdout :: Application -> Application
--- serve :: Proxy api -> Server api -> Application
--- so applying a middleware is really as simple as
--- applying a function to the result of 'serve'
-app :: Application
-app = logStdout (serve simpleAPI server)
-
-main :: IO ()
-main = run 8080 app

servant-foreign/CHANGELOG.md

@@ -1,4 +1,5 @@
-HEAD
+0.5
 -----
 * Use the `text` package instead of `String`.
 * Extract javascript-oblivious types and helpers to *servant-foreign*
+* Typed-languages support

servant-foreign/LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2014, Zalora South East Asia Pte Ltd
+Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors
 
 All rights reserved.
 

servant-foreign/include/overlapping-compat.h

@@ -0,0 +1,8 @@
+#if __GLASGOW_HASKELL__ >= 710
+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
+#define OVERLAPPING_  {-# OVERLAPPING #-}
+#else
+{-# LANGUAGE OverlappingInstances #-}
+#define OVERLAPPABLE_
+#define OVERLAPPING_
+#endif

servant-foreign/servant-foreign.cabal

@@ -1,5 +1,5 @@
 name:                servant-foreign
-version:             0.5
+version:             0.6
 synopsis:            Helpers for generating clients for servant APIs in any programming language
 description:
   Helper types and functions for generating client functions for servant APIs in any programming language
@@ -11,13 +11,14 @@ description:
   <https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md CHANGELOG>
 license:             BSD3
 license-file:        LICENSE
-author:              Denis Redozubov, Maksymilian Owsianny
+author:              Servant Contributors
-maintainer:          denis.redozubov@gmail.com
+maintainer:          haskell-servant-maintainers@googlegroups.com
-copyright:           2015 Denis Redozubov, Alp Mestanogullari
+copyright:           2015-2016 Servant Contributors
 category:            Web
 build-type:          Simple
 cabal-version:       >=1.10
 extra-source-files:
+  include/*.h
   CHANGELOG.md
   README.md
 source-repository head
@@ -25,24 +26,55 @@ source-repository head
   location: http://github.com/haskell-servant/servant.git
 
 library
-  exposed-modules:     Servant.Foreign, Servant.Foreign.Internal
+  exposed-modules:     Servant.Foreign
-  build-depends:       base    == 4.*
+                     , Servant.Foreign.Internal
-                     , lens    == 4.*
+                     , Servant.Foreign.Inflections
-                     , servant == 0.5.*
+  build-depends:       base       == 4.*
-                     , text    >= 1.2  && < 1.3
+                     , lens       == 4.*
+                     , servant    == 0.6.*
+                     , text       >= 1.2  && < 1.3
+                     , http-types
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall
+  include-dirs: include
+  default-extensions:  CPP
+                     , ConstraintKinds
+                     , DataKinds
+                     , FlexibleContexts
+                     , FlexibleInstances
+                     , GeneralizedNewtypeDeriving
+                     , MultiParamTypeClasses
+                     , ScopedTypeVariables
+                     , StandaloneDeriving
+                     , TemplateHaskell
+                     , TypeFamilies
+                     , TypeOperators
+                     , UndecidableInstances
+                     , OverloadedStrings
+                     , PolyKinds
 
 
 test-suite spec
   type:              exitcode-stdio-1.0
   hs-source-dirs:    test
   ghc-options:       -Wall
+  include-dirs:      include
   main-is:           Spec.hs
-  other-modules:
+  other-modules:     Servant.ForeignSpec
-      Servant.ForeignSpec
   build-depends:     base
                    , hspec >= 2.1.8
                    , servant-foreign
   default-language:  Haskell2010
+  default-extensions:  ConstraintKinds
+                     , DataKinds
+                     , FlexibleContexts
+                     , FlexibleInstances
+                     , GeneralizedNewtypeDeriving
+                     , MultiParamTypeClasses
+                     , ScopedTypeVariables
+                     , TypeFamilies
+                     , TypeOperators
+                     , UndecidableInstances
+                     , OverloadedStrings
+                     , PolyKinds

servant-foreign/src/Servant/Foreign.hs

@@ -1,39 +1,56 @@
 -- | Generalizes all the data needed to make code generation work with
 -- arbitrary programming languages.
 module Servant.Foreign
-  ( HasForeign(..)
+  ( ArgType(..)
-  , HasForeignType(..)
+  , HeaderArg(..)
+  , QueryArg(..)
+  , Req(..)
   , Segment(..)
   , SegmentType(..)
-  , FunctionName
+  , Url(..)
-  , QueryArg(..)
+    -- aliases
-  , HeaderArg(..)
+  , Path
-  , ArgType(..)
+  , Arg(..)
-  , Req
+  , FunctionName(..)
-  , captureArg
+  , PathSegment(..)
-  , defReq
+    -- lenses
-  , concatCase
-  , snakeCase
-  , camelCase
-  -- lenses
-  , argType
   , argName
-  , isCapture
+  , argType
-  , funcName
+  , argPath
-  , path
   , reqUrl
-  , reqBody
-  , reqHeaders
   , reqMethod
+  , reqHeaders
+  , reqBody
   , reqReturnType
-  , segment
+  , reqFuncName
+  , path
   , queryStr
-  , listFromAPI
+  , queryArgName
+  , queryArgType
+  , headerArg
+    -- prisms
+  , _PathSegment
+  , _HeaderArg
+  , _ReplaceHeaderArg
+  , _Static
+  , _Cap
+  , _Normal
+  , _Flag
+  , _List
+    -- rest of it
+  , HasForeign(..)
+  , HasForeignType(..)
   , GenerateList(..)
   , NoTypes
-  -- re-exports
+  , captureArg
+  , isCapture
+  , defReq
+  , listFromAPI
+    -- re-exports
   , module Servant.API
+  , module Servant.Foreign.Inflections
   ) where
 
 import Servant.API
 import Servant.Foreign.Internal
+import Servant.Foreign.Inflections

servant-foreign/src/Servant/Foreign/Inflections.hs

@@ -0,0 +1,45 @@
+module Servant.Foreign.Inflections
+  ( concatCase
+  , snakeCase
+  , camelCase
+    -- lenses
+  , concatCaseL
+  , snakeCaseL
+  , camelCaseL
+  ) where
+
+
+import           Control.Lens hiding (cons)
+import qualified Data.Char as C
+import           Data.Monoid
+import           Data.Text hiding (map)
+import           Prelude hiding (head, tail)
+import           Servant.Foreign.Internal
+
+concatCaseL :: Getter FunctionName Text
+concatCaseL = _FunctionName . to mconcat
+
+-- | Function name builder that simply concat each part together
+concatCase :: FunctionName -> Text
+concatCase = view concatCaseL
+
+snakeCaseL :: Getter FunctionName Text
+snakeCaseL = _FunctionName . to (intercalate "_")
+
+-- | Function name builder using the snake_case convention.
+-- each part is separated by a single underscore character.
+snakeCase :: FunctionName -> Text
+snakeCase = view snakeCaseL
+
+camelCaseL :: Getter FunctionName Text
+camelCaseL = _FunctionName . to (convert . map (replace "-" ""))
+  where
+    convert []     = ""
+    convert (p:ps) = mconcat $ p : map capitalize ps
+    capitalize ""   = ""
+    capitalize name = C.toUpper (head name) `cons` tail name
+
+-- | Function name builder using the CamelCase convention.
+-- each part begins with an upper case character.
+camelCase :: FunctionName -> Text
+camelCase = view camelCaseL

servant-foreign/src/Servant/Foreign/Internal.hs

@@ -1,117 +1,138 @@
-{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
 #if !MIN_VERSION_base(4,8,0)
-{-# LANGUAGE NullaryTypeClasses    #-}
+{-# LANGUAGE NullaryTypeClasses #-}
 #endif
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE OverloadedStrings     #-}
 
 -- | Generalizes all the data needed to make code generation work with
 -- arbitrary programming languages.
 module Servant.Foreign.Internal where
 
-import           Control.Lens (makeLenses, (%~), (&), (.~), (<>~))
+import           Control.Lens hiding (cons, List)
-import qualified Data.Char    as C
+#if !MIN_VERSION_base(4,8,0)
+import           Data.Monoid
+#endif
 import           Data.Proxy
+import           Data.String
 import           Data.Text
-import           GHC.Exts     (Constraint)
+import           Data.Text.Encoding (decodeUtf8)
+import           GHC.Exts (Constraint)
 import           GHC.TypeLits
-import           Prelude      hiding (concat)
+import qualified Network.HTTP.Types as HTTP
+import           Prelude hiding (concat)
 import           Servant.API
 
--- | Function name builder that simply concat each part together
-concatCase :: FunctionName -> Text
-concatCase = concat
 
--- | Function name builder using the snake_case convention.
+newtype FunctionName = FunctionName { unFunctionName :: [Text] }
--- each part is separated by a single underscore character.
+  deriving (Show, Eq, Monoid)
-snakeCase :: FunctionName -> Text
-snakeCase = intercalate "_"
 
--- | Function name builder using the CamelCase convention.
+makePrisms ''FunctionName
--- each part begins with an upper case character.
-camelCase :: FunctionName -> Text
-camelCase = camelCase' . Prelude.map (replace "-" "")
-  where camelCase' []     = ""
-        camelCase' (p:ps) = concat $ p : Prelude.map capitalize ps
-        capitalize ""   = ""
-        capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
 
-type ForeignType = Text
+newtype PathSegment = PathSegment { unPathSegment :: Text }
-type Arg = (Text, ForeignType)
+  deriving (Show, Eq, IsString, Monoid)
 
-newtype Segment = Segment { _segment :: SegmentType  }
+makePrisms ''PathSegment
-  deriving (Eq, Show)
 
-data SegmentType = Static Text  -- ^ a static path segment. like "/foo"
+data Arg f = Arg
-                 | Cap Arg        -- ^ a capture. like "/:userid"
+  { _argName :: PathSegment
-  deriving (Eq, Show)
+  , _argType :: f }
 
-type Path = [Segment]
+deriving instance Eq f => Eq (Arg f)
+deriving instance Show f => Show (Arg f)
 
-data ArgType =
+makeLenses ''Arg
-    Normal
+
+argPath :: Getter (Arg f) Text
+argPath = argName . _PathSegment
+
+data SegmentType f
+  = Static PathSegment
+    -- ^ a static path segment. like "/foo"
+  | Cap (Arg f)
+    -- ^ a capture. like "/:userid"
+
+deriving instance Eq f => Eq (SegmentType f)
+deriving instance Show f => Show (SegmentType f)
+
+makePrisms ''SegmentType
+
+newtype Segment f = Segment { unSegment :: SegmentType f }
+
+deriving instance Eq f => Eq (Segment f)
+deriving instance Show f => Show (Segment f)
+
+makePrisms ''Segment
+
+isCapture :: Segment f -> Bool
+isCapture (Segment (Cap _)) = True
+isCapture                _  = False
+
+captureArg :: Segment f -> Arg f
+captureArg (Segment (Cap s)) = s
+captureArg                 _ = error "captureArg called on non capture"
+
+type Path f = [Segment f]
+
+data ArgType
+  = Normal
   | Flag
   | List
   deriving (Eq, Show)
 
-data QueryArg = QueryArg
+makePrisms ''ArgType
-  { _argName :: Arg
-  , _argType :: ArgType
-  } deriving (Eq, Show)
 
-data HeaderArg = HeaderArg
+data QueryArg f = QueryArg
-    { headerArg :: Arg
+  { _queryArgName :: Arg f
-    }
+  , _queryArgType :: ArgType
-  | ReplaceHeaderArg
+  }
-    { headerArg :: Arg
-    , headerPattern :: Text
-    } deriving (Eq, Show)
 
-
+deriving instance Eq f => Eq (QueryArg f)
-data Url = Url
+deriving instance Show f => Show (QueryArg f)
-  { _path     :: Path
-  , _queryStr :: [QueryArg]
-  } deriving (Eq, Show)
-
-defUrl :: Url
-defUrl = Url [] []
-
-type FunctionName = [Text]
-type Method = Text
-
-data Req = Req
-  { _reqUrl        :: Url
-  , _reqMethod     :: Method
-  , _reqHeaders    :: [HeaderArg]
-  , _reqBody       :: Maybe ForeignType
-  , _reqReturnType :: ForeignType
-  , _funcName      :: FunctionName
-  } deriving (Eq, Show)
 
 makeLenses ''QueryArg
-makeLenses ''Segment
+
+data HeaderArg f = HeaderArg
+  { _headerArg :: Arg f }
+  | ReplaceHeaderArg
+  { _headerArg     :: Arg f
+  , _headerPattern :: Text
+  }
+
+deriving instance Eq f => Eq (HeaderArg f)
+deriving instance Show f => Show (HeaderArg f)
+
+makeLenses ''HeaderArg
+
+makePrisms ''HeaderArg
+
+data Url f = Url
+  { _path     :: Path f
+  , _queryStr :: [QueryArg f]
+  }
+
+deriving instance Eq f => Eq (Url f)
+deriving instance Show f => Show (Url f)
+
+defUrl :: Url f
+defUrl = Url [] []
+
 makeLenses ''Url
+
+data Req f = Req
+  { _reqUrl        :: Url f
+  , _reqMethod     :: HTTP.Method
+  , _reqHeaders    :: [HeaderArg f]
+  , _reqBody       :: Maybe f
+  , _reqReturnType :: Maybe f
+  , _reqFuncName   :: FunctionName
+  }
+
+deriving instance Eq f => Eq (Req f)
+deriving instance Show f => Show (Req f)
+
 makeLenses ''Req
 
-isCapture :: Segment -> Bool
+defReq :: Req ftype
-isCapture (Segment (Cap _)) = True
+defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName [])
-isCapture                _  = False
-
-captureArg :: Segment -> Arg
-captureArg (Segment (Cap s)) = s
-captureArg                 _ = error "captureArg called on non capture"
-
-defReq :: Req
-defReq = Req defUrl "GET" [] Nothing "" []
 
 -- | To be used exclusively as a "negative" return type/constraint
 -- by @'Elem`@ type family.
@@ -124,226 +145,218 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
 
 -- | 'HasForeignType' maps Haskell types with types in the target
 -- language of your backend. For example, let's say you're
--- implementing a backend to some language __X__:
+-- implementing a backend to some language __X__, and you want
+-- a Text representation of each input/output type mentioned in the API:
 --
 -- > -- First you need to create a dummy type to parametrize your
 -- > -- instances.
 -- > data LangX
 -- >
 -- > -- Otherwise you define instances for the types you need
--- > instance HasForeignType LangX Int where
+-- > instance HasForeignType LangX Text Int where
--- >    typeFor _ _ = "intX"
+-- >    typeFor _ _ _ = "intX"
 -- >
 -- > -- Or for example in case of lists
--- > instance HasForeignType LangX a => HasForeignType LangX [a] where
+-- > instance HasForeignType LangX Text a => HasForeignType LangX Text [a] where
--- >    typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
+-- >    typeFor lang type _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
 --
 -- Finally to generate list of information about all the endpoints for
 -- an API you create a function of a form:
 --
--- > getEndpoints :: (HasForeign LangX api, GenerateList (Foreign api))
+-- > getEndpoints :: (HasForeign LangX Text api, GenerateList Text (Foreign Text api))
--- >              => Proxy api -> [Req]
+-- >              => Proxy api -> [Req Text]
--- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) api
+-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy Text) api
 --
 -- > -- If language __X__ is dynamically typed then you can use
--- > -- a predefined NoTypes parameter
+-- > -- a predefined NoTypes parameter with the () output type:
--- > getEndpoints :: (HasForeign NoTypes api, GenerateList (Foreign api))
+--
--- >              => Proxy api -> [Req]
+-- > getEndpoints :: (HasForeign NoTypes () api, GenerateList Text (Foreign () api))
--- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) api
+-- >              => Proxy api -> [Req ()]
+-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) api
 -- >
 --
-class HasForeignType lang a where
+class HasForeignType lang ftype a where
-    typeFor :: Proxy lang -> Proxy a -> ForeignType
+  typeFor :: Proxy lang -> Proxy ftype -> Proxy a -> ftype
 
 data NoTypes
 
-instance HasForeignType NoTypes a where
+instance HasForeignType NoTypes () ftype where
-    typeFor _ _ = empty
+  typeFor _ _ _ = ()
 
-class HasForeign lang (layout :: *) where
+class HasForeign lang ftype (layout :: *) where
-  type Foreign layout :: *
+  type Foreign ftype layout :: *
-  foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout
+  foreignFor :: Proxy lang -> Proxy ftype -> Proxy layout -> Req ftype -> Foreign ftype layout
 
-instance (HasForeign lang a, HasForeign lang b)
+instance (HasForeign lang ftype a, HasForeign lang ftype b)
-      => HasForeign lang (a :<|> b) where
+  => HasForeign lang ftype (a :<|> b) where
-  type Foreign (a :<|> b) = Foreign a :<|> Foreign b
+  type Foreign ftype (a :<|> b) = Foreign ftype a :<|> Foreign ftype b
 
-  foreignFor lang Proxy req =
+  foreignFor lang ftype Proxy req =
-         foreignFor lang (Proxy :: Proxy a) req
+         foreignFor lang ftype (Proxy :: Proxy a) req
-    :<|> foreignFor lang (Proxy :: Proxy b) req
+    :<|> foreignFor lang ftype (Proxy :: Proxy b) req
 
-instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
+instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout)
-      => HasForeign lang (Capture sym a :> sublayout) where
+  => HasForeign lang ftype (Capture sym t :> sublayout) where
-  type Foreign (Capture sym a :> sublayout) = Foreign sublayout
+  type Foreign ftype (Capture sym a :> sublayout) = Foreign ftype sublayout
-
-  foreignFor lang Proxy req =
-    foreignFor lang (Proxy :: Proxy sublayout) $
-      req & reqUrl.path <>~ [Segment (Cap arg)]
-          & funcName %~ (++ ["by", str])
 
+  foreignFor lang Proxy Proxy req =
+    foreignFor lang Proxy (Proxy :: Proxy sublayout) $
+      req & reqUrl . path <>~ [Segment (Cap arg)]
+          & reqFuncName . _FunctionName %~ (++ ["by", str])
     where
-    str = pack . symbolVal $ (Proxy :: Proxy sym)
+      str   = pack . symbolVal $ (Proxy :: Proxy sym)
-    arg = (str, typeFor lang (Proxy :: Proxy a))
+      ftype = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy t)
+      arg   = Arg
+        { _argName = PathSegment str
+        , _argType = ftype }
 
-instance (Elem JSON list, HasForeignType lang a)
+instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
-      => HasForeign lang (Delete list a) where
+  => HasForeign lang ftype (Verb method status list a) where
-  type Foreign (Delete list a) = Req
+  type Foreign ftype (Verb method status list a) = Req ftype
 
-  foreignFor lang Proxy req =
+  foreignFor lang Proxy Proxy req =
-    req & funcName      %~ ("delete" :)
+    req & reqFuncName . _FunctionName %~ (methodLC :)
-        & reqMethod     .~ "DELETE"
+        & reqMethod .~ method
-        & reqReturnType .~ retType
+        & reqReturnType .~ Just retType
     where
-    retType = typeFor lang (Proxy :: Proxy a)
+      retType  = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a)
+      method   = reflectMethod (Proxy :: Proxy method)
+      methodLC = toLower $ decodeUtf8 method
 
-instance (Elem JSON list, HasForeignType lang a)
+instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
-      => HasForeign lang (Get list a) where
+  => HasForeign lang ftype (Header sym a :> sublayout) where
-  type Foreign (Get list a) = Req
+  type Foreign ftype (Header sym a :> sublayout) = Foreign ftype sublayout
 
-  foreignFor lang Proxy req =
+  foreignFor lang Proxy Proxy req =
-    req & funcName  %~ ("get" :)
+    foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg]
-        & reqMethod .~ "GET"
-        & reqReturnType .~ retType
     where
-    retType = typeFor lang (Proxy :: Proxy a)
+      hname = pack . symbolVal $ (Proxy :: Proxy sym)
+      arg   = Arg
+        { _argName = PathSegment hname
+        , _argType  = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
+      subP  = Proxy :: Proxy sublayout
 
-instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
+instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
-      => HasForeign lang (Header sym a :> sublayout) where
+  => HasForeign lang ftype (QueryParam sym a :> sublayout) where
-  type Foreign (Header sym a :> sublayout) = Foreign sublayout
+  type Foreign ftype (QueryParam sym a :> sublayout) = Foreign ftype sublayout
 
-  foreignFor lang Proxy req =
+  foreignFor lang Proxy Proxy req =
-    foreignFor lang subP $ req
+    foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
-        & reqHeaders <>~ [HeaderArg arg]
-
-    where
-    hname = pack . symbolVal $ (Proxy :: Proxy sym)
-    arg = (hname, typeFor lang (Proxy :: Proxy a))
-    subP = Proxy :: Proxy sublayout
-
-instance (Elem JSON list, HasForeignType lang a)
-      => HasForeign lang (Post list a) where
-  type Foreign (Post list a) = Req
-
-  foreignFor lang Proxy req =
-    req & funcName  %~ ("post" :)
-        & reqMethod .~ "POST"
-        & reqReturnType .~ retType
-    where
-    retType = typeFor lang (Proxy :: Proxy a)
-
-instance (Elem JSON list, HasForeignType lang a)
-      => HasForeign lang (Put list a) where
-  type Foreign (Put list a) = Req
-
-  foreignFor lang Proxy req =
-    req & funcName  %~ ("put" :)
-        & reqMethod .~ "PUT"
-        & reqReturnType .~ retType
-    where
-    retType = typeFor lang (Proxy :: Proxy a)
-
-instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
-      => HasForeign lang (QueryParam sym a :> sublayout) where
-  type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
-
-  foreignFor lang Proxy req =
-    foreignFor lang (Proxy :: Proxy sublayout) $
       req & reqUrl.queryStr <>~ [QueryArg arg Normal]
-
     where
-    str = pack . symbolVal $ (Proxy :: Proxy sym)
+      str = pack . symbolVal $ (Proxy :: Proxy sym)
-    arg = (str, typeFor lang (Proxy :: Proxy a))
+      arg = Arg
+        { _argName = PathSegment str
+        , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
 
-instance (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
+instance
-      => HasForeign lang (QueryParams sym a :> sublayout) where
+  (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout)
-  type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
+  => HasForeign lang ftype (QueryParams sym a :> sublayout) where
-
+  type Foreign ftype (QueryParams sym a :> sublayout) = Foreign ftype sublayout
-  foreignFor lang Proxy req =
+  foreignFor lang Proxy Proxy req =
-    foreignFor lang (Proxy :: Proxy sublayout) $
+    foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
       req & reqUrl.queryStr <>~ [QueryArg arg List]
-
     where
-    str = pack . symbolVal $ (Proxy :: Proxy sym)
+      str = pack . symbolVal $ (Proxy :: Proxy sym)
-    arg = (str, typeFor lang (Proxy :: Proxy [a]))
+      arg = Arg
+        { _argName = PathSegment str
+        , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) }
 
-instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang sublayout)
+instance
-      => HasForeign lang (QueryFlag sym :> sublayout) where
+  (KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout)
-  type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
+  => HasForeign lang ftype (QueryFlag sym :> sublayout) where
+  type Foreign ftype (QueryFlag sym :> sublayout) = Foreign ftype sublayout
 
-  foreignFor lang Proxy req =
+  foreignFor lang ftype Proxy req =
-    foreignFor lang (Proxy :: Proxy sublayout) $
+    foreignFor lang ftype (Proxy :: Proxy sublayout) $
       req & reqUrl.queryStr <>~ [QueryArg arg Flag]
-
     where
-    str = pack . symbolVal $ (Proxy :: Proxy sym)
+      str = pack . symbolVal $ (Proxy :: Proxy sym)
-    arg = (str, typeFor lang (Proxy :: Proxy a))
+      arg = Arg
+        { _argName = PathSegment str
+        , _argType = typeFor lang ftype (Proxy :: Proxy Bool) }
 
-instance HasForeign lang Raw where
+instance HasForeign lang ftype Raw where
-  type Foreign Raw = Method -> Req
+  type Foreign ftype Raw = HTTP.Method -> Req ftype
 
-  foreignFor _ Proxy req method =
+  foreignFor _ Proxy Proxy req method =
-    req & funcName %~ ((toLower method) :)
+    req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
         & reqMethod .~ method
 
-instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout)
+instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
-      => HasForeign lang (ReqBody list a :> sublayout) where
+      => HasForeign lang ftype (ReqBody list a :> sublayout) where
-  type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
+  type Foreign ftype (ReqBody list a :> sublayout) = Foreign ftype sublayout
 
-  foreignFor lang Proxy req =
+  foreignFor lang ftype Proxy req =
-    foreignFor lang (Proxy :: Proxy sublayout) $
+    foreignFor lang ftype (Proxy :: Proxy sublayout) $
-      req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a))
+      req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a))
 
-instance (KnownSymbol path, HasForeign lang sublayout)
+instance (KnownSymbol path, HasForeign lang ftype sublayout)
-      => HasForeign lang (path :> sublayout) where
+      => HasForeign lang ftype (path :> sublayout) where
-  type Foreign (path :> sublayout) = Foreign sublayout
+  type Foreign ftype (path :> sublayout) = Foreign ftype sublayout
-
-  foreignFor lang Proxy req =
-    foreignFor lang (Proxy :: Proxy sublayout) $
-      req & reqUrl.path <>~ [Segment (Static str)]
-          & funcName %~ (++ [str])
 
+  foreignFor lang ftype Proxy req =
+    foreignFor lang ftype (Proxy :: Proxy sublayout) $
+      req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
+          & reqFuncName . _FunctionName %~ (++ [str])
     where
-    str = Data.Text.map (\c -> if c == '.' then '_' else c)
+      str =
-        . pack . symbolVal $ (Proxy :: Proxy path)
+        Data.Text.map (\c -> if c == '.' then '_' else c)
+          . pack . symbolVal $ (Proxy :: Proxy path)
 
-instance HasForeign lang sublayout => HasForeign lang (RemoteHost :> sublayout) where
+instance HasForeign lang ftype sublayout
-  type Foreign (RemoteHost :> sublayout) = Foreign sublayout
+  => HasForeign lang ftype (RemoteHost :> sublayout) where
+  type Foreign ftype (RemoteHost :> sublayout) = Foreign ftype sublayout
 
-  foreignFor lang Proxy req =
+  foreignFor lang ftype Proxy req =
-    foreignFor lang (Proxy :: Proxy sublayout) req
+    foreignFor lang ftype (Proxy :: Proxy sublayout) req
 
-instance HasForeign lang sublayout => HasForeign lang (IsSecure :> sublayout) where
+instance HasForeign lang ftype sublayout
-  type Foreign (IsSecure :> sublayout) = Foreign sublayout
+  => HasForeign lang ftype (IsSecure :> sublayout) where
+  type Foreign ftype (IsSecure :> sublayout) = Foreign ftype sublayout
 
-  foreignFor lang Proxy req =
+  foreignFor lang ftype Proxy req =
-    foreignFor lang (Proxy :: Proxy sublayout) req
+    foreignFor lang ftype (Proxy :: Proxy sublayout) req
 
-instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where
+instance HasForeign lang ftype sublayout => HasForeign lang ftype (Vault :> sublayout) where
-  type Foreign (Vault :> sublayout) = Foreign sublayout
+  type Foreign ftype (Vault :> sublayout) = Foreign ftype sublayout
 
-  foreignFor lang Proxy req =
+  foreignFor lang ftype Proxy req =
-    foreignFor lang (Proxy :: Proxy sublayout) req
+    foreignFor lang ftype (Proxy :: Proxy sublayout) req
 
-instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) where
+instance HasForeign lang ftype sublayout =>
-  type Foreign (HttpVersion :> sublayout) = Foreign sublayout
+  HasForeign lang ftype (WithNamedContext name context sublayout) where
 
-  foreignFor lang Proxy req =
+  type Foreign ftype (WithNamedContext name context sublayout) = Foreign ftype sublayout
-    foreignFor lang (Proxy :: Proxy sublayout) req
+
+  foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy sublayout)
+
+instance HasForeign lang ftype sublayout
+  => HasForeign lang ftype (HttpVersion :> sublayout) where
+  type Foreign ftype (HttpVersion :> sublayout) = Foreign ftype sublayout
+
+  foreignFor lang ftype Proxy req =
+    foreignFor lang ftype (Proxy :: Proxy sublayout) req
 
 -- | Utility class used by 'listFromAPI' which computes
 --   the data needed to generate a function for each endpoint
 --   and hands it all back in a list.
-class GenerateList reqs where
+class GenerateList ftype reqs where
-  generateList :: reqs -> [Req]
+  generateList :: reqs -> [Req ftype]
 
-instance GenerateList Req where
+instance GenerateList ftype (Req ftype) where
   generateList r = [r]
 
-instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> rest) where
+instance (GenerateList ftype start, GenerateList ftype rest)
+  => GenerateList ftype (start :<|> rest) where
   generateList (start :<|> rest) = (generateList start) ++ (generateList rest)
 
 -- | Generate the necessary data for codegen as a list, each 'Req'
 --   describing one endpoint from your API type.
-listFromAPI :: (HasForeign lang api, GenerateList (Foreign api)) => Proxy lang -> Proxy api -> [Req]
+listFromAPI
-listFromAPI lang p = generateList (foreignFor lang p defReq)
+  :: (HasForeign lang ftype api, GenerateList ftype (Foreign ftype api))
-
+  => Proxy lang
+  -> Proxy ftype
+  -> Proxy api
+  -> [Req ftype]
+listFromAPI lang ftype p = generateList (foreignFor lang ftype p defReq)

servant-foreign/test/Servant/ForeignSpec.hs

@@ -1,22 +1,11 @@
-{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE CPP               #-}
-{-# LANGUAGE TypeOperators         #-}
+#include "overlapping-compat.h"
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE TypeSynonymInstances  #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE CPP                   #-}
-#if __GLASGOW_HASKELL__ < 710
-{-# LANGUAGE OverlappingInstances  #-}
-#endif
 
 module Servant.ForeignSpec where
 
 import Data.Monoid ((<>))
 import Data.Proxy
 import Servant.Foreign
-import Servant.Foreign.Internal
 
 import Test.Hspec
 
@@ -28,23 +17,29 @@ spec = describe "Servant.Foreign" $ do
 camelCaseSpec :: Spec
 camelCaseSpec = describe "camelCase" $ do
   it "converts FunctionNames to camelCase" $ do
-    camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc"
+    camelCase (FunctionName ["post", "counter", "inc"])
-    camelCase ["get", "hyphen-ated", "counter"] `shouldBe` "getHyphenatedCounter"
+      `shouldBe` "postCounterInc"
+    camelCase (FunctionName ["get", "hyphen-ated", "counter"])
+      `shouldBe` "getHyphenatedCounter"
 
 ----------------------------------------------------------------------
 
 data LangX
 
-instance HasForeignType LangX () where
+instance HasForeignType LangX String () where
-    typeFor _ _ = "voidX"
+  typeFor _ _ _ = "voidX"
-instance HasForeignType LangX Int where
+
-    typeFor _ _ = "intX"
+instance HasForeignType LangX String Int where
-instance HasForeignType LangX Bool where
+  typeFor _ _ _ = "intX"
-    typeFor _ _ = "boolX"
+
-instance {-# Overlapping #-} HasForeignType LangX String where
+instance HasForeignType LangX String Bool where
-    typeFor _ _ = "stringX"
+  typeFor _ _ _ = "boolX"
-instance {-# Overlappable #-} HasForeignType LangX a => HasForeignType LangX [a] where
+
-    typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a)
+instance OVERLAPPING_ HasForeignType LangX String String where
+  typeFor _ _ _ = "stringX"
+
+instance OVERLAPPABLE_ HasForeignType LangX String a => HasForeignType LangX String [a] where
+  typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
 
 type TestApi
     = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int
@@ -52,63 +47,62 @@ type TestApi
  :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] ()
  :<|> "test" :> Capture "id" Int :> Delete '[JSON] ()
 
-testApi :: [Req]
+testApi :: [Req String]
-testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi)
+testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy String) (Proxy :: Proxy TestApi)
 
 listFromAPISpec :: Spec
 listFromAPISpec = describe "listFromAPI" $ do
-    it "generates 4 endpoints for TestApi" $ do
+  it "generates 4 endpoints for TestApi" $ do
-        length testApi `shouldBe` 4
+    length testApi `shouldBe` 4
 
-    let [getReq, postReq, putReq, deleteReq] = testApi
+  let [getReq, postReq, putReq, deleteReq] = testApi
 
-    it "collects all info for get request" $ do
+  it "collects all info for get request" $ do
-        shouldBe getReq $ defReq
+    shouldBe getReq $ defReq
-            { _reqUrl        = Url
+      { _reqUrl        = Url
-                [ Segment $ Static "test" ]
+          [ Segment $ Static "test" ]
-                [ QueryArg ("flag", "boolX") Flag ]
+          [ QueryArg (Arg "flag" "boolX") Flag ]
-            , _reqMethod     = "GET"
+      , _reqMethod     = "GET"
-            , _reqHeaders    = [HeaderArg ("header", "listX of stringX")]
+      , _reqHeaders    = [HeaderArg $ Arg "header" "listX of stringX"]
-            , _reqBody       = Nothing
+      , _reqBody       = Nothing
-            , _reqReturnType = "intX"
+      , _reqReturnType = Just "intX"
-            , _funcName      = ["get", "test"]
+      , _reqFuncName   = FunctionName ["get", "test"]
-            }
+      }
 
-    it "collects all info for post request" $ do
+  it "collects all info for post request" $ do
-        shouldBe postReq $ defReq
+    shouldBe postReq $ defReq
-            { _reqUrl        = Url
+      { _reqUrl        = Url
-                [ Segment $ Static "test" ]
+          [ Segment $ Static "test" ]
-                [ QueryArg ("param", "intX") Normal ]
+          [ QueryArg (Arg "param" "intX") Normal ]
-            , _reqMethod     = "POST"
+      , _reqMethod     = "POST"
-            , _reqHeaders    = []
+      , _reqHeaders    = []
-            , _reqBody       = Just "listX of stringX"
+      , _reqBody       = Just "listX of stringX"
-            , _reqReturnType = "voidX"
+      , _reqReturnType = Just "voidX"
-            , _funcName      = ["post", "test"]
+      , _reqFuncName   = FunctionName ["post", "test"]
-            }
+      }
 
-    it "collects all info for put request" $ do
+  it "collects all info for put request" $ do
-        shouldBe putReq $ defReq
+    shouldBe putReq $ defReq
-            { _reqUrl        = Url
+      { _reqUrl        = Url
-                [ Segment $ Static "test" ]
+          [ Segment $ Static "test" ]
-                -- Shoud this be |intX| or |listX of intX| ?
+          -- Shoud this be |intX| or |listX of intX| ?
-                [ QueryArg ("params", "listX of intX") List ]
+          [ QueryArg (Arg "params" "listX of intX") List ]
-            , _reqMethod     = "PUT"
+      , _reqMethod     = "PUT"
-            , _reqHeaders    = []
+      , _reqHeaders    = []
-            , _reqBody       = Just "stringX"
+      , _reqBody       = Just "stringX"
-            , _reqReturnType = "voidX"
+      , _reqReturnType = Just "voidX"
-            , _funcName      = ["put", "test"]
+      , _reqFuncName   = FunctionName ["put", "test"]
-            }
+      }
-
-    it "collects all info for delete request" $ do
-        shouldBe deleteReq $ defReq
-            { _reqUrl        = Url
-                [ Segment $ Static "test"
-                , Segment $ Cap ("id", "intX") ]
-                []
-            , _reqMethod     = "DELETE"
-            , _reqHeaders    = []
-            , _reqBody       = Nothing
-            , _reqReturnType = "voidX"
-            , _funcName      = ["delete", "test", "by", "id"]
-            }
 
+  it "collects all info for delete request" $ do
+    shouldBe deleteReq $ defReq
+      { _reqUrl        = Url
+          [ Segment $ Static "test"
+          , Segment $ Cap (Arg "id" "intX") ]
+          []
+      , _reqMethod     = "DELETE"
+      , _reqHeaders    = []
+      , _reqBody       = Nothing
+      , _reqReturnType = Just "voidX"
+      , _reqFuncName   = FunctionName ["delete", "test", "by", "id"]
+      }

servant-js/CHANGELOG.md

@@ -1,6 +1,8 @@
-HEAD
+0.5
 ----
 
+* Extract javascript-obvlious types and helpers to *servant-foreign*
+* Use `text` package instead of `String`
 * Provide new targets for code generation along with the old jQuery one: vanilla Javascript and Angular.js
 * Greatly simplify usage of this library by reducing down the API to just 2 functions: `jsForAPI` and `writeJSForAPI` + the choice of a code generator
 * Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators

servant-js/LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2014, Zalora South East Asia Pte Ltd
+Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors
 
 All rights reserved.
 

servant-js/include/overlapping-compat.h

@@ -0,0 +1,8 @@
+#if __GLASGOW_HASKELL__ >= 710
+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
+#define OVERLAPPING_  {-# OVERLAPPING #-}
+#else
+{-# LANGUAGE OverlappingInstances #-}
+#define OVERLAPPABLE_
+#define OVERLAPPING_
+#endif

servant-js/servant-js.cabal

@@ -1,5 +1,5 @@
 name:                servant-js
-version:             0.5
+version:             0.6
 synopsis:            Automatically derive javascript functions to query servant webservices.
 description:
   Automatically derive javascript functions to query servant webservices.
@@ -13,15 +13,16 @@ description:
   <https://github.com/haskell-servant/servant/blob/master/servant-js/CHANGELOG.md CHANGELOG>
 license:             BSD3
 license-file:        LICENSE
-author:              Alp Mestanogullari, Maksymilian Owsianny
+author:              Servant Contributors
-maintainer:          alpmestan@gmail.com
+maintainer:          haskell-servant-maintainers@googlegroups.com
-copyright:           2014 Alp Mestanogullari
+copyright:           2015-2016 Servant Contributors
 category:            Web
 build-type:          Simple
 cabal-version:       >=1.10
 homepage:            http://haskell-servant.github.io/
 Bug-reports:         http://github.com/haskell-servant/servant/issues
 extra-source-files:
+  include/*.h
   CHANGELOG.md
   README.md
 source-repository head
@@ -41,14 +42,16 @@ library
                        Servant.JS.JQuery
                        Servant.JS.Vanilla
   build-depends:       base            >= 4.5 && <5
+                     , base-compat     >= 0.9
                      , charset         >= 0.3
                      , lens            >= 4
-                     , servant-foreign == 0.5.*
+                     , servant-foreign == 0.6.*
                      , text            >= 1.2  && < 1.3
 
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall
+  include-dirs: include
 
 executable counter
   main-is: counter.hs
@@ -61,11 +64,11 @@ executable counter
     buildable: False
 
   build-depends:    base             >= 4.7 && < 5
-                  , aeson            >= 0.7  && < 0.11
+                  , aeson            >= 0.7  && < 0.12
                   , filepath         >= 1
                   , lens             >= 4
-                  , servant          == 0.5.*
+                  , servant          == 0.6.*
-                  , servant-server   == 0.5.*
+                  , servant-server   == 0.6.*
                   , servant-js
                   , stm
                   , transformers
@@ -81,6 +84,7 @@ test-suite spec
       Servant.JSSpec
       Servant.JSSpec.CustomHeaders
   build-depends:     base
+                   , base-compat
                    , hspec >= 2.1.8
                    , hspec-expectations
                    , language-ecmascript >= 0.16

servant-js/src/Servant/JS.hs

@@ -128,22 +128,22 @@ import           Servant.Foreign (GenerateList(..), listFromAPI, NoTypes)
 -- | Generate the data necessary to generate javascript code
 --   for all the endpoints of an API, as ':<|>'-separated values
 --   of type 'AjaxReq'.
-javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout
+javascript :: HasForeign NoTypes () layout => Proxy layout -> Foreign () layout
-javascript p = foreignFor (Proxy :: Proxy NoTypes) p defReq
+javascript p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p defReq
 
 -- | Directly generate all the javascript functions for your API
 --   from a 'Proxy' for your API type. You can then write it to
 --   a file or integrate it in a page, for example.
-jsForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
+jsForAPI :: (HasForeign NoTypes () api, GenerateList () (Foreign () api))
          => Proxy api -- ^ proxy for your API type
          -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
          -> Text                -- ^ a text that you can embed in your pages or write to a file
-jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) p)
+jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p)
 
 -- | Directly generate all the javascript functions for your API
 --   from a 'Proxy' for your API type using the given generator
 --   and write the resulting code to a file at the given path.
-writeJSForAPI :: (HasForeign NoTypes api, GenerateList (Foreign api))
+writeJSForAPI :: (HasForeign NoTypes () api, GenerateList () (Foreign () api))
               => Proxy api -- ^ proxy for your API type
               -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others)
               -> FilePath -- ^ path to the file you want to write the resulting javascript code into

servant-js/src/Servant/JS/Angular.hs

@@ -6,6 +6,7 @@ import           Data.Maybe (isJust)
 import           Data.Monoid
 import qualified Data.Text as T
 import           Data.Text (Text)
+import           Data.Text.Encoding (decodeUtf8)
 import           Servant.Foreign
 import           Servant.JS.Internal
 
@@ -68,16 +69,19 @@ generateAngularJSWith ngOptions opts req = "\n" <>
  <> "    { url: " <> url <> "\n"
  <> dataBody
  <> reqheaders
- <> "    , method: '" <> method <> "'\n"
+ <> "    , method: '" <> decodeUtf8 method <> "'\n"
  <> "    });\n"
  <> "}\n"
 
   where argsStr = T.intercalate ", " args
         args = http
             ++ captures
-            ++ map (view $ argName._1) queryparams
+            ++ map (view $ queryArgName . argPath) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
+            ++ map ( toValidFunctionName
+                   . (<>) "header"
+                   . view (headerArg . argPath)
+                   ) hs
 
         -- If we want to generate Top Level Function, they must depend on
         -- the $http service, if we generate a service, the functions will
@@ -86,9 +90,9 @@ generateAngularJSWith ngOptions opts req = "\n" <>
                   0 -> ["$http"]
                   _ -> []
 
-        captures = map (fst . captureArg)
+        captures = map (view argPath . captureArg)
                  . filter isCapture
-                 $ req ^. reqUrl.path
+                 $ req ^. reqUrl . path
 
         hs = req ^. reqHeaders
 
@@ -109,10 +113,11 @@ generateAngularJSWith ngOptions opts req = "\n" <>
             then ""
             else "    , headers: { " <> headersStr <> " }\n"
 
-          where headersStr = T.intercalate ", " $ map headerStr hs
+          where
-                headerStr header = "\"" <>
+            headersStr = T.intercalate ", " $ map headerStr hs
-                  fst (headerArg header) <>
+            headerStr header = "\"" <>
-                  "\": " <> toJSHeader header
+              header ^. headerArg . argPath <>
+              "\": " <> toJSHeader header
 
         namespace =
             if hasService
@@ -127,7 +132,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
 
         fsep = if hasService then ":" else " ="
 
-        fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)
 
         method = req ^. reqMethod
         url = if url' == "'" then "'/'" else url'

servant-js/src/Servant/JS/Axios.hs

@@ -5,6 +5,7 @@ import           Control.Lens
 import           Data.Maybe (isJust)
 import           Data.Monoid
 import           Data.Text (Text)
+import           Data.Text.Encoding (decodeUtf8)
 import qualified Data.Text as T
 import           Servant.Foreign
 import           Servant.JS.Internal
@@ -61,11 +62,14 @@ generateAxiosJSWith aopts opts req = "\n" <>
 
   where argsStr = T.intercalate ", " args
         args = captures
-            ++ map (view $ argName._1) queryparams
+            ++ map (view $ queryArgName . argPath) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
+            ++ map ( toValidFunctionName
+                   . (<>) "header"
+                   . view (headerArg . argPath)
+                   ) hs
 
-        captures = map (fst . captureArg)
+        captures = map (view argPath . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -103,10 +107,11 @@ generateAxiosJSWith aopts opts req = "\n" <>
             then ""
             else "    , headers: { " <> headersStr <> " }\n"
 
-          where headersStr = T.intercalate ", " $ map headerStr hs
+          where
-                headerStr header = "\"" <>
+            headersStr = T.intercalate ", " $ map headerStr hs
-                  fst (headerArg header) <>
+            headerStr header = "\"" <>
-                  "\": " <> toJSHeader header
+              header ^. headerArg . argPath <>
+              "\": " <> toJSHeader header
 
         namespace =
                if hasNoModule
@@ -115,9 +120,9 @@ generateAxiosJSWith aopts opts req = "\n" <>
                where
                   hasNoModule = moduleName opts == ""
 
-        fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)
 
-        method = T.toLower $ req ^. reqMethod
+        method = T.toLower . decodeUtf8 $ req ^. reqMethod
         url = if url' == "'" then "'/'" else url'
         url' = "'"
            <> urlPrefix opts

servant-js/src/Servant/JS/Internal.hs

@@ -1,4 +1,6 @@
-{-#LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
 module Servant.JS.Internal
   ( JavaScriptGenerator
   , CommonGeneratorOptions(..)
@@ -19,7 +21,20 @@ module Servant.JS.Internal
   , reqHeaders
   , HasForeign(..)
   , HasForeignType(..)
+  , GenerateList(..)
+  , NoTypes
+  , HeaderArg
+  , ArgType(..)
   , HeaderArg(..)
+  , QueryArg(..)
+  , Req(..)
+  , Segment(..)
+  , SegmentType(..)
+  , Url(..)
+  , Path
+  , Arg(..)
+  , FunctionName(..)
+  , PathSegment(..)
   , concatCase
   , snakeCase
   , camelCase
@@ -32,7 +47,7 @@ module Servant.JS.Internal
   , Header
   ) where
 
-import           Control.Lens                  ((^.), _1)
+import           Control.Lens hiding (List)
 import qualified Data.CharSet as Set
 import qualified Data.CharSet.Unicode.Category as Set
 import           Data.Monoid
@@ -40,23 +55,30 @@ import qualified Data.Text as T
 import           Data.Text (Text)
 import           Servant.Foreign
 
-type AjaxReq = Req
+type AjaxReq = Req ()
 
 -- A 'JavascriptGenerator' just takes the data found in the API type
 -- for each endpoint and generates Javascript code in a Text. Several
 -- generators are available in this package.
-type JavaScriptGenerator = [Req] -> Text
+type JavaScriptGenerator = [Req ()] -> Text
 
 -- | This structure is used by specific implementations to let you
 -- customize the output
 data CommonGeneratorOptions = CommonGeneratorOptions
   {
-    functionNameBuilder :: FunctionName -> Text  -- ^ function generating function names
+    functionNameBuilder :: FunctionName -> Text
-  , requestBody :: Text                -- ^ name used when a user want to send the request body (to let you redefine it)
+    -- ^ function generating function names
-  , successCallback :: Text            -- ^ name of the callback parameter when the request was successful
+  , requestBody :: Text
-  , errorCallback :: Text              -- ^ name of the callback parameter when the request reported an error
+    -- ^ name used when a user want to send the request body
-  , moduleName :: Text                 -- ^ namespace on which we define the foreign function (empty mean local var)
+    -- (to let you redefine it)
-  , urlPrefix :: Text                  -- ^ a prefix we should add to the Url in the codegen
+  , successCallback :: Text
+    -- ^ name of the callback parameter when the request was successful
+  , errorCallback :: Text
+    -- ^ name of the callback parameter when the request reported an error
+  , moduleName :: Text
+    -- ^ namespace on which we define the foreign function (empty mean local var)
+  , urlPrefix :: Text
+    -- ^ a prefix we should add to the Url in the codegen
   }
 
 -- | Default options.
@@ -115,8 +137,9 @@ toValidFunctionName t =
                     , Set.connectorPunctuation
                     ]
 
-toJSHeader :: HeaderArg -> Text
+toJSHeader :: HeaderArg f -> Text
-toJSHeader (HeaderArg n)          = toValidFunctionName ("header" <> fst n)
+toJSHeader (HeaderArg n)
+  = toValidFunctionName ("header" <> n ^. argName . _PathSegment)
 toJSHeader (ReplaceHeaderArg n p)
   | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
   | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
@@ -124,34 +147,35 @@ toJSHeader (ReplaceHeaderArg n p)
                              <> "\""
   | otherwise         = p
   where
-    pv = toValidFunctionName ("header" <> fst n)
+    pv = toValidFunctionName ("header" <> n ^. argName . _PathSegment)
-    pn = "{" <> fst n <> "}"
+    pn = "{" <> n ^. argName . _PathSegment <> "}"
     rp = T.replace pn "" p
 
-jsSegments :: [Segment] -> Text
+jsSegments :: [Segment f] -> Text
 jsSegments []  = ""
 jsSegments [x] = "/" <> segmentToStr x False
 jsSegments (x:xs) = "/" <> segmentToStr x True <> jsSegments xs
 
-segmentToStr :: Segment -> Bool -> Text
+segmentToStr :: Segment f -> Bool -> Text
 segmentToStr (Segment st) notTheEnd =
   segmentTypeToStr st <> if notTheEnd then "" else "'"
 
-segmentTypeToStr :: SegmentType -> Text
+segmentTypeToStr :: SegmentType f -> Text
-segmentTypeToStr (Static s) = s
+segmentTypeToStr (Static s) = s ^. _PathSegment
-segmentTypeToStr (Cap s)    = "' + encodeURIComponent(" <> fst s <> ") + '"
+segmentTypeToStr (Cap s)    =
+  "' + encodeURIComponent(" <> s ^. argName . _PathSegment <> ") + '"
 
-jsGParams :: Text -> [QueryArg] -> Text
+jsGParams :: Text -> [QueryArg f] -> Text
 jsGParams _ []     = ""
 jsGParams _ [x]    = paramToStr x False
 jsGParams s (x:xs) = paramToStr x True <> s <> jsGParams s xs
 
-jsParams :: [QueryArg] -> Text
+jsParams :: [QueryArg f] -> Text
 jsParams = jsGParams "&"
 
-paramToStr :: QueryArg -> Bool -> Text
+paramToStr :: QueryArg f -> Bool -> Text
 paramToStr qarg notTheEnd =
-  case qarg ^. argType of
+  case qarg ^. queryArgType of
     Normal -> name
            <> "=' + encodeURIComponent("
            <> name
@@ -161,4 +185,4 @@ paramToStr qarg notTheEnd =
            <> "[]=' + encodeURIComponent("
            <> name
            <> if notTheEnd then ") + '" else ")"
-  where name = qarg ^. argName . _1
+  where name = qarg ^. queryArgName . argName . _PathSegment

servant-js/src/Servant/JS/JQuery.hs

@@ -6,9 +6,11 @@ import           Data.Maybe (isJust)
 import           Data.Monoid
 import qualified Data.Text as T
 import           Data.Text (Text)
+import           Data.Text.Encoding (decodeUtf8)
 import           Servant.Foreign
 import           Servant.JS.Internal
 
+
 -- | Generate javascript functions that use the /jQuery/ library
 --   to make the AJAX calls. Uses 'defCommonGeneratorOptions'
 --   for the generator options.
@@ -35,18 +37,21 @@ generateJQueryJSWith opts req = "\n" <>
  <> dataBody
  <> reqheaders
  <> "    , error: " <> onError <> "\n"
- <> "    , type: '" <> method <> "'\n"
+ <> "    , type: '" <> decodeUtf8 method <> "'\n"
  <> "    });\n"
  <> "}\n"
 
   where argsStr = T.intercalate ", " args
         args = captures
-            ++ map (view $ argName._1) queryparams
+            ++ map (view $ queryArgName . argPath) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
+            ++ map (toValidFunctionName
+                   . (<>) "header"
+                   . view (headerArg . argPath)
+                   ) hs
             ++ [onSuccess, onError]
 
-        captures = map (fst . captureArg)
+        captures = map (view argPath . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -72,15 +77,16 @@ generateJQueryJSWith opts req = "\n" <>
             then ""
             else "    , headers: { " <> headersStr <> " }\n"
 
-          where headersStr = T.intercalate ", " $ map headerStr hs
+          where
-                headerStr header = "\"" <>
+            headersStr = T.intercalate ", " $ map headerStr hs
-                  fst (headerArg header) <>
+            headerStr header = "\"" <>
-                  "\": " <> toJSHeader header
+              header ^. headerArg . argPath <>
+              "\": " <> toJSHeader header
 
         namespace = if (moduleName opts) == ""
                        then "var "
                        else (moduleName opts) <> "."
-        fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)
 
         method = req ^. reqMethod
         url = if url' == "'" then "'/'" else url'

servant-js/src/Servant/JS/Vanilla.hs

@@ -4,6 +4,7 @@ module Servant.JS.Vanilla where
 import           Control.Lens
 import           Data.Maybe (isJust)
 import           Data.Text (Text)
+import           Data.Text.Encoding (decodeUtf8)
 import qualified Data.Text as T
 import           Data.Monoid
 import           Servant.Foreign
@@ -31,16 +32,19 @@ generateVanillaJSWith opts req = "\n" <>
     fname <> " = function(" <> argsStr <> ")\n"
  <> "{\n"
  <> "  var xhr = new XMLHttpRequest();\n"
- <> "  xhr.open('" <> method <> "', " <> url <> ", true);\n"
+ <> "  xhr.open('" <> decodeUtf8 method <> "', " <> url <> ", true);\n"
  <>    reqheaders
  <> "  xhr.setRequestHeader(\"Accept\",\"application/json\");\n"
  <> (if isJust (req ^. reqBody) then "  xhr.setRequestHeader(\"Content-Type\",\"application/json\");\n" else "")
  <> "  xhr.onreadystatechange = function (e) {\n"
  <> "    if (xhr.readyState == 4) {\n"
+ <> "      if (xhr.status == 204 || xhr.status == 205) {\n"
+ <> "        onSuccess();\n"
+ <> "      } else if (xhr.status >= 200 && xhr.status < 300) {\n"
  <> "        var value = JSON.parse(xhr.responseText);\n"
- <> "      if (xhr.status == 200 || xhr.status == 201) {\n"
  <> "        onSuccess(value);\n"
  <> "      } else {\n"
+ <> "        var value = JSON.parse(xhr.responseText);\n"
  <> "        onError(value);\n"
  <> "      }\n"
  <> "    }\n"
@@ -50,12 +54,15 @@ generateVanillaJSWith opts req = "\n" <>
 
   where argsStr = T.intercalate ", " args
         args = captures
-            ++ map (view $ argName._1) queryparams
+            ++ map (view $ queryArgName . argPath) queryparams
             ++ body
-            ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
+            ++ map ( toValidFunctionName
+                   . (<>) "header"
+                   . view (headerArg . argPath)
+                   ) hs
             ++ [onSuccess, onError]
 
-        captures = map (fst . captureArg)
+        captures = map (view argPath . captureArg)
                  . filter isCapture
                  $ req ^. reqUrl.path
 
@@ -81,15 +88,16 @@ generateVanillaJSWith opts req = "\n" <>
             then ""
             else headersStr <> "\n"
 
-          where headersStr = T.intercalate "\n" $ map headerStr hs
+          where
-                headerStr header = "  xhr.setRequestHeader(\"" <>
+            headersStr = T.intercalate "\n" $ map headerStr hs
-                  fst (headerArg header) <>
+            headerStr header = "  xhr.setRequestHeader(\"" <>
-                  "\", " <> toJSHeader header <> ");"
+              header ^. headerArg . argPath <>
+              "\", " <> toJSHeader header <> ");"
 
         namespace = if moduleName opts == ""
                        then "var "
                        else (moduleName opts) <> "."
-        fname = namespace <> (functionNameBuilder opts $ req ^. funcName)
+        fname = namespace <> (functionNameBuilder opts $ req ^. reqFuncName)
 
         method = req ^. reqMethod
         url = if url' == "'" then "'/'" else url'

servant-js/test/Servant/JSSpec.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE DataKinds           #-}
 {-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE QuasiQuotes         #-}
@@ -7,20 +6,21 @@
 {-# LANGUAGE TypeOperators       #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Servant.JSSpec where
 
 import           Data.Either                  (isRight)
-#if !MIN_VERSION_base(4,8,0)
+import           Data.Monoid                  ()
-import           Data.Monoid                  ((<>),mconcat)
+import           Data.Monoid.Compat           ((<>))
-#else
-import           Data.Monoid                  ((<>))
-#endif
 import           Data.Proxy
 import           Data.Text                    (Text)
 import qualified Data.Text                    as T
 import           Language.ECMAScript3.Parser  (program, parse)
+import           Prelude                      ()
+import           Prelude.Compat
 import           Test.Hspec  hiding (shouldContain, shouldNotContain)
 
+import           Servant.API.Internal.Test.ComprehensiveAPI
 import           Servant.JS
 import           Servant.JS.Internal
 import qualified Servant.JS.Angular           as NG
@@ -29,6 +29,13 @@ import qualified Servant.JS.JQuery            as JQ
 import qualified Servant.JS.Vanilla           as JS
 import           Servant.JSSpec.CustomHeaders
 
+-- * comprehensive api
+
+-- This declaration simply checks that all instances are in place.
+_ = jsForAPI comprehensiveAPI vanillaJS :: Text
+
+-- * specs
+
 type TestAPI = "simple" :> ReqBody '[JSON,FormUrlEncoded] Text :> Post '[JSON] Bool
           :<|> "has.extension" :> Get '[FormUrlEncoded,JSON] Bool
 
@@ -98,7 +105,7 @@ a `shouldNotContain` b  = shouldNotSatisfy a (T.isInfixOf b)
 
 axiosSpec :: Spec
 axiosSpec = describe specLabel $ do
-    let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
+    let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) (Proxy :: Proxy TestAPI)
     it "should add withCredentials when needed" $ do
         let jsText = genJS withCredOpts $ reqList
         output jsText
@@ -122,7 +129,7 @@ axiosSpec = describe specLabel $ do
 
 angularSpec :: TestNames -> Spec
 angularSpec test = describe specLabel $ do
-    let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI)
+    let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) (Proxy :: Proxy TestAPI)
     it "should implement a service globally" $ do
         let jsText = genJS reqList
         output jsText