charset 0.0 → 0.1

raw patch · 5 files changed

+521/−461 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/CharSet.hs +219/−458
• Data/CharSet/Common.hs +65/−0
• Data/CharSet/Posix/Ascii.hs +54/−0
• Data/CharSet/Unicode.hs +177/−0
• charset.cabal +6/−3

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, CPP #-}+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.CharSet@@ -6,532 +6,240 @@ -- License     :  BSD3 -- Maintainer  :  ekmett@gmail.com -- Stability   :  experimental--- Portability :  portable+-- Portability :  portable (CPP) ----- Encode unicode character sets as arbitrary precision floating point values--- using the least character in the set as the exponent. Can efficiently represent--- reasonably tightly grouped character sets, but may use up to 139KiB to represent--- a particularly sparse set.--- +-- Fast complementable character sets+-- -- Designed to be imported qualified: --  -- > import Data.CharSet (CharSet) -- > import qualified Data.CharSet as CharSet ------------------------------------------------------------------------------- -module Data.CharSet+module Data.CharSet      ( -    -- * CharSet+    -- * Set type       CharSet+    -- * Operators+    , (\\)+    -- * Query+    , null+    , size+    , member+    , notMember+    , overlaps, isSubsetOf+    , isComplemented +    -- * Construction     , build-    -- * Manipulation     , empty     , singleton     , full-    , union-    , intersection-    , complement     , insert     , delete-    , (\\)+    , complement+    , range+    -- * Combine+    , union+    , intersection+    , difference+    -- * Filter+    , filter+    , partition+    -- * Map+    , map+    -- * Fold+    , fold+    -- * Conversion+    -- ** List+    , toList     , fromList+    -- ** Ordered list+    , toAscList+    , fromAscList     , fromDistinctAscList+    -- ** IntMaps+    , fromCharSet+    , toCharSet+    -- ** Array     , toArray-    -- * Accessors-    , null-    , size-    , member-    , elem-    , notElem-    , isComplemented-    , toInteger-    -- * Builtins-    -- ** POSIX-    , posixAscii-    -- ** Unicode-    , UnicodeCategory(..)-    , unicodeCategories-    -- ** Data.Char classifiers-    , control, space, lower, upper, alpha, alphaNum-    , print, digit, octDigit, letter, mark, number-    , punctuation, symbol, separator, ascii, latin1, asciiUpper, asciiLower     ) where -import Data.Array hiding (range)-import qualified Data.Bits as Bits-import Data.Bits hiding (complement)-import Data.Char+import Data.Array.Unboxed hiding (range) import Data.Data import Data.Function (on)-import Data.Map (Map)-import qualified Data.Map as Map+import Data.IntSet (IntSet) import Data.Monoid (Monoid(..))-import Prelude hiding (null, exponent, toInteger, elem, notElem, print, pi)+import qualified Data.IntSet as I+import qualified Data.List as L+import Prelude hiding (filter, map, null)+import qualified Prelude as P import Text.Read -data CharSet = CS-        { _countAtLeast  :: {-# UNPACK #-} !Int       -- ^ A conservative upper bound on the element count.-                                                      --   If negative, we are complemented with respect to the universe-        , _countAtMost   :: {-# UNPACK #-} !Int       -- ^ A conservative lower bound on the element count.-                                                      --   If negative, we are complemented with respect to the universe-        , _count         :: Int                       -- ^ Lazy element count used when the above two disagree. O(1) environment size-        , exponent       :: {-# UNPACK #-} !Int       -- ^ Low water mark. index of the least element potentially in the set.-        , _hwm           :: {-# UNPACK #-} !Int       -- ^ High water mark. index of the greatest element potentially in the set.-        , mantissa       :: {-# UNPACK #-} !Integer   -- ^ the set of bits starting from the exponent.-                                                      --   if negative, then we are complemented with respect to universe-        }+data CharSet = P IntSet | N IntSet +(\\) :: CharSet -> CharSet -> CharSet+(\\) = difference -ul, uh :: Char-ul = minBound-uh = maxBound-{-# INLINE ul #-}-{-# INLINE uh #-}+build :: (Char -> Bool) -> CharSet+build p = fromDistinctAscList $ P.filter p [minBound .. maxBound]+{-# INLINE build #-} -ol, oh :: Int-ol = fromEnum ul-oh = fromEnum uh-{-# INLINE ol #-}-{-# INLINE oh #-}+map :: (Char -> Char) -> CharSet -> CharSet+map f (P i) = P (I.map (fromEnum . f . toEnum) i)+map f (N i) = fromList $ P.map f $ P.filter (\x -> fromEnum x `I.notMember` i) [ul..uh] +{-# INLINE map #-} --- | Internal smart constructor. Forces count whenever it is pigeonholed.-bs :: Int -> Int -> Int -> Int -> Int -> Integer -> CharSet-bs !a !b c !l !h !m | a == b = CS a a a l h m -                    | otherwise = CS a b c l h m -{-# INLINE bs #-}+isComplemented :: CharSet -> Bool+isComplemented (P _) = False+isComplemented (N _) = True+{-# INLINE isComplemented #-} --- | /O(d)/ where /d/ is absolute deviation in fromEnum over the set toList :: CharSet -> String-toList (CS _ _ _ l h m) -    | m < 0 = map toEnum [ol..max (pred l) ol] ++ toList' l (map toEnum [min (succ h) oh..oh])-    | otherwise = toList' 0 []-    where-        toList' :: Int -> String -> String-        toList' !n t | n > h = t-                     | testBit m (n - l) = toEnum n : toList' (n+1) t-                     | otherwise         = toList' (n+1) t+toList (P i) = P.map toEnum (I.toList i)+toList (N i) = P.filter (\x -> fromEnum x `I.notMember` i) [ul..uh] {-# INLINE toList #-} --- | /O(1)/ The empty set. Permits /O(1)/ null and size.+toAscList :: CharSet -> String+toAscList (P i) = P.map toEnum (I.toAscList i)+toAscList (N i) = P.filter (\x -> fromEnum x `I.notMember` i) [ul..uh]+{-# INLINE toAscList #-}+     empty :: CharSet-empty = CS 0 0 0 0 0 0 +empty = P I.empty {-# INLINE empty #-} --- | /O(1)/ Construct a @CharSet@ with a single element. Permits /O(1)/ null and size-singleton :: Char -> CharSet -singleton x = CS 1 1 1 e e 1 where e = fromEnum x+singleton :: Char -> CharSet+singleton = P . I.singleton . fromEnum {-# INLINE singleton #-} --- | /O(1|d)/ Is the 'CharSet' empty? May be faster than checking if @'size' == 0@ after union.---   Operations that require a recount are noted.+full :: CharSet+full = N I.empty+{-# INLINE full #-}+ null :: CharSet -> Bool-null (CS a b c _ _ _) -    | a > 0 = False-    | b == 0 = True-    | otherwise = c == 0 +null (P i) = I.null i+null (N i) = I.size i == numChars -- badly normalized! {-# INLINE null #-} --- | /O(1|d)/ The number of elements in the bit set. size :: CharSet -> Int-size (CS a b c _ _ m)-    | (a == b) && (m >= 0) = a-    | a == b = oh - ol - a -    | m >= 0 = c-    | otherwise = oh - ol - c +size (P i) = I.size i+size (N i) = numChars - I.size i {-# INLINE size #-} --- | /O(d)/ A 'CharSet' containing every member of the enumeration of @a@.-full :: CharSet-full = complement empty -{-# INLINE full #-}---- | /O(d)/ Complements a 'CharSet' with respect to the bounds of @a@. Preserves order of 'null' and 'size'-complement :: CharSet -> CharSet -complement (CS a b c l h m) = CS (Bits.complement b) (Bits.complement a) (Bits.complement c) l h (Bits.complement m)-{-# INLINE complement #-}---- | /O(d * n)/ Make a 'CharSet' from a list of items.-fromList :: String -> CharSet-fromList = foldr insert empty -{-# INLINE fromList #-}---- | /O(d * n)/ Make a 'CharSet' from a distinct ascending list of items-fromDistinctAscList :: String -> CharSet -fromDistinctAscList [] = empty-fromDistinctAscList (c:cs) = fromDistinctAscList' cs 1 0 1 -    where-        l = fromEnum c-        fromDistinctAscList' :: String -> Int -> Int -> Integer -> CharSet-        fromDistinctAscList' [] !n !h !m  = CS n n n l h m -        fromDistinctAscList' (c':cs') !n _ !m = fromDistinctAscList' cs' (n+1) h' (setBit m (h' - l))-            where-                h' = fromEnum c'-{-# INLINE fromDistinctAscList #-}---- | /O(d)/ Insert a single element of type @a@ into the 'CharSet'. Preserves order of 'null' and 'size' insert :: Char -> CharSet -> CharSet-insert x r@(CS a b c l h m) -    | (m < 0) && (e < l) = r -    | (m < 0) && (e > h) = r-    | e < l = bs (a+1) (b+1) (c+1) e h (shiftL m (l - e) .|. 1)-    | e > h = bs (a+1) (b+1) (c+1) l p (setBit m p)-    | testBit m p = r -    | otherwise = bs (a+1) (b+1) (c+1) l h (setBit m p)-    where -        e = fromEnum x-        p = e - l +insert c (P i) = P (I.insert (fromEnum c) i)+insert c (N i) = P (I.delete (fromEnum c) i) {-# INLINE insert #-} --- | /O(d)/ Delete a single item from the 'CharSet'. Preserves order of 'null' and 'size'+range :: Char -> Char -> CharSet+range a b +    | a <= b = fromDistinctAscList [a..b]+    | otherwise = empty+ delete :: Char -> CharSet -> CharSet-delete x r@(CS a b c l h m) -    | (m < 0) && (e < l) = bs (a+1) (b+1) (c+1) e h (shiftL m (l - e) .&. Bits.complement 1)-    | (m < 0) && (e > h) = bs (a+1) (b+1) (c+1) l p (clearBit m p)-    | e < l       = r-    | e > h       = r-    | testBit m p = bs (a-1) (b-1) (c-1) l h (clearBit m p)-    | otherwise   = r-    where -        e = fromEnum x-        p = e - l+delete c (P i) = P (I.delete (fromEnum c) i)+delete c (N i) = N (I.insert (fromEnum c) i) {-# INLINE delete #-} --- | /O(1)/ Test for membership in a 'CharSet'-member :: Char -> CharSet -> Bool-member x (CS _ _ _ l h m) -    | e < l     = m < 0 -    | e > h     = m > 0-    | otherwise = testBit m (e - l)-    where -        e = fromEnum x-{-# INLINE member #-}--{--notMember :: Char -> CharSet -> Bool-notMember x - not . member x-{-# INLINE notMember #-}--}---- | /O(1)/ Alias for member-elem :: Char -> CharSet -> Bool-elem = member-{-# INLINE elem #-}---- | /O(1)/ Alias for notMember-notElem :: Char -> CharSet -> Bool-notElem x = not . elem x-{-# INLINE notElem #-}---- | /O(d)/ convert to an Integer representation. Discards negative elements-toInteger :: CharSet -> Integer-toInteger x = mantissa x `shift` exponent x-{-# INLINE toInteger #-}+complement :: CharSet -> CharSet+complement (P i) = N i+complement (N i) = P i+{-# INLINE complement #-} --- | /O(d)/. May force 'size' to take /O(d)/ if ranges overlap, preserves order of 'null'-union :: CharSet -> CharSet -> CharSet -union x@(CS _ _ _ l _ _) y@(CS _ _ _ l' _ _)-    | l' < l        = union' y x -- ensure left side has lower exponent-    | otherwise     = union' x y +union :: CharSet -> CharSet -> CharSet+union (P i) (P j) = P (I.union i j)+union (P i) (N j) = N (I.difference j i)+union (N i) (P j) = N (I.difference i j)+union (N i) (N j) = N (I.intersection i j) {-# INLINE union #-} -union' :: CharSet -> CharSet -> CharSet -union' x@(CS a b c l h m) y@(CS a' b' c' l' h' m')-    | b == 0        = y                                                         -- fast empty union-    | b' == 0       = x                                                         -- fast empty union-    | a == -1       = full                                                      -- fast full union-    | a' == -1      = full                                                      -- fast full union-    | (m < 0) && (m' < 0) = complement (intersection' (complement x) (complement y))  -- appeal to intersection-    | m' < 0        = complement (diff (complement y) x)                        -- union with complement-    | m < 0         = complement (diff (complement x) y)                        -- union with complement-    | h < l'        = bs (a + a') (b + b') (c + c') l h' m''                    -- disjoint positive ranges-    | otherwise     = bs (a `max` a') (b + b') (recount m'') l (h `max` h') m'' -- overlapped positives-    where -        m'' = m .|. shiftL m' (l' - l)---- | /O(1)/ check to see if we are represented as a complemented 'CharSet'. -isComplemented :: CharSet -> Bool-isComplemented = (<0) . mantissa -{-# INLINE isComplemented #-}---- | /O(d)/. May force 'size' and 'null' both to take /O(d)/.-intersection :: CharSet -> CharSet -> CharSet -intersection x@(CS _ _ _ l _ _) y@(CS _ _ _ l' _ _)-    | l' < l = intersection' y x-    | otherwise = intersection' x y+intersection :: CharSet -> CharSet -> CharSet+intersection (P i) (P j) = P (I.intersection i j)+intersection (P i) (N j) = P (I.difference i j)+intersection (N i) (P j) = P (I.difference j i)+intersection (N i) (N j) = N (I.union i j) {-# INLINE intersection #-} --- | /O(d)/. May force 'size' and 'null' both to take /O(d)/.-intersection' :: CharSet -> CharSet -> CharSet -intersection' x@(CS a b _ l h m) y@(CS a' b' _ l' h' m')-    | b == 0  = empty-    | b' == 0 = empty-    | a == -1 = y-    | a' == -1 = x-    | (m < 0) && (m' < 0) = complement (union' (complement x) (complement y))-    | m' < 0 = diff x (complement y) -    | m < 0  = diff y (complement x) -    | h < l' = empty -    | otherwise = bs 0 (b `min` b') (recount m'') l'' (h `min` h') m''-    where-        l'' = max l l'-        m'' = shift m (l'' - l) .&. shift m' (l'' - l')---- | Unsafe internal method for computing differences --- preconditions:---  m >= 0, m' >= 0, a /= -1, a' /= -1, b /= 0, b' /= 0-diff :: CharSet -> CharSet -> CharSet -diff x@(CS a _ _ l h m) (CS _ b' _ l' h' m') -    | h < l' = x-    | h' < l = x-    | otherwise = bs (max (a - b') 0) a (recount m'') l h m''-    where -        m'' = m .&. shift (Bits.complement m') (l' - l)---- | /O(d)/. Preserves order of 'null'. May force /O(d)/ 'size'. difference :: CharSet -> CharSet -> CharSet -difference x@(CS a b _ _ _ m)  y@(CS a' b' _ _ _ m') -   | a == -1       = complement y-   | a' == -1      = empty-   | b == 0        = empty-   | b' == 0       = x-   | (m < 0) && (m' < 0) = diff (complement y) (complement x)-   | m < 0         = complement (complement x `union` y)-   | m' < 0        = x `union` complement y -   | otherwise     = diff x y-    --- | /O(d)/. Preserves order of 'null'. May force /O(d)/ 'size'.-(\\) :: CharSet -> CharSet -> CharSet -(\\) = difference--instance Eq CharSet where-    x@(CS _ _ _ l _ m) == y@(CS _ _ _ l' _ m')-        | signum m == signum m' = shift m (l - l'') == shift m' (l - l'') -        | m' < 0 = y == x-        | otherwise = mask .&. shift m (l - ol) == shift m' (l - ol)-        where -            l'' = min l l'-            mask = setBit 0 (oh - ol + 1) - 1+difference (P i) (P j) = P (I.difference i j)+difference (P i) (N j) = P (I.intersection i j)+difference (N i) (P j) = N (I.union i j)+difference (N i) (N j) = P (I.difference j i)+{-# INLINE difference #-} -instance Ord CharSet where-    compare = compare `on` toInteger+member :: Char -> CharSet -> Bool+member c (P i) = I.member (fromEnum c) i+member c (N i) = I.notMember (fromEnum c) i+{-# INLINE member #-} -instance Bounded CharSet where-    minBound = empty-    maxBound = CS n n n ol oh m-        where-            n = oh - ol + 1-            m = setBit 0 n - 1+notMember :: Char -> CharSet -> Bool+notMember c (P i) = I.notMember (fromEnum c) i+notMember c (N i) = I.member (fromEnum c) i+{-# INLINE notMember #-} --- | Return a charset based on a character range-range :: Char -> Char -> CharSet-range l h -    | l <= h    = CS n n n l' h' m-    | otherwise = empty-    where -        l' = fromEnum l-        h' = fromEnum h-        n = h' - l' + 1-        m = setBit 0 n - 1+fold :: (Char -> b -> b) -> b -> CharSet -> b+fold f z (P i) = I.fold (f . toEnum) z i+fold f z (N i) = foldr f z $ P.filter (\x -> fromEnum x `I.notMember` i) [ul..uh]+{-# INLINE fold #-} --- | /O(d)/-recount :: Integer -> Int-recount !n -    | n < 0     = Bits.complement (recount (Bits.complement n))-    | otherwise = recount' 0 0 -    where-        h = hwm n-        recount' !i !c-            | i > h = c-            | otherwise = recount' (i+1) (if testBit n i then c+1 else c)+filter :: (Char -> Bool) -> CharSet -> CharSet +filter p (P i) = P (I.filter (p . toEnum) i)+filter p (N i) = N $ foldr (I.insert) i $ P.filter (\x -> (x `I.notMember` i) && not (p (toEnum x))) [ol..oh]+{-# INLINE filter #-} --- | /O(d)/. Computes the equivalent of (truncate . logBase 2 . abs) extended with 0 at 0--- This could be computed faster by directly appealing to GMP, but that is tricky in GHC.-hwm :: Integer -> Int-hwm !n -    | n < 0 = hwm (-n)-    | n > 1 = scan p (2*p) -    | otherwise = 0-    where-        p = probe 1-        -- incrementally compute 2^(2^(i+1)) until it exceeds n-        probe :: Int -> Int-        probe !i-            | bit (2*i) > n = i-            | otherwise     = probe (2*i)+partition :: (Char -> Bool) -> CharSet -> (CharSet, CharSet)+partition p (P i) = (P l, P r)+    where (l,r) = I.partition (p . toEnum) i+partition p (N i) = (N (foldr I.insert i l), N (foldr I.insert i r))+    where (l,r) = L.partition (p . toEnum) $ P.filter (\x -> x `I.notMember` i) [ol..oh]+{-# INLINE partition #-} -        -- then binary search the powers for the highest set bit-        scan :: Int -> Int -> Int-        scan !l !h-            | l == h = l-            | bit (m+1) > n = scan l m-            | otherwise = scan (m+1) h-            where m = l + (h - l) `div` 2+overlaps :: CharSet -> CharSet -> Bool+overlaps (P i) (P j) = not (I.null (I.intersection i j))+overlaps (P i) (N j) = not (I.isSubsetOf j i)+overlaps (N i) (P j) = not (I.isSubsetOf i j)+overlaps (N i) (N j) = any (\x -> I.notMember x i && I.notMember x j) [ol..oh] -- not likely+{-# INLINE overlaps #-} -toArray :: CharSet -> Array Char Bool-toArray set = array (minBound, maxBound) $ fmap (\x -> (x, x `elem` set)) [minBound .. maxBound]- -instance Show CharSet where-   showsPrec d x@(CS _ _ _ _ _ m)-        | m < 0     = showParen (d > 10) $ showString "complement " . showsPrec 11 (complement x)-        | otherwise = showParen (d > 10) $ showString "fromDistinctAscList " . showsPrec 11 (toList x)+isSubsetOf :: CharSet -> CharSet -> Bool+isSubsetOf (P i) (P j) = I.isSubsetOf i j+isSubsetOf (P i) (N j) = I.null (I.intersection i j)+isSubsetOf (N i) (P j) = all (\x -> I.member x i && I.member x j) [ol..oh]-- not bloody likely+isSubsetOf (N i) (N j) = I.isSubsetOf j i+{-# INLINE isSubsetOf #-} +fromList :: String -> CharSet +fromList = P . I.fromList . P.map fromEnum+{-# INLINE fromList #-} -instance Read CharSet where-#ifdef __GLASGOW_HASKELL__ -    readPrec = parens $ complemented +++ normal -      where-        complemented = prec 10 $ do -                Ident "complement" <- lexP-                complement `fmap` step readPrec-        normal = prec 10 $ do-                Ident "fromDistinctAscList" <- lexP-                fromDistinctAscList `fmap` step readPrec-#else-    readsPrec d r = -        readParen (d > 10) (\r -> [ (complement m, t) -                                  | ("complement", s) <- lex r-                                  , (m, t) <- readsPrec 11 s]) r-     ++ readParen (d > 10) (\r -> [ (fromDistinctAscList m, t) -                                  | ("fromDistinctAscList", s) <- lex r-                                  , (m, t) <- readsPrec 11 s]) r-#endif+fromAscList :: String -> CharSet+fromAscList = P . I.fromAscList . P.map fromEnum+{-# INLINE fromAscList #-} -instance Monoid CharSet where-    mempty = empty-    mappend = union+fromDistinctAscList :: String -> CharSet+fromDistinctAscList = P . I.fromDistinctAscList . P.map fromEnum+{-# INLINE fromDistinctAscList #-} -build :: (Char -> Bool) -> CharSet-build p = fromDistinctAscList $ filter p [minBound .. maxBound]+-- isProperSubsetOf :: CharSet -> CharSet -> Bool+-- isProperSubsetOf (P i) (P j) = I.isProperSubsetOf i j+-- isProperSubsetOf (P i) (N j) = null (I.intersection i j) && ...+-- isProperSubsetOf (N i) (N j) = I.isProperSubsetOf j i --- :digit:, etc.-posixAscii :: Map String CharSet-posixAscii = Map.fromList-    [ ("alnum", alnum')-    , ("alpha", alpha')-    , ("blank", fromList " \t")-    , ("cntrl", insert '\x7f' $ range '\x00' '\x1f')-    , ("digit", digit')-    , ("graph", range '\x21' '\x7e')-    , ("print", range '\x20' '\x7e')-    , ("word",  insert '_' alnum')-    , ("punct", fromList "-!\"#$%&'()*+,./:;<=>?@[\\]^_`{|}~")-    , ("space", fromList " \t\r\n\v\f")-    , ("upper", upper')-    , ("lower", lower')-    , ("xdigit", digit `union` range 'a' 'f' `union` range 'A' 'F')-    ]-    where-        lower' = range 'a' 'z'-        upper' = range 'A' 'Z'-        alpha' = lower' `union` upper'-        digit' = range '0' '9'-        alnum' = alpha' `union` digit'+ul, uh :: Char+ul = minBound+uh = maxBound+{-# INLINE ul #-}+{-# INLINE uh #-} -data UnicodeCategory = UnicodeCategory String String CharSet String+ol, oh :: Int+ol = fromEnum ul+oh = fromEnum uh+{-# INLINE ol #-}+{-# INLINE oh #-} --- \p{Letter} or \p{Mc}-unicodeCategories :: [UnicodeCategory]-unicodeCategories =-    [ UnicodeCategory "Letter" "L" l "any kind of letter from any language."-    ,     UnicodeCategory "Lowercase_Letter" "Ll" ll "a lowercase letter that has an uppercase variant"-    ,     UnicodeCategory "Uppercase_Letter" "Lu" lu "an uppercase letter that has a lowercase variant"-    ,     UnicodeCategory "Titlecase_Letter" "Lt" lt "a letter that appears at the start of a word when only the first letter of the word is capitalized"-    ,     UnicodeCategory "Letter&" "L&" la "a letter that exists in lowercase and uppercase variants (combination of Ll, Lu and Lt)"-    ,     UnicodeCategory "Modifier_Letter" "Lm" lm "a special character that is used like a letter"-    ,     UnicodeCategory "Other_Letter" "Lo" lo "a letter or ideograph that does not have lowercase and uppercase variants"-    , UnicodeCategory "Mark" "M" m "a character intended to be combined with another character (e.g. accents, umlauts, enclosing boxes, etc.)"-    ,     UnicodeCategory "Non_Spacing_Mark" "Mn" mn "a character intended to be combined with another character without taking up extra space (e.g. accents, umlauts, etc.)"-    ,     UnicodeCategory "Spacing_Combining_Mark" "Mc" mc "a character intended to be combined with another character that takes up extra space (vowel signs in many Eastern languages)"-    ,     UnicodeCategory "Enclosing_Mark" "Me" me "a character that encloses the character is is combined with (circle, square, keycap, etc.)"-    , UnicodeCategory "Separator" "Z" z "any kind of whitespace or invisible separator"-    ,     UnicodeCategory "Space_Separator" "Zs" zs "a whitespace character that is invisible, but does take up space"-    ,     UnicodeCategory "Line_Separator" "Zl" zl "line separator character U+2028"-    ,     UnicodeCategory "Paragraph_Separator" "Zp" zp "paragraph separator character U+2029"-    , UnicodeCategory "Symbol" "S" s "math symbols, currency signs, dingbats, box-drawing characters, etc."-    ,     UnicodeCategory "Math_Symbol" "Sm" sm "any mathematical symbol"-    ,     UnicodeCategory "Currency_Symbol" "Sc" sc "any currency sign"-    ,     UnicodeCategory "Modifier_Symbol" "Sk" sk "a combining character (mark) as a full character on its own"-    ,     UnicodeCategory "Other_Symbol" "So" so "various symbols that are not math symbols, currency signs, or combining characters"-    , UnicodeCategory "Number" "N" n "any kind of numeric character in any script"-    ,     UnicodeCategory "Decimal_Digit_Number" "Nd" nd "a digit zero through nine in any script except ideographic scripts"-    ,     UnicodeCategory "Letter_Number" "Nl" nl "a number that looks like a letter, such as a Roman numeral"-    ,     UnicodeCategory "Other_Number" "No" no "a superscript or subscript digit, or a number that is not a digit 0..9 (excluding numbers from ideographic scripts)"-    , UnicodeCategory "Punctuation" "P" p "any kind of punctuation character"-    ,     UnicodeCategory "Dash_Punctuation" "Pd" pd "any kind of hyphen or dash"-    ,     UnicodeCategory "Open_Punctuation" "Ps" ps "any kind of opening bracket"-    ,     UnicodeCategory "Close_Punctuation" "Pe" pe "any kind of closing bracket"-    ,     UnicodeCategory "Initial_Punctuation" "Pi" pi "any kind of opening quote"-    ,     UnicodeCategory "Final_Punctuation" "Pf" pf "any kind of closing quote"-    ,     UnicodeCategory "Connector_Punctuation" "Pc" pc "a punctuation character such as an underscore that connects words"-    ,     UnicodeCategory "Other_Punctuation" "Po" po "any kind of punctuation character that is not a dash, bracket, quote or connector"-    , UnicodeCategory "Other" "C" c "invisible control characters and unused code points"-    ,     UnicodeCategory "Control" "Cc" cc "an ASCII 0x00..0x1F or Latin-1 0x80..0x9F control character"-    ,     UnicodeCategory "Format" "Cf" cf "invisible formatting indicator"-    ,     UnicodeCategory "Private_Use" "Co" co "any code point reserved for private use"-    ,     UnicodeCategory "Surrogate" "Cs" cs "one half of a surrogate pair in UTF-16 encoding"-    ,     UnicodeCategory "Unassigned" "Cn" cn "any code point to which no character has been assigned.properties" ]-    where-        cat category = build ((category ==) . generalCategory)-        ll = cat LowercaseLetter-        lu = cat UppercaseLetter-        lt = cat TitlecaseLetter-        la = ll `union` lu `union` lt-        lm = cat ModifierLetter-        lo = cat OtherLetter-        l = la `union` lm `union` lo-        mn = cat NonSpacingMark-        mc = cat SpacingCombiningMark-        me = cat EnclosingMark-        m = mn `union` mc `union` me-        zs = cat Space-        zl = cat LineSeparator-        zp = cat ParagraphSeparator-        z = zs `union` zl `union` zp-        sm = cat MathSymbol-        sc = cat CurrencySymbol-        sk = cat ModifierSymbol-        so = cat OtherSymbol-        s = sm `union` sc `union` sk `union` so-        nd = cat DecimalNumber-        nl = cat LetterNumber-        no = cat OtherNumber-        n = nd `union` nl `union` no-        pd = cat DashPunctuation-        ps = cat OpenPunctuation-        pe = cat ClosePunctuation-        pi = cat InitialQuote-        pf = cat FinalQuote-        pc = cat ConnectorPunctuation-        po = cat OtherPunctuation-        p = pd `union` ps `union` pe `union` pi `union` pf `union` pc `union` po-        cc = cat Control-        cf = cat Format-        co = cat PrivateUse-        cs = cat Surrogate-        cn = cat NotAssigned-        c = cc `union` cf `union` co `union` cs `union` cn-        --- Haskell character classes from Data.Char-control, space, lower, upper, alpha, alphaNum, print, digit, octDigit, letter, mark, number, punctuation, symbol, separator, ascii, latin1, asciiUpper, asciiLower :: CharSet-control = build isControl-space = build isSpace-lower = build isLower-upper = build isUpper-alpha = build isAlpha-alphaNum = build isAlphaNum-print = build isPrint-digit = build isDigit-octDigit = build isOctDigit-letter = build isLetter-mark = build isMark-number = build isNumber-punctuation = build isPunctuation-symbol = build isSymbol-separator = build isSeparator-ascii = build isAscii-latin1 = build isLatin1-asciiUpper = build isAsciiUpper-asciiLower = build isAsciiLower+numChars :: Int+numChars = oh - ol + 1+{-# INLINE numChars #-}  instance Typeable CharSet where     typeOf _ = mkTyConApp charSetTyCon []@@ -543,6 +251,7 @@ instance Data CharSet where     gfoldl k z set | isComplemented set = z complement `k` complement set                    | otherwise          = z fromList `k` toList set+     toConstr set          | isComplemented set = complementConstr         | otherwise = fromListConstr@@ -553,7 +262,7 @@         1 -> k (z fromList)         2 -> k (z complement)         _ -> error "gunfold"-        + fromListConstr :: Constr fromListConstr   = mkConstr charSetDataType "fromList" [] Prefix {-# NOINLINE fromListConstr #-}@@ -565,3 +274,55 @@ charSetDataType :: DataType charSetDataType  = mkDataType "Data.CharSet.CharSet" [fromListConstr, complementConstr] {-# NOINLINE charSetDataType #-}++-- returns an intset and if the intset should be complemented to obtain the contents of the CharSet+fromCharSet :: CharSet -> (Bool, IntSet)+fromCharSet (P i) = (False, i)+fromCharSet (N i) = (True, i) +{-# INLINE fromCharSet #-}++toCharSet :: IntSet -> CharSet+toCharSet = P+{-# INLINE toCharSet #-}++instance Eq CharSet where+    (==) = (==) `on` toAscList++instance Ord CharSet where+    compare = compare `on` toAscList++instance Bounded CharSet where+    minBound = empty+    maxBound = full++toArray :: CharSet -> UArray Char Bool+toArray set = array (minBound, maxBound) $ fmap (\x -> (x, x `member` set)) [minBound .. maxBound]+ +instance Show CharSet where+   showsPrec d i+        | isComplemented i = showParen (d > 10) $ showString "complement " . showsPrec 11 (complement i)+        | otherwise        = showParen (d > 10) $ showString "fromDistinctAscList " . showsPrec 11 (toAscList i)++instance Read CharSet where+#ifdef __GLASGOW_HASKELL__ +    readPrec = parens $ complemented +++ normal +      where+        complemented = prec 10 $ do +                Ident "complement" <- lexP+                complement `fmap` step readPrec+        normal = prec 10 $ do+                Ident "fromDistinctAscList" <- lexP+                fromDistinctAscList `fmap` step readPrec+#else+    readsPrec d r = +        readParen (d > 10) (\r -> [ (complement m, t) +                                  | ("complement", s) <- lex r+                                  , (m, t) <- readsPrec 11 s]) r+     ++ readParen (d > 10) (\r -> [ (fromDistinctAscList m, t) +                                  | ("fromDistinctAscList", s) <- lex r+                                  , (m, t) <- readsPrec 11 s]) r+#endif++instance Monoid CharSet where+    mempty = empty+    mappend = union

