-- |
-- Module      : Unicode.Char
-- Copyright   : (c) 2024 Composewell Technologies and Contributors
-- License     : Apache-2.0
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental

module Unicode.Internal.Char.Label
    ( label
    , addHexCodePoint
    , intToDigiT
    ) where

import Data.Char (ord)
import Data.Functor (($>))
import Foreign.C.String (CString, CStringLen)
import Foreign.C.Types (CChar (..))
import Foreign.Marshal (allocaArray, copyArray)
import Foreign.Storable (Storable (..))
import GHC.Exts (Int (..), Int#, Ptr (..), isTrue#, quotRemInt#, (+#), (-#), (<=#))
import Unicode.Char.General (CodePointType (..), codePointType)

-- | Returns the label of a code point if it has no character name, otherwise
-- returns @\"UNDEFINED\"@.
--
-- See subsection
-- [“Code Point Labels”](https://www.unicode.org/versions/Unicode15.0.0/ch04.pdf#G135248)
-- in section 4.8 “Name” of the Unicode Standard.
--
-- @since 0.4.0
label :: Char -> IO CStringLen
label :: Char -> IO CStringLen
label Char
c = case Char -> CodePointType
codePointType Char
c of
    CodePointType
ControlType      -> Int# -> Addr# -> IO CStringLen
mkLabel Int#
8#  Addr#
"control-"#
    CodePointType
PrivateUseType   -> Int# -> Addr# -> IO CStringLen
mkLabel Int#
12# Addr#
"private-use-"#
    CodePointType
SurrogateType    -> Int# -> Addr# -> IO CStringLen
mkLabel Int#
10# Addr#
"surrogate-"#
    CodePointType
NoncharacterType -> Int# -> Addr# -> IO CStringLen
mkLabel Int#
13# Addr#
"noncharacter-"#
    CodePointType
ReservedType     -> Int# -> Addr# -> IO CStringLen
mkLabel Int#
9#  Addr#
"reserved-"#
    CodePointType
_                -> CStringLen -> IO CStringLen
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Addr# -> Ptr CChar
forall a. Addr# -> Ptr a
Ptr Addr#
"UNDEFINED"#, Int
9)

    where

    mkLabel :: Int# -> Addr# -> IO CStringLen
mkLabel Int#
len Addr#
s0 = Int -> (Ptr CChar -> IO CStringLen) -> IO CStringLen
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Int# -> Int
I# Int#
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) ((Ptr CChar -> IO CStringLen) -> IO CStringLen)
-> (Ptr CChar -> IO CStringLen) -> IO CStringLen
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
s -> do
        Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr CChar
s (Addr# -> Ptr CChar
forall a. Addr# -> Ptr a
Ptr Addr#
s0) (Int# -> Int
I# Int#
len)
        Int
len' <- Ptr CChar -> Int# -> Int# -> Char -> IO Int
addHexCodePoint Ptr CChar
s Int#
len Int#
len Char
c
        CStringLen -> IO CStringLen
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ptr CChar
s, Int
len')

-- | Appned the code point of a character using the Unicode Standard convention:
-- hexadecimal codepoint padded with zeros if inferior to 4 characters.
--
-- It is the responsability of the caller to provide a 'CString' that can hold
-- up to 6 characters from the provided index.
addHexCodePoint
    :: CString -- ^ Destination ASCII string
    -> Int#    -- ^ String length
    -> Int#    -- ^ Index
    -> Char    -- ^ Character which code point will be added to the string
    -> IO Int  -- ^ New size of the string
addHexCodePoint :: Ptr CChar -> Int# -> Int# -> Char -> IO Int
addHexCodePoint Ptr CChar
s Int#
len Int#
i0 Char
c
    | Int# -> Bool
isTrue# (Int#
cp# Int# -> Int# -> Int#
<=# Int#
0x0000f#) = Int# -> IO Int
prependAt Int#
3# IO Int -> IO () -> IO Int
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int# -> IO ()
pad0 Int#
0# IO Int -> IO () -> IO Int
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int# -> IO ()
pad0 Int#
1# IO Int -> IO () -> IO Int
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int# -> IO ()
pad0 Int#
2#
    | Int# -> Bool
isTrue# (Int#
cp# Int# -> Int# -> Int#
<=# Int#
0x000ff#) = Int# -> IO Int
prependAt Int#
3# IO Int -> IO () -> IO Int
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int# -> IO ()
pad0 Int#
0# IO Int -> IO () -> IO Int
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int# -> IO ()
pad0 Int#
1#
    | Int# -> Bool
isTrue# (Int#
cp# Int# -> Int# -> Int#
<=# Int#
0x00fff#) = Int# -> IO Int
prependAt Int#
3# IO Int -> IO () -> IO Int
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Int# -> IO ()
pad0 Int#
0#
    | Int# -> Bool
isTrue# (Int#
cp# Int# -> Int# -> Int#
<=# Int#
0x0ffff#) = Int# -> IO Int
prependAt Int#
3#
    | Int# -> Bool
isTrue# (Int#
cp# Int# -> Int# -> Int#
<=# Int#
0xfffff#) = Int# -> IO Int
prependAt Int#
4#
    | Bool
otherwise                  = Int# -> IO Int
prependAt Int#
5#
    where
    !(I# Int#
cp#) = Char -> Int
ord Char
c
    pad0 :: Int# -> IO ()
pad0 Int#
i = Ptr CChar -> Int -> CChar -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CChar
s (Int# -> Int
I# (Int#
i0 Int# -> Int# -> Int#
+# Int#
i)) (Int8 -> CChar
CChar Int8
0x30)
    prependAt :: Int# -> IO Int
prependAt Int#
i = Int# -> (# Int#, Int# #) -> IO ()
go (Int#
i0 Int# -> Int# -> Int#
+# Int#
i) (Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
cp# Int#
16#) IO () -> Int -> IO Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int# -> Int
I# (Int#
len Int# -> Int# -> Int#
+# Int#
i Int# -> Int# -> Int#
+# Int#
1#)
    go :: Int# -> (# Int#, Int# #) -> IO ()
go Int#
i (# Int#
n#, Int#
d #) = do
        Ptr CChar -> Int -> CChar -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CChar
s (Int# -> Int
I# Int#
i) (Int# -> CChar
intToDigiT Int#
d)
        case Int#
n# of
            Int#
0# -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Int#
_  -> Int# -> (# Int#, Int# #) -> IO ()
go (Int#
i Int# -> Int# -> Int#
-# Int#
1#) (Int# -> Int# -> (# Int#, Int# #)
quotRemInt# Int#
n# Int#
16#)

-- | Convert an 'Int#' in the range 0..15 to the corresponding single digit
-- 'CChar' in upper case.
--
-- Undefined for numbers outside the 0..15 range.
intToDigiT :: Int# -> CChar
intToDigiT :: Int# -> CChar
intToDigiT Int#
i = if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<=# Int#
9#)
    then Int -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (Int#
0x30# Int# -> Int# -> Int#
+# Int#
i))
    else Int -> CChar
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int# -> Int
I# (Int#
0x37# Int# -> Int# -> Int#
+# Int#
i))