TextEncoderUtf16Surrogates.hs

{-|
Description:    Emulating tests from @encoding/textencoder-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.TextEncoderUtf16Surrogates
    ( tests
    ) where


import qualified Data.Text as T

import qualified Test.HUnit as U

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

import Web.Willow.Common.Encoding


tests :: U.Test
tests = "textencoder-utf16-surrogates.any.js" ~: U.TestList $
    map test testData
    -- Can't test default length as the concept of initialization doesn't exist

test :: TestData -> U.Test
test d = name d ~: fst (decodeUtf8' . fst . encodeUtf8 . T.pack $ input d) ~?= T.pack (output d)


data TestData = TestData
    { input :: String
    , output :: String
    , name :: String
    }

testData :: [TestData]
testData =
    [ TestData
        { input = "\xD800"
        , output = "\xFFFD"
        , name = "lone surrogate lead"
        }
    , TestData
        { input = "\xDC00"
        , output = "\xFFFD"
        , name = "lone surrogate trail"
        }
    , TestData
        { input = "\xD800\x0000"
        , output = "\xFFFD\x0000"
        , name = "unmatched surrogate lead"
        }
    , TestData
        { input = "\xDC00\x0000"
        , output = "\xFFFD\x0000"
        , name = "unmatched surrogate trail"
        }
    , TestData
        { input = "\xDC00\xD800"
        , output = "\xFFFD\xFFFD"
        , name = "swapped surrogate pair"
        }
    , TestData
        { input = "\xD834\xDD1E"
        , output = "\xD834\xDD1E"
        , name = "properly encoded MUSICAL SYMBOL G CLEF (U+1D11E)"
        }
    ]