-- | <http://www.unicode.org/charts/PDF/U1D100.pdf>
--
-- These symbols are in <http://www.gnu.org/software/freefont/>,
-- debian=ttf-freefont.
module Music.Theory.Unicode where

import Data.Char {- base -}
import Data.List {- base -}
import Numeric {- base -}

import qualified Text.CSV.Lazy.String as C {- lazy-csv -}

import qualified Music.Theory.Io as T {- hmt-base -}
import qualified Music.Theory.List as T {- hmt-base -}
import qualified Music.Theory.Read as T {- hmt-base -}

-- * Non-music

-- | Unicode non breaking hypen character.
--
-- > non_breaking_hypen == '‑'
non_breaking_hypen :: Char
non_breaking_hypen :: Char
non_breaking_hypen = forall a. Enum a => Unicode_Index -> a
toEnum Unicode_Index
0x2011

-- | Unicode non breaking space character.
--
-- > non_breaking_space == ' '
non_breaking_space :: Char
non_breaking_space :: Char
non_breaking_space = forall a. Enum a => Unicode_Index -> a
toEnum Unicode_Index
0x00A0

-- | Unicode interpunct.
--
-- > middle_dot == '·'
middle_dot :: Char
middle_dot :: Char
middle_dot = forall a. Enum a => Unicode_Index -> a
toEnum Unicode_Index
0x00B7

-- | The superscript variants of the digits 0-9
superscript_digits :: [Char]
superscript_digits :: [Char]
superscript_digits = [Char]
"⁰¹²³⁴⁵⁶⁷⁸⁹"

-- | Map 'show' of 'Int' to 'superscript_digits'.
--
-- > unwords (map int_show_superscript [0,12,345,6789]) == "⁰ ¹² ³⁴⁵ ⁶⁷⁸⁹"
int_show_superscript :: Int -> String
int_show_superscript :: Unicode_Index -> [Char]
int_show_superscript = forall a b. (a -> b) -> [a] -> [b]
map (([Char]
superscript_digits forall a. [a] -> Unicode_Index -> a
!!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Unicode_Index
digitToInt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

-- | The subscript variants of the digits 0-9
subscript_digits :: [Char]
subscript_digits :: [Char]
subscript_digits = [Char]
"₀₁₂₃₄₅₆₇₈₉"

-- | The combining over line character.
--
-- > ['1',combining_overline] == "1̅"
-- > ['A',combining_overline] == "A̅"
combining_overline :: Char
combining_overline :: Char
combining_overline = forall a. Enum a => Unicode_Index -> a
toEnum Unicode_Index
0x0305

-- | Add 'combining_overline' to each 'Char'.
--
-- > overline "1234" == "1̅2̅3̅4̅"
overline :: String -> String
overline :: [Char] -> [Char]
overline = let f :: Char -> [Char]
f Char
x = [Char
x,Char
combining_overline] in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
f

-- | The combining under line character.
--
-- > ['1',combining_underline] == "1̲"
combining_underline :: Char
combining_underline :: Char
combining_underline = forall a. Enum a => Unicode_Index -> a
toEnum Unicode_Index
0x0332

-- | Add 'combining_underline' to each 'Char'.
--
-- > underline "1234" == "1̲2̲3̲4̲"
underline :: String -> String
underline :: [Char] -> [Char]
underline = let f :: Char -> [Char]
f Char
x = [Char
x,Char
combining_underline] in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
f

-- * Table

type Unicode_Index = Int
type Unicode_Name = String
type Unicode_Range = (Unicode_Index,Unicode_Index)
type Unicode_Point = (Unicode_Index,Unicode_Name)
type Unicode_Table = [Unicode_Point]

{- | <http://unicode.org/Public/11.0.0/ucd/UnicodeData.txt>

> let fn = "/home/rohan/data/unicode.org/Public/11.0.0/ucd/UnicodeData.txt"
> tbl <- unicode_data_table_read fn
> length tbl == 32292
> T.reverse_lookup_err "MIDDLE DOT" tbl == 0x00B7
> putStrLn $ unwords $ map (\(n,x) -> toEnum n : x) $ filter (\(_,x) -> "EMPTY SET" `isInfixOf` x) tbl
> T.lookup_err 0x22C5 tbl == "DOT OPERATOR"
-}
unicode_data_table_read :: FilePath -> IO Unicode_Table
unicode_data_table_read :: [Char] -> IO Unicode_Table
unicode_data_table_read [Char]
fn = do
  [Char]
s <- [Char] -> IO [Char]
T.read_file_utf8 [Char]
fn
  let t :: [[[Char]]]
t = CSVTable -> [[[Char]]]
C.fromCSVTable (CSVResult -> CSVTable
C.csvTable (Bool -> Char -> [Char] -> CSVResult
C.parseDSV Bool
False Char
';' [Char]
s))
      f :: [[Char]] -> (a, [Char])
f [[Char]]
x = (forall n. (Eq n, Integral n) => [Char] -> n
T.read_hex_err ([[Char]]
x forall a. [a] -> Unicode_Index -> a
!! Unicode_Index
0),[[Char]]
x forall a. [a] -> Unicode_Index -> a
!! Unicode_Index
1)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Integral a => [[Char]] -> (a, [Char])
f [[[Char]]]
t)

unicode_table_block :: (Unicode_Index,Unicode_Index) -> Unicode_Table -> Unicode_Table
unicode_table_block :: (Unicode_Index, Unicode_Index) -> Unicode_Table -> Unicode_Table
unicode_table_block (Unicode_Index
l,Unicode_Index
r) = forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
<= Unicode_Index
r) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((forall a. Ord a => a -> a -> Bool
< Unicode_Index
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

unicode_point_hs :: Unicode_Point -> String
unicode_point_hs :: Unicode_Point -> [Char]
unicode_point_hs (Unicode_Index
n,[Char]
s) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]
"(0x",forall a. (Integral a, Show a) => a -> [Char] -> [Char]
showHex Unicode_Index
n [Char]
"",[Char]
",\"",[Char]
s,[Char]
"\")"]

