{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}

-- |
-- Module      : Data.Char.Small
-- Description : A module used to render subscript and superscript in Unicode.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- One can make use of a <https://www.unicode.org/charts/PDF/U2070.pdf block of Unicode characters> to /emulate/ subscript and superscript. Note that the subscript and superscript will be
-- aligned with the /baseline/ and the /cap line/ respectively, and is thus not equivalent to @<sub>...</sub>@ and @<sup>...</sup>@ in HTML. Furthermore only a small subset of characters
-- is supported.
--
-- This module allows one to map certain characters to their subscript and superscript counterpart, and furthermore makes it more convenient to transform a number (both positive and negative)
-- to a 'Text' that specifies this number in subscript and superscript.
module Data.Char.Small
  ( -- * Convert characters to their subscript and superscript counterpart
    toSub,
    toSup,

    -- * Convert superscript and subscript back their normal character
    fromSubSup,

    -- * Numbers as subscript and superscript.
    asSub,
    asSub',
    asSubPlus,
    asSup,
    asSup',
    asSupPlus,

    -- * Ratio formatting
    ratioToUnicode,
    ratioToUnicode',
    ratioPartsToUnicode,
    ratioPartsToUnicode',

    -- * Ratio parsing
    unicodeToRatio,
    unicodeToRatioParts,
  )
where

import Data.Bits ((.&.), (.|.))
import Data.Char (chr, isDigit, ord)
import Data.Char.Core (PlusStyle (WithPlus, WithoutPlus), positionalNumberSystem10)
import Data.Default.Class (Default (def))
import Data.Ratio (Ratio, denominator, numerator, (%))
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif

import Data.Text (Text, cons, singleton, snoc, unpack)
import qualified Data.Text as T
import Text.Read (readMaybe)

-- | Convert a set of characters to their superscript counterpart, given that
-- characters exists.
toSup ::
  -- | The given character to convert to its superscript counterpart.
  Char ->
  -- | A character wrapped in a 'Just' given the counterpart exists, 'Nothing' otherwise.
  Maybe Char
