From 416abdf96617345d3d7b4616b08dd14733e36911 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= Date: Mon, 22 Apr 2024 10:28:44 +0200 Subject: [PATCH] Remove extraneous source dir --- .../servant-quickcheck/.gitignore | 1 - .../servant-quickcheck/.travis.yml | 34 -- .../servant-quickcheck/LICENSE | 30 -- .../servant-quickcheck/Setup.hs | 2 - .../servant-quickcheck/doc/LICENSE | 30 -- .../servant-quickcheck/doc/Makefile | 216 ------------- .../servant-quickcheck/doc/ServersEqual.lhs | 166 ---------- .../servant-quickcheck/doc/Setup.hs | 2 - .../servant-quickcheck/doc/conf.py | 294 ------------------ .../servant-quickcheck/doc/doc.cabal | 17 - .../servant-quickcheck/doc/index.rst | 22 -- .../servant-quickcheck/doc/requirements.txt | 25 -- .../servant-quickcheck.cabal | 88 ------ .../src/Servant/QuickCheck.hs | 94 ------ .../src/Servant/QuickCheck/Internal.hs | 6 - .../QuickCheck/Internal/Benchmarking.hs | 87 ------ .../Servant/QuickCheck/Internal/Predicates.hs | 132 -------- .../Servant/QuickCheck/Internal/QuickCheck.hs | 159 ---------- .../Servant/QuickCheck/Internal/Testable.hs | 96 ------ .../servant-quickcheck/stack.yaml | 36 --- .../servant-quickcheck/test/Doctest.hs | 44 --- .../test/Servant/CoMock/InternalSpec.hs | 170 ---------- .../servant-quickcheck/test/Spec.hs | 1 - 23 files changed, 1752 deletions(-) delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/.gitignore delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/.travis.yml delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/LICENSE delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/Setup.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/LICENSE delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/Makefile delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/ServersEqual.lhs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/Setup.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/conf.py delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/doc.cabal delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/index.rst delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/requirements.txt delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck.cabal delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Benchmarking.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Predicates.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/QuickCheck.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Testable.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/stack.yaml delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Doctest.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Servant/CoMock/InternalSpec.hs delete mode 100644 servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Spec.hs diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/.gitignore b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/.gitignore deleted file mode 100644 index 9638ef2..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/.gitignore +++ /dev/null @@ -1 +0,0 @@ -doc/_build/ diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/.travis.yml b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/.travis.yml deleted file mode 100644 index 8a1cb24..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/.travis.yml +++ /dev/null @@ -1,34 +0,0 @@ -sudo: false - -language: c - -env: - - GHCVER=7.8.4 - - GHCVER=7.10.2 - -addons: - apt: - sources: - - hvr-ghc - packages: - - ghc-7.8.4 - - ghc-7.10.2 - - cabal-install-1.22 - - libgmp-dev - - wrk - -install: - - (mkdir -p $HOME/.local/bin && cd $HOME/.local/bin && wget https://zalora-public.s3.amazonaws.com/tinc && chmod +x tinc) - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/1.22/bin:$PATH - - ghc --version - - cabal --version - - travis_retry cabal update - - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - -script: - - tinc && cabal configure --enable-tests && cabal build && cabal test - - (cd doc && tinc cabal configure --enable-tests && cabal build && cabal test) - -cache: - directories: - - $HOME/.tinc/cache diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/LICENSE b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/LICENSE deleted file mode 100644 index c4a51a2..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) 2016, Julian K. Arni - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Julian K. Arni nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/Setup.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/LICENSE b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/LICENSE deleted file mode 100644 index c4a51a2..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c) 2016, Julian K. Arni - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Julian K. Arni nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/Makefile b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/Makefile deleted file mode 100644 index 95957c1..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/Makefile +++ /dev/null @@ -1,216 +0,0 @@ -# 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 ' where 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." diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/ServersEqual.lhs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/ServersEqual.lhs deleted file mode 100644 index b90e300..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/ServersEqual.lhs +++ /dev/null @@ -1,166 +0,0 @@ -# Testing that servers behave identically - -## Rewriting an application - -If you are rewriting, or significantly refactoring, an application, you often -want to ensure that the behaviour of the rewritten application is the same as -that of the old one. Sometimes what the behaviour of the old application is is -not always clear, making the process a difficult and error-prone one. - -**servant-quickcheck** can help. It provides a `serversEqual` function that, -given a **servant** API type and two URLs, generates arbitrary requests of the -right type and checks that, for the same request *history*, the two servers -respond identically. - -To see how this works, let's re-implement the [Django -Todo-Backend](https://github.com/mihirk/todo-backend-django) application -in **servant**. (`serversEqual` works for non-**servant** applications, though -it's somewhat nicer to use when one of them is written with **servant**.) You -don't need to know anything about Django or Python to follow along; indeed, -part of the fun of it is using `serversEqual` to guide you through -re-implementing code you may not entirely understand. - -Looking at the code, we can see the routes in `urls.py`: - -``` python -urlpatterns = patterns('', - url(r'^$', RedirectView.as_view(url='/todos')), - url(r'^todos$', views.TodoList.as_view()), - url(r'^todo/(?P[0-9]+)$', views.Todo.as_view()), -) -``` - -And the handlers in `views.py`: - -``` python -class TodoList(APIView): - def get(self, request, format=None): - todo_items = TodoItem.objects.all() - serializer = TodoItemSerializer(todo_items, many=True) - return JSONResponse(serializer.data, status=status.HTTP_200_OK) - - def post(self, request, format=None): - serializer = TodoItemSerializer(data=request.DATA) - if serializer.is_valid(): - saved_item = serializer.save() - saved_item.url = request.build_absolute_uri('/todo/' + str(saved_item.id)) - saved_item.save() - serializer = TodoItemSerializer(instance=saved_item) - return JSONResponse(serializer.data, status=status.HTTP_201_CREATED) - return JSONResponse(serializer.errors, status=status.HTTP_400_BAD_REQUEST) - - def delete(self, request, format=None): - TodoItem.objects.all().delete() - return JSONResponse(None, status=status.HTTP_204_NO_CONTENT) - -class Todo(APIView): - def get(self, request, pk, format=None): - try: - todoItem = TodoItem.objects.get(pk=pk) - serializer = TodoItemSerializer(todoItem) - except TodoItem.DoesNotExist: - return JSONResponse(None, status=status.HTTP_400_BAD_REQUEST) - return JSONResponse(serializer.data, status=status.HTTP_200_OK) - - def delete(self, request, pk, format=None): - try: - todoItem = TodoItem.objects.get(pk=pk) - todoItem.delete() - except TodoItem.DoesNotExist: - return JSONResponse(None, status=status.HTTP_400_BAD_REQUEST) - return JSONResponse(None, status=status.HTTP_204_NO_CONTENT) - - def patch(self, request, pk, format=None): - try: - todoItem = TodoItem.objects.get(pk=pk) - except TodoItem.DoesNotExist: - return JSONResponse(None, status=status.HTTP_400_BAD_REQUEST) - serializer = TodoItemSerializer(data=request.DATA, instance=todoItem, partial=True) - if serializer.is_valid(): - serializer.save() - return JSONResponse(serializer.data, status=status.HTTP_200_OK) - return JSONResponse(serializer.errors, status=status.HTTP_400_BAD_REQUEST) -``` - -And from `models.py`: - -``` python - -class TodoItem(models.Model): - title = models.CharField(max_length=256, null=True, blank=True) - completed = models.NullBooleanField(null=True, blank=True, default=False) - url = models.CharField(max_length=256, null=True, blank=True) - order = models.IntegerField(null=True, blank=True) - -``` - -So as a first pass, let's try: - -``` haskell -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} - -import Servant -import Servant.QuickCheck -import STMContainers.Map as M -import GHC.Conc (atomically) -import Test.QuickCheck - -data Todo = Todo - { title :: String - , completed :: Bool - , url :: String - , order :: Int - } deriving (Eq, Show, Read) - -type API = TodosAPI :<|> TodoAPI - -type TodosAPI - = "todos" :> - ( Get '[JSON] [Todo] - :<|> ReqBody '[JSON] Todo :> Post '[JSON] () - :<|> Delete '[JSON] ()) - -type TodoAPI - = "todo" :> Capture "id " Int :> - ( Get '[JSON] Todo - :<|> ReqBody '[JSON] Todo :> Patch '[JSON] () - :<|> Delete '[JSON} ()) - -serverTodos :: Server TodosAPI -serverTodos tvar = getTodos tvar - :<|> postTodos tvar - :<|> deleteAllTodos tvar - -serverTodo :: Server TodoAPI -serverTodo id' = getTodo tvar id' - :<|> patchTodo tvar id' - :<|> deleteTodo tvar id' - -getTodos :: Map Int Todo -> Handler [Todo] -getTodos m = liftIO . atomically . toList $ S.stream m - -postTodos :: Map Int Todo -> Todo -> Handler () -postTodos m t = liftIO . atomically $ S.insert m t - -deleteTodos :: Map Int Todo -> Todo -> Handler () -deleteTodos m t = liftIO . atomically $ S.insert m t -``` - -(We're keeping the `Todo`s in memory for simplicity - if this were a production - application, we'd likely want to use a database.) - -Notice that we split up the API into two sub-APIs. Partly this makes things -cleaner and more readable, but there's also a more concrete benefit: we can -start testing that **parts** of the API have been correctly rewritten without -implementing the entire server. - -In order to check how we're doing, we need to add an `Arbitrary` instance for -`Todo`: - -``` haskell -instance Arbitrary Todo where - arbitrary = Todo <$> arbitrary <$> arbitrary <$> arbitrary <$> arbitrary -``` - - diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/Setup.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/Setup.hs deleted file mode 100644 index 9a994af..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/conf.py b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/conf.py deleted file mode 100644 index 8c2882c..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/conf.py +++ /dev/null @@ -1,294 +0,0 @@ -# -*- 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-quickcheck' -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 -# " v 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 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-quickcheck.tex', u'servant-quickcheck 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-quickcheck', u'servant-quickcheck 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-quickcheck', u'servant-quickcheck Documentation', - author, 'servant-quickcheck', '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, -} diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/doc.cabal b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/doc.cabal deleted file mode 100644 index 39b2433..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/doc.cabal +++ /dev/null @@ -1,17 +0,0 @@ -name: doc -version: 0.1.0.0 -license: BSD3 -license-file: LICENSE -author: Julian K. Arni -maintainer: jkarni@gmail.com -build-type: Simple -cabal-version: >=1.10 - -library - exposed-modules: ServersEqual - other-extensions: DataKinds, TypeOperators - build-depends: base >=4.8 && <4.9 - , servant-server == 0.7.* - - ghc-options: -Wall -Werror -pgmL markdown-unlit - default-language: Haskell2010 diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/index.rst b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/index.rst deleted file mode 100644 index 5f3635c..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/index.rst +++ /dev/null @@ -1,22 +0,0 @@ -servant-quickcheck – QuickCheck entire APIs -============================================ - -**servant-quickcheck** provides ways of observing and testing the behaviour of -webservers under arbitrary, but sensible, requests. ('Sensible' here means -requests which have the correct type for their arguments (captures, query -params, headers, and request bodies).) - -**servant-quickcheck** can currently: - - - Test whether two servers behave identically when provided the same inputs - in the same order; - - Test whether certain properties hold true of an entire API (e.g. that an - API never throws a 500 error); - - Stress test arbitrary endpoints in an API. - -.. toctree:: - :maxdepth: 1 - - ServersEqual.lhs - ServerSatisfies.lhs - ServerBenchmark.lhs diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/requirements.txt b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/requirements.txt deleted file mode 100644 index 0c9c95a..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/doc/requirements.txt +++ /dev/null @@ -1,25 +0,0 @@ -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 diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck.cabal b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck.cabal deleted file mode 100644 index 6cf775d..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck.cabal +++ /dev/null @@ -1,88 +0,0 @@ -name: servant-quickcheck -version: 0.1.0.0 -synopsis: QuickCheck entire APIs -description: - This packages provides QuickCheck properties that are tested across an entire - API. - -license: BSD3 -license-file: LICENSE -author: Julian K. Arni -maintainer: jkarni@gmail.com -category: Web -build-type: Simple -cabal-version: >=1.10 - -flag long-tests - description: Run more QuickCheck tests - default: False - -library - exposed-modules: Servant.QuickCheck - , Servant.QuickCheck.Internal - , Servant.QuickCheck.Internal.Benchmarking - , Servant.QuickCheck.Internal.Predicates - , Servant.QuickCheck.Internal.Testable - , Servant.QuickCheck.Internal.QuickCheck - build-depends: base >=4.8 && <4.9 - , QuickCheck == 2.8.* - , bytestring == 0.10.* - , aeson > 0.10 && < 0.12 - , mtl == 2.2.* - , http-client == 0.4.* - , http-types == 0.9.* - , servant-client == 0.7.* - , servant-server == 0.7.* - , servant == 0.7.* - , warp >= 3.2.4 && < 3.3 - , process == 1.2.* - , temporary == 1.2.* - , hspec - hs-source-dirs: src - default-extensions: TypeOperators - , FlexibleInstances - , FlexibleContexts - , DataKinds - , GADTs - , MultiParamTypeClasses - , DeriveFunctor - , RankNTypes - , ConstraintKinds - , DeriveGeneric - default-language: Haskell2010 - -test-suite spec - type: exitcode-stdio-1.0 - ghc-options: -Wall -O2 -threaded - default-language: Haskell2010 - hs-source-dirs: test - main-is: Spec.hs - other-modules: Servant.QuickCheck.InternalSpec - build-depends: base == 4.* - , servant-quickcheck - , hspec - , http-client - , warp - , servant-server - , servant-client - , transformers - , QuickCheck - default-extensions: TypeOperators - , FlexibleInstances - , FlexibleContexts - , DataKinds - if flag(long-tests) - cpp-options: -DLONG_TESTS - --- test-suite doctests --- default-language: Haskell2010 --- type: exitcode-stdio-1.0 --- ghc-options: -threaded --- main-is: Doctest.hs --- hs-source-dirs: test --- build-depends: base >4 && <5 --- , doctest --- , filemanip --- , directory --- , filepath --- HS-Source-Dirs: test diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck.hs deleted file mode 100644 index c9a3d49..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck.hs +++ /dev/null @@ -1,94 +0,0 @@ --- | @Servant.QuickCheck@ provides utilities related to using QuickCheck over an API. --- Rather than specifying properties that individual handlers must satisfy, --- you can state properties that ought to hold true of the entire API. --- --- While the API must be described with @servant@ types, the server being --- tested itself need not be implemented with @servant-server@ (or indeed, --- written in Haskell). --- --- /N.B./ The examples given here assume the following setup: --- --- > import Servant --- > import Servant.QuickCheck --- > import Test.Hspec --- > --- > type API = ReqBody '[JSON] Int :> Post '[JSON] String --- > --- > api :: Proxy API --- > api = Proxy -module Servant.QuickCheck - ( - - -- * Server properties - -- | Functions to verify that a server meets certain properties. - -- - -- Example: - -- - -- > server :: Server API - -- > server = return . show - -- > - -- > - -- > test :: Spec - -- > test = describe "my server" $ do - -- > - -- > it "never throws a 500 on valid input" $ do - -- > withServantServer api server $ \url -> - -- > serverSatisfiers api url emptyPredicates never500s 100 - serverSatisfies - - -- * Server equality - -- | Functions to verify that two servers behave identically. - -- - -- This can be useful when for example rewriting or refactoring an - -- application. - -- - -- Example: - -- - -- > server :: Server API - -- > server = return . show - -- > - -- > server2 :: Server API - -- > server2 = const $ return "hi" - -- > - -- > test :: Spec - -- > test = describe "my new server" $ do - -- > - -- > it "behaves like the old one" $ do - -- > withServantServer api server $ \url1 -> - -- > withServantServer api server2 $ \url2 -> - -- > serversEqual api url1 url2 100 - -- - , serversEqual - - -- * Server benchmarking - -- | Functions that randomly generate and run benchmarking scripts - , serverBenchmark - , BenchOptions(..) - , defaultBenchOptions - - - -- * Test setup helpers - -- | Helpers to setup and teardown @servant@ servers during tests. - , withServantServer - - -- * Predicates - -- | Predicates (functions with signatures @a -> Bool@) are used to filter - -- out QuickCheck-generated values (so as to specify that requests must - -- possess certain properties) and to check that the response specifies the - -- expected properties. - , Predicates - , emptyPredicates - , addPredicate - , addPolyPredicate - - -- ** Predicate convenience functions - , addRightPredicate - , addLeftPredicate - - -- ** Useful predicates - , never500s - , onlyJsonObjects - - ) where - -import Servant.QuickCheck.Internal diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal.hs deleted file mode 100644 index 7178e62..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Servant.QuickCheck.Internal (module X) where - -import Servant.QuickCheck.Internal.Testable as X -import Servant.QuickCheck.Internal.Predicates as X -import Servant.QuickCheck.Internal.QuickCheck as X -import Servant.QuickCheck.Internal.Benchmarking as X diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Benchmarking.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Benchmarking.hs deleted file mode 100644 index 0c8abc3..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Benchmarking.hs +++ /dev/null @@ -1,87 +0,0 @@ --- | This module contains benchmark-related logic. --- --- Currently it generates 'wrk' scripts rather than benchmarking directly with --- the @servant-client@ functions since the performance of 'wrk' is --- significantly better. -module Servant.QuickCheck.Internal.Benchmarking where - -import Data.ByteString (ByteString) -import Data.ByteString.Lazy (toStrict) -import Network.HTTP.Client -import Network.HTTP.Types -import Servant.Client - -data BenchOptions = BenchOptions - { duration :: Int - , threads :: Int - , connections :: Int - , noOfTests :: Int - } deriving (Eq, Show, Read) - -defaultBenchOptions :: BenchOptions -defaultBenchOptions = BenchOptions - { duration = 10 - , threads = 1 - , connections = 10 - , noOfTests = 10 - } - -data WrkScript = WrkScript - { wrkScheme :: Scheme - , wrkHost :: ByteString - , wrkPort :: Int - , wrkMethod :: Method - , wrkPath :: ByteString - , wrkHeaders :: [Header] - , wrkBody :: ByteString - } deriving (Eq, Show) - -mkScript :: WrkScript -> String -mkScript w - = "wrk.scheme = \"" ++ sscheme (wrkScheme w) ++ "\"" - ++ "\nwrk.host = " ++ show (wrkHost w) - ++ "\nwrk.port = " ++ show (wrkPort w) - ++ "\nwrk.method = " ++ show (wrkMethod w) - ++ "\nwrk.path = " ++ show (wrkPath w) - ++ foldr (\(h,v) old -> old ++ "\nwrk.headers[" ++ show h ++ "] = " ++ show v) - "" - (wrkHeaders w) - ++ "\nwrk.body = " ++ show (wrkBody w) - ++ "\n" ++ reportFmt - where - sscheme Http = "http" - sscheme Https = "https" - -reqToWrk :: Request -> WrkScript -reqToWrk r = WrkScript - { wrkScheme = Http - , wrkHost = host r - , wrkPort = port r - , wrkMethod = method r - , wrkPath = path r - , wrkHeaders = requestHeaders r - , wrkBody = case requestBody r of - RequestBodyLBS r' -> toStrict r' - _ -> error "expecting RequestBodyLBS" - } - -reportFmt :: String -reportFmt - = "done = function(summary, latency, requests)\n" - ++ " for _, p in pairs({ 50, 75, 99, 99.999 }) do\n" - ++ " n = latency:percentile(p)\n" - ++ " io.write(string.format(\"%g%%, %d\\n\", p, n))\n" - ++ " end\n" - ++ "end\n" - -{-data BenchResult = BenchResult-} - {-{ benchReq :: Request-} - {-, benchLatencyDist :: [(Percentile, Microsecs)]-} - {-, benchLatencyAvg :: Microsecs-} - {-} deriving (Eq, Show, Read, Generic)-} - -{-newtype Microsecs = Microsecs { unMicroSecs :: Int }-} - {-deriving (Eq, Show, Read, Generic)-} - -{-newtype Percentile = Percentile { unPercentile :: Int }-} - {-deriving (Eq, Show, Read, Generic)-} diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Predicates.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Predicates.hs deleted file mode 100644 index f50aedc..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Predicates.hs +++ /dev/null @@ -1,132 +0,0 @@ --- | This module contains all logic related to constructing or using --- @Predicates@. -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Servant.QuickCheck.Internal.Predicates where - -import Data.Aeson (ToJSON (toJSON), Value (..)) -import Data.Proxy (Proxy (..)) -import Data.Void -import Network.HTTP.Types (statusCode) -import Servant.Common.Req (ServantError (..)) -import Test.QuickCheck - - --- | An HList containing predicates (functions of type @a -> Bool@). This --- datatype is used to represent both filters (what values to discard when --- generating arguments to test an API) and tests results (what to consider a --- failing response). --- --- For both filters and test results, only the *first* predicate of the --- appropriate type is used. --- --- Use 'emptyPredicates', 'addPredicate', 'addLeftPredicate' and --- 'addRightPredicate' to construct a @Predicates@. -data Predicates a where - HNil :: Predicates '[] - HCons :: (a -> Bool) -> Predicates b -> Predicates (a ': b) - HConsC :: Constraint a -> Predicates b -> Predicates (Constraint a ': b) - -class HasPredicate a b where - getPredicate :: Predicates a -> b -> Bool - -instance {-# OVERLAPPING #-} HasPredicate '[] a where - getPredicate _ = const True - --- TODO: Find some better way of distinguishing how the predicate is being used -instance {-# OVERLAPPING #-} HasPredicate '[] (Either ServantError a) where - getPredicate _ = discard - -instance {-# OVERLAPPING #-} HasPredicate (a ': xs) a where - getPredicate (HCons a _) = a - getPredicate (HConsC _ _) = error "not impossible, but non-sensical" - -data Constraint ctx = Constraint - { getConstraint :: forall a . (ctx a) => a -> Bool } - --- This is a little bit of a hack. Ideally instances would match when the --- predicate is polymorphic, but that doesn't work since the polymorphic type --- may have to unify with multiple distict values. --- --- It may however be possible to define a MPTC from monomorphic to polymorphic --- datatypes to avoid this issue. -instance {-# OVERLAPPING #-} - HasPredicate (Either ServantError Void ': xs) (Either ServantError a) where - getPredicate (HCons f _) x = case x of - Left e -> f (Left e) - Right _ -> True - -instance {-# OVERLAPPING #-} (ctx a) - => HasPredicate (Constraint ctx ': xs) (Either ServantError a) where - getPredicate (HConsC f _) x = case x of - Left _ -> discard -- Not clear whether checking for FailureResponse is better - Right v -> getConstraint f v - getPredicate (HCons _ _) _ = error "not impossible, but non-sensical" - -instance {-# OVERLAPPABLE #-} (ls ~ (b ': xs), HasPredicate xs a) - => HasPredicate ls a where - getPredicate (HCons _ xs) = getPredicate xs - getPredicate _ = error "impossible" - --- | Add a predicate to a list of predicates. Note that the predicate may not --- be polymorphic. -addPredicate :: (a -> Bool) -> Predicates b -> Predicates (a ': b) -addPredicate = HCons - --- | Add a predicate with a class constraint. --- --- Note that every possible argument must be an instance of that class for this --- to typecheck. In other words, if the @Predicates@ is being used for return --- types, every return type in the API must be an instance of the class. If --- it's being used for filtering, every capture, header, body, etc. type must --- be an instance of that class. --- --- This can be used to for example test that returned JSON has certain --- properties, or (via generics) that if any datatype contains a (possibly --- nested) field of a particular type, it always meets certain properties. -addPolyPredicate :: proxy ctx -> (forall a. ctx a => a -> Bool) -> Predicates b - -> Predicates (Constraint ctx ': b) -addPolyPredicate _ p = HConsC (Constraint p) - --- | Given a predicate over an @p :: a -> Bool@, add a predicate to the @Predicates@ --- list that succeeds on an @val :: Either ServantError a@ if @val@ is a --- @Left@, or a @Right v@ such that @p a == True@. -addRightPredicate :: (a -> Bool) -> Predicates b -> Predicates (Either ServantError a ': b) -addRightPredicate p = addPredicate $ either (const True) p - --- | The @Left@ analog of 'addRightPredicate'. -addLeftPredicate :: (ServantError -> Bool) -> Predicates b - -> Predicates (Either ServantError Void ': b) -addLeftPredicate p = addPredicate $ either p (error "impossible") - --- | An empty list of predicates. This doesn't discard any values when used as --- a filter, and doesn't fail any value when used as a condition to satisfy. -emptyPredicates :: Predicates '[] -emptyPredicates = HNil - --- * Useful predicates - --- | A @Predicates@ list that fails a test if the response is an HTTP 500 error. -never500s :: Predicates '[Either ServantError Void] -never500s = addLeftPredicate go emptyPredicates - where - go (FailureResponse x _ _) = statusCode x /= 500 - go _ = True - --- | A @Predicates@ list that fails a test if the response is anything but a --- top-level object (e.g., if it is an array or literal). --- --- Returning anything other than object is considered bad practice, as --- --- (1) it is hard to modify the returned value while maintaining backwards --- compatibility; --- (2) many older tools do not support top-level arrays; --- (3) whether top-level numbers, booleans, or strings are valid JSON depends --- on what RFC you're going by; --- (4) there are security issues with top-level arrays. -onlyJsonObjects :: Predicates '[Constraint ToJSON] -onlyJsonObjects = addPolyPredicate (Proxy :: Proxy ToJSON) go emptyPredicates - where - go x = case toJSON x of - Object _ -> True - _ -> False diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/QuickCheck.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/QuickCheck.hs deleted file mode 100644 index 68d28c4..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/QuickCheck.hs +++ /dev/null @@ -1,159 +0,0 @@ --- | This module contains wrappers around lower-level functionality. -module Servant.QuickCheck.Internal.QuickCheck where - -import Control.Concurrent (threadDelay) -import Control.Concurrent.MVar (modifyMVar_, readMVar) -import Control.Monad (replicateM_) -import Data.Proxy (Proxy) -import Data.Void (Void) -import Network.HTTP.Client (Manager, defaultManagerSettings, - newManager) -import Network.HTTP.Client (managerModifyRequest, getUri) -import Network.Wai.Handler.Warp (withApplication) -import Servant (HasServer, Server, serve) -import Servant.Client (BaseUrl (..), Client, HasClient, - Scheme (..), ServantError, client) -import System.IO (hPutStrLn, hFlush) -import System.IO.Temp (withSystemTempFile) -import System.Mem (performGC) -import System.Process (callCommand) -import Test.Hspec (Expectation, expectationFailure) -import Test.QuickCheck (Args (..), Property, Result (..), - Testable, property, - quickCheckWithResult, stdArgs) - -import Servant.QuickCheck.Internal.Testable -import Servant.QuickCheck.Internal.Predicates -import Servant.QuickCheck.Internal.Benchmarking - - --- | Start a servant application on an open port, run the provided function, --- then stop the application. -withServantServer :: HasServer a '[] => Proxy a -> IO (Server a) - -> (BaseUrl -> IO r) -> IO r -withServantServer api server t - = withApplication (return . serve api =<< server) $ \port -> - t (BaseUrl Http "localhost" port "") - --- | A QuickCheck 'Property' that randomly generates arguments (captures, query --- params, request bodies, headers, etc.) expected by endpoints of a server, --- and makes requests to the servers running in the two provided URLs in the --- same order, failing if they do not return the same response. --- --- Evidently, if the behaviour of the server is expected to be --- non-deterministic, this function may produce spurious failures. --- --- Note that this QuickCheck 'Property' does IO; interleaving it with other IO --- actions will not work. It is provided so that it can be used with QuickCheck --- functions such as 'quickCheckWith'. For most use cases, you should use --- @serversEqual@ or @servantServersEqual@. -serversEqualProperty :: (HasClient a, Testable (ShouldMatch (Client a))) - => Proxy a -> Manager -> BaseUrl -> BaseUrl -> Property -serversEqualProperty api mgr burl1 burl2 = property $ ShouldMatch c1 c2 - where c1 = client api burl1 mgr - c2 = client api burl2 mgr - --- | Check that the two servers running under the provided @BaseUrl@s behave --- identically by randomly generating arguments (captures, query params, request bodies, --- headers, etc.) expected by the server. If, given the same request, the --- response is not the same (according to the definition of @==@ for the return --- datatype), the 'Expectation' fails, printing the counterexample. --- --- The @Int@ argument specifies maximum number of test cases to generate and --- run. --- --- Evidently, if the behaviour of the server is expected to be --- non-deterministic, this function may produce spurious failures. -serversEqual :: (HasClient a, Testable (ShouldMatch (Client a))) - => Proxy a -> BaseUrl -> BaseUrl -> Int -> Expectation -serversEqual api burl1 burl2 tries = do - mgr <- managerWithStoredReq - let args = stdArgs { chatty = False, maxSuccess = tries } - res <- quickCheckWithResult args $ serversEqualProperty api mgr burl1 burl2 - case res of - Success _ _ _ -> return () - _ -> prettyErr >>= expectationFailure - - -serverSatisfiesProperty :: (HasClient a, Testable (ShouldSatisfy filt exp (Client a))) - => Proxy a -> Manager -> BaseUrl -> Predicates filt -> Predicates exp -> Property -serverSatisfiesProperty api mgr burl filters expect = do - property $ ShouldSatisfy (client api burl mgr) filters expect - --- | Check that a server's responses satisfies certain properties. -serverSatisfies :: (HasClient a, Testable (ShouldSatisfy filt exp (Client a))) - => Proxy a -> BaseUrl -> Predicates filt -> Predicates exp - -> Int -> Expectation -serverSatisfies api burl filters expect tries = do - mgr <- managerWithStoredReq - let args = stdArgs { chatty = False, maxSuccess = tries } - res <- quickCheckWithResult args $ serverSatisfiesProperty api mgr burl filters expect - case res of - Success _ _ _ -> return () - GaveUp n _ _ -> expectationFailure $ "Gave up after " ++ show n ++ " tests" - _ -> prettyErr >>= expectationFailure - --- | Check that the two servers running under the provided @BaseUrl@s do not --- behave identically. --- --- As with @serversEqualProperty@, non-determinism in the servers will likely --- result in failures that may not be significant. -serversUnequal :: (HasClient a, Testable (ShouldMatch (Client a))) - => Proxy a -> BaseUrl -> BaseUrl -> Int -> Expectation -serversUnequal api burl1 burl2 tries = do - mgr <- managerWithStoredReq - let args = stdArgs { chatty = False, maxSuccess = tries } - res <- quickCheckWithResult args $ serversEqualProperty api mgr burl1 burl2 - case res of - Success _ _ _ -> prettyErr >>= expectationFailure - _ -> return () - -serverDoesntSatisfy :: (HasClient a, Testable (ShouldSatisfy filt exp (Client a))) - => Proxy a -> BaseUrl -> Predicates filt -> Predicates exp - -> Int -> Expectation -serverDoesntSatisfy api burl filters expect tries = do - mgr <- managerWithStoredReq - let args = stdArgs { chatty = False, maxSuccess = tries } - res <- quickCheckWithResult args $ serverSatisfiesProperty api mgr burl filters expect - case res of - Success _ _ _ -> prettyErr >>= expectationFailure - _ -> return () - --- | Benchmarks a server with arbitrary requests using 'wrk'. --- --- When using this, you should compile your program with '-threaded'. --- Moreover, 'wrk' must be in the @$PATH@. --- --- Note that this function is still very experimental, and it's behaviour will --- likely change. -serverBenchmark :: - (HasClient a , Testable (ShouldSatisfy '[] '[Either ServantError Void] (Client a))) - => Proxy a -> BaseUrl -> BenchOptions -> IO () -serverBenchmark api burl opts = replicateM_ (noOfTests opts) go - where - go = do - let alwaysTrue = addLeftPredicate (const True) emptyPredicates - serverSatisfies api burl emptyPredicates alwaysTrue 1 - Just (r, _) <- readMVar currentReq - withSystemTempFile "wrkscript.lua" $ \f h -> do - let url = show $ getUri r - s = mkScript $ reqToWrk r - c = "wrk -c" ++ show (connections opts) - ++ " -d" ++ show (duration opts) ++ "s " - ++ " -t" ++ show (threads opts) - ++ " -s \"" ++ f ++ "\" " - ++ " --latency " - ++ url - hPutStrLn h s - hFlush h - callCommand c - -- While running wrk and the server on the same machine make the - -- results much less meaningful, this ameliorates the situation - -- somewhat. - performGC - threadDelay 1000 - -managerWithStoredReq :: IO Manager -managerWithStoredReq = newManager defaultManagerSettings { managerModifyRequest = go } - where go req = modifyMVar_ currentReq (addReq req) >> return req - addReq req _ = return $ Just (req, "") diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Testable.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Testable.hs deleted file mode 100644 index ee0aad1..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/src/Servant/QuickCheck/Internal/Testable.hs +++ /dev/null @@ -1,96 +0,0 @@ --- | This module contains QuickCheck-related logic. -module Servant.QuickCheck.Internal.Testable where - -import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar) -import Control.Monad.Except (runExceptT) -import GHC.Generics (Generic) -import Network.HTTP.Client (Request, RequestBody (..), - requestBody) -import Servant.API ((:<|>)(..)) -import Servant.Client (ServantError (..), ClientM) -import System.IO.Unsafe (unsafePerformIO) -import Test.QuickCheck (Arbitrary (..), discard) -import Test.QuickCheck.Property (Testable (..), forAllShrink, - ioProperty, (.&.)) - -import Servant.QuickCheck.Internal.Predicates - - --- * ShouldMatch - --- | Two corresponding client functions. Used for checking that APIs match. -data ShouldMatch a = ShouldMatch a a - deriving (Eq, Show, Read, Generic) - -instance (Show a, Eq a) => Testable (ShouldMatch (ClientM a)) where - property (ShouldMatch e1 e2) = ioProperty $ do - e1' <- runExceptT e1 - e2' <- runExceptT e2 - modifyMVar_ currentReq $ \x -> case x of - Nothing -> error "impossible" - Just (x', _) -> return $ Just (x', "LHS:\n" ++ show e1' - ++ "\nRHS:\n" ++ show e2') - case (e1', e2') of - (Right v1, Right v2) -> return $ v1 == v2 - (Left (FailureResponse a1 b1 c1), Left (FailureResponse a2 b2 c2)) -> - return $ a1 == a2 && b1 == b2 && c1 == c2 - (err1, err2) -> error $ "Exception response:" - ++ "\nLHS:\n" ++ show err1 - ++ "\nRHS:\n" ++ show err2 - -instance (Arbitrary a, Show a, Testable (ShouldMatch b)) - => Testable (ShouldMatch (a -> b)) where - property (ShouldMatch f1 f2) = forAllShrink arbitrary shrink go - where go x = ShouldMatch (f1 x) (f2 x) - -instance (Testable (ShouldMatch a), Testable (ShouldMatch b)) - => Testable (ShouldMatch (a :<|> b)) where - property (ShouldMatch (a1 :<|> b1) (a2 :<|> b2)) - = property (ShouldMatch a1 a2) .&. property (ShouldMatch b1 b2) - --- * ShouldSatisfy - -data ShouldSatisfy filter expect a = ShouldSatisfy - { ssVal :: a - , ssFilter :: Predicates filter - , ssExpect :: Predicates expect - } deriving (Functor) - -instance (Show a, Eq a, HasPredicate expect (Either ServantError a)) - => Testable (ShouldSatisfy filter expect (ClientM a)) where - property (ShouldSatisfy a _ e) = ioProperty $ do - a' <- runExceptT a - modifyMVar_ currentReq $ \x -> case x of - Nothing -> error "impossible" - Just (x', _) -> return $ Just (x', show a') - return $ getPredicate e a' - -instance ( Arbitrary a, Show a, Testable (ShouldSatisfy filter expect b) - , HasPredicate filter a) - => Testable (ShouldSatisfy filter expect (a -> b)) where - property (ShouldSatisfy g f e) = forAllShrink arbitrary shrink go - where go x | getPredicate f x = ShouldSatisfy (g x) f e - | otherwise = discard - -instance ( Testable (ShouldSatisfy filter expect a) - , Testable (ShouldSatisfy filter expect b)) - => Testable (ShouldSatisfy filter expect (a :<|> b)) where - property (ShouldSatisfy (a :<|> b) f e) - = property (ShouldSatisfy a f e) .&. property (ShouldSatisfy b f e) - --- * Utils - --- Used to store the current request and response so that in case of failure we --- have the failing test in a user-friendly form. -currentReq :: MVar (Maybe (Request, String)) -currentReq = unsafePerformIO $ newMVar Nothing -{-# NOINLINE currentReq #-} - -prettyErr :: IO String -prettyErr = do - Just (req, resp) <- readMVar currentReq - return $ show req ++ "Body:\n" ++ showReqBody (requestBody req) - ++ "\n\nResponse:\n" ++ resp - where - showReqBody (RequestBodyLBS x) = show x - showReqBody _ = error "expecting RequestBodyLBS" diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/stack.yaml b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/stack.yaml deleted file mode 100644 index c9ce168..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/stack.yaml +++ /dev/null @@ -1,36 +0,0 @@ -# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: nightly-2016-04-20 - -# Local packages, usually specified by relative directory name -packages: -- '.' -- 'doc' -# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) -extra-deps: -- servant-0.7 -- servant-client-0.7 -- servant-server-0.7 - -# Override default flag values for local packages and extra-deps -flags: {} - -# Extra package databases containing global packages -extra-package-dbs: [] - -# Control whether we use the GHC we find on the path -# system-ghc: true - -# Require a specific version of stack, using version ranges -# require-stack-version: -any # Default -# require-stack-version: >= 1.0.0 - -# Override the architecture used by stack, especially useful on Windows -# arch: i386 -# arch: x86_64 - -# Extra directories used by stack for building -# extra-include-dirs: [/path/to/dir] -# extra-lib-dirs: [/path/to/dir] - -# Allow a newer minor version of GHC than the snapshot specifies -# compiler-check: newer-minor diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Doctest.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Doctest.hs deleted file mode 100644 index b6f23e5..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Doctest.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Main where - -import Data.List (isPrefixOf) -import System.Directory -import System.FilePath -import System.FilePath.Find -import Test.DocTest - -main :: IO () -main = do - files <- find always (extension ==? ".hs") "src" - mCabalMacrosFile <- getCabalMacrosFile - doctest $ "-isrc" : "-Iinclude" : - (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++ - "-XOverloadedStrings" : - "-XDeriveFunctor" : - "-XFlexibleInstances" : - "-XFlexibleContexts" : - "-XMultiParamTypeClasses" : - "-XDataKinds" : - "-XTypeOperators" : - "-XGADTs" : - files - -getCabalMacrosFile :: IO (Maybe FilePath) -getCabalMacrosFile = do - exists <- doesDirectoryExist "dist" - if exists - then do - contents <- getDirectoryContents "dist" - let rest = "build" "autogen" "cabal_macros.h" - whenExists $ case filter ("dist-sandbox-" `isPrefixOf`) contents of - [x] -> "dist" x rest - [] -> "dist" rest - xs -> error $ "ran doctests with multiple dist/dist-sandbox-xxxxx's: \n" - ++ show xs ++ "\nTry cabal clean" - else return Nothing - where - whenExists :: FilePath -> IO (Maybe FilePath) - whenExists file = do - exists <- doesFileExist file - return $ if exists - then Just file - else Nothing diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Servant/CoMock/InternalSpec.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Servant/CoMock/InternalSpec.hs deleted file mode 100644 index 34b09d4..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Servant/CoMock/InternalSpec.hs +++ /dev/null @@ -1,170 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Servant.CoMock.InternalSpec (spec) where - -import Control.Concurrent.MVar (newMVar, readMVar, swapMVar) -import Control.Monad.IO.Class (liftIO) -import Data.Proxy -import Servant -import Test.Hspec - -import Servant.CoMock.Internal - -spec :: Spec -spec = do - serversEqualSpec - serverSatisfiesSpec - serverBenchmarkSpec - - -serversEqualSpec :: Spec -serversEqualSpec = describe "serversEqual" $ do - - context "servers without function types" $ do - - it "considers equal servers equal" $ do - withServantServer onlyReturnAPI onlyReturnAPIServer $ \burl -> - serversEqual onlyReturnAPI burl burl noOfTestCases - - it "considers unequal servers unequal" $ do - withServantServer onlyReturnAPI onlyReturnAPIServer $ \burl1 -> - withServantServer onlyReturnAPI onlyReturnAPIServer' $ \burl2 -> - serversUnequal onlyReturnAPI burl1 burl2 noOfTestCases - - - context "servers with function types" $ do - - it "considers equal servers equal" $ do - withServantServer functionAPI functionAPIServer $ \burl -> - serversEqual functionAPI burl burl noOfTestCases - - it "considers unequal servers unequal" $ do - withServantServer functionAPI functionAPIServer $ \burl1 -> - withServantServer functionAPI functionAPIServer' $ \burl2 -> - serversUnequal functionAPI burl1 burl2 noOfTestCases - - - context "stateful servers" $ do - - it "considers equal servers equal" $ do - withServantServer statefulAPI statefulAPIServer $ \burl1 -> - withServantServer statefulAPI statefulAPIServer $ \burl2 -> - serversEqual statefulAPI burl1 burl2 noOfTestCases - - -serverSatisfiesSpec :: Spec -serverSatisfiesSpec = describe "serverSatisfies" $ do - - it "passes true predicates" $ do - let e = addRightPredicate (== (5 :: Int)) emptyPredicates - withServantServer onlyReturnAPI onlyReturnAPIServer $ \burl -> - serverSatisfies onlyReturnAPI burl emptyPredicates e noOfTestCases - - it "fails false predicates" $ do - let e = addRightPredicate (== (4 :: Int)) emptyPredicates - withServantServer onlyReturnAPI onlyReturnAPIServer $ \burl -> - serverDoesntSatisfy onlyReturnAPI burl emptyPredicates e noOfTestCases - - it "allows filtering" $ do - let f = addPredicate (\(x :: String) -> length x > 2) emptyPredicates - e = addRightPredicate (\(x :: Int) -> x > 2) emptyPredicates - e' = addRightPredicate (\(x :: Int) -> x < 2) emptyPredicates - withServantServer functionAPI functionAPIServer $ \burl -> do - serverSatisfies functionAPI burl f e noOfTestCases - serverDoesntSatisfy functionAPI burl f e' noOfTestCases - - it "allows polymorphic predicates" $ do - let p1 x = length (show x) < 100000 - p2 x = length (show x) < 1 - e1 = addPolyPredicate (Proxy :: Proxy Show) p1 emptyPredicates - e2 = addPolyPredicate (Proxy :: Proxy Show) p2 emptyPredicates - withServantServer onlyReturnAPI onlyReturnAPIServer $ \burl -> do - serverSatisfies onlyReturnAPI burl emptyPredicates e1 noOfTestCases - serverDoesntSatisfy onlyReturnAPI burl emptyPredicates e2 noOfTestCases - - - context "never500s" $ do - - it "is true for servers that don't return 500s" $ do - withServantServer functionAPI functionAPIServer $ \burl -> - serverSatisfies functionAPI burl emptyPredicates never500s noOfTestCases - - it "is false for servers that return 500s" $ do - withServantServer onlyReturnAPI onlyReturnAPIServer'' $ \burl -> - serverDoesntSatisfy onlyReturnAPI burl emptyPredicates never500s noOfTestCases - - context "onlyJsonObjects" $ do - - it "is false for servers that return top-level literals" $ do - withServantServer onlyReturnAPI onlyReturnAPIServer $ \burl -> - serverDoesntSatisfy onlyReturnAPI burl emptyPredicates onlyJsonObjects noOfTestCases - - -serverBenchmarkSpec :: Spec -serverBenchmarkSpec = describe "serverBenchmark" $ do - - it "works" $ do - withServantServer onlyReturnAPI onlyReturnAPIServer $ \burl -> - serverBenchmark onlyReturnAPI burl defaultBenchOptions - ------------------------------------------------------------------------------- --- APIs ------------------------------------------------------------------------------- - --- * OnlyReturn - -type OnlyReturnAPI = Get '[JSON] Int - :<|> Post '[JSON] String - -onlyReturnAPI :: Proxy OnlyReturnAPI -onlyReturnAPI = Proxy - -onlyReturnAPIServer :: IO (Server OnlyReturnAPI) -onlyReturnAPIServer = return $ return 5 :<|> return "hi" - -onlyReturnAPIServer' :: IO (Server OnlyReturnAPI) -onlyReturnAPIServer' = return $ return 5 :<|> return "hia" - -onlyReturnAPIServer'' :: IO (Server OnlyReturnAPI) -onlyReturnAPIServer'' = return $ error "err" :<|> return "hia" - --- * Function - -type FunctionAPI = ReqBody '[JSON] String :> Post '[JSON] Int - :<|> Header "X-abool" Bool :> Get '[JSON] (Maybe Bool) - -functionAPI :: Proxy FunctionAPI -functionAPI = Proxy - -functionAPIServer :: IO (Server FunctionAPI) -functionAPIServer = return $ return . length :<|> return - -functionAPIServer' :: IO (Server FunctionAPI) -functionAPIServer' - = return $ (\x -> return $ length x - 1) :<|> \x -> return (not <$> x) - --- * Stateful - -type StatefulAPI = ReqBody '[JSON] String :> Post '[JSON] String - :<|> Get '[JSON] Int - -statefulAPI :: Proxy StatefulAPI -statefulAPI = Proxy - -statefulAPIServer :: IO (Server StatefulAPI) -statefulAPIServer = do - mvar <- newMVar "" - return $ (\x -> liftIO $ swapMVar mvar x) - :<|> (liftIO $ readMVar mvar >>= return . length) - - ------------------------------------------------------------------------------- --- Utils ------------------------------------------------------------------------------- - -noOfTestCases :: Int -#if LONG_TESTS -noOfTestCases = 20000 -#else -noOfTestCases = 500 -#endif diff --git a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Spec.hs b/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Spec.hs deleted file mode 100644 index a824f8c..0000000 --- a/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/servant-quickcheck/test/Spec.hs +++ /dev/null @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover #-}