Export open type family IsElem' to allow custom API types in Links.

Also:
* Export unLink function to be able to use the contents of a Link
* Add Raw to the isLink'' family.
This commit is contained in:
Christian Marie 2015-01-23 17:44:06 +11:00
parent 4eb943021f
commit 7336ecbaeb

View file

@ -6,29 +6,49 @@
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
-- | Type safe internal links. -- | Type safe internal links.
-- --
-- Provides the function 'mkLink': -- Provides the function 'mkLink':
-- --
-- @ -- @
-- type API = Proxy ("hello" :> Get Int -- {-# LANGUAGE DataKinds #-}
-- :<|> "bye" :> QueryParam "name" String :> Post Bool) -- {-# LANGUAGE TypeFamilies #-}
-- {-# LANGUAGE TypeOperators #-}
--
-- import Servant.API
-- import Servant.Utils.Links
--
-- -- You might want to put some custom types in your API
-- data Thing = Thing
--
-- -- If you want these to form part of a valid URL, just add them to the
-- -- open type family IsElem' like so:
-- type instance IsElem' e (Thing :> s) = IsElem e s
--
-- type API = "hello" :> Thing :> Get Int
-- :<|> "bye" :> QueryParam "name" String :> Post Bool
-- --
-- api :: API -- api :: API
-- api = proxy -- api = undefined
-- --
-- link1 :: Proxy ("hello" :> Get Int) -- link1 :: "hello" :> Get Int
-- link1 = proxy -- link1 = undefined
-- --
-- link2 :: Proxy ("hello" :> Delete) -- link2 :: "hello" :> Delete
-- link2 = proxy -- link2 = undefined
-- --
-- mkLink link1 API -- typechecks, returns 'Link "/hello"' -- main :: IO ()
-- main =
-- -- typechecks, prints "/hello"'
-- let Link str = mkLink link1 api
-- in putStrLn str
-- --
-- mkLink link2 API -- doesn't typecheck -- -- doesn't typecheck
-- -- mkLink link2 api
-- @ -- @
-- --
-- That is, 'mkLink' takes two arguments, a link proxy and a sitemap, and -- That is, 'mkLink' takes two arguments, a link and a sitemap, and
-- returns a 'Link', but only typechecks if the link proxy is a valid link, -- returns a 'Link', but only typechecks if the link proxy is a valid link,
-- and part of the sitemap. -- and part of the sitemap.
-- --
@ -37,7 +57,7 @@ module Servant.Utils.Links (
-- * Link and mkLink -- * Link and mkLink
-- | The only end-user utilities -- | The only end-user utilities
mkLink mkLink
, Link , Link, unLink
-- * Internal -- * Internal
-- | These functions will likely only be of interest if you are writing -- | These functions will likely only be of interest if you are writing
-- more API combinators and would like to extend the behavior of -- more API combinators and would like to extend the behavior of
@ -45,8 +65,9 @@ module Servant.Utils.Links (
, ValidLinkIn() , ValidLinkIn()
, VLinkHelper(..) , VLinkHelper(..)
, IsElem , IsElem
, IsElem'
, IsLink , IsLink
)where ) where
import Data.Proxy ( Proxy(..) ) import Data.Proxy ( Proxy(..) )
import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal ) import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
@ -60,6 +81,7 @@ import Servant.API.Post ( Post )
import Servant.API.Put ( Put ) import Servant.API.Put ( Put )
import Servant.API.Delete ( Delete ) import Servant.API.Delete ( Delete )
import Servant.API.Sub ( type (:>) ) import Servant.API.Sub ( type (:>) )
import Servant.API.Raw ( Raw )
import Servant.API.Alternative ( type (:<|>) ) import Servant.API.Alternative ( type (:<|>) )
@ -73,6 +95,8 @@ type family And a b where
And a 'False = 'False And a 'False = 'False
And 'False b = 'False And 'False b = 'False
type family IsElem' a s :: Bool
type family IsElem a s where type family IsElem a s where
IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb) IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
IsElem (e :> sa) (e :> sb) = IsElem sa sb IsElem (e :> sa) (e :> sb) = IsElem sa sb
@ -85,13 +109,14 @@ type family IsElem a s where
IsElem sa (MatrixParams x y :> sb) = IsElem sa sb IsElem sa (MatrixParams x y :> sb) = IsElem sa sb
IsElem sa (MatrixFlag x :> sb) = IsElem sa sb IsElem sa (MatrixFlag x :> sb) = IsElem sa sb
IsElem e e = 'True IsElem e e = 'True
IsElem e a = 'False IsElem e a = IsElem' e a
type family IsLink'' l where type family IsLink'' l where
IsLink'' (e :> Get x) = IsLink' e IsLink'' (e :> Get x) = IsLink' e
IsLink'' (e :> Post x) = IsLink' e IsLink'' (e :> Post x) = IsLink' e
IsLink'' (e :> Put x) = IsLink' e IsLink'' (e :> Put x) = IsLink' e
IsLink'' (e :> Delete) = IsLink' e IsLink'' (e :> Delete) = IsLink' e
IsLink'' (e :> Raw) = IsLink' e
IsLink'' a = 'False IsLink'' a = 'False
type family IsLink' e where type family IsLink' e where
@ -116,7 +141,7 @@ instance ( IsElem f s ~ 'True
-- | A safe link datatype. -- | A safe link datatype.
-- The only way of constructing a 'Link' is using 'mkLink', which means any -- The only way of constructing a 'Link' is using 'mkLink', which means any
-- 'Link' is guaranteed to be part of the mentioned API. -- 'Link' is guaranteed to be part of the mentioned API.
data Link = Link String deriving Show newtype Link = Link { unLink :: String } deriving Show
class VLinkHelper f where class VLinkHelper f where
vlh :: forall proxy. proxy f -> String vlh :: forall proxy. proxy f -> String