Move erroring instances of HasLink to separate file

This commit is contained in:
Nicolas BACQUEY 2022-03-17 16:07:41 +01:00
parent fd644b7cc8
commit 7ccc54612f
No known key found for this signature in database
GPG key ID: 518D364D061C12AC
4 changed files with 70 additions and 24 deletions

View file

@ -75,6 +75,10 @@ library
exposed-modules: exposed-modules:
Servant.Links Servant.Links
other-modules:
Servant.Links.Internal
Servant.Links.TypeErrors
-- Bundled with GHC: Lower bound to not force re-installs -- Bundled with GHC: Lower bound to not force re-installs
-- text and mtl are bundled starting with GHC-8.4 -- text and mtl are bundled starting with GHC-8.4
-- --

View file

@ -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 ()

View file

@ -100,7 +100,7 @@
-- `IsElem'` as a last resort. -- `IsElem'` as a last resort.
-- --
-- @since 0.14.1 -- @since 0.14.1
module Servant.Links ( module Servant.Links.Internal (
module Servant.API.TypeLevel, module Servant.API.TypeLevel,
-- * Building and using safe links -- * Building and using safe links
@ -141,7 +141,7 @@ import qualified Data.Text.Encoding as TE
import Data.Type.Bool import Data.Type.Bool
(If) (If)
import GHC.TypeLits import GHC.TypeLits
(KnownSymbol, TypeError, symbolVal) (KnownSymbol, symbolVal)
import Network.URI import Network.URI
(URI (..), escapeURIString, isUnreserved) (URI (..), escapeURIString, isUnreserved)
import Prelude () import Prelude ()
@ -184,7 +184,6 @@ import Servant.API.Stream
(Stream, StreamBody') (Stream, StreamBody')
import Servant.API.Sub import Servant.API.Sub
(type (:>)) (type (:>))
import Servant.API.TypeErrors
import Servant.API.TypeLevel import Servant.API.TypeLevel
import Servant.API.UVerb import Servant.API.UVerb
import Servant.API.Vault import Servant.API.Vault
@ -194,8 +193,6 @@ import Servant.API.Verbs
import Servant.API.WithNamedContext import Servant.API.WithNamedContext
(WithNamedContext) (WithNamedContext)
import Web.HttpApiData import Web.HttpApiData
import Data.Kind
(Type)
-- | A safe link datatype. -- | A safe link datatype.
-- The only way of constructing a 'Link' is using 'safeLink', which means any -- 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 -- $setup
-- >>> import Servant.API -- >>> import Servant.API
-- >>> import Data.Text (Text) -- >>> 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

View file

@ -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