@@ -0,0 +1,65 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.CharSet.Common+-- Copyright   :  (c) Edward Kmett 2010+-- License     :  BSD3+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- The various character classifications from "Data.Char" as 'CharSet's+-------------------------------------------------------------------------------++module Data.CharSet.Common+    ( +    -- ** Data.Char classes+      control+    , space+    , lower+    , upper+    , alpha+    , alphaNum+    , print+    , digit+    , octDigit+    , letter+    , mark+    , number+    , punctuation+    , symbol+    , separator+    , ascii+    , latin1+    , asciiUpper+    , asciiLower+    ) where++import Prelude ()+import Data.Char+import Data.CharSet++-- Haskell character classes from Data.Char+control, space, lower, upper, alpha, alphaNum, +  print, digit, octDigit, letter, mark, number, +  punctuation, symbol, separator, ascii, latin1+  , asciiUpper, asciiLower :: CharSet++control = build isControl+space = build isSpace+lower = build isLower+upper = build isUpper+alpha = build isAlpha+alphaNum = build isAlphaNum+print = build isPrint+digit = build isDigit+octDigit = build isOctDigit+letter = build isLetter+mark = build isMark+number = build isNumber+punctuation = build isPunctuation+symbol = build isSymbol+separator = build isSeparator+ascii = build isAscii+latin1 = build isLatin1+asciiUpper = build isAsciiUpper+asciiLower = build isAsciiLower

