{-# 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
  :: 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.
sansSerif :: ItalicType -> Emphasis -> Char -> Maybe Char
sansSerif = (Emphasis -> Char -> Maybe Char)
-> (Emphasis -> Char -> Maybe Char)
-> ItalicType
-> Emphasis
-> Char
-> Maybe Char
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'
  :: 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 without serifs, depending on the given 'Emphasis' in bold or not, and depending on the given 'ItalicType' in italics or not.
sansSerif' :: ItalicType -> Emphasis -> Char -> Char
sansSerif' = (Emphasis -> Char -> Char)
-> (Emphasis -> Char -> Char)
-> ItalicType
-> Emphasis
-> Char
-> Char
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'
  :: Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ 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.
sansSerifItalic' :: Emphasis -> Char -> Char
sansSerifItalic' = (Char -> Char) -> (Char -> Char) -> Emphasis -> Char -> Char
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
  :: 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.
sansSerifItalic :: Emphasis -> Char -> Maybe Char
sansSerifItalic = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> Emphasis -> Char -> Maybe Char
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'
  :: Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ 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.
sansSerifNoItalic' :: Emphasis -> Char -> Char
sansSerifNoItalic' = (Char -> Char) -> (Char -> Char) -> Emphasis -> Char -> Char
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
  :: 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.
sansSerifNoItalic :: Emphasis -> Char -> Maybe Char
sansSerifNoItalic = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> Emphasis -> Char -> Maybe Char
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'
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ 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.
sansSerifBold' :: ItalicType -> Char -> Char
sansSerifBold' = (Char -> Char) -> (Char -> Char) -> ItalicType -> Char -> Char
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
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
sansSerifBold :: ItalicType -> Char -> Maybe Char
sansSerifBold = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> ItalicType -> Char -> Maybe Char
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'
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ 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.
sansSerifNoBold' :: ItalicType -> Char -> Char
sansSerifNoBold' = (Char -> Char) -> (Char -> Char) -> ItalicType -> Char -> Char
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
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
sansSerifNoBold :: ItalicType -> Char -> Maybe Char
sansSerifNoBold = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> ItalicType -> Char -> Maybe Char
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'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, not in bold and not in italics.
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
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
sansSerifNoBoldNoItalic :: Char -> Maybe Char
sansSerifNoBoldNoItalic Char
c
  | Char -> Bool
isAsciiAlpha Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Char
latinSansSerifNoBoldNoItalic' Char
c)
  | Char -> Bool
isDigit Char
c      = Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Char
digitSansSerifRegular' Char
c)
  | Bool
otherwise      = Maybe Char
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'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, not in bold and in italics.
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
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
sansSerifNoBoldItalic :: Char -> Maybe Char
sansSerifNoBoldItalic Char
c
  | Char -> Bool
isAsciiAlpha Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Char
latinSansSerifNoBoldItalic' Char
c)
  | Char -> Bool
isDigit Char
c      = Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Char
digitSansSerifRegular' Char
c)
  | Bool
otherwise      = Maybe Char
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'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, in bold and not in italics.
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
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
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'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted without serifs, in bold and in italics.
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
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
sansSerifBoldItalic :: Char -> Maybe Char
sansSerifBoldItalic = (Char -> Char)
-> (Char -> Char) -> (Char -> Char) -> Char -> Maybe Char
_dispatchLatinGreekDigit Char -> Char
latinSansSerifBoldItalic' Char -> Char
greekSansSerifBoldItalic' Char -> Char
digitSansSerifBold'