{-# 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'
  :: Char  -- ^ 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.
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
  :: Char  -- ^ The character to convert to a /double struck/ symbol.
  -> Maybe Char  -- ^ The double struck symbol for the given character wrapped
                -- in a 'Just' data constructor, 'Nothing' if there is no
                -- equivalent /double stuck/ character.
doubleStruck :: Char -> Maybe Char
doubleStruck = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
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'
  :: Int  -- ^ The given number to convert.
  -> Char  -- ^ The corresponding character in double-struck style. Unspecified outside the digit range.
intToDigitDoubleStruck' :: Int -> Char
intToDigitDoubleStruck' = Char -> Char
digitDoubleStruck' (Char -> Char) -> (Int -> Char) -> Int -> Char
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
  :: Int  -- ^ The given number to convert.
  -> Maybe Char  -- ^ The corresponding symbol in /monospace/ style wrapped in a 'Just',
                -- 'Nothing' if the character is outside the range.
intToDigitDoubleStruck :: Int -> Maybe Char
intToDigitDoubleStruck = (Int -> Bool) -> (Int -> Char) -> Int -> Maybe Char
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'
  :: Char  -- ^ The given digit character to convert.
  -> Char  -- ^ The corresponding character in double-struck style. Unspecified outside the digit range.
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
  :: Char  -- ^ The given digit character to convert.
  -> Maybe Char  -- ^ The corresponding symbol in double-struck style wrapped in a 'Just',
                -- 'Nothing' if the character is outside the range.
digitDoubleStruck :: Char -> Maybe Char
digitDoubleStruck = (Char -> Bool) -> (Char -> Char) -> Char -> Maybe Char
forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isDigit Char -> Char
digitDoubleStruck'