unicode_table_hs :: Unicode_Table -> String
unicode_table_hs :: Unicode_Table -> [Char]
unicode_table_hs = forall a. (a, a) -> [a] -> [a]
T.bracket (Char
'[',Char
']') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Unicode_Point -> [Char]
unicode_point_hs

-- * Music

-- > putStrLn$ map (toEnum . fst) (concat music_tbl)
music_tbl :: [Unicode_Table]
music_tbl :: [Unicode_Table]
music_tbl = [Unicode_Table
barlines_tbl,Unicode_Table
accidentals_tbl,Unicode_Table
notes_tbl,Unicode_Table
rests_tbl,Unicode_Table
clefs_tbl]

-- > putStrLn$ concatMap (unicode_table_hs . flip unicode_table_block tbl) accidentals_rng_set
accidentals_rng_set :: [Unicode_Range]
accidentals_rng_set :: [(Unicode_Index, Unicode_Index)]
accidentals_rng_set = [(Unicode_Index
0x266D,Unicode_Index
0x266F),(Unicode_Index
0x1D12A,Unicode_Index
0x1D133)]

-- > putStrLn$ unicode_table_hs (unicode_table_block barlines_rng tbl)
barlines_rng :: Unicode_Range
barlines_rng :: (Unicode_Index, Unicode_Index)
barlines_rng = (Unicode_Index
0x1D100,Unicode_Index
0x1D105)

-- | UNICODE barline symbols.
--
-- > let r = "𝄀𝄁𝄂𝄃𝄄𝄅" in map (toEnum . fst) barlines_tbl == r
barlines_tbl :: Unicode_Table
barlines_tbl :: Unicode_Table
barlines_tbl =
  [(Unicode_Index
0x1D100,[Char]
"MUSICAL SYMBOL SINGLE BARLINE")
  ,(Unicode_Index
0x1D101,[Char]
"MUSICAL SYMBOL DOUBLE BARLINE")
  ,(Unicode_Index
0x1D102,[Char]
"MUSICAL SYMBOL FINAL BARLINE")
  ,(Unicode_Index
0x1D103,[Char]
"MUSICAL SYMBOL REVERSE FINAL BARLINE")
  ,(Unicode_Index
0x1D104,[Char]
"MUSICAL SYMBOL DASHED BARLINE")
  ,(Unicode_Index
0x1D105,[Char]
"MUSICAL SYMBOL SHORT BARLINE")]

-- | UNICODE accidental symbols.
--
-- > let r = "♭♮♯𝄪𝄫𝄬𝄭𝄮𝄯𝄰𝄱𝄲𝄳" in map (toEnum . fst) accidentals_tbl == r
accidentals_tbl :: Unicode_Table
accidentals_tbl :: Unicode_Table
accidentals_tbl =
    [(Unicode_Index
0x266D,[Char]
"MUSIC FLAT SIGN")
    ,(Unicode_Index
0x266E,[Char]
"MUSIC NATURAL SIGN")
    ,(Unicode_Index
0x266F,[Char]
"MUSIC SHARP SIGN")
    ,(Unicode_Index
0x1D12A,[Char]
"MUSICAL SYMBOL DOUBLE SHARP")
    ,(Unicode_Index
0x1D12B,[Char]
"MUSICAL SYMBOL DOUBLE FLAT")
    ,(Unicode_Index
0x1D12C,[Char]
"MUSICAL SYMBOL FLAT UP")
    ,(Unicode_Index
0x1D12D,[Char]
"MUSICAL SYMBOL FLAT DOWN")
    ,(Unicode_Index
0x1D12E,[Char]
"MUSICAL SYMBOL NATURAL UP")
    ,(Unicode_Index
0x1D12F,[Char]
"MUSICAL SYMBOL NATURAL DOWN")
    ,(Unicode_Index
0x1D130,[Char]
"MUSICAL SYMBOL SHARP UP")
    ,(Unicode_Index
0x1D131,[Char]
"MUSICAL SYMBOL SHARP DOWN")
    ,(Unicode_Index
0x1D132,[Char]
"MUSICAL SYMBOL QUARTER TONE SHARP")
    ,(Unicode_Index
0x1D133,[Char]
"MUSICAL SYMBOL QUARTER TONE FLAT")]

