{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.CharSet.Unicode.Block
-- Copyright   :  (c) Edward Kmett 2010-2011
-- License     :  BSD3
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Provides unicode general categories, which are typically connoted by
-- @\p{InBasicLatin}@ or @\p{InIPA_Extensions}@. Lookups can be constructed using 'categories'
-- or individual character sets can be used directly.
-------------------------------------------------------------------------------

module Data.CharSet.Unicode.Block
    (
    -- * Unicode General Category
      Block(..)
    -- * Lookup
    , blocks
    , lookupBlock
    , lookupBlockCharSet
    -- * CharSets by Block
    , basicLatin
    , latin1Supplement
    , latinExtendedA
    , latinExtendedB
    , ipaExtensions
    , spacingModifierLetters
    , combiningDiacriticalMarks
    , greekAndCoptic
    , cyrillic
    , cyrillicSupplementary
    , armenian
    , hebrew
    , arabic
    , syriac
    , thaana
    , devanagari
    , bengali
    , gurmukhi
    , gujarati
    , oriya
    , tamil
    , telugu
    , kannada
    , malayalam
    , sinhala
    , thai
    , lao
    , tibetan
    , myanmar
    , georgian
    , hangulJamo
    , ethiopic
    , cherokee
    , unifiedCanadianAboriginalSyllabics
    , ogham
    , runic
    , tagalog
    , hanunoo
    , buhid
    , tagbanwa
    , khmer
    , mongolian
    , limbu
    , taiLe
    , khmerSymbols
    , phoneticExtensions
    , latinExtendedAdditional
    , greekExtended
    , generalPunctuation
    , superscriptsAndSubscripts
    , currencySymbols
    , combiningDiacriticalMarksForSymbols
    , letterlikeSymbols
    , numberForms
    , arrows
    , mathematicalOperators
    , miscellaneousTechnical
    , controlPictures
    , opticalCharacterRecognition
    , enclosedAlphanumerics
    , boxDrawing
    , blockElements
    , geometricShapes
    , miscellaneousSymbols
    , dingbats
    , miscellaneousMathematicalSymbolsA
    , supplementalArrowsA
    , braillePatterns
    , supplementalArrowsB
    , miscellaneousMathematicalSymbolsB
    , supplementalMathematicalOperators
    , miscellaneousSymbolsAndArrows
    , cjkRadicalsSupplement
    , kangxiRadicals
    , ideographicDescriptionCharacters
    , cjkSymbolsAndPunctuation
    , hiragana
    , katakana
    , bopomofo
    , hangulCompatibilityJamo
    , kanbun
    , bopomofoExtended
    , katakanaPhoneticExtensions
    , enclosedCjkLettersAndMonths
    , cjkCompatibility
    , cjkUnifiedIdeographsExtensionA
    , yijingHexagramSymbols
    , cjkUnifiedIdeographs
    , yiSyllables
    , yiRadicals
    , hangulSyllables
    , highSurrogates
    , highPrivateUseSurrogates
    , lowSurrogates
    , privateUseArea
    , cjkCompatibilityIdeographs
    , alphabeticPresentationForms
    , arabicPresentationFormsA
    , variationSelectors
    , combiningHalfMarks
    , cjkCompatibilityForms
    , smallFormVariants
    , arabicPresentationFormsB
    , halfwidthAndFullwidthForms
    , specials
    ) where

import Data.Char
import Data.CharSet
import Data.Data
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap

data Block = Block
    { Block -> String
blockName :: String
    , Block -> CharSet
blockCharSet :: CharSet
    } deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, Typeable Block
DataType
Constr
Typeable Block =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Block -> c Block)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Block)
-> (Block -> Constr)
-> (Block -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Block))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block))
-> ((forall b. Data b => b -> b) -> Block -> Block)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r)
-> (forall u. (forall d. Data d => d -> u) -> Block -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Block -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Block -> m Block)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Block -> m Block)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Block -> m Block)
-> Data Block
Block -> DataType
Block -> Constr
(forall b. Data b => b -> b) -> Block -> Block
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Block -> u
forall u. (forall d. Data d => d -> u) -> Block -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block -> m Block
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Block)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
$cBlock :: Constr
$tBlock :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Block -> m Block
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapMp :: (forall d. Data d => d -> m d) -> Block -> m Block
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapM :: (forall d. Data d => d -> m d) -> Block -> m Block
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Block -> m Block
gmapQi :: Int -> (forall d. Data d => d -> u) -> Block -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Block -> u
gmapQ :: (forall d. Data d => d -> u) -> Block -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Block -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Block -> r
gmapT :: (forall b. Data b => b -> b) -> Block -> Block
$cgmapT :: (forall b. Data b => b -> b) -> Block -> Block
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Block)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Block)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Block)
dataTypeOf :: Block -> DataType
$cdataTypeOf :: Block -> DataType
toConstr :: Block -> Constr
$ctoConstr :: Block -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Block
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Block -> c Block
$cp1Data :: Typeable Block
Data, Typeable)

