unicode-normalization (empty) → 0.1
raw patch · 5 files changed
+379/−0 lines, 5 filesdep +basedep +bytestringdep +compact-stringbuild-type:Customsetup-changed
Dependencies added: base, bytestring, compact-string
Files
- LICENSE +23/−0
- Setup.hs +3/−0
- Text/Unicode/Base.hs +124/−0
- Text/Unicode/Normalization.hs +203/−0
- unicode-normalization.cabal +26/−0
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ Text/Unicode/Base.hs view
@@ -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+
+ Text/Unicode/Normalization.hs view
@@ -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+
+ unicode-normalization.cabal view
@@ -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+