{-# LANGUAGE Safe #-}

-- |
-- Module      : Data.Char.Math.Serif.Digit
-- 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.Digit
  ( -- * Characters conversion
    digitSerif,
    digitSerif',
    digitSerifRegular,
    digitSerifRegular',
    digitSerifBold,
    digitSerifBold',

    -- ** Int to digit characters
    intToDigitSerif,
    intToDigitSerif',
    intToDigitSerifRegular,
    intToDigitSerifRegular',
    intToDigitSerifBold,
    intToDigitSerifBold',
  )
where

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

-- | Convert the given digit character (@0@–@9@) to its corresponding character
-- with a given 'Emphasis' in serif style. The result for characters outside this
-- range is unspecified.
digitSerif' ::
  -- | The given /emphasis/ style.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The corresponding symbol in serifs for the given /emphasis/ style, unspecified outside the the range.
  Char
digitSerif' :: Emphasis -> Char -> Char
digitSerif' = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Char
digitSerifRegular' Char -> Char
digitSerifBold'

-- | Convert the given digit character (@0@–@9@) to its corresponding character
-- with the given 'Emphasis' in serif style wrapped in a 'Just' data constructor.
-- For characters outside this range, 'Nothing' is returned.
digitSerif ::
  -- | The given /emphasis/ style.
  Emphasis ->
  -- | The given character to convert.
  Char ->
  -- | The corresponding symbol in serifs for the given /emphasis/ style wrapped in a 'Just',
  -- 'Nothing' if the character is outside the range.
  Maybe Char
digitSerif :: Emphasis -> Char -> Maybe Char
digitSerif = forall a. a -> a -> Emphasis -> a
splitEmphasis Char -> Maybe Char
digitSerifRegular Char -> Maybe Char
digitSerifBold

-- | Convert the given digit character (@0@–@9@) to its corresponding character
-- in a non-bold serif style. The result for characters outside this range is
-- unspecified.
digitSerifRegular' ::
  -- | The given character to convert.
  Char ->
  -- | The corresponding symbol in serifs not in bold, unspecified outside the the range.
  Char
digitSerifRegular' :: Char -> Char
digitSerifRegular' = forall a. a -> a
id

-- | Convert the given digit character (@0@–@9@) to its corresponding character
-- in a non-bold serif style wrapped in a 'Just' data constructor. For
-- characters outside this range, 'Nothing' is returned.
digitSerifRegular ::
  -- | The given character to convert.
  Char ->
  -- | The corresponding symbol in serifs not in bold wrapped in a 'Just',
  -- 'Nothing' if the character is outside the range.
  Maybe Char
digitSerifRegular :: Char -> Maybe Char
digitSerifRegular = forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isDigit Char -> Char
digitSerifRegular'

-- | Convert the given digit character (@0@–@9@) to its corresponding character
-- in a bold serif style. The result for characters outside this range is
-- unspecified.
digitSerifBold' ::
  -- | The given character to convert.
  Char ->
  -- | The corresponding symbol in serifs in bold, unspecified outside the the range.
  Char
digitSerifBold' :: Char -> Char
digitSerifBold' = Int -> Char -> Char
_shiftC Int
0x1d79e

-- | Convert the given digit character (@0@–@9@) to its corresponding character
-- in a bold serif style wrapped in a 'Just' data constructor. For
-- characters outside this range, 'Nothing' is returned.
digitSerifBold ::
  -- | The given character to convert.
  Char ->
  -- | The corresponding symbol in serifs in bold wrapped in a 'Just',
  -- 'Nothing' if the character is outside the range.
  Maybe Char
digitSerifBold :: Char -> Maybe Char
digitSerifBold = forall a b. (a -> Bool) -> (a -> b) -> a -> Maybe b
_withCondition Char -> Bool
isDigit Char -> Char
digitSerifBold'

-- | Convert the given number (@0@–@9@) to its corresponding character
-- in a non-bold serif style. The result for numbers outside this range is
-- unspecified.
intToDigitSerifRegular' ::
  -- | The given number to convert.
  Int ->
  -- | The corresponding symbol in serifs not in bold, unspecified outside the the range.
  Char
intToDigitSerifRegular' :: Int -> Char
intToDigitSerifRegular' = Char -> Char
digitSerifRegular' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
intToDigit

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

-- | Convert the given number (@0@–@9@) to its corresponding character
-- in a bold serif style. The result for numbers outside this range is
-- unspecified.
intToDigitSerifBold' ::
  -- | The given number to convert.
  Int ->
  -- | The corresponding symbol in serifs in bold, unspecified outside the the range.
  Char
intToDigitSerifBold' :: Int -> Char
intToDigitSerifBold' = Char -> Char
digitSerifBold' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
intToDigit

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

-- | Convert the given number (@0@–@9@) to its corresponding character
-- with a given 'Emphasis' in serif style. The result for numbers outside this
-- range is unspecified.
intToDigitSerif' ::
  -- | The given /emphasis/ style.
  Emphasis ->
  -- | The given number to convert.
  Int ->
  -- | The corresponding symbol in serifs in the given /emphasis/ style, unspecified outside the the range.
  Char
intToDigitSerif' :: Emphasis -> Int -> Char
intToDigitSerif' = forall a. a -> a -> Emphasis -> a
splitEmphasis Int -> Char
intToDigitSerifRegular' Int -> Char
intToDigitSerifBold'

-- | Convert the given number (@0@–@9@) to its corresponding character
-- with the given 'Emphasis' in serif style wrapped in a 'Just' data constructor.
-- For numbers outside this range, 'Nothing' is returned.
intToDigitSerif ::
  -- | The given /emphasis/ style.
  Emphasis ->
  -- | The given number to convert
  Int ->
  -- | The corresponding symbol in serifs in the given /emphasis/ style wrapped in a 'Just',
  -- 'Nothing' if the character is outside the range.
  Maybe Char
intToDigitSerif :: Emphasis -> Int -> Maybe Char
intToDigitSerif = forall a. a -> a -> Emphasis -> a
splitEmphasis Int -> Maybe Char
intToDigitSerifRegular Int -> Maybe Char
intToDigitSerifBold