blocks :: [Block]
blocks :: [Block]
blocks =
    [ String -> CharSet -> Block
Block "Basic_Latin" CharSet
basicLatin
    , String -> CharSet -> Block
Block "Latin-1_Supplement" CharSet
latin1Supplement
    , String -> CharSet -> Block
Block "Latin_Extended-A" CharSet
latinExtendedA
    , String -> CharSet -> Block
Block "Latin_Extended-B" CharSet
latinExtendedB
    , String -> CharSet -> Block
Block "IPA_Extensions" CharSet
ipaExtensions
    , String -> CharSet -> Block
Block "Spacing_Modifier_Letters" CharSet
spacingModifierLetters
    , String -> CharSet -> Block
Block "Combining_Diacritical_Marks" CharSet
combiningDiacriticalMarks
    , String -> CharSet -> Block
Block "Greek_and_Coptic" CharSet
greekAndCoptic
    , String -> CharSet -> Block
Block "Cyrillic" CharSet
cyrillic
    , String -> CharSet -> Block
Block "Cyrillic_Supplementary" CharSet
cyrillicSupplementary
    , String -> CharSet -> Block
Block "Armenian" CharSet
armenian
    , String -> CharSet -> Block
Block "Hebrew" CharSet
hebrew
    , String -> CharSet -> Block
Block "Arabic" CharSet
arabic
    , String -> CharSet -> Block
Block "Syriac" CharSet
syriac
    , String -> CharSet -> Block
Block "Thaana" CharSet
thaana
    , String -> CharSet -> Block
Block "Devanagari" CharSet
devanagari
    , String -> CharSet -> Block
Block "Bengali" CharSet
bengali
    , String -> CharSet -> Block
Block "Gurmukhi" CharSet
gurmukhi
    , String -> CharSet -> Block
Block "Gujarati" CharSet
gujarati
    , String -> CharSet -> Block
Block "Oriya" CharSet
oriya
    , String -> CharSet -> Block
Block "Tamil" CharSet
tamil
    , String -> CharSet -> Block
Block "Telugu" CharSet
telugu
    , String -> CharSet -> Block
Block "Kannada" CharSet
kannada
    , String -> CharSet -> Block
Block "Malayalam" CharSet
malayalam
    , String -> CharSet -> Block
Block "Sinhala" CharSet
sinhala
    , String -> CharSet -> Block
Block "Thai" CharSet
thai
    , String -> CharSet -> Block
Block "Lao" CharSet
lao
    , String -> CharSet -> Block
Block "Tibetan" CharSet
tibetan
    , String -> CharSet -> Block
Block "Myanmar" CharSet
myanmar
    , String -> CharSet -> Block
Block "Georgian" CharSet
georgian
    , String -> CharSet -> Block
Block "Hangul_Jamo" CharSet
hangulJamo
    , String -> CharSet -> Block
Block "Ethiopic" CharSet
ethiopic
    , String -> CharSet -> Block
Block "Cherokee" CharSet
cherokee
    , String -> CharSet -> Block
Block "Unified_Canadian_Aboriginal_Syllabics" CharSet
unifiedCanadianAboriginalSyllabics
    , String -> CharSet -> Block
Block "Ogham" CharSet
ogham
    , String -> CharSet -> Block
Block "Runic" CharSet
runic
    , String -> CharSet -> Block
Block "Tagalog" CharSet
tagalog
    , String -> CharSet -> Block
Block "Hanunoo" CharSet
hanunoo
    , String -> CharSet -> Block
Block "Buhid" CharSet
buhid
    , String -> CharSet -> Block
Block "Tagbanwa" CharSet
tagbanwa
    , String -> CharSet -> Block
Block "Khmer" CharSet
khmer
    , String -> CharSet -> Block
Block "Mongolian" CharSet
mongolian
    , String -> CharSet -> Block
Block "Limbu" CharSet
limbu
    , String -> CharSet -> Block
Block "Tai_Le" CharSet
taiLe
    , String -> CharSet -> Block
Block "Khmer_Symbols" CharSet
khmerSymbols
    , String -> CharSet -> Block
Block "Phonetic_Extensions" CharSet
phoneticExtensions
    , String -> CharSet -> Block
Block "Latin_Extended_Additional" CharSet
latinExtendedAdditional
    , String -> CharSet -> Block
Block "Greek_Extended" CharSet
greekExtended
    , String -> CharSet -> Block
Block "General_Punctuation" CharSet
generalPunctuation
    , String -> CharSet -> Block
Block "Superscripts_and_Subscripts" CharSet
superscriptsAndSubscripts
    , String -> CharSet -> Block
Block "Currency_Symbols" CharSet
currencySymbols
    , String -> CharSet -> Block
Block "Combining_Diacritical_Marks_for_Symbols" CharSet
combiningDiacriticalMarksForSymbols
    , String -> CharSet -> Block
Block "Letterlike_Symbols" CharSet
letterlikeSymbols
    , String -> CharSet -> Block
Block "Number_Forms" CharSet
numberForms
    , String -> CharSet -> Block
Block "Arrows" CharSet
arrows
    , String -> CharSet -> Block
Block "Mathematical_Operators" CharSet
mathematicalOperators
    , String -> CharSet -> Block
Block "Miscellaneous_Technical" CharSet
miscellaneousTechnical
    , String -> CharSet -> Block
Block "Control_Pictures" CharSet
controlPictures
    , String -> CharSet -> Block
Block "Optical_Character_Recognition" CharSet
opticalCharacterRecognition
    , String -> CharSet -> Block
Block "Enclosed_Alphanumerics" CharSet
enclosedAlphanumerics
    , String -> CharSet -> Block
Block "Box_Drawing" CharSet
boxDrawing
    , String -> CharSet -> Block
Block "Block_Elements" CharSet
blockElements
    , String -> CharSet -> Block
Block "Geometric_Shapes" CharSet
geometricShapes
    , String -> CharSet -> Block
Block "Miscellaneous_Symbols" CharSet
miscellaneousSymbols
    , String -> CharSet -> Block
Block "Dingbats" CharSet
dingbats
    , String -> CharSet -> Block
Block "Miscellaneous_Mathematical_Symbols-A" CharSet
miscellaneousMathematicalSymbolsA
    , String -> CharSet -> Block
Block "Supplemental_Arrows-A" CharSet
supplementalArrowsA
    , String -> CharSet -> Block
Block "Braille_Patterns" CharSet
braillePatterns
    , String -> CharSet -> Block
Block "Supplemental_Arrows-B" CharSet
supplementalArrowsB
    , String -> CharSet -> Block
Block "Miscellaneous_Mathematical_Symbols-B" CharSet
miscellaneousMathematicalSymbolsB
    , String -> CharSet -> Block
Block "Supplemental_Mathematical_Operators" CharSet
supplementalMathematicalOperators
    , String -> CharSet -> Block
Block "Miscellaneous_Symbols_and_Arrows" CharSet
miscellaneousSymbolsAndArrows
    , String -> CharSet -> Block
Block "CJK_Radicals_Supplement" CharSet
cjkRadicalsSupplement
    , String -> CharSet -> Block
Block "Kangxi_Radicals" CharSet
kangxiRadicals
    , String -> CharSet -> Block
Block "Ideographic_Description_Characters" CharSet
ideographicDescriptionCharacters
    , String -> CharSet -> Block
Block "CJK_Symbols_and_Punctuation" CharSet
cjkSymbolsAndPunctuation
    , String -> CharSet -> Block
Block "Hiragana" CharSet
hiragana
    , String -> CharSet -> Block
Block "Katakana" CharSet
katakana
    , String -> CharSet -> Block
Block "Bopomofo" CharSet
bopomofo
    , String -> CharSet -> Block
Block "Hangul_Compatibility_Jamo" CharSet
hangulCompatibilityJamo
    , String -> CharSet -> Block
Block "Kanbun" CharSet
kanbun
    , String -> CharSet -> Block
Block "Bopomofo_Extended" CharSet
bopomofoExtended
    , String -> CharSet -> Block
Block "Katakana_Phonetic_Extensions" CharSet
katakanaPhoneticExtensions
    , String -> CharSet -> Block
Block "Enclosed_CJK_Letters_and_Months" CharSet
enclosedCjkLettersAndMonths
    , String -> CharSet -> Block
Block "CJK_Compatibility" CharSet
cjkCompatibility
    , String -> CharSet -> Block
Block "CJK_Unified_Ideographs_Extension_A" CharSet
cjkUnifiedIdeographsExtensionA
    , String -> CharSet -> Block
Block "Yijing_Hexagram_Symbols" CharSet
yijingHexagramSymbols
    , String -> CharSet -> Block
Block "CJK_Unified_Ideographs" CharSet
cjkUnifiedIdeographs
    , String -> CharSet -> Block
Block "Yi_Syllables" CharSet
yiSyllables
    , String -> CharSet -> Block
Block "Yi_Radicals" CharSet
yiRadicals
    , String -> CharSet -> Block
Block "Hangul_Syllables" CharSet
hangulSyllables
    , String -> CharSet -> Block
Block "High_Surrogates" CharSet
highSurrogates
    , String -> CharSet -> Block
Block "High_Private_Use_Surrogates" CharSet
highPrivateUseSurrogates
    , String -> CharSet -> Block
Block "Low_Surrogates" CharSet
lowSurrogates
    , String -> CharSet -> Block
Block "Private_Use_Area" CharSet
privateUseArea
    , String -> CharSet -> Block
Block "CJK_Compatibility_Ideographs" CharSet
cjkCompatibilityIdeographs
    , String -> CharSet -> Block
Block "Alphabetic_Presentation_Forms" CharSet
alphabeticPresentationForms
    , String -> CharSet -> Block
Block "Arabic_Presentation_Forms-A" CharSet
arabicPresentationFormsA
    , String -> CharSet -> Block
Block "Variation_Selectors" CharSet
variationSelectors
    , String -> CharSet -> Block
Block "Combining_Half_Marks" CharSet
combiningHalfMarks
    , String -> CharSet -> Block
Block "CJK_Compatibility_Forms" CharSet
cjkCompatibilityForms
    , String -> CharSet -> Block
Block "Small_Form_Variants" CharSet
smallFormVariants
    , String -> CharSet -> Block
Block "Arabic_Presentation_Forms-B" CharSet
arabicPresentationFormsB
    , String -> CharSet -> Block
Block "Halfwidth_and_Fullwidth_Forms" CharSet
halfwidthAndFullwidthForms
    , String -> CharSet -> Block
Block "Specials" CharSet
specials ]

