{-# LANGUAGE Safe #-}

-- |
-- Module      : Data.Char.Math.Serif.Latin
-- Description : Serif mathematical alphanumeric symbols
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- See "Data.Char.Math" for further documentation.
module Data.Char.Math.Serif.Latin
  ( latinSerif,
    latinSerif',
    latinSerifNoBold,
    latinSerifNoBold',
    latinSerifBold,
    latinSerifBold',
    latinSerifNoItalic,
    latinSerifNoItalic',
    latinSerifItalic,
    latinSerifItalic',
    latinSerifNoBoldNoItalic,
    latinSerifNoBoldNoItalic',
    latinSerifBoldNoItalic,
    latinSerifBoldNoItalic',
    latinSerifNoBoldItalic,
    latinSerifNoBoldItalic',
    latinSerifBoldItalic,
    latinSerifBoldItalic',
  )
where

import Data.Char.Core (Emphasis, ItalicType, isAsciiAlpha, splitEmphasis, splitItalicType)
import Data.Char.Math.Internal

-- | Convert the given character to a mathematical symbol with serifs, 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.
latinSerif ::
  -- | 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
latinSerif :: ItalicType -> Emphasis -> Char -> Maybe Char
latinSerif = forall a. a -> a -> ItalicType -> a
splitItalicType Emphasis -> Char -> Maybe Char
latinSerifNoItalic Emphasis -> Char -> Maybe Char
latinSerifItalic

-- | Convert the given character to a mathematical symbol with serifs, with a
-- given /emphasis/ and a given /italics/ style. This maps characters an equivalent serif symbol for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
latinSerif' ::
  -- | The given 'ItalicType' to use.
  ItalicType ->
  -- | The given 'Emphasis' to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted with serifs, depending on the given 'Emphasis' in bold or not, and depending on the given 'ItalicType' in italics or not.
  Char
latinSerif' :: ItalicType -> Emphasis -> Char -> Char
latinSerif' = forall a. a -> a -> ItalicType -> a
splitItalicType Emphasis -> Char -> Char
latinSerifNoItalic' Emphasis -> Char -> Char
latinSerifItalic'

-- | Convert the given character to a mathematical symbol with serifs, with no
-- /bold/ and no /italics/. This maps characters to itself for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
latinSerifNoBoldNoItalic' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted with serifs, not in bold and not in italics.
  Char
latinSerifNoBoldNoItalic' :: Char -> Char
latinSerifNoBoldNoItalic' = forall a. a -> a
id

-- | Convert the given character to a mathematical symbol with serifs, with no
-- /bold/, and no /italics/ wrapped in a 'Just'. If the character is outside the
-- @A@–@Z@ and @a@–@z@ range, 'Nothing' is returned.
latinSerifNoBoldNoItalic ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
latinSerifNoBoldNoItalic :: Char -> Maybe Char
latinSerifNoBoldNoItalic = forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isAsciiAlpha Char -> Char
latinSerifNoBoldNoItalic'

-- | Convert the given character to a mathematical symbol with serifs, with no
-- /bold/ and in /italics/. This maps characters an equivalent serif symbol for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
latinSerifNoBoldItalic' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted with serifs, not in bold and in italics.
  Char
latinSerifNoBoldItalic' :: Char -> Char
latinSerifNoBoldItalic' Char
'h' = Char
'\x210e'
latinSerifNoBoldItalic' Char
c = Int -> Char -> Char
_baseUpperLower Int
0x1d3ed Char
c

-- | Convert the given character to a mathematical symbol with serifs, with no
-- /bold/, and in /italics/ wrapped in a 'Just'. If the character is outside the
-- @A@–@Z@ and @a@–@z@ range, 'Nothing' is returned.
latinSerifNoBoldItalic ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
latinSerifNoBoldItalic :: Char -> Maybe Char
latinSerifNoBoldItalic = forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isAsciiAlpha Char -> Char
latinSerifNoBoldItalic'

-- | Convert the given character to a mathematical symbol with serifs, in /bold/
-- not in /italics/. This maps characters an equivalent serif symbol for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
latinSerifBoldNoItalic' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted with serifs, in bold and not in italics.
  Char
latinSerifBoldNoItalic' :: Char -> Char
latinSerifBoldNoItalic' = Int -> Char -> Char
_baseUpperLower Int
0x1d3b9

-- | Convert the given character to a mathematical symbol with serifs, in
-- /bold/, and no /italics/ wrapped in a 'Just'. If the character is outside the
-- @A@–@Z@ and @a@–@z@ range, 'Nothing' is returned.
latinSerifBoldNoItalic ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
latinSerifBoldNoItalic :: Char -> Maybe Char
latinSerifBoldNoItalic = forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isAsciiAlpha Char -> Char
latinSerifBoldNoItalic'

-- | Convert the given character to a mathematical symbol with serifs, with in
-- /bold/ and in /italics/. This maps characters an equivalent serif symbol for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
latinSerifBoldItalic' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted with serifs, in bold and in italics.
  Char
latinSerifBoldItalic' :: Char -> Char
latinSerifBoldItalic' = Int -> Char -> Char
_baseUpperLower Int
0x1d421

-- | Convert the given character to a mathematical symbol with serifs, in
-- /bold/, and in /italics/ wrapped in a 'Just'. If the character is outside the
-- @A@–@Z@ and @a@–@z@ range, 'Nothing' is returned.
latinSerifBoldItalic ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
  Maybe Char
latinSerifBoldItalic :: Char -> Maybe Char
latinSerifBoldItalic = forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isAsciiAlpha Char -> Char
latinSerifBoldItalic'

-- | Convert the given character to a mathematical symbol with serifs, in /bold/
-- and in a /italics/ type. This maps characters an equivalent serif symbol for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
latinSerifBold' ::
  -- | The given 'ItalicType' to use.
  ItalicType ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted with serifs, in bold and depending on the given 'ItalicType' in italics or not.
  Char
latinSerifBold' :: ItalicType -> Char -> Char
latinSerifBold' = forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Char
latinSerifBoldNoItalic' Char -> Char
latinSerifBoldItalic'

-- | Convert the given character to a mathematical symbol with serifs, in /bold/
-- with the given /italics/ type wrapped in a 'Just'. If the character is outside the
-- @A@–@Z@ and @a@–@z@ range, 'Nothing' is returned.
latinSerifBold ::
  -- | 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
latinSerifBold :: ItalicType -> Char -> Maybe Char
latinSerifBold = forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Maybe Char
latinSerifBoldNoItalic Char -> Maybe Char
latinSerifBoldItalic

-- | Convert the given character to a mathematical symbol with serifs, not in /bold/
-- and in a /italics/ type. This maps characters an equivalent serif symbol for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
latinSerifNoBold' ::
  -- | The given 'ItalicType' to use.
  ItalicType ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted with serifs, not in bold and depending on the given 'ItalicType' in italics or not.
  Char
latinSerifNoBold' :: ItalicType -> Char -> Char
latinSerifNoBold' = forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Char
latinSerifNoBoldNoItalic' Char -> Char
latinSerifNoBoldItalic'

-- | Convert the given character to a mathematical symbol with serifs, with no /bold/
-- 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.
latinSerifNoBold ::
  -- | 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
latinSerifNoBold :: ItalicType -> Char -> Maybe Char
latinSerifNoBold = forall a. a -> a -> ItalicType -> a
splitItalicType Char -> Maybe Char
latinSerifNoBoldNoItalic Char -> Maybe Char
latinSerifNoBoldItalic

-- | Convert the given character to a mathematical symbol with serifs, with a
-- given /emphasis/ and in italics. This maps characters an equivalent serif symbol for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
latinSerifItalic' ::
  -- | The given 'Emphasis' to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted with serifs, depending on the given 'Emphasis' in bold or not, and in italics.
  Char
latinSerifItalic' :: Emphasis -> Char -> Char
latinSerifItalic' = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Char
latinSerifNoBoldItalic' Char -> Char
latinSerifBoldItalic'

-- | Convert the given character to a mathematical symbol with serifs, in the
-- given /emphasis/ and in /italics/ wrapped in a 'Just'. If the character
-- is outside the @A@–@Z@ and @a@–@z@ range, 'Nothing' is returned.
latinSerifItalic ::
  -- | 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
latinSerifItalic :: Emphasis -> Char -> Maybe Char
latinSerifItalic = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Maybe Char
latinSerifNoBoldItalic Char -> Maybe Char
latinSerifBoldItalic

-- | Convert the given character to a mathematical symbol with serifs, with a
-- given /emphasis/ and not in italics. This maps characters an equivalent serif symbol for the @A@–@Z@ and
-- @a@–@z@ range. For characters outside the range, the behavior is unspecified.
latinSerifNoItalic' ::
  -- | The given 'Emphasis' to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted with serifs, depending on the given 'Emphasis' in bold or not, and not in italics.
  Char
latinSerifNoItalic' :: Emphasis -> Char -> Char
latinSerifNoItalic' = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Char
latinSerifNoBoldNoItalic' Char -> Char
latinSerifBoldNoItalic'

-- | Convert the given character to a mathematical symbol with serifs, in the
-- given /emphasis/ and not in /italics/ wrapped in a 'Just'. If the character
-- is outside the @A@–@Z@ and @a@–@z@ range, 'Nothing' is returned.
latinSerifNoItalic ::
  -- | 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
latinSerifNoItalic :: Emphasis -> Char -> Maybe Char
latinSerifNoItalic = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Maybe Char
latinSerifNoBoldNoItalic Char -> Maybe Char
latinSerifBoldNoItalic