ApiInvalidLabel.hs

{-|
Description:    Emulating tests from @encoding/api-invalid-label.any.js@

Copyright:      (c) 2020 Samuel May
License:        MPL-2.0
Maintainer:     ag.eitilt@gmail.com

Stability:      experimental
Portability:    portable
-}
module Test.Willow.WebPlatformTests.Manual.Encoding.ApiInvalidLabel
    ( tests
    ) where


import qualified Data.Maybe as Y
import qualified Data.Text as T

import qualified Numeric as NM

import qualified Test.HUnit as U

import Test.HUnit ( (~:), (@?) )

import Web.Willow.Common.Encoding.Labels

import Test.Willow.WebPlatformTests.Manual.CommonReader


tests :: IO U.Test
tests = do
    invalidLabel' <- allEncodingLabels invalidLabel
    return $ "api-invalid-label.any.js" ~: U.TestList
        [ "invalid whitespace stripping" ~: invalidLabel'
        ]


invalidLabel :: T.Text -> U.Test
invalidLabel l = U.TestList $ map invalidLabel' "\NUL\v\x00A0\x2028\x2029"
  where invalidLabel' ws = NM.showHex (fromEnum ws) "0x" ~: do
            Y.isNothing (lookupEncoding $ T.cons ws l) @? "prefix should be rejected"
            Y.isNothing (lookupEncoding $ T.snoc l ws) @? "suffix should be rejected"
            Y.isNothing (lookupEncoding . T.cons ws $ T.snoc l ws) @? "circumfix should be rejected"