@@ -6,29 +6,49 @@
66{-# LANGUAGE FunctionalDependencies #-}
77{-# LANGUAGE ScopedTypeVariables #-}
88{-# LANGUAGE UndecidableInstances #-}
9+
910-- | Type safe internal links.
1011--
1112-- Provides the function 'mkLink':
1213--
1314-- @
14−-- type API = Proxy ("hello" :> Get Int
15−-- :<|> "bye" :> QueryParam "name" String :> Post Bool)
15+-- {-# LANGUAGE DataKinds #-}
16+-- {-# LANGUAGE TypeFamilies #-}
17+-- {-# LANGUAGE TypeOperators #-}
18+--
19+-- import Servant.API
20+-- import Servant.Utils.Links
21+--
22+-- -- You might want to put some custom types in your API
23+-- data Thing = Thing
24+--
25+-- -- If you want these to form part of a valid URL, just add them to the
26+-- -- open type family IsElem' like so:
27+-- type instance IsElem' e (Thing :> s) = IsElem e s
28+--
29+-- type API = "hello" :> Thing :> Get Int
30+-- :<|> "bye" :> QueryParam "name" String :> Post Bool
1631--
1732-- api :: API
18−-- api = proxy
33+-- api = undefined
1934--
20−-- link1 :: Proxy ("hello" :> Get Int)
21−-- link1 = proxy
35+-- link1 :: "hello" :> Get Int
36+-- link1 = undefined
2237--
23−-- link2 :: Proxy ("hello" :> Delete)
24−-- link2 = proxy
38+-- link2 :: "hello" :> Delete
39+-- link2 = undefined
2540--
26−-- mkLink link1 API -- typechecks, returns 'Link "/hello"'
41+-- main :: IO ()
42+-- main =
43+-- -- typechecks, prints "/hello"'
44+-- let Link str = mkLink link1 api
45+-- in putStrLn str
2746--
28−-- mkLink link2 API -- doesn't typecheck
47+-- -- doesn't typecheck
48+-- -- mkLink link2 api
2949-- @
3050--
31−-- That is, 'mkLink' takes two arguments, a link proxy and a sitemap, and
51+-- That is, 'mkLink' takes two arguments, a link and a sitemap, and
3252-- returns a 'Link', but only typechecks if the link proxy is a valid link,
3353-- and part of the sitemap.
3454--
@@ -37,7 +57,7 @@ module Servant.Utils.Links (
3757 -- * Link and mkLink
3858 -- | The only end-user utilities
3959 mkLink
40− , Link
60+ , Link, unLink
4161 -- * Internal
4262 -- | These functions will likely only be of interest if you are writing
4363 -- more API combinators and would like to extend the behavior of
@@ -45,8 +65,9 @@ module Servant.Utils.Links (
4565 , ValidLinkIn()
4666 , VLinkHelper(..)
4767 , IsElem
68+ , IsElem'
4869 , IsLink
49− )where
70+ ) where
5071
5172import Data.Proxy ( Proxy(..) )
5273import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
@@ -60,6 +81,7 @@ import Servant.API.Post ( Post )
6081import Servant.API.Put ( Put )
6182import Servant.API.Delete ( Delete )
6283import Servant.API.Sub ( type (:>) )
84+import Servant.API.Raw ( Raw )
6385import Servant.API.Alternative ( type (:<|>) )
6486
6587
@@ -73,6 +95,8 @@ type family And a b where
7395 And a 'False = 'False
7496 And 'False b = 'False
7597
98+type family IsElem' a s :: Bool
99+
76100type family IsElem a s where
77101 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
78102 IsElem (e :> sa) (e :> sb) = IsElem sa sb
@@ -85,13 +109,14 @@ type family IsElem a s where
85109 IsElem sa (MatrixParams x y :> sb) = IsElem sa sb
86110 IsElem sa (MatrixFlag x :> sb) = IsElem sa sb
87111 IsElem e e = 'True
88− IsElem e a = 'False
112+ IsElem e a = IsElem' e a
89113
90114type family IsLink'' l where
91115 IsLink'' (e :> Get x) = IsLink' e
92116 IsLink'' (e :> Post x) = IsLink' e
93117 IsLink'' (e :> Put x) = IsLink' e
94118 IsLink'' (e :> Delete) = IsLink' e
119+ IsLink'' (e :> Raw) = IsLink' e
95120 IsLink'' a = 'False
96121
97122type family IsLink' e where
@@ -109,14 +134,14 @@ class ValidLinkIn f s where
109134 -- is an URI within `s`
110135
111136instance ( IsElem f s ~ 'True
112− , IsLink f ~ 'True
137+ , IsLink f ~ 'True
113138 , VLinkHelper f) => ValidLinkIn f s where
114139 mkLink _ _ = Link (vlh (Proxy :: Proxy f))
115140
116141-- | A safe link datatype.
117142-- The only way of constructing a 'Link' is using 'mkLink', which means any
118143-- 'Link' is guaranteed to be part of the mentioned API.
119−data Link = Link String deriving Show
144+newtype Link = Link { unLink :: String } deriving Show
120145
121146class VLinkHelper f where
122147 vlh :: forall proxy. proxy f -> String