toSup :: Char -> Maybe Char
toSup Char
'i' = forall a. a -> Maybe a
Just Char
'\x2071'
toSup Char
'+' = forall a. a -> Maybe a
Just Char
'\x207a'
toSup Char
'-' = forall a. a -> Maybe a
Just Char
'\x207b'
toSup Char
'\x2212' = forall a. a -> Maybe a
Just Char
'\x207b'
toSup Char
'=' = forall a. a -> Maybe a
Just Char
'\x207c'
toSup Char
'(' = forall a. a -> Maybe a
Just Char
'\x207d'
toSup Char
')' = forall a. a -> Maybe a
Just Char
'\x207e'
toSup Char
'n' = forall a. a -> Maybe a
Just Char
'\x207f'
toSup Char
'h' = forall a. a -> Maybe a
Just Char
'\x02b0'
toSup Char
'ɦ' = forall a. a -> Maybe a
Just Char
'\x02b1'
toSup Char
'j' = forall a. a -> Maybe a
Just Char
'\x02b2'
toSup Char
'r' = forall a. a -> Maybe a
Just Char
'\x02b3'
toSup Char
'ɹ' = forall a. a -> Maybe a
Just Char
'\x02b4'
toSup Char
'ɻ' = forall a. a -> Maybe a
Just Char
'\x02b5'
toSup Char
'ʁ' = forall a. a -> Maybe a
Just Char
'\x02b6'
toSup Char
'w' = forall a. a -> Maybe a
Just Char
'\x02b7'
toSup Char
'y' = forall a. a -> Maybe a
Just Char
'\x02b8'
toSup Char
'A' = forall a. a -> Maybe a
Just Char
'\x1d2c'
toSup Char
'Æ' = forall a. a -> Maybe a
Just Char
'\x1d2d'
toSup Char
'B' = forall a. a -> Maybe a
Just Char
'\x1d2e'
toSup Char
'D' = forall a. a -> Maybe a
Just Char
'\x1d30'
toSup Char
'E' = forall a. a -> Maybe a
Just Char
'\x1d31'
toSup Char
'Ǝ' = forall a. a -> Maybe a
Just Char
'\x1d32'
toSup Char
'G' = forall a. a -> Maybe a
Just Char
'\x1d33'
toSup Char
'H' = forall a. a -> Maybe a
Just Char
'\x1d34'
toSup Char
'I' = forall a. a -> Maybe a
Just Char
'\x1d35'
toSup Char
'J' = forall a. a -> Maybe a
Just Char
'\x1d36'
toSup Char
'K' = forall a. a -> Maybe a
Just Char
'\x1d37'
toSup Char
'L' = forall a. a -> Maybe a
Just Char
'\x1d38'
toSup Char
'M' = forall a. a -> Maybe a
Just Char
'\x1d39'
toSup Char
'N' = forall a. a -> Maybe a
Just Char
'\x1d3a'
toSup Char
'O' = forall a. a -> Maybe a
Just Char
'\x1d3c'
toSup Char
'Ȣ' = forall a. a -> Maybe a
Just Char
'\x1d3d'
toSup Char
'P' = forall a. a -> Maybe a
Just Char
'\x1d3e'
toSup Char
'R' = forall a. a -> Maybe a
Just Char
'\x1d3f'
toSup Char
'T' = forall a. a -> Maybe a
Just Char
'\x1d40'
toSup Char
'U' = forall a. a -> Maybe a
Just Char
'\x1d41'
toSup Char
'W' = forall a. a -> Maybe a
Just Char
'\x1d42'
toSup Char
'a' = forall a. a -> Maybe a
Just Char
'\x1d43'
toSup Char
'ɐ' = forall a. a -> Maybe a
Just Char
'\x1d44'
toSup Char
'ɑ' = forall a. a -> Maybe a
Just Char
'\x1d45'
toSup Char
'ᴂ' = forall a. a -> Maybe a
Just Char
'\x1d46'
toSup Char
'b' = forall a. a -> Maybe a
Just Char
'\x1d47'
toSup Char
'd' = forall a. a -> Maybe a
Just Char
'\x1d48'
toSup Char
'e' = forall a. a -> Maybe a
Just Char
'\x1d49'
toSup Char
'ə' = forall a. a -> Maybe a
Just Char
'\x1d4a'
toSup Char
'ɛ' = forall a. a -> Maybe a
Just Char
'\x1d4b'
toSup Char
'ɜ' = forall a. a -> Maybe a
Just Char
'\x1d4c'
toSup Char
'g' = forall a. a -> Maybe a
Just Char
'\x1d4d'
toSup Char
'k' = forall a. a -> Maybe a
Just Char
'\x1d4f'
toSup Char
'm' = forall a. a -> Maybe a
Just Char
'\x1d50'
toSup Char
'ŋ' = forall a. a -> Maybe a
Just Char
'\x1d51'
toSup Char
'o' = forall a. a -> Maybe a
Just Char
'\x1d52'
toSup Char
'ɔ' = forall a. a -> Maybe a
Just Char
'\x1d53'
toSup Char
'ᴖ' = forall a. a -> Maybe a
Just Char
'\x1d54'
toSup Char
'ᴗ' = forall a. a -> Maybe a
Just Char
'\x1d55'
toSup Char
'p' = forall a. a -> Maybe a
Just Char
'\x1d56'
toSup Char
't' = forall a. a -> Maybe a
Just Char
'\x1d57'
toSup Char
'u' = forall a. a -> Maybe a
Just Char
'\x1d58'
toSup Char
'ᴝ' = forall a. a -> Maybe a
Just Char
'\x1d59'
toSup Char
'ɯ' = forall a. a -> Maybe a
Just Char
'\x1d5a'
toSup Char
'v' = forall a. a -> Maybe a
Just Char
'\x1d5b'
toSup Char
'ᴥ' = forall a. a -> Maybe a
Just Char
'\x1d5c'
toSup Char
'н' = forall a. a -> Maybe a
Just Char
'\x1d78'
toSup Char
'β' = forall a. a -> Maybe a
Just Char
'\x1d5d'
toSup Char
'γ' = forall a. a -> Maybe a
Just Char
'\x1d5e'
toSup Char
'δ' = forall a. a -> Maybe a
Just Char
'\x1d5f'
toSup Char
'φ' = forall a. a -> Maybe a
Just Char
'\x1d60'
toSup Char
'χ' = forall a. a -> Maybe a
Just Char
'\x1d61'
toSup Char
'ɣ' = forall a. a -> Maybe a
Just Char
'\x02e0'
toSup Char
'l' = forall a. a -> Maybe a
Just Char
'\x02e1'
toSup Char
's' = forall a. a -> Maybe a
Just Char
'\x02e2'
toSup Char
'x' = forall a. a -> Maybe a
Just Char
'\x02e3'
toSup Char
'ʕ' = forall a. a -> Maybe a
Just Char
'\x02e4'
toSup Char
'ნ' = forall a. a -> Maybe a
Just Char
'\x10fc'
toSup Char
'ɒ' = forall a. a -> Maybe a
Just Char
'\x1d9b'
toSup Char
'c' = forall a. a -> Maybe a
Just Char
'\x1d9c'
toSup Char
'ɕ' = forall a. a -> Maybe a
Just Char
'\x1d9d'
toSup Char
'ð' = forall a. a -> Maybe a
Just Char
'\x1d9e'
-- toSup 'ɜ' = Just '\x1d9f'  already \1d4c
toSup Char
'f' = forall a. a -> Maybe a
Just Char
'\x1da0'
toSup Char
'ɟ' = forall a. a -> Maybe a
Just Char
'\x1da1'
toSup Char
'ɡ' = forall a. a -> Maybe a
Just Char
'\x1da2'
toSup Char
'ɥ' = forall a. a -> Maybe a
Just Char
'\x1da3'
toSup Char
'ɨ' = forall a. a -> Maybe a
Just Char
'\x1da4'
toSup Char
'ɩ' = forall a. a -> Maybe a
Just Char
'\x1da5'
toSup Char
'ɪ' = forall a. a -> Maybe a
Just Char
'\x1da6'
toSup Char
'ᵻ' = forall a. a -> Maybe a
Just Char
'\x1da7'
toSup Char
'ʝ' = forall a. a -> Maybe a
Just Char
'\x1da8'
toSup Char
'ɭ' = forall a. a -> Maybe a
Just Char
'\x1da9'
toSup Char
'ᶅ' = forall a. a -> Maybe a
Just Char
'\x1daa'
toSup Char
'ʟ' = forall a. a -> Maybe a
Just Char
'\x1dab'
toSup Char
'ɱ' = forall a. a -> Maybe a
Just Char
'\x1dac'
toSup Char
'ɰ' = forall a. a -> Maybe a
Just Char
'\x1dad'
toSup Char
'ɲ' = forall a. a -> Maybe a
Just Char
'\x1dae'
toSup Char
'ɳ' = forall a. a -> Maybe a
Just Char
'\x1daf'
toSup Char
'ɴ' = forall a. a -> Maybe a
Just Char
'\x1db0'
toSup Char
'ɵ' = forall a. a -> Maybe a
Just Char
'\x1db1'
toSup Char
'ɸ' = forall a. a -> Maybe a
Just Char
'\x1db2'
toSup Char
'ʂ' = forall a. a -> Maybe a
Just Char
'\x1db3'
toSup Char
'ʃ' = forall a. a -> Maybe a
Just Char
'\x1db4'
toSup Char
'ƫ' = forall a. a -> Maybe a
Just Char
'\x1db5'
toSup Char
'ʉ' = forall a. a -> Maybe a
Just Char
'\x1db6'
toSup Char
'ʊ' = forall a. a -> Maybe a
Just Char
'\x1db7'
toSup Char
'ᴜ' = forall a. a -> Maybe a
Just Char
'\x1db8'
toSup Char
'ʋ' = forall a. a -> Maybe a
Just Char
'\x1db9'
toSup Char
'ʌ' = forall a. a -> Maybe a
Just Char
'\x1dba'
toSup Char
'z' = forall a. a -> Maybe a
Just Char
'\x1dbb'
toSup Char
'ʐ' = forall a. a -> Maybe a
Just Char
'\x1dbc'
toSup Char
'ʑ' = forall a. a -> Maybe a
Just Char
'\x1dbd'
toSup Char
'ʒ' = forall a. a -> Maybe a
Just Char
'\x1dbe'
toSup Char
'θ' = forall a. a -> Maybe a
Just Char
'\x1dbf'
toSup Char
'V' = forall a. a -> Maybe a
Just Char
'\x2c7d'
toSup Char
'ⵡ' = forall a. a -> Maybe a
Just Char
'\x2d7f'
toSup Char
'一' = forall a. a -> Maybe a
Just Char
'\x3192'
toSup Char
'二' = forall a. a -> Maybe a
Just Char
'\x3193'
toSup Char
'三' = forall a. a -> Maybe a
Just Char
'\x3194'
toSup Char
'四' = forall a. a -> Maybe a
Just Char
'\x3195'
toSup Char
'上' = forall a. a -> Maybe a
Just Char
'\x3196'
toSup Char
'中' = forall a. a -> Maybe a
Just Char
'\x3197'
toSup Char
'下' = forall a. a -> Maybe a
Just Char
'\x3198'
toSup Char
'甲' = forall a. a -> Maybe a
Just Char
'\x3199'
toSup Char
'乙' = forall a. a -> Maybe a
Just Char
'\x319a'
toSup Char
'丙' = forall a. a -> Maybe a
Just Char
'\x319b'
toSup Char
'丁' = forall a. a -> Maybe a
Just Char
'\x319c'
toSup Char
'天' = forall a. a -> Maybe a
Just Char
'\x319d'
toSup Char
'地' = forall a. a -> Maybe a
Just Char
'\x319e'
toSup Char
'人' = forall a. a -> Maybe a
Just Char
'\x319f'
toSup Char
'ъ' = forall a. a -> Maybe a
Just Char
'\xa69c'
toSup Char
'ь' = forall a. a -> Maybe a
Just Char
'\xa69d'
toSup Char
'ꝯ' = forall a. a -> Maybe a
Just Char
'\xa770'
toSup Char
'C' = forall a. a -> Maybe a
Just Char
'\xa7f2'
toSup Char
'F' = forall a. a -> Maybe a
Just Char
'\xa7f3'
toSup Char
'Q' = forall a. a -> Maybe a
Just Char
'\xa7f4'
toSup Char
'Ħ' = forall a. a -> Maybe a
Just Char
'\xa7f8'
toSup Char
'œ' = forall a. a -> Maybe a
Just Char
'\xa7f9'
toSup Char
'ꜧ' = forall a. a -> Maybe a
Just Char
'\xab5c'
toSup Char
'ꬷ' = forall a. a -> Maybe a
Just Char
'\xab5d'
toSup Char
'ɫ' = forall a. a -> Maybe a
Just Char
'\xab5e'
toSup Char
'ꭒ' = forall a. a -> Maybe a
Just Char
'\xab5f'
toSup Char
'ʍ' = forall a. a -> Maybe a
Just Char
'\xab69'
toSup Char
'ː' = forall a. a -> Maybe a
Just Char
'\x10781'
toSup Char
'ˑ' = forall a. a -> Maybe a
Just Char
'\x10782'
toSup Char
'æ' = forall a. a -> Maybe a
Just Char
'\x10783'
toSup Char
'ʙ' = forall a. a -> Maybe a
Just Char
'\x10784'
toSup Char
'ɓ' = forall a. a -> Maybe a
Just Char
'\x10785'
toSup Char
'ʣ' = forall a. a -> Maybe a
Just Char
'\x10787'
toSup Char
'\xab66' = forall a. a -> Maybe a
Just Char
'\x10788'
toSup Char
'ʥ' = forall a. a -> Maybe a
Just Char
'\x10789'
toSup Char
'ʤ' = forall a. a -> Maybe a
Just Char
'\x1078a'
toSup Char
'ɖ' = forall a. a -> Maybe a
Just Char
'\x1078b'
toSup Char
'ɗ' = forall a. a -> Maybe a
Just Char
'\x1078c'
toSup Char
'ᶑ' = forall a. a -> Maybe a
Just Char
'\x1078d'
toSup Char
'ɘ' = forall a. a -> Maybe a
Just Char
'\x1078e'
toSup Char
'ɞ' = forall a. a -> Maybe a
Just Char
'\x1078f'
toSup Char
'ʩ' = forall a. a -> Maybe a
Just Char
'\x10790'
toSup Char
'ɤ' = forall a. a -> Maybe a
Just Char
'\x10791'
toSup Char
'ɢ' = forall a. a -> Maybe a
Just Char
'\x10792'
toSup Char
'ɠ' = forall a. a -> Maybe a
Just Char
'\x10793'
toSup Char
'ʛ' = forall a. a -> Maybe a
Just Char
'\x10794'
toSup Char
'ħ' = forall a. a -> Maybe a
Just Char
'\x10795'
toSup Char
'ʜ' = forall a. a -> Maybe a
Just Char
'\x10796'
toSup Char
'ɧ' = forall a. a -> Maybe a
Just Char
'\x10797'
toSup Char
'ʄ' = forall a. a -> Maybe a
Just Char
'\x10798'
toSup Char
'ʪ' = forall a. a -> Maybe a
Just Char
'\x10799'
toSup Char
'ʫ' = forall a. a -> Maybe a
Just Char
'\x1079a'
toSup Char
'ɬ' = forall a. a -> Maybe a
Just Char
'\x1079b'
toSup Char
'\x1df04' = forall a. a -> Maybe a
Just Char
'\x1079c'
toSup Char
'ꞎ' = forall a. a -> Maybe a
Just Char
'\x1079d'
toSup Char
'ɮ' = forall a. a -> Maybe a
Just Char
'\x1079e'
toSup Char
'\x1df05' = forall a. a -> Maybe a
Just Char
'\x1079f'
toSup Char
'ʎ' = forall a. a -> Maybe a
Just Char
'\x107a0'
toSup Char
'\x1df06' = forall a. a -> Maybe a
Just Char
'\x107a1'
toSup Char
'ø' = forall a. a -> Maybe a
Just Char
'\x107a2'
toSup Char
'ɶ' = forall a. a -> Maybe a
Just Char
'\x107a3'
toSup Char
'ɷ' = forall a. a -> Maybe a
Just Char
'\x107a4'
toSup Char
'q' = forall a. a -> Maybe a
Just Char
'\x107a5'
toSup Char
'ɺ' = forall a. a -> Maybe a
Just Char
'\x107a6'
toSup Char
'\x1df08' = forall a. a -> Maybe a
Just Char
'\x107a7'
toSup Char
'ɽ' = forall a. a -> Maybe a
Just Char
'\x107a8'
toSup Char
'ɾ' = forall a. a -> Maybe a
Just Char
'\x107a9'
toSup Char
'ʀ' = forall a. a -> Maybe a
Just Char
'\x107aa'
toSup Char
'ʨ' = forall a. a -> Maybe a
Just Char
'\x107ab'
toSup Char
'ʦ' = forall a. a -> Maybe a
Just Char
'\x107ac'
toSup Char
'\xab67' = forall a. a -> Maybe a
Just Char
'\x107ad'
toSup Char
'ʧ' = forall a. a -> Maybe a
Just Char
'\x107ae'
toSup Char
'ʈ' = forall a. a -> Maybe a
Just Char
'\x107af'
toSup Char
'ⱱ' = forall a. a -> Maybe a
Just Char
'\x107b0'
toSup Char
'ʏ' = forall a. a -> Maybe a
Just Char
'\x107b2'
toSup Char
'ʡ' = forall a. a -> Maybe a
Just Char
'\x107b3'
toSup Char
'ʢ' = forall a. a -> Maybe a
Just Char
'\x107b4'
toSup Char
'ʘ' = forall a. a -> Maybe a
Just Char
'\x107b5'
toSup Char
'ǀ' = forall a. a -> Maybe a
Just Char
'\x107b6'
toSup Char
'ǁ' = forall a. a -> Maybe a
Just Char
'\x107b7'
toSup Char
'ǂ' = forall a. a -> Maybe a
Just Char
'\x107b8'
toSup Char
'\x1df0a' = forall a. a -> Maybe a
Just Char
'\x107b9'
toSup Char
'\x1df1e' = forall a. a -> Maybe a
Just Char
'\x107ba'
toSup Char
c
  | Char -> Bool
