Cleanup pre-GHC-8.0 stuff

This commit is contained in:
Oleg Grenrus 2018-07-11 01:39:38 +03:00
parent 720bb40645
commit cfade67c2f
31 changed files with 46 additions and 219 deletions

View file

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

View file

@ -15,7 +15,6 @@ copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2017 Servant
category: Web category: Web
build-type: Simple build-type: Simple
extra-source-files: extra-source-files:
include/*.h
CHANGELOG.md CHANGELOG.md
README.md README.md
tested-with: tested-with:
@ -53,10 +52,6 @@ library
, text >= 1.2.3.0 && < 1.3 , text >= 1.2.3.0 && < 1.3
, transformers >= 0.3.0.0 && < 0.6 , transformers >= 0.3.0.0 && < 0.6
if !impl(ghc >= 8.0)
build-depends:
semigroups >=0.18.4 && <0.19
-- Servant dependencies -- Servant dependencies
build-depends: build-depends:
servant >= 0.14.1 && <0.15 servant >= 0.14.1 && <0.15
@ -78,7 +73,6 @@ library
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall
include-dirs: include
test-suite spec test-suite spec
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -8,8 +7,6 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
#include "overlapping-compat.h"
module Servant.Client.Core.Internal.Generic where module Servant.Client.Core.Internal.Generic where
import Generics.SOP import Generics.SOP
@ -142,7 +139,7 @@ instance (GClientList b acc, GClientList a (ClientList b acc))
=> GClientList (a :<|> b) acc where => GClientList (a :<|> b) acc where
gClientList (a :<|> b) acc = gClientList a (gClientList b acc) gClientList (a :<|> b) acc = gClientList a (gClientList b acc)
instance OVERLAPPABLE_ (ClientList client acc ~ (client ': acc)) instance {-# OVERLAPPABLE #-} (ClientList client acc ~ (client ': acc))
=> GClientList client acc where => GClientList client acc where
gClientList c acc = I c :* acc gClientList c acc = I c :* acc

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
@ -12,7 +11,6 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
#include "overlapping-compat.h"
module Servant.Client.Core.Internal.HasClient where module Servant.Client.Core.Internal.HasClient where
import Prelude () import Prelude ()
@ -209,7 +207,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
hoistClientMonad pm _ f cl = \as -> hoistClientMonad pm _ f cl = \as ->
hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as) hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
-- Note [Non-Empty Content Types] -- Note [Non-Empty Content Types]
( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts) ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
) => HasClient m (Verb method status cts' a) where ) => HasClient m (Verb method status cts' a) where
@ -226,7 +224,7 @@ instance OVERLAPPABLE_
hoistClientMonad _ _ f ma = f ma hoistClientMonad _ _ f ma = f ma
instance OVERLAPPING_ instance {-# OVERLAPPING #-}
( RunClient m, ReflectMethod method ( RunClient m, ReflectMethod method
) => HasClient m (Verb method status cts NoContent) where ) => HasClient m (Verb method status cts NoContent) where
type Client m (Verb method status cts NoContent) type Client m (Verb method status cts NoContent)
@ -238,7 +236,7 @@ instance OVERLAPPING_
hoistClientMonad _ _ f ma = f ma hoistClientMonad _ _ f ma = f ma
instance OVERLAPPING_ instance {-# OVERLAPPING #-}
-- Note [Non-Empty Content Types] -- Note [Non-Empty Content Types]
( RunClient m, MimeUnrender ct a, BuildHeadersTo ls ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
, ReflectMethod method, cts' ~ (ct ': cts) , ReflectMethod method, cts' ~ (ct ': cts)
@ -261,7 +259,7 @@ instance OVERLAPPING_
hoistClientMonad _ _ f ma = f ma hoistClientMonad _ _ f ma = f ma
instance OVERLAPPING_ instance {-# OVERLAPPING #-}
( RunClient m, BuildHeadersTo ls, ReflectMethod method ( RunClient m, BuildHeadersTo ls, ReflectMethod method
) => HasClient m (Verb method status cts (Headers ls NoContent)) where ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
type Client m (Verb method status cts (Headers ls NoContent)) type Client m (Verb method status cts (Headers ls NoContent))
@ -275,7 +273,7 @@ instance OVERLAPPING_
hoistClientMonad _ _ f ma = f ma hoistClientMonad _ _ f ma = f ma
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
( RunClient m, MonadIO m, MimeUnrender ct a, ReflectMethod method, ( RunClient m, MonadIO m, MimeUnrender ct a, ReflectMethod method,
FramingUnrender framing a, FromResultStream a b FramingUnrender framing a, FromResultStream a b
) => HasClient m (Stream method status framing ct b) where ) => HasClient m (Stream method status framing ct b) where

View file

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

View file

@ -23,7 +23,6 @@ tested-with:
homepage: http://haskell-servant.readthedocs.org/ homepage: http://haskell-servant.readthedocs.org/
Bug-reports: http://github.com/haskell-servant/servant/issues Bug-reports: http://github.com/haskell-servant/servant/issues
extra-source-files: extra-source-files:
include/*.h
CHANGELOG.md CHANGELOG.md
README.md README.md
source-repository head source-repository head
@ -48,9 +47,6 @@ library
, time >= 1.4.2 && < 1.9 , time >= 1.4.2 && < 1.9
, transformers >= 0.3.0.0 && < 0.6 , transformers >= 0.3.0.0 && < 0.6
if !impl(ghc >= 8.0)
build-depends: semigroups >=0.18.4 && <0.19
-- Servant dependencies -- Servant dependencies
build-depends: build-depends:
servant-client-core == 0.14.* servant-client-core == 0.14.*
@ -71,10 +67,7 @@ library
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall -Wno-redundant-constraints
if impl(ghc >= 8.0)
ghc-options: -Wno-redundant-constraints
include-dirs: include
test-suite spec test-suite spec
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@ -104,10 +97,6 @@ test-suite spec
, wai , wai
, warp , warp
if !impl(ghc >= 8.0)
build-depends:
semigroups
-- Additonal dependencies -- Additonal dependencies
build-depends: build-depends:
generics-sop >= 0.3.2.0 && < 0.4 generics-sop >= 0.3.2.0 && < 0.4

View file

@ -15,15 +15,10 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -freduction-depth=100 #-} {-# OPTIONS_GHC -freduction-depth=100 #-}
#else
{-# OPTIONS_GHC -fcontext-stack=100 #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
#include "overlapping-compat.h"
module Servant.ClientSpec (spec, Person(..), startWaiApp, endWaiApp) where module Servant.ClientSpec (spec, Person(..), startWaiApp, endWaiApp) where
import Prelude () import Prelude ()

View file

@ -15,15 +15,10 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -freduction-depth=100 #-} {-# OPTIONS_GHC -freduction-depth=100 #-}
#else
{-# OPTIONS_GHC -fcontext-stack=100 #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
#include "overlapping-compat.h"
module Servant.StreamSpec (spec) where module Servant.StreamSpec (spec) where
import Control.Monad import Control.Monad

View file

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

View file

@ -23,7 +23,6 @@ tested-with:
homepage: http://haskell-servant.readthedocs.org/ homepage: http://haskell-servant.readthedocs.org/
Bug-reports: http://github.com/haskell-servant/servant/issues Bug-reports: http://github.com/haskell-servant/servant/issues
extra-source-files: extra-source-files:
include/*.h
CHANGELOG.md CHANGELOG.md
README.md README.md
source-repository head source-repository head
@ -45,10 +44,6 @@ library
, bytestring >= 0.10.4.0 && < 0.11 , bytestring >= 0.10.4.0 && < 0.11
, text >= 1.2.3.0 && < 1.3 , text >= 1.2.3.0 && < 1.3
if !impl(ghc >= 8.0)
build-depends:
semigroups >=0.18.3 && <0.19
-- Servant dependencies -- Servant dependencies
build-depends: build-depends:
servant == 0.13.* || ==0.14.* servant == 0.13.* || ==0.14.*
@ -70,10 +65,7 @@ library
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall -Wno-redundant-constraints
if impl(ghc >= 8.0)
ghc-options: -Wno-redundant-constraints
include-dirs: include
executable greet-docs executable greet-docs
main-is: greet.hs main-is: greet.hs

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DefaultSignatures #-}
@ -17,7 +16,6 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
#include "overlapping-compat.h"
module Servant.Docs.Internal where module Servant.Docs.Internal where
import Prelude () import Prelude ()
@ -788,7 +786,7 @@ markdownWith RenderingOptions{..} api = unlines $
-- | The generated docs for @a ':<|>' b@ just appends the docs -- | The generated docs for @a ':<|>' b@ just appends the docs
-- for @a@ with the docs for @b@. -- for @a@ with the docs for @b@.
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
(HasDocs a, HasDocs b) (HasDocs a, HasDocs b)
=> HasDocs (a :<|> b) where => HasDocs (a :<|> b) where
@ -836,7 +834,7 @@ instance (KnownSymbol sym, ToCapture (CaptureAll sym a), HasDocs sublayout)
symP = Proxy :: Proxy sym symP = Proxy :: Proxy sym
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
(ToSample a, AllMimeRender (ct ': cts) a, KnownNat status (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
, ReflectMethod method) , ReflectMethod method)
=> HasDocs (Verb method status (ct ': cts) a) where => HasDocs (Verb method status (ct ': cts) a) where
@ -855,7 +853,7 @@ instance OVERLAPPABLE_
-- | TODO: mention the endpoint is streaming, its framing strategy -- | TODO: mention the endpoint is streaming, its framing strategy
-- --
-- Also there are no samples. -- Also there are no samples.
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
(MimeRender ct a, KnownNat status (MimeRender ct a, KnownNat status
, ReflectMethod method) , ReflectMethod method)
=> HasDocs (Stream method status framing ct a) where => HasDocs (Stream method status framing ct a) where
@ -870,7 +868,7 @@ instance OVERLAPPABLE_
status = fromInteger $ natVal (Proxy :: Proxy status) status = fromInteger $ natVal (Proxy :: Proxy status)
p = Proxy :: Proxy a p = Proxy :: Proxy a
instance OVERLAPPING_ instance {-# OVERLAPPING #-}
(ToSample a, AllMimeRender (ct ': cts) a, KnownNat status (ToSample a, AllMimeRender (ct ': cts) a, KnownNat status
, ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls)) , ReflectMethod method, AllHeaderSamples ls, GetHeaders (HList ls))
=> HasDocs (Verb method status (ct ': cts) (Headers ls a)) where => HasDocs (Verb method status (ct ': cts) (Headers ls a)) where

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -8,11 +7,7 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -freduction-depth=100 #-} {-# OPTIONS_GHC -freduction-depth=100 #-}
#else
{-# OPTIONS_GHC -fcontext-stack=100 #-}
#endif
module Servant.DocsSpec where module Servant.DocsSpec where

View file

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

View file

@ -19,7 +19,6 @@ category: Servant, Web
build-type: Simple build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
extra-source-files: extra-source-files:
include/*.h
CHANGELOG.md CHANGELOG.md
README.md README.md
bug-reports: http://github.com/haskell-servant/servant/issues bug-reports: http://github.com/haskell-servant/servant/issues
@ -45,10 +44,6 @@ library
base >= 4.7 && <4.12 base >= 4.7 && <4.12
, text >= 1.2.3.0 && < 1.3 , text >= 1.2.3.0 && < 1.3
if !impl(ghc >= 8.0)
build-depends:
semigroups >=0.18.3 && <0.19
-- Servant dependencies -- Servant dependencies
build-depends: build-depends:
servant == 0.13.* || ==0.14.* servant == 0.13.* || ==0.14.*
@ -62,16 +57,12 @@ library
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall -Wno-redundant-constraints
if impl(ghc >= 8.0)
ghc-options: -Wno-redundant-constraints
include-dirs: include
test-suite spec test-suite spec
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
hs-source-dirs: test hs-source-dirs: test
ghc-options: -Wall ghc-options: -Wall
include-dirs: include
main-is: Spec.hs main-is: Spec.hs
other-modules: Servant.ForeignSpec other-modules: Servant.ForeignSpec

View file

@ -12,9 +12,6 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE NullaryTypeClasses #-}
#endif
-- | Generalizes all the data needed to make code generation work with -- | Generalizes all the data needed to make code generation work with
-- arbitrary programming languages. -- arbitrary programming languages.

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -9,10 +8,6 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ < 709
{-# OPTIONS_GHC -fcontext-stack=41 #-}
#endif
#include "overlapping-compat.h"
module Servant.ForeignSpec where module Servant.ForeignSpec where
@ -59,10 +54,10 @@ instance HasForeignType LangX String Int where
instance HasForeignType LangX String Bool where instance HasForeignType LangX String Bool where
typeFor _ _ _ = "boolX" typeFor _ _ _ = "boolX"
instance OVERLAPPING_ HasForeignType LangX String String where instance {-# OVERLAPPING #-} HasForeignType LangX String String where
typeFor _ _ _ = "stringX" typeFor _ _ _ = "stringX"
instance OVERLAPPABLE_ HasForeignType LangX String a => HasForeignType LangX String [a] where instance {-# OVERLAPPABLE #-} HasForeignType LangX String a => HasForeignType LangX String [a] where
typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a) typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a)
instance (HasForeignType LangX String a) => HasForeignType LangX String (Maybe a) where instance (HasForeignType LangX String a) => HasForeignType LangX String (Maybe a) where

View file

@ -1,4 +1,3 @@
\begin{code}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wall #-}
module Main (main) where module Main (main) where
@ -16,6 +15,11 @@ main = defaultMainWithDoctests "doctests"
#else #else
#ifdef MIN_VERSION_Cabal #ifdef MIN_VERSION_Cabal
-- If the macro is defined, we have new cabal-install,
-- but for some reason we don't have cabal-doctest in package-db
--
-- Probably we are running cabal sdist, when otherwise using new-build
-- workflow
#warning You are configuring this package without cabal-doctest installed. \ #warning You are configuring this package without cabal-doctest installed. \
The doctests test-suite will not work as a result. \ The doctests test-suite will not work as a result. \
To fix this, install cabal-doctest before configuring. To fix this, install cabal-doctest before configuring.
@ -27,5 +31,3 @@ main :: IO ()
main = defaultMain main = defaultMain
#endif #endif
\end{code}

View file

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

View file

@ -26,7 +26,6 @@ tested-with:
GHC==8.2.2 GHC==8.2.2
GHC==8.4.3 GHC==8.4.3
extra-source-files: extra-source-files:
include/*.h
CHANGELOG.md CHANGELOG.md
README.md README.md
@ -103,10 +102,7 @@ library
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall ghc-options: -Wall -Wno-redundant-constraints
if impl(ghc >= 8.0)
ghc-options: -Wno-redundant-constraints
include-dirs: include
executable greet executable greet
main-is: greet.hs main-is: greet.hs
@ -187,4 +183,3 @@ test-suite doctests
ghc-options: -Wall -threaded ghc-options: -Wall -threaded
if impl(ghc >= 8.2) if impl(ghc >= 8.2)
x-doctest-options: -fdiagnostics-color=never x-doctest-options: -fdiagnostics-color=never
include-dirs: include

View file

@ -18,8 +18,6 @@
#define HAS_TYPE_ERROR #define HAS_TYPE_ERROR
#endif #endif
#include "overlapping-compat.h"
module Servant.Server.Internal module Servant.Server.Internal
( module Servant.Server.Internal ( module Servant.Server.Internal
, module Servant.Server.Internal.BasicAuth , module Servant.Server.Internal.BasicAuth
@ -256,7 +254,7 @@ methodRouter splitHeaders method proxy status action = leafRouter route'
let bdy = if allowedMethodHead method request then "" else body let bdy = if allowedMethodHead method request then "" else body
in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
( AllCTRender ctypes a, ReflectMethod method, KnownNat status ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
) => HasServer (Verb method status ctypes a) context where ) => HasServer (Verb method status ctypes a) context where
@ -267,7 +265,7 @@ instance OVERLAPPABLE_
where method = reflectMethod (Proxy :: Proxy method) where method = reflectMethod (Proxy :: Proxy method)
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
instance OVERLAPPING_ instance {-# OVERLAPPING #-}
( AllCTRender ctypes a, ReflectMethod method, KnownNat status ( AllCTRender ctypes a, ReflectMethod method, KnownNat status
, GetHeaders (Headers h a) , GetHeaders (Headers h a)
) => HasServer (Verb method status ctypes (Headers h a)) context where ) => HasServer (Verb method status ctypes (Headers h a)) context where
@ -280,7 +278,7 @@ instance OVERLAPPING_
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
( MimeRender ctype a, ReflectMethod method, KnownNat status, ( MimeRender ctype a, ReflectMethod method, KnownNat status,
FramingRender framing ctype, ToStreamGenerator b a FramingRender framing ctype, ToStreamGenerator b a
) => HasServer (Stream method status framing ctype b) context where ) => HasServer (Stream method status framing ctype b) context where
@ -292,7 +290,7 @@ instance OVERLAPPABLE_
where method = reflectMethod (Proxy :: Proxy method) where method = reflectMethod (Proxy :: Proxy method)
status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)
instance OVERLAPPING_ instance {-# OVERLAPPING #-}
( MimeRender ctype a, ReflectMethod method, KnownNat status, ( MimeRender ctype a, ReflectMethod method, KnownNat status,
FramingRender framing ctype, ToStreamGenerator b a, FramingRender framing ctype, ToStreamGenerator b a,
GetHeaders (Headers h b) GetHeaders (Headers h b)

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
@ -8,8 +7,6 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
#include "overlapping-compat.h"
module Servant.Server.Internal.Context where module Servant.Server.Internal.Context where
import Data.Proxy import Data.Proxy
@ -64,11 +61,11 @@ instance (Eq a, Eq (Context as)) => Eq (Context (a ': as)) where
class HasContextEntry (context :: [*]) (val :: *) where class HasContextEntry (context :: [*]) (val :: *) where
getContextEntry :: Context context -> val getContextEntry :: Context context -> val
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
HasContextEntry xs val => HasContextEntry (notIt ': xs) val where HasContextEntry xs val => HasContextEntry (notIt ': xs) val where
getContextEntry (_ :. xs) = getContextEntry xs getContextEntry (_ :. xs) = getContextEntry xs
instance OVERLAPPING_ instance {-# OVERLAPPING #-}
HasContextEntry (val ': xs) val where HasContextEntry (val ': xs) val where
getContextEntry (x :. _) = x getContextEntry (x :. _) = x

View file

@ -24,10 +24,6 @@ import Servant.Server
(ServerT, Tagged (..)) (ServerT, Tagged (..))
import System.FilePath import System.FilePath
(addTrailingPathSeparator) (addTrailingPathSeparator)
#if !MIN_VERSION_wai_app_static(3,1,0)
import Filesystem.Path.CurrentOS
(decodeString)
#endif
import WaiAppStatic.Storage.Filesystem import WaiAppStatic.Storage.Filesystem
(ETagLookup) (ETagLookup)
@ -84,9 +80,4 @@ serveDirectory = serveDirectoryFileServer
{-# DEPRECATED serveDirectory "Use serveDirectoryFileServer instead" #-} {-# DEPRECATED serveDirectory "Use serveDirectoryFileServer instead" #-}
fixPath :: FilePath -> FilePath fixPath :: FilePath -> FilePath
fixPath = fixPath = addTrailingPathSeparator
#if MIN_VERSION_wai_app_static(3,1,0)
addTrailingPathSeparator
#else
decodeString . addTrailingPathSeparator
#endif

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -9,11 +8,7 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -freduction-depth=100 #-} {-# OPTIONS_GHC -freduction-depth=100 #-}
#else
{-# OPTIONS_GHC -fcontext-stack=100 #-}
#endif
module Servant.ServerSpec where module Servant.ServerSpec where

View file

@ -1,4 +1,3 @@
\begin{code}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wall #-}
module Main (main) where module Main (main) where
@ -16,6 +15,11 @@ main = defaultMainWithDoctests "doctests"
#else #else
#ifdef MIN_VERSION_Cabal #ifdef MIN_VERSION_Cabal
-- If the macro is defined, we have new cabal-install,
-- but for some reason we don't have cabal-doctest in package-db
--
-- Probably we are running cabal sdist, when otherwise using new-build
-- workflow
#warning You are configuring this package without cabal-doctest installed. \ #warning You are configuring this package without cabal-doctest installed. \
The doctests test-suite will not work as a result. \ The doctests test-suite will not work as a result. \
To fix this, install cabal-doctest before configuring. To fix this, install cabal-doctest before configuring.
@ -27,5 +31,3 @@ main :: IO ()
main = defaultMain main = defaultMain
#endif #endif
\end{code}

View file

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

View file

@ -22,7 +22,6 @@ tested-with:
GHC==8.2.2 GHC==8.2.2
GHC==8.4.3 GHC==8.4.3
extra-source-files: extra-source-files:
include/*.h
CHANGELOG.md CHANGELOG.md
source-repository head source-repository head
type: git type: git
@ -120,10 +119,7 @@ library
, TypeOperators , TypeOperators
, TypeSynonymInstances , TypeSynonymInstances
, UndecidableInstances , UndecidableInstances
ghc-options: -Wall ghc-options: -Wall -Wno-redundant-constraints
if impl(ghc >= 8.0)
ghc-options: -Wno-redundant-constraints
include-dirs: include
test-suite spec test-suite spec
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@ -146,10 +142,6 @@ test-suite spec
, string-conversions , string-conversions
, text , text
if !impl(ghc >= 8.0)
build-depends:
semigroups
-- Additonal dependencies -- Additonal dependencies
build-depends: build-depends:
aeson-compat >= 0.3.8 && < 0.4 aeson-compat >= 0.3.8 && < 0.4
@ -177,6 +169,5 @@ test-suite doctests
ghc-options: -Wall -threaded ghc-options: -Wall -threaded
if impl(ghc >= 8.2) if impl(ghc >= 8.2)
x-doctest-options: -fdiagnostics-color=never x-doctest-options: -fdiagnostics-color=never
include-dirs: include
x-doctest-source-dirs: test x-doctest-source-dirs: test
x-doctest-modules: Servant.LinksSpec x-doctest-modules: Servant.LinksSpec

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
@ -14,8 +13,6 @@
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_HADDOCK not-home #-}
#include "overlapping-compat.h"
-- | A collection of basic Content-Types (also known as Internet Media -- | A collection of basic Content-Types (also known as Internet Media
-- Types, or MIME types). Additionally, this module provides classes that -- Types, or MIME types). Additionally, this module provides classes that
-- encapsulate how to serialize or deserialize values to or from -- encapsulate how to serialize or deserialize values to or from
@ -98,16 +95,13 @@ import qualified Data.Text.Lazy.Encoding as TextL
import Data.Typeable import Data.Typeable
import GHC.Generics import GHC.Generics
(Generic) (Generic)
import qualified GHC.TypeLits as TL
import qualified Network.HTTP.Media as M import qualified Network.HTTP.Media as M
import Prelude () import Prelude ()
import Prelude.Compat import Prelude.Compat
import Web.FormUrlEncoded import Web.FormUrlEncoded
(FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm) (FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm)
#if MIN_VERSION_base(4,9,0)
import qualified GHC.TypeLits as TL
#endif
-- * Provided content types -- * Provided content types
data JSON deriving Typeable data JSON deriving Typeable
data PlainText deriving Typeable data PlainText deriving Typeable
@ -185,18 +179,16 @@ class (AllMime list) => AllCTRender (list :: [*]) a where
-- mimetype). -- mimetype).
handleAcceptH :: Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString) handleAcceptH :: Proxy list -> AcceptHeader -> a -> Maybe (ByteString, ByteString)
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
(Accept ct, AllMime cts, AllMimeRender (ct ': cts) a) => AllCTRender (ct ': cts) a where (Accept ct, AllMime cts, AllMimeRender (ct ': cts) a) => AllCTRender (ct ': cts) a where
handleAcceptH _ (AcceptHeader accept) val = M.mapAcceptMedia lkup accept handleAcceptH _ (AcceptHeader accept) val = M.mapAcceptMedia lkup accept
where pctyps = Proxy :: Proxy (ct ': cts) where pctyps = Proxy :: Proxy (ct ': cts)
amrs = allMimeRender pctyps val amrs = allMimeRender pctyps val
lkup = fmap (\(a,b) -> (a, (fromStrict $ M.renderHeader a, b))) amrs lkup = fmap (\(a,b) -> (a, (fromStrict $ M.renderHeader a, b))) amrs
#if MIN_VERSION_base(4,9,0)
instance TL.TypeError ('TL.Text "No instance for (), use NoContent instead.") instance TL.TypeError ('TL.Text "No instance for (), use NoContent instead.")
=> AllCTRender '[] () where => AllCTRender '[] () where
handleAcceptH _ _ _ = error "unreachable" handleAcceptH _ _ _ = error "unreachable"
#endif
-------------------------------------------------------------------------- --------------------------------------------------------------------------
-- * Unrender -- * Unrender
@ -277,13 +269,13 @@ class (AllMime list) => AllMimeRender (list :: [*]) a where
-> a -- value to serialize -> a -- value to serialize
-> [(M.MediaType, ByteString)] -- content-types/response pairs -> [(M.MediaType, ByteString)] -- content-types/response pairs
instance OVERLAPPABLE_ ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where instance {-# OVERLAPPABLE #-} ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
allMimeRender _ a = map (, bs) $ NE.toList $ contentTypes pctyp allMimeRender _ a = map (, bs) $ NE.toList $ contentTypes pctyp
where where
bs = mimeRender pctyp a bs = mimeRender pctyp a
pctyp = Proxy :: Proxy ctyp pctyp = Proxy :: Proxy ctyp
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
( MimeRender ctyp a ( MimeRender ctyp a
, AllMimeRender (ctyp' ': ctyps) a , AllMimeRender (ctyp' ': ctyps) a
) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where ) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
@ -299,12 +291,12 @@ instance OVERLAPPABLE_
-- Ideally we would like to declare a 'MimeRender a NoContent' instance, and -- Ideally we would like to declare a 'MimeRender a NoContent' instance, and
-- then this would be taken care of. However there is no more specific instance -- then this would be taken care of. However there is no more specific instance
-- between that and 'MimeRender JSON a', so we do this instead -- between that and 'MimeRender JSON a', so we do this instead
instance OVERLAPPING_ ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where
allMimeRender _ _ = map (, "") $ NE.toList $ contentTypes pctyp allMimeRender _ _ = map (, "") $ NE.toList $ contentTypes pctyp
where where
pctyp = Proxy :: Proxy ctyp pctyp = Proxy :: Proxy ctyp
instance OVERLAPPING_ instance {-# OVERLAPPING #-}
( AllMime (ctyp ': ctyp' ': ctyps) ( AllMime (ctyp ': ctyp' ': ctyps)
) => AllMimeRender (ctyp ': ctyp' ': ctyps) NoContent where ) => AllMimeRender (ctyp ': ctyp' ': ctyps) NoContent where
allMimeRender p _ = zip (allMime p) (repeat "") allMimeRender p _ = zip (allMime p) (repeat "")
@ -334,14 +326,14 @@ instance ( MimeUnrender ctyp a
-- * MimeRender Instances -- * MimeRender Instances
-- | `encode` -- | `encode`
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
ToJSON a => MimeRender JSON a where ToJSON a => MimeRender JSON a where
mimeRender _ = encode mimeRender _ = encode
-- | @urlEncodeAsForm@ -- | @urlEncodeAsForm@
-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only -- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
-- holds if every element of x is non-null (i.e., not @("", "")@) -- holds if every element of x is non-null (i.e., not @("", "")@)
instance OVERLAPPABLE_ instance {-# OVERLAPPABLE #-}
ToForm a => MimeRender FormUrlEncoded a where ToForm a => MimeRender FormUrlEncoded a where
mimeRender _ = urlEncodeAsForm mimeRender _ = urlEncodeAsForm

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFunctor #-}
@ -15,7 +14,6 @@
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_HADDOCK not-home #-}
#include "overlapping-compat.h"
-- | This module provides facilities for adding headers to a response. -- | This module provides facilities for adding headers to a response.
-- --
-- >>> let headerVal = addHeader "some-url" 5 :: Headers '[Header "Location" String] Int -- >>> let headerVal = addHeader "some-url" 5 :: Headers '[Header "Location" String] Int
@ -80,10 +78,10 @@ class BuildHeadersTo hs where
-- the values are interspersed with commas before deserialization (see -- the values are interspersed with commas before deserialization (see
-- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html#sec4.2 RFC2616 Sec 4.2>) -- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html#sec4.2 RFC2616 Sec 4.2>)
instance OVERLAPPING_ BuildHeadersTo '[] where instance {-# OVERLAPPING #-} BuildHeadersTo '[] where
buildHeadersTo _ = HNil buildHeadersTo _ = HNil
instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h ) instance {-# OVERLAPPABLE #-} ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
=> BuildHeadersTo (Header h v ': xs) where => BuildHeadersTo (Header h v ': xs) where
buildHeadersTo headers = buildHeadersTo headers =
let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h) let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
@ -144,11 +142,11 @@ class AddHeader h v orig new
addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times addOptionalHeader :: ResponseHeader h v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
instance OVERLAPPING_ ( KnownSymbol h, ToHttpApiData v ) instance {-# OVERLAPPING #-} ( KnownSymbol h, ToHttpApiData v )
=> AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads) addOptionalHeader hdr (Headers resp heads) = Headers resp (HCons hdr heads)
instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData v instance {-# OVERLAPPABLE #-} ( KnownSymbol h, ToHttpApiData v
, new ~ (Headers '[Header h v] a) ) , new ~ (Headers '[Header h v] a) )
=> AddHeader h v a new where => AddHeader h v a new where
addOptionalHeader hdr resp = Headers resp (HCons hdr HNil) addOptionalHeader hdr resp = Headers resp (HCons hdr HNil)

View file

@ -41,9 +41,6 @@ module Servant.API.TypeLevel (
-- ** Logic -- ** Logic
Or, Or,
And, And,
-- * Custom type errors
-- | Before @base-4.9.0.0@ we use non-exported 'ElemNotFoundIn' class,
-- which cannot be instantiated.
) where ) where
@ -63,10 +60,8 @@ import Servant.API.Sub
(type (:>)) (type (:>))
import Servant.API.Verbs import Servant.API.Verbs
(Verb) (Verb)
#if MIN_VERSION_base(4,9,0)
import GHC.TypeLits import GHC.TypeLits
(ErrorMessage (..), TypeError) (ErrorMessage (..), TypeError)
#endif
@ -222,14 +217,10 @@ type Elem e es = ElemGo e es es
type family ElemGo e es orig :: Constraint where type family ElemGo e es orig :: Constraint where
ElemGo x (x ': xs) orig = () ElemGo x (x ': xs) orig = ()
ElemGo y (x ': xs) orig = ElemGo y xs orig ElemGo y (x ': xs) orig = ElemGo y xs orig
#if MIN_VERSION_base(4,9,0)
-- Note [Custom Errors] -- Note [Custom Errors]
ElemGo x '[] orig = TypeError ('ShowType x ElemGo x '[] orig = TypeError ('ShowType x
':<>: 'Text " expected in list " ':<>: 'Text " expected in list "
':<>: 'ShowType orig) ':<>: 'ShowType orig)
#else
ElemGo x '[] orig = ElemNotFoundIn x orig
#endif
-- ** Logic -- ** Logic
@ -244,12 +235,6 @@ type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
type family And (a :: Constraint) (b :: Constraint) :: Constraint where type family And (a :: Constraint) (b :: Constraint) :: Constraint where
And () () = () And () () = ()
-- * Custom type errors
#if !MIN_VERSION_base(4,9,0)
class ElemNotFoundIn val list
#endif
{- Note [Custom Errors] {- Note [Custom Errors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We might try to factor these our more cleanly, but the type synonyms and type We might try to factor these our more cleanly, but the type synonyms and type

View file

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
@ -195,7 +194,6 @@ spec = describe "Servant.API.ContentTypes" $ do
handleCTypeH (Proxy :: Proxy '[JSONorText]) "image/jpeg" handleCTypeH (Proxy :: Proxy '[JSONorText]) "image/jpeg"
"foobar" `shouldBe` (Nothing :: Maybe (Either String Int)) "foobar" `shouldBe` (Nothing :: Maybe (Either String Int))
#if MIN_VERSION_aeson(0,9,0)
-- aeson >= 0.9 decodes top-level strings -- aeson >= 0.9 decodes top-level strings
describe "eitherDecodeLenient" $ do describe "eitherDecodeLenient" $ do
@ -204,7 +202,6 @@ spec = describe "Servant.API.ContentTypes" $ do
-- The Left messages differ, so convert to Maybe -- The Left messages differ, so convert to Maybe
property $ \x -> toMaybe (eitherDecodeLenient x) property $ \x -> toMaybe (eitherDecodeLenient x)
`shouldBe` (decode x :: Maybe String) `shouldBe` (decode x :: Maybe String)
#endif
data SomeData = SomeData { record1 :: String, record2 :: Int } data SomeData = SomeData { record1 :: String, record2 :: Int }

View file

@ -1,12 +1,8 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-} {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ < 709
{-# OPTIONS_GHC -fcontext-stack=41 #-}
#endif
module Servant.LinksSpec where module Servant.LinksSpec where
import Data.Proxy import Data.Proxy