Fatal.hs

{-# LANGUAGE OverloadedStrings #-}

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

import qualified Data.Aeson as J
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.C
import qualified Data.Either as E
import qualified Data.Maybe as Y
import qualified Data.Text as T
import qualified Data.Word as W

import qualified Test.HUnit as U

import Data.Aeson ( (.:) )
import Test.HUnit ( (~:), (~?=), (@?), (@?=) )
import System.FilePath ( (</>), (<.>) )

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

import Test.Willow.WebPlatformTests.Manual.CommonReader


tests :: IO U.Test
tests = do
    testFile <- dataFile $ "encoding" </> "textdecoder-fatal" <.> "any" <.> "js"
    testData <- BS.readFile testFile
    return $ "textdecoder-fatal.any.js" ~: U.TestList
        [ "bad input" ~: U.TestList (map test $ process testData)
        , "decode() should decode full sequence" ~: fst (decodeUtf8NoBom sample) ~?= [Right "\x2665"]
        , "decode() should throw on tail" ~:
            filter E.isRight (fst . decodeUtf8NoBom $ BS.init sample) ~?= []
        -- can't test throwing on subsequent, as the decoder is re-initialized each time
        ]
  where sample = BS.pack [226, 153, 165]

test :: TestData -> U.Test
test d = name d ~: do
    let enc' = lookupEncoding . T.pack $ encoding d
    Y.isJust enc' @? "encoding not found"
    (enc' >>= \enc -> return . decodeEnc enc . BS.pack $ input d) @?= Just []


data TestData = TestData
    { encoding :: String
    , input :: [W.Word8]
    , name :: String
    }
instance J.FromJSON TestData where
    parseJSON = J.withObject "data" $ \v -> TestData
        <$> v .: T.pack "encoding"
        <*> v .: T.pack "input"
        <*> v .: T.pack "name"

process :: BS.ByteString -> [TestData]
process = Y.mapMaybe J.decodeStrict . filter (BS.C.isPrefixOf "    { encoding") . BS.C.lines