git.iko.soy/servant
on master help sign in
Move type-level operations from Utils.Links to API.TypeLevel
commit09c8464a5a5c6ce99f4b5a2f7f80de8fb6927e95 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateWed 20 Jan 2016, 17:39 (11 years ago) parent48014f4
4 files changed+83−59
compare with master
unifiedsplit
servant/servant.cabal+1 servant/src/Servant/API/TypeLevel.hs+78 servant/src/Servant/Utils/Links.hs+3−59 servant/test/Servant/Utils/LinksSpec.hs+1
servant/servant.cabal+1
@@ -47,6 +47,7 @@ library
4747 Servant.API.ReqBody
4848 Servant.API.ResponseHeaders
4949 Servant.API.Sub
50+ Servant.API.TypeLevel
5051 Servant.API.Vault
5152 Servant.API.Verbs
5253 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 @@
66{-# LANGUAGE ScopedTypeVariables #-}
77{-# LANGUAGE TypeFamilies #-}
88{-# LANGUAGE TypeOperators #-}
9−{-# LANGUAGE UndecidableInstances #-}
109{-# OPTIONS_HADDOCK not-home #-}
1110
1211-- | Type safe generation of internal links.
@@ -79,6 +78,8 @@
7978-- bad_link under api after trying the open (but empty) type family
8079-- `IsElem'` as a last resort.
8180module Servant.Utils.Links (
81+ module Servant.API.TypeLevel,
82+
8283 -- * Building and using safe links
8384 --
8485 -- | Note that 'URI' is Network.URI.URI from the network-uri package.
@@ -88,10 +89,6 @@ module Servant.Utils.Links (
8889 , HasLink(..)
8990 , linkURI
9091 , Link
91− , IsElem'
92− -- * Illustrative exports
93− , IsElem
94− , Or
9592) where
9693
9794import Data.List
@@ -99,7 +96,6 @@ import Data.Monoid.Compat ( (<>) )
9996import Data.Proxy ( Proxy(..) )
10097import qualified Data.Text as Text
10198import qualified Data.Text.Encoding as TE
102−import GHC.Exts (Constraint)
10399import GHC.TypeLits ( KnownSymbol, symbolVal )
104100import Network.URI ( URI(..), escapeURIString, isUnreserved )
105101import Prelude ()
@@ -115,7 +111,7 @@ import Servant.API.RemoteHost ( RemoteHost )
115111import Servant.API.Verbs ( Verb )
116112import Servant.API.Sub ( type (:>) )
117113import Servant.API.Raw ( Raw )
118−import Servant.API.Alternative ( type (:<|>) )
114+import Servant.API.TypeLevel
119115
120116-- | A safe link datatype.
121117-- The only way of constructing a 'Link' is using 'safeLink', which means any
@@ -131,58 +127,6 @@ instance ToHttpApiData Link where
131127 let uri = linkURI l
132128 in Text.pack $ uriPath uri ++ uriQuery uri
133129
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−
186130-- Phantom types for Param
187131data Query
188132
servant/test/Servant/Utils/LinksSpec.hs+1
@@ -10,6 +10,7 @@ import Test.Hspec (Expectation, Spec, describe, it,
1010import Data.String (fromString)
1111
1212import Servant.API
13+import Servant.API.TypeLevel
1314
1415type TestApi =
1516 -- Capture and query params