{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-|
This module contains functions to do Unicode normalization of CompactStrings.
-}
module Text.Unicode.Normalization(NormalizationMode(..)
,normalizationToCInt -- voor QuickCheck
,NormalizationOption(..)
,normalize
,NormalizationCheckResult(..)
,quickCheck
,isNormalized
,concatenate
,ComparisonOption(..)
,compare
) where
import Prelude hiding (compare)
-- for the foreign hackery
import System.IO.Unsafe(unsafePerformIO)
import Foreign.Ptr
import Foreign.C.Types
import Data.Int
-- Strings in UTF-16
import Data.CompactString(CompactString)
import Data.CompactString.Encodings(UTF16Native)
import qualified Data.CompactString as CS
import qualified Data.CompactString.Unsafe as CS(unsafeFromByteString)
#if __GLASGOW_HASKELL__ >= 608
import Data.ByteString.Internal(createAndTrim)
#else
import Data.ByteString.Base(createAndTrim)
#endif
import Text.Unicode.Base
-- debugging
import Debug.Trace
{-|
A data type for representing an ICU Normalization type. You use this to specify
how you'd like ICU to normalize your string.
-}
data NormalizationMode = NFD | NFKD | NFC | NFKC | FCD deriving (Eq, Show)
{-|
Options to pass to normalize.
There is only one option ATM.
-}
data NormalizationOption = Unicode3_2 -- ^ Normalize according to Unicode 3.2
deriving (Eq, Show)
instance BitPackable NormalizationOption where
intValue Unicode3_2 = 0x20
{-|
Internal function to convert a NormalizationMode to its C enum value
-}
normalizationToCInt :: NormalizationMode -> CInt
normalizationToCInt NFD = 2
normalizationToCInt NFKD = 3
normalizationToCInt NFC = 4
normalizationToCInt NFKC = 5
normalizationToCInt FCD = 6
foreign import ccall "unicode/unorm.h unorm_normalize_3_8" raw_normalize :: Ptr UChar -> Int32 -> CInt -> Int32 -> Ptr UChar -> Int32 -> Ptr UErrorCode -> IO Int32
{-|
Normalizes the given string, according to the given normalization type and options.
This function is a higher-level wrapper around raw_normalize.
Move this to something like Data.CompactString.Normalization, eventually.
Generalize out the UErrorCode handling.
-}
normalize :: CompactString UTF16Native -> NormalizationMode -> [NormalizationOption] -> CompactString UTF16Native
-- bouw weer CompactString van bytestring waaruit buf en bufSize voortgekomen zijn --
normalize s n opts = CS.unsafeFromByteString $ unsafePerformIO $ createAndTrim maxBufSizeWord8s $ \tptr ->
withCompactString s $ \sptr slen ->
withPackedOptions opts $ \rawOptions ->
let buf = castPtr tptr :: Ptr UChar
rawNormalization = normalizationToCInt n
rawBufSize = fromIntegral maxBufSizeUChars
in do resultLength <- handleError $ \errptr ->
raw_normalize sptr slen rawNormalization rawOptions buf rawBufSize errptr
-- resultLength is in UChars,return value in Word8s.
-- So multiply by two.
return (fromIntegral resultLength * 2)
where -- normalization to NFD never takes more than three times the space of
-- the original string, according to Unicode
maxBufSizeWord8s = 3 * 2 * CS.length s
maxBufSizeUChars = 3 * CS.length s
{-|
A type for the result of a quick normalization check.
-}
data NormalizationCheckResult = Normalized | NotNormalized | MaybeNormalized deriving (Eq, Show)
{-|
Translates a normalization check result from C land to a NormalizationCheckResult.
-}
int32ToNormalizationCheckResult :: Int32 -> NormalizationCheckResult
int32ToNormalizationCheckResult 0 = NotNormalized
int32ToNormalizationCheckResult 1 = Normalized
int32ToNormalizationCheckResult 2 = MaybeNormalized
foreign import ccall "unicode/unorm.h unorm_quickCheckWithOptions_3_8" raw_quickCheck :: Ptr UChar -> Int32 -> CInt -> Int32 -> Ptr UErrorCode -> IO Int32
{-|
Attempts to check quickly whether a string is already normalized according to a certain
normalization mode.
When you get MaybeNormalized as a result, you should normalize the
string and compare it to the original to know if it is normalized. You can
make ICU do that by calling isNormalized.
-}
quickCheck :: CompactString UTF16Native -> NormalizationMode -> [NormalizationOption] -> NormalizationCheckResult
quickCheck s nm opts = int32ToNormalizationCheckResult $ unsafePerformIO $ withCompactString s $ \buf len ->
withPackedOptions opts $ \rawOpts ->
handleError $ \errptr -> raw_quickCheck buf len rawNormalizationMode rawOpts errptr
where rawNormalizationMode = normalizationToCInt nm
foreign import ccall "unicode/unorm.h unorm_isNormalizedWithOptions_3_8" raw_isNormalized :: Ptr UChar -> Int32 -> CInt -> Int32 -> Ptr UErrorCode -> IO UBool
{-|
Tells of a string whether it is already normalized according to a certain
mode and options
-}
isNormalized :: CompactString UTF16Native -> NormalizationMode -> [NormalizationOption] -> Bool
isNormalized s nm opts = uBoolToBool $ unsafePerformIO $ withCompactString s $ \buf len ->
withPackedOptions opts $ \rawOpts ->
handleError $ \errptr -> raw_isNormalized buf len rawNormalizationMode rawOpts errptr
where rawNormalizationMode = normalizationToCInt nm
foreign import ccall "unicode/unorm.h unorm_concatenate_3_8" raw_concatenate :: Ptr UChar -> Int32 -> Ptr UChar -> Int32 -> Ptr UChar -> Int32 -> CInt -> Int32 -> Ptr UErrorCode -> IO Int32
{-|
Concatenates two normalized strings, such that the result is also normalized.
More formally:
Given that string1 is normalized according to mode and options, and string2
is normalized according to mode and options, the result of concatenate
string1 string2 mode options will be a concatenation of string1 and string2
and be normalized according to mode and options.
-}
concatenate :: CompactString UTF16Native
-> CompactString UTF16Native
-> NormalizationMode
-> [NormalizationOption]
-> CompactString UTF16Native
concatenate s1 s2 m opts = CS.unsafeFromByteString $ unsafePerformIO $ createAndTrim maxBufSizeWord8s $ \targetPtrWord8 ->
withCompactString s1 $ \buf1 len1 ->
withCompactString s2 $ \buf2 len2 ->
withPackedOptions opts $ \rawOpts ->
handleError $ \errptr ->
let targetPtr = castPtr targetPtrWord8 :: Ptr UChar
in do bufUsed <- raw_concatenate buf1 len1
buf2 len2
targetPtr maxBufSizeUChars
rawMode rawOpts errptr
-- again, we get an Int32
-- from C but we must
-- supply an Int to
-- createAndTrim
return (fromIntegral bufUsed * 2)
where rawMode = normalizationToCInt m
-- the buffer size estimate is overly big, but I can't come up with
-- anything less ATM
maxBufSizeWord8s :: Int
maxBufSizeWord8s = fromIntegral (2 * maxBufSizeUChars)
maxBufSizeUChars :: Int32
maxBufSizeUChars = fromIntegral (3 * (CS.length s1 + CS.length s2))
{-|
A data type to encode options to the compare function.
-}
data ComparisonOption = InputIsFCD -- ^ Assume that both strings are FCD normalized
| IgnoreCase -- ^ Do case-insensitive comparison
| CompareCodePointOrder -- ^ Compare by code point order (default is code unit order)
deriving (Eq, Show)
instance BitPackable ComparisonOption where
intValue InputIsFCD = 0x20000
intValue IgnoreCase = 0x10000
intValue CompareCodePointOrder = 0x8000
foreign import ccall "unicode/unorm.h unorm_compare_3_8" raw_compare :: Ptr UChar -> Int32 -> Ptr UChar -> Int32 -> Int32 -> Ptr UErrorCode -> IO Int32
{-|
Compares two Unicode strings for canonical equivalence.
Two Unicode strings are canonically equivalent when their NFD and NFC
normalizations are equal.
-}
compare :: CompactString UTF16Native -> CompactString UTF16Native -> [ComparisonOption] -> Ordering
compare s1 s2 opts = cOrderingToOrdering $ unsafePerformIO $ withCompactString s1 $ \buf1 len1 ->
withCompactString s2 $ \buf2 len2 ->
withPackedOptions opts $ \rawOpts ->
handleError $ \errptr ->
raw_compare buf1 len1 buf2 len2 rawOpts errptr