{-# LANGUAGE CPP #-}

-- |
-- Module      : Unicode.Char.General.Scripts
-- Copyright   : (c) 2020 Composewell Technologies and Contributors
-- License     : Apache-2.0
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
--
-- Unicode [scripts](https://www.unicode.org/reports/tr24/) related functions.
--
-- @since 0.1.0
--

module Unicode.Char.General.Scripts
    ( S.Script(..)
    , script
    , scriptExtensions
    , scriptDefinition
    )
where

#include "MachDeps.h"

import Data.Char (chr)
import Data.List.NonEmpty (NonEmpty)
import GHC.Exts
       (Ptr(..), Char(..), Int(..),
        indexWord32OffAddr#, word2Int#,
        and#, isTrue#, neWord#, (-#), (<#), chr#)
#if MIN_VERSION_base(4,16,0)
import GHC.Exts (word32ToWord#)
#endif
#ifdef WORDS_BIGENDIAN
import GHC.Exts (byteSwap32#, narrow32Word#)
#endif

import qualified Unicode.Internal.Char.Scripts as S
import qualified Unicode.Internal.Char.ScriptExtensions as S

-- | Character [script](https://www.unicode.org/reports/tr24/).
--
-- @since 0.1.0
{-# INLINE script #-}
script :: Char -> S.Script
script :: Char -> Script
script = Int -> Script
forall a. Enum a => Int -> a
toEnum (Int -> Script) -> (Char -> Int) -> Char -> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
S.script

{- HLINT ignore scriptDefinition "Eta reduce" -}
-- | Characters corresponding to a 'S.Script'.
--
-- @since 0.1.0
scriptDefinition :: S.Script -> String
scriptDefinition :: Script -> String
scriptDefinition = (Ptr Int32, Int) -> String
forall {a}. (Ptr a, Int) -> String
unpack ((Ptr Int32, Int) -> String)
-> (Script -> (Ptr Int32, Int)) -> Script -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> (Ptr Int32, Int)
S.scriptDefinition
    where
    -- [NOTE] Encoding:
    -- • A single char is encoded as an LE Word32.
    -- • A range is encoded as two LE Word32 (first is lower bound, second is
    --   upper bound), which correspond to the codepoints with the 32th bit set.

    scriptRangeMask# :: Word#
scriptRangeMask# = Word#
0x80000000## -- 1 << 31
    maskComplement# :: Word#
maskComplement#  = Word#
0x7fffffff## -- 1 << 31 ^ 0xffffffff

    unpack :: (Ptr a, Int) -> String
unpack (Ptr Addr#
addr#, I# Int#
n#) = let {
        getRawCodePoint :: Int# -> Word#
getRawCodePoint Int#
k# =
#ifdef WORDS_BIGENDIAN
#if MIN_VERSION_base(4,16,0)
            narrow32Word# (byteSwap32# (word32ToWord# (indexWord32OffAddr# addr# k#)));
#else
            narrow32Word# (byteSwap32# (indexWord32OffAddr# addr# k#));
#endif
#elif MIN_VERSION_base(4,16,0)
            Word32# -> Word#
word32ToWord# (Addr# -> Int# -> Word32#
indexWord32OffAddr# Addr#
addr# Int#
k#);
#else
            indexWord32OffAddr# addr# k#;
#endif
        getCodePoint :: Word# -> Int#
getCodePoint Word#
k# = Word# -> Int#
word2Int# (Word# -> Word# -> Word#
and# Word#
maskComplement# Word#
k#);
        addRange :: Int# -> String -> String
addRange Int#
k# String
acc = if Int# -> Bool
isTrue# (Int#
k# Int# -> Int# -> Int#
<# Int#
0#)
            then String
acc
            else let {
                r1# :: Word#
r1# = Int# -> Word#
getRawCodePoint Int#
k#;
                c1# :: Int#
c1# = Word# -> Int#
getCodePoint Word#
r1#;
                isRange :: Bool
isRange = Int# -> Bool
isTrue# (Word# -> Word# -> Word#
and# Word#
r1# Word#
scriptRangeMask# Word# -> Word# -> Int#
`neWord#` Word#
0##)
            } in if Bool
isRange
                then let {
                    c2# :: Int#
c2# = Word# -> Int#
getCodePoint (Int# -> Word#
getRawCodePoint (Int#
k# Int# -> Int# -> Int#
-# Int#
1#));
                    acc' :: String
acc' = (Int -> String -> String) -> String -> [Int] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Char -> String -> String)
-> (Int -> Char) -> Int -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr) String
acc [Int# -> Int
I# Int#
c2# .. Int# -> Int
I# Int#
c1#]
                } in Int# -> String -> String
addRange (Int#
k# Int# -> Int# -> Int#
-# Int#
2#) String
acc'
                else Int# -> String -> String
addRange (Int#
k# Int# -> Int# -> Int#
-# Int#
1#) (Char# -> Char
C# (Int# -> Char#
chr# Int#
c1#) Char -> String -> String
forall a. a -> [a] -> [a]
: String
acc)
    } in Int# -> String -> String
addRange (Int#
n# Int# -> Int# -> Int#
-# Int#
1#) String
forall a. Monoid a => a
mempty

-- | Character
-- [script extensions](https://www.unicode.org/reports/tr24/#Script_Extensions).
--
-- @since 0.1.0
{-# INLINE scriptExtensions #-}
scriptExtensions :: Char -> NonEmpty S.Script
scriptExtensions :: Char -> NonEmpty Script
scriptExtensions = Int -> NonEmpty Script
S.decodeScriptExtensions (Int -> NonEmpty Script)
-> (Char -> Int) -> Char -> NonEmpty Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
S.scriptExtensions