eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add typeclass default for HasLink.

Browse source
This commit is contained in:
Mikkel Christiansen 2017-03-28 20:39:58 +02:00
parent f05b394261
commit 5159688d50
1 changed files with 9 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
servant/src/Servant/Utils/Links.hs
View file

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