git.iko.soy/servant
on master help sign in
Implement HasLink instance for NamedRoutes
b033871Gaël Deest
servant/servant.cabal+1
compare with master
unifiedsplit
@@ -80,6 +80,7 @@ library
80 build-depends:
80 build-depends:
81 base >= 4.9 && < 4.16
81 base >= 4.9 && < 4.16
82 , bytestring >= 0.10.8.1 && < 0.12
82 , bytestring >= 0.10.8.1 && < 0.12
83+ , constraints
83 , mtl >= 2.2.2 && < 2.3
84 , mtl >= 2.2.2 && < 2.3
84 , sop-core >= 0.4.0.0 && < 0.6
85 , sop-core >= 0.4.0.0 && < 0.6
85 , transformers >= 0.5.2.0 && < 0.6
86 , transformers >= 0.5.2.0 && < 0.6
servant/src/Servant/Links.hs+40
@@ -1,13 +1,22 @@
1+{-# LANGUAGE AllowAmbiguousTypes #-}
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
3+{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FunctionalDependencies #-}
7{-# LANGUAGE FunctionalDependencies #-}
8+{-# LANGUAGE InstanceSigs #-}
6{-# LANGUAGE PolyKinds #-}
9{-# LANGUAGE PolyKinds #-}
7{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE TypeApplications #-}
8{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE TypeOperators #-}
10{-# LANGUAGE UndecidableInstances #-}
14{-# LANGUAGE UndecidableInstances #-}
15+
16+#if __GLASGOW_HASKELL__ >= 806
17+{-# LANGUAGE QuantifiedConstraints #-}
18+#endif
19+
11{-# OPTIONS_HADDOCK not-home #-}
20{-# OPTIONS_HADDOCK not-home #-}
12
21
13-- | Type safe generation of internal links.
22-- | Type safe generation of internal links.
@@ -125,6 +134,7 @@ module Servant.Links (
125) where
134) where
126
135
127import Data.List
136import Data.List
137+import Data.Constraint
128import Data.Proxy
138import Data.Proxy
129 (Proxy (..))
139 (Proxy (..))
130import Data.Singletons.Bool
140import Data.Singletons.Bool
@@ -579,6 +589,36 @@ instance HasLink (Stream m status fr ct a) where
579instance HasLink (UVerb m ct a) where
589instance HasLink (UVerb m ct a) where
580 type MkLink (UVerb m ct a) r = r
590 type MkLink (UVerb m ct a) r = r
581 toLink toA _ = toA
591 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
582
622
583-- AuthProtext instances
623-- AuthProtext instances
584instance HasLink sub => HasLink (AuthProtect tag :> sub) where
624instance HasLink sub => HasLink (AuthProtect tag :> sub) where