-- |
-- Module      : Unicode.Char.General.Names
-- Copyright   : (c) 2022 Composewell Technologies and Contributors
-- License     : Apache-2.0
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
--
-- Unicode character names and name aliases.
-- See Unicode standard 15.0.0, section 4.8.
--
-- @since 0.1.0

module Unicode.Char.General.Names
    ( -- * Name
      name
    , nameOrAlias
    , correctedName
      -- * Name Aliases
    , NameAliases.NameAliasType(..)
    , nameAliases
    , nameAliasesByType
    , nameAliasesWithTypes
    ) where

import Control.Applicative ((<|>))
import Data.Maybe (listToMaybe)
import Foreign.C.String (CString, peekCAString)
import System.IO.Unsafe (unsafePerformIO)

import qualified Unicode.Internal.Char.UnicodeData.DerivedName as DerivedName
import qualified Unicode.Internal.Char.UnicodeData.NameAliases as NameAliases

-- | Name of a character, if defined.
--
-- @since 0.1.0
{-# INLINE name #-}
name :: Char -> Maybe String
name :: Char -> Maybe String
name = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CString -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe CString
DerivedName.name

-- | Returns /corrected/ name of a character (see 'NameAliases.Correction'),
-- if defined, otherwise returns its original 'name' if defined.
--
-- @since 0.1.0
{-# INLINE correctedName #-}
correctedName :: Char -> Maybe String
correctedName :: Char -> Maybe String
correctedName Char
c =
    forall a. [a] -> Maybe a
listToMaybe (NameAliasType -> Char -> [String]
nameAliasesByType NameAliasType
NameAliases.Correction Char
c) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Maybe String
name Char
c

-- | Returns a character’s 'name' if defined,
-- otherwise returns its first name alias if defined.
--
-- @since 0.1.0
nameOrAlias :: Char -> Maybe String
nameOrAlias :: Char -> Maybe String
nameOrAlias Char
c = Char -> Maybe String
name Char
c forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> case Char -> [(NameAliasType, [CString])]
NameAliases.nameAliasesWithTypes Char
c of
    (NameAliasType
_, CString
n:[CString]
_):[(NameAliasType, [CString])]
_ -> forall a. a -> Maybe a
Just (CString -> String
unpack CString
n)
    [(NameAliasType, [CString])]
_          -> forall a. Maybe a
Nothing

-- | All name aliases of a character, if defined.
-- The names are listed in the original order of the UCD.
--
-- See 'nameAliasesWithTypes' for the detailed list by alias type.
--
-- @since 0.1.0
{-# INLINE nameAliases #-}
nameAliases :: Char -> [String]
nameAliases :: Char -> [String]
nameAliases = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CString -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [CString]
NameAliases.nameAliases

-- | Name aliases of a character for a specific name alias type.
--
-- @since 0.1.0
{-# INLINE nameAliasesByType #-}
nameAliasesByType :: NameAliases.NameAliasType -> Char -> [String]
nameAliasesByType :: NameAliasType -> Char -> [String]
nameAliasesByType NameAliasType
t = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CString -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameAliasType -> Char -> [CString]
NameAliases.nameAliasesByType NameAliasType
t

-- | Detailed character names aliases.
-- The names are listed in the original order of the UCD.
--
-- See 'nameAliases' if the alias type is not required.
--
-- @since 0.1.0
{-# INLINE nameAliasesWithTypes #-}
nameAliasesWithTypes :: Char -> [(NameAliases.NameAliasType, [String])]
nameAliasesWithTypes :: Char -> [(NameAliasType, [String])]
nameAliasesWithTypes
  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CString -> String
unpack))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> [(NameAliasType, [CString])]
NameAliases.nameAliasesWithTypes

-- Note: names are ASCII. See Unicode Standard 15.0.0, section 4.8.
{-# INLINE unpack #-}
unpack :: CString -> String
unpack :: CString -> String
unpack = forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO String
peekCAString