servant/test/Servant/QQSpec.hs

214 lines
7.2 KiB
Haskell
Raw Normal View History

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
2014-11-25 17:35:17 +01:00
module Servant.QQSpec where
2015-01-08 16:24:19 +01:00
import Test.Hspec ( Expectation, Spec, shouldBe, it, describe, pendingWith )
2015-01-08 16:24:19 +01:00
spec = describe "this" $ it "is" $ pendingWith "playing around"
{-
import Servant.API
2015-01-06 17:57:50 +01:00
( (:<|>),
ReqBody,
QueryParam,
2015-01-15 10:44:45 +01:00
MatrixParam,
2015-01-06 17:57:50 +01:00
Put,
Get,
Post,
Capture,
(:>),
2015-01-08 16:24:19 +01:00
JSON,
2015-01-06 17:57:50 +01:00
sitemap )
2014-10-29 14:37:52 +01:00
--------------------------------------------------------------------------
-- Types for testing
--------------------------------------------------------------------------
2014-10-29 14:54:13 +01:00
-- Methods ---------------------------------------------------------------
type SimpleGet = [sitemap|
GET hello ()
|]
2015-01-08 16:24:19 +01:00
type SimpleGet' = "hello" :> Get '[JSON] ()
type SimpleGet'' = "hello" :> Get '[JSON] Bool
2014-10-29 14:37:52 +01:00
type SimpleGet2 = [sitemap|
GET hello Bool
|]
2015-01-08 16:24:19 +01:00
type SimpleGet2' = "hello" :> Get '[JSON] Bool
type SimpleGet2'' = "hello" :> Get '[JSON] Int
2014-10-29 14:37:52 +01:00
type SimplePost = [sitemap|
POST hello ()
|]
type SimplePost' = "hello" :> Post ()
type SimplePost'' = "hello" :> Post Bool
type SimplePost2 = [sitemap|
POST hello Bool
|]
type SimplePost2' = "hello" :> Post Bool
type SimplePost2'' = "hello" :> Post ()
2014-10-29 14:54:13 +01:00
type SimplePut = [sitemap|
PUT hello ()
|]
type SimplePut' = "hello" :> Put ()
type SimplePut'' = "hello" :> Put Bool
type SimplePut2 = [sitemap|
PUT hello Bool
|]
type SimplePut2' = "hello" :> Put Bool
type SimplePut2'' = "hello" :> Put ()
-- Parameters ------------------------------------------------------------
2014-10-29 14:37:52 +01:00
type SimpleReqBody = [sitemap|
POST hello () -> Bool
|]
type SimpleReqBody' = "hello" :> ReqBody () :> Post Bool
type SimpleReqBody'' = "hello" :> ReqBody Bool :> Post ()
2014-10-29 14:54:13 +01:00
type SimpleCapture = [sitemap|
POST hello/p:Int Bool
|]
type SimpleCapture' = "hello" :> Capture "p" Int :> Post Bool
type SimpleCapture'' = "hello" :> Capture "r" Int :> Post Bool
type SimpleCapture''' = "hello" :> Capture "p" Bool :> Post Bool
type SimpleQueryParam = [sitemap|
POST hello/?p:Int Bool
|]
type SimpleQueryParam' = "hello" :> QueryParam "p" Int :> Post Bool
type SimpleQueryParam'' = "hello" :> QueryParam "r" Int :> Post Bool
type SimpleQueryParam''' = "hello" :> QueryParam "p" Bool :> Post Bool
type SimpleMatrixParam = [sitemap|
POST hello;p:Int Bool
|]
type SimpleMatrixParam' = "hello" :> MatrixParam "p" Int :> Post Bool
type SimpleMatrixParam'' = "hello" :> MatrixParam "r" Int :> Post Bool
type SimpleMatrixParam''' = "hello" :> MatrixParam "p" Bool :> Post Bool
type ComplexMatrixParam = [sitemap|
POST hello;p:Int;q:String/world;r:Int Bool
|]
type ComplexMatrixParam' = "hello" :> MatrixParam "p" Int :> MatrixParam "q" String :> "world" :> MatrixParam "r" Int :> Post Bool
type ComplexMatrixParam'' = "hello" :> MatrixParam "p" Int :> MatrixParam "q" String :> "world" :> MatrixParam "s" Int :> Post Bool
type ComplexMatrixParam''' = "hello" :> MatrixParam "p" Int :> MatrixParam "q" String :> "world" :> MatrixParam "r" Bool :> Post Bool
2014-10-29 14:54:13 +01:00
-- Combinations ----------------------------------------------------------
type TwoPaths = [sitemap|
POST hello Bool
GET hello Bool
|]
2015-01-08 16:24:19 +01:00
type TwoPaths' = ("hello" :> Post Bool) :<|> ("hello" :> Get '[JSON] Bool)
2014-11-13 18:22:26 +01:00
type WithInlineComments = [sitemap|
GET hello Bool -- This is a comment
|]
2015-01-08 16:24:19 +01:00
type WithInlineComments' = "hello" :> Get '[JSON] Bool
2014-11-13 18:22:26 +01:00
type WithInlineComments2 = [sitemap|
GET hello Bool
-- This is a comment
|]
2015-01-08 16:24:19 +01:00
type WithInlineComments2' = "hello" :> Get '[JSON] Bool
2014-11-13 18:22:26 +01:00
type WithBlockComments = [sitemap|
GET hello Bool {-
POST hello Bool
-}
|]
2015-01-08 16:24:19 +01:00
type WithBlockComments' = "hello" :> Get '[JSON] Bool
2014-11-13 18:22:26 +01:00
type WithBlockComments2 = [sitemap|
GET hello Bool {-
POST hello Bool
-}
POST hello Bool
|]
2015-01-08 16:24:19 +01:00
type WithBlockComments2' = ("hello" :> Get '[JSON] Bool) :<|> ("hello" :> Post Bool)
2014-11-13 18:22:26 +01:00
2014-10-29 14:37:52 +01:00
--------------------------------------------------------------------------
-- Spec
--------------------------------------------------------------------------
spec :: Spec
spec = do
describe "'sitemap' QuasiQuoter" $ do
it "Handles simple GET types" $ do
2014-10-29 14:37:52 +01:00
(u::SimpleGet) ~= (u::SimpleGet' ) ~> True
(u::SimpleGet) ~= (u::SimpleGet'' ) ~> False
(u::SimpleGet2) ~= (u::SimpleGet2' ) ~> True
(u::SimpleGet2) ~= (u::SimpleGet2'') ~> False
it "Handles simple POST types" $ do
(u::SimplePost) ~= (u::SimplePost' ) ~> True
(u::SimplePost) ~= (u::SimplePost'' ) ~> False
(u::SimplePost2) ~= (u::SimplePost2' ) ~> True
(u::SimplePost2) ~= (u::SimplePost2'') ~> False
2014-10-29 14:54:13 +01:00
it "Handles simple PUT types" $ do
(u::SimplePut) ~= (u::SimplePut' ) ~> True
(u::SimplePut) ~= (u::SimplePut'' ) ~> False
(u::SimplePut2) ~= (u::SimplePut2' ) ~> True
(u::SimplePut2) ~= (u::SimplePut2'') ~> False
2014-10-29 14:37:52 +01:00
it "Handles simple request body types" $ do
(u::SimpleReqBody) ~= (u::SimpleReqBody' ) ~> True
(u::SimpleReqBody) ~= (u::SimpleReqBody'') ~> False
2014-10-29 14:54:13 +01:00
it "Handles simple captures" $ do
(u::SimpleCapture) ~= (u::SimpleCapture' ) ~> True
(u::SimpleCapture) ~= (u::SimpleCapture'') ~> False
(u::SimpleCapture) ~= (u::SimpleCapture''') ~> False
it "Handles simple querystring parameters" $ do
(u::SimpleQueryParam) ~= (u::SimpleQueryParam' ) ~> True
(u::SimpleQueryParam) ~= (u::SimpleQueryParam'') ~> False
(u::SimpleQueryParam) ~= (u::SimpleQueryParam''') ~> False
it "Handles simple matrix parameters" $ do
(u::SimpleMatrixParam) ~= (u::SimpleMatrixParam' ) ~> True
(u::SimpleMatrixParam) ~= (u::SimpleMatrixParam'') ~> False
(u::SimpleMatrixParam) ~= (u::SimpleMatrixParam''') ~> False
it "Handles more complex matrix parameters" $ do
(u::ComplexMatrixParam) ~= (u::ComplexMatrixParam' ) ~> True
(u::ComplexMatrixParam) ~= (u::ComplexMatrixParam'') ~> False
(u::ComplexMatrixParam) ~= (u::ComplexMatrixParam''') ~> False
2014-10-29 14:54:13 +01:00
it "Handles multiples paths" $ do
(u::TwoPaths) ~= (u::TwoPaths') ~> True
2014-11-13 18:22:26 +01:00
it "Ignores inline comments" $ do
(u::WithInlineComments) ~= (u::WithInlineComments') ~> True
(u::WithInlineComments2) ~= (u::WithInlineComments2') ~> True
it "Ignores inline comments" $ do
(u::WithBlockComments) ~= (u::WithBlockComments') ~> True
(u::WithBlockComments2) ~= (u::WithBlockComments2') ~> True
2014-10-29 14:37:52 +01:00
2015-01-08 16:24:19 +01:00
-}
2014-10-29 14:37:52 +01:00
--------------------------------------------------------------------------
-- Utilities
--------------------------------------------------------------------------
data HTrue
data HFalse
-- Kiselyov's Type Equality predicate
class TypeEq x y b | x y -> b where { areEq :: x -> y -> Bool }
instance TypeEq x x HTrue where { areEq _ _ = True }
instance b ~ HFalse => TypeEq x y b where { areEq _ _ = False}
infix 4 ~=
(~=) :: TypeEq x y b => x -> y -> Bool
(~=) = areEq
u :: a
u = undefined
infix 3 ~>
2014-10-30 08:41:18 +01:00
(~>) :: (Show a, Eq a) => a -> a -> Expectation
2014-10-29 14:37:52 +01:00
(~>) = shouldBe