diff --git a/src/Servant/QQ.hs b/src/Servant/QQ.hs index 3cd50617..1db7e416 100644 --- a/src/Servant/QQ.hs +++ b/src/Servant/QQ.hs @@ -72,7 +72,8 @@ data PathElemE data OptsE data SitemapE - +sitemap = undefined +{- data Validation e a = Failure e | Success a @@ -93,13 +94,13 @@ data Exp a where data ParseError = ParseError Int String parseEverything :: String -> Exp SitemapE -parseEverything str = removeComments <$> lines str +parseEverything str = undefined {-removeComments <$> lines str where removeComments = takeWhile (/= '#') parseLines _ [] = [] parseLines lineno (x:xs) = case opts of - [] -> (parseUrlLine x):parseLines rest - xs -> (parseUrlLine x `AddOpts` - where (opts, rest) = span (startsWith ' ') xs + [] -> (parseUrlLine x):parseLines rest + xs -> undefined + where (opts, rest) = span (startsWith ' ') xs -} @@ -340,3 +341,4 @@ sitemap = QuasiQuoter { quoteExp = undefined Right st -> return st , quoteDec = undefined } +-} diff --git a/src/Servant/Utils/Links.hs b/src/Servant/Utils/Links.hs index baf700a1..52a8b08c 100644 --- a/src/Servant/Utils/Links.hs +++ b/src/Servant/Utils/Links.hs @@ -136,6 +136,10 @@ type family Or (a :: Constraint) (b :: Constraint) :: Constraint where Or () b = () Or a () = () +-- | If both a or b produce an empty constraint, produce an empty constraint. +type family And (a :: Constraint) (b :: Constraint) :: Constraint where + And () () = () + -- | You may use this type family to tell the type checker that your custom type -- may be skipped as part of a link. This is useful for things like -- 'QueryParam' that are optional in a URI and do not affect them if they are @@ -164,29 +168,19 @@ type family IsElem endpoint api :: Constraint where IsElem sa (MatrixParam x y :> sb) = IsElem sa sb IsElem sa (MatrixParams x y :> sb) = IsElem sa sb IsElem sa (MatrixFlag x :> sb) = IsElem sa sb - IsElem e e = () - IsElem e a = IsElem' e a IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct' IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct' IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct' - IsElem e e = 'True - IsElem e a = 'False + IsElem e e = () + IsElem e a = IsElem' e a -type family IsSubList a b where - IsSubList '[] b = 'True - IsSubList '[x] (x ': xs) = 'True +type family IsSubList a b :: Constraint where + IsSubList '[] b = () + IsSubList '[x] (x ': xs) = () IsSubList '[x] (y ': ys) = IsSubList '[x] ys IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y - IsSubList a b = 'False - -type family IsLink'' l where - IsLink'' (e :> Get cts x) = IsLink' e - IsLink'' (e :> Post cts x) = IsLink' e - IsLink'' (e :> Put cts x) = IsLink' e - IsLink'' (e :> Delete) = IsLink' e - IsLink'' a = 'False - + IsSubList a b = 'True ~ 'False -- Phantom types for Param data Matrix @@ -343,7 +337,7 @@ instance HasLink (Get y r) where type MkLink (Get y r) = URI toLink _ = linkURI -instance HasLink (Post r) where +instance HasLink (Post y r) where type MkLink (Post y r) = URI toLink _ = linkURI diff --git a/test/Servant/Utils/LinksSpec.hs b/test/Servant/Utils/LinksSpec.hs index 4d373572..870a927c 100644 --- a/test/Servant/Utils/LinksSpec.hs +++ b/test/Servant/Utils/LinksSpec.hs @@ -8,10 +8,7 @@ module Servant.Utils.LinksSpec where import Test.Hspec ( Spec, it, describe, shouldBe, Expectation ) import Data.Proxy ( Proxy(..) ) -import Servant.API ( type (:<|>), ReqBody, QueryParam, MatrixParam, MatrixParams - , MatrixFlag, Get, Post, Capture, type (:>) , HTML , JSON, XML ) -import Servant.QQSpec ( (~>) ) -import Servant.Utils.Links ( IsElem, IsLink ) +import Servant.API type TestApi = -- Capture and query/matrix params @@ -69,7 +66,7 @@ spec = describe "Servant.Utils.Links" $ do let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String :> "child" :> MatrixParam "gender" String - :> Get String) + :> Get '[JSON] String) apiLink l3 ["Hubert?x=;&", "Cumberdale"] "Edward?" `shouldBeURI` "parent;name[]=Hubert%3Fx%3D%3B%26;\ \name[]=Cumberdale/child;gender=Edward%3F" @@ -86,8 +83,8 @@ spec = describe "Servant.Utils.Links" $ do apiLink l2 False True `shouldBeURI` "ducks;loud" it "Generates correct links for all of the verbs" $ do - apiLink (Proxy :: Proxy ("get" :> Get ())) `shouldBeURI` "get" - apiLink (Proxy :: Proxy ("put" :> Put ())) `shouldBeURI` "put" - apiLink (Proxy :: Proxy ("post" :> Post ())) `shouldBeURI` "post" + apiLink (Proxy :: Proxy ("get" :> Get '[JSON] ())) `shouldBeURI` "get" + apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put" + apiLink (Proxy :: Proxy ("post" :> Post '[JSON] ())) `shouldBeURI` "post" apiLink (Proxy :: Proxy ("delete" :> Delete)) `shouldBeURI` "delete" apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"