fix rebase issues
This commit is contained in:
parent
a75c723226
commit
dab3c9b62d
3 changed files with 23 additions and 30 deletions
|
@ -72,7 +72,8 @@ data PathElemE
|
||||||
data OptsE
|
data OptsE
|
||||||
data SitemapE
|
data SitemapE
|
||||||
|
|
||||||
|
sitemap = undefined
|
||||||
|
{-
|
||||||
data Validation e a = Failure e
|
data Validation e a = Failure e
|
||||||
| Success a
|
| Success a
|
||||||
|
|
||||||
|
@ -93,13 +94,13 @@ data Exp a where
|
||||||
data ParseError = ParseError Int String
|
data ParseError = ParseError Int String
|
||||||
|
|
||||||
parseEverything :: String -> Exp SitemapE
|
parseEverything :: String -> Exp SitemapE
|
||||||
parseEverything str = removeComments <$> lines str
|
parseEverything str = undefined {-removeComments <$> lines str
|
||||||
where removeComments = takeWhile (/= '#')
|
where removeComments = takeWhile (/= '#')
|
||||||
parseLines _ [] = []
|
parseLines _ [] = []
|
||||||
parseLines lineno (x:xs) = case opts of
|
parseLines lineno (x:xs) = case opts of
|
||||||
[] -> (parseUrlLine x):parseLines rest
|
[] -> (parseUrlLine x):parseLines rest
|
||||||
xs -> (parseUrlLine x `AddOpts`
|
xs -> undefined
|
||||||
where (opts, rest) = span (startsWith ' ') xs
|
where (opts, rest) = span (startsWith ' ') xs -}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -340,3 +341,4 @@ sitemap = QuasiQuoter { quoteExp = undefined
|
||||||
Right st -> return st
|
Right st -> return st
|
||||||
, quoteDec = undefined
|
, quoteDec = undefined
|
||||||
}
|
}
|
||||||
|
-}
|
||||||
|
|
|
@ -136,6 +136,10 @@ type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
|
||||||
Or () b = ()
|
Or () b = ()
|
||||||
Or a () = ()
|
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
|
-- | 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
|
-- 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
|
-- '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 (MatrixParam x y :> sb) = IsElem sa sb
|
||||||
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 = ()
|
|
||||||
IsElem e a = IsElem' e a
|
|
||||||
IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'
|
IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'
|
||||||
IsElem (Post ct typ) (Post 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 (Put ct typ) (Put ct' typ) = IsSubList ct ct'
|
||||||
IsElem e e = 'True
|
IsElem e e = ()
|
||||||
IsElem e a = 'False
|
IsElem e a = IsElem' e a
|
||||||
|
|
||||||
|
|
||||||
type family IsSubList a b where
|
type family IsSubList a b :: Constraint where
|
||||||
IsSubList '[] b = 'True
|
IsSubList '[] b = ()
|
||||||
IsSubList '[x] (x ': xs) = 'True
|
IsSubList '[x] (x ': xs) = ()
|
||||||
IsSubList '[x] (y ': ys) = IsSubList '[x] ys
|
IsSubList '[x] (y ': ys) = IsSubList '[x] ys
|
||||||
IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y
|
IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y
|
||||||
IsSubList a b = 'False
|
IsSubList a b = 'True ~ '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
|
|
||||||
|
|
||||||
|
|
||||||
-- Phantom types for Param
|
-- Phantom types for Param
|
||||||
data Matrix
|
data Matrix
|
||||||
|
@ -343,7 +337,7 @@ instance HasLink (Get y r) where
|
||||||
type MkLink (Get y r) = URI
|
type MkLink (Get y r) = URI
|
||||||
toLink _ = linkURI
|
toLink _ = linkURI
|
||||||
|
|
||||||
instance HasLink (Post r) where
|
instance HasLink (Post y r) where
|
||||||
type MkLink (Post y r) = URI
|
type MkLink (Post y r) = URI
|
||||||
toLink _ = linkURI
|
toLink _ = linkURI
|
||||||
|
|
||||||
|
|
|
@ -8,10 +8,7 @@ module Servant.Utils.LinksSpec where
|
||||||
import Test.Hspec ( Spec, it, describe, shouldBe, Expectation )
|
import Test.Hspec ( Spec, it, describe, shouldBe, Expectation )
|
||||||
import Data.Proxy ( Proxy(..) )
|
import Data.Proxy ( Proxy(..) )
|
||||||
|
|
||||||
import Servant.API ( type (:<|>), ReqBody, QueryParam, MatrixParam, MatrixParams
|
import Servant.API
|
||||||
, MatrixFlag, Get, Post, Capture, type (:>) , HTML , JSON, XML )
|
|
||||||
import Servant.QQSpec ( (~>) )
|
|
||||||
import Servant.Utils.Links ( IsElem, IsLink )
|
|
||||||
|
|
||||||
type TestApi =
|
type TestApi =
|
||||||
-- Capture and query/matrix params
|
-- Capture and query/matrix params
|
||||||
|
@ -69,7 +66,7 @@ spec = describe "Servant.Utils.Links" $ do
|
||||||
let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String
|
let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String
|
||||||
:> "child"
|
:> "child"
|
||||||
:> MatrixParam "gender" String
|
:> MatrixParam "gender" String
|
||||||
:> Get String)
|
:> Get '[JSON] String)
|
||||||
apiLink l3 ["Hubert?x=;&", "Cumberdale"] "Edward?"
|
apiLink l3 ["Hubert?x=;&", "Cumberdale"] "Edward?"
|
||||||
`shouldBeURI` "parent;name[]=Hubert%3Fx%3D%3B%26;\
|
`shouldBeURI` "parent;name[]=Hubert%3Fx%3D%3B%26;\
|
||||||
\name[]=Cumberdale/child;gender=Edward%3F"
|
\name[]=Cumberdale/child;gender=Edward%3F"
|
||||||
|
@ -86,8 +83,8 @@ spec = describe "Servant.Utils.Links" $ do
|
||||||
apiLink l2 False True `shouldBeURI` "ducks;loud"
|
apiLink l2 False True `shouldBeURI` "ducks;loud"
|
||||||
|
|
||||||
it "Generates correct links for all of the verbs" $ do
|
it "Generates correct links for all of the verbs" $ do
|
||||||
apiLink (Proxy :: Proxy ("get" :> Get ())) `shouldBeURI` "get"
|
apiLink (Proxy :: Proxy ("get" :> Get '[JSON] ())) `shouldBeURI` "get"
|
||||||
apiLink (Proxy :: Proxy ("put" :> Put ())) `shouldBeURI` "put"
|
apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put"
|
||||||
apiLink (Proxy :: Proxy ("post" :> Post ())) `shouldBeURI` "post"
|
apiLink (Proxy :: Proxy ("post" :> Post '[JSON] ())) `shouldBeURI` "post"
|
||||||
apiLink (Proxy :: Proxy ("delete" :> Delete)) `shouldBeURI` "delete"
|
apiLink (Proxy :: Proxy ("delete" :> Delete)) `shouldBeURI` "delete"
|
||||||
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"
|
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"
|
||||||
|
|
Loading…
Reference in a new issue