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:
parent
4eb943021f
commit
7336ecbaeb
1 changed files with 40 additions and 15 deletions
|
@ -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
|
||||||
|
@ -109,14 +134,14 @@ class ValidLinkIn f s where
|
||||||
-- is an URI within `s`
|
-- is an URI within `s`
|
||||||
|
|
||||||
instance ( IsElem f s ~ 'True
|
instance ( IsElem f s ~ 'True
|
||||||
, IsLink f ~ 'True
|
, IsLink f ~ 'True
|
||||||
, VLinkHelper f) => ValidLinkIn f s where
|
, VLinkHelper f) => ValidLinkIn f s where
|
||||||
mkLink _ _ = Link (vlh (Proxy :: Proxy f))
|
mkLink _ _ = Link (vlh (Proxy :: Proxy f))
|
||||||
|
|
||||||
-- | 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
|
||||||
|
|
Loading…
Reference in a new issue