{-# LANGUAGE Safe #-}

{-|
Module      : Data.Char.Math.Script
Description : Script/calligraphy mathematical alphanumeric symbols
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

See "Data.Char.Math" for further documentation.
-}

module Data.Char.Math.Script
  ( script,             script'
  , scriptRegular,      scriptRegular'
  , scriptBold,         scriptBold'
  , calligraphy,        calligraphy'
  , calligraphyRegular, calligraphyRegular'
  , calligraphyBold,    calligraphyBold'
  ) where


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

-- | Convert the given character to its /script/ or /calligraphic/ symbol. This
-- symbol is /not/ written in boldface.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
scriptRegular'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted in calligraphy, not in bold.
scriptRegular' :: Char -> Char
scriptRegular' Char
'B' = Char
'\x212c'
scriptRegular' Char
'E' = Char
'\x2130'
scriptRegular' Char
'F' = Char
'\x2131'
scriptRegular' Char
'H' = Char
'\x210b'
scriptRegular' Char
'I' = Char
'\x2110'
scriptRegular' Char
'L' = Char
'\x2112'
scriptRegular' Char
'M' = Char
'\x2133'
scriptRegular' Char
'R' = Char
'\x211b'
scriptRegular' Char
'e' = Char
'\x212f'
scriptRegular' Char
'g' = Char
'\x210a'
scriptRegular' Char
'o' = Char
'\x2134'
scriptRegular' Char
c = Int -> Char -> Char
_baseUpperLower Int
0x1d455 Char
c

-- | Convert the given character to its /script/ or /calligraphic/ symbol
-- wrapped in a 'Just' data constructor. This symbol is /not/ written in
-- boldface.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
scriptRegular
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The calligraphy symbol for the given character wrapped
                -- in a 'Just' data constructor, 'Nothing' if there is no
                -- equivalent /calligraphy/ character.
scriptRegular :: Char -> Maybe Char
scriptRegular = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isAsciiAlpha Char -> Char
scriptRegular'

-- | Convert the given character to its /script/ or /calligraphic/ symbol. This
-- symbol is written in boldface.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
scriptBold'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted in calligraphy, and in bold.
scriptBold' :: Char -> Char
scriptBold' = Int -> Char -> Char
_baseUpperLower Int
0x1d489

-- | Convert the given character to its /script/ or /calligraphic/ symbol
-- wrapped in a 'Just' data constructor. This symbol is written in
-- boldface.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
scriptBold
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The calligraphy symbol for the given character wrapped
                -- in a 'Just' data constructor, 'Nothing' if there is no
                -- equivalent /calligraphy/ character.
scriptBold :: Char -> Maybe Char
scriptBold = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isAsciiAlpha Char -> Char
scriptBold'

-- | Convert the given character to its /script/ or /calligraphic/ symbol. This
-- symbol is written in the given 'Emphasis' style.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
script'
  :: Emphasis  -- ^ The given 'Emphasis' style to use.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted in calligraphy, and depending on the 'Emphasis' in bold or not.
script' :: Emphasis -> Char -> Char
script' = (Char -> Char) -> (Char -> Char) -> Emphasis -> Char -> Char
forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Char
scriptRegular' Char -> Char
scriptBold'

-- | Convert the given character to its /script/ or /calligraphic/ symbol
-- wrapped in a 'Just' data constructor. This symbol is /not/ written in
-- the given 'Emphasis' style.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
script
  :: Emphasis  -- ^ The given 'Emphasis' style to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The calligraphy symbol for the given character wrapped
                -- in a 'Just' data constructor, 'Nothing' if there is no
                -- equivalent /calligraphy/ character.
script :: Emphasis -> Char -> Maybe Char
script = (Char -> Maybe Char)
-> (Char -> Maybe Char) -> Emphasis -> Char -> Maybe Char
forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Maybe Char
scriptRegular Char -> Maybe Char
scriptBold

-- | Convert the given character to its /script/ or /calligraphic/ symbol. This
-- symbol is /not/ written in boldface.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
-- This is an alias of 'scriptRegular''.
calligraphyRegular'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted in calligraphy, not in bold.
calligraphyRegular' :: Char -> Char
calligraphyRegular' = Char -> Char
scriptRegular'

-- | Convert the given character to its /script/ or /calligraphic/ symbol
-- wrapped in a 'Just' data constructor. This symbol is /not/ written in
-- boldface.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
-- This is an alias of 'scriptRegular'.
calligraphyRegular
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The calligraphy symbol for the given character wrapped
                -- in a 'Just' data constructor, 'Nothing' if there is no
                -- equivalent /calligraphy/ character.
calligraphyRegular :: Char -> Maybe Char
calligraphyRegular = Char -> Maybe Char
scriptRegular

-- | Convert the given character to its /script/ or /calligraphic/ symbol. This
-- symbol is written in boldface.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
-- This is an alias of 'scriptBold''.
calligraphyBold'
  :: Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted in calligraphy, and in bold.
calligraphyBold' :: Char -> Char
calligraphyBold' = Char -> Char
scriptBold'

-- | Convert the given character to its /script/ or /calligraphic/ symbol
-- wrapped in a 'Just' data constructor. This symbol is written in boldface.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
-- This is an alias of 'scriptBold'.
calligraphyBold
  :: Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The calligraphy symbol for the given character wrapped
                -- in a 'Just' data constructor, 'Nothing' if there is no
                -- equivalent /calligraphy/ character.
calligraphyBold :: Char -> Maybe Char
calligraphyBold = Char -> Maybe Char
scriptBold

-- | Convert the given character to its /script/ or /calligraphic/ symbol. This
-- symbol is written in the given 'Emphasis' style.
-- If the symbol is not supported (see: "Data.Char.Math#characters_ranges"), the returned character is unspecified.
-- This is an alias of 'script''.
calligraphy'
  :: Emphasis  -- ^ The given 'Emphasis' style to use.
  -> Char  -- ^ The given character to convert.
  -> Char  -- ^ The equivalent character that is formatted in calligraphy, and depending on the 'Emphasis' in bold or not.
calligraphy' :: Emphasis -> Char -> Char
calligraphy' = Emphasis -> Char -> Char
script'

-- | Convert the given character to its /script/ or /calligraphic/ symbol
-- wrapped in a 'Just' data constructor. This symbol is /not/ written in
-- the given 'Emphasis' style.
-- If the character is not supported (see: "Data.Char.Math#characters_ranges"), 'Nothing' is returned.
-- This is an alias of 'script'.
calligraphy
  :: Emphasis  -- ^ The given 'Emphasis' style to use.
  -> Char  -- ^ The given character to convert.
  -> Maybe Char  -- ^ The calligraphy symbol for the given character wrapped
                -- in a 'Just' data constructor, 'Nothing' if there is no
                -- equivalent /calligraphy/ character.
calligraphy :: Emphasis -> Char -> Maybe Char
calligraphy = Emphasis -> Char -> Maybe Char
script