{-# 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' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted in calligraphy, not in bold.
  Char
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 ::
  -- | The given character to convert.
  Char ->
  -- | The calligraphy symbol for the given character wrapped
  -- in a 'Just' data constructor, 'Nothing' if there is no
  -- equivalent /calligraphy/ character.
  Maybe Char
scriptRegular :: Char -> Maybe Char
scriptRegular = 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' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted in calligraphy, and in bold.
  Char
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 ::
  -- | The given character to convert.
  Char ->
  -- | The calligraphy symbol for the given character wrapped
  -- in a 'Just' data constructor, 'Nothing' if there is no
  -- equivalent /calligraphy/ character.
  Maybe Char
scriptBold :: Char -> Maybe Char
scriptBold = 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' ::
  -- | The given 'Emphasis' style to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted in calligraphy, and depending on the 'Emphasis' in bold or not.
  Char
script' :: Emphasis -> Char -> Char
script' = 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 ::
  -- | The given 'Emphasis' style to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The calligraphy symbol for the given character wrapped
  -- in a 'Just' data constructor, 'Nothing' if there is no
  -- equivalent /calligraphy/ character.
  Maybe Char
script :: Emphasis -> Char -> Maybe Char
script = 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' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted in calligraphy, not in bold.
  Char
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 ::
  -- | The given character to convert.
  Char ->
  -- | The calligraphy symbol for the given character wrapped
  -- in a 'Just' data constructor, 'Nothing' if there is no
  -- equivalent /calligraphy/ character.
  Maybe Char
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' ::
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted in calligraphy, and in bold.
  Char
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 ::
  -- | The given character to convert.
  Char ->
  -- | The calligraphy symbol for the given character wrapped
  -- in a 'Just' data constructor, 'Nothing' if there is no
  -- equivalent /calligraphy/ character.
  Maybe Char
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' ::
  -- | The given 'Emphasis' style to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The equivalent character that is formatted in calligraphy, and depending on the 'Emphasis' in bold or not.
  Char
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 ::
  -- | The given 'Emphasis' style to use.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The calligraphy symbol for the given character wrapped
  -- in a 'Just' data constructor, 'Nothing' if there is no
  -- equivalent /calligraphy/ character.
  Maybe Char
calligraphy :: Emphasis -> Char -> Maybe Char
calligraphy = Emphasis -> Char -> Maybe Char
script