git.iko.soy/typeable/servant
on master help sign in
Add constrainty Link implementation.
commit6785717d8c5a5ffe5057d729731a39236bf695a2 authorChristian Marie <christian@ponies.io> dateTue 27 Jan 2015, 16:06 (12 years ago) parent7336ecb
1 file changed+16−18
src/Servant/Utils/Links.hs+16−18
src/Servant/Utils/Links.hs+16−18
@@ -1,4 +1,5 @@
11{-# LANGUAGE PolyKinds #-}
2+{-# LANGUAGE ConstraintKinds #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE FlexibleInstances #-}
45{-# LANGUAGE TypeFamilies #-}
@@ -71,6 +72,7 @@ module Servant.Utils.Links (
7172
7273import Data.Proxy ( Proxy(..) )
7374import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
75+import GHC.Exts(Constraint)
7476
7577import Servant.API.Capture ( Capture )
7678import Servant.API.ReqBody ( ReqBody )
@@ -85,19 +87,16 @@ import Servant.API.Raw ( Raw )
8587import Servant.API.Alternative ( type (:<|>) )
8688
8789
88−type family Or a b where
89− Or 'False 'False = 'False
90− Or 'True b = 'True
91− Or a 'True = 'True
90+type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
91+ Or () b = ()
92+ Or a () = ()
9293
93−type family And a b where
94− And 'True 'True = 'True
95− And a 'False = 'False
96− And 'False b = 'False
94+type family And (a :: Constraint) (b :: Constraint) :: Constraint where
95+ And () () = ()
9796
98−type family IsElem' a s :: Bool
97+type family IsElem' a s :: Constraint
9998
100−type family IsElem a s where
99+type family IsElem a s :: Constraint where
101100 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
102101 IsElem (e :> sa) (e :> sb) = IsElem sa sb
103102 IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
@@ -108,21 +107,20 @@ type family IsElem a s where
108107 IsElem sa (MatrixParam x y :> sb) = IsElem sa sb
109108 IsElem sa (MatrixParams x y :> sb) = IsElem sa sb
110109 IsElem sa (MatrixFlag x :> sb) = IsElem sa sb
111− IsElem e e = 'True
110+ IsElem e e = ()
112111 IsElem e a = IsElem' e a
113112
114−type family IsLink'' l where
113+type family IsLink'' l :: Constraint where
115114 IsLink'' (e :> Get x) = IsLink' e
116115 IsLink'' (e :> Post x) = IsLink' e
117116 IsLink'' (e :> Put x) = IsLink' e
118117 IsLink'' (e :> Delete) = IsLink' e
119118 IsLink'' (e :> Raw) = IsLink' e
120− IsLink'' a = 'False
121119
122−type family IsLink' e where
123− IsLink' (f :: Symbol) = 'True
120+type family IsLink' e :: Constraint where
121+ IsLink' (f :: Symbol) = ()
124122
125−type family IsLink e where
123+type family IsLink e :: Constraint where
126124 IsLink (a :> b) = Or (And (IsLink' a) (IsLink'' b))
127125 (IsLink'' (a :> b))
128126
@@ -133,8 +131,8 @@ class ValidLinkIn f s where
133131 mkLink :: f -> s -> Link -- ^ This function will only typecheck if `f`
134132 -- is an URI within `s`
135133
136−instance ( IsElem f s ~ 'True
137− , IsLink f ~ 'True
134+instance ( IsElem f s
135+ , IsLink f
138136 , VLinkHelper f) => ValidLinkIn f s where
139137 mkLink _ _ = Link (vlh (Proxy :: Proxy f))
140138