{-# LANGUAGE Safe #-}

-- |
-- Module      : Data.Char.Math.DoubleStruck
-- Description : Double struck mathematical alphanumeric symbols
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- See "Data.Char.Math" for further documentation.
module Data.Char.Math.DoubleStruck
  ( -- * Letters
    doubleStruck,
    doubleStruck',

    -- * Digits
    digitDoubleStruck,
    digitDoubleStruck',
    intToDigitDoubleStruck,
    intToDigitDoubleStruck',
  )
where

import Data.Char (intToDigit, isDigit)
import Data.Char.Core (isAsciiAlphaNum)
import Data.Char.Math.Internal

-- | Obtain the double struck symbol for the given character. The supported
-- range of characters are the alphabet character (@A@–@Z@, and @a@–@z@), and
-- the numerical characters (@0@–@9@). For characters other than these, the
-- behaviour is unspecified.
doubleStruck' ::
  -- | The character to convert to a /double struck/ symbol.
  Char ->
  -- | The double struck symbol for the given character. If the character
  -- is not an ASCII alphanumerical character, the result is
  -- unspecified.
  Char
doubleStruck' :: Char -> Char
doubleStruck' Char
'C' = Char
'\x2102'
doubleStruck' Char
'H' = Char
'\x210d'
doubleStruck' Char
'N' = Char
'\x2115'
doubleStruck' Char
'P' = Char
'\x2119'
doubleStruck' Char
'Q' = Char
'\x211a'
doubleStruck' Char
'R' = Char
'\x211d'
doubleStruck' Char
'Z' = Char
'\x2124'
doubleStruck' Char
c = Int -> Int -> Char -> Char
_baseUpperLowerNum Int
0x1d7a8 Int
0x1d4f1 Char
c

-- | Obtain the double struck symbol for the given character. The supported
-- range of characters are the alphabet characters (@A@–@Z@, and @a@–@z@), and
-- the numerical characters (@0@–@9@). The symbols are wrapped in the 'Just'
-- data constructor. For characters outside the range, 'Nothing' is returned.
doubleStruck ::
  -- | The character to convert to a /double struck/ symbol.
  Char ->
  -- | The double struck symbol for the given character wrapped
  -- in a 'Just' data constructor, 'Nothing' if there is no
  -- equivalent /double stuck/ character.
  Maybe Char
doubleStruck :: Char -> Maybe Char
doubleStruck = forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isAsciiAlphaNum Char -> Char
doubleStruck'

-- | Convert the given number (@0@–@9@) to its corresponding character in
-- /double-struck/ style. Unspecified result for numbers outside this range.
intToDigitDoubleStruck' ::
  -- | The given number to convert.
  Int ->
  -- | The corresponding character in double-struck style. Unspecified outside the digit range.
  Char
intToDigitDoubleStruck' :: Int -> Char
intToDigitDoubleStruck' = Char -> Char
digitDoubleStruck' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
intToDigit

-- | Convert the given number (@0@–@9@) to its corresponding character
-- in /double-struck/ style wrapped in a 'Just' data constructor. For
-- numbers outside this range, 'Nothing' is returned.
intToDigitDoubleStruck ::
  -- | The given number to convert.
  Int ->
  -- | The corresponding symbol in /monospace/ style wrapped in a 'Just',
  -- 'Nothing' if the character is outside the range.
  Maybe Char
intToDigitDoubleStruck :: Int -> Maybe Char
intToDigitDoubleStruck = forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Int -> Bool
_isValidInt Int -> Char
intToDigitDoubleStruck'

-- | Converts the given digit (@0@–@9@) charcters to its equivalent in
-- /double-struck/ style. Unspecified result for characters outside the range.
digitDoubleStruck' ::
  -- | The given digit character to convert.
  Char ->
  -- | The corresponding character in double-struck style. Unspecified outside the digit range.
  Char
digitDoubleStruck' :: Char -> Char
digitDoubleStruck' = Char -> Char
doubleStruck'

-- | Converts the given digit (@0@–@9@) charcters to its equivalent in
-- /double-struck/ style wrapped in a 'Just' data constructor. 'Nothing'
-- for characters outside the range.
digitDoubleStruck ::
  -- | The given digit character to convert.
  Char ->
  -- | The corresponding symbol in double-struck style wrapped in a 'Just',
  -- 'Nothing' if the character is outside the range.
  Maybe Char
digitDoubleStruck :: Char -> Maybe Char
digitDoubleStruck = forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isDigit Char -> Char
digitDoubleStruck'