TextDecoderUtf16Surrogates.hs

{-|
Description:    Emulating tests from @encoding/textdecoder-utf16-surrogates.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.TextDecoderUtf16Surrogates
    ( tests
    ) where


import qualified Data.ByteString as BS
import qualified Data.Either as E
import qualified Data.Text as T

import qualified Test.HUnit as U

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

import Web.Willow.Common.Encoding

import Test.Willow.WebPlatformTests.Manual.Common


tests :: U.Test
tests = "textdecoder-utf16-surrogates.any.js" ~: U.TestList
    [ "replacement" ~: U.TestList $ map testReplace testData
    , "fatal" ~: U.TestList $ map testFatal testData
    ]

testFatal :: InlineDecode -> U.Test
--TODO: Should the fatal *coders stop on failure rather than just returning a 'Left'?
testFatal d = nameD d ~: takeWhile E.isRight (decodeEnc Utf16le $ inputD d) ~?= []

testReplace :: InlineDecode -> U.Test
testReplace d = nameD d ~: decodeEnc' Utf16le (inputD d) ~?= outputD d


testData :: [InlineDecode]
testData =
    [ InlineDecode
        { inputD = BS.pack [0x00, 0xd8]
        , outputD = T.pack "\xFFFD"
        , nameD = "lone surrogate lead"
        }
    , InlineDecode
        { inputD = BS.pack [0x00, 0xdc]
        , outputD = T.pack "\xFFFD"
        , nameD = "lone surrogate trail"
        }
    , InlineDecode
        { inputD = BS.pack [0x00, 0xd8, 0x00, 0x00]
        , outputD = T.pack "\xFFFD\x0000"
        , nameD = "unmatched surrogate lead"
        }
    , InlineDecode
        { inputD = BS.pack [0x00, 0xdc, 0x00, 0x00]
        , outputD = T.pack "\xFFFD\x0000"
        , nameD = "unmatched surrogate trail"
        }
    , InlineDecode
        { inputD = BS.pack [0x00, 0xdc, 0x00, 0xd8]
        , outputD = T.pack "\xFFFD\xFFFD"
        , nameD = "swapped surrogate pair"
        }
    ]