isDigit Char
c = forall a. a -> Maybe a
Just (Int -> Char
_digitToSub (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'))
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Convert a set of characters to their subscript counterpart, given that
-- characters exists.
toSub ::
  -- | The given character to convert to its subscript counterpart.
  Char ->
  -- | A character wrapped in a 'Just' given the counterpart exists, 'Nothing' otherwise.
  Maybe Char
toSub :: Char -> Maybe Char
toSub Char
'+' = forall a. a -> Maybe a
Just Char
'\x208a'
toSub Char
'-' = forall a. a -> Maybe a
Just Char
'\x208b'
toSub Char
'\x2212' = forall a. a -> Maybe a
Just Char
'\x208b'
toSub Char
'=' = forall a. a -> Maybe a
Just Char
'\x208c'
toSub Char
'(' = forall a. a -> Maybe a
Just Char
'\x208d'
toSub Char
')' = forall a. a -> Maybe a
Just Char
'\x208e'
toSub Char
'a' = forall a. a -> Maybe a
Just Char
'\x2090'
toSub Char
'e' = forall a. a -> Maybe a
Just Char
'\x2091'
toSub Char
'o' = forall a. a -> Maybe a
Just Char
'\x2092'
toSub Char
'x' = forall a. a -> Maybe a
Just Char
'\x2093'
toSub Char
'\x259' = forall a. a -> Maybe a
Just Char
'\x2094'
toSub Char
'h' = forall a. a -> Maybe a
Just Char
'\x2095'
toSub Char
'j' = forall a. a -> Maybe a
Just Char
'\x2c7c'
toSub Char
'k' = forall a. a -> Maybe a
Just Char
'\x2096'
toSub Char
'l' = forall a. a -> Maybe a
Just Char
'\x2097'
toSub Char
'm' = forall a. a -> Maybe a
Just Char
'\x2098'
toSub Char
'n' = forall a. a -> Maybe a
Just Char
'\x2099'
toSub Char
'p' = forall a. a -> Maybe a
Just Char
'\x209a'
toSub Char
's' = forall a. a -> Maybe a
Just Char
'\x209b'
toSub Char
't' = forall a. a -> Maybe a
Just Char
'\x209c'
toSub Char
'i' = forall a. a -> Maybe a
Just Char
'\x1d62'
toSub Char
'r' = forall a. a -> Maybe a
Just Char
'\x1d63'
toSub Char
'u' = forall a. a -> Maybe a
Just Char
'\x1d64'
toSub Char
'v' = forall a. a -> Maybe a
Just Char
'\x1d65'
toSub Char
'β' = forall a. a -> Maybe a
Just Char
'\x1d66'
toSub Char
'γ' = forall a. a -> Maybe a
Just Char
'\x1d67'
toSub Char
'ρ' = forall a. a -> Maybe a
Just Char
'\x1d68'
toSub Char
'φ' = forall a. a -> Maybe a
Just Char
'\x1d69'
toSub Char
'χ' = forall a. a -> Maybe a
Just Char
'\x1d6a'
toSub Char
c
  | Char -> Bool
isDigit Char
c = forall a. a -> Maybe a
Just (Int -> Char
_digitToSub (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'))
  | Bool
otherwise = forall a. Maybe a
Nothing

_fromSubSup :: Int -> Char
_fromSubSup :: Int -> Char
_fromSubSup Int
0xa = Char
'+'
_fromSubSup Int
0xb = Char
'-'
_fromSubSup Int
0xc = Char
'='
_fromSubSup Int
0xd = Char
'('
_fromSubSup Int
0xe = Char
')'
_fromSubSup Int
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Should not happen!"

-- | Convert subscripts and superscripts back to the original counterpart, so @'⁵'@ back to @'5'@. For non-subscript or -superscript
-- characters, it returns the original character.
fromSubSup ::
  -- | A character to un-subscript or un-superscript, for example @'⁵'@.
  Char ->
  -- | The corresponding original character, for example @'5'@.
  Char
fromSubSup :: Char -> Char
fromSubSup Char
'\x2070' = Char
'0'
fromSubSup Char
'\xb2' = Char
'2'
fromSubSup Char
'\xb3' = Char
'3'
fromSubSup Char
'\xb9' = Char
'1'
fromSubSup Char
'\x2071' = Char
'i'
fromSubSup Char
'\x207f' = Char
'n'
fromSubSup Char
'\x2090' = Char
'a'
fromSubSup Char
'\x2091' = Char
'e'
fromSubSup Char
'\x2092' = Char
'o'
fromSubSup Char
'\x2093' = Char
'x'
fromSubSup Char
'\x2094' = Char
'\x259'
fromSubSup Char
'\x2095' = Char
'h'
fromSubSup Char
'\x2096' = Char
'k'
fromSubSup Char
'\x2097' = Char
'l'
fromSubSup Char
'\x2098' = Char
'm'
fromSubSup Char
'\x2099' = Char
'n'
fromSubSup Char
'\x209a' = Char
'p'
fromSubSup Char
'\x209b' = Char
's'
fromSubSup Char
'\x209c' = Char
't'
fromSubSup Char
x
  | Char
'\x207a' forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
'\x208e' Bool -> Bool -> Bool
&& Int
0x0a forall a. Ord a => a -> a -> Bool
<= Int
m Bool -> Bool -> Bool
&& Int
m forall a. Ord a => a -> a -> Bool
<= Int
0x0e = Int -> Char
_fromSubSup Int
m
  | Char
'\x2074' forall a. Ord a => a -> a -> Bool
<= Char
x Bool -> Bool -> Bool
&& Char
x forall a. Ord a => a -> a -> Bool
<= Char
'\x2089' = Int -> Char
chr (Int
0x30 forall a. Bits a => a -> a -> a
.|. (Char -> Int
ord Char
x forall a. Bits a => a -> a -> a
.&. Int
0xf))
  | Bool
otherwise = Char
x
  where
    m :: Int
m = Char -> Int
ord Char
x forall a. Bits a => a -> a -> a
.&. Int
0xf

_value :: Integral i => (Int -> Char) -> i -> Text
_value :: forall i. Integral i => (Int -> Char) -> i -> Text
_value Int -> Char
f = i -> Text
go
  where
    f' :: i -> Char
f' = Int -> Char
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
    go :: i -> Text
go i
n
      | i
n forall a. Ord a => a -> a -> Bool
<= i
9 = Char -> Text
singleton (i -> Char
f' i
n)
      | Bool
otherwise = Text -> Char -> Text
snoc (i -> Text
go i
q) (i -> Char
f' i
r)
      where
        (i
q, i
r) = forall a. Integral a => a -> a -> (a, a)
quotRem i
n i
10

_prefixSign :: Integral i => Char -> (Int -> Char) -> i -> Text
_prefixSign :: forall i. Integral i => Char -> (Int -> Char) -> i -> Text
_prefixSign Char
c Int -> Char
f i
v
  | i
v forall a. Ord a => a -> a -> Bool
< i
0 = Char -> Text -> Text
cons Char
c (i -> Text
f' (-i
v))
  | Bool
otherwise = i -> Text
f' i
v
  where
    f' :: i -> Text
f' = forall i. Integral i => (Int -> Char) -> i -> Text
_value Int -> Char
f

_prefixSignPlus :: Integral i => Char -> Char -> (Int -> Char) -> i -> Text
_prefixSignPlus :: forall i. Integral i => Char -> Char -> (Int -> Char) -> i -> Text
_prefixSignPlus Char
cp Char
cn Int -> Char
f i
v
  | i
v forall a. Ord a => a -> a -> Bool
< i
0 = Char -> i -> Text
c' Char
cn (-i
v)
  | Bool
otherwise = Char -> i -> Text
c' Char
cp i
v
  where
    c' :: Char -> i -> Text
c' = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => (Int -> Char) -> i -> Text
_value Int -> Char
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
cons

-- | Converting the given numerator and denominator to a fraction
-- where the numerator is written in superscript, and the denominator
-- in subscript. If the denominator is negative, the item is rendered
-- with a minus at the numerator part.
ratioPartsToUnicode ::
  (Integral i, Integral j) =>
  -- | the given plus style that will be applied to the numerator.
  PlusStyle ->
  -- | The given numerator.
  i ->
  -- | The given denominator.
  j ->
  -- | A 'Text' object that presents the fraction with superscript and subscript.
  Text
ratioPartsToUnicode :: forall i j. (Integral i, Integral j) => PlusStyle -> i -> j -> Text
ratioPartsToUnicode PlusStyle
ps i
num j
den
  | j
den forall a. Ord a => a -> a -> Bool
< j
0 = forall i j. (Integral i, Integral j) => PlusStyle -> i -> j -> Text
ratioPartsToUnicode PlusStyle
ps (-i
num) (-j
den)
  | Bool
otherwise = forall i. Integral i => PlusStyle -> i -> Text
asSup PlusStyle
ps i
num forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
cons Char
'\x2044' (forall i. Integral i => i -> Text
asSub' j
den)

-- | Converting the given numerator and denominator to a fraction
-- where the numerator is written in superscript, and the denominator
-- in subscript. If the denominator is negative, the item is rendered
-- with a minus at the numerator part.
ratioPartsToUnicode' ::
  (Integral i, Integral j) =>
  -- | The given numerator.
  i ->
  -- | The given denominator.
  j ->
  -- | A 'Text' object that presents the fraction with superscript and subscript.
  Text
ratioPartsToUnicode' :: forall i j. (Integral i, Integral j) => i -> j -> Text
ratioPartsToUnicode' = forall i j. (Integral i, Integral j) => PlusStyle -> i -> j -> Text
ratioPartsToUnicode forall a. Default a => a
def

-- | Try to convert the given text that contains a fraction to the numerator and denominator. This does *not* take /vulgar fractions/
-- into account. You can process these with 'Dat.Char.Number.VulgarFraction.fromVulgarFallback'.
unicodeToRatioParts ::
  (Read i, Read j) =>
  -- | The 'Text' we try to decode.
  Text ->
  -- | A 2-tuple with the numerator and denominator wrapped in a 'Just' if the fraction can be parsed, 'Nothing' otherwise.
  Maybe (i, j)
unicodeToRatioParts :: forall i j. (Read i, Read j) => Text -> Maybe (i, j)
unicodeToRatioParts Text
t = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i. Read i => [Char] -> Maybe i
_parseInt (Text -> [Char]
unpack Text
n) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall i. Read i => [Char] -> Maybe i
_parseInt (forall a. Int -> [a] -> [a]
drop Int
1 (Text -> [Char]
unpack Text
d))
  where
    ~(Text
n, Text
d) = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
_isFrac ((Char -> Char) -> Text -> Text
T.map Char -> Char
fromSubSup Text
t)

-- | Try to convert the given text that contains a fraction to a 'Ratio'. This does *not* take /vulgar fractions/
-- into account. You can process these with 'Dat.Char.Number.VulgarFraction.fromVulgarFallbackToRatio'.
unicodeToRatio ::
  (Integral i, Read i) =>
  -- | The 'Text' we try to decode.
  Text ->
  -- | The fraction wrapped in a 'Just'; 'Nothing' if the fraction can not be parsed.
  Maybe (Ratio i)
unicodeToRatio :: forall i. (Integral i, Read i) => Text -> Maybe (Ratio i)
unicodeToRatio = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Integral a => a -> a -> Ratio a
(%)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i j. (Read i, Read j) => Text -> Maybe (i, j)
unicodeToRatioParts

-- | Convert the given 'Ratio' object to a sequence of characters with the
-- numerator in superscript and the denominator in subscript. The given
-- 'PlusStyle' is applied to the numerator.
ratioToUnicode ::
  Integral i =>
  -- | The given 'PlusStyle' to use.
  PlusStyle ->
  -- | The given 'Ratio' object to convert to a 'Text'.
  Ratio i ->
  -- | A 'Text' object that denotes the given 'Ratio' making use of superscript and subscript.
  Text
ratioToUnicode :: forall i. Integral i => PlusStyle -> Ratio i -> Text
ratioToUnicode PlusStyle
ps Ratio i
dn = forall i j. (Integral i, Integral j) => PlusStyle -> i -> j -> Text
ratioPartsToUnicode PlusStyle
ps (forall a. Ratio a -> a
numerator Ratio i
dn) (forall a. Ratio a -> a
denominator Ratio i
dn)

-- | Format a given 'Ratio' object to a 'Text' value that formats the ratio with
-- superscript and subscript using the 'Default' 'PlusStyle'.
ratioToUnicode' ::
  Integral i =>
  -- | The given 'Ratio' value to format.
  Ratio i ->
  -- | The 'Text' block that contains a textual representation of the 'Ratio'.
  Text
ratioToUnicode' :: forall i. Integral i => Ratio i -> Text
ratioToUnicode' = forall i. Integral i => PlusStyle -> Ratio i -> Text
ratioToUnicode forall a. Default a => a
def

-- | Convert a number (positive or negative) to a 'Text' object that denotes
-- that number in superscript characters.
asSup ::
  Integral i =>
  -- | The given 'PlusStyle' to use.
  PlusStyle ->
  -- | The given number to convert.
  i ->
  -- | A 'Text' value that denotes the number as a sequence of superscript characters.
  Text
asSup :: forall i. Integral i => PlusStyle -> i -> Text
asSup = forall i.
Integral i =>
(Int -> Char) -> Char -> Char -> PlusStyle -> i -> Text
positionalNumberSystem10 Int -> Char
_digitToSup Char
'\x207a' Char
'\x207b'

-- | Convert a number (positive or negative) to a 'Text' object that denotes that
-- number in superscript characters.
asSup' ::
  Integral i =>
  -- | The number to convert.
  i ->
  -- | A 'Text' value that contains the number as a sequence of superscript characters.
  Text
asSup' :: forall i. Integral i => i -> Text
asSup' = forall i. Integral i => PlusStyle -> i -> Text
asSup PlusStyle
WithoutPlus

-- | Convert a number (positive or negative) to a 'Text' that specifies that
-- number in superscript characters. For positive characters, the superscript
-- contains a plus character (@⁺@).
asSupPlus ::
  Integral i =>
  -- | The number to convert.
  i ->
  -- | A 'Text' value that contains the number as a sequence of superscript characters.
  Text
asSupPlus :: forall i. Integral i => i -> Text
asSupPlus = forall i. Integral i => PlusStyle -> i -> Text
asSup PlusStyle
WithPlus -- _prefixSignPlus '\x207a' '\x207b' _digitToSup

-- | Convert a number (positive or negative) to a 'Text' object that denotes
-- that number in subscript characters.
asSub ::
  Integral i =>
  -- | The given 'PlusStyle' to use.
  PlusStyle ->
  -- | The given number to convert.
  i ->
  -- | A 'Text' value that denotes the number as a sequence of subscript characters.
  Text
asSub :: forall i. Integral i => PlusStyle -> i -> Text
asSub = forall i.
Integral i =>
(Int -> Char) -> Char -> Char -> PlusStyle -> i -> Text
positionalNumberSystem10 Int -> Char
_digitToSub Char
'\x208a' Char
'\x208b'

-- | Convert a number (positive or negative) to a 'Text' that specifies that
-- number in subscript characters.
asSub' ::
  Integral i =>
  -- | The number to convert.
  i ->
  -- | A 'Text' value that contains the number as a sequence of subscript characters.
  Text
asSub' :: forall i. Integral i => i -> Text
asSub' = forall i. Integral i => PlusStyle -> i -> Text
asSub PlusStyle
WithoutPlus

-- | Convert a number (positive or negative) to a 'Text' that specifies that
-- number in subscript characters. For positive characters, the subscript
-- contains a plus character (@₊@).
asSubPlus ::
  Integral i =>
  -- | The number to convert.
  i ->
  -- | A 'Text' value that contains the number as a sequence of subscript characters.
  Text
asSubPlus :: forall i. Integral i => i -> Text
asSubPlus = forall i. Integral i => PlusStyle -> i -> Text
asSub PlusStyle
WithPlus

_digitToSub :: Int -> Char
_digitToSub :: Int -> Char
_digitToSub = Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
8320 forall a. Num a => a -> a -> a
+)

_digitToSup :: Int -> Char
_digitToSup :: Int -> Char
_digitToSup Int
0 = Char
'\x2070'
_digitToSup Int
1 = Char
'\xb9'
_digitToSup Int
n
  | Int
n forall a. Ord a => a -> a -> Bool
<= Int
3 = Int -> Char
chr (Int
176 forall a. Num a => a -> a -> a
+ Int
n)
  | Bool
otherwise = Int -> Char
chr (Int
8304 forall a. Num a => a -> a -> a
+ Int
n)

_parseInt :: Read i => String -> Maybe i
_parseInt :: forall i. Read i => [Char] -> Maybe i
_parseInt (Char
'+' : [Char]
d) = forall i. Read i => [Char] -> Maybe i
readMaybe [Char]
d
_parseInt [Char]
d = forall i. Read i => [Char] -> Maybe i
readMaybe [Char]
d

_isFrac :: Char -> Bool
_isFrac :: Char -> Bool
_isFrac Char
'/' = Bool
True
_isFrac Char
'\x2044' = Bool
True
_isFrac Char
_ = Bool
False