unicode-data-scripts-0.3.0: test/Unicode/Char/General/ScriptsSpec.hs
{-# LANGUAGE BlockArguments, OverloadedLists #-}
module Unicode.Char.General.ScriptsSpec
( spec
) where
import Data.Foldable (traverse_)
import GHC.Exts
( isTrue#, orI#, andI#, (-#), (<#), (<=#), (==#)
, Char (..), ord#
, plusAddr#, eqAddr#, nullAddr#, ltAddr# )
import Test.Hspec
( expectationFailure, shouldBe, shouldSatisfy, it, describe, Spec )
import Unicode.Internal.Bits.Scripts (nextInt32#)
import qualified Unicode.Char.General.Scripts as S
import qualified Unicode.Internal.Char.Scripts as IS
{- [NOTE]
These tests may fail if the compiler’s Unicode version
does not match the version of this package.
+-------------+----------------+-----------------+
| GHC version | @base@ version | Unicode version |
+=============+================+=================+
| 8.8 | 4.13 | 12.0 |
| 8.10.[1-4] | 4.14.{0,1} | 12.0 |
| 8.10.5+ | 4.14.2+ | 13.0 |
| 9.0.[1-2] | 4.15.0 | 12.1 |
| 9.2.[1-6] | 4.16.0 | 14.0 |
| 9.4.[1-4] | 4.17.0 | 14.0 |
| 9.6.1 | 4.18.0 | 15.0 |
+-------------+----------------+-----------------+
-}
spec :: Spec
spec = do
describe "Unicode scripts" do
describe "Examples" do
it "script" do
let check s = (== s) . S.script
minBound `shouldSatisfy` check S.Common
maxBound `shouldSatisfy` check S.Unknown
'.' `shouldSatisfy` check S.Common
'1' `shouldSatisfy` check S.Common
'A' `shouldSatisfy` check S.Latin
'Α' `shouldSatisfy` check S.Greek -- Greek capital
'α' `shouldSatisfy` check S.Greek
'\x0300' `shouldSatisfy` check S.Inherited
'\x0485' `shouldSatisfy` check S.Inherited
'\x0600' `shouldSatisfy` check S.Arabic
'\x060c' `shouldSatisfy` check S.Common
'\x0965' `shouldSatisfy` check S.Common
'\x1100' `shouldSatisfy` check S.Hangul
'\x3000' `shouldSatisfy` check S.Common
'\x4E00' `shouldSatisfy` check S.Han
'\x11FD0' `shouldSatisfy` check S.Tamil
'\x1F600' `shouldSatisfy` check S.Common
'\x20000' `shouldSatisfy` check S.Han
-- BOM
'\xFEFF' `shouldSatisfy` check S.Common
'\xFFFF' `shouldSatisfy` check S.Unknown
-- Private Use Areas
'\xE000' `shouldSatisfy` check S.Unknown
'\xF0000' `shouldSatisfy` check S.Unknown
it "scriptExtensions" do
let check s = (== s) . S.scriptExtensions
minBound `shouldSatisfy` check [ S.Common]
maxBound `shouldSatisfy` check [ S.Unknown]
'.' `shouldSatisfy` check [ S.Common]
'1' `shouldSatisfy` check [ S.Common]
'A' `shouldSatisfy` check [ S.Latin]
'Α' `shouldSatisfy` check [ S.Greek]
'α' `shouldSatisfy` check [ S.Greek]
'\x0300' `shouldSatisfy` check [ S.Inherited]
'\x0485' `shouldSatisfy` check [ S.Cyrillic, S.Latin]
'\x0600' `shouldSatisfy` check [ S.Arabic]
'\x060C' `shouldSatisfy` check [ S.Arabic
, S.HanifiRohingya
, S.Nko
, S.Syriac
, S.Thaana
, S.Yezidi ]
'\x0965' `shouldSatisfy` check [ S.Bengali
, S.Devanagari
, S.Dogra
, S.Grantha
, S.Gujarati
, S.GunjalaGondi
, S.Gurmukhi
, S.Kannada
, S.Khudawadi
, S.Limbu
, S.Mahajani
, S.Malayalam
, S.MasaramGondi
, S.Nandinagari
, S.Oriya
, S.Sinhala
, S.SylotiNagri
, S.Takri
, S.Tamil
, S.Telugu
, S.Tirhuta ]
'\x1100' `shouldSatisfy` check [ S.Hangul]
'\x3001' `shouldSatisfy` check [ S.Bopomofo
, S.Han
, S.Hangul
, S.Hiragana
, S.Katakana
, S.Yi ]
'\x4E00' `shouldSatisfy` check [ S.Han]
'\x11FD0' `shouldSatisfy` check [ S.Grantha, S.Tamil ]
'\x1F600' `shouldSatisfy` check [ S.Common]
'\x20000' `shouldSatisfy` check [ S.Han]
-- BOM
'\xFEFF' `shouldSatisfy` check [ S.Common ]
'\xFFFF' `shouldSatisfy` check [ S.Unknown ]
-- Private Use Areas
'\xE000' `shouldSatisfy` check [ S.Unknown ]
'\xF0000' `shouldSatisfy` check [ S.Unknown ]
it "scriptDefinition" do
take 304 (S.scriptDefinition S.Latin) `shouldBe`
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzªºÀÁÂÃÄÅÆÇ\
\ÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿĀāĂ㥹Ćć\
\ĈĉĊċČčĎďĐđĒēĔĕĖėĘęĚěĜĝĞğĠġĢģĤĥĦħĨĩĪīĬĭĮįİıIJijĴĵĶķĸĹĺĻļĽľĿŀŁłŃńŅ\
\ņŇňʼnŊŋŌōŎŏŐőŒœŔŕŖŗŘřŚśŜŝŞşŠšŢţŤťŦŧŨũŪūŬŭŮůŰűŲųŴŵŶŷŸŹźŻżŽžſƀƁƂƃ\
\ƄƅƆƇƈƉƊƋƌƍƎƏƐƑƒƓƔƕƖƗƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻ"
S.scriptDefinition S.ZanabazarSquare `shouldBe`
['\x11A00'..'\x11A47']
S.scriptDefinition S.Lydian `shouldBe`
(['\x10920'..'\x10939'] <> "\x1093F")
it "Smallest script definitions have at least one range in their bitmap"
let {
check s = case IS.scriptDefinition s of
(# _, _, addr#, n# #) -> case n# of
0# -> isTrue# (addr# `eqAddr#` nullAddr#)
4# ->
let lower = nextInt32# addr#
upper = nextInt32# (addr# `plusAddr#` 4#)
-- Check we have a range
in isTrue# ((lower <# IS.ScriptCharMask) `andI#`
(upper <# IS.ScriptCharMask) `andI#`
(1# <# (upper -# lower)) )
_ -> True
} in traverse_ (`shouldSatisfy` check) (enumFromTo minBound maxBound)
it "Characters are in the definition of their corresponding script"
let {
check c =
let s = S.script c
in if c `inScript` s
then pure ()
else expectationFailure $ mconcat
[ "Char “", show c, "” in not in the definition of “"
, show s, "”." ]
} in traverse_ check (enumFromTo minBound maxBound)
it "Characters in a script definition have the corresponding script"
let {
checkChar s c = let s' = S.script c in if s' == s
then pure ()
else expectationFailure $ mconcat
[ "Script is different for “", show c, "”. Expected: “"
, show s, "” but got: “", show s', "”." ];
check s = case S.scriptDefinition s of
[] -> expectationFailure $ mconcat
["Script “", show s, "” has an empty definition"]
chars -> traverse_ (checkChar s) chars
} in traverse_ check (enumFromTo minBound maxBound)
it "Characters in with a script extension different from its script"
let {
check c =
let script = S.script c
exts = S.scriptExtensions c
in if exts == pure script
|| (isSpecialScript script && script `notElem` exts)
|| (script `elem` exts)
then pure ()
else expectationFailure (show (c, script, exts));
isSpecialScript = \case
S.Common -> True
S.Inherited -> True
_ -> False
} in traverse_ check (enumFromTo minBound maxBound)
-- | Return 'True' if a character is in a script.
-- Faster than checking scriptDefinition directly.
inScript :: Char -> S.Script -> Bool
inScript (C# c#) s = case IS.scriptDefinition s of
(# lower#, upper#, addr0#, offset# #) ->
case (cp# <# lower#) `orI#` (upper# <# cp#) of
1# -> False
_ -> case offset# of
0# -> True
_ -> isTrue# ((cp# ==# lower#) `orI#` (cp# ==# upper#))
|| check addr0#
where
cp# = ord# c#
addr1# = addr0# `plusAddr#` offset#
check addr# = case addr1# `ltAddr#` addr# of
1# -> False
_ -> case nextInt32# addr# of
cp1# -> case andI# cp1# IS.ScriptCharMask of
-- Range
0# ->
isTrue# ((cp1# <=# cp#) `andI#`
(cp# <=# nextInt32# (addr# `plusAddr#` 4#)))
|| check (addr# `plusAddr#` 8#)
-- Single char
_ -> case andI# IS.ScriptCharMaskComplement cp1# -# cp# of
0# -> True
_ -> check (addr# `plusAddr#` 4#)