git.iko.soy/servant
on master help sign in
Move type-level operations from Utils.Links to API.TypeLevel
09c8464Nickolay Kudasov
servant/servant.cabal+1
compare with master
unifiedsplit
@@ -47,6 +47,7 @@ library
47 Servant.API.ReqBody
47 Servant.API.ReqBody
48 Servant.API.ResponseHeaders
48 Servant.API.ResponseHeaders
49 Servant.API.Sub
49 Servant.API.Sub
50+ Servant.API.TypeLevel
50 Servant.API.Vault
51 Servant.API.Vault
51 Servant.API.Verbs
52 Servant.API.Verbs
52 Servant.API.WithNamedContext
53 Servant.API.WithNamedContext
servant/src/Servant/API/TypeLevel.hsnew file+78
@@ -0,0 +1,78 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE KindSignatures #-}
3+{-# LANGUAGE PolyKinds #-}
4+{-# LANGUAGE TypeFamilies #-}
5+{-# LANGUAGE TypeOperators #-}
6+{-# LANGUAGE UndecidableInstances #-}
7+module Servant.API.TypeLevel where
8+
9+import GHC.Exts(Constraint)
10+import Servant.API.Capture ( Capture )
11+import Servant.API.ReqBody ( ReqBody )
12+import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
13+import Servant.API.Header ( Header )
14+import Servant.API.Verbs ( Verb )
15+import Servant.API.Sub ( type (:>) )
16+import Servant.API.Alternative ( type (:<|>) )
17+
18+-- * API predicates
19+
20+-- | You may use this type family to tell the type checker that your custom
21+-- type may be skipped as part of a link. This is useful for things like
22+-- 'QueryParam' that are optional in a URI and do not affect them if they are
23+-- omitted.
24+--
25+-- >>> data CustomThing
26+-- >>> type instance IsElem' e (CustomThing :> s) = IsElem e s
27+--
28+-- Note that 'IsElem' is called, which will mutually recurse back to `IsElem'`
29+-- if it exhausts all other options again.
30+--
31+-- Once you have written a HasLink instance for CustomThing you are ready to
32+-- go.
33+type family IsElem' a s :: Constraint
34+
35+-- | Closed type family, check if @endpoint@ is within @api@.
36+-- Uses @'IsElem''@.
37+type family IsElem endpoint api :: Constraint where
38+ IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
39+ IsElem (e :> sa) (e :> sb) = IsElem sa sb
40+ IsElem sa (Header sym x :> sb) = IsElem sa sb
41+ IsElem sa (ReqBody y x :> sb) = IsElem sa sb
42+ IsElem (CaptureAll z y :> sa) (CaptureAll x y :> sb)
43+ = IsElem sa sb
44+ IsElem (Capture z y :> sa) (Capture x y :> sb)
45+ = IsElem sa sb
46+ IsElem sa (QueryParam x y :> sb) = IsElem sa sb
47+ IsElem sa (QueryParams x y :> sb) = IsElem sa sb
48+ IsElem sa (QueryFlag x :> sb) = IsElem sa sb
49+ IsElem (Verb m s ct typ) (Verb m s ct' typ)
50+ = IsSubList ct ct'
51+ IsElem e e = ()
52+ IsElem e a = IsElem' e a
53+
54+-- * Helpers
55+
56+-- ** Lists
57+
58+type family IsSubList a b :: Constraint where
59+ IsSubList '[] b = ()
60+ IsSubList (x ': xs) y = Elem x y `And` IsSubList xs y
61+
62+type family Elem e es :: Constraint where
63+ Elem x (x ': xs) = ()
64+ Elem y (x ': xs) = Elem y xs
65+
66+-- ** Logic
67+
68+-- | If either a or b produce an empty constraint, produce an empty constraint.
69+type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
70+ -- This works because of:
71+ -- https://ghc.haskell.org/trac/ghc/wiki/NewAxioms/CoincidentOverlap
72+ Or () b = ()
73+ Or a () = ()
74+
75+-- | If both a or b produce an empty constraint, produce an empty constraint.
76+type family And (a :: Constraint) (b :: Constraint) :: Constraint where
77+ And () () = ()
78+
servant/src/Servant/Utils/Links.hs+3−59
@@ -6,7 +6,6 @@
6{-# LANGUAGE ScopedTypeVariables #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeOperators #-}
8{-# LANGUAGE TypeOperators #-}
9−{-# LANGUAGE UndecidableInstances #-}
10{-# OPTIONS_HADDOCK not-home #-}
9{-# OPTIONS_HADDOCK not-home #-}
11
10
12-- | Type safe generation of internal links.
11-- | Type safe generation of internal links.
@@ -79,6 +78,8 @@
79-- bad_link under api after trying the open (but empty) type family
78-- bad_link under api after trying the open (but empty) type family
80-- `IsElem'` as a last resort.
79-- `IsElem'` as a last resort.
81module Servant.Utils.Links (
80module Servant.Utils.Links (
81+ module Servant.API.TypeLevel,
82+
82 -- * Building and using safe links
83 -- * Building and using safe links
83 --
84 --
84 -- | Note that 'URI' is Network.URI.URI from the network-uri package.
85 -- | Note that 'URI' is Network.URI.URI from the network-uri package.
@@ -88,10 +89,6 @@ module Servant.Utils.Links (
88 , HasLink(..)
89 , HasLink(..)
89 , linkURI
90 , linkURI
90 , Link
91 , Link
91− , IsElem'
92− -- * Illustrative exports
93− , IsElem
94− , Or
95) where
92) where
96
93
97import Data.List
94import Data.List
@@ -99,7 +96,6 @@ import Data.Monoid.Compat ( (<>) )
99import Data.Proxy ( Proxy(..) )
96import Data.Proxy ( Proxy(..) )
100import qualified Data.Text as Text
97import qualified Data.Text as Text
101import qualified Data.Text.Encoding as TE
98import qualified Data.Text.Encoding as TE
102−import GHC.Exts (Constraint)
103import GHC.TypeLits ( KnownSymbol, symbolVal )
99import GHC.TypeLits ( KnownSymbol, symbolVal )
104import Network.URI ( URI(..), escapeURIString, isUnreserved )
100import Network.URI ( URI(..), escapeURIString, isUnreserved )
105import Prelude ()
101import Prelude ()
@@ -115,7 +111,7 @@ import Servant.API.RemoteHost ( RemoteHost )
115import Servant.API.Verbs ( Verb )
111import Servant.API.Verbs ( Verb )
116import Servant.API.Sub ( type (:>) )
112import Servant.API.Sub ( type (:>) )
117import Servant.API.Raw ( Raw )
113import Servant.API.Raw ( Raw )
118−import Servant.API.Alternative ( type (:<|>) )
114+import Servant.API.TypeLevel
119
115
120-- | A safe link datatype.
116-- | A safe link datatype.
121-- The only way of constructing a 'Link' is using 'safeLink', which means any
117-- The only way of constructing a 'Link' is using 'safeLink', which means any
@@ -131,58 +127,6 @@ instance ToHttpApiData Link where
131 let uri = linkURI l
127 let uri = linkURI l
132 in Text.pack $ uriPath uri ++ uriQuery uri
128 in Text.pack $ uriPath uri ++ uriQuery uri
133
129
134−-- | If either a or b produce an empty constraint, produce an empty constraint.
135−type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
136− -- This works because of:
137− -- https://ghc.haskell.org/trac/ghc/wiki/NewAxioms/CoincidentOverlap
138− Or () b = ()
139− Or a () = ()
140−
141−-- | If both a or b produce an empty constraint, produce an empty constraint.
142−type family And (a :: Constraint) (b :: Constraint) :: Constraint where
143− And () () = ()
144−
145−-- | You may use this type family to tell the type checker that your custom
146−-- type may be skipped as part of a link. This is useful for things like
147−-- 'QueryParam' that are optional in a URI and do not affect them if they are
148−-- omitted.
149−--
150−-- >>> data CustomThing
151−-- >>> type instance IsElem' e (CustomThing :> s) = IsElem e s
152−--
153−-- Note that 'IsElem' is called, which will mutually recurse back to `IsElem'`
154−-- if it exhausts all other options again.
155−--
156−-- Once you have written a HasLink instance for CustomThing you are ready to
157−-- go.
158−type family IsElem' a s :: Constraint
159−
160−-- | Closed type family, check if endpoint is within api
161−type family IsElem endpoint api :: Constraint where
162− IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
163− IsElem (e :> sa) (e :> sb) = IsElem sa sb
164− IsElem sa (Header sym x :> sb) = IsElem sa sb
165− IsElem sa (ReqBody y x :> sb) = IsElem sa sb
166− IsElem (Capture z y :> sa) (Capture x y :> sb)
167− = IsElem sa sb
168− IsElem (CaptureAll z y :> sa) (CaptureAll x y :> sb)
169− = IsElem sa sb
170− IsElem sa (QueryParam x y :> sb) = IsElem sa sb
171− IsElem sa (QueryParams x y :> sb) = IsElem sa sb
172− IsElem sa (QueryFlag x :> sb) = IsElem sa sb
173− IsElem (Verb m s ct typ) (Verb m s ct' typ)
174− = IsSubList ct ct'
175− IsElem e e = ()
176− IsElem e a = IsElem' e a
177−
178−type family IsSubList a b :: Constraint where
179− IsSubList '[] b = ()
180− IsSubList (x ': xs) y = Elem x y `And` IsSubList xs y
181−
182−type family Elem e es :: Constraint where
183− Elem x (x ': xs) = ()
184− Elem y (x ': xs) = Elem y xs
185−
186-- Phantom types for Param
130-- Phantom types for Param
187data Query
131data Query
188
132
servant/test/Servant/Utils/LinksSpec.hs+1
@@ -10,6 +10,7 @@ import Test.Hspec (Expectation, Spec, describe, it,
10import Data.String (fromString)
10import Data.String (fromString)
11
11
12import Servant.API
12import Servant.API
13+import Servant.API.TypeLevel
13
14
14type TestApi =
15type TestApi =
15 -- Capture and query params
16 -- Capture and query params