less OverlappingInstances noise
This commit is contained in:
parent
9cc344b95b
commit
e7c9084917
31 changed files with 197 additions and 257 deletions
8
servant-blaze/include/overlapping-compat.h
Normal file
8
servant-blaze/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -30,3 +30,4 @@ library
|
||||||
, blaze-html
|
, blaze-html
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
include-dirs: include
|
||||||
|
|
|
@ -3,10 +3,8 @@
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
#if !MIN_VERSION_base(4,8,0)
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
|
||||||
#endif
|
|
||||||
|
|
||||||
|
#include "overlapping-compat.h"
|
||||||
-- | An @HTML@ empty data type with `MimeRender` instances for @blaze-html@'s
|
-- | An @HTML@ empty data type with `MimeRender` instances for @blaze-html@'s
|
||||||
-- `ToMarkup` class and `Html` datatype.
|
-- `ToMarkup` class and `Html` datatype.
|
||||||
-- You should only need to import this module for it's instances and the
|
-- You should only need to import this module for it's instances and the
|
||||||
|
@ -29,17 +27,9 @@ data HTML deriving Typeable
|
||||||
instance Accept HTML where
|
instance Accept HTML where
|
||||||
contentType _ = "text" M.// "html" M./: ("charset", "utf-8")
|
contentType _ = "text" M.// "html" M./: ("charset", "utf-8")
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_ ToMarkup a => MimeRender HTML a where
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
ToMarkup a => MimeRender HTML a where
|
|
||||||
mimeRender _ = renderHtml . toHtml
|
mimeRender _ = renderHtml . toHtml
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_ MimeRender HTML Html where
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
MimeRender HTML Html where
|
|
||||||
mimeRender _ = renderHtml
|
mimeRender _ = renderHtml
|
||||||
|
|
||||||
|
|
8
servant-cassava/include/overlapping-compat.h
Normal file
8
servant-cassava/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -27,3 +27,4 @@ library
|
||||||
, vector
|
, vector
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
include-dirs: include
|
||||||
|
|
8
servant-client/include/overlapping-compat.h
Normal file
8
servant-client/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -49,6 +49,7 @@ 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
|
||||||
|
|
|
@ -8,9 +8,8 @@
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE UndecidableInstances #-}
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
#if !MIN_VERSION_base(4,8,0)
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
#include "overlapping-compat.h"
|
||||||
#endif
|
|
||||||
-- | This module provides 'client' which can automatically generate
|
-- | This module provides 'client' which can automatically generate
|
||||||
-- querying functions for each endpoint just from the type representing your
|
-- querying functions for each endpoint just from the type representing your
|
||||||
-- API.
|
-- API.
|
||||||
|
@ -123,19 +122,13 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
|
||||||
-- side querying function that is created when calling 'client'
|
-- side querying function that is created when calling 'client'
|
||||||
-- will just require an argument that specifies the scheme, host
|
-- will just require an argument that specifies the scheme, host
|
||||||
-- and port to send the request to.
|
-- and port to send the request to.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
(MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where
|
(MimeUnrender ct a, cts' ~ (ct ': cts)) => HasClient (Delete cts' a) where
|
||||||
type Client (Delete cts' a) = ExceptT ServantError IO a
|
type Client (Delete cts' a) = ExceptT ServantError IO a
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl manager
|
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl manager
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasClient (Delete cts ()) where
|
HasClient (Delete cts ()) where
|
||||||
type Client (Delete cts ()) = ExceptT ServantError IO ()
|
type Client (Delete cts ()) = ExceptT ServantError IO ()
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
|
@ -143,10 +136,7 @@ instance
|
||||||
|
|
||||||
-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the
|
-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the
|
||||||
-- corresponding headers.
|
-- corresponding headers.
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)
|
( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)
|
||||||
) => HasClient (Delete cts' (Headers ls a)) where
|
) => HasClient (Delete cts' (Headers ls a)) where
|
||||||
type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
type Client (Delete cts' (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
||||||
|
@ -160,19 +150,13 @@ instance
|
||||||
-- side querying function that is created when calling 'client'
|
-- side querying function that is created when calling 'client'
|
||||||
-- will just require an argument that specifies the scheme, host
|
-- will just require an argument that specifies the scheme, host
|
||||||
-- and port to send the request to.
|
-- and port to send the request to.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
(MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
|
(MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
|
||||||
type Client (Get (ct ': cts) result) = ExceptT ServantError IO result
|
type Client (Get (ct ': cts) result) = ExceptT ServantError IO result
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl manager
|
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl manager
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasClient (Get (ct ': cts) ()) where
|
HasClient (Get (ct ': cts) ()) where
|
||||||
type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()
|
type Client (Get (ct ': cts) ()) = ExceptT ServantError IO ()
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
|
@ -180,10 +164,7 @@ instance
|
||||||
|
|
||||||
-- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the
|
-- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the
|
||||||
-- corresponding headers.
|
-- corresponding headers.
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( MimeUnrender ct a, BuildHeadersTo ls
|
( MimeUnrender ct a, BuildHeadersTo ls
|
||||||
) => HasClient (Get (ct ': cts) (Headers ls a)) where
|
) => HasClient (Get (ct ': cts) (Headers ls a)) where
|
||||||
type Client (Get (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
type Client (Get (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
||||||
|
@ -240,19 +221,13 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
|
||||||
-- side querying function that is created when calling 'client'
|
-- side querying function that is created when calling 'client'
|
||||||
-- will just require an argument that specifies the scheme, host
|
-- will just require an argument that specifies the scheme, host
|
||||||
-- and port to send the request to.
|
-- and port to send the request to.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
(MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
|
(MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
|
||||||
type Client (Post (ct ': cts) a) = ExceptT ServantError IO a
|
type Client (Post (ct ': cts) a) = ExceptT ServantError IO a
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl manager
|
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl manager
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasClient (Post (ct ': cts) ()) where
|
HasClient (Post (ct ': cts) ()) where
|
||||||
type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()
|
type Client (Post (ct ': cts) ()) = ExceptT ServantError IO ()
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
|
@ -260,10 +235,7 @@ instance
|
||||||
|
|
||||||
-- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the
|
-- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the
|
||||||
-- corresponding headers.
|
-- corresponding headers.
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( MimeUnrender ct a, BuildHeadersTo ls
|
( MimeUnrender ct a, BuildHeadersTo ls
|
||||||
) => HasClient (Post (ct ': cts) (Headers ls a)) where
|
) => HasClient (Post (ct ': cts) (Headers ls a)) where
|
||||||
type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
type Client (Post (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
||||||
|
@ -277,19 +249,13 @@ instance
|
||||||
-- side querying function that is created when calling 'client'
|
-- side querying function that is created when calling 'client'
|
||||||
-- will just require an argument that specifies the scheme, host
|
-- will just require an argument that specifies the scheme, host
|
||||||
-- and port to send the request to.
|
-- and port to send the request to.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
(MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
|
(MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
|
||||||
type Client (Put (ct ': cts) a) = ExceptT ServantError IO a
|
type Client (Put (ct ': cts) a) = ExceptT ServantError IO a
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl manager
|
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl manager
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasClient (Put (ct ': cts) ()) where
|
HasClient (Put (ct ': cts) ()) where
|
||||||
type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()
|
type Client (Put (ct ': cts) ()) = ExceptT ServantError IO ()
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
|
@ -297,10 +263,7 @@ instance
|
||||||
|
|
||||||
-- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the
|
-- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the
|
||||||
-- corresponding headers.
|
-- corresponding headers.
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( MimeUnrender ct a, BuildHeadersTo ls
|
( MimeUnrender ct a, BuildHeadersTo ls
|
||||||
) => HasClient (Put (ct ': cts) (Headers ls a)) where
|
) => HasClient (Put (ct ': cts) (Headers ls a)) where
|
||||||
type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
type Client (Put (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
||||||
|
@ -314,19 +277,13 @@ instance
|
||||||
-- side querying function that is created when calling 'client'
|
-- side querying function that is created when calling 'client'
|
||||||
-- will just require an argument that specifies the scheme, host
|
-- will just require an argument that specifies the scheme, host
|
||||||
-- and port to send the request to.
|
-- and port to send the request to.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
(MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
|
(MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
|
||||||
type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a
|
type Client (Patch (ct ': cts) a) = ExceptT ServantError IO a
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl manager
|
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl manager
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasClient (Patch (ct ': cts) ()) where
|
HasClient (Patch (ct ': cts) ()) where
|
||||||
type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()
|
type Client (Patch (ct ': cts) ()) = ExceptT ServantError IO ()
|
||||||
clientWithRoute Proxy req baseurl manager =
|
clientWithRoute Proxy req baseurl manager =
|
||||||
|
@ -334,10 +291,7 @@ instance
|
||||||
|
|
||||||
-- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the
|
-- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the
|
||||||
-- corresponding headers.
|
-- corresponding headers.
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( MimeUnrender ct a, BuildHeadersTo ls
|
( MimeUnrender ct a, BuildHeadersTo ls
|
||||||
) => HasClient (Patch (ct ': cts) (Headers ls a)) where
|
) => HasClient (Patch (ct ': cts) (Headers ls a)) where
|
||||||
type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
type Client (Patch (ct ': cts) (Headers ls a)) = ExceptT ServantError IO (Headers ls a)
|
||||||
|
|
|
@ -6,9 +6,6 @@
|
||||||
{-# LANGUAGE FunctionalDependencies #-}
|
{-# LANGUAGE FunctionalDependencies #-}
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
#if !MIN_VERSION_base(4,8,0)
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
|
||||||
#endif
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
@ -20,6 +17,7 @@
|
||||||
{-# 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 where
|
module Servant.ClientSpec where
|
||||||
|
|
||||||
#if !MIN_VERSION_base(4,8,0)
|
#if !MIN_VERSION_base(4,8,0)
|
||||||
|
@ -323,33 +321,21 @@ pathGen = fmap NonEmpty path
|
||||||
class GetNth (n :: Nat) a b | n a -> b where
|
class GetNth (n :: Nat) a b | n a -> b where
|
||||||
getNth :: Proxy n -> a -> b
|
getNth :: Proxy n -> a -> b
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
GetNth 0 (x :<|> y) x where
|
GetNth 0 (x :<|> y) x where
|
||||||
getNth _ (x :<|> _) = x
|
getNth _ (x :<|> _) = x
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
(GetNth (n - 1) x y) => GetNth n (a :<|> x) y where
|
(GetNth (n - 1) x y) => GetNth n (a :<|> x) y where
|
||||||
getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x
|
getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x
|
||||||
|
|
||||||
class GetLast a b | a -> b where
|
class GetLast a b | a -> b where
|
||||||
getLast :: a -> b
|
getLast :: a -> b
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
(GetLast b c) => GetLast (a :<|> b) c where
|
(GetLast b c) => GetLast (a :<|> b) c where
|
||||||
getLast (_ :<|> b) = getLast b
|
getLast (_ :<|> b) = getLast b
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
GetLast a a where
|
GetLast a a where
|
||||||
getLast a = a
|
getLast a = a
|
||||||
|
|
8
servant-docs/include/overlapping-compat.h
Normal file
8
servant-docs/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -49,6 +49,7 @@ library
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
include-dirs: include
|
||||||
|
|
||||||
executable greet-docs
|
executable greet-docs
|
||||||
main-is: greet.hs
|
main-is: greet.hs
|
||||||
|
|
|
@ -16,9 +16,8 @@
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE UndecidableInstances #-}
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
#if !MIN_VERSION_base(4,8,0)
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
#include "overlapping-compat.h"
|
||||||
#endif
|
|
||||||
module Servant.Docs.Internal where
|
module Servant.Docs.Internal where
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
@ -661,10 +660,7 @@ markdown 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
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
(HasDocs layout1, HasDocs layout2)
|
(HasDocs layout1, HasDocs layout2)
|
||||||
=> HasDocs (layout1 :<|> layout2) where
|
=> HasDocs (layout1 :<|> layout2) where
|
||||||
|
|
||||||
|
@ -692,10 +688,7 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
|
||||||
symP = Proxy :: Proxy sym
|
symP = Proxy :: Proxy sym
|
||||||
|
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLe #-}
|
|
||||||
#endif
|
|
||||||
(ToSample a, IsNonEmpty cts, AllMimeRender cts a)
|
(ToSample a, IsNonEmpty cts, AllMimeRender cts a)
|
||||||
=> HasDocs (Delete cts a) where
|
=> HasDocs (Delete cts a) where
|
||||||
docsFor Proxy (endpoint, action) DocOptions{..} =
|
docsFor Proxy (endpoint, action) DocOptions{..} =
|
||||||
|
@ -707,10 +700,7 @@ instance
|
||||||
t = Proxy :: Proxy cts
|
t = Proxy :: Proxy cts
|
||||||
p = Proxy :: Proxy a
|
p = Proxy :: Proxy a
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
(ToSample a, IsNonEmpty cts, AllMimeRender cts a
|
(ToSample a, IsNonEmpty cts, AllMimeRender cts a
|
||||||
, AllHeaderSamples ls , GetHeaders (HList ls) )
|
, AllHeaderSamples ls , GetHeaders (HList ls) )
|
||||||
=> HasDocs (Delete cts (Headers ls a)) where
|
=> HasDocs (Delete cts (Headers ls a)) where
|
||||||
|
@ -725,10 +715,7 @@ instance
|
||||||
t = Proxy :: Proxy cts
|
t = Proxy :: Proxy cts
|
||||||
p = Proxy :: Proxy a
|
p = Proxy :: Proxy a
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLe #-}
|
|
||||||
#endif
|
|
||||||
(ToSample a, IsNonEmpty cts, AllMimeRender cts a)
|
(ToSample a, IsNonEmpty cts, AllMimeRender cts a)
|
||||||
=> HasDocs (Get cts a) where
|
=> HasDocs (Get cts a) where
|
||||||
docsFor Proxy (endpoint, action) DocOptions{..} =
|
docsFor Proxy (endpoint, action) DocOptions{..} =
|
||||||
|
@ -740,10 +727,7 @@ instance
|
||||||
t = Proxy :: Proxy cts
|
t = Proxy :: Proxy cts
|
||||||
p = Proxy :: Proxy a
|
p = Proxy :: Proxy a
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
(ToSample a, IsNonEmpty cts, AllMimeRender cts a
|
(ToSample a, IsNonEmpty cts, AllMimeRender cts a
|
||||||
, AllHeaderSamples ls , GetHeaders (HList ls) )
|
, AllHeaderSamples ls , GetHeaders (HList ls) )
|
||||||
=> HasDocs (Get cts (Headers ls a)) where
|
=> HasDocs (Get cts (Headers ls a)) where
|
||||||
|
@ -767,10 +751,7 @@ instance (KnownSymbol sym, HasDocs sublayout)
|
||||||
action' = over headers (|> headername) action
|
action' = over headers (|> headername) action
|
||||||
headername = pack $ symbolVal (Proxy :: Proxy sym)
|
headername = pack $ symbolVal (Proxy :: Proxy sym)
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
(ToSample a, IsNonEmpty cts, AllMimeRender cts a)
|
(ToSample a, IsNonEmpty cts, AllMimeRender cts a)
|
||||||
=> HasDocs (Post cts a) where
|
=> HasDocs (Post cts a) where
|
||||||
docsFor Proxy (endpoint, action) DocOptions{..} =
|
docsFor Proxy (endpoint, action) DocOptions{..} =
|
||||||
|
@ -783,10 +764,7 @@ instance
|
||||||
t = Proxy :: Proxy cts
|
t = Proxy :: Proxy cts
|
||||||
p = Proxy :: Proxy a
|
p = Proxy :: Proxy a
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
(ToSample a, IsNonEmpty cts, AllMimeRender cts a
|
(ToSample a, IsNonEmpty cts, AllMimeRender cts a
|
||||||
, AllHeaderSamples ls , GetHeaders (HList ls) )
|
, AllHeaderSamples ls , GetHeaders (HList ls) )
|
||||||
=> HasDocs (Post cts (Headers ls a)) where
|
=> HasDocs (Post cts (Headers ls a)) where
|
||||||
|
@ -802,10 +780,7 @@ instance
|
||||||
t = Proxy :: Proxy cts
|
t = Proxy :: Proxy cts
|
||||||
p = Proxy :: Proxy a
|
p = Proxy :: Proxy a
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
(ToSample a, IsNonEmpty cts, AllMimeRender cts a)
|
(ToSample a, IsNonEmpty cts, AllMimeRender cts a)
|
||||||
=> HasDocs (Put cts a) where
|
=> HasDocs (Put cts a) where
|
||||||
docsFor Proxy (endpoint, action) DocOptions{..} =
|
docsFor Proxy (endpoint, action) DocOptions{..} =
|
||||||
|
@ -818,10 +793,7 @@ instance
|
||||||
t = Proxy :: Proxy cts
|
t = Proxy :: Proxy cts
|
||||||
p = Proxy :: Proxy a
|
p = Proxy :: Proxy a
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( ToSample a, IsNonEmpty cts, AllMimeRender cts a,
|
( ToSample a, IsNonEmpty cts, AllMimeRender cts a,
|
||||||
AllHeaderSamples ls , GetHeaders (HList ls) )
|
AllHeaderSamples ls , GetHeaders (HList ls) )
|
||||||
=> HasDocs (Put cts (Headers ls a)) where
|
=> HasDocs (Put cts (Headers ls a)) where
|
||||||
|
|
8
servant-examples/include/overlapping-compat.h
Normal file
8
servant-examples/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
8
servant-foreign/include/overlapping-compat.h
Normal file
8
servant-foreign/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -33,6 +33,7 @@ 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
|
||||||
|
|
8
servant-jquery/include/overlapping-compat.h
Normal file
8
servant-jquery/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
8
servant-js/include/overlapping-compat.h
Normal file
8
servant-js/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -49,6 +49,7 @@ library
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
include-dirs: include
|
||||||
|
|
||||||
executable counter
|
executable counter
|
||||||
main-is: counter.hs
|
main-is: counter.hs
|
||||||
|
|
8
servant-lucid/include/overlapping-compat.h
Normal file
8
servant-lucid/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -30,3 +30,4 @@ library
|
||||||
, servant == 0.5.*
|
, servant == 0.5.*
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
include-dirs: include
|
||||||
|
|
|
@ -3,9 +3,8 @@
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
#if !MIN_VERSION_base(4,8,0)
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
#include "overlapping-compat.h"
|
||||||
#endif
|
|
||||||
|
|
||||||
-- | An @HTML@ empty data type with `MimeRender` instances for @lucid@'s
|
-- | An @HTML@ empty data type with `MimeRender` instances for @lucid@'s
|
||||||
-- `ToHtml` class and `Html` datatype.
|
-- `ToHtml` class and `Html` datatype.
|
||||||
|
@ -28,16 +27,10 @@ data HTML deriving Typeable
|
||||||
instance Accept HTML where
|
instance Accept HTML where
|
||||||
contentType _ = "text" M.// "html" M./: ("charset", "utf-8")
|
contentType _ = "text" M.// "html" M./: ("charset", "utf-8")
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
ToHtml a => MimeRender HTML a where
|
ToHtml a => MimeRender HTML a where
|
||||||
mimeRender _ = renderBS . toHtml
|
mimeRender _ = renderBS . toHtml
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
MimeRender HTML (Html a) where
|
MimeRender HTML (Html a) where
|
||||||
mimeRender _ = renderBS
|
mimeRender _ = renderBS
|
||||||
|
|
8
servant-mock/include/overlapping-compat.h
Normal file
8
servant-mock/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -34,6 +34,7 @@ library
|
||||||
wai >= 3.0 && <3.1
|
wai >= 3.0 && <3.1
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
include-dirs: include
|
||||||
|
|
||||||
executable mock-app
|
executable mock-app
|
||||||
main-is: main.hs
|
main-is: main.hs
|
||||||
|
|
8
servant-property/include/overlapping-compat.h
Normal file
8
servant-property/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
8
servant-server/include/overlapping-compat.h
Normal file
8
servant-server/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -69,6 +69,7 @@ library
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
include-dirs: include
|
||||||
|
|
||||||
executable greet
|
executable greet
|
||||||
main-is: greet.hs
|
main-is: greet.hs
|
||||||
|
@ -134,3 +135,4 @@ test-suite doctests
|
||||||
buildable: True
|
buildable: True
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -threaded
|
ghc-options: -threaded
|
||||||
|
include-dirs: include
|
||||||
|
|
|
@ -8,9 +8,8 @@
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
#if !MIN_VERSION_base(4,8,0)
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
#include "overlapping-compat.h"
|
||||||
#endif
|
|
||||||
|
|
||||||
module Servant.Server.Internal
|
module Servant.Server.Internal
|
||||||
( module Servant.Server.Internal
|
( module Servant.Server.Internal
|
||||||
|
@ -206,10 +205,7 @@ methodRouterEmpty method action = LeafRouter route'
|
||||||
-- to be returned. You can use 'Control.Monad.Trans.Except.throwE' to
|
-- to be returned. You can use 'Control.Monad.Trans.Except.throwE' to
|
||||||
-- painlessly error out if the conditions for a successful deletion
|
-- painlessly error out if the conditions for a successful deletion
|
||||||
-- are not met.
|
-- are not met.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
( AllCTRender ctypes a
|
( AllCTRender ctypes a
|
||||||
) => HasServer (Delete ctypes a) where
|
) => HasServer (Delete ctypes a) where
|
||||||
|
|
||||||
|
@ -217,10 +213,7 @@ instance
|
||||||
|
|
||||||
route Proxy = methodRouter methodDelete (Proxy :: Proxy ctypes) ok200
|
route Proxy = methodRouter methodDelete (Proxy :: Proxy ctypes) ok200
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasServer (Delete ctypes ()) where
|
HasServer (Delete ctypes ()) where
|
||||||
|
|
||||||
type ServerT (Delete ctypes ()) m = m ()
|
type ServerT (Delete ctypes ()) m = m ()
|
||||||
|
@ -228,10 +221,7 @@ instance
|
||||||
route Proxy = methodRouterEmpty methodDelete
|
route Proxy = methodRouterEmpty methodDelete
|
||||||
|
|
||||||
-- Add response headers
|
-- Add response headers
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( GetHeaders (Headers h v), AllCTRender ctypes v
|
( GetHeaders (Headers h v), AllCTRender ctypes v
|
||||||
) => HasServer (Delete ctypes (Headers h v)) where
|
) => HasServer (Delete ctypes (Headers h v)) where
|
||||||
|
|
||||||
|
@ -252,10 +242,7 @@ instance
|
||||||
-- (returning a status code of 200). If there was no @Accept@ header or it
|
-- (returning a status code of 200). If there was no @Accept@ header or it
|
||||||
-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
|
-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
|
||||||
-- list.
|
-- list.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
( AllCTRender ctypes a ) => HasServer (Get ctypes a) where
|
( AllCTRender ctypes a ) => HasServer (Get ctypes a) where
|
||||||
|
|
||||||
type ServerT (Get ctypes a) m = m a
|
type ServerT (Get ctypes a) m = m a
|
||||||
|
@ -263,10 +250,7 @@ instance
|
||||||
route Proxy = methodRouter methodGet (Proxy :: Proxy ctypes) ok200
|
route Proxy = methodRouter methodGet (Proxy :: Proxy ctypes) ok200
|
||||||
|
|
||||||
-- '()' ==> 204 No Content
|
-- '()' ==> 204 No Content
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasServer (Get ctypes ()) where
|
HasServer (Get ctypes ()) where
|
||||||
|
|
||||||
type ServerT (Get ctypes ()) m = m ()
|
type ServerT (Get ctypes ()) m = m ()
|
||||||
|
@ -274,10 +258,7 @@ instance
|
||||||
route Proxy = methodRouterEmpty methodGet
|
route Proxy = methodRouterEmpty methodGet
|
||||||
|
|
||||||
-- Add response headers
|
-- Add response headers
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( GetHeaders (Headers h v), AllCTRender ctypes v
|
( GetHeaders (Headers h v), AllCTRender ctypes v
|
||||||
) => HasServer (Get ctypes (Headers h v)) where
|
) => HasServer (Get ctypes (Headers h v)) where
|
||||||
|
|
||||||
|
@ -329,10 +310,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout)
|
||||||
-- (returning a status code of 201). If there was no @Accept@ header or it
|
-- (returning a status code of 201). If there was no @Accept@ header or it
|
||||||
-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
|
-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
|
||||||
-- list.
|
-- list.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
( AllCTRender ctypes a
|
( AllCTRender ctypes a
|
||||||
) => HasServer (Post ctypes a) where
|
) => HasServer (Post ctypes a) where
|
||||||
|
|
||||||
|
@ -340,10 +318,7 @@ instance
|
||||||
|
|
||||||
route Proxy = methodRouter methodPost (Proxy :: Proxy ctypes) created201
|
route Proxy = methodRouter methodPost (Proxy :: Proxy ctypes) created201
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasServer (Post ctypes ()) where
|
HasServer (Post ctypes ()) where
|
||||||
|
|
||||||
type ServerT (Post ctypes ()) m = m ()
|
type ServerT (Post ctypes ()) m = m ()
|
||||||
|
@ -351,10 +326,7 @@ instance
|
||||||
route Proxy = methodRouterEmpty methodPost
|
route Proxy = methodRouterEmpty methodPost
|
||||||
|
|
||||||
-- Add response headers
|
-- Add response headers
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( GetHeaders (Headers h v), AllCTRender ctypes v
|
( GetHeaders (Headers h v), AllCTRender ctypes v
|
||||||
) => HasServer (Post ctypes (Headers h v)) where
|
) => HasServer (Post ctypes (Headers h v)) where
|
||||||
|
|
||||||
|
@ -375,20 +347,14 @@ instance
|
||||||
-- (returning a status code of 200). If there was no @Accept@ header or it
|
-- (returning a status code of 200). If there was no @Accept@ header or it
|
||||||
-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
|
-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
|
||||||
-- list.
|
-- list.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
( AllCTRender ctypes a) => HasServer (Put ctypes a) where
|
( AllCTRender ctypes a) => HasServer (Put ctypes a) where
|
||||||
|
|
||||||
type ServerT (Put ctypes a) m = m a
|
type ServerT (Put ctypes a) m = m a
|
||||||
|
|
||||||
route Proxy = methodRouter methodPut (Proxy :: Proxy ctypes) ok200
|
route Proxy = methodRouter methodPut (Proxy :: Proxy ctypes) ok200
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasServer (Put ctypes ()) where
|
HasServer (Put ctypes ()) where
|
||||||
|
|
||||||
type ServerT (Put ctypes ()) m = m ()
|
type ServerT (Put ctypes ()) m = m ()
|
||||||
|
@ -396,10 +362,7 @@ instance
|
||||||
route Proxy = methodRouterEmpty methodPut
|
route Proxy = methodRouterEmpty methodPut
|
||||||
|
|
||||||
-- Add response headers
|
-- Add response headers
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( GetHeaders (Headers h v), AllCTRender ctypes v
|
( GetHeaders (Headers h v), AllCTRender ctypes v
|
||||||
) => HasServer (Put ctypes (Headers h v)) where
|
) => HasServer (Put ctypes (Headers h v)) where
|
||||||
|
|
||||||
|
@ -418,20 +381,14 @@ instance
|
||||||
-- If successfully returning a value, we just require that its type has
|
-- If successfully returning a value, we just require that its type has
|
||||||
-- a 'ToJSON' instance and servant takes care of encoding it for you,
|
-- a 'ToJSON' instance and servant takes care of encoding it for you,
|
||||||
-- yielding status code 200 along the way.
|
-- yielding status code 200 along the way.
|
||||||
instance
|
instance OVERLAPPABLE_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
( AllCTRender ctypes a) => HasServer (Patch ctypes a) where
|
( AllCTRender ctypes a) => HasServer (Patch ctypes a) where
|
||||||
|
|
||||||
type ServerT (Patch ctypes a) m = m a
|
type ServerT (Patch ctypes a) m = m a
|
||||||
|
|
||||||
route Proxy = methodRouter methodPatch (Proxy :: Proxy ctypes) ok200
|
route Proxy = methodRouter methodPatch (Proxy :: Proxy ctypes) ok200
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
HasServer (Patch ctypes ()) where
|
HasServer (Patch ctypes ()) where
|
||||||
|
|
||||||
type ServerT (Patch ctypes ()) m = m ()
|
type ServerT (Patch ctypes ()) m = m ()
|
||||||
|
@ -439,10 +396,7 @@ instance
|
||||||
route Proxy = methodRouterEmpty methodPatch
|
route Proxy = methodRouterEmpty methodPatch
|
||||||
|
|
||||||
-- Add response headers
|
-- Add response headers
|
||||||
instance
|
instance OVERLAPPING_
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( GetHeaders (Headers h v), AllCTRender ctypes v
|
( GetHeaders (Headers h v), AllCTRender ctypes v
|
||||||
) => HasServer (Patch ctypes (Headers h v)) where
|
) => HasServer (Patch ctypes (Headers h v)) where
|
||||||
|
|
||||||
|
|
8
servant-session/include/overlapping-compat.h
Normal file
8
servant-session/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
8
servant/include/overlapping-compat.h
Normal file
8
servant/include/overlapping-compat.h
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#if __GLASGOW_HASKELL__ >= 710
|
||||||
|
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
|
||||||
|
#define OVERLAPPING_ {-# OVERLAPPING #-}
|
||||||
|
#else
|
||||||
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
|
#define OVERLAPPABLE_
|
||||||
|
#define OVERLAPPING_
|
||||||
|
#endif
|
|
@ -81,6 +81,7 @@ library
|
||||||
, TypeSynonymInstances
|
, TypeSynonymInstances
|
||||||
, UndecidableInstances
|
, UndecidableInstances
|
||||||
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
|
||||||
|
@ -118,3 +119,4 @@ test-suite doctests
|
||||||
buildable: True
|
buildable: True
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -threaded
|
ghc-options: -threaded
|
||||||
|
include-dirs: include
|
||||||
|
|
|
@ -12,11 +12,9 @@
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
{-# LANGUAGE UndecidableInstances #-}
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
#if !MIN_VERSION_base(4,8,0)
|
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
|
||||||
#endif
|
|
||||||
{-# 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
|
||||||
|
@ -68,19 +66,12 @@ 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
|
instance OVERLAPPING_ BuildHeadersTo '[] where
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
BuildHeadersTo '[] where
|
|
||||||
buildHeadersTo _ = HNil
|
buildHeadersTo _ = HNil
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h
|
||||||
#if MIN_VERSION_base(4,8,0)
|
, Contains h xs ~ 'False)
|
||||||
{-# OVERLAPPABLE #-}
|
=> BuildHeadersTo ((Header h v) ': xs) where
|
||||||
#endif
|
|
||||||
( FromByteString v, BuildHeadersTo xs, KnownSymbol h, Contains h xs ~ 'False
|
|
||||||
) => 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)
|
||||||
matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers
|
matching = snd <$> filter (\(h, _) -> h == wantedHeader) headers
|
||||||
|
@ -96,38 +87,22 @@ instance
|
||||||
class GetHeaders ls where
|
class GetHeaders ls where
|
||||||
getHeaders :: ls -> [HTTP.Header]
|
getHeaders :: ls -> [HTTP.Header]
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_ GetHeaders (HList '[]) where
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
GetHeaders (HList '[]) where
|
|
||||||
getHeaders _ = []
|
getHeaders _ = []
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs))
|
||||||
#if MIN_VERSION_base(4,8,0)
|
=> GetHeaders (HList (Header h x ': xs)) where
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
( KnownSymbol h, ToByteString x, GetHeaders (HList xs)
|
|
||||||
) => GetHeaders (HList (Header h x ': xs)) where
|
|
||||||
getHeaders hdrs = case hdrs of
|
getHeaders hdrs = case hdrs of
|
||||||
Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest
|
Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest
|
||||||
UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest
|
UndecodableHeader h `HCons` rest -> (headerName, h) : getHeaders rest
|
||||||
MissingHeader `HCons` rest -> getHeaders rest
|
MissingHeader `HCons` rest -> getHeaders rest
|
||||||
where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
|
where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_ GetHeaders (Headers '[] a) where
|
||||||
#if MIN_VERSION_base(4,8,0)
|
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
GetHeaders (Headers '[] a) where
|
|
||||||
getHeaders _ = []
|
getHeaders _ = []
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v)
|
||||||
#if MIN_VERSION_base(4,8,0)
|
=> GetHeaders (Headers (Header h v ': rest) a) where
|
||||||
{-# OVERLAPPABLE #-}
|
|
||||||
#endif
|
|
||||||
( KnownSymbol h, GetHeaders (HList rest), ToByteString v
|
|
||||||
) => GetHeaders (Headers (Header h v ': rest) a) where
|
|
||||||
getHeaders hs = getHeaders $ getHeadersHList hs
|
getHeaders hs = getHeaders $ getHeadersHList hs
|
||||||
|
|
||||||
-- * Adding
|
-- * Adding
|
||||||
|
@ -138,21 +113,13 @@ class AddHeader h v orig new
|
||||||
addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
|
addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times
|
||||||
|
|
||||||
|
|
||||||
instance
|
instance OVERLAPPING_ ( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False)
|
||||||
#if MIN_VERSION_base(4,8,0)
|
=> AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
|
||||||
{-# OVERLAPPING #-}
|
|
||||||
#endif
|
|
||||||
( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False
|
|
||||||
) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where
|
|
||||||
addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)
|
addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads)
|
||||||
|
|
||||||
instance
|
instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v
|
||||||
#if MIN_VERSION_base(4,8,0)
|
, new ~ (Headers '[Header h v] a))
|
||||||
{-# OVERLAPPABLE #-}
|
=> AddHeader h v a new where
|
||||||
#endif
|
|
||||||
( KnownSymbol h, ToByteString v
|
|
||||||
, new ~ (Headers '[Header h v] a)
|
|
||||||
) => AddHeader h v a new where
|
|
||||||
addHeader a resp = Headers resp (HCons (Header a) HNil)
|
addHeader a resp = Headers resp (HCons (Header a) HNil)
|
||||||
|
|
||||||
type family Contains x xs where
|
type family Contains x xs where
|
||||||
|
|
Loading…
Reference in a new issue