-- > putStrLn$ unicode_table_hs (unicode_table_block notes_rng tbl)
notes_rng :: Unicode_Range
notes_rng :: (Unicode_Index, Unicode_Index)
notes_rng = (Unicode_Index
0x1D15C,Unicode_Index
0x1D164)

-- | UNICODE note duration symbols.
--
-- > let r = "𝅜𝅝𝅗𝅥𝅘𝅥𝅘𝅥𝅮𝅘𝅥𝅯𝅘𝅥𝅰𝅘𝅥𝅱𝅘𝅥𝅲" in map (toEnum . fst) notes_tbl == r
notes_tbl :: Unicode_Table
notes_tbl :: Unicode_Table
notes_tbl =
    [(Unicode_Index
0x1D15C,[Char]
"MUSICAL SYMBOL BREVE")
    ,(Unicode_Index
0x1D15D,[Char]
"MUSICAL SYMBOL WHOLE NOTE")
    ,(Unicode_Index
0x1D15E,[Char]
"MUSICAL SYMBOL HALF NOTE")
    ,(Unicode_Index
0x1D15F,[Char]
"MUSICAL SYMBOL QUARTER NOTE")
    ,(Unicode_Index
0x1D160,[Char]
"MUSICAL SYMBOL EIGHTH NOTE")
    ,(Unicode_Index
0x1D161,[Char]
"MUSICAL SYMBOL SIXTEENTH NOTE")
    ,(Unicode_Index
0x1D162,[Char]
"MUSICAL SYMBOL THIRTY-SECOND NOTE")
    ,(Unicode_Index
0x1D163,[Char]
"MUSICAL SYMBOL SIXTY-FOURTH NOTE")
    ,(Unicode_Index
0x1D164,[Char]
"MUSICAL SYMBOL ONE HUNDRED TWENTY-EIGHTH NOTE")]

-- > putStrLn$ unicode_table_hs (unicode_table_block rests_rng tbl)
rests_rng :: Unicode_Range
rests_rng :: (Unicode_Index, Unicode_Index)
rests_rng = (Unicode_Index
0x1D13B,Unicode_Index
0x1D142)

-- | UNICODE rest symbols.
--
-- > let r = "𝄻𝄼𝄽𝄾𝄿𝅀𝅁𝅂" in map (toEnum . fst) rests_tbl == r
rests_tbl :: Unicode_Table
rests_tbl :: Unicode_Table
rests_tbl =
    [(Unicode_Index
0x1D13B,[Char]
"MUSICAL SYMBOL WHOLE REST")
    ,(Unicode_Index
0x1D13C,[Char]
"MUSICAL SYMBOL HALF REST")
    ,(Unicode_Index
0x1D13D,[Char]
"MUSICAL SYMBOL QUARTER REST")
    ,(Unicode_Index
0x1D13E,[Char]
"MUSICAL SYMBOL EIGHTH REST")
    ,(Unicode_Index
0x1D13F,[Char]
"MUSICAL SYMBOL SIXTEENTH REST")
    ,(Unicode_Index
0x1D140,[Char]
"MUSICAL SYMBOL THIRTY-SECOND REST")
    ,(Unicode_Index
0x1D141,[Char]
"MUSICAL SYMBOL SIXTY-FOURTH REST")
    ,(Unicode_Index
0x1D142,[Char]
"MUSICAL SYMBOL ONE HUNDRED TWENTY-EIGHTH REST")]

-- | Augmentation dot.
--
-- > map toEnum [0x1D15E,0x1D16D,0x1D16D] == "𝅗𝅥𝅭𝅭"
augmentation_dot :: Unicode_Point
augmentation_dot :: Unicode_Point
augmentation_dot = (Unicode_Index
0x1D16D, [Char]
"MUSICAL SYMBOL COMBINING AUGMENTATION DOT")

-- > putStrLn$ unicode_table_hs (unicode_table_block clefs_rng tbl)
clefs_rng :: Unicode_Range
clefs_rng :: (Unicode_Index, Unicode_Index)
clefs_rng = (Unicode_Index
0x1D11E,Unicode_Index
0x1D126)

