QQSpec.hs

{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE ViewPatterns      #-}

module Text.QQSpec (spec) where

import Test.Hspec
import Text.URI
import qualified Text.URI.QQ as QQ

spec :: Spec
spec = do

  describe "uri" $ do
    it "works as an expression" $ do
      let uriQQ = [QQ.uri|https://markkarpov.com|]
      uri <- mkURI "https://markkarpov.com"
      uriQQ `shouldBe` uri
    it "works as a pattern" $
      mkURI "https://markkarpov.com" >>= \case
        [QQ.uri|https://haskell.org|] -> shouldNotMatch
        [QQ.uri|https://markkarpov.com|] -> return ()
        _ -> shouldHaveMatchedAlready

  describe "scheme" $ do
    it "works as an expression" $ do
      let schemeQQ = [QQ.scheme|https|]
      scheme <- mkScheme "https"
      schemeQQ `shouldBe` scheme
    it "works as a pattern" $
      mkScheme "https" >>= \case
        [QQ.scheme|ftp|] -> shouldNotMatch
        [QQ.scheme|https|] -> return ()
        _ -> shouldHaveMatchedAlready

  describe "host" $ do
    it "works as an expression" $ do
      let hostQQ = [QQ.host|markkarpov.com|]
      host <- mkHost "markkarpov.com"
      hostQQ `shouldBe` host
    it "works as a pattern" $ do
      mkHost "markkarpov.com" >>= \case
        [QQ.host|haskell.org|] -> shouldNotMatch
        [QQ.host|markkarpov.com|] -> return ()
        _ -> shouldHaveMatchedAlready

  describe "username" $ do
    it "works as an expression" $ do
      let usernameQQ = [QQ.username|mark|]
      username <- mkUsername "mark"
      usernameQQ `shouldBe` username
    it "works as a pattern" $ do
      mkUsername "mark" >>= \case
        [QQ.username|chris|] -> shouldNotMatch
        [QQ.username|mark|] -> return ()
        _ -> shouldHaveMatchedAlready

  describe "password" $ do
    it "works as an expression" $ do
      let passwordQQ = [QQ.password|secret123|]
      password <- mkPassword "secret123"
      passwordQQ `shouldBe` password
    it "works as a pattern" $ do
      mkPassword "secret123" >>= \case
        [QQ.password|secretXYZ|] -> shouldNotMatch
        [QQ.password|secret123|] -> return ()
        _ -> shouldHaveMatchedAlready

  describe "pathPiece" $ do
    it "works as an expression" $ do
      let pathPieceQQ = [QQ.pathPiece|foo|]
      pathPiece <- mkPathPiece "foo"
      pathPieceQQ `shouldBe` pathPiece
    it "works as a pattern" $ do
      mkPathPiece "foo" >>= \case
        [QQ.pathPiece|bar|] -> shouldNotMatch
        [QQ.pathPiece|foo|] -> return ()
        _ -> shouldHaveMatchedAlready

  describe "queryKey" $ do
    it "works as an expression" $ do
      let queryKeyQQ = [QQ.queryKey|foo|]
      queryKey <- mkQueryKey "foo"
      queryKeyQQ `shouldBe` queryKey
    it "works as a pattern" $ do
      mkQueryKey "foo" >>= \case
        [QQ.queryKey|xyz|] -> shouldNotMatch
        [QQ.queryKey|foo|] -> return ()
        _ -> shouldHaveMatchedAlready

  describe "queryValue" $ do
    it "works as an expression" $ do
      let queryValueQQ = [QQ.queryValue|bar|]
      queryValue <- mkQueryValue "bar"
      queryValueQQ `shouldBe` queryValue
    it "works as a pattern" $ do
      mkQueryValue "bar" >>= \case
        [QQ.queryValue|xyz|] -> shouldNotMatch
        [QQ.queryValue|bar|] -> return ()
        _ -> shouldHaveMatchedAlready

  describe "fragment" $ do
    it "works as an expression" $ do
      let fragmentQQ = [QQ.fragment|frag|]
      fragment <- mkFragment "frag"
      fragmentQQ `shouldBe` fragment
    it "works as a pattern" $ do
      mkFragment "frag" >>= \case
        [QQ.fragment|xyz|] -> shouldNotMatch
        [QQ.fragment|frag|] -> return ()
        _ -> shouldHaveMatchedAlready

shouldNotMatch :: Expectation
shouldNotMatch = expectationFailure
  "First case should not have matched, but did"

shouldHaveMatchedAlready :: Expectation
shouldHaveMatchedAlready = expectationFailure
  "Second case should have matched, but didn't"