{-# LANGUAGE Safe #-}

-- |
-- Module      : Data.Char.Math.SansSerif
-- Description : Sans serif mathematical alphanumeric symbols
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- See "Data.Char.Math" for further documentation.
module Data.Char.Math.SansSerif
  ( -- * Sans-serif mathematical alphabet symbols
    sansSerif,
    sansSerif',
    sansSerifNoBold,
    sansSerifNoBold',
    sansSerifBold,
    sansSerifBold',
    sansSerifNoItalic,
    sansSerifNoItalic',
    sansSerifItalic,
    sansSerifItalic',
    sansSerifNoBoldNoItalic,
    sansSerifNoBoldNoItalic',
    sansSerifBoldNoItalic,
    sansSerifBoldNoItalic',
    sansSerifNoBoldItalic,
    sansSerifNoBoldItalic',
    sansSerifBoldItalic,
    sansSerifBoldItalic',

    -- * Digit characters

    -- ** Character conversion
    digitSansSerif,
    digitSansSerif',
    digitSansSerifRegular,
    digitSansSerifRegular',
    digitSansSerifBold,
    digitSansSerifBold',

    -- ** Int to digit characters
    intToDigitSansSerif,
    intToDigitSansSerif',
    intToDigitSansSerifRegular,
    intToDigitSansSerifRegular',
    intToDigitSansSerifBold,
    intToDigitSansSerifBold',
  )
where

import Data.Char (isDigit)
import Data.Char.Core (Emphasis, ItalicType, isAsciiAlpha, splitEmphasis, splitItalicType)
import Data.Char.Math.Internal (_dispatchLatinGreekDigit, _dispatchLatinGreekDigit')
import Data.Char.Math.SansSerif.Digit
import Data.Char.Math.SansSerif.Greek
import Data.Char.Math.SansSerif.Latin

-- | Convert the given character to a mathematical symbol without serifs, in the
-- given /emphasis/ and in the given /italics/ type wrapped in a 'Just'.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
sansSerif ::
  -- | The given 'ItalicType' to use.
  ItalicType ->
  -- | The given 'Emphasis' to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
sansSerif :: ItalicType -> Emphasis -> Char -> Maybe Char
sansSerif = forall a. a -> a -> ItalicType -> a
splitItalicType Emphasis -> Char -> Maybe Char
sansSerifNoItalic Emphasis -> Char -> Maybe Char
sansSerifItalic

-- | Convert the given character to a mathematical symbol without serifs, with a
-- given /emphasis/ and a given /italics/ style.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
sansSerif' ::
  -- | The given 'ItalicType' to use.
  ItalicType ->
  -- | The given 'Emphasis' to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted without serifs, depending on the given 'Emphasis' in bold or not, and depending on the given 'ItalicType' in italics or not.
  Char
sansSerif' :: ItalicType -> Emphasis -> Char -> Char
sansSerif' = forall a. a -> a -> ItalicType -> a
splitItalicType Emphasis -> Char -> Char
sansSerifNoItalic' Emphasis -> Char -> Char
sansSerifItalic'

-- | Convert the given character to a mathematical symbol without serifs, with a
-- given /emphasis/ and in italics.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
sansSerifItalic' ::
  -- | The given 'Emphasis' to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted without serifs, depending on the given 'Emphasis' in bold or not, and in italics.
  Char
sansSerifItalic' :: Emphasis -> Char -> Char
sansSerifItalic' = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Char
sansSerifNoBoldItalic' Char -> Char
sansSerifBoldItalic'

-- | Convert the given character to a mathematical symbol without serifs, in the
-- given /emphasis/ and in /italics/ wrapped in a 'Just'.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
sansSerifItalic ::
  -- | The given 'Emphasis' to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
sansSerifItalic :: Emphasis -> Char -> Maybe Char
sansSerifItalic = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Maybe Char
sansSerifNoBoldItalic Char -> Maybe Char
sansSerifBoldItalic

-- | Convert the given character to a mathematical symbol without serifs, with a
-- given /emphasis/ and not in italics.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
sansSerifNoItalic' ::
  -- | The given 'Emphasis' to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted without serifs, depending on the given 'Emphasis' in bold or not, and not in italics.
  Char
sansSerifNoItalic' :: Emphasis -> Char -> Char
sansSerifNoItalic' = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Char
sansSerifNoBoldNoItalic' Char -> Char
sansSerifBoldNoItalic'

-- | Convert the given character to a mathematical symbol without serifs, in the
-- given /emphasis/ and not in /italics/ wrapped in a 'Just'.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
sansSerifNoItalic ::
  -- | The given 'Emphasis' to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
sansSerifNoItalic :: Emphasis -> Char -> Maybe Char
sansSerifNoItalic = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Maybe Char
sansSerifNoBoldNoItalic Char -> Maybe Char
sansSerifBoldNoItalic

-- | Convert the given character to a mathematical symbol without serifs, in /bold/
-- and in a /italics/ type.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
sansSerifBold' ::
  -- | The given 'ItalicType' to use.
  ItalicType ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted without serifs, in bold and depending on the given 'ItalicType' in italics or not.
  Char
sansSerifBold' :: ItalicType -> Char -> Char
sansSerifBold' = forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Char
sansSerifBoldNoItalic' Char -> Char
sansSerifBoldItalic'

-- | Convert the given character to a mathematical symbol without serifs, in /bold/
-- with the given /italics/ type wrapped in a 'Just'.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
sansSerifBold ::
  -- | The given 'ItalicType' to use.
  ItalicType ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
sansSerifBold :: ItalicType -> Char -> Maybe Char
sansSerifBold = forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Maybe Char
sansSerifBoldNoItalic Char -> Maybe Char
sansSerifBoldItalic

-- | Convert the given character to a mathematical symbol without serifs, not in /bold/
-- and in a /italics/ type.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
sansSerifNoBold' ::
  -- | The given 'ItalicType' to use.
  ItalicType ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted without serifs, not in bold and depending on the given 'ItalicType' in italics or not.
  Char
sansSerifNoBold' :: ItalicType -> Char -> Char
sansSerifNoBold' = forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Char
sansSerifNoBoldNoItalic' Char -> Char
sansSerifNoBoldItalic'

-- | Convert the given character to a mathematical symbol without serifs, with no /bold/
-- and in the given /italics/ type wrapped in a 'Just'.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
sansSerifNoBold ::
  -- | The given 'ItalicType' to use.
  ItalicType ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
sansSerifNoBold :: ItalicType -> Char -> Maybe Char
sansSerifNoBold = forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Maybe Char
sansSerifNoBoldNoItalic Char -> Maybe Char
sansSerifNoBoldItalic

-- | Convert the given character to a mathematical symbol without serifs, with no
-- /bold/ and no /italics/.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
sansSerifNoBoldNoItalic' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted without serifs, not in bold and not in italics.
  Char
sansSerifNoBoldNoItalic' :: Char -> Char
sansSerifNoBoldNoItalic' = (Char -> Char) -> (Char -> Char) -> (Char -> Char) -> Char -> Char
_dispatchLatinGreekDigit' Char -> Char
latinSansSerifNoBoldNoItalic' Char -> Char
greekSansSerifNoBoldNoItalic' Char -> Char
digitSansSerifRegular'

-- | Convert the given character to a mathematical symbol without serifs, with no
-- /bold/, and no /italics/ wrapped in a 'Just'.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
sansSerifNoBoldNoItalic ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
sansSerifNoBoldNoItalic :: Char -> Maybe Char
sansSerifNoBoldNoItalic Char
c
  | Char -> Bool
isAsciiAlpha Char
c = forall a. a -> Maybe a
Just (Char -> Char
latinSansSerifNoBoldNoItalic' Char
c)
  | Char -> Bool
isDigit Char
c = forall a. a -> Maybe a
Just (Char -> Char
digitSansSerifRegular' Char
c)
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Convert the given character to a mathematical symbol without serifs, with no
-- /bold/ and in /italics/.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
sansSerifNoBoldItalic' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted without serifs, not in bold and in italics.
  Char
sansSerifNoBoldItalic' :: Char -> Char
sansSerifNoBoldItalic' = (Char -> Char) -> (Char -> Char) -> (Char -> Char) -> Char -> Char
_dispatchLatinGreekDigit' Char -> Char
latinSansSerifNoBoldItalic' Char -> Char
greekSansSerifNoBoldItalic' Char -> Char
digitSansSerifRegular'

-- | Convert the given character to a mathematical symbol without serifs, with no
-- /bold/, and in /italics/ wrapped in a 'Just'.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
sansSerifNoBoldItalic ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
sansSerifNoBoldItalic :: Char -> Maybe Char
sansSerifNoBoldItalic Char
c
  | Char -> Bool
isAsciiAlpha Char
c = forall a. a -> Maybe a
Just (Char -> Char
latinSansSerifNoBoldItalic' Char
c)
  | Char -> Bool
isDigit Char
c = forall a. a -> Maybe a
Just (Char -> Char
digitSansSerifRegular' Char
c)
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Convert the given character to a mathematical symbol without serifs, in /bold/
-- not in /italics/.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
sansSerifBoldNoItalic' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted without serifs, in bold and not in italics.
  Char
sansSerifBoldNoItalic' :: Char -> Char
sansSerifBoldNoItalic' = (Char -> Char) -> (Char -> Char) -> (Char -> Char) -> Char -> Char
_dispatchLatinGreekDigit' Char -> Char
latinSansSerifBoldNoItalic' Char -> Char
greekSansSerifBoldNoItalic' Char -> Char
digitSansSerifBold'

-- | Convert the given character to a mathematical symbol without serifs, in
-- /bold/, and no /italics/ wrapped in a 'Just'.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
sansSerifBoldNoItalic ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
sansSerifBoldNoItalic :: Char -> Maybe Char
sansSerifBoldNoItalic = (Char -> Char)
-> (Char -> Char) -> (Char -> Char) -> Char -> Maybe Char
_dispatchLatinGreekDigit Char -> Char
latinSansSerifBoldNoItalic' Char -> Char
greekSansSerifBoldNoItalic' Char -> Char
digitSansSerifBold'

-- | Convert the given character to a mathematical symbol without serifs, with in
-- /bold/ and in /italics/.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
sansSerifBoldItalic' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted without serifs, in bold and in italics.
  Char
sansSerifBoldItalic' :: Char -> Char
sansSerifBoldItalic' = (Char -> Char) -> (Char -> Char) -> (Char -> Char) -> Char -> Char
_dispatchLatinGreekDigit' Char -> Char
latinSansSerifBoldItalic' Char -> Char
greekSansSerifBoldItalic' Char -> Char
digitSansSerifBold'

-- | Convert the given character to a mathematical symbol without serifs, in
-- /bold/, and in /italics/ wrapped in a 'Just'.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
sansSerifBoldItalic ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
sansSerifBoldItalic :: Char -> Maybe Char
sansSerifBoldItalic = (Char -> Char)
-> (Char -> Char) -> (Char -> Char) -> Char -> Maybe Char
_dispatchLatinGreekDigit Char -> Char
latinSansSerifBoldItalic' Char -> Char
greekSansSerifBoldItalic' Char -> Char
digitSansSerifBold'