diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,23 @@ +© 2007, Reinier Lamers + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + * The name of Reinier Lamers may not be used to endorse or promote products + derived from this software without specific prior written permission. + +This software is provided by the copyright holders and contributors “as is” and +any express or implied warranties, including, but not limited to, the implied +warranties of merchantability and fitness for a particular purpose are +disclaimed. In no event shall the foundation or contributors be liable for any +direct, indirect, incidental, special, exemplary, or consequential damages +(including, but not limited to, procurement of substitute goods or services; +loss of use, data, or profits; or business interruption) however caused and on +any theory of liability, whether in contract, strict liability, or tort +(including negligence or otherwise) arising in any way out of the use of this +software, even if advised of the possibility of such damage. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple +main = defaultMain + diff --git a/Text/Unicode/Base.hs b/Text/Unicode/Base.hs new file mode 100644 --- /dev/null +++ b/Text/Unicode/Base.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} +{-| + This module contains basal stuff for the CompactString ICU bindings. + The real functionality is in other modules. +-} +module Text.Unicode.Base(UChar + ,UErrorCode + ,UBool + ,uBoolToBool + ,BitPackable(..) + ,withCompactString + ,handleError + ,cOrderingToOrdering + ) where + +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(toForeignPtr) +#else +import Data.ByteString.Base(toForeignPtr) +#endif + +import Foreign.Ptr +import Foreign.ForeignPtr +import Foreign.C.Types(CInt, CChar) +import Foreign.Storable(peek, poke) +import Foreign.Marshal.Alloc(alloca) +import Data.Int(Int32) +import Data.Word(Word16) +import Data.Bits((.|.)) + +import Control.Monad(when) + +{-| + The ICU character type. A UChar is a 16-bit unit of a UTF-16 encoded string +-} +type UChar = Word16 + +{-| + The internal ICU error code type. +-} +type UErrorCode = CInt + +{-| + The internal ICU boolean type. + See unicode/umachine.h. Be aware that to Haskell, this is a numeric type and + not a boolean. +-} +type UBool = CChar + +{-| + Converts an ICU bool to a Haskell one, preserving truth or falsehood. +-} +uBoolToBool :: UBool -> Bool +uBoolToBool = (/= 0) + +{-| + A type class for all option types, for which we want to turn a list of options + into a bit field. +-} +class BitPackable a where + {-| + Tells of a certain option what its C integer/enum value is. + -} + intValue :: a -> Int32 + + {-| + Takes a list of options and encodes it into a C integer. + -} + packOptions :: [a] -> Int32 + packOptions = foldr (.|.) 0 . map intValue + + {-| + Runs a function, expecting a 32-bit integer, with the given options + bit-packed into a 32-bit integer. + -} + withPackedOptions :: [a] -> (Int32 -> IO b) -> IO b + withPackedOptions opts f = f $ packOptions opts + +{-| + Runs a raw ICU-type function on a CompactString encoded in UTF16. + The ICU-type function has type "Ptr UChar -> Int32 -> a". This function may + not modify the memory under the Ptr UChar. The size of the Ptr UChar in 16-bit + words is passed in as the Int32 argument. Accessing memory from Ptr UChar + outside of that size also sends us off to lala land, of course. +-} +withCompactString :: CompactString UTF16Native -> (Ptr UChar -> Int32 -> IO a) -> IO a +withCompactString cs f = withForeignPtr ptr $ \word8Pointer -> + let contentPointer = plusPtr word8Pointer offset :: Ptr UChar + numUChars = fromIntegral (length `div` 2) -- length is always even for a UTF-16 string + in f contentPointer numUChars + where (ptr, offset, length) = toForeignPtr $ CS.toByteString cs + +{-| + Provides simple (i.e. abort-if-anything-wrong) error handling for ICU + functions. + + Takes as an argument a function that writes an ICU error code to a certain + memory address (like most ICU4C functions do). + + This function runs the given function, giving it a memory address to write the + error code to. When the given function indicates an error, it aborts the + program. Otherwise it just returns the result. +-} +handleError :: (Ptr UErrorCode -> IO a) -> IO a +handleError f = alloca $ \errptr -> + do poke errptr 0 + result <- f errptr + errorCode <- peek errptr + when (errorCode > 0) (error (errMsg ++ show errorCode)) + return result + where errMsg = "Data.CompactString.ICU.handleError: error returned by ICU4C function: " + +{-| + Converts a C ordering (-1 means LT, 0 means EQ, 1 means GT) to a Haskell ordering. +-} +cOrderingToOrdering :: (Integral a) => a -> Ordering +cOrderingToOrdering i | i < 0 = LT + | i == 0 = EQ + | i > 0 = GT + diff --git a/Text/Unicode/Normalization.hs b/Text/Unicode/Normalization.hs new file mode 100644 --- /dev/null +++ b/Text/Unicode/Normalization.hs @@ -0,0 +1,203 @@ +{-# 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 + diff --git a/unicode-normalization.cabal b/unicode-normalization.cabal new file mode 100644 --- /dev/null +++ b/unicode-normalization.cabal @@ -0,0 +1,26 @@ +Name: unicode-normalization +Version: 0.1 +Cabal-Version: >= 1.2 +License: BSD3 +License-File: LICENSE +Author: Reinier Lamers +Maintainer: reinier.lamers@phil.uu.nl +Homepage: http://sloompie.reinier.de/unicode-normalization/ +Category: text +Synopsis: Unicode normalization using the ICU library +Description: Unicode normalization using the ICU library + +flag split-base + +Library + extensions: ForeignFunctionInterface, CPP + extra-libraries: icuuc + + Exposed-modules: + Text.Unicode.Base, Text.Unicode.Normalization + + if flag(split-base) + build-depends: base, compact-string, bytestring + else + build-depends: base, compact-string +