lookupTable :: HashMap String Block
lookupTable :: HashMap String Block
lookupTable = [(String, Block)] -> HashMap String Block
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(String, Block)] -> HashMap String Block)
-> [(String, Block)] -> HashMap String Block
forall a b. (a -> b) -> a -> b
$
              (Block -> (String, Block)) -> [Block] -> [(String, Block)]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (\y :: Block
y@(Block x :: String
x _) -> (ShowS
canonicalize String
x, Block
y))
              [Block]
blocks

canonicalize :: String -> String
canonicalize :: ShowS
canonicalize s :: String
s = case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Char
toLower String
s of
    'i': 'n' : xs :: String
xs -> ShowS
go String
xs
    xs :: String
xs -> ShowS
go String
xs
    where
        go :: ShowS
go ('-':xs :: String
xs) = ShowS
go String
xs
        go ('_':xs :: String
xs) = ShowS
go String
xs
        go (' ':xs :: String
xs) = ShowS
go String
xs
        go (x :: Char
x:xs :: String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
xs
        go [] = []

lookupBlock :: String -> Maybe Block
lookupBlock :: String -> Maybe Block
lookupBlock s :: String
s = String -> HashMap String Block -> Maybe Block
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (ShowS
canonicalize String
s) HashMap String Block
lookupTable

lookupBlockCharSet :: String -> Maybe CharSet
lookupBlockCharSet :: String -> Maybe CharSet
lookupBlockCharSet = (Block -> CharSet) -> Maybe Block -> Maybe CharSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> CharSet
blockCharSet (Maybe Block -> Maybe CharSet)
-> (String -> Maybe Block) -> String -> Maybe CharSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Block
lookupBlock

basicLatin :: CharSet
basicLatin = Char -> Char -> CharSet
range '\x0000' '\x007f'
latin1Supplement :: CharSet
latin1Supplement = Char -> Char -> CharSet
range '\x0080' '\x00ff'
latinExtendedA :: CharSet
latinExtendedA = Char -> Char -> CharSet
range '\x0100' '\x017F'
latinExtendedB :: CharSet
latinExtendedB = Char -> Char -> CharSet
range '\x0180' '\x024F'
ipaExtensions :: CharSet
ipaExtensions = Char -> Char -> CharSet
range '\x0250' '\x02AF'
spacingModifierLetters :: CharSet
spacingModifierLetters = Char -> Char -> CharSet
range '\x02B0' '\x02FF'
combiningDiacriticalMarks :: CharSet
combiningDiacriticalMarks = Char -> Char -> CharSet
range '\x0300' '\x036F'
greekAndCoptic :: CharSet
greekAndCoptic = Char -> Char -> CharSet
range '\x0370' '\x03FF'
cyrillic :: CharSet
cyrillic = Char -> Char -> CharSet
range '\x0400' '\x04FF'
cyrillicSupplementary :: CharSet
cyrillicSupplementary = Char -> Char -> CharSet
range '\x0500' '\x052F'
armenian :: CharSet
armenian = Char -> Char -> CharSet
range '\x0530' '\x058F'
hebrew :: CharSet
hebrew = Char -> Char -> CharSet
range '\x0590' '\x05FF'
arabic :: CharSet
arabic = Char -> Char -> CharSet
range '\x0600' '\x06FF'
syriac :: CharSet
syriac = Char -> Char -> CharSet
range '\x0700' '\x074F'
thaana :: CharSet
thaana = Char -> Char -> CharSet
range '\x0780' '\x07BF'
devanagari :: CharSet
devanagari = Char -> Char -> CharSet
range '\x0900' '\x097F'
bengali :: CharSet
bengali = Char -> Char -> CharSet
range '\x0980' '\x09FF'
gurmukhi :: CharSet
gurmukhi = Char -> Char -> CharSet
range '\x0A00' '\x0A7F'
gujarati :: CharSet
gujarati = Char -> Char -> CharSet
range '\x0A80' '\x0AFF'
oriya :: CharSet
oriya = Char -> Char -> CharSet
range '\x0B00' '\x0B7F'
tamil :: CharSet
tamil = Char -> Char -> CharSet
range '\x0B80' '\x0BFF'
telugu :: CharSet
telugu = Char -> Char -> CharSet
range '\x0C00' '\x0C7F'
kannada :: CharSet
kannada = Char -> Char -> CharSet
range '\x0C80' '\x0CFF'
malayalam :: CharSet
malayalam = Char -> Char -> CharSet
range '\x0D00' '\x0D7F'
sinhala :: CharSet
sinhala = Char -> Char -> CharSet
range '\x0D80' '\x0DFF'
thai :: CharSet
thai = Char -> Char -> CharSet
range '\x0E00' '\x0E7F'
lao :: CharSet
lao = Char -> Char -> CharSet
range '\x0E80' '\x0EFF'
tibetan :: CharSet
tibetan = Char -> Char -> CharSet
range '\x0F00' '\x0FFF'
myanmar :: CharSet
myanmar = Char -> Char -> CharSet
range '\x1000' '\x109F'
georgian :: CharSet
georgian = Char -> Char -> CharSet
range '\x10A0' '\x10FF'
hangulJamo :: CharSet
hangulJamo = Char -> Char -> CharSet
range '\x1100' '\x11FF'
ethiopic :: CharSet
ethiopic = Char -> Char -> CharSet
range '\x1200' '\x137F'
cherokee :: CharSet
cherokee = Char -> Char -> CharSet
range '\x13A0' '\x13FF'
unifiedCanadianAboriginalSyllabics :: CharSet
unifiedCanadianAboriginalSyllabics = Char -> Char -> CharSet
range '\x1400' '\x167F'
ogham :: CharSet
ogham = Char -> Char -> CharSet
range '\x1680' '\x169F'
runic :: CharSet
runic = Char -> Char -> CharSet
range '\x16A0' '\x16FF'
tagalog :: CharSet
tagalog = Char -> Char -> CharSet
range '\x1700' '\x171F'
hanunoo :: CharSet
hanunoo = Char -> Char -> CharSet
range '\x1720' '\x173F'
buhid :: CharSet
buhid = Char -> Char -> CharSet
range '\x1740' '\x175F'
tagbanwa :: CharSet
tagbanwa = Char -> Char -> CharSet
range '\x1760' '\x177F'
khmer :: CharSet
khmer = Char -> Char -> CharSet
range '\x1780' '\x17FF'
mongolian :: CharSet
mongolian = Char -> Char -> CharSet
range '\x1800' '\x18AF'
limbu :: CharSet
limbu = Char -> Char -> CharSet
range '\x1900' '\x194F'
taiLe :: CharSet
taiLe = Char -> Char -> CharSet
range '\x1950' '\x197F'
khmerSymbols :: CharSet
khmerSymbols = Char -> Char -> CharSet
range '\x19E0' '\x19FF'
phoneticExtensions :: CharSet
phoneticExtensions = Char -> Char -> CharSet
range '\x1D00' '\x1D7F'
latinExtendedAdditional :: CharSet
latinExtendedAdditional = Char -> Char -> CharSet
range '\x1E00' '\x1EFF'
greekExtended :: CharSet
greekExtended = Char -> Char -> CharSet
range '\x1F00' '\x1FFF'
generalPunctuation :: CharSet
generalPunctuation = Char -> Char -> CharSet
range '\x2000' '\x206F'
superscriptsAndSubscripts :: CharSet
superscriptsAndSubscripts = Char -> Char -> CharSet
range '\x2070' '\x209F'
currencySymbols :: CharSet
currencySymbols = Char -> Char -> CharSet
range '\x20A0' '\x20CF'
combiningDiacriticalMarksForSymbols :: CharSet
combiningDiacriticalMarksForSymbols = Char -> Char -> CharSet
range '\x20D0' '\x20FF'
letterlikeSymbols :: CharSet
letterlikeSymbols = Char -> Char -> CharSet
range '\x2100' '\x214F'
numberForms :: CharSet
numberForms = Char -> Char -> CharSet
range '\x2150' '\x218F'
arrows :: CharSet
arrows = Char -> Char -> CharSet
range '\x2190' '\x21FF'
mathematicalOperators :: CharSet
mathematicalOperators = Char -> Char -> CharSet
range '\x2200' '\x22FF'
miscellaneousTechnical :: CharSet
miscellaneousTechnical = Char -> Char -> CharSet
range '\x2300' '\x23FF'
controlPictures :: CharSet
controlPictures = Char -> Char -> CharSet
range '\x2400' '\x243F'
opticalCharacterRecognition :: CharSet
opticalCharacterRecognition = Char -> Char -> CharSet
range '\x2440' '\x245F'
enclosedAlphanumerics :: CharSet
enclosedAlphanumerics = Char -> Char -> CharSet
range '\x2460' '\x24FF'
boxDrawing :: CharSet
boxDrawing = Char -> Char -> CharSet
range '\x2500' '\x257F'
blockElements :: CharSet
blockElements = Char -> Char -> CharSet
range '\x2580' '\x259F'
geometricShapes :: CharSet
geometricShapes = Char -> Char -> CharSet
range '\x25A0' '\x25FF'
miscellaneousSymbols :: CharSet
miscellaneousSymbols = Char -> Char -> CharSet
range '\x2600' '\x26FF'
dingbats :: CharSet
dingbats = Char -> Char -> CharSet
range '\x2700' '\x27BF'
miscellaneousMathematicalSymbolsA :: CharSet
miscellaneousMathematicalSymbolsA = Char -> Char -> CharSet
range '\x27C0' '\x27EF'
supplementalArrowsA :: CharSet
supplementalArrowsA = Char -> Char -> CharSet
range '\x27F0' '\x27FF'
braillePatterns :: CharSet
braillePatterns = Char -> Char -> CharSet
range '\x2800' '\x28FF'
supplementalArrowsB :: CharSet
supplementalArrowsB = Char -> Char -> CharSet
range '\x2900' '\x297F'
miscellaneousMathematicalSymbolsB :: CharSet
miscellaneousMathematicalSymbolsB = Char -> Char -> CharSet
range '\x2980' '\x29FF'
supplementalMathematicalOperators :: CharSet
supplementalMathematicalOperators = Char -> Char -> CharSet
range '\x2A00' '\x2AFF'
miscellaneousSymbolsAndArrows :: CharSet
miscellaneousSymbolsAndArrows = Char -> Char -> CharSet
range '\x2B00' '\x2BFF'
cjkRadicalsSupplement :: CharSet
cjkRadicalsSupplement = Char -> Char -> CharSet
range '\x2E80' '\x2EFF'
kangxiRadicals :: CharSet
kangxiRadicals = Char -> Char -> CharSet
range '\x2F00' '\x2FDF'
ideographicDescriptionCharacters :: CharSet
ideographicDescriptionCharacters = Char -> Char -> CharSet
range '\x2FF0' '\x2FFF'
cjkSymbolsAndPunctuation :: CharSet
cjkSymbolsAndPunctuation = Char -> Char -> CharSet
range '\x3000' '\x303F'
hiragana :: CharSet
hiragana = Char -> Char -> CharSet
range '\x3040' '\x309F'
katakana :: CharSet
katakana = Char -> Char -> CharSet
range '\x30A0' '\x30FF'
bopomofo :: CharSet
bopomofo = Char -> Char -> CharSet
range '\x3100' '\x312F'
hangulCompatibilityJamo :: CharSet
hangulCompatibilityJamo = Char -> Char -> CharSet
range '\x3130' '\x318F'
kanbun :: CharSet
kanbun = Char -> Char -> CharSet
range '\x3190' '\x319F'
bopomofoExtended :: CharSet
bopomofoExtended = Char -> Char -> CharSet
range '\x31A0' '\x31BF'
katakanaPhoneticExtensions :: CharSet
katakanaPhoneticExtensions = Char -> Char -> CharSet
range '\x31F0' '\x31FF'
enclosedCjkLettersAndMonths :: CharSet
enclosedCjkLettersAndMonths = Char -> Char -> CharSet
range '\x3200' '\x32FF'
cjkCompatibility :: CharSet
cjkCompatibility = Char -> Char -> CharSet
range '\x3300' '\x33FF'
cjkUnifiedIdeographsExtensionA :: CharSet
cjkUnifiedIdeographsExtensionA = Char -> Char -> CharSet
range '\x3400' '\x4DBF'
yijingHexagramSymbols :: CharSet
yijingHexagramSymbols = Char -> Char -> CharSet
range '\x4DC0' '\x4DFF'
cjkUnifiedIdeographs :: CharSet
cjkUnifiedIdeographs = Char -> Char -> CharSet
range '\x4E00' '\x9FFF'
yiSyllables :: CharSet
yiSyllables = Char -> Char -> CharSet
range '\xA000' '\xA48F'
yiRadicals :: CharSet
yiRadicals = Char -> Char -> CharSet
range '\xA490' '\xA4CF'
hangulSyllables :: CharSet
hangulSyllables = Char -> Char -> CharSet
range '\xAC00' '\xD7AF'
highSurrogates :: CharSet
highSurrogates = Char -> Char -> CharSet
range '\xD800' '\xDB7F'
highPrivateUseSurrogates :: CharSet
highPrivateUseSurrogates = Char -> Char -> CharSet
range '\xDB80' '\xDBFF'
lowSurrogates :: CharSet
lowSurrogates = Char -> Char -> CharSet
range '\xDC00' '\xDFFF'
privateUseArea :: CharSet
privateUseArea = Char -> Char -> CharSet
range '\xE000' '\xF8FF'
cjkCompatibilityIdeographs :: CharSet
cjkCompatibilityIdeographs = Char -> Char -> CharSet
range '\xF900' '\xFAFF'
alphabeticPresentationForms :: CharSet
alphabeticPresentationForms = Char -> Char -> CharSet
range '\xFB00' '\xFB4F'
arabicPresentationFormsA :: CharSet
arabicPresentationFormsA = Char -> Char -> CharSet
range '\xFB50' '\xFDFF'
variationSelectors :: CharSet
variationSelectors = Char -> Char -> CharSet
range '\xFE00' '\xFE0F'
combiningHalfMarks :: CharSet
combiningHalfMarks = Char -> Char -> CharSet
range '\xFE20' '\xFE2F'
cjkCompatibilityForms :: CharSet
cjkCompatibilityForms = Char -> Char -> CharSet
range '\xFE30' '\xFE4F'
smallFormVariants :: CharSet
smallFormVariants = Char -> Char -> CharSet
range '\xFE50' '\xFE6F'
arabicPresentationFormsB :: CharSet
arabicPresentationFormsB = Char -> Char -> CharSet
range '\xFE70' '\xFEFF'
halfwidthAndFullwidthForms :: CharSet
halfwidthAndFullwidthForms = Char -> Char -> CharSet
range '\xFF00' '\xFFEF'
specials :: CharSet
specials = Char -> Char -> CharSet
range '\xFFF0' '\xFFFF'