-- | UNICODE clef symbols.
--
-- > let r = "𝄞𝄟𝄠𝄡𝄢𝄣𝄤𝄥𝄦" in map (toEnum . fst) clefs_tbl == r
clefs_tbl :: Unicode_Table
clefs_tbl :: Unicode_Table
clefs_tbl =
    [(Unicode_Index
0x1D11E,[Char]
"MUSICAL SYMBOL G CLEF")
    ,(Unicode_Index
0x1D11F,[Char]
"MUSICAL SYMBOL G CLEF OTTAVA ALTA")
    ,(Unicode_Index
0x1D120,[Char]
"MUSICAL SYMBOL G CLEF OTTAVA BASSA")
    ,(Unicode_Index
0x1D121,[Char]
"MUSICAL SYMBOL C CLEF")
    ,(Unicode_Index
0x1D122,[Char]
"MUSICAL SYMBOL F CLEF")
    ,(Unicode_Index
0x1D123,[Char]
"MUSICAL SYMBOL F CLEF OTTAVA ALTA")
    ,(Unicode_Index
0x1D124,[Char]
"MUSICAL SYMBOL F CLEF OTTAVA BASSA")
    ,(Unicode_Index
0x1D125,[Char]
"MUSICAL SYMBOL DRUM CLEF-1")
    ,(Unicode_Index
0x1D126,[Char]
"MUSICAL SYMBOL DRUM CLEF-2")]

-- > putStrLn$ unicode_table_hs (unicode_table_block noteheads_rng tbl)
noteheads_rng :: Unicode_Range
noteheads_rng :: (Unicode_Index, Unicode_Index)
noteheads_rng = (Unicode_Index
0x1D143,Unicode_Index
0x1D15B)

