content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE FunctionalDependencies #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverlappingInstances #-}
  {-# LANGUAGE QuasiQuotes #-}
  {-# LANGUAGE TypeFamilies  #-}
  {-# LANGUAGE TypeOperators  #-}
  {-# LANGUAGE UndecidableInstances  #-}
  module Servant.QQSpec where
  
  import Test.Hspec
  
  import Servant.API
  
  --------------------------------------------------------------------------
  -- Types for testing
  --------------------------------------------------------------------------
  
  -- Methods ---------------------------------------------------------------
  type SimpleGet = [sitemap|
  GET  hello  ()
  |]
  type SimpleGet' = "hello" :> Get ()
  type SimpleGet'' = "hello" :> Get Bool
  
  type SimpleGet2 = [sitemap|
  GET  hello  Bool
  |]
  type SimpleGet2' = "hello" :> Get Bool
  type SimpleGet2'' = "hello" :> Get Int
  
  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 ()
  
  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 ------------------------------------------------------------
  
  type SimpleReqBody = [sitemap|
  POST  hello  () -> Bool
  |]
  type SimpleReqBody' = "hello" :> ReqBody () :> Post Bool
  type SimpleReqBody'' = "hello" :> ReqBody Bool :> Post ()
  
  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
  
  -- Combinations ----------------------------------------------------------
  
  type TwoPaths = [sitemap|
  POST hello  Bool
  GET  hello  Bool
  |]
  type TwoPaths' = ("hello" :> Post Bool) :<|> ("hello" :> Get Bool)
  
  type WithInlineComments = [sitemap|
  GET  hello  Bool   -- This is a comment
  |]
  type WithInlineComments' = "hello" :> Get Bool
  
  type WithInlineComments2 = [sitemap|
  GET  hello  Bool
  -- This is a comment
  |]
  type WithInlineComments2' = "hello" :> Get Bool
  
  
  type WithBlockComments = [sitemap|
  GET  hello  Bool   {-
  POST hello  Bool
  -}
  |]
  type WithBlockComments' = "hello" :> Get Bool
  
  type WithBlockComments2 = [sitemap|
  GET  hello  Bool   {-
  POST hello  Bool
  -}
  POST hello Bool
  |]
  type WithBlockComments2' = ("hello" :> Get Bool) :<|> ("hello" :> Post Bool)
  
  --------------------------------------------------------------------------
  -- Spec
  --------------------------------------------------------------------------
  
  spec :: Spec
  spec = do
      describe "'sitemap' QuasiQuoter" $ do
          it "Handles simple GET types" $ do
              (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
          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
          it "Handles simple request body types" $ do
              (u::SimpleReqBody) ~= (u::SimpleReqBody' ) ~> True
              (u::SimpleReqBody) ~= (u::SimpleReqBody'') ~> False
          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 multiples paths" $ do
              (u::TwoPaths) ~= (u::TwoPaths') ~> True
          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
  
  
  --------------------------------------------------------------------------
  -- 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 ~>
  (~>) :: (Show a, Eq a) => a -> a -> Expectation
  (~>) = shouldBe
  