-- |
-- Module      : Unicode.Char.Identifiers.Security
-- Copyright   : (c) 2021 Composewell Technologies and Contributors
-- License     : Apache-2.0
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
--
-- Unicode Security Mechanisms functions based on
-- [Unicode Technical Standard #39](https://www.unicode.org/reports/tr39/).
--
-- @since 0.1.0

module Unicode.Char.Identifiers.Security
    ( -- * Identifier status
      isAllowedInIdentifier

      -- * Identifier type
    , T.IdentifierType(..)
    , identifierTypes
    , isIdentifierTypeAllowed

      -- * Confusables
    , confusablePrototype
    -- , prototype
    , intentionalConfusables
    , isIntentionallyConfusable
    )
where

import           Data.List.NonEmpty (NonEmpty)
import           Data.Maybe (isJust)
import qualified GHC.Foreign as Foreign
import qualified GHC.IO.Encoding as Encoding
import           System.IO.Unsafe (unsafePerformIO)

import qualified Unicode.Internal.Char.Security.Confusables as C
import qualified Unicode.Internal.Char.Security.IdentifierStatus as S
import qualified Unicode.Internal.Char.Security.IdentifierType as T
import qualified Unicode.Internal.Char.Security.IntentionalConfusables as IC

-- | Returns 'True' if the given character is allowed in an identifier.
--
-- * /Restricted/ characters should be treated with caution when considering
-- possible use in identifiers, and should be disallowed unless there is
-- good reason to allow them in the environment in question.
-- * /Allowed/ characters are not typically used as is by implementations.
-- Instead, they are applied as filters to the set of supported characters.
--
-- @since 0.1.0
{-# INLINE isAllowedInIdentifier #-}
isAllowedInIdentifier :: Char -> Bool
isAllowedInIdentifier :: Char -> Bool
isAllowedInIdentifier = Char -> Bool
S.isAllowedInIdentifier

-- | Return 'True' if the given 'T.IdentifierType' is allowed.
--
-- @since 0.1.0
{-# INLINE isIdentifierTypeAllowed #-}
isIdentifierTypeAllowed :: T.IdentifierType -> Bool
isIdentifierTypeAllowed :: IdentifierType -> Bool
isIdentifierTypeAllowed = \case
    IdentifierType
T.Inclusion   -> Bool
True
    IdentifierType
T.Recommended -> Bool
True
    IdentifierType
_             -> Bool
False

-- | Returns the 'IdentifierType's corresponding to a character.
--
-- @since 0.1.0
{-# INLINE identifierTypes #-}
identifierTypes :: Char -> NonEmpty T.IdentifierType
identifierTypes :: Char -> NonEmpty IdentifierType
identifierTypes = Int -> NonEmpty IdentifierType
T.decodeIdentifierTypes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
T.identifierTypes

-- | Returns the /prototype/ of a character if it is /unintentionally/
-- confusable, else 'Nothing'.
--
-- @since 0.1.0
{-# INLINE confusablePrototype #-}
confusablePrototype :: Char -> Maybe String
confusablePrototype :: Char -> Maybe String
confusablePrototype = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CString -> String
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe CString
C.confusablePrototype
    where
    decode :: CString -> String
decode = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> CString -> IO String
Foreign.peekCString TextEncoding
Encoding.utf8

-- [TODO] Assess the need for this function
-- -- | Returns the /prototype/ of a character.
-- --
-- -- Note: returns the character itself if it is not /unintentionally/ confusable.
-- --
-- -- @since 0.1.0
-- {-# INLINE prototype #-}
-- prototype :: Char -> String
-- prototype c = fromMaybe [c] (confusablePrototype c)

-- | Returns the list of /intentional/ confusables of a character, if any.
--
-- @since 0.1.0
{-# INLINE intentionalConfusables #-}
intentionalConfusables :: Char -> String
intentionalConfusables :: Char -> String
intentionalConfusables = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty CString -> String
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe CString
IC.intentionalConfusables
    where
    decode :: CString -> String
decode = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> CString -> IO String
Foreign.peekCString TextEncoding
Encoding.utf8

-- | Returns 'True' if the character is /intentionally/ confusable.
--
-- @since 0.1.0
{-# INLINE isIntentionallyConfusable #-}
isIntentionallyConfusable :: Char -> Bool
isIntentionallyConfusable :: Char -> Bool
isIntentionallyConfusable = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe CString
IC.intentionalConfusables