GB.hs

{-|
Description:    

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

Stability:      experimental
Portability:    portable
-}
module Test.Willow.Unit.Encoding.GB
    ( tests
    ) where


import qualified Data.Char as C
import qualified Data.Word as W

import qualified Test.HUnit as U

import Test.HUnit ( (~:) )

import Web.Willow.Common.Encoding

import Test.Willow.Unit.Encoding.Common


tests :: U.Test
tests = "GB encodings" ~: U.TestList
    [ "decode" ~: U.TestList
        [ "ASCII" ~: U.TestList
            [ map C.toUpper (show enc) ~: U.TestList $ map (decodeAscii enc) ['\NUL'..'\DEL']
            | enc <- [ Gbk, Gb18030 ]
            ]
        , decodeGbTest "Euro sign" [0x80] $ Just "\x20AC"
        , decodeGbTest "0xFF" [0xFF] Nothing
        , decodeGbTest (show '\xE7C7') [0x81, 0x35, 0xF4, 0x37] $ Just "\xE7C7"
        ]
    , "encode" ~: U.TestList
        [ "ASCII" ~: U.TestList
            [ map C.toUpper (show enc) ~: U.TestList $ map (encodeAscii enc) ['\NUL'..'\DEL']
            | enc <- [ Gbk, Gb18030 ]
            ]
        , encodeGbTest '\xE5E5' Nothing Nothing
        , encodeGbTest '\xE7C7' Nothing (Just [0x81, 0x35, 0xF4, 0x37])
        ]
    ]


decodeGbTest :: String -> [W.Word8] -> Maybe String -> U.Test
decodeGbTest name bs cs = name ~: U.TestList
    [ decodeTest' Gbk
    , decodeTest' Gb18030
    ]
  where decodeTest' enc = decodeTest enc (map C.toUpper $ show enc) bs cs

encodeGbTest :: Char -> Maybe [W.Word8] -> Maybe [W.Word8] -> U.Test
encodeGbTest c bsGbk bs18030 = [c] ~: U.TestList
    [ encodeTest' Gbk bsGbk
    , encodeTest' Gb18030 bs18030
    ]
  where encodeTest' enc = encodeTest enc (map C.toUpper $ show enc) [c]