@@ -1,13 +1,22 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
12{-# LANGUAGE ConstraintKinds #-}
3+{-# LANGUAGE CPP #-}
24{-# LANGUAGE DataKinds #-}
35{-# LANGUAGE FlexibleContexts #-}
46{-# LANGUAGE FlexibleInstances #-}
57{-# LANGUAGE FunctionalDependencies #-}
8+{-# LANGUAGE InstanceSigs #-}
69{-# LANGUAGE PolyKinds #-}
710{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE TypeApplications #-}
812{-# LANGUAGE TypeFamilies #-}
913{-# LANGUAGE TypeOperators #-}
1014{-# LANGUAGE UndecidableInstances #-}
15+
16+#if __GLASGOW_HASKELL__ >= 806
17+{-# LANGUAGE QuantifiedConstraints #-}
18+#endif
19+
1120{-# OPTIONS_HADDOCK not-home #-}
1221
1322-- | Type safe generation of internal links.
@@ -125,6 +134,7 @@ module Servant.Links (
125134) where
126135
127136import Data.List
137+import Data.Constraint
128138import Data.Proxy
129139 (Proxy (..))
130140import Data.Singletons.Bool
@@ -579,6 +589,36 @@ instance HasLink (Stream m status fr ct a) where
579589instance HasLink (UVerb m ct a) where
580590 type MkLink (UVerb m ct a) r = r
581591 toLink toA _ = toA
592+-- Instance for NamedRoutes combinator
593+
594+#if __GLASGOW_HASKELL__ >= 806
595+type GLinkConstraints routes a =
596+ ( MkLink (ToServant routes AsApi) a ~ ToServant routes (AsLink a)
597+ , GenericServant routes (AsLink a)
598+ )
599+
600+class GLink (routes :: * -> *) (a :: *) where
601+ proof :: Dict (GLinkConstraints routes a)
602+
603+instance GLinkConstraints routes a => GLink routes a where
604+ proof = Dict
605+
606+instance
607+ ( HasLink (ToServantApi routes)
608+ , forall a. GLink routes a
609+ ) => HasLink (NamedRoutes routes) where
610+
611+ type MkLink (NamedRoutes routes) a = routes (AsLink a)
612+
613+ toLink
614+ :: forall a. (Link -> a)
615+ -> Proxy (NamedRoutes routes)
616+ -> Link
617+ -> routes (AsLink a)
618+
619+ toLink toA _ l = case proof @routes @a of
620+ Dict -> fromServant $ toLink toA (Proxy @(ToServantApi routes)) l
621+#endif
582622
583623-- AuthProtext instances
584624instance HasLink sub => HasLink (AuthProtect tag :> sub) where