dab3c9b · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

fix rebase issues

dab3c9bJulian K. Arni12 years ago

src/Servant/QQ.hs+7−5

compare with master

unifiedsplit

@@ -72,7 +72,8 @@ data PathElemE

72data OptsE

73data SitemapE

75−

75+sitemap = undefined

76+{-

76data Validation e a = Failure e

77data Validation e a = Failure e

77 | Success a

78 | Success a

@@ -93,13 +94,13 @@ data Exp a where

93data ParseError = ParseError Int String

94data ParseError = ParseError Int String

95parseEverything :: String -> Exp SitemapE

96parseEverything :: String -> Exp SitemapE

96−parseEverything str = removeComments <$> lines str

97+parseEverything str = undefined {-removeComments <$> lines str

97 where removeComments = takeWhile (/= '#')

98 where removeComments = takeWhile (/= '#')

98 parseLines _ [] = []

99 parseLines _ [] = []

99 parseLines lineno (x:xs) = case opts of

100 parseLines lineno (x:xs) = case opts of

100− [] -> (parseUrlLine x):parseLines rest

101+ [] -> (parseUrlLine x):parseLines rest

101− xs -> (parseUrlLine x `AddOpts`

102+ xs -> undefined

102− where (opts, rest) = span (startsWith ' ') xs

103+ where (opts, rest) = span (startsWith ' ') xs -}

103

104

105

106

@@ -340,3 +341,4 @@ sitemap = QuasiQuoter { quoteExp = undefined

340 Right st -> return st

341 Right st -> return st

341 , quoteDec = undefined

342 , quoteDec = undefined

342 }

343 }

344+-}

src/Servant/Utils/Links.hs+11−17

@@ -136,6 +136,10 @@ type family Or (a :: Constraint) (b :: Constraint) :: Constraint where

136 Or () b = ()

137 Or a () = ()

138

139+-- | If both a or b produce an empty constraint, produce an empty constraint.

140+type family And (a :: Constraint) (b :: Constraint) :: Constraint where

141+ And () () = ()

142+

139-- | You may use this type family to tell the type checker that your custom type

143-- | You may use this type family to tell the type checker that your custom type

140-- may be skipped as part of a link. This is useful for things like

144-- may be skipped as part of a link. This is useful for things like

141-- 'QueryParam' that are optional in a URI and do not affect them if they are

145-- '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

164 IsElem sa (MatrixParam x y :> sb) = IsElem sa sb

168 IsElem sa (MatrixParam x y :> sb) = IsElem sa sb

165 IsElem sa (MatrixParams x y :> sb) = IsElem sa sb

169 IsElem sa (MatrixParams x y :> sb) = IsElem sa sb

166 IsElem sa (MatrixFlag x :> sb) = IsElem sa sb

170 IsElem sa (MatrixFlag x :> sb) = IsElem sa sb

167− IsElem e e = ()

168− IsElem e a = IsElem' e a

169 IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'

171 IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'

170 IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct'

172 IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct'

171 IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct'

173 IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct'

172− IsElem e e = 'True

174+ IsElem e e = ()

173− IsElem e a = 'False

175+ IsElem e a = IsElem' e a

174

176

175

177

176−type family IsSubList a b where

178+type family IsSubList a b :: Constraint where

177− IsSubList '[] b = 'True

179+ IsSubList '[] b = ()

178− IsSubList '[x] (x ': xs) = 'True

180+ IsSubList '[x] (x ': xs) = ()

179 IsSubList '[x] (y ': ys) = IsSubList '[x] ys

181 IsSubList '[x] (y ': ys) = IsSubList '[x] ys

180 IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y

182 IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y

181− IsSubList a b = 'False

183+ IsSubList a b = 'True ~ 'False

182−

183−type family IsLink'' l where

184− IsLink'' (e :> Get cts x) = IsLink' e

185− IsLink'' (e :> Post cts x) = IsLink' e

186− IsLink'' (e :> Put cts x) = IsLink' e

187− IsLink'' (e :> Delete) = IsLink' e

188− IsLink'' a = 'False

189−

190

184

191-- Phantom types for Param

185-- Phantom types for Param

192data Matrix

186data Matrix

@@ -343,7 +337,7 @@ instance HasLink (Get y r) where

343 type MkLink (Get y r) = URI

337 type MkLink (Get y r) = URI

344 toLink _ = linkURI

338 toLink _ = linkURI

345

339

346−instance HasLink (Post r) where

340+instance HasLink (Post y r) where

347 type MkLink (Post y r) = URI

341 type MkLink (Post y r) = URI

348 toLink _ = linkURI

342 toLink _ = linkURI

349

343

test/Servant/Utils/LinksSpec.hs+5−8

@@ -8,10 +8,7 @@ module Servant.Utils.LinksSpec where

8import Test.Hspec ( Spec, it, describe, shouldBe, Expectation )

9import Data.Proxy ( Proxy(..) )

11−import Servant.API ( type (:<|>), ReqBody, QueryParam, MatrixParam, MatrixParams

11+import Servant.API

12− , MatrixFlag, Get, Post, Capture, type (:>) , HTML , JSON, XML )

13−import Servant.QQSpec ( (~>) )

14−import Servant.Utils.Links ( IsElem, IsLink )

16type TestApi =

13type TestApi =

17 -- Capture and query/matrix params

14 -- Capture and query/matrix params

@@ -69,7 +66,7 @@ spec = describe "Servant.Utils.Links" $ do

69 let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String

66 let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String

70 :> "child"

67 :> "child"

71 :> MatrixParam "gender" String

68 :> MatrixParam "gender" String

72− :> Get String)

69+ :> Get '[JSON] String)

73 apiLink l3 ["Hubert?x=;&", "Cumberdale"] "Edward?"

70 apiLink l3 ["Hubert?x=;&", "Cumberdale"] "Edward?"

74 `shouldBeURI` "parent;name[]=Hubert%3Fx%3D%3B%26;\

71 `shouldBeURI` "parent;name[]=Hubert%3Fx%3D%3B%26;\

75 \name[]=Cumberdale/child;gender=Edward%3F"

72 \name[]=Cumberdale/child;gender=Edward%3F"

@@ -86,8 +83,8 @@ spec = describe "Servant.Utils.Links" $ do

86 apiLink l2 False True `shouldBeURI` "ducks;loud"

83 apiLink l2 False True `shouldBeURI` "ducks;loud"

88 it "Generates correct links for all of the verbs" $ do

85 it "Generates correct links for all of the verbs" $ do

89− apiLink (Proxy :: Proxy ("get" :> Get ())) `shouldBeURI` "get"

86+ apiLink (Proxy :: Proxy ("get" :> Get '[JSON] ())) `shouldBeURI` "get"

90− apiLink (Proxy :: Proxy ("put" :> Put ())) `shouldBeURI` "put"

87+ apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put"

91− apiLink (Proxy :: Proxy ("post" :> Post ())) `shouldBeURI` "post"

88+ apiLink (Proxy :: Proxy ("post" :> Post '[JSON] ())) `shouldBeURI` "post"

92 apiLink (Proxy :: Proxy ("delete" :> Delete)) `shouldBeURI` "delete"

89 apiLink (Proxy :: Proxy ("delete" :> Delete)) `shouldBeURI` "delete"

93 apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"

90 apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"