diff --git a/servant/servant.cabal b/servant/servant.cabal index a3dc401d..bc8679b9 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -75,6 +75,10 @@ library exposed-modules: Servant.Links + other-modules: + Servant.Links.Internal + Servant.Links.TypeErrors + -- Bundled with GHC: Lower bound to not force re-installs -- text and mtl are bundled starting with GHC-8.4 -- diff --git a/servant/src/Servant/Links.hs b/servant/src/Servant/Links.hs new file mode 100644 index 00000000..3ce7388b --- /dev/null +++ b/servant/src/Servant/Links.hs @@ -0,0 +1,8 @@ +-- | Wrapper for Servant.Links.Internal, which brings in scope the instance declarations +-- in Servant.Links.TypeErrors +module Servant.Links + ( module Servant.Links.Internal + ) where + +import Servant.Links.Internal +import Servant.Links.TypeErrors () diff --git a/servant/src/Servant/Links/Internal.hs b/servant/src/Servant/Links/Internal.hs index 74314e0a..06648085 100644 --- a/servant/src/Servant/Links/Internal.hs +++ b/servant/src/Servant/Links/Internal.hs @@ -100,7 +100,7 @@ -- `IsElem'` as a last resort. -- -- @since 0.14.1 -module Servant.Links ( +module Servant.Links.Internal ( module Servant.API.TypeLevel, -- * Building and using safe links @@ -141,7 +141,7 @@ import qualified Data.Text.Encoding as TE import Data.Type.Bool (If) import GHC.TypeLits - (KnownSymbol, TypeError, symbolVal) + (KnownSymbol, symbolVal) import Network.URI (URI (..), escapeURIString, isUnreserved) import Prelude () @@ -184,7 +184,6 @@ import Servant.API.Stream (Stream, StreamBody') import Servant.API.Sub (type (:>)) -import Servant.API.TypeErrors import Servant.API.TypeLevel import Servant.API.UVerb import Servant.API.Vault @@ -194,8 +193,6 @@ import Servant.API.Verbs import Servant.API.WithNamedContext (WithNamedContext) import Web.HttpApiData -import Data.Kind - (Type) -- | A safe link datatype. -- The only way of constructing a 'Link' is using 'safeLink', which means any @@ -648,22 +645,3 @@ simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub) -- $setup -- >>> import Servant.API -- >>> import Data.Text (Text) - --- Erroring instance for 'HasLink' when a combinator is not fully applied -instance TypeError (PartialApplication -#if __GLASGOW_HASKELL__ >= 904 - @(Type -> Constraint) -#endif - HasLink arr) => HasLink ((arr :: a -> b) :> sub) - where - type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr) - toLink = error "unreachable" - --- Erroring instances for 'HasLink' for unknown API combinators -instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub -#if __GLASGOW_HASKELL__ >= 904 - @(Type -> Constraint) -#endif - HasLink ty) => HasLink (ty :> sub) - -instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api diff --git a/servant/src/Servant/Links/TypeErrors.hs b/servant/src/Servant/Links/TypeErrors.hs new file mode 100644 index 00000000..75233fae --- /dev/null +++ b/servant/src/Servant/Links/TypeErrors.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} + +#if __GLASGOW_HASKELL__ >= 904 +{-# LANGUAGE TypeApplications #-} +#endif + +-- | This module contains erroring instances for @Servant.Links.Internal@. +-- They are separated from the bulk of the code, because they raise "missing methods" +-- warnings. These warnings are expected, but ignoring them would lead to missing +-- relevant warnings in @Servant.Links.Internal@. Therefore, we put them in a separate +-- file, and ignore the warnings here. +module Servant.Links.TypeErrors () + where + +import Data.Constraint +import GHC.TypeLits + (TypeError) +import Prelude () +import Prelude.Compat + +import Servant.API.Sub + (type (:>)) +import Servant.API.TypeErrors +import Servant.Links.Internal + +#if __GLASGOW_HASKELL__ >= 904 +import Data.Kind (Type) +#endif + +-- Erroring instance for 'HasLink' when a combinator is not fully applied +instance TypeError (PartialApplication +#if __GLASGOW_HASKELL__ >= 904 + @(Type -> Constraint) +#endif + HasLink arr) => HasLink ((arr :: a -> b) :> sub) + where + type MkLink (arr :> sub) _ = TypeError (PartialApplication (HasLink :: * -> Constraint) arr) + toLink = error "unreachable" + +-- Erroring instances for 'HasLink' for unknown API combinators +instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub +#if __GLASGOW_HASKELL__ >= 904 + @(Type -> Constraint) +#endif + HasLink ty) => HasLink (ty :> sub) + +instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api