@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.CharSet.Posix.Ascii+-- Copyright   :  (c) Edward Kmett 2010+-- License     :  BSD3+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-------------------------------------------------------------------------------++module Data.CharSet.Posix.Ascii+    ( posixAscii+    -- * POSIX ASCII \"classes\"+    , alnum, alpha, blank, cntrl, digit, graph, print, word, punct, space, upper, lower, xdigit+    ) where++import Prelude hiding (print)+import Data.CharSet+import Data.Map (Map)+import qualified Data.Map as Map++alnum, alpha, blank, cntrl, digit, graph, print, word, punct, space, upper, lower, xdigit :: CharSet+alnum = alpha `union` digit+alpha = lower `union` upper+blank = fromList " \t"+cntrl = insert '\x7f' $ range '\x00' '\x1f'+digit = range '0' '9'+lower = range 'a' 'z'+upper = range 'A' 'Z'+graph = range '\x21' '\x7e'+print = insert '\x20' graph+word  = insert '_' alnum+punct = fromList "-!\"#$%&'()*+,./:;<=>?@[\\]^_`{|}~"+space = fromList " \t\r\n\v\f"+xdigit = digit `union` range 'a' 'f' `union` range 'A' 'F'++-- :digit:, etc.+posixAscii :: Map String CharSet+posixAscii = Map.fromList+    [ ("alnum", alnum)+    , ("alpha", alpha)+    , ("blank", blank)+    , ("cntrl", cntrl)+    , ("digit", digit)+    , ("graph", graph) +    , ("print", print)+    , ("word",  word)+    , ("punct", punct)+    , ("space", space)+    , ("upper", upper)+    , ("lower", lower)+    , ("xdigit", xdigit)+    ]

@@ -0,0 +1,177 @@+{-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.CharSet.Unicode+-- Copyright   :  (c) Edward Kmett 2010+-- License     :  BSD3+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Provides unicode general categories, which are typically connoted by +-- @\p{Ll}@ or @\p{Modifier_Letter}@. Lookups can be constructed using 'categories'+-- or individual character sets can be used directly.+-------------------------------------------------------------------------------++module Data.CharSet.Unicode+    ( +    -- * Unicode General Category+      UnicodeCategory(..)+    -- * Lookup+    , unicodeCategories+    -- * CharSets by UnicodeCategory+    -- ** Letter+    , modifierLetter, otherLetter, letter+    -- *** Letter\&+    , lowercaseLetter, uppercaseLetter, titlecaseLetter, letterAnd+    -- ** Mark+    , nonSpacingMark, spacingCombiningMark, enclosingMark, mark+    -- ** Separator+    , space, lineSeparator, paragraphSeparator, separator+    -- ** Symbol+    , mathSymbol, currencySymbol, modifierSymbol, otherSymbol, symbol+    -- ** Number+    , decimalNumber, letterNumber, otherNumber, number+    -- ** Punctuation+    , dashPunctuation, openPunctuation, closePunctuation, initialQuote+    , finalQuote, connectorPunctuation, otherPunctuation, punctuation +    -- ** Other+    , control, format, privateUse, surrogate, notAssigned, other+    ) where++import Data.Char+import Data.CharSet+import Data.Data++data UnicodeCategory = UnicodeCategory String String CharSet String+    deriving (Show, Data, Typeable)++-- \p{Letter} or \p{Mc}+unicodeCategories :: [UnicodeCategory]+unicodeCategories =+    [ UnicodeCategory "Letter" "L" letter "any kind of letter from any language."+    ,     UnicodeCategory "Lowercase_Letter" "Ll" lowercaseLetter "a lowercase letter that has an uppercase variant"+    ,     UnicodeCategory "Uppercase_Letter" "Lu" uppercaseLetter "an uppercase letter that has a lowercase variant"+    ,     UnicodeCategory "Titlecase_Letter" "Lt" titlecaseLetter "a letter that appears at the start of a word when only the first letter of the word is capitalized"+    ,     UnicodeCategory "Letter&" "L&" letterAnd "a letter that exists in lowercase and uppercase variants (combination of Ll, Lu and Lt)"+    ,     UnicodeCategory "Modifier_Letter" "Lm" modifierLetter "a special character that is used like a letter"+    ,     UnicodeCategory "Other_Letter" "Lo" otherLetter "a letter or ideograph that does not have lowercase and uppercase variants"+    , UnicodeCategory "Mark" "M" mark "a character intended to be combined with another character (e.g. accents, umlauts, enclosing boxes, etc.)"+    ,     UnicodeCategory "Non_Spacing_Mark" "Mn" nonSpacingMark "a character intended to be combined with another character without taking up extra space (e.g. accents, umlauts, etc.)"+    ,     UnicodeCategory "Spacing_Combining_Mark" "Mc" spacingCombiningMark "a character intended to be combined with another character that takes up extra space (vowel signs in many Eastern languages)"+    ,     UnicodeCategory "Enclosing_Mark" "Me" enclosingMark "a character that encloses the character is is combined with (circle, square, keycap, etc.)"+    , UnicodeCategory "Separator" "Z" separator "any kind of whitespace or invisible separator"+    ,     UnicodeCategory "Space_Separator" "Zs" space "a whitespace character that is invisible, but does take up space"+    ,     UnicodeCategory "Line_Separator" "Zl" lineSeparator "line separator character U+2028"+    ,     UnicodeCategory "Paragraph_Separator" "Zp" paragraphSeparator "paragraph separator character U+2029"+    , UnicodeCategory "Symbol" "S" symbol "math symbols, currency signs, dingbats, box-drawing characters, etc."+    ,     UnicodeCategory "Math_Symbol" "Sm" mathSymbol "any mathematical symbol"+    ,     UnicodeCategory "Currency_Symbol" "Sc" currencySymbol "any currency sign"+    ,     UnicodeCategory "Modifier_Symbol" "Sk" modifierSymbol "a combining character (mark) as a full character on its own"+    ,     UnicodeCategory "Other_Symbol" "So" otherSymbol "various symbols that are not math symbols, currency signs, or combining characters"+    , UnicodeCategory "Number" "N" number "any kind of numeric character in any script"+    ,     UnicodeCategory "Decimal_Digit_Number" "Nd" decimalNumber "a digit zero through nine in any script except ideographic scripts"+    ,     UnicodeCategory "Letter_Number" "Nl" letterNumber "a number that looks like a letter, such as a Roman numeral"+    ,     UnicodeCategory "Other_Number" "No" otherNumber "a superscript or subscript digit, or a number that is not a digit 0..9 (excluding numbers from ideographic scripts)"+    , UnicodeCategory "Punctuation" "P" punctuation "any kind of punctuation character"+    ,     UnicodeCategory "Dash_Punctuation" "Pd" dashPunctuation "any kind of hyphen or dash"+    ,     UnicodeCategory "Open_Punctuation" "Ps" openPunctuation "any kind of opening bracket"+    ,     UnicodeCategory "Close_Punctuation" "Pe" closePunctuation "any kind of closing bracket"+    ,     UnicodeCategory "Initial_Punctuation" "Pi" initialQuote "any kind of opening quote"+    ,     UnicodeCategory "Final_Punctuation" "Pf" finalQuote "any kind of closing quote"+    ,     UnicodeCategory "Connector_Punctuation" "Pc" connectorPunctuation "a punctuation character such as an underscore that connects words"+    ,     UnicodeCategory "Other_Punctuation" "Po" otherPunctuation "any kind of punctuation character that is not a dash, bracket, quote or connector"+    , UnicodeCategory "Other" "C" other "invisible control characters and unused code points"+    ,     UnicodeCategory "Control" "Cc" control "an ASCII 0x00..0x1F or Latin-1 0x80..0x9F control character"+    ,     UnicodeCategory "Format" "Cf" format "invisible formatting indicator"+    ,     UnicodeCategory "Private_Use" "Co" privateUse "any code point reserved for private use"+    ,     UnicodeCategory "Surrogate" "Cs" surrogate "one half of a surrogate pair in UTF-16 encoding"+    ,     UnicodeCategory "Unassigned" "Cn" notAssigned "any code point to which no character has been assigned.properties" ]++cat :: GeneralCategory -> CharSet+cat category = build ((category ==) . generalCategory)++-- Letter+lowercaseLetter, uppercaseLetter, titlecaseLetter, letterAnd, modifierLetter, otherLetter, letter :: CharSet+lowercaseLetter = cat LowercaseLetter+uppercaseLetter = cat UppercaseLetter+titlecaseLetter = cat TitlecaseLetter+letterAnd = lowercaseLetter +    `union` uppercaseLetter +    `union` titlecaseLetter+modifierLetter  = cat ModifierLetter+otherLetter = cat OtherLetter+letter +          = letterAnd +    `union` modifierLetter +    `union` otherLetter++-- Marks+nonSpacingMark, spacingCombiningMark, enclosingMark, mark :: CharSet+nonSpacingMark = cat NonSpacingMark+spacingCombiningMark = cat SpacingCombiningMark+enclosingMark = cat EnclosingMark+mark +          = nonSpacingMark +    `union` spacingCombiningMark +    `union` enclosingMark++space, lineSeparator, paragraphSeparator, separator :: CharSet+space = cat Space+lineSeparator = cat LineSeparator+paragraphSeparator = cat ParagraphSeparator+separator +          = space +    `union` lineSeparator +    `union` paragraphSeparator++mathSymbol, currencySymbol, modifierSymbol, otherSymbol, symbol :: CharSet+mathSymbol = cat MathSymbol+currencySymbol = cat CurrencySymbol+modifierSymbol = cat ModifierSymbol+otherSymbol = cat OtherSymbol+symbol +          = mathSymbol +    `union` currencySymbol +    `union` modifierSymbol +    `union` otherSymbol++decimalNumber, letterNumber, otherNumber, number :: CharSet+decimalNumber = cat DecimalNumber+letterNumber = cat LetterNumber+otherNumber = cat OtherNumber+number +          = decimalNumber +    `union` letterNumber +    `union` otherNumber++dashPunctuation, openPunctuation, closePunctuation, initialQuote, +  finalQuote, connectorPunctuation, otherPunctuation, punctuation :: CharSet++dashPunctuation = cat DashPunctuation+openPunctuation = cat OpenPunctuation+closePunctuation = cat ClosePunctuation+initialQuote = cat InitialQuote+finalQuote = cat FinalQuote+connectorPunctuation  = cat ConnectorPunctuation+otherPunctuation = cat OtherPunctuation+punctuation +          = dashPunctuation +    `union` openPunctuation +    `union` closePunctuation +    `union` initialQuote +    `union` finalQuote +    `union` connectorPunctuation +    `union` otherPunctuation++control, format, privateUse, surrogate, notAssigned, other :: CharSet+control = cat Control+format = cat Format+privateUse = cat PrivateUse+surrogate = cat Surrogate+notAssigned = cat NotAssigned+other = control +    `union` format +    `union` privateUse +    `union` surrogate +    `union` notAssigned

@@ -1,5 +1,5 @@ name:         charset-version:      0.0+version:      0.1 license:      BSD3 license-File: LICENSE copyright:    (c) Edward Kmett 2010@@ -8,8 +8,8 @@ stability:    Experimental category:     Data homepage:     http://github.com/ekmett/charset-synopsis:     Fast unicode character sets-description:  Fast unicode character sets+synopsis:     Fast unicode character sets based on complemented PATRICIA tries+description:  Fast unicode character sets based on complemented PATRICIA tries  build-type:   Simple build-depends:       @@ -19,5 +19,8 @@  exposed-modules:     Data.CharSet+    Data.CharSet.Common+    Data.CharSet.Posix.Ascii+    Data.CharSet.Unicode  GHC-Options: -Wall -fspec-constr -fdicts-cheap -O2