{-# LANGUAGE Safe #-}

{-|
Module      : Data.Char.Math
Description : A module to write math unicode alphanumerical characters.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

= Introduction
This module aims to make it more convenient to transform mathematical characters
to their /double struck/, /fraktur/, /calligraphic/, etc. equivalent.

Most of the characters are defined in the @<https://www.unicode.org/charts/PDF/U1D400.pdf 1D400–1D7FF>@
Unicode block /Mathematical Alphanumeric Symbols/.
See also the <https://en.wikipedia.org/wiki/Mathematical_Alphanumeric_Symbols Wikipedia page>.

== Examples
>>> math Serif Italic Bold 'x'
Just '\119961'
>>> math Serif Italic Bold '3'
Just '\120785'
>>> latinMath Serif Italic Bold 'x'
Just '\119961'
>>> latinMath Serif Italic Bold '3'
Nothing
>>> script NoBold 'S'
Just '\119982'
>>> intToDigitChar SansSerif Bold 3
Just '\120815'
>>> intToDigitChar SansSerif Bold 33
Nothing

== Supported ranges of characters #characters_ranges#
The transformations of this module only supports the following small subset of Unicode points:

[ASCII latin letters] @A@–@Z@ and @a@–@z@ ranges
[Greek-like symbols]

    * The following characters from the Unicode block [/Greek and Coptic/](http://unicode.org/charts/PDF/U0370.pdf):
      @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩϴαβγδεζηθικλμνξοπρςστυφχψωϵϑϰϕϱϖ@.
    * The following characters from the Unicode block [/Mathematical Operators/](https://www.unicode.org/charts/PDF/U2200.pdf):
      @∇∂@.

[Digits] @0@–@9@ range

== Naming Conventions
The functions with a name finishing with a quote @'@ (such as 'math'') do not check their input:
they transform the characters in the supported range and have an /unspecified behaviour/ outside this range.

The functions without a quote in their name (such as 'math') check their input and output and wrap the
resulting transformation with 'Maybe'.
-}

module Data.Char.Math (
    -- * Serif/sans-serif mathematical symbols
    math, math'
    -- ** Latin-only characters
  , latinMath
  , mathAlpha, mathAlpha'
    -- ** Serif mathematical symbols
  , serif,               serif'
  , serifNoBold,         serifNoBold'
  , serifBold,           serifBold'
  , serifNoItalic,       serifNoItalic'
  , serifItalic,         serifItalic'
  , serifNoBoldNoItalic, serifNoBoldNoItalic'
  , serifBoldNoItalic,   serifBoldNoItalic'
  , serifNoBoldItalic,   serifNoBoldItalic'
  , serifBoldItalic,     serifBoldItalic'
    -- ** Sans-serif mathematical symbols
  , sansSerif,               sansSerif'
  , sansSerifNoBold,         sansSerifNoBold'
  , sansSerifBold,           sansSerifBold'
  , sansSerifNoItalic,       sansSerifNoItalic'
  , sansSerifItalic,         sansSerifItalic'
  , sansSerifNoBoldNoItalic, sansSerifNoBoldNoItalic'
  , sansSerifBoldNoItalic,   sansSerifBoldNoItalic'
  , sansSerifNoBoldItalic,   sansSerifNoBoldItalic'
  , sansSerifBoldItalic,     sansSerifBoldItalic'
    -- * Digit characters
    -- ** Char-based conversion
  , digit,                 digit'
  , digitSansSerif,        digitSansSerif'
  , digitSerif,            digitSerif'
  , digitSerifRegular,     digitSerifRegular'
  , digitSerifBold,        digitSerifBold'
  , digitSansSerifRegular, digitSansSerifRegular'
  , digitSansSerifBold,    digitSansSerifBold'
  , digitMonospace,        digitMonospace'
  , digitDoubleStruck,     digitDoubleStruck'
    -- ** Int to digit characters
  , intToDigitChar,             intToDigitChar'
  , intToDigitSerif,            intToDigitSerif'
  , intToDigitSansSerif,        intToDigitSansSerif'
  , intToDigitSerifRegular,     intToDigitSerifRegular'
  , intToDigitSerifBold,        intToDigitSerifBold'
  , intToDigitMonospace,        intToDigitMonospace'
  , intToDigitDoubleStruck,     intToDigitDoubleStruck'
    -- * Monospace symbols
  , monospace, monospace'
    -- * Double struck symbols
  , doubleStruck, doubleStruck'
    -- * Script (or calligraphic symbols)
  , script,             script'
  , scriptRegular,      scriptRegular'
  , scriptBold,         scriptBold'
  , calligraphy,        calligraphy'
  , calligraphyRegular, calligraphyRegular'
  , calligraphyBold,    calligraphyBold'
    -- * Fraktur symbols
  , fraktur,        fraktur'
  , frakturRegular, frakturRegular'
  , frakturBold,    frakturBold'
  ) where

import Data.Char.Core (Emphasis, FontStyle, ItalicType, splitFontStyle, isAsciiAlpha)
import Data.Char.Math.DoubleStruck
import Data.Char.Math.Fraktur
import Data.Char.Math.Monospace
import Data.Char.Math.SansSerif
import Data.Char.Math.Script
import Data.Char.Math.Serif

-- | Convert the given character to a mathematical symbol with the given /font/ style, with a
-- given /emphasis/ and a given /italics/ style. This maps characters an equivalent sans-serif symbol for
-- characters in the [supported ranges](#characters_ranges).
-- For characters outside the range, the behavior is unspecified.
math'
  :: FontStyle  -- ^ The given 'FontStyle' to use.
  -> ItalicType  -- ^ The given 'ItalicType' to use.
  -> Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted in the given 'FontStyle', depending on the given 'Emphasis' in bold or not, and depending on the given 'ItalicType' in italics or not.
math' :: FontStyle -> ItalicType -> Emphasis -> Char -> Char
math' = (ItalicType -> Emphasis -> Char -> Char)
-> (ItalicType -> Emphasis -> Char -> Char)
-> FontStyle
-> ItalicType
-> Emphasis
-> Char
-> Char
forall a. a -> a -> FontStyle -> a
splitFontStyle ItalicType -> Emphasis -> Char -> Char
sansSerif' ItalicType -> Emphasis -> Char -> Char
serif'

-- | Convert the given character to a mathematical symbol with the given /font/
-- style, in the given /emphasis/ and in the given /italics/ type wrapped in a 'Just'
-- if the character is supported (see: [supported ranges](#characters_ranges))
-- If the character is outside theses ranges, 'Nothing' is returned.
math
  :: FontStyle  -- ^ The given 'FontStyle' to use.
  -> ItalicType  -- ^ The given 'ItalicType' to use.
  -> Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
math :: FontStyle -> ItalicType -> Emphasis -> Char -> Maybe Char
math = (ItalicType -> Emphasis -> Char -> Maybe Char)
-> (ItalicType -> Emphasis -> Char -> Maybe Char)
-> FontStyle
-> ItalicType
-> Emphasis
-> Char
-> Maybe Char
forall a. a -> a -> FontStyle -> a
splitFontStyle ItalicType -> Emphasis -> Char -> Maybe Char
sansSerif ItalicType -> Emphasis -> Char -> Maybe Char
serif

{-# DEPRECATED mathAlpha' "Use `math'`" #-}
-- | Convert the given character to a mathematical symbol with the given /font/ style, with a
-- given /emphasis/ and a given /italics/ style. This maps characters an equivalent sansSerif symbol for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
mathAlpha'
  :: FontStyle  -- ^ The given 'FontStyle' to use.
  -> ItalicType  -- ^ The given 'ItalicType' to use.
  -> Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted in the given 'FontStyle', depending on the given 'Emphasis' in bold or not, and depending on the given 'ItalicType' in italics or not.
mathAlpha' :: FontStyle -> ItalicType -> Emphasis -> Char -> Char
mathAlpha' = FontStyle -> ItalicType -> Emphasis -> Char -> Char
math'

{-# DEPRECATED mathAlpha "Use `latinMath`" #-}
-- | Convert the given character to a mathematical symbol with the given /font/
-- style, in the given /emphasis/ and in the given /italics/ type wrapped in a 'Just'. If
-- the character is outside the @A@–@Z@ and @a@–@z@ range, 'Nothing' is returned.
mathAlpha
  :: FontStyle  -- ^ The given 'FontStyle' to use.
  -> ItalicType  -- ^ The given 'ItalicType' to use.
  -> Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
mathAlpha :: FontStyle -> ItalicType -> Emphasis -> Char -> Maybe Char
mathAlpha = FontStyle -> ItalicType -> Emphasis -> Char -> Maybe Char
latinMath

-- | Convert the given character to a mathematical symbol with the given /font/
-- style, in the given /emphasis/ and in the given /italics/ type wrapped in a 'Just'. If
-- the character is outside the @A@–@Z@ and @a@–@z@ range, 'Nothing' is returned.
latinMath
  :: FontStyle  -- ^ The given 'FontStyle' to use.
  -> ItalicType  -- ^ The given 'ItalicType' to use.
  -> Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
latinMath :: FontStyle -> ItalicType -> Emphasis -> Char -> Maybe Char
latinMath FontStyle
f ItalicType
i Emphasis
e Char
c
  | Char -> Bool
isAsciiAlpha Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char) -> Char -> Maybe Char
forall a b. (a -> b) -> a -> b
$ (ItalicType -> Emphasis -> Char -> Char)
-> (ItalicType -> Emphasis -> Char -> Char)
-> FontStyle
-> ItalicType
-> Emphasis
-> Char
-> Char
forall a. a -> a -> FontStyle -> a
splitFontStyle ItalicType -> Emphasis -> Char -> Char
sansSerif' ItalicType -> Emphasis -> Char -> Char
serif' FontStyle
f ItalicType
i Emphasis
e Char
c
  | Bool
otherwise      = Maybe Char
forall a. Maybe a
Nothing

-- | Convert the given digit character (@0@–@9@) to its corresponding character
-- with a given 'Emphasis' in the given /font/ style. The result for characters outside this
-- range is unspecified.
digit'
  :: FontStyle  -- ^ The given /font/ style.
  -> Emphasis  -- ^ The given /emphasis/ style.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The corresponding symbol in the given /font/ style for the given /emphasis/ style, unspecified outside the the range.
digit' :: FontStyle -> Emphasis -> Char -> Char
digit' = (Emphasis -> Char -> Char)
-> (Emphasis -> Char -> Char)
-> FontStyle
-> Emphasis
-> Char
-> Char
forall a. a -> a -> FontStyle -> a
splitFontStyle Emphasis -> Char -> Char
digitSansSerif' Emphasis -> Char -> Char
digitSerif'

-- | Convert the given digit character (@0@–@9@) to its corresponding character
-- with the given 'Emphasis' in the given /font/ style wrapped in a 'Just' data constructor.
-- For characters outside this range, 'Nothing' is returned.
digit
  :: FontStyle  -- ^ The given /font/ style.
  -> Emphasis  -- ^ The given /emphasis/ style.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The corresponding symbol in serifs for the given /emphasis/ style wrapped in a 'Just',
                -- 'Nothing' if the character is outside the range.
digit :: FontStyle -> Emphasis -> Char -> Maybe Char
digit = (Emphasis -> Char -> Maybe Char)
-> (Emphasis -> Char -> Maybe Char)
-> FontStyle
-> Emphasis
-> Char
-> Maybe Char
forall a. a -> a -> FontStyle -> a
splitFontStyle Emphasis -> Char -> Maybe Char
digitSansSerif Emphasis -> Char -> Maybe Char
digitSerif

-- | Convert the given number (@0@–@9@) to its corresponding character
-- with a given 'Emphasis' in the given 'FontStyle'. The result for numbers outside this
-- range is unspecified.
intToDigitChar'
  :: FontStyle  -- ^ The given /font/ style.
  -> Emphasis  -- ^ The given /emphasis/ style.
  -> Int  -- ^ The given number to convert.
  -> Char  -- ^ The corresponding symbol in sans-serifs in the given /font/ style the given /emphasis/ style, unspecified outside the the range.
intToDigitChar' :: FontStyle -> Emphasis -> Int -> Char
intToDigitChar' = (Emphasis -> Int -> Char)
-> (Emphasis -> Int -> Char)
-> FontStyle
-> Emphasis
-> Int
-> Char
forall a. a -> a -> FontStyle -> a
splitFontStyle Emphasis -> Int -> Char
intToDigitSansSerif' Emphasis -> Int -> Char
intToDigitSerif'

-- | Convert the given number (@0@–@9@) to its corresponding character
-- with the given 'Emphasis' in the given 'FontStyle' wrapped in a 'Just' data constructor.
-- For numbers outside this range, 'Nothing' is returned.
intToDigitChar
  :: FontStyle  -- ^ The given /font/ style.
  -> Emphasis  -- ^ The given /emphasis/ style.
  -> Int  -- ^ The given number to convert.
  -> Maybe Char  -- ^ The corresponding symbol in the given /font/ style in the given /emphasis/ style wrapped in a 'Just',
                -- 'Nothing' if the character is outside the range.
intToDigitChar :: FontStyle -> Emphasis -> Int -> Maybe Char
intToDigitChar = (Emphasis -> Int -> Maybe Char)
-> (Emphasis -> Int -> Maybe Char)
-> FontStyle
-> Emphasis
-> Int
-> Maybe Char
forall a. a -> a -> FontStyle -> a
splitFontStyle Emphasis -> Int -> Maybe Char
intToDigitSansSerif Emphasis -> Int -> Maybe Char
intToDigitSerif