{-# 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
  :: 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.
latinSerif :: ItalicType -> Emphasis -> Char -> Maybe Char
latinSerif = (Emphasis -> Char -> Maybe Char)
-> (Emphasis -> Char -> Maybe Char)
-> ItalicType
-> Emphasis
-> Char
-> Maybe Char
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'
  :: 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 with serifs, depending on the given 'Emphasis' in bold or not, and depending on the given 'ItalicType' in italics or not.
latinSerif' :: ItalicType -> Emphasis -> Char -> Char
latinSerif' = (Emphasis -> Char -> Char)
-> (Emphasis -> Char -> Char)
-> ItalicType
-> Emphasis
-> Char
-> Char
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'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted with serifs, not in bold and not in italics.
latinSerifNoBoldNoItalic' :: Char -> Char
latinSerifNoBoldNoItalic' = Char -> Char
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
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
latinSerifNoBoldNoItalic :: Char -> Maybe Char
latinSerifNoBoldNoItalic = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
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'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted with serifs, not in bold and in italics.
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
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
latinSerifNoBoldItalic :: Char -> Maybe Char
latinSerifNoBoldItalic = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
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'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted with serifs, in bold and not in italics.
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
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
latinSerifBoldNoItalic :: Char -> Maybe Char
latinSerifBoldNoItalic = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
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'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted with serifs, in bold and in italics.
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
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The equivalent character wrapped in a 'Just' if in the valid range, 'Nothing' otherwise.
latinSerifBoldItalic :: Char -> Maybe Char
latinSerifBoldItalic = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
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'
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ 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.
latinSerifBold' :: ItalicType -> Char -> Char
latinSerifBold' = (Char -> Char) -> (Char -> Char) -> ItalicType -> Char -> Char
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
  :: 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.
latinSerifBold :: ItalicType -> Char -> Maybe Char
latinSerifBold = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> ItalicType -> Char -> Maybe Char
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'
  :: ItalicType  -- ^ The given 'ItalicType' to use.
  -> Char  -- ^ 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.
latinSerifNoBold' :: ItalicType -> Char -> Char
latinSerifNoBold' = (Char -> Char) -> (Char -> Char) -> ItalicType -> Char -> Char
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
  :: 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.
latinSerifNoBold :: ItalicType -> Char -> Maybe Char
latinSerifNoBold = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> ItalicType -> Char -> Maybe Char
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'
  :: Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ 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.
latinSerifItalic' :: Emphasis -> Char -> Char
latinSerifItalic' = (Char -> Char) -> (Char -> Char) -> Emphasis -> Char -> Char
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
  :: 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.
latinSerifItalic :: Emphasis -> Char -> Maybe Char
latinSerifItalic = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> Emphasis -> Char -> Maybe Char
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'
  :: Emphasis  -- ^ The given 'Emphasis' to use.
  -> Char  -- ^ 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.
latinSerifNoItalic' :: Emphasis -> Char -> Char
latinSerifNoItalic' = (Char -> Char) -> (Char -> Char) -> Emphasis -> Char -> Char
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
  :: 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.
latinSerifNoItalic :: Emphasis -> Char -> Maybe Char
latinSerifNoItalic = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> Emphasis -> Char -> Maybe Char
forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Maybe Char
latinSerifNoBoldNoItalic Char -> Maybe Char
latinSerifBoldNoItalic