text-icu 0.3.0.0 → 0.4.0.0
raw patch · 17 files changed
+1336/−89 lines, 17 files
Files
- Data/Text/ICU.hs +79/−0
- Data/Text/ICU/Break.hsc +224/−0
- Data/Text/ICU/Collate.hsc +321/−0
- Data/Text/ICU/Collate/Internal.hs +67/−0
- Data/Text/ICU/Collate/Pure.hs +74/−0
- Data/Text/ICU/Convert.hs +5/−9
- Data/Text/ICU/Error.hsc +15/−2
- Data/Text/ICU/Error/Internal.hs +18/−18
- Data/Text/ICU/Internal.hs +0/−24
- Data/Text/ICU/Internal.hsc +99/−0
- Data/Text/ICU/Iterator.hs +70/−0
- Data/Text/ICU/Normalize.hsc +24/−34
- Data/Text/ICU/Text.hs +98/−0
- Data/Text/ICU/Types.hs +18/−0
- cbits/text_icu.c +146/−0
- include/hs_text_icu.h +64/−0
- text-icu.cabal +14/−2
+ Data/Text/ICU.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE CPP, NoImplicitPrelude #-}+-- |+-- Module : Data.Text.ICU+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Commonly used functions for Unicode, implemented as bindings to the+-- International Components for Unicode (ICU) libraries.+--+-- This module contains only the most commonly used types and+-- functions. Other modules in this package expose richer interfaces.+module Data.Text.ICU+ (+ -- * Data representation+ -- $data++ -- * Types+ LocaleName(..)+ -- * Case mapping+ , toCaseFold+ , toLower+ , toUpper+ -- * Iteration+ , CharIterator+ , fromString+ , fromText+ , fromUtf8+ -- * Normalization+ , NormalizationMode(..)+ , normalize+ , quickCheck+ , isNormalized+ -- * String comparison+ -- ** Normalization-sensitive string comparison+ , CompareOption(..)+ , compare+ -- ** Locale-sensitive string collation+ -- $collate+ , Collator+ , collator+ , collate+ , collateIter+ , sortKey+ , uca+ ) where++import Data.Text.ICU.Collate.Pure+import Data.Text.ICU.Internal+import Data.Text.ICU.Iterator+import Data.Text.ICU.Normalize+import Data.Text.ICU.Text+#if defined(__HADDOCK__)+import Data.Text.Foreign+import Data.Text (Text)+#endif++-- $data+--+-- The Haskell 'Text' type is implemented as an array in the Haskell+-- heap. This means that its location is not pinned; it may be copied+-- during a garbage collection pass. ICU, on the other hand, works+-- with strings that are allocated in the normal system heap and have+-- a fixed address.+--+-- To accommodate this need, these bindings use the functions from+-- 'Data.Text.Foreign' to copy data between the Haskell heap and the+-- system heap. The copied strings are still managed automatically,+-- but the need to duplicate data does add some performance and memory+-- overhead.++-- $collate+--+-- For the impure collation API (which is richer, but less easy to+-- use than the pure API), see the 'Data.Text.ICU.Collate'+-- module.
+ Data/Text/ICU/Break.hsc view
@@ -0,0 +1,224 @@+{-# LANGUAGE BangPatterns, EmptyDataDecls, ForeignFunctionInterface #-}+-- |+-- Module : Data.Text.ICU.Break+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- String breaking functions for Unicode, implemented as bindings to+-- the International Components for Unicode (ICU) libraries.+--+-- The text boundary positions are found according to the rules described in+-- Unicode Standard Annex #29, Text Boundaries, and Unicode Standard Annex+-- #14, Line Breaking Properties. These are available at+-- <http://www.unicode.org/reports/tr14/> and+-- <http://www.unicode.org/reports/tr29/>.++module Data.Text.ICU.Break+ (+ -- * Types+ BreakIterator+ , Line(..)+ , Word(..)+ -- * Breaking functions+ , breakCharacter+ , breakLine+ , breakSentence+ , breakWord+ , setText+ -- * Iteration functions+ , first+ , last+ , next+ , previous+ , getStatus+ , getStatuses+ ) where++#include <unicode/ubrk.h>++import Data.Int (Int32)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Text (Text)+import Data.Text.Foreign (dropWord16, takeWord16, useAsPtr)+import Data.Text.ICU.Error.Internal (UErrorCode, handleError)+import Data.Text.ICU.Internal (LocaleName, UChar, withLocaleName)+import Foreign.C.String (CString)+import Foreign.C.Types (CInt)+import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)+import Foreign.Marshal.Array (allocaArray, peekArray)+import Foreign.Ptr (FunPtr, Ptr, nullPtr)+import Prelude hiding (last)++-- | Line break status.+data Line = Soft -- ^ A soft line break is a position at+ -- which a line break is acceptable, but not+ -- required.+ | Hard+ deriving (Eq, Show, Enum)++-- | Word break status.+data Word = Uncategorized -- ^ A "word" that does not fit into another+ -- category. Includes spaces and most+ -- punctuation.+ | Number -- ^ A word that appears to be a number.+ | Letter -- ^ A word containing letters, excluding+ -- hiragana, katakana or ideographic+ -- characters.+ | Kana -- ^ A word containing kana characters.+ | Ideograph -- ^ A word containing ideographic characters.+ deriving (Eq, Show, Enum)++-- A break iterator.+data BreakIterator a = BI (IORef Text) (Int32 -> a) (ForeignPtr UBreakIterator)++-- | Break a string on character boundaries.+--+-- Character boundary analysis identifies the boundaries of "Extended+-- Grapheme Clusters", which are groupings of codepoints that should be+-- treated as character-like units for many text operations. Please see+-- Unicode Standard Annex #29, Unicode Text Segmentation,+-- <http://www.unicode.org/reports/tr29/> for additional information on+-- grapheme clusters and guidelines on their use.+breakCharacter :: LocaleName -> Text -> IO (BreakIterator ())+breakCharacter = open (#const UBRK_CHARACTER) (const ())++-- | Break a string on line boundaries.+--+-- Line boundary analysis determines where a text string can be broken when+-- line wrapping. The mechanism correctly handles punctuation and hyphenated+-- words.+breakLine :: LocaleName -> Text -> IO (BreakIterator Line)+breakLine = open (#const UBRK_LINE) asLine+ where+ asLine i+ | i < (#const UBRK_LINE_SOFT_LIMIT) = Soft+ | i < (#const UBRK_LINE_HARD_LIMIT) = Hard+ | otherwise = error $ "unknown line break status " ++ show i++-- | Break a string on sentence boundaries.+--+-- Sentence boundary analysis allows selection with correct interpretation+-- of periods within numbers and abbreviations, and trailing punctuation+-- marks such as quotation marks and parentheses.+breakSentence :: LocaleName -> Text -> IO (BreakIterator ())+breakSentence = open (#const UBRK_SENTENCE) (const ())++-- | Break a string on word boundaries.+--+-- Word boundary analysis is used by search and replace functions, as well+-- as within text editing applications that allow the user to select words+-- with a double click. Word selection provides correct interpretation of+-- punctuation marks within and following words. Characters that are not+-- part of a word, such as symbols or punctuation marks, have word breaks on+-- both sides.+breakWord :: LocaleName -> Text -> IO (BreakIterator Word)+breakWord = open (#const UBRK_WORD) asWord+ where+ asWord i+ | i < (#const UBRK_WORD_NONE_LIMIT) = Uncategorized+ | i < (#const UBRK_WORD_NUMBER_LIMIT) = Number+ | i < (#const UBRK_WORD_LETTER_LIMIT) = Letter+ | i < (#const UBRK_WORD_KANA_LIMIT) = Kana+ | i < (#const UBRK_WORD_IDEO_LIMIT) = Ideograph+ | otherwise = error $ "unknown word break status " ++ show i++-- | Create a new 'BreakIterator' for locating text boundaries in the+-- specified locale.+open :: UBreakIteratorType -> (Int32 -> a) -> LocaleName -> Text+ -> IO (BreakIterator a)+open brk f loc t = withLocaleName loc $ \locale ->+ useAsPtr t $ \ptr len -> do+ bi <- handleError $ ubrk_open brk locale ptr (fromIntegral len)+ r <- newIORef t+ BI r f `fmap` newForeignPtr ubrk_close bi++-- | Point an existing 'BreakIterator' at a new piece of text.+setText :: BreakIterator a -> Text -> IO ()+setText (BI r _ bi) t =+ useAsPtr t $ \ptr len -> do+ withForeignPtr bi $ \p -> handleError $+ ubrk_setText p ptr (fromIntegral len)+ writeIORef r t++asIndex :: (Ptr UBreakIterator -> IO Int32) -> BreakIterator a+ -> IO (Maybe (Text, Text))+asIndex act (BI r _ bi) = do+ ix <- withForeignPtr bi act+ if ix == (#const UBRK_DONE)+ then return Nothing+ else do+ let n = fromIntegral ix+ t <- readIORef r+ return $! Just (takeWord16 n t, dropWord16 n t)++-- | Reset the iterator and break at the first character in the text being+-- scanned.+first :: BreakIterator a -> IO (Maybe (Text, Text))+first = asIndex ubrk_first++-- | Reset the iterator and break immediately /beyond/ the last character in+-- the text being scanned.+last :: BreakIterator a -> IO (Maybe (Text, Text))+last = asIndex ubrk_last++-- | Advance the iterator and break at the text boundary that follows the+-- current text boundary.+next :: BreakIterator a -> IO (Maybe (Text, Text))+next = asIndex ubrk_next++-- | Advance the iterator and break at the text boundary that precedes the+-- current text boundary.+previous :: BreakIterator a -> IO (Maybe (Text, Text))+previous = asIndex ubrk_previous++-- | Return the status from the break rule that determined the most recently+-- returned break position. For rules that do not specify a status, a+-- default value of @()@ is returned.+getStatus :: BreakIterator a -> IO a+getStatus (BI _ f bi) = f `fmap` withForeignPtr bi ubrk_getRuleStatus++-- | Return statuses from all of the break rules that determined the most+-- recently returned break position.+getStatuses :: BreakIterator a -> IO [a]+getStatuses (BI _ f bi) =+ withForeignPtr bi $ \brk -> do+ n <- handleError $ ubrk_getRuleStatusVec brk nullPtr 0+ allocaArray (fromIntegral n) $ \ptr -> do+ _ <- handleError $ ubrk_getRuleStatusVec brk ptr n+ map f `fmap` peekArray (fromIntegral n) ptr++type UBreakIteratorType = CInt+data UBreakIterator++foreign import ccall unsafe "hs_text_icu.h __hs_ubrk_open" ubrk_open+ :: UBreakIteratorType -> CString -> Ptr UChar -> Int32 -> Ptr UErrorCode+ -> IO (Ptr UBreakIterator)++foreign import ccall unsafe "hs_text_icu.h __hs_ubrk_setText" ubrk_setText+ :: Ptr UBreakIterator -> Ptr UChar -> Int32 -> Ptr UErrorCode+ -> IO ()++foreign import ccall unsafe "hs_text_icu.h &__hs_ubrk_close" ubrk_close+ :: FunPtr (Ptr UBreakIterator -> IO ())++foreign import ccall unsafe "hs_text_icu.h __hs_ubrk_first" ubrk_first+ :: Ptr UBreakIterator -> IO Int32++foreign import ccall unsafe "hs_text_icu.h __hs_ubrk_last" ubrk_last+ :: Ptr UBreakIterator -> IO Int32++foreign import ccall unsafe "hs_text_icu.h __hs_ubrk_next" ubrk_next+ :: Ptr UBreakIterator -> IO Int32++foreign import ccall unsafe "hs_text_icu.h __hs_ubrk_previous" ubrk_previous+ :: Ptr UBreakIterator -> IO Int32++foreign import ccall unsafe "hs_text_icu.h __hs_ubrk_getRuleStatus" ubrk_getRuleStatus+ :: Ptr UBreakIterator -> IO Int32++foreign import ccall unsafe "hs_text_icu.h __hs_ubrk_getRuleStatusVec" ubrk_getRuleStatusVec+ :: Ptr UBreakIterator -> Ptr Int32 -> Int32 -> Ptr UErrorCode -> IO Int32
+ Data/Text/ICU/Collate.hsc view
@@ -0,0 +1,321 @@+{-# LANGUAGE CPP, DeriveDataTypeable, ForeignFunctionInterface #-}+-- |+-- Module : Data.Text.ICU.Collate+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- String collation functions for Unicode, implemented as bindings to+-- the International Components for Unicode (ICU) libraries.++module Data.Text.ICU.Collate+ (+ -- * Unicode collation API+ -- $api+ -- * Types+ MCollator+ , Attribute(..)+ , AlternateHandling(..)+ , CaseFirst(..)+ , Strength(..)+ -- * Functions+ , open+ , collate+ , collateIter+ -- ** Utility functions+ , equals+ , getAttribute+ , setAttribute+ , sortKey+ , freeze+ ) where++#include <unicode/ucol.h>++import Data.ByteString (empty)+import Data.ByteString.Internal (ByteString(..), create, mallocByteString,+ memcpy)+import Data.Int (Int32)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Foreign (useAsPtr)+import Data.Text.ICU.Collate.Internal (Collator(..), MCollator, UCollator,+ equals, withCollator, wrap)+import Data.Text.ICU.Error.Internal (UErrorCode, handleError)+import Data.Text.ICU.Internal+ (LocaleName, UChar, CharIterator, UCharIterator,+ asOrdering, withCharIterator, withLocaleName)+import Data.Typeable (Typeable)+import Data.Word (Word8)+import Foreign.C.String (CString)+import Foreign.C.Types (CInt)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (Ptr, nullPtr)++-- $api+--++-- | Control the handling of variable weight elements.+data AlternateHandling = NonIgnorable+ -- ^ Treat all codepoints with non-ignorable primary+ -- weights in the same way.+ | Shifted+ -- ^ Cause codepoints with primary weights that are+ -- equal to or below the variable top value to be+ -- ignored on primary level and moved to the+ -- quaternary level.+ deriving (Eq, Bounded, Enum, Show, Typeable)++-- | Control the ordering of upper and lower case letters.+data CaseFirst = UpperFirst -- ^ Force upper case letters to sort before+ -- lower case.+ | LowerFirst -- ^ Force lower case letters to sort before+ -- upper case.+ deriving (Eq, Bounded, Enum, Show, Typeable)++-- | The strength attribute. The usual strength for most locales (except+-- Japanese) is tertiary. Quaternary strength is useful when combined with+-- shifted setting for alternate handling attribute and for JIS x 4061+-- collation, when it is used to distinguish between Katakana and Hiragana+-- (this is achieved by setting 'HiraganaQuaternaryMode' mode to+-- 'True'). Otherwise, quaternary level is affected only by the number of+-- non ignorable code points in the string. Identical strength is rarely+-- useful, as it amounts to codepoints of the 'NFD' form of the string.+data Strength = Primary+ | Secondary+ | Tertiary+ | Quaternary+ | Identical+ deriving (Eq, Bounded, Enum, Show, Typeable)++data Attribute = French Bool+ -- ^ Direction of secondary weights, used in French. 'True',+ -- results in secondary weights being considered backwards,+ -- while 'False' treats secondary weights in the order in+ -- which they appear.+ | AlternateHandling AlternateHandling+ -- ^ For handling variable elements. 'NonIgnorable' is+ -- default.+ | CaseFirst (Maybe CaseFirst)+ -- ^ Control the ordering of upper and lower case letters.+ -- 'Nothing' (the default) orders upper and lower case+ -- letters in accordance to their tertiary weights.+ | CaseLevel Bool+ -- ^ Controls whether an extra case level (positioned+ -- before the third level) is generated or not. When+ -- 'False' (default), case level is not generated; when+ -- 'True', the case level is generated. Contents of the+ -- case level are affected by the value of the 'CaseFirst'+ -- attribute. A simple way to ignore accent differences in+ -- a string is to set the strength to 'Primary' and enable+ -- case level.+ | NormalizationMode Bool+ -- ^ Controls whether the normalization check and necessary+ -- normalizations are performed. When 'False' (default) no+ -- normalization check is performed. The correctness of the+ -- result is guaranteed only if the input data is in+ -- so-called 'FCD' form (see users manual for more info).+ -- When 'True', an incremental check is performed to see+ -- whether the input data is in 'FCD' form. If the data is+ -- not in 'FCD' form, incremental 'NFD' normalization is+ -- performed.+ | Strength Strength+ | HiraganaQuaternaryMode Bool+ -- ^ When turned on, this attribute positions Hiragana+ -- before all non-ignorables on quaternary level. This is a+ -- sneaky way to produce JIS sort order.+ | Numeric Bool+ -- ^ When enabled, this attribute generates a collation key+ -- for the numeric value of substrings of digits. This is+ -- a way to get '100' to sort /after/ '2'.+ deriving (Eq, Show, Typeable)++type UColAttribute = CInt+type UColAttributeValue = CInt++toUAttribute :: Attribute -> (UColAttribute, UColAttributeValue)+toUAttribute (French v)+ = ((#const UCOL_FRENCH_COLLATION), toOO v)+toUAttribute (AlternateHandling v)+ = ((#const UCOL_ALTERNATE_HANDLING), toAH v)+toUAttribute (CaseFirst v)+ = ((#const UCOL_CASE_FIRST), toCF v)+toUAttribute (CaseLevel v)+ = ((#const UCOL_CASE_LEVEL), toOO v)+toUAttribute (NormalizationMode v)+ = ((#const UCOL_NORMALIZATION_MODE), toOO v)+toUAttribute (Strength v)+ = ((#const UCOL_STRENGTH), toS v)+toUAttribute (HiraganaQuaternaryMode v)+ = ((#const UCOL_HIRAGANA_QUATERNARY_MODE), toOO v)+toUAttribute (Numeric v)+ = ((#const UCOL_NUMERIC_COLLATION), toOO v)++toOO :: Bool -> UColAttributeValue+toOO False = #const UCOL_OFF+toOO True = #const UCOL_ON++toAH :: AlternateHandling -> UColAttributeValue+toAH NonIgnorable = #const UCOL_NON_IGNORABLE+toAH Shifted = #const UCOL_SHIFTED++toCF :: Maybe CaseFirst -> UColAttributeValue+toCF Nothing = #const UCOL_OFF+toCF (Just UpperFirst) = #const UCOL_UPPER_FIRST+toCF (Just LowerFirst) = #const UCOL_LOWER_FIRST++toS :: Strength -> UColAttributeValue+toS Primary = #const UCOL_PRIMARY+toS Secondary = #const UCOL_SECONDARY+toS Tertiary = #const UCOL_TERTIARY+toS Quaternary = #const UCOL_QUATERNARY+toS Identical = #const UCOL_IDENTICAL++fromOO :: UColAttributeValue -> Bool+fromOO (#const UCOL_OFF) = False+fromOO (#const UCOL_ON) = True+fromOO bad = valueError "fromOO" bad++fromAH :: UColAttributeValue -> AlternateHandling+fromAH (#const UCOL_NON_IGNORABLE) = NonIgnorable+fromAH (#const UCOL_SHIFTED) = Shifted+fromAH bad = valueError "fromAH" bad++fromCF :: UColAttributeValue -> Maybe CaseFirst+fromCF (#const UCOL_OFF) = Nothing+fromCF (#const UCOL_UPPER_FIRST) = Just UpperFirst+fromCF (#const UCOL_LOWER_FIRST) = Just LowerFirst+fromCF bad = valueError "fromCF" bad++fromS :: UColAttributeValue -> Strength+fromS (#const UCOL_PRIMARY) = Primary+fromS (#const UCOL_SECONDARY) = Secondary+fromS (#const UCOL_TERTIARY) = Tertiary+fromS (#const UCOL_QUATERNARY) = Quaternary+fromS (#const UCOL_IDENTICAL) = Identical+fromS bad = valueError "fromS" bad++fromUAttribute :: UColAttribute -> UColAttributeValue -> Attribute+fromUAttribute key val =+ case key of+ (#const UCOL_FRENCH_COLLATION) -> French (fromOO val)+ (#const UCOL_ALTERNATE_HANDLING) -> AlternateHandling (fromAH val)+ (#const UCOL_CASE_FIRST) -> CaseFirst (fromCF val)+ (#const UCOL_CASE_LEVEL) -> CaseLevel (fromOO val)+ (#const UCOL_NORMALIZATION_MODE) -> NormalizationMode (fromOO val)+ (#const UCOL_STRENGTH) -> Strength (fromS val)+ (#const UCOL_HIRAGANA_QUATERNARY_MODE) -> HiraganaQuaternaryMode (fromOO val)+ (#const UCOL_NUMERIC_COLLATION) -> Numeric (fromOO val)+ _ -> valueError "fromUAttribute" key++valueError :: Show a => String -> a -> z+valueError func bad = error ("Data.Text.ICU.Collate.IO." ++ func +++ ": invalid value " ++ show bad)++type UCollationResult = CInt++-- | Open a 'Collator' for comparing strings.+open :: LocaleName+ -- ^ The locale containing the required collation rules.+ -> IO MCollator+open loc = wrap =<< withLocaleName loc (handleError . ucol_open)++-- | Set the value of an 'MCollator' attribute.+setAttribute :: MCollator -> Attribute -> IO ()+setAttribute c a =+ withCollator c $ \cptr ->+ handleError $ uncurry (ucol_setAttribute cptr) (toUAttribute a)++-- | Get the value of an 'MCollator' attribute.+--+-- It is safe to provide a dummy argument to an 'Attribute' constructor when+-- using this function, so the following will work:+--+-- > getAttribute mcol (NormalizationMode undefined)+getAttribute :: MCollator -> Attribute -> IO Attribute+getAttribute c a = do+ let name = fst (toUAttribute a)+ val <- withCollator c $ \cptr -> handleError $ ucol_getAttribute cptr name+ return $! fromUAttribute name val++-- | Compare two strings.+collate :: MCollator -> Text -> Text -> IO Ordering+collate c a b =+ withCollator c $ \cptr ->+ useAsPtr a $ \aptr alen ->+ useAsPtr b $ \bptr blen ->+ fmap asOrdering . handleError $+ ucol_strcoll cptr aptr (fromIntegral alen) bptr (fromIntegral blen)++-- | Compare two 'CharIterator's.+--+-- If either iterator was constructed from a 'ByteString', it does not need+-- to be copied or converted internally, so this function can be quite+-- cheap.+collateIter :: MCollator -> CharIterator -> CharIterator -> IO Ordering+collateIter c a b =+ fmap asOrdering . withCollator c $ \cptr ->+ withCharIterator a $ \ai ->+ withCharIterator b $ handleError . ucol_strcollIter cptr ai++-- | Create a key for sorting the 'Text' using the given 'Collator'.+-- The result of comparing two 'ByteString's that have been+-- transformed with 'sortKey' will be the same as the result of+-- 'collate' on the two untransformed 'Text's.+sortKey :: MCollator -> Text -> IO ByteString+sortKey c t+ | T.null t = return empty+ | otherwise = do+ withCollator c $ \cptr ->+ useAsPtr t $ \tptr tlen -> do+ let len = fromIntegral tlen+ loop n = do+ fp <- mallocByteString (fromIntegral n)+ i <- withForeignPtr fp $ \p -> ucol_getSortKey cptr tptr len p n+ let j = fromIntegral i+ case undefined of+ _ | i == 0 -> error "Data.Text.ICU.Collate.IO.sortKey: internal error"+ | i > n -> loop i+ | i <= n `div` 2 -> create j $ \p -> withForeignPtr fp $ \op ->+ memcpy p op (fromIntegral i)+ | otherwise -> return $! PS fp 0 j+ loop (min (len * 4) 8)++-- | Make a safe copy of a mutable 'MCollator' for use in pure code.+-- Subsequent changes to the 'MCollator' will not affect the state of+-- the returned 'Collator'.+freeze :: MCollator -> IO Collator+freeze c = do+ p <- withCollator c $ \cptr ->+ with (#const U_COL_SAFECLONE_BUFFERSIZE)+ (handleError . ucol_safeClone cptr nullPtr)+ C `fmap` wrap p++foreign import ccall unsafe "hs_text_icu.h __hs_ucol_open" ucol_open+ :: CString -> Ptr UErrorCode -> IO (Ptr UCollator)++foreign import ccall unsafe "hs_text_icu.h __hs_ucol_getAttribute" ucol_getAttribute+ :: Ptr UCollator -> UColAttribute -> Ptr UErrorCode -> IO UColAttributeValue++foreign import ccall unsafe "hs_text_icu.h __hs_ucol_setAttribute" ucol_setAttribute+ :: Ptr UCollator -> UColAttribute -> UColAttributeValue -> Ptr UErrorCode -> IO ()++foreign import ccall unsafe "hs_text_icu.h __hs_ucol_strcoll" ucol_strcoll+ :: Ptr UCollator -> Ptr UChar -> Int32 -> Ptr UChar -> Int32+ -> Ptr UErrorCode -> IO UCollationResult++foreign import ccall unsafe "hs_text_icu.h __hs_ucol_getSortKey" ucol_getSortKey+ :: Ptr UCollator -> Ptr UChar -> Int32 -> Ptr Word8 -> Int32+ -> IO Int32++foreign import ccall unsafe "hs_text_icu.h __hs_ucol_strcollIter" ucol_strcollIter+ :: Ptr UCollator -> Ptr UCharIterator -> Ptr UCharIterator -> Ptr UErrorCode+ -> IO UCollationResult++foreign import ccall unsafe "hs_text_icu.h __hs_ucol_safeClone" ucol_safeClone+ :: Ptr UCollator -> Ptr a -> Ptr Int32 -> Ptr UErrorCode+ -> IO (Ptr UCollator)
+ Data/Text/ICU/Collate/Internal.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE DeriveDataTypeable, EmptyDataDecls, ForeignFunctionInterface #-}+-- |+-- Module : Data.Text.ICU.Collate.Internal+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Internals of the string collation infrastructure.++module Data.Text.ICU.Collate.Internal+ (+ -- * Unicode collation API+ MCollator(..)+ , Collator(..)+ , UCollator+ , equals+ , withCollator+ , wrap+ ) where++import Data.Text.ICU.Internal (UBool, asBool)+import Data.Typeable (Typeable)+import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)+import Foreign.Ptr (FunPtr, Ptr)+import System.IO.Unsafe (unsafePerformIO)++-- $api+--++data UCollator++-- | String collator type.+data MCollator = MCollator {-# UNPACK #-} !(ForeignPtr UCollator)+ deriving (Typeable)++-- | String collator type. 'Collator's are considered equal if they+-- will sort strings identically.+newtype Collator = C MCollator+ deriving (Typeable)++instance Eq Collator where+ (C a) == (C b) = unsafePerformIO $ equals a b++withCollator :: MCollator -> (Ptr UCollator -> IO a) -> IO a+withCollator (MCollator col) action = withForeignPtr col action+{-# INLINE withCollator #-}++wrap :: Ptr UCollator -> IO MCollator+wrap = fmap MCollator . newForeignPtr ucol_close+{-# INLINE wrap #-}++-- | 'MCollator's are considered equal if they will sort strings+-- identically. This means that both the current attributes and the rules+-- must be equivalent.+equals :: MCollator -> MCollator -> IO Bool+equals a b = fmap asBool .+ withCollator a $ \aptr ->+ withCollator b $ ucol_equals aptr++foreign import ccall unsafe "hs_text_icu.h &__hs_ucol_close" ucol_close+ :: FunPtr (Ptr UCollator -> IO ())++foreign import ccall unsafe "hs_text_icu.h __hs_ucol_equals" ucol_equals+ :: Ptr UCollator -> Ptr UCollator -> IO UBool
+ Data/Text/ICU/Collate/Pure.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE DeriveDataTypeable, ForeignFunctionInterface #-}+-- |+-- Module : Data.Text.ICU.Collate.Pure+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Pure string collation functions for Unicode, implemented as+-- bindings to the International Components for Unicode (ICU)+-- libraries.+--+-- For the impure collation API (which is richer, but less easy to+-- use), see the 'Data.Text.ICU.CollateO' module.++module Data.Text.ICU.Collate.Pure+ (+ -- * Unicode collation API+ -- $api+ Collator+ , collator+ , collate+ , collateIter+ , sortKey+ , uca+ ) where++#include <unicode/ucol.h>++import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Text.ICU.Collate.Internal (Collator(..))+import Data.Text.ICU.Internal (CharIterator, LocaleName(..))+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.Text.ICU.Collate as IO++-- $api+--+ +-- | Create an immutable 'Collator' for comparing strings.+--+-- If 'Root' is passed as the locale, UCA collation rules will be+-- used.+collator :: LocaleName -> Collator+collator loc = unsafePerformIO $ C `fmap` IO.open loc++-- | Compare two strings.+collate :: Collator -> Text -> Text -> Ordering+collate (C c) a b = unsafePerformIO $ IO.collate c a b+{-# INLINE collate #-}++-- | Compare two 'CharIterator's.+--+-- If either iterator was constructed from a 'ByteString', it does not+-- need to be copied or converted beforehand, so this function can be+-- quite cheap.+collateIter :: Collator -> CharIterator -> CharIterator -> Ordering+collateIter (C c) a b = unsafePerformIO $ IO.collateIter c a b+{-# INLINE collateIter #-}++-- | Create a key for sorting the 'Text' using the given 'Collator'.+-- The result of comparing two 'ByteString's that have been+-- transformed with 'sortKey' will be the same as the result of+-- 'collate' on the two untransformed 'Text's.+sortKey :: Collator -> Text -> ByteString+sortKey (C c) = unsafePerformIO . IO.sortKey c+{-# INLINE sortKey #-}++-- | A 'Collator' that uses the Unicode Collation Algorithm (UCA).+uca :: Collator+uca = collator Root+{-# NOINLINE uca #-}
Data/Text/ICU/Convert.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE CPP, ForeignFunctionInterface #-}+{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Module : Data.Text.ICU.Convert--- Copyright : (c) Bryan O'Sullivan 2009+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan -- -- License : BSD-style -- Maintainer : bos@serpentine.com@@ -11,7 +11,6 @@ -- Character set conversion functions for Unicode, implemented as -- bindings to the International Components for Unicode (ICU) -- libraries.- module Data.Text.ICU.Convert ( -- * Character set conversion@@ -47,9 +46,9 @@ import Foreign.C.Types (CInt) import Foreign.ForeignPtr (newForeignPtr) import Foreign.Marshal.Array (allocaArray)-import Foreign.Ptr (FunPtr, Ptr, castPtr, nullPtr)+import Foreign.Ptr (FunPtr, Ptr, castPtr) import System.IO.Unsafe (unsafePerformIO)-import Data.Text.ICU.Internal (UBool, UChar, asBool, asOrdering)+import Data.Text.ICU.Internal (UBool, UChar, asBool, asOrdering, withName) -- | Do a fuzzy compare of two converter/alias names. The comparison -- is case-insensitive, ignores leading zeroes if they are not@@ -96,14 +95,11 @@ -- (see 'usesFallback' for details). -> IO Converter open name mf = do- c <- fmap Converter . newForeignPtr ucnv_close =<< named (handleError . ucnv_open)+ c <- fmap Converter . newForeignPtr ucnv_close =<< withName name (handleError . ucnv_open) case mf of Just f -> withConverter c $ \p -> ucnv_setFallback p . fromIntegral . fromEnum $ f _ -> return () return c- where named act- | null name = act nullPtr- | otherwise = withCString name act -- | Convert the Unicode string into a codepage string using the given -- converter.
Data/Text/ICU/Error.hsc view
@@ -1,7 +1,20 @@+-- |+-- Module : Data.Text.ICU.Error+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Errors thrown by bindings to the International Components for+-- Unicode (ICU) libraries.+--+-- Most ICU functions can throw an 'ICUError' value as an exception. module Data.Text.ICU.Error ( -- * Types- ErrorCode,+ ICUError, -- * Functions isSuccess,@@ -153,7 +166,7 @@ import Data.Text.ICU.Error.Internal -#{enum ErrorCode, ErrorCode,+#{enum ICUError, ICUError, u_USING_FALLBACK_WARNING = U_USING_FALLBACK_WARNING, u_USING_DEFAULT_WARNING = U_USING_DEFAULT_WARNING, u_SAFECLONE_ALLOCATED_WARNING = U_SAFECLONE_ALLOCATED_WARNING,
Data/Text/ICU/Error/Internal.hs view
@@ -3,7 +3,7 @@ module Data.Text.ICU.Error.Internal ( -- * Types- ErrorCode(..)+ ICUError(..) -- ** Low-level types , UErrorCode -- * Functions@@ -17,32 +17,34 @@ import Control.Exception (Exception, throw) import Foreign.Ptr (Ptr)-import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Utils (with) import Data.Typeable (Typeable) import Foreign.C.String (CString, peekCString) import Foreign.C.Types (CInt)-import Foreign.Storable (peek, poke)+import Foreign.Storable (peek) import System.IO.Unsafe (unsafePerformIO) type UErrorCode = CInt --- | ICU error code.-newtype ErrorCode = ErrorCode {+-- | ICU error type. This is an instance of the 'Exception' type+-- class. A value of this type may be thrown as an exception by most+-- ICU functions.+newtype ICUError = ICUError { fromErrorCode :: UErrorCode } deriving (Eq, Typeable) -instance Show ErrorCode where- show code = "ErrorCode " ++ errorName code+instance Show ICUError where+ show code = "ICUError " ++ errorName code -instance Exception ErrorCode+instance Exception ICUError -- | Indicate whether the given error code is a success.-isSuccess :: ErrorCode -> Bool+isSuccess :: ICUError -> Bool {-# INLINE isSuccess #-} isSuccess = (<= 0) . fromErrorCode -- | Indicate whether the given error code is a failure.-isFailure :: ErrorCode -> Bool+isFailure :: ICUError -> Bool {-# INLINE isFailure #-} isFailure = (> 0) . fromErrorCode @@ -50,29 +52,27 @@ throwOnError :: UErrorCode -> IO () {-# INLINE throwOnError #-} throwOnError code = do- let err = (ErrorCode code)+ let err = (ICUError code) if isFailure err then throw err else return () -withError :: (Ptr UErrorCode -> IO a) -> IO (ErrorCode, a)+withError :: (Ptr UErrorCode -> IO a) -> IO (ICUError, a) {-# INLINE withError #-}-withError action = alloca $ \errPtr -> do- poke errPtr 0+withError action = with 0 $ \errPtr -> do ret <- action errPtr err <- peek errPtr- return (ErrorCode err, ret)+ return (ICUError err, ret) handleError :: (Ptr UErrorCode -> IO a) -> IO a {-# INLINE handleError #-}-handleError action = alloca $ \errPtr -> do- poke errPtr 0+handleError action = with 0 $ \errPtr -> do ret <- action errPtr throwOnError =<< peek errPtr return ret -- | Return a string representing the name of the given error code.-errorName :: ErrorCode -> String+errorName :: ICUError -> String errorName code = unsafePerformIO $ peekCString (u_errorName (fromErrorCode code))
− Data/Text/ICU/Internal.hs
@@ -1,24 +0,0 @@-module Data.Text.ICU.Internal- (- UBool- , UChar- , asBool- , asOrdering- ) where--import Data.Int (Int8)-import Data.Word (Word16)--type UBool = Int8-type UChar = Word16--asBool :: Integral a => a -> Bool-{-# INLINE asBool #-}-asBool = (/=0)--asOrdering :: Integral a => a -> Ordering-{-# INLINE asOrdering #-}-asOrdering i- | i < 0 = LT- | i == 0 = EQ- | otherwise = GT
+ Data/Text/ICU/Internal.hsc view
@@ -0,0 +1,99 @@+{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-}++module Data.Text.ICU.Internal+ (+ LocaleName(..)+ , UBool+ , UChar+ , UCharIterator+ , CharIterator(..)+ , asBool+ , asOrdering+ , withCharIterator+ , withLocaleName+ , withName+ ) where++#include <unicode/uiter.h>++import Data.ByteString.Internal (ByteString(..))+import Data.Int (Int8, Int32)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8)+import Data.Text.Foreign (useAsPtr)+import Data.Word (Word16)+import Foreign.C.String (CString, withCString)+import Foreign.C.Types (CChar)+import Foreign.Marshal.Alloc (alloca)+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, castPtr, nullPtr)+import Foreign.Storable (Storable(..))++-- | A type that supports efficient iteration over Unicode characters.+--+-- As an example of where this may be useful, a function using this+-- type may be able to iterate over a UTF-8 'ByteString' directly,+-- rather than first copying and converting it to an intermediate+-- form. This type also allows e.g. comparison between 'Text' and+-- 'ByteString', with minimal overhead.+data CharIterator = CIText !Text+ | CIUTF8 !ByteString++instance Show CharIterator where+ show (CIText t) = show t+ show (CIUTF8 bs) = show (decodeUtf8 bs)++data UCharIterator++instance Storable UCharIterator where+ sizeOf _ = #{size UCharIterator}+ alignment _ = alignment (undefined :: CString)++-- | Temporarily allocate a 'UCharIterator' and use it with the+-- contents of the to-be-iterated-over string.+withCharIterator :: CharIterator -> (Ptr UCharIterator -> IO a) -> IO a+withCharIterator (CIUTF8 (PS fp _ l)) act =+ alloca $ \i -> withForeignPtr fp $ \p ->+ uiter_setUTF8 i (castPtr p) (fromIntegral l) >> act i+withCharIterator (CIText t) act =+ alloca $ \i -> useAsPtr t $ \p l ->+ uiter_setString i p (fromIntegral l) >> act i++type UBool = Int8+type UChar = Word16++asBool :: Integral a => a -> Bool+{-# INLINE asBool #-}+asBool = (/=0)++asOrdering :: Integral a => a -> Ordering+{-# INLINE asOrdering #-}+asOrdering i+ | i < 0 = LT+ | i == 0 = EQ+ | otherwise = GT++withName :: String -> (CString -> IO a) -> IO a+withName name act+ | null name = act nullPtr+ | otherwise = withCString name act++-- | The name of a locale.+data LocaleName = Root+ -- ^ The root locale. For a description of resource bundles+ -- and the root resource, see+ -- <http://userguide.icu-project.org/locale/resources>.+ | Locale String -- ^ A specific locale.+ | Current -- ^ The program's current locale. + deriving (Eq, Ord, Read, Show)++withLocaleName :: LocaleName -> (CString -> IO a) -> IO a+withLocaleName Current act = act nullPtr+withLocaleName Root act = withCString "" act+withLocaleName (Locale n) act = withCString n act++foreign import ccall unsafe "hs_text_icu.h __hs_uiter_setString" uiter_setString+ :: Ptr UCharIterator -> Ptr UChar -> Int32 -> IO ()++foreign import ccall unsafe "hs_text_icu.h __hs_uiter_setUTF8" uiter_setUTF8+ :: Ptr UCharIterator -> Ptr CChar -> Int32 -> IO ()
+ Data/Text/ICU/Iterator.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Data.Text.ICU.Iterator+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Iteration functions for Unicode, implemented as bindings to the+-- International Components for Unicode (ICU) libraries.+--+-- Unlike the C and C++ @UCharIterator@ type, the Haskell+-- 'CharIterator' type is immutable, and can safely be used in pure+-- code.+--+-- Functions using these iterators may be more efficient than their+-- counterparts. For instance, the 'CharIterator' type allows a UTF-8+-- 'ByteString' to be compared against a 'Text', without first+-- converting the 'ByteString':+--+-- > fromUtf8 bs == fromText t+module Data.Text.ICU.Iterator+ (+ -- * Types and constructors+ CharIterator+ , fromString+ , fromText+ , fromUtf8+ ) where++import Data.ByteString (ByteString)+import Data.Int (Int32)+import Data.Text (Text, pack)+import Data.Text.ICU.Internal (CharIterator(..), UCharIterator, asOrdering,+ withCharIterator)+import Foreign.Ptr (Ptr)+import System.IO.Unsafe (unsafePerformIO)++instance Eq CharIterator where+ a == b = compareIter a b == EQ++instance Ord CharIterator where+ compare = compareIter++-- | Compare two 'CharIterator's.+compareIter :: CharIterator -> CharIterator -> Ordering+compareIter a b = unsafePerformIO . fmap asOrdering .+ withCharIterator a $ withCharIterator b . u_strCompareIter++-- | Construct a 'CharIterator' from a Unicode string.+fromString :: String -> CharIterator+fromString = CIText . pack+{-# INLINE fromString #-}++-- | Construct a 'CharIterator' from a Unicode string.+fromText :: Text -> CharIterator+fromText = CIText+{-# INLINE fromText #-}++-- | Construct a 'CharIterator' from a Unicode string encoded as a+-- UTF-8 'ByteString'.+fromUtf8 :: ByteString -> CharIterator+fromUtf8 = CIUTF8+{-# INLINE fromUtf8 #-}++foreign import ccall unsafe "hs_text_icu.h __hs_u_strCompareIter" u_strCompareIter+ :: Ptr UCharIterator -> Ptr UCharIterator -> IO Int32
Data/Text/ICU/Normalize.hsc view
@@ -1,8 +1,7 @@-{-# LANGUAGE CPP, DeriveDataTypeable, ForeignFunctionInterface,- GeneralizedNewtypeDeriving #-}+{-# LANGUAGE CPP, DeriveDataTypeable, ForeignFunctionInterface #-} -- | -- Module : Data.Text.ICU.Normalize--- Copyright : (c) Bryan O'Sullivan 2009+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan -- -- License : BSD-style -- Maintainer : bos@serpentine.com@@ -21,7 +20,6 @@ -- * Normalization functions , normalize -- * Normalization checks- , NormalizationCheckResult(..) , quickCheck , isNormalized -- * Normalization-sensitive comparison@@ -56,10 +54,10 @@ -- $api ----- 'normalize' transforms Unicode text into an equivalent composed or--- decomposed form, allowing for easier sorting and searching of text.--- 'normalize' supports the standard normalization forms described in--- <http://www.unicode.org/unicode/reports/tr15/>,+-- The 'normalize' function transforms Unicode text into an equivalent+-- composed or decomposed form, allowing for easier sorting and+-- searching of text. 'normalize' supports the standard normalization+-- forms described in <http://www.unicode.org/unicode/reports/tr15/>, -- Unicode Standard Annex #15: Unicode Normalization Forms. -- -- Characters with accents or other adornments can be encoded in@@ -163,12 +161,9 @@ -- | Options to 'compare'. data CompareOption = InputIsFCD -- ^ The caller knows that both strings fulfill the- -- 'FCD' conditions. If not set, 'compare' will+ -- 'FCD' conditions. If /not/ set, 'compare' will -- 'quickCheck' for 'FCD' and normalize if -- necessary.- | CompareCodePointOrder- -- ^ Choose code point order instead of code unit- -- order. | CompareIgnoreCase -- ^ Compare strings case-insensitively using case -- folding, instead of case-sensitively. If set,@@ -182,12 +177,11 @@ fromCompareOption :: CompareOption -> UCompareOption fromCompareOption InputIsFCD = #const UNORM_INPUT_IS_FCD-fromCompareOption CompareCodePointOrder = #const U_COMPARE_CODE_POINT_ORDER fromCompareOption CompareIgnoreCase = #const U_COMPARE_IGNORE_CASE fromCompareOption FoldCaseExcludeSpecialI = #const U_FOLD_CASE_EXCLUDE_SPECIAL_I reduceCompareOptions :: [CompareOption] -> UCompareOption-reduceCompareOptions = foldl' orO (#const U_FOLD_CASE_DEFAULT)+reduceCompareOptions = foldl' orO (#const U_COMPARE_CODE_POINT_ORDER) where a `orO` b = a .|. fromCompareOption b type UNormalizationMode = CInt@@ -212,18 +206,10 @@ type UNormalizationCheckResult = CInt --- | Result of a fast normalization check using 'quickCheck'.-data NormalizationCheckResult- = No -- ^ Text is not normalized.- | Perhaps -- ^ It cannot be determined whether text is in normalized - -- form without further thorough checks.- | Yes -- ^ Text is in normalized form.- deriving (Eq, Show, Enum, Typeable)- -toNCR :: UNormalizationCheckResult -> NormalizationCheckResult-toNCR (#const UNORM_NO) = No-toNCR (#const UNORM_MAYBE) = Perhaps-toNCR (#const UNORM_YES) = Yes+toNCR :: UNormalizationCheckResult -> Maybe Bool+toNCR (#const UNORM_NO) = Just False+toNCR (#const UNORM_MAYBE) = Nothing+toNCR (#const UNORM_YES) = Just True toNCR _ = error "toNormalizationCheckResult" -- | Normalize a string according the specified normalization mode.@@ -246,12 +232,16 @@ -- | Perform an efficient check on a string, to quickly determine if--- the string is in a particular normalization format.+-- the string is in a particular normalization form. ----- A 'Perhaps' result indicates that a more thorough check is--- required, e.g. with 'isNormalized'. The user may have to put the--- string in its normalized form and compare the results.-quickCheck :: NormalizationMode -> Text -> NormalizationCheckResult+-- A 'Nothing' result indicates that a certain answer could not be+-- determined quickly, and a more thorough check is required,+-- e.g. with 'isNormalized'. The user may have to convert the string+-- to its normalized form and compare the results.+--+-- A result of 'Just' 'True' or 'Just' 'False' indicates that the+-- string definitely is, or is not, in the given normalization form.+quickCheck :: NormalizationMode -> Text -> Maybe Bool quickCheck mode t = unsafePerformIO . useAsPtr t $ \ptr len -> fmap toNCR . handleError $ unorm_quickCheck ptr (fromIntegral len)@@ -281,9 +271,9 @@ -- performance significantly. -- -- Bulk normalization is only necessary if the strings do not fulfill--- the FCD conditions. Only in this case, and only if the strings are--- relatively long, is memory allocated temporarily. For FCD strings--- and short non-FCD strings there is no memory allocation.+-- the 'FCD' conditions. Only in this case, and only if the strings+-- are relatively long, is memory allocated temporarily. For 'FCD'+-- strings and short non-'FCD' strings there is no memory allocation. compare :: [CompareOption] -> Text -> Text -> Ordering compare opts a b = unsafePerformIO . useAsPtr a $ \aptr alen ->
+ Data/Text/ICU/Text.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- |+-- Module : Data.Text.ICU.Text+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Functions for manipulating Unicode text, implemented as bindings to+-- the International Components for Unicode (ICU) libraries.+module Data.Text.ICU.Text+ (+ -- * Case conversion+ -- $case+ toCaseFold+ , toLower+ , toUpper+ ) where++import Data.Int (Int32)+import Data.Text (Text)+import Data.Text.Foreign (fromPtr, useAsPtr)+import Data.Text.ICU.Error.Internal (UErrorCode, handleError)+import Data.Text.ICU.Internal (LocaleName, UChar, withLocaleName)+import Data.Word (Word32)+import Foreign.C.String (CString)+import Foreign.Marshal.Array (allocaArray)+import Foreign.Ptr (Ptr)+import System.IO.Unsafe (unsafePerformIO)++-- $case+--+-- In some languages, case conversion is a locale- and+-- context-dependent operation. The case conversion functions in this+-- module are locale and context sensitive.++-- | Case-fold the characters in a string.+--+-- Case folding is locale independent and not context sensitive, but+-- there is an option for treating the letter I specially for Turkic+-- languages. The result may be longer or shorter than the original.+toCaseFold :: Bool -- ^ Whether to include or exclude mappings for+ -- dotted and dotless I and i that are marked with+ -- 'I' in @CaseFolding.txt@.+ -> Text -> Text+toCaseFold excludeI s = unsafePerformIO .+ useAsPtr s $ \sptr slen -> do+ let opts = fromIntegral . fromEnum $ excludeI+ go len = allocaArray len $ \dptr -> do+ n <- fmap fromIntegral . handleError $+ u_strFoldCase dptr (fromIntegral len) sptr+ (fromIntegral slen) opts+ if n > len+ then go n+ else fromPtr dptr n+ go slen++type CaseMapper = Ptr UChar -> Int32 -> Ptr UChar -> Int32 -> CString+ -> Ptr UErrorCode -> IO Int32++caseMap :: CaseMapper -> LocaleName -> Text -> Text+caseMap mapFn loc s = unsafePerformIO .+ withLocaleName loc $ \locale ->+ useAsPtr s $ \sptr slen -> do+ let go len = allocaArray len $ \dptr -> do+ n <- fmap fromIntegral . handleError $+ mapFn dptr (fromIntegral len) sptr+ (fromIntegral slen) locale+ if n > len+ then go n+ else fromPtr dptr n+ go slen++-- | Lowercase the characters in a string.+--+-- Casing is locale dependent and context sensitive. The result may+-- be longer or shorter than the original.+toLower :: LocaleName -> Text -> Text+toLower = caseMap u_strToLower++-- | Uppercase the characters in a string.+--+-- Casing is locale dependent and context sensitive. The result may+-- be longer or shorter than the original.+toUpper :: LocaleName -> Text -> Text+toUpper = caseMap u_strToUpper++foreign import ccall unsafe "hs_text_icu.h __hs_u_strFoldCase" u_strFoldCase+ :: Ptr UChar -> Int32 -> Ptr UChar -> Int32 -> Word32 -> Ptr UErrorCode+ -> IO Int32++foreign import ccall unsafe "hs_text_icu.h __hs_u_strToLower" u_strToLower+ :: CaseMapper++foreign import ccall unsafe "hs_text_icu.h __hs_u_strToUpper" u_strToUpper+ :: CaseMapper
+ Data/Text/ICU/Types.hs view
@@ -0,0 +1,18 @@+-- |+-- Module : Data.Text.ICU.Types+-- Copyright : (c) 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Types for use when manipulating Unicode text, using the bindings to+-- the International Components for Unicode (ICU) libraries.+module Data.Text.ICU.Types+ (+ -- * Widely used types+ LocaleName(..)+ ) where++import Data.Text.ICU.Internal (LocaleName(..))
cbits/text_icu.c view
@@ -1,5 +1,112 @@ #include "hs_text_icu.h" +UBreakIterator* __hs_ubrk_open(UBreakIteratorType type, const char *locale,+ const UChar *text, int32_t textLength,+ UErrorCode *status)+{+ return ubrk_open(type, locale, text, textLength, status);+}++void __hs_ubrk_close(UBreakIterator *bi)+{+ ubrk_close(bi);+}++void __hs_ubrk_setText(UBreakIterator* bi, const UChar *text,+ int32_t textLength, UErrorCode *status)+{+ ubrk_setText(bi, text, textLength, status);+}++int32_t __hs_ubrk_first(UBreakIterator *bi)+{+ return ubrk_first(bi);+}++int32_t __hs_ubrk_last(UBreakIterator *bi)+{+ return ubrk_last(bi);+}++int32_t __hs_ubrk_next(UBreakIterator *bi)+{+ return ubrk_next(bi);+}++int32_t __hs_ubrk_previous(UBreakIterator *bi)+{+ return ubrk_previous(bi);+}++int32_t __hs_ubrk_getRuleStatus(UBreakIterator *bi)+{+ return ubrk_getRuleStatus(bi);+}++int32_t __hs_ubrk_getRuleStatusVec(UBreakIterator *bi, int32_t *fillInVec,+ int32_t capacity, UErrorCode *status)+{+ return ubrk_getRuleStatusVec(bi, fillInVec, capacity, status);+}++UCollator* __hs_ucol_open(const char *loc, UErrorCode *status)+{+ return ucol_open(loc, status);+}++void __hs_ucol_close(UCollator *coll)+{+ ucol_close(coll);+}++void __hs_ucol_setAttribute(UCollator *coll, UColAttribute attr,+ UColAttributeValue value, UErrorCode *status)+{+ ucol_setAttribute(coll, attr, value, status);+}++UColAttributeValue __hs_ucol_getAttribute(const UCollator *coll,+ UColAttribute attr,+ UErrorCode *status)+{+ return ucol_getAttribute(coll, attr, status);+}++UCollationResult __hs_ucol_strcoll(const UCollator *coll,+ const UChar *source, int32_t sourceLength,+ const UChar *target, int32_t targetLength)+{+ return ucol_strcoll(coll, source, sourceLength, target, targetLength);+}++UCollationResult __hs_ucol_strcollIter(const UCollator *coll,+ UCharIterator *sIter,+ UCharIterator *tIter,+ UErrorCode *status)+{+ return ucol_strcollIter(coll, sIter, tIter, status);+}++UCollator* __hs_ucol_safeClone(const UCollator *coll,+ void *stackBuffer,+ int32_t *pBufferSize,+ UErrorCode *status)+{+ return ucol_safeClone(coll, stackBuffer, pBufferSize, status);+}++int32_t __hs_ucol_getSortKey(const UCollator *coll,+ const UChar *source, int32_t sourceLength,+ uint8_t *result, int32_t resultLength)+{+ return ucol_getSortKey(coll, source, sourceLength, result, resultLength);+}++UBool __hs_ucol_equals(const UCollator *source, const UCollator *target)+{+ return ucol_equals(source, target);+}+ int __get_max_bytes_for_string(UConverter *cnv, int src_length) { return UCNV_GET_MAX_BYTES_FOR_STRING(src_length, ucnv_getMaxCharSize(cnv));@@ -100,6 +207,16 @@ return ucnv_isAmbiguous(cnv); } +void __hs_uiter_setString(UCharIterator *iter, const UChar *s, int32_t length)+{+ uiter_setString(iter, s, length);+}++void __hs_uiter_setUTF8(UCharIterator *iter, const char *s, int32_t length)+{+ uiter_setUTF8(iter, s, length);+}+ int32_t __hs_unorm_compare(const UChar *s1, int32_t length1, const UChar *s2, int32_t length2, uint32_t options,@@ -131,3 +248,32 @@ return unorm_normalize(source, sourceLength, mode, options, result, resultLength, status); }++int32_t __hs_u_strToUpper(UChar *dest, int32_t destCapacity,+ const UChar *src, int32_t srcLength,+ const char *locale, UErrorCode *pErrorCode)+{+ return u_strToUpper(dest, destCapacity, src, srcLength, locale, pErrorCode);+}++int32_t __hs_u_strToLower(UChar *dest, int32_t destCapacity,+ const UChar *src, int32_t srcLength,+ const char *locale, UErrorCode *pErrorCode)+{+ return u_strToLower(dest, destCapacity, src, srcLength, locale, pErrorCode);+}++int32_t __hs_u_strFoldCase(UChar *dest, int32_t destCapacity,+ const UChar *src, int32_t srcLength,+ uint32_t options, UErrorCode *pErrorCode)+{+ return u_strFoldCase(dest, destCapacity, src, srcLength, options,+ pErrorCode);+}++int32_t __hs_u_strCompareIter(UCharIterator *iter1, UCharIterator *iter2)+{+ return u_strCompareIter(iter1, iter2, TRUE);+}++
include/hs_text_icu.h view
@@ -3,11 +3,57 @@ #endif #include "unicode/utypes.h"++#include "unicode/ubrk.h"+#include "unicode/ucol.h" #include "unicode/ucnv.h"+#include "unicode/uiter.h" #include "unicode/unorm.h"+#include "unicode/ustring.h" #include <stdint.h> +/* ubrk.h */++UBreakIterator* __hs_ubrk_open(UBreakIteratorType type, const char *locale,+ const UChar *text, int32_t textLength,+ UErrorCode *status);+void __hs_ubrk_close(UBreakIterator *bi);+void __hs_ubrk_setText(UBreakIterator* bi, const UChar *text,+ int32_t textLength, UErrorCode *status);+int32_t __hs_ubrk_first(UBreakIterator *bi);+int32_t __hs_ubrk_last(UBreakIterator *bi);+int32_t __hs_ubrk_next(UBreakIterator *bi);+int32_t __hs_ubrk_previous(UBreakIterator *bi);+int32_t __hs_ubrk_getRuleStatus(UBreakIterator *bi);+int32_t __hs_ubrk_getRuleStatusVec(UBreakIterator *bi, int32_t *fillInVec,+ int32_t capacity, UErrorCode *status);++/* ucol.h */++UCollator* __hs_ucol_open(const char *loc, UErrorCode *status);+void __hs_ucol_close(UCollator *coll);+void __hs_ucol_setAttribute(UCollator *coll, UColAttribute attr,+ UColAttributeValue value, UErrorCode *status);+UColAttributeValue __hs_ucol_getAttribute(const UCollator *coll,+ UColAttribute attr,+ UErrorCode *status);+UCollationResult __hs_ucol_strcoll(const UCollator *coll,+ const UChar *source, int32_t sourceLength,+ const UChar *target, int32_t targetLength);+UCollationResult __hs_ucol_strcollIter(const UCollator *coll,+ UCharIterator *sIter,+ UCharIterator *tIter,+ UErrorCode *status);+UCollator* __hs_ucol_safeClone(const UCollator *coll,+ void *stackBuffer,+ int32_t *pBufferSize,+ UErrorCode *status);+int32_t __hs_ucol_getSortKey(const UCollator *coll,+ const UChar *source, int32_t sourceLength,+ uint8_t *result, int32_t resultLength);+UBool __hs_ucol_equals(const UCollator *source, const UCollator *target);+ /* ucnv.h */ int __get_max_bytes_for_string(UConverter *cnv, int src_length);@@ -35,6 +81,11 @@ void __hs_ucnv_setFallback(UConverter *cnv, UBool usesFallback); UBool __hs_ucnv_isAmbiguous(const UConverter *cnv); +/* uiter.h */++void __hs_uiter_setString(UCharIterator *iter, const UChar *s, int32_t length);+void __hs_uiter_setUTF8(UCharIterator *iter, const char *s, int32_t length);+ /* unorm.h */ int32_t __hs_unorm_compare(const UChar *s1, int32_t length1,@@ -52,3 +103,16 @@ UNormalizationMode mode, int32_t options, UChar *result, int32_t resultLength, UErrorCode *status);++/* ustring.h */++int32_t __hs_u_strFoldCase(UChar *dest, int32_t destCapacity,+ const UChar *src, int32_t srcLength,+ uint32_t options, UErrorCode *pErrorCode);+int32_t __hs_u_strToUpper(UChar *dest, int32_t destCapacity,+ const UChar *src, int32_t srcLength,+ const char *locale, UErrorCode *pErrorCode);+int32_t __hs_u_strToLower(UChar *dest, int32_t destCapacity,+ const UChar *src, int32_t srcLength,+ const char *locale, UErrorCode *pErrorCode);+int32_t __hs_u_strCompareIter(UCharIterator *iter1, UCharIterator *iter2);
text-icu.cabal view
@@ -1,5 +1,5 @@ name: text-icu-version: 0.3.0.0+version: 0.4.0.0 synopsis: Bindings to the ICU library description: Haskell bindings to the International Components for Unicode (ICU) libraries. These libraries provide@@ -11,7 +11,7 @@ license: BSD3 license-file: LICENSE build-type: Simple-cabal-version: >= 1.2+cabal-version: >= 1.6 extra-source-files: README include/hs_text_icu.h @@ -21,13 +21,21 @@ build-depends: base >= 4 exposed-modules:+ Data.Text.ICU+ Data.Text.ICU.Collate Data.Text.ICU.Convert Data.Text.ICU.Error Data.Text.ICU.Normalize+ Data.Text.ICU.Types other-modules:+ Data.Text.ICU.Break+ Data.Text.ICU.Collate.Internal+ Data.Text.ICU.Collate.Pure Data.Text.ICU.Convert.Internal Data.Text.ICU.Error.Internal Data.Text.ICU.Internal+ Data.Text.ICU.Iterator+ Data.Text.ICU.Text c-sources: cbits/text_icu.c include-dirs: include extra-libraries: icuuc@@ -39,3 +47,7 @@ ghc-options: -Wall if impl(ghc >= 6.8) ghc-options: -fwarn-tabs++source-repository head+ type: darcs+ location: http://code.haskell.org/text-icu/