ApiBasics.hs

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


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

import qualified Test.HUnit as U

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

import Web.Willow.Common.Encoding
import Web.Willow.Common.Encoding.Labels

import Test.Willow.WebPlatformTests.Manual.Common


tests :: U.Test
tests = "api-basics.any.js" ~: U.TestList
    [ roundtrip
    , decodeSample "utf-16le" bytes16le
    , decodeSample "utf-16be" bytes16be
    , decodeSample "utf-16" bytes16le
    ]

sample :: T.Text
sample = T.pack "z\xA2\x6C34\xD834\xDD1E\xF8FF\xDBFF\xDFFD\xFFFE"

bytes8 :: BS.ByteString
bytes8 = BS.pack
    [ 0x7A, 0xC2, 0xA2, 0xE6, 0xB0, 0xB4, 0xF0, 0x9D
    , 0x84, 0x9E, 0xEF, 0xA3, 0xBF, 0xF4, 0x8F, 0xBF
    , 0xBD, 0xEF, 0xBF, 0xBE
    ]

bytes16le :: BS.ByteString
bytes16le = BS.pack
    [ 0x7A, 0x00, 0xA2, 0x00, 0x34, 0x6C, 0x34, 0xD8
    , 0x1E, 0xDD, 0xFF, 0xF8, 0xFF, 0xDB, 0xFD, 0xDF
    , 0xFE, 0xFF
    ]

bytes16be :: BS.ByteString
bytes16be = BS.pack
    [ 0x00, 0x7A, 0x00, 0xA2, 0x6C, 0x34, 0xD8, 0x34
    , 0xDD, 0x1E, 0xF8, 0xFF, 0xDB, 0xFF, 0xDF, 0xFD
    , 0xFF, 0xFE
    ]

roundtrip :: U.Test
roundtrip = "Encode/decode round trip: utf-8" ~: U.TestList
    [ encodeEnc' enc sample ~?= bytes8
    , decodeEnc' enc bytes8 ~?= sample
    ]
  where enc = Y.fromMaybe Replacement . lookupEncoding $ T.pack "utf-8"

decodeSample :: String -> BS.ByteString -> U.Test
decodeSample enc bs = "Decode sample: " ++ enc ~:
    decodeEnc' (Y.fromMaybe Replacement . lookupEncoding $ T.pack enc) bs ~?= sample