-- | UNICODE notehead symbols.
--
-- > let r = "𝅃𝅄𝅅𝅆𝅇𝅈𝅉𝅊𝅋𝅌𝅍𝅎𝅏𝅐𝅑𝅒𝅓𝅔𝅕𝅖𝅗𝅘𝅙𝅚𝅛" in map (toEnum . fst) noteheads_tbl == r
noteheads_tbl :: Unicode_Table
noteheads_tbl :: Unicode_Table
noteheads_tbl =
    [(Unicode_Index
0x1d143,[Char]
"MUSICAL SYMBOL X NOTEHEAD")
    ,(Unicode_Index
0x1d144,[Char]
"MUSICAL SYMBOL PLUS NOTEHEAD")
    ,(Unicode_Index
0x1d145,[Char]
"MUSICAL SYMBOL CIRCLE X NOTEHEAD")
    ,(Unicode_Index
0x1d146,[Char]
"MUSICAL SYMBOL SQUARE NOTEHEAD WHITE")
    ,(Unicode_Index
0x1d147,[Char]
"MUSICAL SYMBOL SQUARE NOTEHEAD BLACK")
    ,(Unicode_Index
0x1d148,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD UP WHITE")
    ,(Unicode_Index
0x1d149,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD UP BLACK")
    ,(Unicode_Index
0x1d14a,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD LEFT WHITE")
    ,(Unicode_Index
0x1d14b,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD LEFT BLACK")
    ,(Unicode_Index
0x1d14c,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD RIGHT WHITE")
    ,(Unicode_Index
0x1d14d,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD RIGHT BLACK")
    ,(Unicode_Index
0x1d14e,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD DOWN WHITE")
    ,(Unicode_Index
0x1d14f,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD DOWN BLACK")
    ,(Unicode_Index
0x1d150,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD UP RIGHT WHITE")
    ,(Unicode_Index
0x1d151,[Char]
"MUSICAL SYMBOL TRIANGLE NOTEHEAD UP RIGHT BLACK")
    ,(Unicode_Index
0x1d152,[Char]
"MUSICAL SYMBOL MOON NOTEHEAD WHITE")
    ,(Unicode_Index
0x1d153,[Char]
"MUSICAL SYMBOL MOON NOTEHEAD BLACK")
    ,(Unicode_Index
0x1d154,[Char]
"MUSICAL SYMBOL TRIANGLE-ROUND NOTEHEAD DOWN WHITE")
    ,(Unicode_Index
0x1d155,[Char]
"MUSICAL SYMBOL TRIANGLE-ROUND NOTEHEAD DOWN BLACK")
    ,(Unicode_Index
0x1d156,[Char]
"MUSICAL SYMBOL PARENTHESIS NOTEHEAD")
    ,(Unicode_Index
0x1d157,[Char]
"MUSICAL SYMBOL VOID NOTEHEAD")
    ,(Unicode_Index
0x1d158,[Char]
"MUSICAL SYMBOL NOTEHEAD BLACK")
    ,(Unicode_Index
0x1d159,[Char]
"MUSICAL SYMBOL NULL NOTEHEAD")
    ,(Unicode_Index
0x1d15a,[Char]
"MUSICAL SYMBOL CLUSTER NOTEHEAD WHITE")
    ,(Unicode_Index
0x1d15b,[Char]
"MUSICAL SYMBOL CLUSTER NOTEHEAD BLACK")]

-- > map toEnum [0x1D143,0x1D165] == "𝅃𝅥"
stem :: Unicode_Point
stem :: Unicode_Point
stem = (Unicode_Index
0x1D165, [Char]
"MUSICAL SYMBOL COMBINING STEM")

-- > putStrLn$ unicode_table_hs (unicode_table_block dynamics_rng tbl)
dynamics_rng :: Unicode_Range
dynamics_rng :: (Unicode_Index, Unicode_Index)
dynamics_rng = (Unicode_Index
0x1D18C,Unicode_Index
0x1D193)

-- > map (toEnum . fst) dynamics_tbl == "𝆌𝆍𝆎𝆏𝆐𝆑𝆒𝆓"
dynamics_tbl :: Unicode_Table
dynamics_tbl :: Unicode_Table
dynamics_tbl =
    [(Unicode_Index
0x1d18c,[Char]
"MUSICAL SYMBOL RINFORZANDO")
    ,(Unicode_Index
0x1d18d,[Char]
"MUSICAL SYMBOL SUBITO")
    ,(Unicode_Index
0x1d18e,[Char]
"MUSICAL SYMBOL Z")
    ,(Unicode_Index
0x1d18f,[Char]
"MUSICAL SYMBOL PIANO")
    ,(Unicode_Index
0x1d190,[Char]
"MUSICAL SYMBOL MEZZO")
    ,(Unicode_Index
0x1d191,[Char]
"MUSICAL SYMBOL FORTE")
    ,(Unicode_Index
0x1d192,[Char]
"MUSICAL SYMBOL CRESCENDO")
    ,(Unicode_Index
0x1d193,[Char]
"MUSICAL SYMBOL DECRESCENDO")]

-- > putStrLn$ unicode_table_hs (unicode_table_block articulations_rng tbl)
articulations_rng :: Unicode_Range
articulations_rng :: (Unicode_Index, Unicode_Index)
articulations_rng = (Unicode_Index
0x1D17B,Unicode_Index
0x1D18B)

-- > putStrLn (map (toEnum . fst) articulations_tbl :: String)
articulations_tbl :: Unicode_Table
articulations_tbl :: Unicode_Table
articulations_tbl =
    [(Unicode_Index
0x1d17b,[Char]
"MUSICAL SYMBOL COMBINING ACCENT")
    ,(Unicode_Index
0x1d17c,[Char]
"MUSICAL SYMBOL COMBINING STACCATO")
    ,(Unicode_Index
0x1d17d,[Char]
"MUSICAL SYMBOL COMBINING TENUTO")
    ,(Unicode_Index
0x1d17e,[Char]
"MUSICAL SYMBOL COMBINING STACCATISSIMO")
    ,(Unicode_Index
0x1d17f,[Char]
"MUSICAL SYMBOL COMBINING MARCATO")
    ,(Unicode_Index
0x1d180,[Char]
"MUSICAL SYMBOL COMBINING MARCATO-STACCATO")
    ,(Unicode_Index
0x1d181,[Char]
"MUSICAL SYMBOL COMBINING ACCENT-STACCATO")
    ,(Unicode_Index
0x1d182,[Char]
"MUSICAL SYMBOL COMBINING LOURE")
    ,(Unicode_Index
0x1d183,[Char]
"MUSICAL SYMBOL ARPEGGIATO UP")
    ,(Unicode_Index
0x1d184,[Char]
"MUSICAL SYMBOL ARPEGGIATO DOWN")
    ,(Unicode_Index
0x1d185,[Char]
"MUSICAL SYMBOL COMBINING DOIT")
    ,(Unicode_Index
0x1d186,[Char]
"MUSICAL SYMBOL COMBINING RIP")
    ,(Unicode_Index
0x1d187,[Char]
"MUSICAL SYMBOL COMBINING FLIP")
    ,(Unicode_Index
0x1d188,[Char]
"MUSICAL SYMBOL COMBINING SMEAR")
    ,(Unicode_Index
0x1d189,[Char]
"MUSICAL SYMBOL COMBINING BEND")
    ,(Unicode_Index
0x1d18a,[Char]
"MUSICAL SYMBOL COMBINING DOUBLE TONGUE")
    ,(Unicode_Index
0x1d18b,[Char]
"MUSICAL SYMBOL COMBINING TRIPLE TONGUE")]

-- * Math

ix_set_to_tbl :: Unicode_Table -> [Unicode_Index] -> Unicode_Table
ix_set_to_tbl :: Unicode_Table -> [Unicode_Index] -> Unicode_Table
ix_set_to_tbl Unicode_Table
tbl [Unicode_Index]
ix = forall a b. [a] -> [b] -> [(a, b)]
zip [Unicode_Index]
ix (forall a b. (a -> b) -> [a] -> [b]
map (forall k v. Eq k => k -> [(k, v)] -> v
`T.lookup_err` Unicode_Table
tbl) [Unicode_Index]
ix)

-- | Unicode dot-operator.
--
-- > dot_operator == '⋅'
dot_operator :: Char
dot_operator :: Char
dot_operator = forall a. Enum a => Unicode_Index -> a
toEnum Unicode_Index
0x22C5

-- | Math symbols outside of the math blocks.
--
-- > putStrLn (unicode_table_hs (ix_set_to_tbl tbl math_plain_ix))
math_plain_ix :: [Unicode_Index]
math_plain_ix :: [Unicode_Index]
math_plain_ix = [Unicode_Index
0x00D7,Unicode_Index
0x00F7]

-- > map (toEnum . fst) math_plain_tbl == "×÷"
math_plain_tbl :: Unicode_Table
math_plain_tbl :: Unicode_Table
math_plain_tbl = [(Unicode_Index
0xd7,[Char]
"MULTIPLICATION SIGN"),(Unicode_Index
0xf7,[Char]
"DIVISION SIGN")]

-- * Blocks

type Unicode_Block = (Unicode_Range,String)

-- > putStrLn$ unicode_table_hs (concatMap (flip unicode_table_block tbl . fst) unicode_blocks)
unicode_blocks :: [Unicode_Block]
unicode_blocks :: [Unicode_Block]
unicode_blocks =
    [((Unicode_Index
0x01B00,Unicode_Index
0x01B7F),[Char]
"Balinese")
    ,((Unicode_Index
0x02200,Unicode_Index
0x022FF),[Char]
"Mathematical Operators")
    ,((Unicode_Index
0x025A0,Unicode_Index
0x025FF),[Char]
"Geometric Shapes")
    ,((Unicode_Index
0x027C0,Unicode_Index
0x027EF),[Char]
"Miscellaneous Mathematical Symbols-A")
    ,((Unicode_Index
0x027F0,Unicode_Index
0x027FF),[Char]
"Supplemental Arrows-A")
    ,((Unicode_Index
0x02800,Unicode_Index
0x028FF),[Char]
"Braille Patterns")
    ,((Unicode_Index
0x02900,Unicode_Index
0x0297F),[Char]
"Supplemental Arrows-B")
    ,((Unicode_Index
0x02980,Unicode_Index
0x029FF),[Char]
"Miscellaneous Mathematical Symbols-B")
    ,((Unicode_Index
0x02A00,Unicode_Index
0x02AFF),[Char]
"Supplemental Mathematical Operators")
    ,((Unicode_Index
0x1D000,Unicode_Index
0x1D0FF),[Char]
"Byzantine Musical Symbols")
    ,((Unicode_Index
0x1D100,Unicode_Index
0x1D1FF),[Char]
"Musical Symbols")
    ,((Unicode_Index
0x1D200,Unicode_Index
0x1D24F),[Char]
"Ancient Greek Musical Notation")
    ]

-- * BAGUA, EIGHT TRI-GRAMS

-- | Bagua tri-grams.
--
-- > putStrLn $ unicode_table_hs (unicode_table_block (fst bagua) tbl)
bagua :: Unicode_Block
bagua :: Unicode_Block
bagua = ((Unicode_Index
0x02630,Unicode_Index
0x02637),[Char]
"BAGUA")

{- | Table of eight tri-grams.

HEAVEN,乾,Qián,☰,111
LAKE,兌,Duì,☱,110
FIRE,離,Lí,☲,101
THUNDER,震,Zhèn,☳,100
WIND,巽,Xùn,☴,011
WATER,坎,Kǎn,☵,010
MOUNTAIN,艮,Gèn,☶,001
EARTH,坤,Kūn,☷,000

-}
bagua_tbl :: Unicode_Table
bagua_tbl :: Unicode_Table
bagua_tbl =
  [(Unicode_Index
0x2630,[Char]
"TRIGRAM FOR HEAVEN")
  ,(Unicode_Index
0x2631,[Char]
"TRIGRAM FOR LAKE")
  ,(Unicode_Index
0x2632,[Char]
"TRIGRAM FOR FIRE")
  ,(Unicode_Index
0x2633,[Char]
"TRIGRAM FOR THUNDER")
  ,(Unicode_Index
0x2634,[Char]
"TRIGRAM FOR WIND")
  ,(Unicode_Index
0x2635,[Char]
"TRIGRAM FOR WATER")
  ,(Unicode_Index
0x2636,[Char]
"TRIGRAM FOR MOUNTAIN")
  ,(Unicode_Index
0x2637,[Char]
"TRIGRAM FOR EARTH")]

-- * YIJING (I-CHING), SIXTY-FOUR HEXAGRAMS

-- | Yijing hexagrams in King Wen sequence.
--
-- > putStrLn $ unicode_table_hs (unicode_table_block (fst yijing) tbl)
yijing :: Unicode_Block
yijing :: Unicode_Block
yijing = ((Unicode_Index
0x04DC0,Unicode_Index
0x04DFF),[Char]
"YIJING")

{- | Yijing hexagrams in King Wen sequence.

䷀,乾,qián,111,111
䷁,坤,kūn,000,000
䷂,屯,chún,100,010
䷃,蒙,méng,010,001
䷄,需,xū,111,010
䷅,訟,sòng,010,111
䷆,師,shī,010,000
䷇,比,bǐ,000,010
䷈,小畜,xiǎo chù,111,011
䷉,履,lǚ,110,111
䷊,泰,tài,111,000
䷋,否,pǐ,000,111
䷌,同人,tóng rén,101,111
䷍,大有,dà yǒu,111,101
䷎,謙,qiān,001,000
䷏,豫,yù,000,100
䷐,隨,suí,100,110
䷑,蠱,gŭ,011,001
䷒,臨,lín,110,000
䷓,觀,guān,000,011
䷔,噬嗑,shì kè,100,101
䷕,賁,bì,101,001
䷖,剝,bō,000,001
䷗,復,fù,100,000
䷘,無妄,wú wàng,100,111
䷙,大畜,dà chù,111,001
䷚,頤,yí,100,001
䷛,大過,dà guò,011,110
䷜,坎,kǎn,010,010
䷝,離,lí,101,101
䷞,咸,xián,001,110
䷟,恆,héng,011,100
䷠,遯,dùn,001,111
䷡,大壯,dà zhuàng,111,100
䷢,晉,jìn,000,101
䷣,明夷,míng yí,101,000
䷤,家人,jiā rén,101,011
䷥,睽,kuí,110,101
䷦,蹇,jiǎn,001,010
䷧,解,xiè,010,100
䷨,損,sǔn,110,001
䷩,益,yì,100,011
䷪,夬,guài,111,110
䷫,姤,gòu,011,111
䷬,萃,cuì,000,110
䷭,升,shēng,011,000
䷮,困,kùn,010,110
䷯,井,jǐng,011,010
䷰,革,gé,101,110
䷱,鼎,dǐng,011,101
䷲,震,zhèn,100,100
䷳,艮,gèn,001,001
䷴,漸,jiàn,001,011
䷵,歸妹,guī mèi,110,100
䷶,豐,fēng,101,100
䷷,旅,lǚ,001,101
䷸,巽,xùn,011,011
䷹,兌,duì,110,110
䷺,渙,huàn,010,011
䷻,節,jié,110,010
䷼,中孚,zhōng fú,110,011
䷽,小過,xiǎo guò,001,110
䷾,既濟,jì jì,101,010
䷿,未濟,wèi jì,010,101
-}
yijing_tbl :: Unicode_Table
yijing_tbl :: Unicode_Table
yijing_tbl =
  [(Unicode_Index
0x4dc0,[Char]
"HEXAGRAM FOR THE CREATIVE HEAVEN")
  ,(Unicode_Index
0x4dc1,[Char]
"HEXAGRAM FOR THE RECEPTIVE EARTH")
  ,(Unicode_Index
0x4dc2,[Char]
"HEXAGRAM FOR DIFFICULTY AT THE BEGINNING")
  ,(Unicode_Index
0x4dc3,[Char]
"HEXAGRAM FOR YOUTHFUL FOLLY")
  ,(Unicode_Index
0x4dc4,[Char]
"HEXAGRAM FOR WAITING")
  ,(Unicode_Index
0x4dc5,[Char]
"HEXAGRAM FOR CONFLICT")
  ,(Unicode_Index
0x4dc6,[Char]
"HEXAGRAM FOR THE ARMY")
  ,(Unicode_Index
0x4dc7,[Char]
"HEXAGRAM FOR HOLDING TOGETHER")
  ,(Unicode_Index
0x4dc8,[Char]
"HEXAGRAM FOR SMALL TAMING")
  ,(Unicode_Index
0x4dc9,[Char]
"HEXAGRAM FOR TREADING")
  ,(Unicode_Index
0x4dca,[Char]
"HEXAGRAM FOR PEACE")
  ,(Unicode_Index
0x4dcb,[Char]
"HEXAGRAM FOR STANDSTILL")
  ,(Unicode_Index
0x4dcc,[Char]
"HEXAGRAM FOR FELLOWSHIP")
  ,(Unicode_Index
0x4dcd,[Char]
"HEXAGRAM FOR GREAT POSSESSION")
  ,(Unicode_Index
0x4dce,[Char]
"HEXAGRAM FOR MODESTY")
  ,(Unicode_Index
0x4dcf,[Char]
"HEXAGRAM FOR ENTHUSIASM")
  ,(Unicode_Index
0x4dd0,[Char]
"HEXAGRAM FOR FOLLOWING")
  ,(Unicode_Index
0x4dd1,[Char]
"HEXAGRAM FOR WORK ON THE DECAYED")
  ,(Unicode_Index
0x4dd2,[Char]
"HEXAGRAM FOR APPROACH")
  ,(Unicode_Index
0x4dd3,[Char]
"HEXAGRAM FOR CONTEMPLATION")
  ,(Unicode_Index
0x4dd4,[Char]
"HEXAGRAM FOR BITING THROUGH")
  ,(Unicode_Index
0x4dd5,[Char]
"HEXAGRAM FOR GRACE")
  ,(Unicode_Index
0x4dd6,[Char]
"HEXAGRAM FOR SPLITTING APART")
  ,(Unicode_Index
0x4dd7,[Char]
"HEXAGRAM FOR RETURN")
  ,(Unicode_Index
0x4dd8,[Char]
"HEXAGRAM FOR INNOCENCE")
  ,(Unicode_Index
0x4dd9,[Char]
"HEXAGRAM FOR GREAT TAMING")
  ,(Unicode_Index
0x4dda,[Char]
"HEXAGRAM FOR MOUTH CORNERS")
  ,(Unicode_Index
0x4ddb,[Char]
"HEXAGRAM FOR GREAT PREPONDERANCE")
  ,(Unicode_Index
0x4ddc,[Char]
"HEXAGRAM FOR THE ABYSMAL WATER")
  ,(Unicode_Index
0x4ddd,[Char]
"HEXAGRAM FOR THE CLINGING FIRE")
  ,(Unicode_Index
0x4dde,[Char]
"HEXAGRAM FOR INFLUENCE")
  ,(Unicode_Index
0x4ddf,[Char]
"HEXAGRAM FOR DURATION")
  ,(Unicode_Index
0x4de0,[Char]
"HEXAGRAM FOR RETREAT")
  ,(Unicode_Index
0x4de1,[Char]
"HEXAGRAM FOR GREAT POWER")
  ,(Unicode_Index
0x4de2,[Char]
"HEXAGRAM FOR PROGRESS")
  ,(Unicode_Index
0x4de3,[Char]
"HEXAGRAM FOR DARKENING OF THE LIGHT")
  ,(Unicode_Index
0x4de4,[Char]
"HEXAGRAM FOR THE FAMILY")
  ,(Unicode_Index
0x4de5,[Char]
"HEXAGRAM FOR OPPOSITION")
  ,(Unicode_Index
0x4de6,[Char]
"HEXAGRAM FOR OBSTRUCTION")
  ,(Unicode_Index
0x4de7,[Char]
"HEXAGRAM FOR DELIVERANCE")
  ,(Unicode_Index
0x4de8,[Char]
"HEXAGRAM FOR DECREASE")
  ,(Unicode_Index
0x4de9,[Char]
"HEXAGRAM FOR INCREASE")
  ,(Unicode_Index
0x4dea,[Char]
"HEXAGRAM FOR BREAKTHROUGH")
  ,(Unicode_Index
0x4deb,[Char]
"HEXAGRAM FOR COMING TO MEET")
  ,(Unicode_Index
0x4dec,[Char]
"HEXAGRAM FOR GATHERING TOGETHER")
  ,(Unicode_Index
0x4ded,[Char]
"HEXAGRAM FOR PUSHING UPWARD")
  ,(Unicode_Index
0x4dee,[Char]
"HEXAGRAM FOR OPPRESSION")
  ,(Unicode_Index
0x4def,[Char]
"HEXAGRAM FOR THE WELL")
  ,(Unicode_Index
0x4df0,[Char]
"HEXAGRAM FOR REVOLUTION")
  ,(Unicode_Index
0x4df1,[Char]
"HEXAGRAM FOR THE CAULDRON")
  ,(Unicode_Index
0x4df2,[Char]
"HEXAGRAM FOR THE AROUSING THUNDER")
  ,(Unicode_Index
0x4df3,[Char]
"HEXAGRAM FOR THE KEEPING STILL MOUNTAIN")
  ,(Unicode_Index
0x4df4,[Char]
"HEXAGRAM FOR DEVELOPMENT")
  ,(Unicode_Index
0x4df5,[Char]
"HEXAGRAM FOR THE MARRYING MAIDEN")
  ,(Unicode_Index
0x4df6,[Char]
"HEXAGRAM FOR ABUNDANCE")
  ,(Unicode_Index
0x4df7,[Char]
"HEXAGRAM FOR THE WANDERER")
  ,(Unicode_Index
0x4df8,[Char]
"HEXAGRAM FOR THE GENTLE WIND")
  ,(Unicode_Index
0x4df9,[Char]
"HEXAGRAM FOR THE JOYOUS LAKE")
  ,(Unicode_Index
0x4dfa,[Char]
"HEXAGRAM FOR DISPERSION")
  ,(Unicode_Index
0x4dfb,[Char]
"HEXAGRAM FOR LIMITATION")
  ,(Unicode_Index
0x4dfc,[Char]
"HEXAGRAM FOR INNER TRUTH")
  ,(Unicode_Index
0x4dfd,[Char]
"HEXAGRAM FOR SMALL PREPONDERANCE")
  ,(Unicode_Index
0x4dfe,[Char]
"HEXAGRAM FOR AFTER COMPLETION")
  ,(Unicode_Index
0x4dff,[Char]
"HEXAGRAM FOR BEFORE COMPLETION")]