fix rebase issues

This commit is contained in:
Julian K. Arni 2015-02-18 10:40:55 +01:00
parent a75c723226
commit dab3c9b62d
3 changed files with 23 additions and 30 deletions

View file

@ -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
}
-}

View file

@ -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

View file

@ -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"