{-# LANGUAGE Safe #-}

{-|
Module      : Data.Char.Enclosed
Description : A module to map alphanumerical characters to their equivalent in an enclosed forms.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

Unicode defines two blocks of enclosed alphanumerical characters. The <http://unicode.org/charts/PDF/U2460.pdf U2460 block>, and the <http://unicode.org/charts/PDF/U1F100.pdf 1F100 block>.
This module aims to make it more convenient to map numbers, upper case and lower case values to their corresponding enclosed characters.
-}


module Data.Char.Enclosed (
    -- * Numbers with comma
    numberWithComma, numberWithComma'
    -- * Circled alphanumerical characters
  , circledAlpha,  circledAlpha'
  , circledNumber, circledNumber'
    -- * Parenthesized alphanumerical characters
  , parenthesizedAlpha,  parenthesizedAlpha'
  , parenthesizedNumber, parenthesizedNumber'
    -- * Numbers with period
  , numberWithPeriod, numberWithPeriod'
    -- * Double circled numbers
  , doubleCircledNumber, doubleCircledNumber'
    -- * Regional indicators
  , regionalIndicatorUppercase, regionalIndicatorUppercase'
    -- * Squared Latin letters
  , squaredUppercase, squaredUppercase'
    -- * White on black circled Latin letters
  , whiteOnBlackCircledUppercase, whiteOnBlackCircledUppercase'
    -- * White on black squared Latin letters
  , whiteOnBlackSquaredUppercase, whiteOnBlackSquaredUppercase'
    -- * White numbers on a black circle
  , numberWhiteOnBlackCircle, numberWhiteOnBlackCircle'
  ) where

import Data.Char.Core(liftNumber, liftNumber', liftNumberFrom, liftNumberFrom', liftUpperLowercase, liftUpperLowercase', liftDigit, liftDigit', liftUppercase, liftUppercase')


-- | Convert the given number to a 'Char'acter where the number is circled
-- wrapped in a 'Just'. This works for numbers in the @0-20@ range. For numbers
-- outside this range 'Nothing' is returned.
circledNumber
  :: Int  -- ^ The given number to convert.
  -> Maybe Char  -- ^ A 'Char'acter that is circled variant of the given number wrapped in a 'Just' data constructor if it exists; 'Nothing' otherwise.
circledNumber :: Int -> Maybe Char
circledNumber Int
0 = forall a. a -> Maybe a
Just Char
'\x24ea'
circledNumber Int
n = Int -> Int -> Int -> Maybe Char
liftNumber Int
20 Int
0x245f Int
n

-- | Convert the given number to a 'Char'acter where the number is circled.
-- This works for numbers in the @0-20@ range. For numbers outside this range,
-- the behavior is unspecified.
circledNumber'
  :: Int  -- ^ The given number to convert.
  -> Char  -- ^ A character that is the circled variant of the given number.
circledNumber' :: Int -> Char
circledNumber' Int
0 = Char
'\x24ea'
circledNumber' Int
n = Int -> Int -> Char
liftNumber' Int
0x245f Int
n

-- | Convert the given upper case or lower case 'Char'acter to a character that
-- is circled. The result is wrapped in a 'Just' data constructor. If the value
-- is outside the @A-Z,a-z@ range, 'Nothing' is returned.
circledAlpha
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
circledAlpha :: Char -> Maybe Char
circledAlpha = Int -> Int -> Char -> Maybe Char
liftUpperLowercase Int
0x24b6 Int
0x24d0

-- | Convert the given upper case or lower case 'Char'acter to a character that
-- is circled. If the value is outside the @A-Z,a-z@ range, the result is
-- unspecified.
circledAlpha'
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
circledAlpha' :: Char -> Char
circledAlpha' = Int -> Int -> Char -> Char
liftUpperLowercase' Int
0x24b6 Int
0x24d0

-- | Convert the given number to a 'Char'acter where the number is
-- parenthesized wrapped in a 'Just' data constructor. If the number is outside
-- the @1-20@ range, 'Nothing' is returned.
parenthesizedNumber
  :: Int  -- ^ The given number to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
parenthesizedNumber :: Int -> Maybe Char
parenthesizedNumber = Int -> Int -> Int -> Int -> Maybe Char
liftNumberFrom Int
1 Int
20 Int
0x2474

-- | Convert the given number to a 'Char'acter where the number is
-- parenthesized. If the number is outside the @1-20@ range, the result is
-- unspecified.
parenthesizedNumber'
  :: Int  -- ^ The given number to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
parenthesizedNumber' :: Int -> Char
parenthesizedNumber' = Int -> Int -> Int -> Char
liftNumberFrom' Int
1 Int
0x2474

-- | Convert the given number to a 'Char'acter where the number is succeeded by a
-- period (@.@) wrapped in a 'Just' data constructor. If the number is outside the
-- @0-20@ range, 'Nothing' is returned.
numberWithPeriod
  :: Int  -- ^ The given number to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
numberWithPeriod :: Int -> Maybe Char
numberWithPeriod Int
0 = forall a. a -> Maybe a
Just Char
'\x1f100'
numberWithPeriod Int
n = Int -> Int -> Int -> Maybe Char
liftNumber Int
20 Int
0x2487 Int
n

-- | Convert the given number to 'Char'acter where the number is succeeded by a
-- period (@.@). If the number is outside the @0-20@ range, the result is
-- unspecified.
numberWithPeriod'
  :: Int  -- ^ The given number to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
numberWithPeriod' :: Int -> Char
numberWithPeriod' Int
0 = Char
'\x1f100'
numberWithPeriod' Int
n = Int -> Int -> Char
liftNumber' Int
0x2487 Int
n

-- | Convert the given number to a 'Char'acter where the number is double
-- circled. The result is wrapped in a 'Just' data constructor.
-- If the given number is outside the @1-10@ range, 'Nothing' is returned.
doubleCircledNumber
  :: Int  -- ^ The given number to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
doubleCircledNumber :: Int -> Maybe Char
doubleCircledNumber = Int -> Int -> Int -> Int -> Maybe Char
liftNumberFrom Int
1 Int
10 Int
0x24f5

-- | Convert the given number to a 'Char'acter where the number is double
-- circled. If the given number is outside the @1-10@ range, the result is
-- unspecified.
doubleCircledNumber'
  :: Int  -- ^ The given number to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
doubleCircledNumber' :: Int -> Char
doubleCircledNumber' = Int -> Int -> Int -> Char
liftNumberFrom' Int
1 Int
0x24f5

-- | Convert the given number to a 'Char'acter where the number is succeeded by
-- a comma (@,@). The result is wrapped in a 'Just' data constructor. If the
-- given number is outside the @0-9@ range, 'Nothing' is returned.
numberWithComma
  :: Int  -- ^ The given number to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
numberWithComma :: Int -> Maybe Char
numberWithComma = Int -> Int -> Maybe Char
liftDigit Int
0x1f101

-- | Convert the given number to a 'Char'acter where the number is succeeded by
-- a comma (@,@). If the given number is outside the @0-9@ range, the result is
-- unspecified.
numberWithComma'
  :: Int  -- ^ The given number to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
numberWithComma' :: Int -> Char
numberWithComma' = Int -> Int -> Char
liftDigit' Int
0x1f101

-- | Convert the given upper case or lower case 'Char'acter to a 'Char'acter
-- where it is parenthesized. The result is wrapped in a 'Just' data constructor.
-- If the value is outside the @A-Z,a-z@ range, 'Nothing' is returned.
parenthesizedAlpha
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
parenthesizedAlpha :: Char -> Maybe Char
parenthesizedAlpha = Int -> Int -> Char -> Maybe Char
liftUpperLowercase Int
0x1f110 Int
0x249c

-- | Convert the given upper case or lower case character to a 'Char'acter
-- where it is parenthesized. If the value is outside the @A-Z,a-z@ range,
-- the result is unspecified.
parenthesizedAlpha'
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
parenthesizedAlpha' :: Char -> Char
parenthesizedAlpha' = Int -> Int -> Char -> Char
liftUpperLowercase' Int
0x1f110 Int
0x249c

-- | Convert the given upper case character to a 'Char'acter where it is
-- squared (put in a square box). The result is wrapped in a 'Just' data
-- constructor. If the value is outside the @A-Z@ range, 'Nothing' is returned.
squaredUppercase
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
squaredUppercase :: Char -> Maybe Char
squaredUppercase = Int -> Char -> Maybe Char
liftUppercase Int
0x1f130

-- | Convert the given upper case character to a 'Char'acter where it is squared
-- (put in a square box). If the value is outside the @A-Z@ range, the result is
-- unspecified.
squaredUppercase'
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
squaredUppercase' :: Char -> Char
squaredUppercase' = Int -> Char -> Char
liftUppercase' Int
0x1f130

-- | Convert the given upper case character to a character where the character
-- is written in white on a black circle. The result is wrapped in a 'Just' data
-- constructor. If the given value is outside the @A-Z@ range, 'Nothing' is
-- returned.
whiteOnBlackCircledUppercase
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
whiteOnBlackCircledUppercase :: Char -> Maybe Char
whiteOnBlackCircledUppercase = Int -> Char -> Maybe Char
liftUppercase Int
0x1f150

-- | Convert the given upper case character to a character where the character
-- is written in white on a black circle. If the given value is outside the
-- @A-Z@ range, the result is unspecified.
whiteOnBlackCircledUppercase'
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
whiteOnBlackCircledUppercase' :: Char -> Char
whiteOnBlackCircledUppercase' = Int -> Char -> Char
liftUppercase' Int
0x1f150

-- | Convert the given upper case character to a character where the character
-- is written in white on a black square. The result is wrapped in a 'Just' data
-- constructor. If the given value is outside the @A-Z@ range, 'Nothing' is
-- returned.
whiteOnBlackSquaredUppercase
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
whiteOnBlackSquaredUppercase :: Char -> Maybe Char
whiteOnBlackSquaredUppercase = Int -> Char -> Maybe Char
liftUppercase Int
0x1f170

-- | Convert the given upper case character to a character where the character
-- is written in white on a black square. If the given value is outside the
-- @A-Z@ range, the result is unspecified.
whiteOnBlackSquaredUppercase'
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
whiteOnBlackSquaredUppercase' :: Char -> Char
whiteOnBlackSquaredUppercase' = Int -> Char -> Char
liftUppercase' Int
0x1f170

-- | Convert the given number to a character where the number is written in
-- white on a black circle. The result is wrapped in a 'Just' data constructor.
-- If the given value is outside the @0,11-20@ range, 'Nothing' is returned.
numberWhiteOnBlackCircle
  :: Int  -- ^ The given number to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
numberWhiteOnBlackCircle :: Int -> Maybe Char
numberWhiteOnBlackCircle Int
0 = forall a. a -> Maybe a
Just Char
'\x24ff'
numberWhiteOnBlackCircle Int
n = Int -> Int -> Int -> Int -> Maybe Char
liftNumberFrom Int
11 Int
20 Int
0x24eb Int
n

-- | Convert the given number to a character where the number is written in
-- white on a black circle. If the given value is outside the @0,11-20@ range,
-- the result is unspecified.
numberWhiteOnBlackCircle'
  :: Int  -- ^ The given number to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
numberWhiteOnBlackCircle' :: Int -> Char
numberWhiteOnBlackCircle' Int
0 = Char
'\x24ff'
numberWhiteOnBlackCircle' Int
n = Int -> Int -> Int -> Char
liftNumberFrom' Int
11 Int
0x24eb Int
n

-- | Convert the given upper case character to a regional indicator character.
-- The result is wrapped in a 'Just' data constructor. If the value is outside
-- the @A-Z@ range, 'Nothing' is returned. The regional indicators are used for
-- flag emojis. Two consecutive regional indicators that together form an ISO
-- 63166 Alpha-2 code, then this will result in the corresponding flag Emoji.
-- Deprecated countries like the Soviet Union (SU) and Yugoslavia (YU) do not
-- have a flag emoji. Antarctica (AQ), the European Union (EU) and the United
-- Nations (UN) have a flag emoji.
regionalIndicatorUppercase
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' data constructor. If outside the range, 'Nothing'.
regionalIndicatorUppercase :: Char -> Maybe Char
regionalIndicatorUppercase = Int -> Char -> Maybe Char
liftUppercase Int
0x1f1e6

-- | Convert the given upper case character to a regional indicator character.
-- If the value is outside the @A-Z@ range, the result is unspecified.
--
-- The regional indicators are used for flag emojis. Two consecutive regional
-- indicators that together form an ISO 63166 Alpha-2 code, then this will
-- result in the corresponding flag Emoji. Deprecated countries like the Soviet
-- Union (SU) and Yugoslavia (YU) do not have a flag emoji. Antarctica (AQ),
-- the European Union (EU) and the United Nations (UN) have a flag emoji.
regionalIndicatorUppercase'
  :: Char  -- ^ The given 'Char'acter to convert.
  -> Char  -- ^ The corresponding 'Char'acter. If outside the range, unspecified result.
regionalIndicatorUppercase' :: Char -> Char
regionalIndicatorUppercase' = Int -> Char -> Char
liftUppercase' Int
0x1f1e6