diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs index ef1dadfa..d3f79ed0 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/servant/src/Servant/Utils/Links.hs @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK not-home #-} -- | Type safe generation of internal links. @@ -176,11 +177,15 @@ safeLink safeLink _ endpoint = toLink endpoint (Link mempty mempty) -- | Construct a toLink for an endpoint. +-- +-- Default implementation for combinators not used in link e.g. headers. class HasLink endpoint where type MkLink endpoint + type MkLink endpoint = MkLink endpoint toLink :: Proxy endpoint -- ^ The API endpoint you would like to point to -> Link -> MkLink endpoint + toLink _ = toLink (Proxy :: Proxy endpoint) -- Naked symbol instance instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where @@ -240,17 +245,10 @@ instance (ToHttpApiData v, HasLink sub) toLink (Proxy :: Proxy sub) $ foldl' (flip $ addSegment . escape . Text.unpack . toUrlPiece) l vs -instance HasLink sub => HasLink (Header sym a :> sub) where - type MkLink (Header sym a :> sub) = MkLink sub - toLink _ = toLink (Proxy :: Proxy sub) - -instance HasLink sub => HasLink (RemoteHost :> sub) where - type MkLink (RemoteHost :> sub) = MkLink sub - toLink _ = toLink (Proxy :: Proxy sub) - -instance HasLink sub => HasLink (BasicAuth realm a :> sub) where - type MkLink (BasicAuth realm a :> sub) = MkLink sub - toLink _ = toLink (Proxy :: Proxy sub) +instance HasLink sub => HasLink (Header sym a :> sub) +instance HasLink sub => HasLink (RemoteHost :> sub) +instance HasLink sub => HasLink (BasicAuth realm a :> sub) +instance HasLink sub => HasLink (AuthProtect tag :> sub) -- Verb (terminal) instances instance HasLink (Verb m s ct a) where @@ -260,8 +258,3 @@ instance HasLink (Verb m s ct a) where instance HasLink Raw where type MkLink Raw = Link toLink _ = id - --- AuthProtext instances -instance HasLink sub => HasLink (AuthProtect tag :> sub) where - type MkLink (AuthProtect tag :> sub) = MkLink sub - toLink _ = toLink (Proxy :: Proxy sub)