servant/servant-server/test/Servant/Server/Internal/ContextSpec.hs

66 lines
2.4 KiB
Haskell
Raw Normal View History

2016-02-28 23:23:32 +01:00
{-# LANGUAGE DataKinds #-}
2016-04-18 12:07:23 +02:00
{-# OPTIONS_GHC -fdefer-type-errors -Wwarn #-}
2016-02-28 23:23:32 +01:00
module Servant.Server.Internal.ContextSpec (spec) where
2018-06-29 21:08:26 +02:00
import Data.Proxy
(Proxy (..))
import Test.Hspec
(Spec, context, describe, it, shouldBe)
import Test.ShouldNotTypecheck
(shouldNotTypecheck)
2016-02-28 23:23:32 +01:00
import Servant.API
import Servant.Server.Internal.Context
spec :: Spec
spec = do
describe "getContextEntry" $ do
it "gets the context if a matching one exists" $ do
let cxt = 'a' :. EmptyContext
getContextEntry cxt `shouldBe` 'a'
it "gets the first matching context" $ do
let cxt = 'a' :. 'b' :. EmptyContext
getContextEntry cxt `shouldBe` 'a'
it "does not typecheck if type does not exist" $ do
let cxt = 'a' :. EmptyContext
x = getContextEntry cxt :: Bool
shouldNotTypecheck x
context "Show instance" $ do
it "has a Show instance" $ do
2016-04-18 12:07:23 +02:00
let cxt = 'a' :. True :. EmptyContext
2016-02-28 23:23:32 +01:00
show cxt `shouldBe` "'a' :. True :. EmptyContext"
context "bracketing" $ do
it "works" $ do
2016-04-18 12:07:23 +02:00
let cxt = 'a' :. True :. EmptyContext
2016-02-28 23:23:32 +01:00
show (Just cxt) `shouldBe` "Just ('a' :. True :. EmptyContext)"
it "works with operators" $ do
2017-06-03 20:44:40 +02:00
let cxt = (1 :: Integer) :. 'a' :. EmptyContext :<|> 'b' :. True :. EmptyContext
2017-06-02 17:47:28 +02:00
show cxt `shouldBe` "1 :. 'a' :. EmptyContext :<|> 'b' :. True :. EmptyContext"
2016-02-28 23:23:32 +01:00
describe "descendIntoNamedContext" $ do
let cxt :: Context [Char, NamedContext "sub" '[Char]]
cxt =
'a' :.
(NamedContext subContext :: NamedContext "sub" '[Char])
:. EmptyContext
subContext = 'b' :. EmptyContext
it "allows extracting subcontexts" $ do
descendIntoNamedContext (Proxy :: Proxy "sub") cxt `shouldBe` subContext
it "allows extracting entries from subcontexts" $ do
getContextEntry (descendIntoNamedContext (Proxy :: Proxy "sub") cxt :: Context '[Char])
`shouldBe` 'b'
it "does not typecheck if subContext has the wrong type" $ do
let x = descendIntoNamedContext (Proxy :: Proxy "sub") cxt :: Context '[Int]
shouldNotTypecheck (show x)
it "does not typecheck if subContext with that name doesn't exist" $ do
let x = descendIntoNamedContext (Proxy :: Proxy "foo") cxt :: Context '[Char]
shouldNotTypecheck (show x)