Merge pull request #1009 from phadej/cleanup-pre-ghc-8.0
Cleanup pre-GHC-8.0 stuff
This commit is contained in:
commit
99e535b579
31 changed files with 46 additions and 219 deletions
|
@ -1,8 +0,0 @@
|
||||||
#if __GLASGOW_HASKELL__ >= 710
|
|
||||||
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
|
||||||
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
|
||||||
#else
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
|
||||||
#define OVERLAPPABLE_
|
|
||||||
#define OVERLAPPING_
|
|
||||||
#endif
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -1,8 +0,0 @@
|
||||||
#if __GLASGOW_HASKELL__ >= 710
|
|
||||||
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
|
||||||
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
|
||||||
#else
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
|
||||||
#define OVERLAPPABLE_
|
|
||||||
#define OVERLAPPING_
|
|
||||||
#endif
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -1,8 +0,0 @@
|
||||||
#if __GLASGOW_HASKELL__ >= 710
|
|
||||||
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
|
||||||
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
|
||||||
#else
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
|
||||||
#define OVERLAPPABLE_
|
|
||||||
#define OVERLAPPING_
|
|
||||||
#endif
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -1,8 +0,0 @@
|
||||||
#if __GLASGOW_HASKELL__ >= 710
|
|
||||||
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
|
||||||
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
|
||||||
#else
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
|
||||||
#define OVERLAPPABLE_
|
|
||||||
#define OVERLAPPING_
|
|
||||||
#endif
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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}
|
|
|
@ -1,8 +0,0 @@
|
||||||
#if __GLASGOW_HASKELL__ >= 710
|
|
||||||
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
|
||||||
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
|
||||||
#else
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
|
||||||
#define OVERLAPPABLE_
|
|
||||||
#define OVERLAPPING_
|
|
||||||
#endif
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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}
|
|
|
@ -1,8 +0,0 @@
|
||||||
#if __GLASGOW_HASKELL__ >= 710
|
|
||||||
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
|
||||||
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
|
||||||
#else
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
|
||||||
#define OVERLAPPABLE_
|
|
||||||
#define OVERLAPPING_
|
|
||||||
#endif
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 }
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue