git.iko.soy/servant
on bec10dd help sign in
servant/src/Servant/API/Elem.hs
83 lines 2.4 kB history raw
1{-# LANGUAGE PolyKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE FunctionalDependencies #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE UndecidableInstances #-}
9module Servant.API.Elem where
11import Data.Proxy
12import GHC.TypeLits
14import Servant.API.Capture
15import Servant.API.ReqBody
16import Servant.API.QueryParam
17import Servant.API.Get
18import Servant.API.Post
19import Servant.API.Put
20import Servant.API.Delete
21import Servant.API.Sub
22import Servant.API.Alternative
25type family Or a b where
26 Or 'False 'False = 'False
27 Or 'True b = 'True
28 Or a 'True = 'True
30type family And a b where
31 And 'True 'True = 'True
32 And a 'False = 'False
33 And 'False b = 'False
35type family IsElem a s where
36 IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
37 IsElem (e :> sa) (e :> sb) = IsElem sa sb
38 IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
39 IsElem sa (ReqBody x :> sb) = IsElem sa sb
40 IsElem sa (QueryParam x y :> sb) = IsElem sa sb
41 IsElem e e = 'True
42 IsElem e a = 'False
44type family IsLink'' l where
45 IsLink'' (e :> Get x) = IsLink' e
46 IsLink'' (e :> Post x) = IsLink' e
47 IsLink'' (e :> Put x) = IsLink' e
48 IsLink'' (e :> Delete) = IsLink' e
49 IsLink'' a = 'False
51type family IsLink' e where
52 IsLink' (f :: Symbol) = 'True
54type family IsLink e where
55 IsLink (a :> b) = Or (And (IsLink' a) (IsLink'' b))
56 (IsLink'' (a :> b))
59-- | The 'ValidLinkIn f s' constraint holds when 's' is an API that
60-- contains 'f', and 'f' is a link.
61class ValidLinkIn f s where
62 mkLink :: f -> s -> Link -- ^ This function will only typecheck if `f`
63 -- is an URI within `s`
65instance ( IsElem f s ~ 'True
66 , IsLink f ~ 'True
67 , VLinkHelper f) => ValidLinkIn f s where
68 mkLink _ _ = Link (vlh (Proxy :: Proxy f))
70data Link = Link String deriving Show
72class VLinkHelper f where
73 vlh :: forall proxy. proxy f -> String
75instance (KnownSymbol s, VLinkHelper e) => VLinkHelper (s :> e) where
76 vlh _ = "/" ++ symbolVal (Proxy :: Proxy s) ++ vlh (Proxy :: Proxy e)
78instance VLinkHelper (Get x) where
79 vlh _ = ""
81instance VLinkHelper (Post x) where
82 vlh _ = ""