packages feed

text 1.2.4.0 → 1.2.4.1

raw patch · 101 files changed

+12094/−12013 lines, 101 filesdep +ghc-bignumdep −HUnitdep −QuickCheckdep −directorydep ~arraydep ~basedep ~binary

Dependencies added: ghc-bignum

Dependencies removed: HUnit, QuickCheck, directory, quickcheck-unicode, random, test-framework, test-framework-hunit, test-framework-quickcheck2

Dependency ranges changed: array, base, binary, bytestring, bytestring-builder, deepseq, ghc-prim, integer-gmp, template-haskell

Files

− Data/Text.hs 
@@ -1,1887 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples, TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--- Using TemplateHaskell in text unconditionally is unacceptable, as--- it's a GHC boot library. TemplateHaskellQuotes was added in 8.0, so--- this would seem to be a problem. However, GHC's policy of only--- needing to be able to compile itself from the last few releases--- allows us to use full-fat TH on older versions, while using THQ for--- GHC versions that may be used for bootstrapping.-#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE TemplateHaskellQuotes #-}-#else-{-# LANGUAGE TemplateHaskell #-}-#endif---- |--- Module      : Data.Text--- Copyright   : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,---               (c) 2009 Duncan Coutts,---               (c) 2008, 2009 Tom Harper------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : GHC------ A time and space-efficient implementation of Unicode text.--- Suitable for performance critical use, both in terms of large data--- quantities and high speed.------ /Note/: Read below the synopsis for important notes on the use of--- this module.------ This module is intended to be imported @qualified@, to avoid name--- clashes with "Prelude" functions, e.g.------ > import qualified Data.Text as T------ To use an extended and very rich family of functions for working--- with Unicode text (including normalization, regular expressions,--- non-standard encodings, text breaking, and locales), see the--- <http://hackage.haskell.org/package/text-icu text-icu package >.-----module Data.Text-    (-    -- * Strict vs lazy types-    -- $strict--    -- * Acceptable data-    -- $replacement--    -- * Definition of character-    -- $character_definition--    -- * Fusion-    -- $fusion--    -- * Types-      Text--    -- * Creation and elimination-    , pack-    , unpack-    , singleton-    , empty--    -- * Basic interface-    , cons-    , snoc-    , append-    , uncons-    , unsnoc-    , head-    , last-    , tail-    , init-    , null-    , length-    , compareLength--    -- * Transformations-    , map-    , intercalate-    , intersperse-    , transpose-    , reverse-    , replace--    -- ** Case conversion-    -- $case-    , toCaseFold-    , toLower-    , toUpper-    , toTitle--    -- ** Justification-    , justifyLeft-    , justifyRight-    , center--    -- * Folds-    , foldl-    , foldl'-    , foldl1-    , foldl1'-    , foldr-    , foldr1--    -- ** Special folds-    , concat-    , concatMap-    , any-    , all-    , maximum-    , minimum--    -- * Construction--    -- ** Scans-    , scanl-    , scanl1-    , scanr-    , scanr1--    -- ** Accumulating maps-    , mapAccumL-    , mapAccumR--    -- ** Generation and unfolding-    , replicate-    , unfoldr-    , unfoldrN--    -- * Substrings--    -- ** Breaking strings-    , take-    , takeEnd-    , drop-    , dropEnd-    , takeWhile-    , takeWhileEnd-    , dropWhile-    , dropWhileEnd-    , dropAround-    , strip-    , stripStart-    , stripEnd-    , splitAt-    , breakOn-    , breakOnEnd-    , break-    , span-    , group-    , groupBy-    , inits-    , tails--    -- ** Breaking into many substrings-    -- $split-    , splitOn-    , split-    , chunksOf--    -- ** Breaking into lines and words-    , lines-    --, lines'-    , words-    , unlines-    , unwords--    -- * Predicates-    , isPrefixOf-    , isSuffixOf-    , isInfixOf--    -- ** View patterns-    , stripPrefix-    , stripSuffix-    , commonPrefixes--    -- * Searching-    , filter-    , breakOnAll-    , find-    , partition--    -- , findSubstring--    -- * Indexing-    -- $index-    , index-    , findIndex-    , count--    -- * Zipping-    , zip-    , zipWith--    -- -* Ordered text-    -- , sort--    -- * Low level operations-    , copy-    , unpackCString#-    ) where--import Prelude (Char, Bool(..), Int, Maybe(..), String,-                Eq(..), Ord(..), Ordering(..), (++),-                Read(..),-                (&&), (||), (+), (-), (.), ($), ($!), (>>),-                not, return, otherwise, quot)-import Control.DeepSeq (NFData(rnf))-#if defined(ASSERTS)-import Control.Exception (assert)-#endif-import Data.Char (isSpace)-import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,-                  Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))-import Control.Monad (foldM)-import Control.Monad.ST (ST)-import qualified Data.Text.Array as A-import qualified Data.List as L-import Data.Binary (Binary(get, put))-import Data.Monoid (Monoid(..))-#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup(..))-#endif-import Data.String (IsString(..))-import qualified Data.Text.Internal.Fusion as S-import qualified Data.Text.Internal.Fusion.Common as S-import Data.Text.Encoding (decodeUtf8', encodeUtf8)-import Data.Text.Internal.Fusion (stream, reverseStream, unstream)-import Data.Text.Internal.Private (span_)-import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)-import Data.Text.Show (singleton, unpack, unpackCString#)-import qualified Prelude as P-import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,-                         reverseIter_, unsafeHead, unsafeTail)-import Data.Text.Internal.Unsafe.Char (unsafeChr)-import qualified Data.Text.Internal.Functions as F-import qualified Data.Text.Internal.Encoding.Utf16 as U16-import Data.Text.Internal.Search (indices)-import Data.Text.Internal.Unsafe.Shift (UnsafeShift(..))-#if defined(__HADDOCK__)-import Data.ByteString (ByteString)-import qualified Data.Text.Lazy as L-import Data.Int (Int64)-#endif-import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)-#if MIN_VERSION_base(4,7,0)-import qualified GHC.Exts as Exts-#endif-import qualified Language.Haskell.TH.Lib as TH-import Language.Haskell.TH.Syntax (Lift, lift)-#if MIN_VERSION_base(4,7,0)-import Text.Printf (PrintfArg, formatArg, formatString)-#endif---- $character_definition------ This package uses the term /character/ to denote Unicode /code points/.------ Note that this is not the same thing as a grapheme (e.g. a--- composition of code points that form one visual symbol). For--- instance, consider the grapheme \"&#x00e4;\". This symbol has two--- Unicode representations: a single code-point representation--- @U+00E4@ (the @LATIN SMALL LETTER A WITH DIAERESIS@ code point),--- and a two code point representation @U+0061@ (the \"@A@\" code--- point) and @U+0308@ (the @COMBINING DIAERESIS@ code point).---- $strict------ This package provides both strict and lazy 'Text' types.  The--- strict type is provided by the "Data.Text" module, while the lazy--- type is provided by the "Data.Text.Lazy" module. Internally, the--- lazy @Text@ type consists of a list of strict chunks.------ The strict 'Text' type requires that an entire string fit into--- memory at once.  The lazy 'Data.Text.Lazy.Text' type is capable of--- streaming strings that are larger than memory using a small memory--- footprint.  In many cases, the overhead of chunked streaming makes--- the lazy 'Data.Text.Lazy.Text' type slower than its strict--- counterpart, but this is not always the case.  Sometimes, the time--- complexity of a function in one module may be different from the--- other, due to their differing internal structures.------ Each module provides an almost identical API, with the main--- difference being that the strict module uses 'Int' values for--- lengths and counts, while the lazy module uses 'Data.Int.Int64'--- lengths.---- $replacement------ A 'Text' value is a sequence of Unicode scalar values, as defined--- in--- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.--- As such, a 'Text' cannot contain values in the range U+D800 to--- U+DFFF inclusive. Haskell implementations admit all Unicode code--- points--- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)--- as 'Char' values, including code points from this invalid range.--- This means that there are some 'Char' values that are not valid--- Unicode scalar values, and the functions in this module must handle--- those cases.------ Within this module, many functions construct a 'Text' from one or--- more 'Char' values. Those functions will substitute 'Char' values--- that are not valid Unicode scalar values with the replacement--- character \"&#xfffd;\" (U+FFFD).  Functions that perform this--- inspection and replacement are documented with the phrase--- \"Performs replacement on invalid scalar values\".------ (One reason for this policy of replacement is that internally, a--- 'Text' value is represented as packed UTF-16 data. Values in the--- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate--- code points, and so cannot be represented. The functions replace--- invalid scalar values, instead of dropping them, as a security--- measure. For details, see--- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)---- $fusion------ Most of the functions in this module are subject to /fusion/,--- meaning that a pipeline of such functions will usually allocate at--- most one 'Text' value.------ As an example, consider the following pipeline:------ > import Data.Text as T--- > import Data.Text.Encoding as E--- > import Data.ByteString (ByteString)--- >--- > countChars :: ByteString -> Int--- > countChars = T.length . T.toUpper . E.decodeUtf8------ From the type signatures involved, this looks like it should--- allocate one 'Data.ByteString.ByteString' value, and two 'Text'--- values. However, when a module is compiled with optimisation--- enabled under GHC, the two intermediate 'Text' values will be--- optimised away, and the function will be compiled down to a single--- loop over the source 'Data.ByteString.ByteString'.------ Functions that can be fused by the compiler are documented with the--- phrase \"Subject to fusion\".--instance Eq Text where-    Text arrA offA lenA == Text arrB offB lenB-        | lenA == lenB = A.equal arrA offA arrB offB lenA-        | otherwise    = False-    {-# INLINE (==) #-}--instance Ord Text where-    compare = compareText--instance Read Text where-    readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]--#if MIN_VERSION_base(4,9,0)--- | Non-orphan 'Semigroup' instance only defined for--- @base-4.9.0.0@ and later; orphan instances for older GHCs are--- provided by--- the [semigroups](http://hackage.haskell.org/package/semigroups)--- package------ @since 1.2.2.0-instance Semigroup Text where-    (<>) = append-#endif--instance Monoid Text where-    mempty  = empty-#if MIN_VERSION_base(4,9,0)-    mappend = (<>) -- future-proof definition-#else-    mappend = append-#endif-    mconcat = concat--instance IsString Text where-    fromString = pack--#if MIN_VERSION_base(4,7,0)--- | @since 1.2.0.0-instance Exts.IsList Text where-    type Item Text = Char-    fromList       = pack-    toList         = unpack-#endif--instance NFData Text where rnf !_ = ()---- | @since 1.2.1.0-instance Binary Text where-    put t = put (encodeUtf8 t)-    get   = do-      bs <- get-      case decodeUtf8' bs of-        P.Left exn -> P.fail (P.show exn)-        P.Right a -> P.return a---- | This instance preserves data abstraction at the cost of inefficiency.--- We omit reflection services for the sake of data abstraction.------ This instance was created by copying the updated behavior of--- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you--- feel a mistake has been made, please feel free to submit--- improvements.------ The original discussion is archived here:--- <https://mail.haskell.org/pipermail/haskell-cafe/2010-January/072379.html could we get a Data instance for Data.Text.Text? >------ The followup discussion that changed the behavior of 'Data.Set.Set'--- and 'Data.Map.Map' is archived here:--- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >--instance Data Text where-  gfoldl f z txt = z pack `f` (unpack txt)-  toConstr _ = packConstr-  gunfold k z c = case constrIndex c of-    1 -> k (z pack)-    _ -> P.error "gunfold"-  dataTypeOf _ = textDataType---- | This instance has similar considerations to the 'Data' instance:--- it preserves abstraction at the cost of inefficiency.------ @since 1.2.4.0-instance Lift Text where-  lift = TH.appE (TH.varE 'pack) . TH.stringE . unpack--#if MIN_VERSION_base(4,7,0)--- | Only defined for @base-4.7.0.0@ and later------ @since 1.2.2.0-instance PrintfArg Text where-  formatArg txt = formatString $ unpack txt-#endif--packConstr :: Constr-packConstr = mkConstr textDataType "pack" [] Prefix--textDataType :: DataType-textDataType = mkDataType "Data.Text.Text" [packConstr]---- | /O(n)/ Compare two 'Text' values lexicographically.-compareText :: Text -> Text -> Ordering-compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)-    | lenA == 0 && lenB == 0 = EQ-    | otherwise              = go 0 0-  where-    go !i !j-        | i >= lenA || j >= lenB = compare lenA lenB-        | a < b                  = LT-        | a > b                  = GT-        | otherwise              = go (i+di) (j+dj)-      where Iter a di = iter ta i-            Iter b dj = iter tb j---- -------------------------------------------------------------------------------- * Conversion to/from 'Text'---- | /O(n)/ Convert a 'String' into a 'Text'.  Subject to--- fusion.  Performs replacement on invalid scalar values.-pack :: String -> Text-pack = unstream . S.map safe . S.streamList-{-# INLINE [1] pack #-}---- -------------------------------------------------------------------------------- * Basic functions---- | /O(n)/ Adds a character to the front of a 'Text'.  This function--- is more costly than its 'List' counterpart because it requires--- copying a new array.  Subject to fusion.  Performs replacement on--- invalid scalar values.-cons :: Char -> Text -> Text-cons c t = unstream (S.cons (safe c) (stream t))-{-# INLINE cons #-}--infixr 5 `cons`---- | /O(n)/ Adds a character to the end of a 'Text'.  This copies the--- entire array in the process, unless fused.  Subject to fusion.--- Performs replacement on invalid scalar values.-snoc :: Text -> Char -> Text-snoc t c = unstream (S.snoc (stream t) (safe c))-{-# INLINE snoc #-}---- | /O(n)/ Appends one 'Text' to the other by copying both of them--- into a new 'Text'.  Subject to fusion.-append :: Text -> Text -> Text-append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)-    | len1 == 0 = b-    | len2 == 0 = a-    | len > 0   = Text (A.run x) 0 len-    | otherwise = overflowError "append"-    where-      len = len1+len2-      x :: ST s (A.MArray s)-      x = do-        arr <- A.new len-        A.copyI arr 0 arr1 off1 len1-        A.copyI arr len1 arr2 off2 len-        return arr-{-# NOINLINE append #-}--{-# RULES-"TEXT append -> fused" [~1] forall t1 t2.-    append t1 t2 = unstream (S.append (stream t1) (stream t2))-"TEXT append -> unfused" [1] forall t1 t2.-    unstream (S.append (stream t1) (stream t2)) = append t1 t2- #-}---- | /O(1)/ Returns the first character of a 'Text', which must be--- non-empty.  Subject to fusion.-head :: Text -> Char-head t = S.head (stream t)-{-# INLINE head #-}---- | /O(1)/ Returns the first character and rest of a 'Text', or--- 'Nothing' if empty. Subject to fusion.-uncons :: Text -> Maybe (Char, Text)-uncons t@(Text arr off len)-    | len <= 0  = Nothing-    | otherwise = Just $ let !(Iter c d) = iter t 0-                         in (c, text arr (off+d) (len-d))-{-# INLINE [1] uncons #-}---- | Lifted from Control.Arrow and specialized.-second :: (b -> c) -> (a,b) -> (a,c)-second f (a, b) = (a, f b)---- | /O(1)/ Returns the last character of a 'Text', which must be--- non-empty.  Subject to fusion.-last :: Text -> Char-last (Text arr off len)-    | len <= 0                 = emptyError "last"-    | n < 0xDC00 || n > 0xDFFF = unsafeChr n-    | otherwise                = U16.chr2 n0 n-    where n  = A.unsafeIndex arr (off+len-1)-          n0 = A.unsafeIndex arr (off+len-2)-{-# INLINE [1] last #-}--{-# RULES-"TEXT last -> fused" [~1] forall t.-    last t = S.last (stream t)-"TEXT last -> unfused" [1] forall t.-    S.last (stream t) = last t-  #-}---- | /O(1)/ Returns all characters after the head of a 'Text', which--- must be non-empty.  Subject to fusion.-tail :: Text -> Text-tail t@(Text arr off len)-    | len <= 0  = emptyError "tail"-    | otherwise = text arr (off+d) (len-d)-    where d = iter_ t 0-{-# INLINE [1] tail #-}--{-# RULES-"TEXT tail -> fused" [~1] forall t.-    tail t = unstream (S.tail (stream t))-"TEXT tail -> unfused" [1] forall t.-    unstream (S.tail (stream t)) = tail t- #-}---- | /O(1)/ Returns all but the last character of a 'Text', which must--- be non-empty.  Subject to fusion.-init :: Text -> Text-init (Text arr off len) | len <= 0                   = emptyError "init"-                        | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)-                        | otherwise                  = text arr off (len-1)-    where-      n = A.unsafeIndex arr (off+len-1)-{-# INLINE [1] init #-}--{-# RULES-"TEXT init -> fused" [~1] forall t.-    init t = unstream (S.init (stream t))-"TEXT init -> unfused" [1] forall t.-    unstream (S.init (stream t)) = init t- #-}---- | /O(1)/ Returns all but the last character and the last character of a--- 'Text', or 'Nothing' if empty.------ @since 1.2.3.0-unsnoc :: Text -> Maybe (Text, Char)-unsnoc (Text arr off len)-    | len <= 0                 = Nothing-    | n < 0xDC00 || n > 0xDFFF = Just (text arr off (len-1), unsafeChr n)-    | otherwise                = Just (text arr off (len-2), U16.chr2 n0 n)-    where n  = A.unsafeIndex arr (off+len-1)-          n0 = A.unsafeIndex arr (off+len-2)-{-# INLINE [1] unsnoc #-}---- | /O(1)/ Tests whether a 'Text' is empty or not.  Subject to--- fusion.-null :: Text -> Bool-null (Text _arr _off len) =-#if defined(ASSERTS)-    assert (len >= 0) $-#endif-    len <= 0-{-# INLINE [1] null #-}--{-# RULES-"TEXT null -> fused" [~1] forall t.-    null t = S.null (stream t)-"TEXT null -> unfused" [1] forall t.-    S.null (stream t) = null t- #-}---- | /O(1)/ Tests whether a 'Text' contains exactly one character.--- Subject to fusion.-isSingleton :: Text -> Bool-isSingleton = S.isSingleton . stream-{-# INLINE isSingleton #-}---- | /O(n)/ Returns the number of characters in a 'Text'.--- Subject to fusion.-length :: Text -> Int-length t = S.length (stream t)-{-# INLINE [1] length #-}--- length needs to be phased after the compareN/length rules otherwise--- it may inline before the rules have an opportunity to fire.---- | /O(n)/ Compare the count of characters in a 'Text' to a number.--- Subject to fusion.------ This function gives the same answer as comparing against the result--- of 'length', but can short circuit if the count of characters is--- greater than the number, and hence be more efficient.-compareLength :: Text -> Int -> Ordering-compareLength t n = S.compareLengthI (stream t) n-{-# INLINE [1] compareLength #-}--{-# RULES-"TEXT compareN/length -> compareLength" [~1] forall t n.-    compare (length t) n = compareLength t n-  #-}--{-# RULES-"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.-    eqInt (length t) n = compareLength t n == EQ-  #-}--{-# RULES-"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.-    neInt (length t) n = compareLength t n /= EQ-  #-}--{-# RULES-"TEXT <N/length -> compareLength/==LT" [~1] forall t n.-    ltInt (length t) n = compareLength t n == LT-  #-}--{-# RULES-"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.-    leInt (length t) n = compareLength t n /= GT-  #-}--{-# RULES-"TEXT >N/length -> compareLength/==GT" [~1] forall t n.-    gtInt (length t) n = compareLength t n == GT-  #-}--{-# RULES-"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.-    geInt (length t) n = compareLength t n /= LT-  #-}---- -------------------------------------------------------------------------------- * Transformations--- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to--- each element of @t@.------ Example:------ >>> let message = pack "I am not angry. Not at all."--- >>> T.map (\c -> if c == '.' then '!' else c) message--- "I am not angry! Not at all!"------ Subject to fusion.  Performs replacement on invalid scalar values.-map :: (Char -> Char) -> Text -> Text-map f t = unstream (S.map (safe . f) (stream t))-{-# INLINE [1] map #-}---- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of--- 'Text's and concatenates the list after interspersing the first--- argument between each element of the list.------ Example:------ >>> T.intercalate "NI!" ["We", "seek", "the", "Holy", "Grail"]--- "WeNI!seekNI!theNI!HolyNI!Grail"-intercalate :: Text -> [Text] -> Text-intercalate t = concat . (F.intersperse t)-{-# INLINE intercalate #-}---- | /O(n)/ The 'intersperse' function takes a character and places it--- between the characters of a 'Text'.------ Example:------ >>> T.intersperse '.' "SHIELD"--- "S.H.I.E.L.D"------ Subject to fusion.  Performs replacement on invalid scalar values.-intersperse     :: Char -> Text -> Text-intersperse c t = unstream (S.intersperse (safe c) (stream t))-{-# INLINE intersperse #-}---- | /O(n)/ Reverse the characters of a string.------ Example:------ >>> T.reverse "desrever"--- "reversed"------ Subject to fusion (fuses with its argument).-reverse :: Text -> Text-reverse t = S.reverse (stream t)-{-# INLINE reverse #-}---- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in--- @haystack@ with @replacement@.------ This function behaves as though it was defined as follows:------ @--- replace needle replacement haystack =---   'intercalate' replacement ('splitOn' needle haystack)--- @------ As this suggests, each occurrence is replaced exactly once.  So if--- @needle@ occurs in @replacement@, that occurrence will /not/ itself--- be replaced recursively:------ >>> replace "oo" "foo" "oo"--- "foo"------ In cases where several instances of @needle@ overlap, only the--- first one will be replaced:------ >>> replace "ofo" "bar" "ofofo"--- "barfo"------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-replace :: Text-        -- ^ @needle@ to search for.  If this string is empty, an-        -- error will occur.-        -> Text-        -- ^ @replacement@ to replace @needle@ with.-        -> Text-        -- ^ @haystack@ in which to search.-        -> Text-replace needle@(Text _      _      neeLen)-               (Text repArr repOff repLen)-      haystack@(Text hayArr hayOff hayLen)-  | neeLen == 0 = emptyError "replace"-  | L.null ixs  = haystack-  | len > 0     = Text (A.run x) 0 len-  | otherwise   = empty-  where-    ixs = indices needle haystack-    len = hayLen - (neeLen - repLen) `mul` L.length ixs-    x :: ST s (A.MArray s)-    x = do-      marr <- A.new len-      let loop (i:is) o d = do-            let d0 = d + i - o-                d1 = d0 + repLen-            A.copyI marr d  hayArr (hayOff+o) d0-            A.copyI marr d0 repArr repOff d1-            loop is (i + neeLen) d1-          loop []     o d = A.copyI marr d hayArr (hayOff+o) len-      loop ixs 0 0-      return marr---- ------------------------------------------------------------------------------- ** Case conversions (folds)---- $case------ When case converting 'Text' values, do not use combinators like--- @map toUpper@ to case convert each character of a string--- individually, as this gives incorrect results according to the--- rules of some writing systems.  The whole-string case conversion--- functions from this module, such as @toUpper@, obey the correct--- case conversion rules.  As a result, these functions may map one--- input character to two or three output characters. For examples,--- see the documentation of each function.------ /Note/: In some languages, case conversion is a locale- and--- context-dependent operation. The case conversion functions in this--- module are /not/ locale sensitive. Programs that require locale--- sensitivity should use appropriate versions of the--- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.---- | /O(n)/ Convert a string to folded case.  Subject to fusion.------ This function is mainly useful for performing caseless (also known--- as case insensitive) string comparisons.------ A string @x@ is a caseless match for a string @y@ if and only if:------ @toCaseFold x == toCaseFold y@------ The result string may be longer than the input string, and may--- differ from applying 'toLower' to the input string.  For instance,--- the Armenian small ligature \"&#xfb13;\" (men now, U+FB13) is case--- folded to the sequence \"&#x574;\" (men, U+0574) followed by--- \"&#x576;\" (now, U+0576), while the Greek \"&#xb5;\" (micro sign,--- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)--- instead of itself.-toCaseFold :: Text -> Text-toCaseFold t = unstream (S.toCaseFold (stream t))-{-# INLINE toCaseFold #-}---- | /O(n)/ Convert a string to lower case, using simple case--- conversion.  Subject to fusion.------ The result string may be longer than the input string.  For--- instance, \"&#x130;\" (Latin capital letter I with dot above,--- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)--- followed by \" &#x307;\" (combining dot above, U+0307).-toLower :: Text -> Text-toLower t = unstream (S.toLower (stream t))-{-# INLINE toLower #-}---- | /O(n)/ Convert a string to upper case, using simple case--- conversion.  Subject to fusion.------ The result string may be longer than the input string.  For--- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the--- two-letter sequence \"SS\".-toUpper :: Text -> Text-toUpper t = unstream (S.toUpper (stream t))-{-# INLINE toUpper #-}---- | /O(n)/ Convert a string to title case, using simple case--- conversion. Subject to fusion.------ The first letter of the input is converted to title case, as is--- every subsequent letter that immediately follows a non-letter.--- Every letter that immediately follows another letter is converted--- to lower case.------ The result string may be longer than the input string. For example,--- the Latin small ligature &#xfb02; (U+FB02) is converted to the--- sequence Latin capital letter F (U+0046) followed by Latin small--- letter l (U+006C).------ /Note/: this function does not take language or culture specific--- rules into account. For instance, in English, different style--- guides disagree on whether the book name \"The Hill of the Red--- Fox\" is correctly title cased&#x2014;but this function will--- capitalize /every/ word.------ @since 1.0.0.0-toTitle :: Text -> Text-toTitle t = unstream (S.toTitle (stream t))-{-# INLINE toTitle #-}---- | /O(n)/ Left-justify a string to the given length, using the--- specified fill character on the right. Subject to fusion.--- Performs replacement on invalid scalar values.------ Examples:------ >>> justifyLeft 7 'x' "foo"--- "fooxxxx"------ >>> justifyLeft 3 'x' "foobar"--- "foobar"-justifyLeft :: Int -> Char -> Text -> Text-justifyLeft k c t-    | len >= k  = t-    | otherwise = t `append` replicateChar (k-len) c-  where len = length t-{-# INLINE [1] justifyLeft #-}--{-# RULES-"TEXT justifyLeft -> fused" [~1] forall k c t.-    justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))-"TEXT justifyLeft -> unfused" [1] forall k c t.-    unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t-  #-}---- | /O(n)/ Right-justify a string to the given length, using the--- specified fill character on the left.  Performs replacement on--- invalid scalar values.------ Examples:------ >>> justifyRight 7 'x' "bar"--- "xxxxbar"------ >>> justifyRight 3 'x' "foobar"--- "foobar"-justifyRight :: Int -> Char -> Text -> Text-justifyRight k c t-    | len >= k  = t-    | otherwise = replicateChar (k-len) c `append` t-  where len = length t-{-# INLINE justifyRight #-}---- | /O(n)/ Center a string to the given length, using the specified--- fill character on either side.  Performs replacement on invalid--- scalar values.------ Examples:------ >>> center 8 'x' "HS"--- "xxxHSxxx"-center :: Int -> Char -> Text -> Text-center k c t-    | len >= k  = t-    | otherwise = replicateChar l c `append` t `append` replicateChar r c-  where len = length t-        d   = k - len-        r   = d `quot` 2-        l   = d - r-{-# INLINE center #-}---- | /O(n)/ The 'transpose' function transposes the rows and columns--- of its 'Text' argument.  Note that this function uses 'pack',--- 'unpack', and the list version of transpose, and is thus not very--- efficient.------ Examples:------ >>> transpose ["green","orange"]--- ["go","rr","ea","en","ng","e"]------ >>> transpose ["blue","red"]--- ["br","le","ud","e"]-transpose :: [Text] -> [Text]-transpose ts = P.map pack (L.transpose (P.map unpack ts))---- -------------------------------------------------------------------------------- * Reducing 'Text's (folds)---- | /O(n)/ 'foldl', applied to a binary operator, a starting value--- (typically the left-identity of the operator), and a 'Text',--- reduces the 'Text' using the binary operator, from left to right.--- Subject to fusion.-foldl :: (a -> Char -> a) -> a -> Text -> a-foldl f z t = S.foldl f z (stream t)-{-# INLINE foldl #-}---- | /O(n)/ A strict version of 'foldl'.  Subject to fusion.-foldl' :: (a -> Char -> a) -> a -> Text -> a-foldl' f z t = S.foldl' f z (stream t)-{-# INLINE foldl' #-}---- | /O(n)/ A variant of 'foldl' that has no starting value argument,--- and thus must be applied to a non-empty 'Text'.  Subject to fusion.-foldl1 :: (Char -> Char -> Char) -> Text -> Char-foldl1 f t = S.foldl1 f (stream t)-{-# INLINE foldl1 #-}---- | /O(n)/ A strict version of 'foldl1'.  Subject to fusion.-foldl1' :: (Char -> Char -> Char) -> Text -> Char-foldl1' f t = S.foldl1' f (stream t)-{-# INLINE foldl1' #-}---- | /O(n)/ 'foldr', applied to a binary operator, a starting value--- (typically the right-identity of the operator), and a 'Text',--- reduces the 'Text' using the binary operator, from right to left.--- Subject to fusion.-foldr :: (Char -> a -> a) -> a -> Text -> a-foldr f z t = S.foldr f z (stream t)-{-# INLINE foldr #-}---- | /O(n)/ A variant of 'foldr' that has no starting value argument,--- and thus must be applied to a non-empty 'Text'.  Subject to--- fusion.-foldr1 :: (Char -> Char -> Char) -> Text -> Char-foldr1 f t = S.foldr1 f (stream t)-{-# INLINE foldr1 #-}---- -------------------------------------------------------------------------------- ** Special folds---- | /O(n)/ Concatenate a list of 'Text's.-concat :: [Text] -> Text-concat ts = case ts' of-              [] -> empty-              [t] -> t-              _ -> Text (A.run go) 0 len-  where-    ts' = L.filter (not . null) ts-    len = sumP "concat" $ L.map lengthWord16 ts'-    go :: ST s (A.MArray s)-    go = do-      arr <- A.new len-      let step i (Text a o l) =-            let !j = i + l in A.copyI arr i a o j >> return j-      foldM step 0 ts' >> return arr---- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and--- concatenate the results.-concatMap :: (Char -> Text) -> Text -> Text-concatMap f = concat . foldr ((:) . f) []-{-# INLINE concatMap #-}---- | /O(n)/ 'any' @p@ @t@ determines whether any character in the--- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.-any :: (Char -> Bool) -> Text -> Bool-any p t = S.any p (stream t)-{-# INLINE any #-}---- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the--- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.-all :: (Char -> Bool) -> Text -> Bool-all p t = S.all p (stream t)-{-# INLINE all #-}---- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which--- must be non-empty. Subject to fusion.-maximum :: Text -> Char-maximum t = S.maximum (stream t)-{-# INLINE maximum #-}---- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which--- must be non-empty. Subject to fusion.-minimum :: Text -> Char-minimum t = S.minimum (stream t)-{-# INLINE minimum #-}---- -------------------------------------------------------------------------------- * Building 'Text's---- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of--- successive reduced values from the left. Subject to fusion.--- Performs replacement on invalid scalar values.------ > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]------ Note that------ > last (scanl f z xs) == foldl f z xs.-scanl :: (Char -> Char -> Char) -> Char -> Text -> Text-scanl f z t = unstream (S.scanl g z (stream t))-    where g a b = safe (f a b)-{-# INLINE scanl #-}---- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting--- value argument. Performs replacement on invalid scalar values.------ > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]-scanl1 :: (Char -> Char -> Char) -> Text -> Text-scanl1 f t | null t    = empty-           | otherwise = scanl f (unsafeHead t) (unsafeTail t)-{-# INLINE scanl1 #-}---- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.  Performs--- replacement on invalid scalar values.------ > scanr f v == reverse . scanl (flip f) v . reverse-scanr :: (Char -> Char -> Char) -> Char -> Text -> Text-scanr f z = S.reverse . S.reverseScanr g z . reverseStream-    where g a b = safe (f a b)-{-# INLINE scanr #-}---- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting--- value argument. Performs replacement on invalid scalar values.-scanr1 :: (Char -> Char -> Char) -> Text -> Text-scanr1 f t | null t    = empty-           | otherwise = scanr f (last t) (init t)-{-# INLINE scanr1 #-}---- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a--- function to each element of a 'Text', passing an accumulating--- parameter from left to right, and returns a final 'Text'.  Performs--- replacement on invalid scalar values.-mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)-mapAccumL f z0 = S.mapAccumL g z0 . stream-    where g a b = second safe (f a b)-{-# INLINE mapAccumL #-}---- | The 'mapAccumR' function behaves like a combination of 'map' and--- a strict 'foldr'; it applies a function to each element of a--- 'Text', passing an accumulating parameter from right to left, and--- returning a final value of this accumulator together with the new--- 'Text'.--- Performs replacement on invalid scalar values.-mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)-mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream-    where g a b = second safe (f a b)-{-# INLINE mapAccumR #-}---- -------------------------------------------------------------------------------- ** Generating and unfolding 'Text's---- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input--- @t@ repeated @n@ times.-replicate :: Int -> Text -> Text-replicate n t@(Text a o l)-    | n <= 0 || l <= 0       = empty-    | n == 1                 = t-    | isSingleton t          = replicateChar n (unsafeHead t)-    | otherwise              = Text (A.run x) 0 len-  where-    len = l `mul` n -- TODO: detect overflows-    x :: ST s (A.MArray s)-    x = do-      arr <- A.new len-      A.copyI arr 0 a o l-      let loop !l1 =-            let rest = len - l1 in-            if rest <= l1 then A.copyM arr l1 arr 0 rest >> return arr-            else A.copyM arr l1 arr 0 l1 >> loop (l1 `shiftL` 1)-      loop l-{-# INLINE [1] replicate #-}---{-# RULES-"TEXT replicate/singleton -> replicateChar" [~1] forall n c.-    replicate n (singleton c) = replicateChar n c-  #-}---- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the--- value of every element. Subject to fusion.-replicateChar :: Int -> Char -> Text-replicateChar n c = unstream (S.replicateCharI n (safe c))-{-# INLINE replicateChar #-}---- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'--- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a--- 'Text' from a seed value. The function takes the element and--- returns 'Nothing' if it is done producing the 'Text', otherwise--- 'Just' @(a,b)@.  In this case, @a@ is the next 'Char' in the--- string, and @b@ is the seed value for further production. Subject--- to fusion.  Performs replacement on invalid scalar values.-unfoldr     :: (a -> Maybe (Char,a)) -> a -> Text-unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)-{-# INLINE unfoldr #-}---- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed--- value. However, the length of the result should be limited by the--- first argument to 'unfoldrN'. This function is more efficient than--- 'unfoldr' when the maximum length of the result is known and--- correct, otherwise its performance is similar to 'unfoldr'. Subject--- to fusion.  Performs replacement on invalid scalar values.-unfoldrN     :: Int -> (a -> Maybe (Char,a)) -> a -> Text-unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)-{-# INLINE unfoldrN #-}---- -------------------------------------------------------------------------------- * Substrings---- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the--- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than--- the length of the Text. Subject to fusion.-take :: Int -> Text -> Text-take n t@(Text arr off len)-    | n <= 0    = empty-    | n >= len  = t-    | otherwise = text arr off (iterN n t)-{-# INLINE [1] take #-}--iterN :: Int -> Text -> Int-iterN n t@(Text _arr _off len) = loop 0 0-  where loop !i !cnt-            | i >= len || cnt >= n = i-            | otherwise            = loop (i+d) (cnt+1)-          where d = iter_ t i--{-# RULES-"TEXT take -> fused" [~1] forall n t.-    take n t = unstream (S.take n (stream t))-"TEXT take -> unfused" [1] forall n t.-    unstream (S.take n (stream t)) = take n t-  #-}---- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after--- taking @n@ characters from the end of @t@.------ Examples:------ >>> takeEnd 3 "foobar"--- "bar"------ @since 1.1.1.0-takeEnd :: Int -> Text -> Text-takeEnd n t@(Text arr off len)-    | n <= 0    = empty-    | n >= len  = t-    | otherwise = text arr (off+i) (len-i)-  where i = iterNEnd n t--iterNEnd :: Int -> Text -> Int-iterNEnd n t@(Text _arr _off len) = loop (len-1) n-  where loop i !m-          | m <= 0    = i+1-          | i <= 0    = 0-          | otherwise = loop (i+d) (m-1)-          where d = reverseIter_ t i---- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the--- 'Text' after the first @n@ characters, or the empty 'Text' if @n@--- is greater than the length of the 'Text'. Subject to fusion.-drop :: Int -> Text -> Text-drop n t@(Text arr off len)-    | n <= 0    = t-    | n >= len  = empty-    | otherwise = text arr (off+i) (len-i)-  where i = iterN n t-{-# INLINE [1] drop #-}--{-# RULES-"TEXT drop -> fused" [~1] forall n t.-    drop n t = unstream (S.drop n (stream t))-"TEXT drop -> unfused" [1] forall n t.-    unstream (S.drop n (stream t)) = drop n t-  #-}---- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after--- dropping @n@ characters from the end of @t@.------ Examples:------ >>> dropEnd 3 "foobar"--- "foo"------ @since 1.1.1.0-dropEnd :: Int -> Text -> Text-dropEnd n t@(Text arr off len)-    | n <= 0    = t-    | n >= len  = empty-    | otherwise = text arr off (iterNEnd n t)---- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',--- returns the longest prefix (possibly empty) of elements that--- satisfy @p@.  Subject to fusion.-takeWhile :: (Char -> Bool) -> Text -> Text-takeWhile p t@(Text arr off len) = loop 0-  where loop !i | i >= len    = t-                | p c         = loop (i+d)-                | otherwise   = text arr off i-            where Iter c d    = iter t i-{-# INLINE [1] takeWhile #-}--{-# RULES-"TEXT takeWhile -> fused" [~1] forall p t.-    takeWhile p t = unstream (S.takeWhile p (stream t))-"TEXT takeWhile -> unfused" [1] forall p t.-    unstream (S.takeWhile p (stream t)) = takeWhile p t-  #-}---- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',--- returns the longest suffix (possibly empty) of elements that--- satisfy @p@.--- Examples:------ >>> takeWhileEnd (=='o') "foo"--- "oo"------ @since 1.2.2.0-takeWhileEnd :: (Char -> Bool) -> Text -> Text-takeWhileEnd p t@(Text arr off len) = loop (len-1) len-  where loop !i !l | l <= 0    = t-                   | p c       = loop (i+d) (l+d)-                   | otherwise = text arr (off+l) (len-l)-            where (c,d)        = reverseIter t i-{-# INLINE [1] takeWhileEnd #-}---- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after--- 'takeWhile' @p@ @t@. Subject to fusion.-dropWhile :: (Char -> Bool) -> Text -> Text-dropWhile p t@(Text arr off len) = loop 0 0-  where loop !i !l | l >= len  = empty-                   | p c       = loop (i+d) (l+d)-                   | otherwise = Text arr (off+i) (len-l)-            where Iter c d     = iter t i-{-# INLINE [1] dropWhile #-}--{-# RULES-"TEXT dropWhile -> fused" [~1] forall p t.-    dropWhile p t = unstream (S.dropWhile p (stream t))-"TEXT dropWhile -> unfused" [1] forall p t.-    unstream (S.dropWhile p (stream t)) = dropWhile p t-  #-}---- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after--- dropping characters that satisfy the predicate @p@ from the end of--- @t@.------ Examples:------ >>> dropWhileEnd (=='.') "foo..."--- "foo"-dropWhileEnd :: (Char -> Bool) -> Text -> Text-dropWhileEnd p t@(Text arr off len) = loop (len-1) len-  where loop !i !l | l <= 0    = empty-                   | p c       = loop (i+d) (l+d)-                   | otherwise = Text arr off l-            where (c,d)        = reverseIter t i-{-# INLINE [1] dropWhileEnd #-}---- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after--- dropping characters that satisfy the predicate @p@ from both the--- beginning and end of @t@.  Subject to fusion.-dropAround :: (Char -> Bool) -> Text -> Text-dropAround p = dropWhile p . dropWhileEnd p-{-# INLINE [1] dropAround #-}---- | /O(n)/ Remove leading white space from a string.  Equivalent to:------ > dropWhile isSpace-stripStart :: Text -> Text-stripStart = dropWhile isSpace-{-# INLINE stripStart #-}---- | /O(n)/ Remove trailing white space from a string.  Equivalent to:------ > dropWhileEnd isSpace-stripEnd :: Text -> Text-stripEnd = dropWhileEnd isSpace-{-# INLINE [1] stripEnd #-}---- | /O(n)/ Remove leading and trailing white space from a string.--- Equivalent to:------ > dropAround isSpace-strip :: Text -> Text-strip = dropAround isSpace-{-# INLINE [1] strip #-}---- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a--- prefix of @t@ of length @n@, and whose second is the remainder of--- the string. It is equivalent to @('take' n t, 'drop' n t)@.-splitAt :: Int -> Text -> (Text, Text)-splitAt n t@(Text arr off len)-    | n <= 0    = (empty, t)-    | n >= len  = (t, empty)-    | otherwise = let k = iterN n t-                  in (text arr off k, text arr (off+k) (len-k))---- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns--- a pair whose first element is the longest prefix (possibly empty)--- of @t@ of elements that satisfy @p@, and whose second is the--- remainder of the list.-span :: (Char -> Bool) -> Text -> (Text, Text)-span p t = case span_ p t of-             (# hd,tl #) -> (hd,tl)-{-# INLINE span #-}---- | /O(n)/ 'break' is like 'span', but the prefix returned is--- over elements that fail the predicate @p@.-break :: (Char -> Bool) -> Text -> (Text, Text)-break p = span (not . p)-{-# INLINE break #-}---- | /O(n)/ Group characters in a string according to a predicate.-groupBy :: (Char -> Char -> Bool) -> Text -> [Text]-groupBy p = loop-  where-    loop t@(Text arr off len)-        | null t    = []-        | otherwise = text arr off n : loop (text arr (off+n) (len-n))-        where Iter c d = iter t 0-              n     = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))---- | Returns the /array/ index (in units of 'Word16') at which a--- character may be found.  This is /not/ the same as the logical--- index returned by e.g. 'findIndex'.-findAIndexOrEnd :: (Char -> Bool) -> Text -> Int-findAIndexOrEnd q t@(Text _arr _off len) = go 0-    where go !i | i >= len || q c       = i-                | otherwise             = go (i+d)-                where Iter c d          = iter t i---- | /O(n)/ Group characters in a string by equality.-group :: Text -> [Text]-group = groupBy (==)---- | /O(n)/ Return all initial segments of the given 'Text', shortest--- first.-inits :: Text -> [Text]-inits t@(Text arr off len) = loop 0-    where loop i | i >= len = [t]-                 | otherwise = Text arr off i : loop (i + iter_ t i)---- | /O(n)/ Return all final segments of the given 'Text', longest--- first.-tails :: Text -> [Text]-tails t | null t    = [empty]-        | otherwise = t : tails (unsafeTail t)---- $split------ Splitting functions in this library do not perform character-wise--- copies to create substrings; they just construct new 'Text's that--- are slices of the original.---- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'--- argument (which cannot be empty), consuming the delimiter. An empty--- delimiter is invalid, and will cause an error to be raised.------ Examples:------ >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"--- ["a","b","d","e"]------ >>> splitOn "aaa"  "aaaXaaaXaaaXaaa"--- ["","X","X","X",""]------ >>> splitOn "x"    "x"--- ["",""]------ and------ > intercalate s . splitOn s         == id--- > splitOn (singleton c)             == split (==c)------ (Note: the string @s@ to split on above cannot be empty.)------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-splitOn :: Text-        -- ^ String to split on. If this string is empty, an error-        -- will occur.-        -> Text-        -- ^ Input text.-        -> [Text]-splitOn pat@(Text _ _ l) src@(Text arr off len)-    | l <= 0          = emptyError "splitOn"-    | isSingleton pat = split (== unsafeHead pat) src-    | otherwise       = go 0 (indices pat src)-  where-    go !s (x:xs) =  text arr (s+off) (x-s) : go (x+l) xs-    go  s _      = [text arr (s+off) (len-s)]-{-# INLINE [1] splitOn #-}--{-# RULES-"TEXT splitOn/singleton -> split/==" [~1] forall c t.-    splitOn (singleton c) t = split (==c) t-  #-}---- | /O(n)/ Splits a 'Text' into components delimited by separators,--- where the predicate returns True for a separator element.  The--- resulting components do not contain the separators.  Two adjacent--- separators result in an empty component in the output.  eg.------ >>> split (=='a') "aabbaca"--- ["","","bb","c",""]------ >>> split (=='a') ""--- [""]-split :: (Char -> Bool) -> Text -> [Text]-split _ t@(Text _off _arr 0) = [t]-split p t = loop t-    where loop s | null s'   = [l]-                 | otherwise = l : loop (unsafeTail s')-              where (# l, s' #) = span_ (not . p) s-{-# INLINE split #-}---- | /O(n)/ Splits a 'Text' into components of length @k@.  The last--- element may be shorter than the other chunks, depending on the--- length of the input. Examples:------ >>> chunksOf 3 "foobarbaz"--- ["foo","bar","baz"]------ >>> chunksOf 4 "haskell.org"--- ["hask","ell.","org"]-chunksOf :: Int -> Text -> [Text]-chunksOf k = go-  where-    go t = case splitAt k t of-             (a,b) | null a    -> []-                   | otherwise -> a : go b-{-# INLINE chunksOf #-}---- ------------------------------------------------------------------------------- * Searching------------------------------------------------------------------------------------ ** Searching with a predicate---- | /O(n)/ The 'find' function takes a predicate and a 'Text', and--- returns the first element matching the predicate, or 'Nothing' if--- there is no such element. Subject to fusion.-find :: (Char -> Bool) -> Text -> Maybe Char-find p t = S.findBy p (stream t)-{-# INLINE find #-}---- | /O(n)/ The 'partition' function takes a predicate and a 'Text',--- and returns the pair of 'Text's with elements which do and do not--- satisfy the predicate, respectively; i.e.------ > partition p t == (filter p t, filter (not . p) t)-partition :: (Char -> Bool) -> Text -> (Text, Text)-partition p t = (filter p t, filter (not . p) t)-{-# INLINE partition #-}---- | /O(n)/ 'filter', applied to a predicate and a 'Text',--- returns a 'Text' containing those characters that satisfy the--- predicate.-filter :: (Char -> Bool) -> Text -> Text-filter p t = unstream (S.filter p (stream t))-{-# INLINE filter #-}---- | /O(n+m)/ Find the first instance of @needle@ (which must be--- non-'null') in @haystack@.  The first element of the returned tuple--- is the prefix of @haystack@ before @needle@ is matched.  The second--- is the remainder of @haystack@, starting with the match.------ Examples:------ >>> breakOn "::" "a::b::c"--- ("a","::b::c")------ >>> breakOn "/" "foobar"--- ("foobar","")------ Laws:------ > append prefix match == haystack--- >   where (prefix, match) = breakOn needle haystack------ If you need to break a string by a substring repeatedly (e.g. you--- want to break on every instance of a substring), use 'breakOnAll'--- instead, as it has lower startup overhead.------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-breakOn :: Text -> Text -> (Text, Text)-breakOn pat src@(Text arr off len)-    | null pat  = emptyError "breakOn"-    | otherwise = case indices pat src of-                    []    -> (src, empty)-                    (x:_) -> (text arr off x, text arr (off+x) (len-x))-{-# INLINE breakOn #-}---- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the--- string.------ The first element of the returned tuple is the prefix of @haystack@--- up to and including the last match of @needle@.  The second is the--- remainder of @haystack@, following the match.------ >>> breakOnEnd "::" "a::b::c"--- ("a::b::","c")-breakOnEnd :: Text -> Text -> (Text, Text)-breakOnEnd pat src = (reverse b, reverse a)-    where (a,b) = breakOn (reverse pat) (reverse src)-{-# INLINE breakOnEnd #-}---- | /O(n+m)/ Find all non-overlapping instances of @needle@ in--- @haystack@.  Each element of the returned list consists of a pair:------ * The entire string prior to the /k/th match (i.e. the prefix)------ * The /k/th match, followed by the remainder of the string------ Examples:------ >>> breakOnAll "::" ""--- []------ >>> breakOnAll "/" "a/b/c/"--- [("a","/b/c/"),("a/b","/c/"),("a/b/c","/")]------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.------ The @needle@ parameter may not be empty.-breakOnAll :: Text              -- ^ @needle@ to search for-           -> Text              -- ^ @haystack@ in which to search-           -> [(Text, Text)]-breakOnAll pat src@(Text arr off slen)-    | null pat  = emptyError "breakOnAll"-    | otherwise = L.map step (indices pat src)-  where-    step       x = (chunk 0 x, chunk x (slen-x))-    chunk !n !l  = text arr (n+off) l-{-# INLINE breakOnAll #-}------------------------------------------------------------------------------------ ** Indexing 'Text's---- $index------ If you think of a 'Text' value as an array of 'Char' values (which--- it is not), you run the risk of writing inefficient code.------ An idiom that is common in some languages is to find the numeric--- offset of a character or substring, then use that number to split--- or trim the searched string.  With a 'Text' value, this approach--- would require two /O(n)/ operations: one to perform the search, and--- one to operate from wherever the search ended.------ For example, suppose you have a string that you want to split on--- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of--- searching for the index of @\"::\"@ and taking the substrings--- before and after that index, you would instead use @breakOnAll \"::\"@.---- | /O(n)/ 'Text' index (subscript) operator, starting from 0. Subject to fusion.-index :: Text -> Int -> Char-index t n = S.index (stream t) n-{-# INLINE index #-}---- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'--- and returns the index of the first element in the 'Text' satisfying--- the predicate. Subject to fusion.-findIndex :: (Char -> Bool) -> Text -> Maybe Int-findIndex p t = S.findIndex p (stream t)-{-# INLINE findIndex #-}---- | /O(n+m)/ The 'count' function returns the number of times the--- query string appears in the given 'Text'. An empty query string is--- invalid, and will cause an error to be raised.------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-count :: Text -> Text -> Int-count pat src-    | null pat        = emptyError "count"-    | isSingleton pat = countChar (unsafeHead pat) src-    | otherwise       = L.length (indices pat src)-{-# INLINE [1] count #-}--{-# RULES-"TEXT count/singleton -> countChar" [~1] forall c t.-    count (singleton c) t = countChar c t-  #-}---- | /O(n)/ The 'countChar' function returns the number of times the--- query element appears in the given 'Text'. Subject to fusion.-countChar :: Char -> Text -> Int-countChar c t = S.countChar c (stream t)-{-# INLINE countChar #-}------------------------------------------------------------------------------------ * Zipping---- | /O(n)/ 'zip' takes two 'Text's and returns a list of--- corresponding pairs of bytes. If one input 'Text' is short,--- excess elements of the longer 'Text' are discarded. This is--- equivalent to a pair of 'unpack' operations.-zip :: Text -> Text -> [(Char,Char)]-zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)-{-# INLINE zip #-}---- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function--- given as the first argument, instead of a tupling function.--- Performs replacement on invalid scalar values.-zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text-zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))-    where g a b = safe (f a b)-{-# INLINE zipWith #-}---- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's--- representing white space.-words :: Text -> [Text]-words t@(Text arr off len) = loop 0 0-  where-    loop !start !n-        | n >= len = if start == n-                     then []-                     else [Text arr (start+off) (n-start)]-        | isSpace c =-            if start == n-            then loop (start+1) (start+1)-            else Text arr (start+off) (n-start) : loop (n+d) (n+d)-        | otherwise = loop start (n+d)-        where Iter c d = iter t n-{-# INLINE words #-}---- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at--- newline 'Char's. The resulting strings do not contain newlines.-lines :: Text -> [Text]-lines ps | null ps   = []-         | otherwise = h : if null t-                           then []-                           else lines (unsafeTail t)-    where (# h,t #) = span_ (/= '\n') ps-{-# INLINE lines #-}--{---- | /O(n)/ Portably breaks a 'Text' up into a list of 'Text's at line--- boundaries.------ A line boundary is considered to be either a line feed, a carriage--- return immediately followed by a line feed, or a carriage return.--- This accounts for both Unix and Windows line ending conventions,--- and for the old convention used on Mac OS 9 and earlier.-lines' :: Text -> [Text]-lines' ps | null ps   = []-          | otherwise = h : case uncons t of-                              Nothing -> []-                              Just (c,t')-                                  | c == '\n' -> lines t'-                                  | c == '\r' -> case uncons t' of-                                                   Just ('\n',t'') -> lines t''-                                                   _               -> lines t'-    where (h,t)    = span notEOL ps-          notEOL c = c /= '\n' && c /= '\r'-{-# INLINE lines' #-}--}---- | /O(n)/ Joins lines, after appending a terminating newline to--- each.-unlines :: [Text] -> Text-unlines = concat . L.map (`snoc` '\n')-{-# INLINE unlines #-}---- | /O(n)/ Joins words using single space characters.-unwords :: [Text] -> Text-unwords = intercalate (singleton ' ')-{-# INLINE unwords #-}---- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns--- 'True' iff the first is a prefix of the second.  Subject to fusion.-isPrefixOf :: Text -> Text -> Bool-isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =-    alen <= blen && S.isPrefixOf (stream a) (stream b)-{-# INLINE [1] isPrefixOf #-}--{-# RULES-"TEXT isPrefixOf -> fused" [~1] forall s t.-    isPrefixOf s t = S.isPrefixOf (stream s) (stream t)-  #-}---- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns--- 'True' iff the first is a suffix of the second.-isSuffixOf :: Text -> Text -> Bool-isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =-    d >= 0 && a == b'-  where d              = blen - alen-        b' | d == 0    = b-           | otherwise = Text barr (boff+d) alen-{-# INLINE isSuffixOf #-}---- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns--- 'True' iff the first is contained, wholly and intact, anywhere--- within the second.------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-isInfixOf :: Text -> Text -> Bool-isInfixOf needle haystack-    | null needle        = True-    | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack-    | otherwise          = not . L.null . indices needle $ haystack-{-# INLINE [1] isInfixOf #-}--{-# RULES-"TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.-    isInfixOf (singleton n) h = S.elem n (S.stream h)-  #-}------------------------------------------------------------------------------------ * View patterns---- | /O(n)/ Return the suffix of the second string if its prefix--- matches the entire first string.------ Examples:------ >>> stripPrefix "foo" "foobar"--- Just "bar"------ >>> stripPrefix ""    "baz"--- Just "baz"------ >>> stripPrefix "foo" "quux"--- Nothing------ This is particularly useful with the @ViewPatterns@ extension to--- GHC, as follows:------ > {-# LANGUAGE ViewPatterns #-}--- > import Data.Text as T--- >--- > fnordLength :: Text -> Int--- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf--- > fnordLength _                                 = -1-stripPrefix :: Text -> Text -> Maybe Text-stripPrefix p@(Text _arr _off plen) t@(Text arr off len)-    | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)-    | otherwise        = Nothing---- | /O(n)/ Find the longest non-empty common prefix of two strings--- and return it, along with the suffixes of each string at which they--- no longer match.------ If the strings do not have a common prefix or either one is empty,--- this function returns 'Nothing'.------ Examples:------ >>> commonPrefixes "foobar" "fooquux"--- Just ("foo","bar","quux")------ >>> commonPrefixes "veeble" "fetzer"--- Nothing------ >>> commonPrefixes "" "baz"--- Nothing-commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)-commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0-  where-    go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)-             | i > 0     = Just (Text arr0 off0 i,-                                 text arr0 (off0+i) (len0-i),-                                 text arr1 (off1+j) (len1-j))-             | otherwise = Nothing-      where Iter a d0 = iter t0 i-            Iter b d1 = iter t1 j---- | /O(n)/ Return the prefix of the second string if its suffix--- matches the entire first string.------ Examples:------ >>> stripSuffix "bar" "foobar"--- Just "foo"------ >>> stripSuffix ""    "baz"--- Just "baz"------ >>> stripSuffix "foo" "quux"--- Nothing------ This is particularly useful with the @ViewPatterns@ extension to--- GHC, as follows:------ > {-# LANGUAGE ViewPatterns #-}--- > import Data.Text as T--- >--- > quuxLength :: Text -> Int--- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre--- > quuxLength _                                = -1-stripSuffix :: Text -> Text -> Maybe Text-stripSuffix p@(Text _arr _off plen) t@(Text arr off len)-    | p `isSuffixOf` t = Just $! text arr off (len-plen)-    | otherwise        = Nothing---- | Add a list of non-negative numbers.  Errors out on overflow.-sumP :: String -> [Int] -> Int-sumP fun = go 0-  where go !a (x:xs)-            | ax >= 0   = go ax xs-            | otherwise = overflowError fun-          where ax = a + x-        go a  _         = a--emptyError :: String -> a-emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"--overflowError :: String -> a-overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"---- | /O(n)/ Make a distinct copy of the given string, sharing no--- storage with the original string.------ As an example, suppose you read a large string, of which you need--- only a small portion.  If you do not use 'copy', the entire original--- array will be kept alive in memory by the smaller string. Making a--- copy \"breaks the link\" to the original array, allowing it to be--- garbage collected if there are no other live references to it.-copy :: Text -> Text-copy (Text arr off len) = Text (A.run go) 0 len-  where-    go :: ST s (A.MArray s)-    go = do-      marr <- A.new len-      A.copyI marr 0 arr off len-      return marr------------------------------------------------------- NOTE: the named chunk below used by doctest;---       verify the doctests via `doctest -fobject-code Data/Text.hs`---- $setup--- >>> :set -XOverloadedStrings--- >>> import qualified Data.Text as T
− Data/Text/Array.hs 
@@ -1,249 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types,-    RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}-{-# OPTIONS_GHC -fno-warn-unused-matches #-}--- |--- Module      : Data.Text.Array--- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : portable------ Packed, unboxed, heap-resident arrays.  Suitable for performance--- critical use, both in terms of large data quantities and high--- speed.------ This module is intended to be imported @qualified@, to avoid name--- clashes with "Prelude" functions, e.g.------ > import qualified Data.Text.Array as A------ The names in this module resemble those in the 'Data.Array' family--- of modules, but are shorter due to the assumption of qualified--- naming.-module Data.Text.Array-    (-    -- * Types-      Array(Array, aBA)-    , MArray(MArray, maBA)--    -- * Functions-    , copyM-    , copyI-    , empty-    , equal-#if defined(ASSERTS)-    , length-#endif-    , run-    , run2-    , toList-    , unsafeFreeze-    , unsafeIndex-    , new-    , unsafeWrite-    ) where--#if defined(ASSERTS)--- This fugly hack is brought by GHC's apparent reluctance to deal--- with MagicHash and UnboxedTuples when inferring types. Eek!-# define CHECK_BOUNDS(_func_,_len_,_k_) \-if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else-#else-# define CHECK_BOUNDS(_func_,_len_,_k_)-#endif--#include "MachDeps.h"--#if defined(ASSERTS)-import Control.Exception (assert)-#endif-#if MIN_VERSION_base(4,4,0)-import Control.Monad.ST.Unsafe (unsafeIOToST)-#else-import Control.Monad.ST (unsafeIOToST)-#endif-import Data.Bits ((.&.), xor)-import Data.Text.Internal.Unsafe (inlinePerformIO)-import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)-#if MIN_VERSION_base(4,5,0)-import Foreign.C.Types (CInt(CInt), CSize(CSize))-#else-import Foreign.C.Types (CInt, CSize)-#endif-import GHC.Base (ByteArray#, MutableByteArray#, Int(..),-                 indexWord16Array#, newByteArray#,-                 unsafeFreezeByteArray#, writeWord16Array#)-import GHC.ST (ST(..), runST)-import GHC.Word (Word16(..))-import Prelude hiding (length, read)---- | Immutable array type.------ The 'Array' constructor is exposed since @text-1.1.1.3@-data Array = Array {-      aBA :: ByteArray#-#if defined(ASSERTS)-    , aLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)-#endif-    }---- | Mutable array type, for use in the ST monad.------ The 'MArray' constructor is exposed since @text-1.1.1.3@-data MArray s = MArray {-      maBA :: MutableByteArray# s-#if defined(ASSERTS)-    , maLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)-#endif-    }--#if defined(ASSERTS)--- | Operations supported by all arrays.-class IArray a where-    -- | Return the length of an array.-    length :: a -> Int--instance IArray Array where-    length = aLen-    {-# INLINE length #-}--instance IArray (MArray s) where-    length = maLen-    {-# INLINE length #-}-#endif---- | Create an uninitialized mutable array.-new :: forall s. Int -> ST s (MArray s)-new n-  | n < 0 || n .&. highBit /= 0 = array_size_error-  | otherwise = ST $ \s1# ->-       case newByteArray# len# s1# of-         (# s2#, marr# #) -> (# s2#, MArray marr#-#if defined(ASSERTS)-                                n-#endif-                                #)-  where !(I# len#) = bytesInArray n-        highBit    = maxBound `xor` (maxBound `shiftR` 1)-{-# INLINE new #-}--array_size_error :: a-array_size_error = error "Data.Text.Array.new: size overflow"---- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!-unsafeFreeze :: MArray s -> ST s Array-unsafeFreeze MArray{..} = ST $ \s1# ->-    case unsafeFreezeByteArray# maBA s1# of-        (# s2#, ba# #) -> (# s2#, Array ba#-#if defined(ASSERTS)-                             maLen-#endif-                             #)-{-# INLINE unsafeFreeze #-}---- | Indicate how many bytes would be used for an array of the given--- size.-bytesInArray :: Int -> Int-bytesInArray n = n `shiftL` 1-{-# INLINE bytesInArray #-}---- | Unchecked read of an immutable array.  May return garbage or--- crash on an out-of-bounds access.-unsafeIndex :: Array -> Int -> Word16-unsafeIndex Array{..} i@(I# i#) =-  CHECK_BOUNDS("unsafeIndex",aLen,i)-    case indexWord16Array# aBA i# of r# -> (W16# r#)-{-# INLINE unsafeIndex #-}---- | Unchecked write of a mutable array.  May return garbage or crash--- on an out-of-bounds access.-unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()-unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->-  CHECK_BOUNDS("unsafeWrite",maLen,i)-  case writeWord16Array# maBA i# e# s1# of-    s2# -> (# s2#, () #)-{-# INLINE unsafeWrite #-}---- | Convert an immutable array to a list.-toList :: Array -> Int -> Int -> [Word16]-toList ary off len = loop 0-    where loop i | i < len   = unsafeIndex ary (off+i) : loop (i+1)-                 | otherwise = []---- | An empty immutable array.-empty :: Array-empty = runST (new 0 >>= unsafeFreeze)---- | Run an action in the ST monad and return an immutable array of--- its result.-run :: (forall s. ST s (MArray s)) -> Array-run k = runST (k >>= unsafeFreeze)---- | Run an action in the ST monad and return an immutable array of--- its result paired with whatever else the action returns.-run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)-run2 k = runST (do-                 (marr,b) <- k-                 arr <- unsafeFreeze marr-                 return (arr,b))-{-# INLINE run2 #-}---- | Copy some elements of a mutable array.-copyM :: MArray s               -- ^ Destination-      -> Int                    -- ^ Destination offset-      -> MArray s               -- ^ Source-      -> Int                    -- ^ Source offset-      -> Int                    -- ^ Count-      -> ST s ()-copyM dest didx src sidx count-    | count <= 0 = return ()-    | otherwise =-#if defined(ASSERTS)-    assert (sidx + count <= length src) .-    assert (didx + count <= length dest) .-#endif-    unsafeIOToST $ memcpyM (maBA dest) (fromIntegral didx)-                           (maBA src) (fromIntegral sidx)-                           (fromIntegral count)-{-# INLINE copyM #-}---- | Copy some elements of an immutable array.-copyI :: MArray s               -- ^ Destination-      -> Int                    -- ^ Destination offset-      -> Array                  -- ^ Source-      -> Int                    -- ^ Source offset-      -> Int                    -- ^ First offset in destination /not/ to-                                -- copy (i.e. /not/ length)-      -> ST s ()-copyI dest i0 src j0 top-    | i0 >= top = return ()-    | otherwise = unsafeIOToST $-                  memcpyI (maBA dest) (fromIntegral i0)-                          (aBA src) (fromIntegral j0)-                          (fromIntegral (top-i0))-{-# INLINE copyI #-}---- | Compare portions of two arrays for equality.  No bounds checking--- is performed.-equal :: Array                  -- ^ First-      -> Int                    -- ^ Offset into first-      -> Array                  -- ^ Second-      -> Int                    -- ^ Offset into second-      -> Int                    -- ^ Count-      -> Bool-equal arrA offA arrB offB count = inlinePerformIO $ do-  i <- memcmp (aBA arrA) (fromIntegral offA)-                     (aBA arrB) (fromIntegral offB) (fromIntegral count)-  return $! i == 0-{-# INLINE equal #-}--foreign import ccall unsafe "_hs_text_memcpy" memcpyI-    :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()--foreign import ccall unsafe "_hs_text_memcmp" memcmp-    :: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt--foreign import ccall unsafe "_hs_text_memcpy" memcpyM-    :: MutableByteArray# s -> CSize -> MutableByteArray# s -> CSize -> CSize-    -> IO ()
− Data/Text/Encoding.hs 
@@ -1,535 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash,-    UnliftedFFITypes #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--- |--- Module      : Data.Text.Encoding--- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan,---               (c) 2009 Duncan Coutts,---               (c) 2008, 2009 Tom Harper------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : portable------ Functions for converting 'Text' values to and from 'ByteString',--- using several standard encodings.------ To gain access to a much larger family of encodings, use the--- <http://hackage.haskell.org/package/text-icu text-icu package>.--module Data.Text.Encoding-    (-    -- * Decoding ByteStrings to Text-    -- $strict-      decodeASCII-    , decodeLatin1-    , decodeUtf8-    , decodeUtf16LE-    , decodeUtf16BE-    , decodeUtf32LE-    , decodeUtf32BE--    -- ** Catchable failure-    , decodeUtf8'--    -- ** Controllable error handling-    , decodeUtf8With-    , decodeUtf16LEWith-    , decodeUtf16BEWith-    , decodeUtf32LEWith-    , decodeUtf32BEWith--    -- ** Stream oriented decoding-    -- $stream-    , streamDecodeUtf8-    , streamDecodeUtf8With-    , Decoding(..)--    -- * Encoding Text to ByteStrings-    , encodeUtf8-    , encodeUtf16LE-    , encodeUtf16BE-    , encodeUtf32LE-    , encodeUtf32BE--    -- * Encoding Text using ByteString Builders-    , encodeUtf8Builder-    , encodeUtf8BuilderEscaped-    ) where--#if MIN_VERSION_base(4,4,0)-import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)-#else-import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)-#endif--import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall))-import Control.Monad.ST (runST)-import Data.Bits ((.&.))-import Data.ByteString as B-import Data.ByteString.Internal as B hiding (c2w)-import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)-import Data.Text.Internal (Text(..), safe, text)-import Data.Text.Internal.Private (runText)-import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)-import Data.Text.Internal.Unsafe.Shift (shiftR)-import Data.Text.Show ()-import Data.Text.Unsafe (unsafeDupablePerformIO)-import Data.Word (Word8, Word32)-#if MIN_VERSION_base(4,5,0)-import Foreign.C.Types (CSize(CSize))-#else-import Foreign.C.Types (CSize)-#endif-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Marshal.Utils (with)-import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)-import Foreign.Storable (Storable, peek, poke)-import GHC.Base (ByteArray#, MutableByteArray#)-import qualified Data.ByteString.Builder as B-import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)-import qualified Data.ByteString.Builder.Prim as BP-import qualified Data.ByteString.Builder.Prim.Internal as BP-import qualified Data.Text.Array as A-import qualified Data.Text.Internal.Encoding.Fusion as E-import qualified Data.Text.Internal.Encoding.Utf16 as U16-import qualified Data.Text.Internal.Fusion as F--#include "text_cbits.h"---- $strict------ All of the single-parameter functions for decoding bytestrings--- encoded in one of the Unicode Transformation Formats (UTF) operate--- in a /strict/ mode: each will throw an exception if given invalid--- input.------ Each function has a variant, whose name is suffixed with -'With',--- that gives greater control over the handling of decoding errors.--- For instance, 'decodeUtf8' will throw an exception, but--- 'decodeUtf8With' allows the programmer to determine what to do on a--- decoding error.---- | /Deprecated/.  Decode a 'ByteString' containing 7-bit ASCII--- encoded text.-decodeASCII :: ByteString -> Text-decodeASCII = decodeUtf8-{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}---- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.------ 'decodeLatin1' is semantically equivalent to---  @Data.Text.pack . Data.ByteString.Char8.unpack@-decodeLatin1 :: ByteString -> Text-decodeLatin1 (PS fp off len) = text a 0 len- where-  a = A.run (A.new len >>= unsafeIOToST . go)-  go dest = withForeignPtr fp $ \ptr -> do-    c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))-    return dest---- | Decode a 'ByteString' containing UTF-8 encoded text.------ __NOTE__: The replacement character returned by 'OnDecodeError'--- MUST be within the BMP plane; surrogate code points will--- automatically be remapped to the replacement char @U+FFFD@--- (/since 0.11.3.0/), whereas code points beyond the BMP will throw an--- 'error' (/since 1.2.3.1/); For earlier versions of @text@ using--- those unsupported code points would result in undefined behavior.-decodeUtf8With :: OnDecodeError -> ByteString -> Text-decodeUtf8With onErr (PS fp off len) = runText $ \done -> do-  let go dest = withForeignPtr fp $ \ptr ->-        with (0::CSize) $ \destOffPtr -> do-          let end = ptr `plusPtr` (off + len)-              loop curPtr = do-                curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end-                if curPtr' == end-                  then do-                    n <- peek destOffPtr-                    unsafeSTToIO (done dest (fromIntegral n))-                  else do-                    x <- peek curPtr'-                    case onErr desc (Just x) of-                      Nothing -> loop $ curPtr' `plusPtr` 1-                      Just c-                        | c > '\xFFFF' -> throwUnsupportedReplChar-                        | otherwise -> do-                            destOff <- peek destOffPtr-                            w <- unsafeSTToIO $-                                 unsafeWrite dest (fromIntegral destOff)-                                             (safe c)-                            poke destOffPtr (destOff + fromIntegral w)-                            loop $ curPtr' `plusPtr` 1-          loop (ptr `plusPtr` off)-  (unsafeIOToST . go) =<< A.new len- where-  desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"--  throwUnsupportedReplChar = throwIO $-    ErrorCall "decodeUtf8With: non-BMP replacement characters not supported"-  -- TODO: The code currently assumes that the transcoded UTF-16-  -- stream is at most twice as long (in bytes) as the input UTF-8-  -- stream. To justify this assumption one has to assume that the-  -- error handler replacement character also satisfies this-  -- invariant, by emitting at most one UTF16 code unit.-  ---  -- One easy way to support the full range of code-points for-  -- replacement characters in the error handler is to simply change-  -- the (over-)allocation to `A.new (2*len)` and then shrink back the-  -- `ByteArray#` to the real size (recent GHCs have a cheap-  -- `ByteArray#` resize-primop for that which allow the GC to reclaim-  -- the overallocation). However, this would require 4 times as much-  -- (temporary) storage as the original UTF-8 required.-  ---  -- Another strategy would be to optimistically assume that-  -- replacement characters are within the BMP, and if the case of a-  -- non-BMP replacement occurs reallocate the target buffer (or throw-  -- an exception, and fallback to a pessimistic codepath, like e.g.-  -- `decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)`)-  ---  -- Alternatively, `OnDecodeError` could become a datastructure which-  -- statically encodes the replacement-character range,-  -- e.g. something isomorphic to-  ---  --   Either (... -> Maybe Word16) (... -> Maybe Char)-  ---  -- And allow to statically switch between the BMP/non-BMP-  -- replacement-character codepaths. There's multiple ways to address-  -- this with different tradeoffs; but ideally we should optimise for-  -- the optimistic/error-free case.-{- INLINE[0] decodeUtf8With #-}---- $stream------ The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept--- a 'ByteString' that represents a possibly incomplete input (e.g. a--- packet from a network stream) that may not end on a UTF-8 boundary.------ 1. The maximal prefix of 'Text' that could be decoded from the---    given input.------ 2. The suffix of the 'ByteString' that could not be decoded due to---    insufficient input.------ 3. A function that accepts another 'ByteString'.  That string will---    be assumed to directly follow the string that was passed as---    input to the original function, and it will in turn be decoded.------ To help understand the use of these functions, consider the Unicode--- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi--- \\xe2\\x98\\x83\"@; the final @\'&#9731;\'@ is encoded as 3 bytes.------ Now suppose that we receive this encoded string as 3 packets that--- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",--- \"\\x83\"]@. We cannot decode the entire Unicode string until we--- have received all three packets, but we would like to make progress--- as we receive each one.------ @--- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"--- ghci> s0--- 'Some' \"hi \" \"\\xe2\" _--- @------ We use the continuation @f0@ to decode our second packet.------ @--- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"--- ghci> s1--- 'Some' \"\" \"\\xe2\\x98\"--- @------ We could not give @f0@ enough input to decode anything, so it--- returned an empty string. Once we feed our second continuation @f1@--- the last byte of input, it will make progress.------ @--- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"--- ghci> s2--- 'Some' \"\\x2603\" \"\" _--- @------ If given invalid input, an exception will be thrown by the function--- or continuation where it is encountered.---- | A stream oriented decoding result.------ @since 1.0.0.0-data Decoding = Some Text ByteString (ByteString -> Decoding)--instance Show Decoding where-    showsPrec d (Some t bs _) = showParen (d > prec) $-                                showString "Some " . showsPrec prec' t .-                                showChar ' ' . showsPrec prec' bs .-                                showString " _"-      where prec = 10; prec' = prec + 1--newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)-newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)---- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8--- encoded text that is known to be valid.------ If the input contains any invalid UTF-8 data, an exception will be--- thrown (either by this function or a continuation) that cannot be--- caught in pure code.  For more control over the handling of invalid--- data, use 'streamDecodeUtf8With'.------ @since 1.0.0.0-streamDecodeUtf8 :: ByteString -> Decoding-streamDecodeUtf8 = streamDecodeUtf8With strictDecode---- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8--- encoded text.------ @since 1.0.0.0-streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding-streamDecodeUtf8With onErr = decodeChunk B.empty 0 0- where-  -- We create a slightly larger than necessary buffer to accommodate a-  -- potential surrogate pair started in the last buffer-  decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString-              -> Decoding-  decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =-    runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)-   where-    decodeChunkToBuffer :: A.MArray s -> IO Decoding-    decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->-      with (0::CSize) $ \destOffPtr ->-      with codepoint0 $ \codepointPtr ->-      with state0 $ \statePtr ->-      with nullPtr $ \curPtrPtr ->-        let end = ptr `plusPtr` (off + len)-            loop curPtr = do-              poke curPtrPtr curPtr-              curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr-                         curPtrPtr end codepointPtr statePtr-              state <- peek statePtr-              case state of-                UTF8_REJECT -> do-                  -- We encountered an encoding error-                  x <- peek curPtr'-                  poke statePtr 0-                  case onErr desc (Just x) of-                    Nothing -> loop $ curPtr' `plusPtr` 1-                    Just c -> do-                      destOff <- peek destOffPtr-                      w <- unsafeSTToIO $-                           unsafeWrite dest (fromIntegral destOff) (safe c)-                      poke destOffPtr (destOff + fromIntegral w)-                      loop $ curPtr' `plusPtr` 1--                _ -> do-                  -- We encountered the end of the buffer while decoding-                  n <- peek destOffPtr-                  codepoint <- peek codepointPtr-                  chunkText <- unsafeSTToIO $ do-                      arr <- A.unsafeFreeze dest-                      return $! text arr 0 (fromIntegral n)-                  lastPtr <- peek curPtrPtr-                  let left = lastPtr `minusPtr` curPtr-                      !undecoded = case state of-                        UTF8_ACCEPT -> B.empty-                        _           -> B.append undecoded0 (B.drop left bs)-                  return $ Some chunkText undecoded-                           (decodeChunk undecoded codepoint state)-        in loop (ptr `plusPtr` off)-  desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"---- | Decode a 'ByteString' containing UTF-8 encoded text that is known--- to be valid.------ If the input contains any invalid UTF-8 data, an exception will be--- thrown that cannot be caught in pure code.  For more control over--- the handling of invalid data, use 'decodeUtf8'' or--- 'decodeUtf8With'.-decodeUtf8 :: ByteString -> Text-decodeUtf8 = decodeUtf8With strictDecode-{-# INLINE[0] decodeUtf8 #-}-{-# RULES "STREAM stream/decodeUtf8 fusion" [1]-    forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}---- | Decode a 'ByteString' containing UTF-8 encoded text.------ If the input contains any invalid UTF-8 data, the relevant--- exception will be returned, otherwise the decoded text.-decodeUtf8' :: ByteString -> Either UnicodeException Text-decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode-{-# INLINE decodeUtf8' #-}---- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.------ @since 1.1.0.0-encodeUtf8Builder :: Text -> B.Builder-encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)---- | Encode text using UTF-8 encoding and escape the ASCII characters using--- a 'BP.BoundedPrim'.------ Use this function is to implement efficient encoders for text-based formats--- like JSON or HTML.------ @since 1.1.0.0-{-# INLINE encodeUtf8BuilderEscaped #-}--- TODO: Extend documentation with references to source code in @blaze-html@--- or @aeson@ that uses this function.-encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder-encodeUtf8BuilderEscaped be =-    -- manual eta-expansion to ensure inlining works as expected-    \txt -> B.builder (mkBuildstep txt)-  where-    bound = max 4 $ BP.sizeBound be--    mkBuildstep (Text arr off len) !k =-        outerLoop off-      where-        iend = off + len--        outerLoop !i0 !br@(B.BufferRange op0 ope)-          | i0 >= iend       = k br-          | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)-          -- TODO: Use a loop with an integrated bound's check if outRemaining-          -- is smaller than 8, as this will save on divisions.-          | otherwise        = return $ B.bufferFull bound op0 (outerLoop i0)-          where-            outRemaining = (ope `minusPtr` op0) `div` bound-            inpRemaining = iend - i0--            goPartial !iendTmp = go i0 op0-              where-                go !i !op-                  | i < iendTmp = case A.unsafeIndex arr i of-                      w | w <= 0x7F -> do-                            BP.runB be (fromIntegral w) op >>= go (i + 1)-                        | w <= 0x7FF -> do-                            poke8 0 $ (w `shiftR` 6) + 0xC0-                            poke8 1 $ (w .&. 0x3f) + 0x80-                            go (i + 1) (op `plusPtr` 2)-                        | 0xD800 <= w && w <= 0xDBFF -> do-                            let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))-                            poke8 0 $ (c `shiftR` 18) + 0xF0-                            poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80-                            poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80-                            poke8 3 $ (c .&. 0x3F) + 0x80-                            go (i + 2) (op `plusPtr` 4)-                        | otherwise -> do-                            poke8 0 $ (w `shiftR` 12) + 0xE0-                            poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80-                            poke8 2 $ (w .&. 0x3F) + 0x80-                            go (i + 1) (op `plusPtr` 3)-                  | otherwise =-                      outerLoop i (B.BufferRange op ope)-                  where-                    poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)---- | Encode text using UTF-8 encoding.-encodeUtf8 :: Text -> ByteString-encodeUtf8 (Text arr off len)-  | len == 0  = B.empty-  | otherwise = unsafeDupablePerformIO $ do-  fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough-  withForeignPtr fp $ \ptr ->-    with ptr $ \destPtr -> do-      c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)-      newDest <- peek destPtr-      let utf8len = newDest `minusPtr` ptr-      if utf8len >= len `shiftR` 1-        then return (PS fp 0 utf8len)-        else do-          fp' <- mallocByteString utf8len-          withForeignPtr fp' $ \ptr' -> do-            memcpy ptr' ptr (fromIntegral utf8len)-            return (PS fp' 0 utf8len)---- | Decode text from little endian UTF-16 encoding.-decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text-decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)-{-# INLINE decodeUtf16LEWith #-}---- | Decode text from little endian UTF-16 encoding.------ If the input contains any invalid little endian UTF-16 data, an--- exception will be thrown.  For more control over the handling of--- invalid data, use 'decodeUtf16LEWith'.-decodeUtf16LE :: ByteString -> Text-decodeUtf16LE = decodeUtf16LEWith strictDecode-{-# INLINE decodeUtf16LE #-}---- | Decode text from big endian UTF-16 encoding.-decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text-decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)-{-# INLINE decodeUtf16BEWith #-}---- | Decode text from big endian UTF-16 encoding.------ If the input contains any invalid big endian UTF-16 data, an--- exception will be thrown.  For more control over the handling of--- invalid data, use 'decodeUtf16BEWith'.-decodeUtf16BE :: ByteString -> Text-decodeUtf16BE = decodeUtf16BEWith strictDecode-{-# INLINE decodeUtf16BE #-}---- | Encode text using little endian UTF-16 encoding.-encodeUtf16LE :: Text -> ByteString-encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))-{-# INLINE encodeUtf16LE #-}---- | Encode text using big endian UTF-16 encoding.-encodeUtf16BE :: Text -> ByteString-encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))-{-# INLINE encodeUtf16BE #-}---- | Decode text from little endian UTF-32 encoding.-decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text-decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)-{-# INLINE decodeUtf32LEWith #-}---- | Decode text from little endian UTF-32 encoding.------ If the input contains any invalid little endian UTF-32 data, an--- exception will be thrown.  For more control over the handling of--- invalid data, use 'decodeUtf32LEWith'.-decodeUtf32LE :: ByteString -> Text-decodeUtf32LE = decodeUtf32LEWith strictDecode-{-# INLINE decodeUtf32LE #-}---- | Decode text from big endian UTF-32 encoding.-decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text-decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)-{-# INLINE decodeUtf32BEWith #-}---- | Decode text from big endian UTF-32 encoding.------ If the input contains any invalid big endian UTF-32 data, an--- exception will be thrown.  For more control over the handling of--- invalid data, use 'decodeUtf32BEWith'.-decodeUtf32BE :: ByteString -> Text-decodeUtf32BE = decodeUtf32BEWith strictDecode-{-# INLINE decodeUtf32BE #-}---- | Encode text using little endian UTF-32 encoding.-encodeUtf32LE :: Text -> ByteString-encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))-{-# INLINE encodeUtf32LE #-}---- | Encode text using big endian UTF-32 encoding.-encodeUtf32BE :: Text -> ByteString-encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))-{-# INLINE encodeUtf32BE #-}--foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8-    :: MutableByteArray# s -> Ptr CSize-    -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state-    :: MutableByteArray# s -> Ptr CSize-    -> Ptr (Ptr Word8) -> Ptr Word8-    -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)--foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1-    :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()--foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8-    :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
− Data/Text/Encoding/Error.hs 
@@ -1,124 +0,0 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}-#if __GLASGOW_HASKELL__ >= 704-{-# LANGUAGE Safe #-}-#elif __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--- |--- Module      : Data.Text.Encoding.Error--- Copyright   : (c) Bryan O'Sullivan 2009------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : GHC------ Types and functions for dealing with encoding and decoding errors--- in Unicode text.------ The standard functions for encoding and decoding text are strict,--- which is to say that they throw exceptions on invalid input.  This--- is often unhelpful on real world input, so alternative functions--- exist that accept custom handlers for dealing with invalid inputs.--- These 'OnError' handlers are normal Haskell functions.  You can use--- one of the presupplied functions in this module, or you can write a--- custom handler of your own.--module Data.Text.Encoding.Error-    (-    -- * Error handling types-      UnicodeException(..)-    , OnError-    , OnDecodeError-    , OnEncodeError-    -- * Useful error handling functions-    , lenientDecode-    , strictDecode-    , strictEncode-    , ignore-    , replace-    ) where--import Control.DeepSeq (NFData (..))-import Control.Exception (Exception, throw)-import Data.Typeable (Typeable)-import Data.Word (Word8)-import Numeric (showHex)---- | Function type for handling a coding error.  It is supplied with--- two inputs:------ * A 'String' that describes the error.------ * The input value that caused the error.  If the error arose---   because the end of input was reached or could not be identified---   precisely, this value will be 'Nothing'.------ If the handler returns a value wrapped with 'Just', that value will--- be used in the output as the replacement for the invalid input.  If--- it returns 'Nothing', no value will be used in the output.------ Should the handler need to abort processing, it should use 'error'--- or 'throw' an exception (preferably a 'UnicodeException').  It may--- use the description provided to construct a more helpful error--- report.-type OnError a b = String -> Maybe a -> Maybe b---- | A handler for a decoding error.-type OnDecodeError = OnError Word8 Char---- | A handler for an encoding error.-{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}-type OnEncodeError = OnError Char Word8---- | An exception type for representing Unicode encoding errors.-data UnicodeException =-    DecodeError String (Maybe Word8)-    -- ^ Could not decode a byte sequence because it was invalid under-    -- the given encoding, or ran out of input in mid-decode.-  | EncodeError String (Maybe Char)-    -- ^ Tried to encode a character that could not be represented-    -- under the given encoding, or ran out of input in mid-encode.-    deriving (Eq, Typeable)--{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}--showUnicodeException :: UnicodeException -> String-showUnicodeException (DecodeError desc (Just w))-    = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)-showUnicodeException (DecodeError desc Nothing)-    = "Cannot decode input: " ++ desc-showUnicodeException (EncodeError desc (Just c))-    = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)-showUnicodeException (EncodeError desc Nothing)-    = "Cannot encode input: " ++ desc--instance Show UnicodeException where-    show = showUnicodeException--instance Exception UnicodeException--instance NFData UnicodeException where-    rnf (DecodeError desc w) = rnf desc `seq` rnf w `seq` ()-    rnf (EncodeError desc c) = rnf desc `seq` rnf c `seq` ()---- | Throw a 'UnicodeException' if decoding fails.-strictDecode :: OnDecodeError-strictDecode desc c = throw (DecodeError desc c)---- | Replace an invalid input byte with the Unicode replacement--- character U+FFFD.-lenientDecode :: OnDecodeError-lenientDecode _ _ = Just '\xfffd'---- | Throw a 'UnicodeException' if encoding fails.-{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}-strictEncode :: OnEncodeError-strictEncode desc c = throw (EncodeError desc c)---- | Ignore an invalid input, substituting nothing in the output.-ignore :: OnError a b-ignore _ _ = Nothing---- | Replace an invalid input with a valid output.-replace :: b -> OnError a b-replace c _ _ = Just c
− Data/Text/Foreign.hs 
@@ -1,176 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}--- |--- Module      : Data.Text.Foreign--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : GHC------ Support for using 'Text' data with native code via the Haskell--- foreign function interface.--module Data.Text.Foreign-    (-    -- * Interoperability with native code-    -- $interop-      I16-    -- * Safe conversion functions-    , fromPtr-    , useAsPtr-    , asForeignPtr-    -- ** Encoding as UTF-8-    , peekCStringLen-    , withCStringLen-    -- * Unsafe conversion code-    , lengthWord16-    , unsafeCopyToPtr-    -- * Low-level manipulation-    -- $lowlevel-    , dropWord16-    , takeWord16-    ) where--#if defined(ASSERTS)-import Control.Exception (assert)-#endif-#if MIN_VERSION_base(4,4,0)-import Control.Monad.ST.Unsafe (unsafeIOToST)-#else-import Control.Monad.ST (unsafeIOToST)-#endif-import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)-import Data.Text.Encoding (decodeUtf8, encodeUtf8)-import Data.Text.Internal (Text(..), empty)-import Data.Text.Unsafe (lengthWord16)-import Data.Word (Word16)-import Foreign.C.String (CStringLen)-import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)-import Foreign.Marshal.Alloc (allocaBytes)-import Foreign.Ptr (Ptr, castPtr, plusPtr)-import Foreign.Storable (peek, poke)-import qualified Data.Text.Array as A---- $interop------ The 'Text' type is implemented using arrays that are not guaranteed--- to have a fixed address in the Haskell heap. All communication with--- native code must thus occur by copying data back and forth.------ The 'Text' type's internal representation is UTF-16, using the--- platform's native endianness.  This makes copied data suitable for--- use with native libraries that use a similar representation, such--- as ICU.  To interoperate with native libraries that use different--- internal representations, such as UTF-8 or UTF-32, consider using--- the functions in the 'Data.Text.Encoding' module.---- | A type representing a number of UTF-16 code units.-newtype I16 = I16 Int-    deriving (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show)---- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word16' by copying the--- contents of the array.-fromPtr :: Ptr Word16           -- ^ source array-        -> I16                  -- ^ length of source array (in 'Word16' units)-        -> IO Text-fromPtr _   (I16 0)   = return empty-fromPtr ptr (I16 len) =-#if defined(ASSERTS)-    assert (len > 0) $-#endif-    return $! Text arr 0 len-  where-    arr = A.run (A.new len >>= copy)-    copy marr = loop ptr 0-      where-        loop !p !i | i == len = return marr-                   | otherwise = do-          A.unsafeWrite marr i =<< unsafeIOToST (peek p)-          loop (p `plusPtr` 2) (i + 1)---- $lowlevel------ Foreign functions that use UTF-16 internally may return indices in--- units of 'Word16' instead of characters.  These functions may--- safely be used with such indices, as they will adjust offsets if--- necessary to preserve the validity of a Unicode string.---- | /O(1)/ Return the prefix of the 'Text' of @n@ 'Word16' units in--- length.------ If @n@ would cause the 'Text' to end inside a surrogate pair, the--- end of the prefix will be advanced by one additional 'Word16' unit--- to maintain its validity.-takeWord16 :: I16 -> Text -> Text-takeWord16 (I16 n) t@(Text arr off len)-    | n <= 0               = empty-    | n >= len || m >= len = t-    | otherwise            = Text arr off m-  where-    m | w < 0xD800 || w > 0xDBFF = n-      | otherwise                = n+1-    w = A.unsafeIndex arr (off+n-1)---- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units--- dropped from its beginning.------ If @n@ would cause the 'Text' to begin inside a surrogate pair, the--- beginning of the suffix will be advanced by one additional 'Word16'--- unit to maintain its validity.-dropWord16 :: I16 -> Text -> Text-dropWord16 (I16 n) t@(Text arr off len)-    | n <= 0               = t-    | n >= len || m >= len = empty-    | otherwise            = Text arr (off+m) (len-m)-  where-    m | w < 0xD800 || w > 0xDBFF = n-      | otherwise                = n+1-    w = A.unsafeIndex arr (off+n-1)---- | /O(n)/ Copy a 'Text' to an array.  The array is assumed to be big--- enough to hold the contents of the entire 'Text'.-unsafeCopyToPtr :: Text -> Ptr Word16 -> IO ()-unsafeCopyToPtr (Text arr off len) ptr = loop ptr off-  where-    end = off + len-    loop !p !i | i == end  = return ()-               | otherwise = do-      poke p (A.unsafeIndex arr i)-      loop (p `plusPtr` 2) (i + 1)---- | /O(n)/ Perform an action on a temporary, mutable copy of a--- 'Text'.  The copy is freed as soon as the action returns.-useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a-useAsPtr t@(Text _arr _off len) action =-    allocaBytes (len * 2) $ \buf -> do-      unsafeCopyToPtr t buf-      action (castPtr buf) (fromIntegral len)---- | /O(n)/ Make a mutable copy of a 'Text'.-asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)-asForeignPtr t@(Text _arr _off len) = do-  fp <- mallocForeignPtrArray len-  withForeignPtr fp $ unsafeCopyToPtr t-  return (fp, I16 len)---- | /O(n)/ Decode a C string with explicit length, which is assumed--- to have been encoded as UTF-8. If decoding fails, a--- 'UnicodeException' is thrown.------ @since 1.0.0.0-peekCStringLen :: CStringLen -> IO Text-peekCStringLen cs = do-  bs <- unsafePackCStringLen cs-  return $! decodeUtf8 bs---- | Marshal a 'Text' into a C string encoded as UTF-8 in temporary--- storage, with explicit length information. The encoded string may--- contain NUL bytes, and is not followed by a trailing NUL byte.------ The temporary storage is freed when the subcomputation terminates--- (either normally or via an exception), so the pointer to the--- temporary storage must /not/ be used after this function returns.------ @since 1.0.0.0-withCStringLen :: Text -> (CStringLen -> IO a) -> IO a-withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
− Data/Text/IO.hs 
@@ -1,350 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--- |--- Module      : Data.Text.IO--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,---               (c) 2009 Simon Marlow--- License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : GHC------ Efficient locale-sensitive support for text I\/O.------ Skip past the synopsis for some important notes on performance and--- portability across different versions of GHC.--module Data.Text.IO-    (-    -- * Performance-    -- $performance--    -- * Locale support-    -- $locale-    -- * File-at-a-time operations-      readFile-    , writeFile-    , appendFile-    -- * Operations on handles-    , hGetContents-    , hGetChunk-    , hGetLine-    , hPutStr-    , hPutStrLn-    -- * Special cases for standard input and output-    , interact-    , getContents-    , getLine-    , putStr-    , putStrLn-    ) where--import Data.Text (Text)-import Prelude hiding (appendFile, getContents, getLine, interact,-                       putStr, putStrLn, readFile, writeFile)-import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,-                  withFile)-import qualified Control.Exception as E-import Control.Monad (liftM2, when)-import Data.IORef (readIORef, writeIORef)-import qualified Data.Text as T-import Data.Text.Internal.Fusion (stream)-import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))-import Data.Text.Internal.IO (hGetLineWith, readChunk)-import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,-                      RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,-                      writeCharBuf)-import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))-import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,-                                wantWritableHandle)-import GHC.IO.Handle.Text (commitBuffer')-import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),-                            HandleType(..), Newline(..))-import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)-import System.IO.Error (isEOFError)---- $performance--- #performance#------ The functions in this module obey the runtime system's locale,--- character set encoding, and line ending conversion settings.------ If you know in advance that you will be working with data that has--- a specific encoding (e.g. UTF-8), and your application is highly--- performance sensitive, you may find that it is faster to perform--- I\/O with bytestrings and to encode and decode yourself than to use--- the functions in this module.------ Whether this will hold depends on the version of GHC you are using,--- the platform you are working on, the data you are working with, and--- the encodings you are using, so be sure to test for yourself.---- | The 'readFile' function reads a file and returns the contents of--- the file as a string.  The entire file is read strictly, as with--- 'getContents'.-readFile :: FilePath -> IO Text-readFile name = openFile name ReadMode >>= hGetContents---- | Write a string to a file.  The file is truncated to zero length--- before writing begins.-writeFile :: FilePath -> Text -> IO ()-writeFile p = withFile p WriteMode . flip hPutStr---- | Write a string the end of a file.-appendFile :: FilePath -> Text -> IO ()-appendFile p = withFile p AppendMode . flip hPutStr--catchError :: String -> Handle -> Handle__ -> IOError -> IO (Text, Bool)-catchError caller h Handle__{..} err-    | isEOFError err = do-        buf <- readIORef haCharBuffer-        return $ if isEmptyBuffer buf-                 then (T.empty, True)-                 else (T.singleton '\r', True)-    | otherwise = E.throwIO (augmentIOError err caller h)---- | Wrap readChunk and return a value indicating if we're reached the EOF.--- This is needed because unpack_nl is unable to discern the difference--- between a buffer with just \r due to EOF or because not enough data was left--- for decoding. e.g. the final character decoded from the byte buffer was \r.-readChunkEof :: Handle__ -> CharBuffer -> IO (Text, Bool)-readChunkEof hh buf = do t <- readChunk hh buf-                         return (t, False)---- | /Experimental./ Read a single chunk of strict text from a--- 'Handle'. The size of the chunk depends on the amount of input--- currently buffered.------ This function blocks only if there is no data available, and EOF--- has not yet been reached. Once EOF is reached, this function--- returns an empty string instead of throwing an exception.-hGetChunk :: Handle -> IO Text-hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk- where-  readSingleChunk hh@Handle__{..} = do-    buf <- readIORef haCharBuffer-    (t, _) <- readChunkEof hh buf `E.catch` catchError "hGetChunk" h hh-    return (hh, t)---- | Read the remaining contents of a 'Handle' as a string.  The--- 'Handle' is closed once the contents have been read, or if an--- exception is thrown.------ Internally, this function reads a chunk at a time from the--- lower-level buffering abstraction, and concatenates the chunks into--- a single string once the entire file has been read.------ As a result, it requires approximately twice as much memory as its--- result to construct its result.  For files more than a half of--- available RAM in size, this may result in memory exhaustion.-hGetContents :: Handle -> IO Text-hGetContents h = do-  chooseGoodBuffering h-  wantReadableHandle "hGetContents" h readAll- where-  readAll hh@Handle__{..} = do-    let readChunks = do-          buf <- readIORef haCharBuffer-          (t, eof) <- readChunkEof hh buf-                         `E.catch` catchError "hGetContents" h hh-          if eof-            then return [t]-            else (t:) `fmap` readChunks-    ts <- readChunks-    (hh', _) <- hClose_help hh-    return (hh'{haType=ClosedHandle}, T.concat ts)---- | Use a more efficient buffer size if we're reading in--- block-buffered mode with the default buffer size.  When we can--- determine the size of the handle we're reading, set the buffer size--- to that, so that we can read the entire file in one chunk.--- Otherwise, use a buffer size of at least 16KB.-chooseGoodBuffering :: Handle -> IO ()-chooseGoodBuffering h = do-  bufMode <- hGetBuffering h-  case bufMode of-    BlockBuffering Nothing -> do-      d <- E.catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->-           if ioe_type e == InappropriateType-           then return 16384 -- faster than the 2KB default-           else E.throwIO e-      when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d-    _ -> return ()---- | Read a single line from a handle.-hGetLine :: Handle -> IO Text-hGetLine = hGetLineWith T.concat---- | Write a string to a handle.-hPutStr :: Handle -> Text -> IO ()--- This function is lifted almost verbatim from GHC.IO.Handle.Text.-hPutStr h t = do-  (buffer_mode, nl) <--       wantWritableHandle "hPutStr" h $ \h_ -> do-                     bmode <- getSpareBuffer h_-                     return (bmode, haOutputNL h_)-  let str = stream t-  case buffer_mode of-     (NoBuffering, _)        -> hPutChars h str-     (LineBuffering, buf)    -> writeLines h nl buf str-     (BlockBuffering _, buf)-         | nl == CRLF        -> writeBlocksCRLF h buf str-         | otherwise         -> writeBlocksRaw h buf str--hPutChars :: Handle -> Stream Char -> IO ()-hPutChars h (Stream next0 s0 _len) = loop s0-  where-    loop !s = case next0 s of-                Done       -> return ()-                Skip s'    -> loop s'-                Yield x s' -> hPutChar h x >> loop s'---- The following functions are largely lifted from GHC.IO.Handle.Text,--- but adapted to a coinductive stream of data instead of an inductive--- list.------ We have several variations of more or less the same code for--- performance reasons.  Splitting the original buffered write--- function into line- and block-oriented versions gave us a 2.1x--- performance improvement.  Lifting out the raw/cooked newline--- handling gave a few more percent on top.--writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()-writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0- where-  outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)-   where-    inner !s !n =-      case next0 s of-        Done -> commit n False{-no flush-} True{-release-} >> return ()-        Skip s' -> inner s' n-        Yield x s'-          | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s-          | x == '\n'    -> do-                   n' <- if nl == CRLF-                         then do n1 <- writeCharBuf raw n '\r'-                                 writeCharBuf raw n1 '\n'-                         else writeCharBuf raw n x-                   commit n' True{-needs flush-} False >>= outer s'-          | otherwise    -> writeCharBuf raw n x >>= inner s'-    commit = commitBuffer h raw len--writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()-writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0- where-  outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)-   where-    inner !s !n =-      case next0 s of-        Done -> commit n False{-no flush-} True{-release-} >> return ()-        Skip s' -> inner s' n-        Yield x s'-          | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s-          | x == '\n'    -> do n1 <- writeCharBuf raw n '\r'-                               writeCharBuf raw n1 '\n' >>= inner s'-          | otherwise    -> writeCharBuf raw n x >>= inner s'-    commit = commitBuffer h raw len--writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()-writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0- where-  outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)-   where-    inner !s !n =-      case next0 s of-        Done -> commit n False{-no flush-} True{-release-} >> return ()-        Skip s' -> inner s' n-        Yield x s'-          | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s-          | otherwise    -> writeCharBuf raw n x >>= inner s'-    commit = commitBuffer h raw len---- This function is completely lifted from GHC.IO.Handle.Text.-getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)-getSpareBuffer Handle__{haCharBuffer=ref,-                        haBuffers=spare_ref,-                        haBufferMode=mode}- = do-   case mode of-     NoBuffering -> return (mode, error "no buffer!")-     _ -> do-          bufs <- readIORef spare_ref-          buf  <- readIORef ref-          case bufs of-            BufferListCons b rest -> do-                writeIORef spare_ref rest-                return ( mode, emptyBuffer b (bufSize buf) WriteBuffer)-            BufferListNil -> do-                new_buf <- newCharBuffer (bufSize buf) WriteBuffer-                return (mode, new_buf)----- This function is completely lifted from GHC.IO.Handle.Text.-commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool-             -> IO CharBuffer-commitBuffer hdl !raw !sz !count flush release =-  wantWritableHandle "commitAndReleaseBuffer" hdl $-     commitBuffer' raw sz count flush release-{-# INLINE commitBuffer #-}---- | Write a string to a handle, followed by a newline.-hPutStrLn :: Handle -> Text -> IO ()-hPutStrLn h t = hPutStr h t >> hPutChar h '\n'---- | The 'interact' function takes a function of type @Text -> Text@--- as its argument. The entire input from the standard input device is--- passed to this function as its argument, and the resulting string--- is output on the standard output device.-interact :: (Text -> Text) -> IO ()-interact f = putStr . f =<< getContents---- | Read all user input on 'stdin' as a single string.-getContents :: IO Text-getContents = hGetContents stdin---- | Read a single line of user input from 'stdin'.-getLine :: IO Text-getLine = hGetLine stdin---- | Write a string to 'stdout'.-putStr :: Text -> IO ()-putStr = hPutStr stdout---- | Write a string to 'stdout', followed by a newline.-putStrLn :: Text -> IO ()-putStrLn = hPutStrLn stdout---- $locale------ /Note/: The behaviour of functions in this module depends on the--- version of GHC you are using.------ Beginning with GHC 6.12, text I\/O is performed using the system or--- handle's current locale and line ending conventions.------ Under GHC 6.10 and earlier, the system I\/O libraries do not--- support locale-sensitive I\/O or line ending conversion.  On these--- versions of GHC, functions in this library all use UTF-8.  What--- does this mean in practice?------ * All data that is read will be decoded as UTF-8.------ * Before data is written, it is first encoded as UTF-8.------ * On both reading and writing, the platform's native newline---   conversion is performed.------ If you must use a non-UTF-8 locale on an older version of GHC, you--- will have to perform the transcoding yourself, e.g. as follows:------ > import qualified Data.ByteString as B--- > import Data.Text (Text)--- > import Data.Text.Encoding (encodeUtf16)--- >--- > putStr_Utf16LE :: Text -> IO ()--- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)------ On transcoding errors, an 'IOError' exception is thrown. You can--- use the API in "Data.Text.Encoding" if you need more control over--- error handling or transcoding.
− Data/Text/Internal.hs 
@@ -1,188 +0,0 @@-{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}-{-# OPTIONS_HADDOCK not-home #-}---- |--- Module      : Data.Text.Internal--- Copyright   : (c) 2008, 2009 Tom Harper,---               (c) 2009, 2010 Bryan O'Sullivan,---               (c) 2009 Duncan Coutts------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ A module containing private 'Text' internals. This exposes the--- 'Text' representation and low level construction functions.--- Modules which extend the 'Text' system may need to use this module.------ You should not use this module unless you are determined to monkey--- with the internals, as the functions here do just about nothing to--- preserve data invariants.  You have been warned!--#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)-#include "MachDeps.h"-#endif--module Data.Text.Internal-    (-    -- * Types-    -- $internals-      Text(..)-    -- * Construction-    , text-    , textP-    -- * Safety-    , safe-    -- * Code that must be here for accessibility-    , empty-    , empty_-    -- * Utilities-    , firstf-    -- * Checked multiplication-    , mul-    , mul32-    , mul64-    -- * Debugging-    , showText-    ) where--#if defined(ASSERTS)-import Control.Exception (assert)-#endif-import Data.Bits-import Data.Int (Int32, Int64)-import Data.Text.Internal.Unsafe.Char (ord)-import Data.Typeable (Typeable)-import qualified Data.Text.Array as A---- | A space efficient, packed, unboxed Unicode text type.-data Text = Text-    {-# UNPACK #-} !A.Array          -- payload (Word16 elements)-    {-# UNPACK #-} !Int              -- offset (units of Word16, not Char)-    {-# UNPACK #-} !Int              -- length (units of Word16, not Char)-    deriving (Typeable)---- | Smart constructor.-text_ :: A.Array -> Int -> Int -> Text-text_ arr off len =-#if defined(ASSERTS)-  let c    = A.unsafeIndex arr off-      alen = A.length arr-  in assert (len >= 0) .-     assert (off >= 0) .-     assert (alen == 0 || len == 0 || off < alen) .-     assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $-#endif-     Text arr off len-{-# INLINE text_ #-}---- | /O(1)/ The empty 'Text'.-empty :: Text-empty = Text A.empty 0 0-{-# INLINE [1] empty #-}---- | A non-inlined version of 'empty'.-empty_ :: Text-empty_ = Text A.empty 0 0-{-# NOINLINE empty_ #-}---- | Construct a 'Text' without invisibly pinning its byte array in--- memory if its length has dwindled to zero.-text :: A.Array -> Int -> Int -> Text-text arr off len | len == 0  = empty-                 | otherwise = text_ arr off len-{-# INLINE text #-}--textP :: A.Array -> Int -> Int -> Text-{-# DEPRECATED textP "Use text instead" #-}-textP = text---- | A useful 'show'-like function for debugging purposes.-showText :: Text -> String-showText (Text arr off len) =-    "Text " ++ show (A.toList arr off len) ++ ' ' :-            show off ++ ' ' : show len---- | Map a 'Char' to a 'Text'-safe value.------ UTF-16 surrogate code points are not included in the set of Unicode--- scalar values, but are unfortunately admitted as valid 'Char'--- values by Haskell.  They cannot be represented in a 'Text'.  This--- function remaps those code points to the Unicode replacement--- character (U+FFFD, \'&#xfffd;\'), and leaves other code points--- unchanged.-safe :: Char -> Char-safe c-    | ord c .&. 0x1ff800 /= 0xd800 = c-    | otherwise                    = '\xfffd'-{-# INLINE [0] safe #-}---- | Apply a function to the first element of an optional pair.-firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)-firstf f (Just (a, b)) = Just (f a, b)-firstf _  Nothing      = Nothing---- | Checked multiplication.  Calls 'error' if the result would--- overflow.-mul :: Int -> Int -> Int-#if WORD_SIZE_IN_BITS == 64-mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b-#else-mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b-#endif-{-# INLINE mul #-}-infixl 7 `mul`---- | Checked multiplication.  Calls 'error' if the result would--- overflow.-mul64 :: Int64 -> Int64 -> Int64-mul64 a b-  | a >= 0 && b >= 0 =  mul64_ a b-  | a >= 0           = -mul64_ a (-b)-  | b >= 0           = -mul64_ (-a) b-  | otherwise        =  mul64_ (-a) (-b)-{-# INLINE mul64 #-}-infixl 7 `mul64`--mul64_ :: Int64 -> Int64 -> Int64-mul64_ a b-  | ahi > 0 && bhi > 0 = error "overflow"-  | top > 0x7fffffff   = error "overflow"-  | total < 0          = error "overflow"-  | otherwise          = total-  where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)-        (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)-        top            = ahi * blo + alo * bhi-        total          = (top `shiftL` 32) + alo * blo-{-# INLINE mul64_ #-}---- | Checked multiplication.  Calls 'error' if the result would--- overflow.-mul32 :: Int32 -> Int32 -> Int32-mul32 a b = case fromIntegral a * fromIntegral b of-              ab | ab < min32 || ab > max32 -> error "overflow"-                 | otherwise                -> fromIntegral ab-  where min32 = -0x80000000 :: Int64-        max32 =  0x7fffffff-{-# INLINE mul32 #-}-infixl 7 `mul32`---- $internals------ Internally, the 'Text' type is represented as an array of 'Word16'--- UTF-16 code units. The offset and length fields in the constructor--- are in these units, /not/ units of 'Char'.------ Invariants that all functions must maintain:------ * Since the 'Text' type uses UTF-16 internally, it cannot represent---   characters in the reserved surrogate code point range U+D800 to---   U+DFFF. To maintain this invariant, the 'safe' function maps---   'Char' values in this range to the replacement character (U+FFFD,---   \'&#xfffd;\').------ * A leading (or \"high\") surrogate code unit (0xD800–0xDBFF) must---   always be followed by a trailing (or \"low\") surrogate code unit---   (0xDC00-0xDFFF). A trailing surrogate code unit must always be---   preceded by a leading surrogate code unit.
− Data/Text/Internal/Builder.hs 
@@ -1,329 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}-{-# OPTIONS_HADDOCK not-home #-}---------------------------------------------------------------------------------- |--- Module      : Data.Text.Internal.Builder--- Copyright   : (c) 2013 Bryan O'Sullivan---               (c) 2010 Johan Tibell--- License     : BSD-style (see LICENSE)------ Maintainer  : Johan Tibell <johan.tibell@gmail.com>--- Stability   : experimental--- Portability : portable to Hugs and GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Efficient construction of lazy @Text@ values.  The principal--- operations on a @Builder@ are @singleton@, @fromText@, and--- @fromLazyText@, which construct new builders, and 'mappend', which--- concatenates two builders.------ To get maximum performance when building lazy @Text@ values using a--- builder, associate @mappend@ calls to the right.  For example,--- prefer------ > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')------ to------ > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'------ as the latter associates @mappend@ to the left.-----------------------------------------------------------------------------------module Data.Text.Internal.Builder-   ( -- * Public API-     -- ** The Builder type-     Builder-   , toLazyText-   , toLazyTextWith--     -- ** Constructing Builders-   , singleton-   , fromText-   , fromLazyText-   , fromString--     -- ** Flushing the buffer state-   , flush--     -- * Internal functions-   , append'-   , ensureFree-   , writeN-   ) where--import Control.Monad.ST (ST, runST)-import Data.Monoid (Monoid(..))-#if !MIN_VERSION_base(4,11,0) && MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup(..))-#endif-import Data.Text.Internal (Text(..))-import Data.Text.Internal.Lazy (smallChunkSize)-import Data.Text.Unsafe (inlineInterleaveST)-import Data.Text.Internal.Unsafe.Char (unsafeWrite)-import Prelude hiding (map, putChar)--import qualified Data.String as String-import qualified Data.Text as S-import qualified Data.Text.Array as A-import qualified Data.Text.Lazy as L------------------------------------------------------------------------------ | A @Builder@ is an efficient way to build lazy @Text@ values.--- There are several functions for constructing builders, but only one--- to inspect them: to extract any data, you have to turn them into--- lazy @Text@ values using @toLazyText@.------ Internally, a builder constructs a lazy @Text@ by filling arrays--- piece by piece.  As each buffer is filled, it is \'popped\' off, to--- become a new chunk of the resulting lazy @Text@.  All this is--- hidden from the user of the @Builder@.-newtype Builder = Builder {-     -- Invariant (from Data.Text.Lazy):-     --      The lists include no null Texts.-     runBuilder :: forall s. (Buffer s -> ST s [S.Text])-                -> Buffer s-                -> ST s [S.Text]-   }--#if MIN_VERSION_base(4,9,0)-instance Semigroup Builder where-   (<>) = append-   {-# INLINE (<>) #-}-#endif--instance Monoid Builder where-   mempty  = empty-   {-# INLINE mempty #-}-#if MIN_VERSION_base(4,9,0)-   mappend = (<>) -- future-proof definition-#else-   mappend = append-#endif-   {-# INLINE mappend #-}-   mconcat = foldr mappend Data.Monoid.mempty-   {-# INLINE mconcat #-}--instance String.IsString Builder where-    fromString = fromString-    {-# INLINE fromString #-}--instance Show Builder where-    show = show . toLazyText--instance Eq Builder where-    a == b = toLazyText a == toLazyText b--instance Ord Builder where-    a <= b = toLazyText a <= toLazyText b------------------------------------------------------------------------------ | /O(1)./ The empty @Builder@, satisfying------  * @'toLazyText' 'empty' = 'L.empty'@----empty :: Builder-empty = Builder (\ k buf -> k buf)-{-# INLINE empty #-}---- | /O(1)./ A @Builder@ taking a single character, satisfying------  * @'toLazyText' ('singleton' c) = 'L.singleton' c@----singleton :: Char -> Builder-singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c-{-# INLINE singleton #-}------------------------------------------------------------------------------ | /O(1)./ The concatenation of two builders, an associative--- operation with identity 'empty', satisfying------  * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@----append :: Builder -> Builder -> Builder-append (Builder f) (Builder g) = Builder (f . g)-{-# INLINE [0] append #-}---- TODO: Experiment to find the right threshold.-copyLimit :: Int-copyLimit = 128---- This function attempts to merge small @Text@ values instead of--- treating each value as its own chunk.  We may not always want this.---- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying------  * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@----fromText :: S.Text -> Builder-fromText t@(Text arr off l)-    | S.null t       = empty-    | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)-    | otherwise      = flush `append` mapBuilder (t :)-{-# INLINE [1] fromText #-}--{-# RULES-"fromText/pack" forall s .-        fromText (S.pack s) = fromString s- #-}---- | /O(1)./ A Builder taking a @String@, satisfying------  * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@----fromString :: String -> Builder-fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->-    let loop !marr !o !u !l [] = k (Buffer marr o u l)-        loop marr o u l s@(c:cs)-            | l <= 1 = do-                arr <- A.unsafeFreeze marr-                let !t = Text arr o u-                marr' <- A.new chunkSize-                ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)-                return $ t : ts-            | otherwise = do-                n <- unsafeWrite marr (o+u) c-                loop marr o (u+n) (l-n) cs-    in loop p0 o0 u0 l0 str-  where-    chunkSize = smallChunkSize-{-# INLINE fromString #-}---- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying------  * @'toLazyText' ('fromLazyText' t) = t@----fromLazyText :: L.Text -> Builder-fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)-{-# INLINE fromLazyText #-}------------------------------------------------------------------------------ Our internal buffer type-data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)-                       {-# UNPACK #-} !Int  -- offset-                       {-# UNPACK #-} !Int  -- used units-                       {-# UNPACK #-} !Int  -- length left------------------------------------------------------------------------------ | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default--- buffer size.  The construction work takes place if and when the--- relevant part of the lazy @Text@ is demanded.-toLazyText :: Builder -> L.Text-toLazyText = toLazyTextWith smallChunkSize---- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given--- size for the initial buffer.  The construction work takes place if--- and when the relevant part of the lazy @Text@ is demanded.------ If the initial buffer is too small to hold all data, subsequent--- buffers will be the default buffer size.-toLazyTextWith :: Int -> Builder -> L.Text-toLazyTextWith chunkSize m = L.fromChunks (runST $-  newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))---- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,--- yielding a new chunk in the result lazy @Text@.-flush :: Builder-flush = Builder $ \ k buf@(Buffer p o u l) ->-    if u == 0-    then k buf-    else do arr <- A.unsafeFreeze p-            let !b = Buffer p (o+u) 0 l-                !t = Text arr o u-            ts <- inlineInterleaveST (k b)-            return $! t : ts-{-# INLINE [1] flush #-}--- defer inlining so that flush/flush rule may fire.------------------------------------------------------------------------------ | Sequence an ST operation on the buffer-withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder-withBuffer f = Builder $ \k buf -> f buf >>= k-{-# INLINE withBuffer #-}---- | Get the size of the buffer-withSize :: (Int -> Builder) -> Builder-withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->-    runBuilder (f l) k buf-{-# INLINE withSize #-}---- | Map the resulting list of texts.-mapBuilder :: ([S.Text] -> [S.Text]) -> Builder-mapBuilder f = Builder (fmap f .)------------------------------------------------------------------------------ | Ensure that there are at least @n@ many elements available.-ensureFree :: Int -> Builder-ensureFree !n = withSize $ \ l ->-    if n <= l-    then empty-    else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))-{-# INLINE [0] ensureFree #-}--writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder-writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)-{-# INLINE [0] writeAtMost #-}---- | Ensure that @n@ many elements are available, and then use @f@ to--- write some elements into the memory.-writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder-writeN n f = writeAtMost n (\ p o -> f p o >> return n)-{-# INLINE writeN #-}--writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)-writeBuffer f (Buffer p o u l) = do-    n <- f p (o+u)-    return $! Buffer p o (u+n) (l-n)-{-# INLINE writeBuffer #-}--newBuffer :: Int -> ST s (Buffer s)-newBuffer size = do-    arr <- A.new size-    return $! Buffer arr 0 0 size-{-# INLINE newBuffer #-}----------------------------------------------------------------------------- Some nice rules for Builder---- This function makes GHC understand that 'writeN' and 'ensureFree'--- are *not* recursive in the precense of the rewrite rules below.--- This is not needed with GHC 7+.-append' :: Builder -> Builder -> Builder-append' (Builder f) (Builder g) = Builder (f . g)-{-# INLINE append' #-}--{-# RULES--"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)-                           (g::forall s. A.MArray s -> Int -> ST s Int) ws.-    append (writeAtMost a f) (append (writeAtMost b g) ws) =-        append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->-                                    g marr (o+n) >>= \ m ->-                                    let s = n+m in s `seq` return s)) ws--"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)-                           (g::forall s. A.MArray s -> Int -> ST s Int).-    append (writeAtMost a f) (writeAtMost b g) =-        writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->-                            g marr (o+n) >>= \ m ->-                            let s = n+m in s `seq` return s)--"ensureFree/ensureFree" forall a b .-    append (ensureFree a) (ensureFree b) = ensureFree (max a b)--"flush/flush"-    append flush flush = flush-- #-}
− Data/Text/Internal/Builder/Functions.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE MagicHash #-}---- |--- Module      : Data.Text.Internal.Builder.Functions--- Copyright   : (c) 2011 MailRank, Inc.------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Useful functions and combinators.--module Data.Text.Internal.Builder.Functions-    (-      (<>)-    , i2d-    ) where--import Data.Monoid (mappend)-import Data.Text.Lazy.Builder (Builder)-import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))-import Prelude ()---- | Unsafe conversion for decimal digits.-{-# INLINE i2d #-}-i2d :: Int -> Char-i2d (I# i#) = C# (chr# (ord# '0'# +# i#))---- | The normal 'mappend' function with right associativity instead of--- left.-(<>) :: Builder -> Builder -> Builder-(<>) = mappend-{-# INLINE (<>) #-}--infixr 4 <>
− Data/Text/Internal/Builder/Int/Digits.hs 
@@ -1,26 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- Module:      Data.Text.Internal.Builder.Int.Digits--- Copyright:   (c) 2013 Bryan O'Sullivan--- License:     BSD-style--- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>--- Stability:   experimental--- Portability: portable------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ This module exists because the C preprocessor does things that we--- shall not speak of when confronted with Haskell multiline strings.--module Data.Text.Internal.Builder.Int.Digits (digits) where--import Data.ByteString.Char8 (ByteString)--digits :: ByteString-digits = "0001020304050607080910111213141516171819\-         \2021222324252627282930313233343536373839\-         \4041424344454647484950515253545556575859\-         \6061626364656667686970717273747576777879\-         \8081828384858687888990919293949596979899"
− Data/Text/Internal/Builder/RealFloat/Functions.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE CPP #-}---- |--- Module:    Data.Text.Internal.Builder.RealFloat.Functions--- Copyright: (c) The University of Glasgow 1994-2002--- License:   see libraries/base/LICENSE------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!--module Data.Text.Internal.Builder.RealFloat.Functions-    (-      roundTo-    ) where--roundTo :: Int -> [Int] -> (Int,[Int])--#if MIN_VERSION_base(4,6,0)--roundTo d is =-  case f d True is of-    x@(0,_) -> x-    (1,xs)  -> (1, 1:xs)-    _       -> error "roundTo: bad Value"- where-  b2 = base `quot` 2--  f n _ []     = (0, replicate n 0)-  f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, [])   -- Round to even when at exactly half the base-               | otherwise = (if x >= b2 then 1 else 0, [])-  f n _ (i:xs)-     | i' == base = (1,0:ds)-     | otherwise  = (0,i':ds)-      where-       (c,ds) = f (n-1) (even i) xs-       i'     = c + i-  base = 10--#else--roundTo d is =-  case f d is of-    x@(0,_) -> x-    (1,xs)  -> (1, 1:xs)-    _       -> error "roundTo: bad Value"- where-  f n []     = (0, replicate n 0)-  f 0 (x:_)  = (if x >= 5 then 1 else 0, [])-  f n (i:xs)-     | i' == 10  = (1,0:ds)-     | otherwise = (0,i':ds)-      where-       (c,ds) = f (n-1) xs-       i'     = c + i--#endif
− Data/Text/Internal/Encoding/Fusion.hs 
@@ -1,208 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}---- |--- Module      : Data.Text.Internal.Encoding.Fusion--- Copyright   : (c) Tom Harper 2008-2009,---               (c) Bryan O'Sullivan 2009,---               (c) Duncan Coutts 2009------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Fusible 'Stream'-oriented functions for converting between 'Text'--- and several common encodings.--module Data.Text.Internal.Encoding.Fusion-    (-    -- * Streaming-      streamASCII-    , streamUtf8-    , streamUtf16LE-    , streamUtf16BE-    , streamUtf32LE-    , streamUtf32BE--    -- * Unstreaming-    , unstream--    , module Data.Text.Internal.Encoding.Fusion.Common-    ) where--#if defined(ASSERTS)-import Control.Exception (assert)-#endif-import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)-import Data.Text.Internal.Fusion (Step(..), Stream(..))-import Data.Text.Internal.Fusion.Size-import Data.Text.Encoding.Error-import Data.Text.Internal.Encoding.Fusion.Common-import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)-import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)-import Data.Word (Word8, Word16, Word32)-import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)-import Foreign.Storable (pokeByteOff)-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import qualified Data.Text.Internal.Encoding.Utf8 as U8-import qualified Data.Text.Internal.Encoding.Utf16 as U16-import qualified Data.Text.Internal.Encoding.Utf32 as U32-import Data.Text.Unsafe (unsafeDupablePerformIO)--streamASCII :: ByteString -> Stream Char-streamASCII bs = Stream next 0 (maxSize l)-    where-      l = B.length bs-      {-# INLINE next #-}-      next i-          | i >= l    = Done-          | otherwise = Yield (unsafeChr8 x1) (i+1)-          where-            x1 = B.unsafeIndex bs i-{-# DEPRECATED streamASCII "Do not use this function" #-}-{-# INLINE [0] streamASCII #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8--- encoding.-streamUtf8 :: OnDecodeError -> ByteString -> Stream Char-streamUtf8 onErr bs = Stream next 0 (maxSize l)-    where-      l = B.length bs-      next i-          | i >= l = Done-          | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)-          | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)-          | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)-          | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)-          | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)-          where-            x1 = idx i-            x2 = idx (i + 1)-            x3 = idx (i + 2)-            x4 = idx (i + 3)-            idx = B.unsafeIndex bs-{-# INLINE [0] streamUtf8 #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little--- endian UTF-16 encoding.-streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char-streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))-    where-      l = B.length bs-      {-# INLINE next #-}-      next i-          | i >= l                         = Done-          | i+1 < l && U16.validate1 x1    = Yield (unsafeChr x1) (i+2)-          | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)-          | otherwise = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (i+1)-          where-            x1    = idx i       + (idx (i + 1) `shiftL` 8)-            x2    = idx (i + 2) + (idx (i + 3) `shiftL` 8)-            idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16-{-# INLINE [0] streamUtf16LE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big--- endian UTF-16 encoding.-streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char-streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))-    where-      l = B.length bs-      {-# INLINE next #-}-      next i-          | i >= l                         = Done-          | i+1 < l && U16.validate1 x1    = Yield (unsafeChr x1) (i+2)-          | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)-          | otherwise = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing (i+1)-          where-            x1    = (idx i `shiftL` 8)       + idx (i + 1)-            x2    = (idx (i + 2) `shiftL` 8) + idx (i + 3)-            idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16-{-# INLINE [0] streamUtf16BE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big--- endian UTF-32 encoding.-streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char-streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))-    where-      l = B.length bs-      {-# INLINE next #-}-      next i-          | i >= l                    = Done-          | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)-          | otherwise = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing (i+1)-          where-            x     = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4-            x1    = idx i-            x2    = idx (i+1)-            x3    = idx (i+2)-            x4    = idx (i+3)-            idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32-{-# INLINE [0] streamUtf32BE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little--- endian UTF-32 encoding.-streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char-streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))-    where-      l = B.length bs-      {-# INLINE next #-}-      next i-          | i >= l                    = Done-          | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)-          | otherwise = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing (i+1)-          where-            x     = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1-            x1    = idx i-            x2    = idx $ i+1-            x3    = idx $ i+2-            x4    = idx $ i+3-            idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32-{-# INLINE [0] streamUtf32LE #-}---- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.-unstream :: Stream Word8 -> ByteString-unstream (Stream next s0 len) = unsafeDupablePerformIO $ do-    let mlen = upperBound 4 len-    mallocByteString mlen >>= loop mlen 0 s0-    where-      loop !n !off !s fp = case next s of-          Done -> trimUp fp n off-          Skip s' -> loop n off s' fp-          Yield x s'-              | off == n -> realloc fp n off s' x-              | otherwise -> do-            withForeignPtr fp $ \p -> pokeByteOff p off x-            loop n (off+1) s' fp-      {-# NOINLINE realloc #-}-      realloc fp n off s x = do-        let n' = n+n-        fp' <- copy0 fp n n'-        withForeignPtr fp' $ \p -> pokeByteOff p off x-        loop n' (off+1) s fp'-      {-# NOINLINE trimUp #-}-      trimUp fp _ off = return $! PS fp 0 off-      copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)-      copy0 !src !srcLen !destLen =-#if defined(ASSERTS)-        assert (srcLen <= destLen) $-#endif-        do-          dest <- mallocByteString destLen-          withForeignPtr src  $ \src'  ->-              withForeignPtr dest $ \dest' ->-                  memcpy dest' src' (fromIntegral srcLen)-          return dest--decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8-            -> s -> Step s Char-decodeError func kind onErr mb i =-    case onErr desc mb of-      Nothing -> Skip i-      Just c  -> Yield c i-    where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++-                 kind ++ " stream"
− Data/Text/Internal/Encoding/Fusion/Common.hs 
@@ -1,123 +0,0 @@-{-# LANGUAGE BangPatterns #-}---- |--- Module      : Data.Text.Internal.Encoding.Fusion.Common--- Copyright   : (c) Tom Harper 2008-2009,---               (c) Bryan O'Sullivan 2009,---               (c) Duncan Coutts 2009,---               (c) Jasper Van der Jeugt 2011------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ /Warning/: this is an internal module, and does not have a stable--- API or name. Use at your own risk!------ Fusible 'Stream'-oriented functions for converting between 'Text'--- and several common encodings.--module Data.Text.Internal.Encoding.Fusion.Common-    (-    -- * Restreaming-    -- Restreaming is the act of converting from one 'Stream'-    -- representation to another.-      restreamUtf16LE-    , restreamUtf16BE-    , restreamUtf32LE-    , restreamUtf32BE-    ) where--import Data.Bits ((.&.))-import Data.Text.Internal.Fusion (Step(..), Stream(..))-import Data.Text.Internal.Fusion.Types (RS(..))-import Data.Text.Internal.Unsafe.Char (ord)-import Data.Text.Internal.Unsafe.Shift (shiftR)-import Data.Word (Word8)--restreamUtf16BE :: Stream Char -> Stream Word8-restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)-  where-    next (RS0 s) = case next0 s of-        Done -> Done-        Skip s' -> Skip (RS0 s')-        Yield x s'-            | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $-                             RS1 s' (fromIntegral n)-            | otherwise   -> Yield c1 $ RS3 s' c2 c3 c4-            where-              n  = ord x-              n1 = n - 0x10000-              c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)-              c2 = fromIntegral (n1 `shiftR` 10)-              n2 = n1 .&. 0x3FF-              c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)-              c4 = fromIntegral n2-    next (RS1 s x2)       = Yield x2 (RS0 s)-    next (RS2 s x2 x3)    = Yield x2 (RS1 s x3)-    next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)-    {-# INLINE next #-}-{-# INLINE restreamUtf16BE #-}--restreamUtf16LE :: Stream Char -> Stream Word8-restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)-  where-    next (RS0 s) = case next0 s of-        Done -> Done-        Skip s' -> Skip (RS0 s')-        Yield x s'-            | n < 0x10000 -> Yield (fromIntegral n) $-                             RS1 s' (fromIntegral $ shiftR n 8)-            | otherwise   -> Yield c1 $ RS3 s' c2 c3 c4-          where-            n  = ord x-            n1 = n - 0x10000-            c2 = fromIntegral (shiftR n1 18 + 0xD8)-            c1 = fromIntegral (shiftR n1 10)-            n2 = n1 .&. 0x3FF-            c4 = fromIntegral (shiftR n2 8 + 0xDC)-            c3 = fromIntegral n2-    next (RS1 s x2)       = Yield x2 (RS0 s)-    next (RS2 s x2 x3)    = Yield x2 (RS1 s x3)-    next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)-    {-# INLINE next #-}-{-# INLINE restreamUtf16LE #-}--restreamUtf32BE :: Stream Char -> Stream Word8-restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)-  where-    next (RS0 s) = case next0 s of-        Done       -> Done-        Skip s'    -> Skip (RS0 s')-        Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)-          where-            n  = ord x-            c1 = fromIntegral $ shiftR n 24-            c2 = fromIntegral $ shiftR n 16-            c3 = fromIntegral $ shiftR n 8-            c4 = fromIntegral n-    next (RS1 s x2)       = Yield x2 (RS0 s)-    next (RS2 s x2 x3)    = Yield x2 (RS1 s x3)-    next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)-    {-# INLINE next #-}-{-# INLINE restreamUtf32BE #-}--restreamUtf32LE :: Stream Char -> Stream Word8-restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)-  where-    next (RS0 s) = case next0 s of-        Done       -> Done-        Skip s'    -> Skip (RS0 s')-        Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)-          where-            n  = ord x-            c4 = fromIntegral $ shiftR n 24-            c3 = fromIntegral $ shiftR n 16-            c2 = fromIntegral $ shiftR n 8-            c1 = fromIntegral n-    next (RS1 s x2)       = Yield x2 (RS0 s)-    next (RS2 s x2 x3)    = Yield x2 (RS1 s x3)-    next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)-    {-# INLINE next #-}-{-# INLINE restreamUtf32LE #-}
− Data/Text/Internal/Encoding/Utf16.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE MagicHash, BangPatterns #-}---- |--- Module      : Data.Text.Internal.Encoding.Utf16--- Copyright   : (c) 2008, 2009 Tom Harper,---               (c) 2009 Bryan O'Sullivan,---               (c) 2009 Duncan Coutts------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Basic UTF-16 validation and character manipulation.-module Data.Text.Internal.Encoding.Utf16-    (-      chr2-    , validate1-    , validate2-    ) where--import GHC.Exts-import GHC.Word (Word16(..))--chr2 :: Word16 -> Word16 -> Char-chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))-    where-      !x# = word2Int# a#-      !y# = word2Int# b#-      !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#-      !lower# = y# -# 0xDC00#-{-# INLINE chr2 #-}--validate1    :: Word16 -> Bool-validate1 x1 = x1 < 0xD800 || x1 > 0xDFFF-{-# INLINE validate1 #-}--validate2       ::  Word16 -> Word16 -> Bool-validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&-                  x2 >= 0xDC00 && x2 <= 0xDFFF-{-# INLINE validate2 #-}
− Data/Text/Internal/Encoding/Utf32.hs 
@@ -1,26 +0,0 @@--- |--- Module      : Data.Text.Internal.Encoding.Utf32--- Copyright   : (c) 2008, 2009 Tom Harper,---               (c) 2009, 2010 Bryan O'Sullivan,---               (c) 2009 Duncan Coutts------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Basic UTF-32 validation.-module Data.Text.Internal.Encoding.Utf32-    (-      validate-    ) where--import Data.Word (Word32)--validate    :: Word32 -> Bool-validate x1 = x1 < 0xD800 || (x1 > 0xDFFF && x1 <= 0x10FFFF)-{-# INLINE validate #-}
− Data/Text/Internal/Encoding/Utf8.hs 
@@ -1,168 +0,0 @@-{-# LANGUAGE CPP, MagicHash, BangPatterns #-}---- |--- Module      : Data.Text.Internal.Encoding.Utf8--- Copyright   : (c) 2008, 2009 Tom Harper,---               (c) 2009, 2010 Bryan O'Sullivan,---               (c) 2009 Duncan Coutts------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Basic UTF-8 validation and character manipulation.-module Data.Text.Internal.Encoding.Utf8-    (-    -- Decomposition-      ord2-    , ord3-    , ord4-    -- Construction-    , chr2-    , chr3-    , chr4-    -- * Validation-    , validate1-    , validate2-    , validate3-    , validate4-    ) where--#if defined(TEST_SUITE)-# undef ASSERTS-#endif--#if defined(ASSERTS)-import Control.Exception (assert)-#endif-import Data.Bits ((.&.))-import Data.Text.Internal.Unsafe.Char (ord)-import Data.Text.Internal.Unsafe.Shift (shiftR)-import GHC.Exts-import GHC.Word (Word8(..))--default(Int)--between :: Word8                -- ^ byte to check-        -> Word8                -- ^ lower bound-        -> Word8                -- ^ upper bound-        -> Bool-between x y z = x >= y && x <= z-{-# INLINE between #-}--ord2 :: Char -> (Word8,Word8)-ord2 c =-#if defined(ASSERTS)-    assert (n >= 0x80 && n <= 0x07ff)-#endif-    (x1,x2)-    where-      n  = ord c-      x1 = fromIntegral $ (n `shiftR` 6) + 0xC0-      x2 = fromIntegral $ (n .&. 0x3F)   + 0x80--ord3 :: Char -> (Word8,Word8,Word8)-ord3 c =-#if defined(ASSERTS)-    assert (n >= 0x0800 && n <= 0xffff)-#endif-    (x1,x2,x3)-    where-      n  = ord c-      x1 = fromIntegral $ (n `shiftR` 12) + 0xE0-      x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80-      x3 = fromIntegral $ (n .&. 0x3F) + 0x80--ord4 :: Char -> (Word8,Word8,Word8,Word8)-ord4 c =-#if defined(ASSERTS)-    assert (n >= 0x10000)-#endif-    (x1,x2,x3,x4)-    where-      n  = ord c-      x1 = fromIntegral $ (n `shiftR` 18) + 0xF0-      x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80-      x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80-      x4 = fromIntegral $ (n .&. 0x3F) + 0x80--chr2 :: Word8 -> Word8 -> Char-chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))-    where-      !y1# = word2Int# x1#-      !y2# = word2Int# x2#-      !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#-      !z2# = y2# -# 0x80#-{-# INLINE chr2 #-}--chr3 :: Word8 -> Word8 -> Word8 -> Char-chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))-    where-      !y1# = word2Int# x1#-      !y2# = word2Int# x2#-      !y3# = word2Int# x3#-      !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#-      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#-      !z3# = y3# -# 0x80#-{-# INLINE chr3 #-}--chr4             :: Word8 -> Word8 -> Word8 -> Word8 -> Char-chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =-    C# (chr# (z1# +# z2# +# z3# +# z4#))-    where-      !y1# = word2Int# x1#-      !y2# = word2Int# x2#-      !y3# = word2Int# x3#-      !y4# = word2Int# x4#-      !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#-      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#-      !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#-      !z4# = y4# -# 0x80#-{-# INLINE chr4 #-}--validate1 :: Word8 -> Bool-validate1 x1 = x1 <= 0x7F-{-# INLINE validate1 #-}--validate2 :: Word8 -> Word8 -> Bool-validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF-{-# INLINE validate2 #-}--validate3 :: Word8 -> Word8 -> Word8 -> Bool-{-# INLINE validate3 #-}-validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4-  where-    validate3_1 = (x1 == 0xE0) &&-                  between x2 0xA0 0xBF &&-                  between x3 0x80 0xBF-    validate3_2 = between x1 0xE1 0xEC &&-                  between x2 0x80 0xBF &&-                  between x3 0x80 0xBF-    validate3_3 = x1 == 0xED &&-                  between x2 0x80 0x9F &&-                  between x3 0x80 0xBF-    validate3_4 = between x1 0xEE 0xEF &&-                  between x2 0x80 0xBF &&-                  between x3 0x80 0xBF--validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool-{-# INLINE validate4 #-}-validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3-  where-    validate4_1 = x1 == 0xF0 &&-                  between x2 0x90 0xBF &&-                  between x3 0x80 0xBF &&-                  between x4 0x80 0xBF-    validate4_2 = between x1 0xF1 0xF3 &&-                  between x2 0x80 0xBF &&-                  between x3 0x80 0xBF &&-                  between x4 0x80 0xBF-    validate4_3 = x1 == 0xF4 &&-                  between x2 0x80 0x8F &&-                  between x3 0x80 0xBF &&-                  between x4 0x80 0xBF
− Data/Text/Internal/Functions.hs 
@@ -1,29 +0,0 @@--- |--- Module      : Data.Text.Internal.Functions--- Copyright   : 2010 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Useful functions.--module Data.Text.Internal.Functions-    (-      intersperse-    ) where---- | A lazier version of Data.List.intersperse.  The other version--- causes space leaks!-intersperse :: a -> [a] -> [a]-intersperse _   []     = []-intersperse sep (x:xs) = x : go xs-  where-    go []     = []-    go (y:ys) = sep : y: go ys-{-# INLINE intersperse #-}
− Data/Text/Internal/Fusion.hs 
@@ -1,244 +0,0 @@-{-# LANGUAGE BangPatterns, MagicHash #-}---- |--- Module      : Data.Text.Internal.Fusion--- Copyright   : (c) Tom Harper 2008-2009,---               (c) Bryan O'Sullivan 2009-2010,---               (c) Duncan Coutts 2009------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Text manipulation functions represented as fusible operations over--- streams.-module Data.Text.Internal.Fusion-    (-    -- * Types-      Stream(..)-    , Step(..)--    -- * Creation and elimination-    , stream-    , unstream-    , reverseStream--    , length--    -- * Transformations-    , reverse--    -- * Construction-    -- ** Scans-    , reverseScanr--    -- ** Accumulating maps-    , mapAccumL--    -- ** Generation and unfolding-    , unfoldrN--    -- * Indexing-    , index-    , findIndex-    , countChar-    ) where--import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,-                Num(..), Ord(..), ($), (&&),-                fromIntegral, otherwise)-import Data.Bits ((.&.))-import Data.Text.Internal (Text(..))-import Data.Text.Internal.Private (runText)-import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)-import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)-import qualified Data.Text.Array as A-import qualified Data.Text.Internal.Fusion.Common as S-import Data.Text.Internal.Fusion.Types-import Data.Text.Internal.Fusion.Size-import qualified Data.Text.Internal as I-import qualified Data.Text.Internal.Encoding.Utf16 as U16--default(Int)---- | /O(n)/ Convert a 'Text' into a 'Stream Char'.-stream :: Text -> Stream Char-stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)-    where-      !end = off+len-      next !i-          | i >= end                   = Done-          | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)-          | otherwise                  = Yield (unsafeChr n) (i + 1)-          where-            n  = A.unsafeIndex arr i-            n2 = A.unsafeIndex arr (i + 1)-{-# INLINE [0] stream #-}---- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate--- backwards.-reverseStream :: Text -> Stream Char-reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)-    where-      {-# INLINE next #-}-      next !i-          | i < off                    = Done-          | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)-          | otherwise                  = Yield (unsafeChr n) (i - 1)-          where-            n  = A.unsafeIndex arr i-            n2 = A.unsafeIndex arr (i - 1)-{-# INLINE [0] reverseStream #-}---- | /O(n)/ Convert a 'Stream Char' into a 'Text'.-unstream :: Stream Char -> Text-unstream (Stream next0 s0 len) = runText $ \done -> do-  -- Before encoding each char we perform a buffer realloc check assuming-  -- worst case encoding size of two 16-bit units for the char. Just add an-  -- extra space to the buffer so that we do not end up reallocating even when-  -- all the chars are encoded as single unit.-  let mlen = upperBound 4 len + 1-  arr0 <- A.new mlen-  let outer !arr !maxi = encode-       where-        -- keep the common case loop as small as possible-        encode !si !di =-            case next0 si of-                Done        -> done arr di-                Skip si'    -> encode si' di-                Yield c si'-                    -- simply check for the worst case-                    | maxi < di + 1 -> realloc si di-                    | otherwise -> do-                            n <- unsafeWrite arr di c-                            encode si' (di + n)--        -- keep uncommon case separate from the common case code-        {-# NOINLINE realloc #-}-        realloc !si !di = do-            let newlen = (maxi + 1) * 2-            arr' <- A.new newlen-            A.copyM arr' 0 arr 0 di-            outer arr' (newlen - 1) si di--  outer arr0 (mlen - 1) s0 0-{-# INLINE [0] unstream #-}-{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}----- ------------------------------------------------------------------------------- * Basic stream functions--length :: Stream Char -> Int-length = S.lengthI-{-# INLINE[0] length #-}---- | /O(n)/ Reverse the characters of a string.-reverse :: Stream Char -> Text-reverse (Stream next s len0)-    | isEmpty len0 = I.empty-    | otherwise    = I.text arr off' len'-  where-    len0' = upperBound 4 (larger len0 4)-    (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')-    loop !s0 !i !len marr =-        case next s0 of-          Done -> return (marr, (j, len-j))-              where j = i + 1-          Skip s1    -> loop s1 i len marr-          Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do-                       let newLen = len `shiftL` 1-                       marr' <- A.new newLen-                       A.copyM marr' (newLen-len) marr 0 len-                       write s1 (len+i) newLen marr'-                     | otherwise -> write s1 i len marr-            where n = ord x-                  least | n < 0x10000 = 0-                        | otherwise   = 1-                  m = n - 0x10000-                  lo = fromIntegral $ (m `shiftR` 10) + 0xD800-                  hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00-                  write t j l mar-                      | n < 0x10000 = do-                          A.unsafeWrite mar j (fromIntegral n)-                          loop t (j-1) l mar-                      | otherwise = do-                          A.unsafeWrite mar (j-1) lo-                          A.unsafeWrite mar j hi-                          loop t (j-2) l mar-{-# INLINE [0] reverse #-}---- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with--- the input and result reversed.-reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char-reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low-  where-    {-# INLINE next #-}-    next (Scan1 z s) = Yield z (Scan2 z s)-    next (Scan2 z s) = case next0 s of-                         Yield x s' -> let !x' = f x z-                                       in Yield x' (Scan2 x' s')-                         Skip s'    -> Skip (Scan2 z s')-                         Done       -> Done-{-# INLINE reverseScanr #-}---- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed--- value. However, the length of the result is limited by the--- first argument to 'unfoldrN'. This function is more efficient than--- 'unfoldr' when the length of the result is known.-unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char-unfoldrN n = S.unfoldrNI n-{-# INLINE [0] unfoldrN #-}------------------------------------------------------------------------------------ ** Indexing streams---- | /O(n)/ stream index (subscript) operator, starting from 0.-index :: Stream Char -> Int -> Char-index = S.indexI-{-# INLINE [0] index #-}---- | The 'findIndex' function takes a predicate and a stream and--- returns the index of the first element in the stream--- satisfying the predicate.-findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int-findIndex = S.findIndexI-{-# INLINE [0] findIndex #-}---- | /O(n)/ The 'count' function returns the number of times the query--- element appears in the given stream.-countChar :: Char -> Stream Char -> Int-countChar = S.countCharI-{-# INLINE [0] countChar #-}---- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a--- function to each element of a 'Text', passing an accumulating--- parameter from left to right, and returns a final 'Text'.-mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)-mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)-  where-    (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)-      where mlen = upperBound 4 len-    outer arr top = loop-      where-        loop !z !s !i =-            case next0 s of-              Done          -> return (arr, (z,i))-              Skip s'       -> loop z s' i-              Yield x s'-                | j >= top  -> {-# SCC "mapAccumL/resize" #-} do-                               let top' = (top + 1) `shiftL` 1-                               arr' <- A.new top'-                               A.copyM arr' 0 arr 0 top-                               outer arr' top' z s i-                | otherwise -> do d <- unsafeWrite arr i c-                                  loop z' s' (i+d)-                where (z',c) = f z x-                      j | ord c < 0x10000 = i-                        | otherwise       = i + 1-{-# INLINE [0] mapAccumL #-}
− Data/Text/Internal/Fusion/CaseMapping.hs 
@@ -1,1002 +0,0 @@-{-# LANGUAGE Rank2Types #-}--- AUTOMATICALLY GENERATED - DO NOT EDIT--- Generated by scripts/CaseMapping.hs--- CaseFolding-9.0.0.txt--- Date: 2016-03-02, 18:54:54 GMT--- SpecialCasing-9.0.0.txt--- Date: 2016-03-02, 18:55:13 GMT--module Data.Text.Internal.Fusion.CaseMapping where-import Data.Char-import Data.Text.Internal.Fusion.Types--upperMapping :: forall s. Char -> s -> Step (CC s) Char-{-# NOINLINE upperMapping #-}--- LATIN SMALL LETTER SHARP S-upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')--- LATIN SMALL LIGATURE FF-upperMapping '\xfb00' s = Yield '\x0046' (CC s '\x0046' '\x0000')--- LATIN SMALL LIGATURE FI-upperMapping '\xfb01' s = Yield '\x0046' (CC s '\x0049' '\x0000')--- LATIN SMALL LIGATURE FL-upperMapping '\xfb02' s = Yield '\x0046' (CC s '\x004c' '\x0000')--- LATIN SMALL LIGATURE FFI-upperMapping '\xfb03' s = Yield '\x0046' (CC s '\x0046' '\x0049')--- LATIN SMALL LIGATURE FFL-upperMapping '\xfb04' s = Yield '\x0046' (CC s '\x0046' '\x004c')--- LATIN SMALL LIGATURE LONG S T-upperMapping '\xfb05' s = Yield '\x0053' (CC s '\x0054' '\x0000')--- LATIN SMALL LIGATURE ST-upperMapping '\xfb06' s = Yield '\x0053' (CC s '\x0054' '\x0000')--- ARMENIAN SMALL LIGATURE ECH YIWN-upperMapping '\x0587' s = Yield '\x0535' (CC s '\x0552' '\x0000')--- ARMENIAN SMALL LIGATURE MEN NOW-upperMapping '\xfb13' s = Yield '\x0544' (CC s '\x0546' '\x0000')--- ARMENIAN SMALL LIGATURE MEN ECH-upperMapping '\xfb14' s = Yield '\x0544' (CC s '\x0535' '\x0000')--- ARMENIAN SMALL LIGATURE MEN INI-upperMapping '\xfb15' s = Yield '\x0544' (CC s '\x053b' '\x0000')--- ARMENIAN SMALL LIGATURE VEW NOW-upperMapping '\xfb16' s = Yield '\x054e' (CC s '\x0546' '\x0000')--- ARMENIAN SMALL LIGATURE MEN XEH-upperMapping '\xfb17' s = Yield '\x0544' (CC s '\x053d' '\x0000')--- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE-upperMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS-upperMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS-upperMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')--- LATIN SMALL LETTER J WITH CARON-upperMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')--- LATIN SMALL LETTER H WITH LINE BELOW-upperMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')--- LATIN SMALL LETTER T WITH DIAERESIS-upperMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')--- LATIN SMALL LETTER W WITH RING ABOVE-upperMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER Y WITH RING ABOVE-upperMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER A WITH RIGHT HALF RING-upperMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI-upperMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA-upperMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')--- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA-upperMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')--- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI-upperMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI-upperMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ETA WITH PERISPOMENI-upperMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA-upperMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA-upperMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER IOTA WITH PERISPOMENI-upperMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI-upperMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA-upperMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA-upperMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER RHO WITH PSILI-upperMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PERISPOMENI-upperMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI-upperMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI-upperMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI-upperMapping '\x1f80' s = Yield '\x1f08' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI-upperMapping '\x1f81' s = Yield '\x1f09' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1f82' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1f83' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1f84' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1f85' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1f86' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1f87' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI-upperMapping '\x1f88' s = Yield '\x1f08' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI-upperMapping '\x1f89' s = Yield '\x1f09' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1f8a' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1f8b' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1f8c' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1f8d' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1f8e' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1f8f' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI-upperMapping '\x1f90' s = Yield '\x1f28' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI-upperMapping '\x1f91' s = Yield '\x1f29' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1f92' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1f93' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1f94' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1f95' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1f96' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1f97' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI-upperMapping '\x1f98' s = Yield '\x1f28' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI-upperMapping '\x1f99' s = Yield '\x1f29' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1f9a' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1f9b' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1f9c' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1f9d' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1f9e' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1f9f' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI-upperMapping '\x1fa0' s = Yield '\x1f68' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI-upperMapping '\x1fa1' s = Yield '\x1f69' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1fa2' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI-upperMapping '\x1fa3' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1fa4' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI-upperMapping '\x1fa5' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1fa6' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1fa7' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI-upperMapping '\x1fa8' s = Yield '\x1f68' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI-upperMapping '\x1fa9' s = Yield '\x1f69' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1faa' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI-upperMapping '\x1fab' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1fac' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI-upperMapping '\x1fad' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1fae' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-upperMapping '\x1faf' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI-upperMapping '\x1fb3' s = Yield '\x0391' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI-upperMapping '\x1fbc' s = Yield '\x0391' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI-upperMapping '\x1fc3' s = Yield '\x0397' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI-upperMapping '\x1fcc' s = Yield '\x0397' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI-upperMapping '\x1ff3' s = Yield '\x03a9' (CC s '\x0399' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI-upperMapping '\x1ffc' s = Yield '\x03a9' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI-upperMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI-upperMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI-upperMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI-upperMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI-upperMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI-upperMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0399' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0399')--- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI-upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')-upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')-lowerMapping :: forall s. Char -> s -> Step (CC s) Char-{-# NOINLINE lowerMapping #-}--- LATIN CAPITAL LETTER I WITH DOT ABOVE-lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')-lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')-titleMapping :: forall s. Char -> s -> Step (CC s) Char-{-# NOINLINE titleMapping #-}--- LATIN SMALL LETTER SHARP S-titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')--- LATIN SMALL LIGATURE FF-titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')--- LATIN SMALL LIGATURE FI-titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')--- LATIN SMALL LIGATURE FL-titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')--- LATIN SMALL LIGATURE FFI-titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')--- LATIN SMALL LIGATURE FFL-titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')--- LATIN SMALL LIGATURE LONG S T-titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')--- LATIN SMALL LIGATURE ST-titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')--- ARMENIAN SMALL LIGATURE ECH YIWN-titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')--- ARMENIAN SMALL LIGATURE MEN NOW-titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')--- ARMENIAN SMALL LIGATURE MEN ECH-titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')--- ARMENIAN SMALL LIGATURE MEN INI-titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')--- ARMENIAN SMALL LIGATURE VEW NOW-titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')--- ARMENIAN SMALL LIGATURE MEN XEH-titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')--- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE-titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS-titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS-titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')--- LATIN SMALL LETTER J WITH CARON-titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')--- LATIN SMALL LETTER H WITH LINE BELOW-titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')--- LATIN SMALL LETTER T WITH DIAERESIS-titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')--- LATIN SMALL LETTER W WITH RING ABOVE-titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER Y WITH RING ABOVE-titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER A WITH RIGHT HALF RING-titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI-titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA-titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')--- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA-titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')--- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI-titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI-titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ETA WITH PERISPOMENI-titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA-titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA-titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER IOTA WITH PERISPOMENI-titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI-titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA-titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA-titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER RHO WITH PSILI-titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PERISPOMENI-titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI-titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI-titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI-titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI-titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI-titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI-titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI-titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI-titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI-titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')--- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI-titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI-titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')-titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')-foldMapping :: forall s. Char -> s -> Step (CC s) Char-{-# NOINLINE foldMapping #-}--- MICRO SIGN-foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')--- LATIN SMALL LETTER SHARP S-foldMapping '\x00df' s = Yield '\x0073' (CC s '\x0073' '\x0000')--- LATIN CAPITAL LETTER I WITH DOT ABOVE-foldMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')--- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE-foldMapping '\x0149' s = Yield '\x02bc' (CC s '\x006e' '\x0000')--- LATIN SMALL LETTER LONG S-foldMapping '\x017f' s = Yield '\x0073' (CC s '\x0000' '\x0000')--- LATIN SMALL LETTER J WITH CARON-foldMapping '\x01f0' s = Yield '\x006a' (CC s '\x030c' '\x0000')--- COMBINING GREEK YPOGEGRAMMENI-foldMapping '\x0345' s = Yield '\x03b9' (CC s '\x0000' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS-foldMapping '\x0390' s = Yield '\x03b9' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS-foldMapping '\x03b0' s = Yield '\x03c5' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER FINAL SIGMA-foldMapping '\x03c2' s = Yield '\x03c3' (CC s '\x0000' '\x0000')--- GREEK BETA SYMBOL-foldMapping '\x03d0' s = Yield '\x03b2' (CC s '\x0000' '\x0000')--- GREEK THETA SYMBOL-foldMapping '\x03d1' s = Yield '\x03b8' (CC s '\x0000' '\x0000')--- GREEK PHI SYMBOL-foldMapping '\x03d5' s = Yield '\x03c6' (CC s '\x0000' '\x0000')--- GREEK PI SYMBOL-foldMapping '\x03d6' s = Yield '\x03c0' (CC s '\x0000' '\x0000')--- GREEK KAPPA SYMBOL-foldMapping '\x03f0' s = Yield '\x03ba' (CC s '\x0000' '\x0000')--- GREEK RHO SYMBOL-foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')--- GREEK LUNATE EPSILON SYMBOL-foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')--- ARMENIAN SMALL LIGATURE ECH YIWN-foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')--- CHEROKEE SMALL LETTER YE-foldMapping '\x13f8' s = Yield '\x13f0' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER YI-foldMapping '\x13f9' s = Yield '\x13f1' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER YO-foldMapping '\x13fa' s = Yield '\x13f2' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER YU-foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER YV-foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER MV-foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')--- CYRILLIC SMALL LETTER ROUNDED VE-foldMapping '\x1c80' s = Yield '\x0432' (CC s '\x0000' '\x0000')--- CYRILLIC SMALL LETTER LONG-LEGGED DE-foldMapping '\x1c81' s = Yield '\x0434' (CC s '\x0000' '\x0000')--- CYRILLIC SMALL LETTER NARROW O-foldMapping '\x1c82' s = Yield '\x043e' (CC s '\x0000' '\x0000')--- CYRILLIC SMALL LETTER WIDE ES-foldMapping '\x1c83' s = Yield '\x0441' (CC s '\x0000' '\x0000')--- CYRILLIC SMALL LETTER TALL TE-foldMapping '\x1c84' s = Yield '\x0442' (CC s '\x0000' '\x0000')--- CYRILLIC SMALL LETTER THREE-LEGGED TE-foldMapping '\x1c85' s = Yield '\x0442' (CC s '\x0000' '\x0000')--- CYRILLIC SMALL LETTER TALL HARD SIGN-foldMapping '\x1c86' s = Yield '\x044a' (CC s '\x0000' '\x0000')--- CYRILLIC SMALL LETTER TALL YAT-foldMapping '\x1c87' s = Yield '\x0463' (CC s '\x0000' '\x0000')--- CYRILLIC SMALL LETTER UNBLENDED UK-foldMapping '\x1c88' s = Yield '\xa64b' (CC s '\x0000' '\x0000')--- LATIN SMALL LETTER H WITH LINE BELOW-foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')--- LATIN SMALL LETTER T WITH DIAERESIS-foldMapping '\x1e97' s = Yield '\x0074' (CC s '\x0308' '\x0000')--- LATIN SMALL LETTER W WITH RING ABOVE-foldMapping '\x1e98' s = Yield '\x0077' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER Y WITH RING ABOVE-foldMapping '\x1e99' s = Yield '\x0079' (CC s '\x030a' '\x0000')--- LATIN SMALL LETTER A WITH RIGHT HALF RING-foldMapping '\x1e9a' s = Yield '\x0061' (CC s '\x02be' '\x0000')--- LATIN SMALL LETTER LONG S WITH DOT ABOVE-foldMapping '\x1e9b' s = Yield '\x1e61' (CC s '\x0000' '\x0000')--- LATIN CAPITAL LETTER SHARP S-foldMapping '\x1e9e' s = Yield '\x0073' (CC s '\x0073' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI-foldMapping '\x1f50' s = Yield '\x03c5' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA-foldMapping '\x1f52' s = Yield '\x03c5' (CC s '\x0313' '\x0300')--- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA-foldMapping '\x1f54' s = Yield '\x03c5' (CC s '\x0313' '\x0301')--- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI-foldMapping '\x1f56' s = Yield '\x03c5' (CC s '\x0313' '\x0342')--- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI-foldMapping '\x1f80' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI-foldMapping '\x1f81' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1f82' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1f83' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1f84' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1f85' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1f86' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1f87' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI-foldMapping '\x1f88' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI-foldMapping '\x1f89' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1f8a' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1f8b' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1f8c' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1f8d' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1f8e' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1f8f' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI-foldMapping '\x1f90' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI-foldMapping '\x1f91' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1f92' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1f93' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1f94' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1f95' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1f96' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1f97' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI-foldMapping '\x1f98' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI-foldMapping '\x1f99' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1f9a' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1f9b' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1f9c' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1f9d' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1f9e' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1f9f' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI-foldMapping '\x1fa0' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI-foldMapping '\x1fa1' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1fa2' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI-foldMapping '\x1fa3' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1fa4' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI-foldMapping '\x1fa5' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1fa6' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1fa7' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI-foldMapping '\x1fa8' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI-foldMapping '\x1fa9' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1faa' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI-foldMapping '\x1fab' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1fac' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI-foldMapping '\x1fad' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1fae' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')--- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI-foldMapping '\x1faf' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI-foldMapping '\x1fb2' s = Yield '\x1f70' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI-foldMapping '\x1fb3' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI-foldMapping '\x1fb4' s = Yield '\x03ac' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI-foldMapping '\x1fb6' s = Yield '\x03b1' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1fb7' s = Yield '\x03b1' (CC s '\x0342' '\x03b9')--- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI-foldMapping '\x1fbc' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')--- GREEK PROSGEGRAMMENI-foldMapping '\x1fbe' s = Yield '\x03b9' (CC s '\x0000' '\x0000')--- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI-foldMapping '\x1fc2' s = Yield '\x1f74' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI-foldMapping '\x1fc3' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI-foldMapping '\x1fc4' s = Yield '\x03ae' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER ETA WITH PERISPOMENI-foldMapping '\x1fc6' s = Yield '\x03b7' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1fc7' s = Yield '\x03b7' (CC s '\x0342' '\x03b9')--- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI-foldMapping '\x1fcc' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA-foldMapping '\x1fd2' s = Yield '\x03b9' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA-foldMapping '\x1fd3' s = Yield '\x03b9' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER IOTA WITH PERISPOMENI-foldMapping '\x1fd6' s = Yield '\x03b9' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI-foldMapping '\x1fd7' s = Yield '\x03b9' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA-foldMapping '\x1fe2' s = Yield '\x03c5' (CC s '\x0308' '\x0300')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA-foldMapping '\x1fe3' s = Yield '\x03c5' (CC s '\x0308' '\x0301')--- GREEK SMALL LETTER RHO WITH PSILI-foldMapping '\x1fe4' s = Yield '\x03c1' (CC s '\x0313' '\x0000')--- GREEK SMALL LETTER UPSILON WITH PERISPOMENI-foldMapping '\x1fe6' s = Yield '\x03c5' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI-foldMapping '\x1fe7' s = Yield '\x03c5' (CC s '\x0308' '\x0342')--- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI-foldMapping '\x1ff2' s = Yield '\x1f7c' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI-foldMapping '\x1ff3' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI-foldMapping '\x1ff4' s = Yield '\x03ce' (CC s '\x03b9' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI-foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')--- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI-foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')--- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI-foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')--- LATIN CAPITAL LETTER SMALL CAPITAL I-foldMapping '\xa7ae' s = Yield '\x026a' (CC s '\x0000' '\x0000')--- LATIN CAPITAL LETTER J WITH CROSSED-TAIL-foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')--- LATIN CAPITAL LETTER CHI-foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')--- LATIN CAPITAL LETTER BETA-foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')--- LATIN CAPITAL LETTER OMEGA-foldMapping '\xa7b6' s = Yield '\xa7b7' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER A-foldMapping '\xab70' s = Yield '\x13a0' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER E-foldMapping '\xab71' s = Yield '\x13a1' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER I-foldMapping '\xab72' s = Yield '\x13a2' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER O-foldMapping '\xab73' s = Yield '\x13a3' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER U-foldMapping '\xab74' s = Yield '\x13a4' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER V-foldMapping '\xab75' s = Yield '\x13a5' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER GA-foldMapping '\xab76' s = Yield '\x13a6' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER KA-foldMapping '\xab77' s = Yield '\x13a7' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER GE-foldMapping '\xab78' s = Yield '\x13a8' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER GI-foldMapping '\xab79' s = Yield '\x13a9' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER GO-foldMapping '\xab7a' s = Yield '\x13aa' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER GU-foldMapping '\xab7b' s = Yield '\x13ab' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER GV-foldMapping '\xab7c' s = Yield '\x13ac' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER HA-foldMapping '\xab7d' s = Yield '\x13ad' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER HE-foldMapping '\xab7e' s = Yield '\x13ae' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER HI-foldMapping '\xab7f' s = Yield '\x13af' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER HO-foldMapping '\xab80' s = Yield '\x13b0' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER HU-foldMapping '\xab81' s = Yield '\x13b1' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER HV-foldMapping '\xab82' s = Yield '\x13b2' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER LA-foldMapping '\xab83' s = Yield '\x13b3' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER LE-foldMapping '\xab84' s = Yield '\x13b4' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER LI-foldMapping '\xab85' s = Yield '\x13b5' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER LO-foldMapping '\xab86' s = Yield '\x13b6' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER LU-foldMapping '\xab87' s = Yield '\x13b7' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER LV-foldMapping '\xab88' s = Yield '\x13b8' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER MA-foldMapping '\xab89' s = Yield '\x13b9' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER ME-foldMapping '\xab8a' s = Yield '\x13ba' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER MI-foldMapping '\xab8b' s = Yield '\x13bb' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER MO-foldMapping '\xab8c' s = Yield '\x13bc' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER MU-foldMapping '\xab8d' s = Yield '\x13bd' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER NA-foldMapping '\xab8e' s = Yield '\x13be' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER HNA-foldMapping '\xab8f' s = Yield '\x13bf' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER NAH-foldMapping '\xab90' s = Yield '\x13c0' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER NE-foldMapping '\xab91' s = Yield '\x13c1' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER NI-foldMapping '\xab92' s = Yield '\x13c2' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER NO-foldMapping '\xab93' s = Yield '\x13c3' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER NU-foldMapping '\xab94' s = Yield '\x13c4' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER NV-foldMapping '\xab95' s = Yield '\x13c5' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER QUA-foldMapping '\xab96' s = Yield '\x13c6' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER QUE-foldMapping '\xab97' s = Yield '\x13c7' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER QUI-foldMapping '\xab98' s = Yield '\x13c8' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER QUO-foldMapping '\xab99' s = Yield '\x13c9' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER QUU-foldMapping '\xab9a' s = Yield '\x13ca' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER QUV-foldMapping '\xab9b' s = Yield '\x13cb' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER SA-foldMapping '\xab9c' s = Yield '\x13cc' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER S-foldMapping '\xab9d' s = Yield '\x13cd' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER SE-foldMapping '\xab9e' s = Yield '\x13ce' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER SI-foldMapping '\xab9f' s = Yield '\x13cf' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER SO-foldMapping '\xaba0' s = Yield '\x13d0' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER SU-foldMapping '\xaba1' s = Yield '\x13d1' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER SV-foldMapping '\xaba2' s = Yield '\x13d2' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER DA-foldMapping '\xaba3' s = Yield '\x13d3' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TA-foldMapping '\xaba4' s = Yield '\x13d4' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER DE-foldMapping '\xaba5' s = Yield '\x13d5' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TE-foldMapping '\xaba6' s = Yield '\x13d6' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER DI-foldMapping '\xaba7' s = Yield '\x13d7' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TI-foldMapping '\xaba8' s = Yield '\x13d8' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER DO-foldMapping '\xaba9' s = Yield '\x13d9' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER DU-foldMapping '\xabaa' s = Yield '\x13da' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER DV-foldMapping '\xabab' s = Yield '\x13db' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER DLA-foldMapping '\xabac' s = Yield '\x13dc' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TLA-foldMapping '\xabad' s = Yield '\x13dd' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TLE-foldMapping '\xabae' s = Yield '\x13de' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TLI-foldMapping '\xabaf' s = Yield '\x13df' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TLO-foldMapping '\xabb0' s = Yield '\x13e0' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TLU-foldMapping '\xabb1' s = Yield '\x13e1' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TLV-foldMapping '\xabb2' s = Yield '\x13e2' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TSA-foldMapping '\xabb3' s = Yield '\x13e3' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TSE-foldMapping '\xabb4' s = Yield '\x13e4' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TSI-foldMapping '\xabb5' s = Yield '\x13e5' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TSO-foldMapping '\xabb6' s = Yield '\x13e6' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TSU-foldMapping '\xabb7' s = Yield '\x13e7' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER TSV-foldMapping '\xabb8' s = Yield '\x13e8' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER WA-foldMapping '\xabb9' s = Yield '\x13e9' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER WE-foldMapping '\xabba' s = Yield '\x13ea' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER WI-foldMapping '\xabbb' s = Yield '\x13eb' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER WO-foldMapping '\xabbc' s = Yield '\x13ec' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER WU-foldMapping '\xabbd' s = Yield '\x13ed' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER WV-foldMapping '\xabbe' s = Yield '\x13ee' (CC s '\x0000' '\x0000')--- CHEROKEE SMALL LETTER YA-foldMapping '\xabbf' s = Yield '\x13ef' (CC s '\x0000' '\x0000')--- LATIN SMALL LIGATURE FF-foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')--- LATIN SMALL LIGATURE FI-foldMapping '\xfb01' s = Yield '\x0066' (CC s '\x0069' '\x0000')--- LATIN SMALL LIGATURE FL-foldMapping '\xfb02' s = Yield '\x0066' (CC s '\x006c' '\x0000')--- LATIN SMALL LIGATURE FFI-foldMapping '\xfb03' s = Yield '\x0066' (CC s '\x0066' '\x0069')--- LATIN SMALL LIGATURE FFL-foldMapping '\xfb04' s = Yield '\x0066' (CC s '\x0066' '\x006c')--- LATIN SMALL LIGATURE LONG S T-foldMapping '\xfb05' s = Yield '\x0073' (CC s '\x0074' '\x0000')--- LATIN SMALL LIGATURE ST-foldMapping '\xfb06' s = Yield '\x0073' (CC s '\x0074' '\x0000')--- ARMENIAN SMALL LIGATURE MEN NOW-foldMapping '\xfb13' s = Yield '\x0574' (CC s '\x0576' '\x0000')--- ARMENIAN SMALL LIGATURE MEN ECH-foldMapping '\xfb14' s = Yield '\x0574' (CC s '\x0565' '\x0000')--- ARMENIAN SMALL LIGATURE MEN INI-foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')--- ARMENIAN SMALL LIGATURE VEW NOW-foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')--- ARMENIAN SMALL LIGATURE MEN XEH-foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')--- OSAGE CAPITAL LETTER A-foldMapping '\x104b0' s = Yield '\x104d8' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER AI-foldMapping '\x104b1' s = Yield '\x104d9' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER AIN-foldMapping '\x104b2' s = Yield '\x104da' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER AH-foldMapping '\x104b3' s = Yield '\x104db' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER BRA-foldMapping '\x104b4' s = Yield '\x104dc' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER CHA-foldMapping '\x104b5' s = Yield '\x104dd' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER EHCHA-foldMapping '\x104b6' s = Yield '\x104de' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER E-foldMapping '\x104b7' s = Yield '\x104df' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER EIN-foldMapping '\x104b8' s = Yield '\x104e0' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER HA-foldMapping '\x104b9' s = Yield '\x104e1' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER HYA-foldMapping '\x104ba' s = Yield '\x104e2' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER I-foldMapping '\x104bb' s = Yield '\x104e3' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER KA-foldMapping '\x104bc' s = Yield '\x104e4' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER EHKA-foldMapping '\x104bd' s = Yield '\x104e5' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER KYA-foldMapping '\x104be' s = Yield '\x104e6' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER LA-foldMapping '\x104bf' s = Yield '\x104e7' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER MA-foldMapping '\x104c0' s = Yield '\x104e8' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER NA-foldMapping '\x104c1' s = Yield '\x104e9' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER O-foldMapping '\x104c2' s = Yield '\x104ea' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER OIN-foldMapping '\x104c3' s = Yield '\x104eb' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER PA-foldMapping '\x104c4' s = Yield '\x104ec' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER EHPA-foldMapping '\x104c5' s = Yield '\x104ed' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER SA-foldMapping '\x104c6' s = Yield '\x104ee' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER SHA-foldMapping '\x104c7' s = Yield '\x104ef' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER TA-foldMapping '\x104c8' s = Yield '\x104f0' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER EHTA-foldMapping '\x104c9' s = Yield '\x104f1' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER TSA-foldMapping '\x104ca' s = Yield '\x104f2' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER EHTSA-foldMapping '\x104cb' s = Yield '\x104f3' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER TSHA-foldMapping '\x104cc' s = Yield '\x104f4' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER DHA-foldMapping '\x104cd' s = Yield '\x104f5' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER U-foldMapping '\x104ce' s = Yield '\x104f6' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER WA-foldMapping '\x104cf' s = Yield '\x104f7' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER KHA-foldMapping '\x104d0' s = Yield '\x104f8' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER GHA-foldMapping '\x104d1' s = Yield '\x104f9' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER ZA-foldMapping '\x104d2' s = Yield '\x104fa' (CC s '\x0000' '\x0000')--- OSAGE CAPITAL LETTER ZHA-foldMapping '\x104d3' s = Yield '\x104fb' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER A-foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER AA-foldMapping '\x10c81' s = Yield '\x10cc1' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EB-foldMapping '\x10c82' s = Yield '\x10cc2' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER AMB-foldMapping '\x10c83' s = Yield '\x10cc3' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EC-foldMapping '\x10c84' s = Yield '\x10cc4' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ENC-foldMapping '\x10c85' s = Yield '\x10cc5' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ECS-foldMapping '\x10c86' s = Yield '\x10cc6' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ED-foldMapping '\x10c87' s = Yield '\x10cc7' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER AND-foldMapping '\x10c88' s = Yield '\x10cc8' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER E-foldMapping '\x10c89' s = Yield '\x10cc9' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER CLOSE E-foldMapping '\x10c8a' s = Yield '\x10cca' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EE-foldMapping '\x10c8b' s = Yield '\x10ccb' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EF-foldMapping '\x10c8c' s = Yield '\x10ccc' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EG-foldMapping '\x10c8d' s = Yield '\x10ccd' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EGY-foldMapping '\x10c8e' s = Yield '\x10cce' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EH-foldMapping '\x10c8f' s = Yield '\x10ccf' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER I-foldMapping '\x10c90' s = Yield '\x10cd0' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER II-foldMapping '\x10c91' s = Yield '\x10cd1' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EJ-foldMapping '\x10c92' s = Yield '\x10cd2' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EK-foldMapping '\x10c93' s = Yield '\x10cd3' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER AK-foldMapping '\x10c94' s = Yield '\x10cd4' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER UNK-foldMapping '\x10c95' s = Yield '\x10cd5' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EL-foldMapping '\x10c96' s = Yield '\x10cd6' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ELY-foldMapping '\x10c97' s = Yield '\x10cd7' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EM-foldMapping '\x10c98' s = Yield '\x10cd8' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EN-foldMapping '\x10c99' s = Yield '\x10cd9' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ENY-foldMapping '\x10c9a' s = Yield '\x10cda' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER O-foldMapping '\x10c9b' s = Yield '\x10cdb' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER OO-foldMapping '\x10c9c' s = Yield '\x10cdc' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG OE-foldMapping '\x10c9d' s = Yield '\x10cdd' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA OE-foldMapping '\x10c9e' s = Yield '\x10cde' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER OEE-foldMapping '\x10c9f' s = Yield '\x10cdf' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EP-foldMapping '\x10ca0' s = Yield '\x10ce0' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EMP-foldMapping '\x10ca1' s = Yield '\x10ce1' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ER-foldMapping '\x10ca2' s = Yield '\x10ce2' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER SHORT ER-foldMapping '\x10ca3' s = Yield '\x10ce3' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ES-foldMapping '\x10ca4' s = Yield '\x10ce4' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ESZ-foldMapping '\x10ca5' s = Yield '\x10ce5' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ET-foldMapping '\x10ca6' s = Yield '\x10ce6' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ENT-foldMapping '\x10ca7' s = Yield '\x10ce7' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ETY-foldMapping '\x10ca8' s = Yield '\x10ce8' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ECH-foldMapping '\x10ca9' s = Yield '\x10ce9' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER U-foldMapping '\x10caa' s = Yield '\x10cea' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER UU-foldMapping '\x10cab' s = Yield '\x10ceb' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG UE-foldMapping '\x10cac' s = Yield '\x10cec' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA UE-foldMapping '\x10cad' s = Yield '\x10ced' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EV-foldMapping '\x10cae' s = Yield '\x10cee' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EZ-foldMapping '\x10caf' s = Yield '\x10cef' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER EZS-foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER ENT-SHAPED SIGN-foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')--- OLD HUNGARIAN CAPITAL LETTER US-foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER ALIF-foldMapping '\x1e900' s = Yield '\x1e922' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER DAALI-foldMapping '\x1e901' s = Yield '\x1e923' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER LAAM-foldMapping '\x1e902' s = Yield '\x1e924' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER MIIM-foldMapping '\x1e903' s = Yield '\x1e925' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER BA-foldMapping '\x1e904' s = Yield '\x1e926' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER SINNYIIYHE-foldMapping '\x1e905' s = Yield '\x1e927' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER PE-foldMapping '\x1e906' s = Yield '\x1e928' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER BHE-foldMapping '\x1e907' s = Yield '\x1e929' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER RA-foldMapping '\x1e908' s = Yield '\x1e92a' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER E-foldMapping '\x1e909' s = Yield '\x1e92b' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER FA-foldMapping '\x1e90a' s = Yield '\x1e92c' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER I-foldMapping '\x1e90b' s = Yield '\x1e92d' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER O-foldMapping '\x1e90c' s = Yield '\x1e92e' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER DHA-foldMapping '\x1e90d' s = Yield '\x1e92f' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER YHE-foldMapping '\x1e90e' s = Yield '\x1e930' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER WAW-foldMapping '\x1e90f' s = Yield '\x1e931' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER NUN-foldMapping '\x1e910' s = Yield '\x1e932' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER KAF-foldMapping '\x1e911' s = Yield '\x1e933' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER YA-foldMapping '\x1e912' s = Yield '\x1e934' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER U-foldMapping '\x1e913' s = Yield '\x1e935' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER JIIM-foldMapping '\x1e914' s = Yield '\x1e936' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER CHI-foldMapping '\x1e915' s = Yield '\x1e937' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER HA-foldMapping '\x1e916' s = Yield '\x1e938' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER QAAF-foldMapping '\x1e917' s = Yield '\x1e939' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER GA-foldMapping '\x1e918' s = Yield '\x1e93a' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER NYA-foldMapping '\x1e919' s = Yield '\x1e93b' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER TU-foldMapping '\x1e91a' s = Yield '\x1e93c' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER NHA-foldMapping '\x1e91b' s = Yield '\x1e93d' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER VA-foldMapping '\x1e91c' s = Yield '\x1e93e' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER KHA-foldMapping '\x1e91d' s = Yield '\x1e93f' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER GBE-foldMapping '\x1e91e' s = Yield '\x1e940' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER ZAL-foldMapping '\x1e91f' s = Yield '\x1e941' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER KPO-foldMapping '\x1e920' s = Yield '\x1e942' (CC s '\x0000' '\x0000')--- ADLAM CAPITAL LETTER SHA-foldMapping '\x1e921' s = Yield '\x1e943' (CC s '\x0000' '\x0000')-foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
− Data/Text/Internal/Fusion/Common.hs 
@@ -1,949 +0,0 @@-{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}--- |--- Module      : Data.Text.Internal.Fusion.Common--- Copyright   : (c) Bryan O'Sullivan 2009, 2012------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Common stream fusion functionality for text.--module Data.Text.Internal.Fusion.Common-    (-    -- * Creation and elimination-      singleton-    , streamList-    , unstreamList-    , streamCString#--    -- * Basic interface-    , cons-    , snoc-    , append-    , head-    , uncons-    , last-    , tail-    , init-    , null-    , lengthI-    , compareLengthI-    , isSingleton--    -- * Transformations-    , map-    , intercalate-    , intersperse--    -- ** Case conversion-    -- $case-    , toCaseFold-    , toLower-    , toTitle-    , toUpper--    -- ** Justification-    , justifyLeftI--    -- * Folds-    , foldl-    , foldl'-    , foldl1-    , foldl1'-    , foldr-    , foldr1--    -- ** Special folds-    , concat-    , concatMap-    , any-    , all-    , maximum-    , minimum--    -- * Construction-    -- ** Scans-    , scanl--    -- ** Generation and unfolding-    , replicateCharI-    , replicateI-    , unfoldr-    , unfoldrNI--    -- * Substrings-    -- ** Breaking strings-    , take-    , drop-    , takeWhile-    , dropWhile--    -- * Predicates-    , isPrefixOf--    -- * Searching-    , elem-    , filter--    -- * Indexing-    , findBy-    , indexI-    , findIndexI-    , countCharI--    -- * Zipping and unzipping-    , zipWith-    ) where--import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),-                Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),-                (&&), fromIntegral, otherwise)-import qualified Data.List as L-import qualified Prelude as P-import Data.Bits (shiftL)-import Data.Char (isLetter, isSpace)-import Data.Int (Int64)-import Data.Text.Internal.Fusion.Types-import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,-                                     upperMapping)-import Data.Text.Internal.Fusion.Size-import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)-import GHC.Types (Char(..), Int(..))--singleton :: Char -> Stream Char-singleton c = Stream next False (codePointsSize 1)-    where next False = Yield c True-          next True  = Done-{-# INLINE [0] singleton #-}--streamList :: [a] -> Stream a-{-# INLINE [0] streamList #-}-streamList s  = Stream next s unknownSize-    where next []       = Done-          next (x:xs)   = Yield x xs--unstreamList :: Stream a -> [a]-unstreamList (Stream next s0 _len) = unfold s0-    where unfold !s = case next s of-                        Done       -> []-                        Skip s'    -> unfold s'-                        Yield x s' -> x : unfold s'-{-# INLINE [0] unstreamList #-}--{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}---- | Stream the UTF-8-like packed encoding used by GHC to represent--- constant strings in generated code.------ This encoding uses the byte sequence "\xc0\x80" to represent NUL,--- and the string is NUL-terminated.-streamCString# :: Addr# -> Stream Char-streamCString# addr = Stream step 0 unknownSize-  where-    step !i-        | b == 0    = Done-        | b <= 0x7f = Yield (C# b#) (i+1)-        | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1-                      in Yield c (i+2)-        | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +-                                      (next 1  `shiftL` 6) +-                                       next 2-                      in Yield c (i+3)-        | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +-                                      (next 1  `shiftL` 12) +-                                      (next 2  `shiftL` 6) +-                                       next 3-                      in Yield c (i+4)-      where b      = I# (ord# b#)-            next n = I# (ord# (at# (i+n))) - 0x80-            !b#    = at# i-    at# (I# i#) = indexCharOffAddr# addr i#-    chr (I# i#) = C# (chr# i#)-{-# INLINE [0] streamCString# #-}---- ------------------------------------------------------------------------------- * Basic stream functions--data C s = C0 !s-         | C1 !s---- | /O(n)/ Adds a character to the front of a Stream Char.-cons :: Char -> Stream Char -> Stream Char-cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len + codePointsSize 1)-    where-      next (C1 s) = Yield w (C0 s)-      next (C0 s) = case next0 s of-                          Done -> Done-                          Skip s' -> Skip (C0 s')-                          Yield x s' -> Yield x (C0 s')-{-# INLINE [0] cons #-}--data Snoc a = N-            | J !a---- | /O(n)/ Adds a character to the end of a stream.-snoc :: Stream Char -> Char -> Stream Char-snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len + codePointsSize 1)-  where-    next (J xs) = case next0 xs of-      Done        -> Yield w N-      Skip xs'    -> Skip    (J xs')-      Yield x xs' -> Yield x (J xs')-    next N = Done-{-# INLINE [0] snoc #-}--data E l r = L !l-           | R !r---- | /O(n)/ Appends one Stream to the other.-append :: Stream Char -> Stream Char -> Stream Char-append (Stream next0 s01 len1) (Stream next1 s02 len2) =-    Stream next (L s01) (len1 + len2)-    where-      next (L s1) = case next0 s1 of-                         Done        -> Skip    (R s02)-                         Skip s1'    -> Skip    (L s1')-                         Yield x s1' -> Yield x (L s1')-      next (R s2) = case next1 s2 of-                          Done        -> Done-                          Skip s2'    -> Skip    (R s2')-                          Yield x s2' -> Yield x (R s2')-{-# INLINE [0] append #-}---- | /O(1)/ Returns the first character of a Text, which must be non-empty.--- Subject to array fusion.-head :: Stream Char -> Char-head (Stream next s0 _len) = loop_head s0-    where-      loop_head !s = case next s of-                      Yield x _ -> x-                      Skip s'   -> loop_head s'-                      Done      -> head_empty-{-# INLINE [0] head #-}--head_empty :: a-head_empty = streamError "head" "Empty stream"-{-# NOINLINE head_empty #-}---- | /O(1)/ Returns the first character and remainder of a 'Stream--- Char', or 'Nothing' if empty.  Subject to array fusion.-uncons :: Stream Char -> Maybe (Char, Stream Char)-uncons (Stream next s0 len) = loop_uncons s0-    where-      loop_uncons !s = case next s of-                         Yield x s1 -> Just (x, Stream next s1 (len - codePointsSize 1))-                         Skip s'    -> loop_uncons s'-                         Done       -> Nothing-{-# INLINE [0] uncons #-}---- | /O(n)/ Returns the last character of a 'Stream Char', which must--- be non-empty.-last :: Stream Char -> Char-last (Stream next s0 _len) = loop0_last s0-    where-      loop0_last !s = case next s of-                        Done       -> emptyError "last"-                        Skip s'    -> loop0_last  s'-                        Yield x s' -> loop_last x s'-      loop_last !x !s = case next s of-                         Done        -> x-                         Skip s'     -> loop_last x  s'-                         Yield x' s' -> loop_last x' s'-{-# INLINE[0] last #-}---- | /O(1)/ Returns all characters after the head of a Stream Char, which must--- be non-empty.-tail :: Stream Char -> Stream Char-tail (Stream next0 s0 len) = Stream next (C0 s0) (len - codePointsSize 1)-    where-      next (C0 s) = case next0 s of-                      Done       -> emptyError "tail"-                      Skip s'    -> Skip (C0 s')-                      Yield _ s' -> Skip (C1 s')-      next (C1 s) = case next0 s of-                      Done       -> Done-                      Skip s'    -> Skip    (C1 s')-                      Yield x s' -> Yield x (C1 s')-{-# INLINE [0] tail #-}--data Init s = Init0 !s-            | Init1 {-# UNPACK #-} !Char !s---- | /O(1)/ Returns all but the last character of a Stream Char, which--- must be non-empty.-init :: Stream Char -> Stream Char-init (Stream next0 s0 len) = Stream next (Init0 s0) (len - codePointsSize 1)-    where-      next (Init0 s) = case next0 s of-                         Done       -> emptyError "init"-                         Skip s'    -> Skip (Init0 s')-                         Yield x s' -> Skip (Init1 x s')-      next (Init1 x s)  = case next0 s of-                            Done        -> Done-                            Skip s'     -> Skip    (Init1 x s')-                            Yield x' s' -> Yield x (Init1 x' s')-{-# INLINE [0] init #-}---- | /O(1)/ Tests whether a Stream Char is empty or not.-null :: Stream Char -> Bool-null (Stream next s0 _len) = loop_null s0-    where-      loop_null !s = case next s of-                       Done      -> True-                       Yield _ _ -> False-                       Skip s'   -> loop_null s'-{-# INLINE[0] null #-}---- | /O(n)/ Returns the number of characters in a string.-lengthI :: Integral a => Stream Char -> a-lengthI (Stream next s0 _len) = loop_length 0 s0-    where-      loop_length !z s  = case next s of-                           Done       -> z-                           Skip    s' -> loop_length z s'-                           Yield _ s' -> loop_length (z + 1) s'-{-# INLINE[0] lengthI #-}---- | /O(n)/ Compares the count of characters in a string to a number.--- Subject to fusion.------ This function gives the same answer as comparing against the result--- of 'lengthI', but can short circuit if the count of characters is--- greater than the number or if the stream can't possibly be as long--- as the number supplied, and hence be more efficient.-compareLengthI :: Integral a => Stream Char -> a -> Ordering-compareLengthI (Stream next s0 len) n-    -- Note that @len@ tracks code units whereas we want to compare the length-    -- in code points. Specifically, a stream with hint @len@ may consist of-    -- anywhere from @len/2@ to @len@ code points.-  | Just r <- compareSize len n' = r-  | otherwise = loop_cmp 0 s0-    where-      n' = codePointsSize $ fromIntegral n-      loop_cmp !z s  = case next s of-                         Done       -> compare z n-                         Skip    s' -> loop_cmp z s'-                         Yield _ s' | z > n     -> GT-                                    | otherwise -> loop_cmp (z + 1) s'-{-# INLINE[0] compareLengthI #-}---- | /O(n)/ Indicate whether a string contains exactly one element.-isSingleton :: Stream Char -> Bool-isSingleton (Stream next s0 _len) = loop 0 s0-    where-      loop !z s  = case next s of-                     Done            -> z == (1::Int)-                     Skip    s'      -> loop z s'-                     Yield _ s'-                         | z >= 1    -> False-                         | otherwise -> loop (z+1) s'-{-# INLINE[0] isSingleton #-}---- ------------------------------------------------------------------------------- * Stream transformations---- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@--- to each element of @xs@.-map :: (Char -> Char) -> Stream Char -> Stream Char-map f (Stream next0 s0 len) = Stream next s0 len-    where-      next !s = case next0 s of-                  Done       -> Done-                  Skip s'    -> Skip s'-                  Yield x s' -> Yield (f x) s'-{-# INLINE [0] map #-}--{-#-  RULES "STREAM map/map fusion" forall f g s.-     map f (map g s) = map (\x -> f (g x)) s- #-}--data I s = I1 !s-         | I2 !s {-# UNPACK #-} !Char-         | I3 !s---- | /O(n)/ Take a character and place it between each of the--- characters of a 'Stream Char'.-intersperse :: Char -> Stream Char -> Stream Char-intersperse c (Stream next0 s0 len) = Stream next (I1 s0) (len + unknownSize)-    where-      next (I1 s) = case next0 s of-        Done       -> Done-        Skip s'    -> Skip (I1 s')-        Yield x s' -> Skip (I2 s' x)-      next (I2 s x)  = Yield x (I3 s)-      next (I3 s) = case next0 s of-        Done       -> Done-        Skip s'    -> Skip    (I3 s')-        Yield x s' -> Yield c (I2 s' x)-{-# INLINE [0] intersperse #-}---- ------------------------------------------------------------------------------- ** Case conversions (folds)---- $case------ With Unicode text, it is incorrect to use combinators like @map--- toUpper@ to case convert each character of a string individually.--- Instead, use the whole-string case conversion functions from this--- module.  For correctness in different writing systems, these--- functions may map one input character to two or three output--- characters.---- | Map a 'Stream' through the given case-mapping function.-caseConvert :: (forall s. Char -> s -> Step (CC s) Char)-            -> Stream Char -> Stream Char-caseConvert remap (Stream next0 s0 len) =-    Stream next (CC s0 '\0' '\0') (len `unionSize` (3*len))-  where-    next (CC s '\0' _) =-        case next0 s of-          Done       -> Done-          Skip s'    -> Skip (CC s' '\0' '\0')-          Yield c s' -> remap c s'-    next (CC s a b)  =  Yield a (CC s b '\0')---- | /O(n)/ Convert a string to folded case.  This function is mainly--- useful for performing caseless (or case insensitive) string--- comparisons.------ A string @x@ is a caseless match for a string @y@ if and only if:------ @toCaseFold x == toCaseFold y@------ The result string may be longer than the input string, and may--- differ from applying 'toLower' to the input string.  For instance,--- the Armenian small ligature men now (U+FB13) is case folded to the--- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is--- case folded to the Greek small letter letter mu (U+03BC) instead of--- itself.-toCaseFold :: Stream Char -> Stream Char-toCaseFold = caseConvert foldMapping-{-# INLINE [0] toCaseFold #-}---- | /O(n)/ Convert a string to upper case, using simple case--- conversion.  The result string may be longer than the input string.--- For instance, the German eszett (U+00DF) maps to the two-letter--- sequence SS.-toUpper :: Stream Char -> Stream Char-toUpper = caseConvert upperMapping-{-# INLINE [0] toUpper #-}---- | /O(n)/ Convert a string to lower case, using simple case--- conversion.  The result string may be longer than the input string.--- For instance, the Latin capital letter I with dot above (U+0130)--- maps to the sequence Latin small letter i (U+0069) followed by--- combining dot above (U+0307).-toLower :: Stream Char -> Stream Char-toLower = caseConvert lowerMapping-{-# INLINE [0] toLower #-}---- | /O(n)/ Convert a string to title case, using simple case--- conversion.------ The first letter of the input is converted to title case, as is--- every subsequent letter that immediately follows a non-letter.--- Every letter that immediately follows another letter is converted--- to lower case.------ The result string may be longer than the input string. For example,--- the Latin small ligature &#xfb02; (U+FB02) is converted to the--- sequence Latin capital letter F (U+0046) followed by Latin small--- letter l (U+006C).------ /Note/: this function does not take language or culture specific--- rules into account. For instance, in English, different style--- guides disagree on whether the book name \"The Hill of the Red--- Fox\" is correctly title cased&#x2014;but this function will--- capitalize /every/ word.-toTitle :: Stream Char -> Stream Char-toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') (len + unknownSize)-  where-    next (CC (letter :*: s) '\0' _) =-      case next0 s of-        Done            -> Done-        Skip s'         -> Skip (CC (letter :*: s') '\0' '\0')-        Yield c s'-          | nonSpace    -> if letter-                           then lowerMapping c (nonSpace :*: s')-                           else titleMapping c (letter' :*: s')-          | otherwise   -> Yield c (CC (letter' :*: s') '\0' '\0')-          where nonSpace = P.not (isSpace c)-                letter'  = isLetter c-    next (CC s a b)      = Yield a (CC s b '\0')-{-# INLINE [0] toTitle #-}--data Justify i s = Just1 !i !s-                 | Just2 !i !s--justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char-justifyLeftI k c (Stream next0 s0 len) =-    Stream next (Just1 0 s0) (larger (fromIntegral k * charSize c + len) len)-  where-    next (Just1 n s) =-        case next0 s of-          Done       -> next (Just2 n s)-          Skip s'    -> Skip (Just1 n s')-          Yield x s' -> Yield x (Just1 (n+1) s')-    next (Just2 n s)-        | n < k       = Yield c (Just2 (n+1) s)-        | otherwise   = Done-    {-# INLINE next #-}-{-# INLINE [0] justifyLeftI #-}---- ------------------------------------------------------------------------------- * Reducing Streams (folds)---- | foldl, applied to a binary operator, a starting value (typically the--- left-identity of the operator), and a Stream, reduces the Stream using the--- binary operator, from left to right.-foldl :: (b -> Char -> b) -> b -> Stream Char -> b-foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0-    where-      loop_foldl z !s = case next s of-                          Done -> z-                          Skip s' -> loop_foldl z s'-                          Yield x s' -> loop_foldl (f z x) s'-{-# INLINE [0] foldl #-}---- | A strict version of foldl.-foldl' :: (b -> Char -> b) -> b -> Stream Char -> b-foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0-    where-      loop_foldl' !z !s = case next s of-                            Done -> z-                            Skip s' -> loop_foldl' z s'-                            Yield x s' -> loop_foldl' (f z x) s'-{-# INLINE [0] foldl' #-}---- | foldl1 is a variant of foldl that has no starting value argument,--- and thus must be applied to non-empty Streams.-foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char-foldl1 f (Stream next s0 _len) = loop0_foldl1 s0-    where-      loop0_foldl1 !s = case next s of-                          Skip s' -> loop0_foldl1 s'-                          Yield x s' -> loop_foldl1 x s'-                          Done -> emptyError "foldl1"-      loop_foldl1 z !s = case next s of-                           Done -> z-                           Skip s' -> loop_foldl1 z s'-                           Yield x s' -> loop_foldl1 (f z x) s'-{-# INLINE [0] foldl1 #-}---- | A strict version of foldl1.-foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char-foldl1' f (Stream next s0 _len) = loop0_foldl1' s0-    where-      loop0_foldl1' !s = case next s of-                           Skip s' -> loop0_foldl1' s'-                           Yield x s' -> loop_foldl1' x s'-                           Done -> emptyError "foldl1"-      loop_foldl1' !z !s = case next s of-                             Done -> z-                             Skip s' -> loop_foldl1' z s'-                             Yield x s' -> loop_foldl1' (f z x) s'-{-# INLINE [0] foldl1' #-}---- | 'foldr', applied to a binary operator, a starting value (typically the--- right-identity of the operator), and a stream, reduces the stream using the--- binary operator, from right to left.-foldr :: (Char -> b -> b) -> b -> Stream Char -> b-foldr f z (Stream next s0 _len) = loop_foldr s0-    where-      loop_foldr !s = case next s of-                        Done -> z-                        Skip s' -> loop_foldr s'-                        Yield x s' -> f x (loop_foldr s')-{-# INLINE [0] foldr #-}---- | foldr1 is a variant of 'foldr' that has no starting value argument,--- and thus must be applied to non-empty streams.--- Subject to array fusion.-foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char-foldr1 f (Stream next s0 _len) = loop0_foldr1 s0-  where-    loop0_foldr1 !s = case next s of-      Done       -> emptyError "foldr1"-      Skip    s' -> loop0_foldr1  s'-      Yield x s' -> loop_foldr1 x s'--    loop_foldr1 x !s = case next s of-      Done        -> x-      Skip     s' -> loop_foldr1 x s'-      Yield x' s' -> f x (loop_foldr1 x' s')-{-# INLINE [0] foldr1 #-}--intercalate :: Stream Char -> [Stream Char] -> Stream Char-intercalate s = concat . (L.intersperse s)-{-# INLINE [0] intercalate #-}---- ------------------------------------------------------------------------------- ** Special folds---- | /O(n)/ Concatenate a list of streams. Subject to array fusion.-concat :: [Stream Char] -> Stream Char-concat = L.foldr append empty-{-# INLINE [0] concat #-}---- | Map a function over a stream that results in a stream and concatenate the--- results.-concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char-concatMap f = foldr (append . f) empty-{-# INLINE [0] concatMap #-}---- | /O(n)/ any @p @xs determines if any character in the stream--- @xs@ satisfies the predicate @p@.-any :: (Char -> Bool) -> Stream Char -> Bool-any p (Stream next0 s0 _len) = loop_any s0-    where-      loop_any !s = case next0 s of-                      Done                   -> False-                      Skip s'                -> loop_any s'-                      Yield x s' | p x       -> True-                                 | otherwise -> loop_any s'-{-# INLINE [0] any #-}---- | /O(n)/ all @p @xs determines if all characters in the 'Text'--- @xs@ satisfy the predicate @p@.-all :: (Char -> Bool) -> Stream Char -> Bool-all p (Stream next0 s0 _len) = loop_all s0-    where-      loop_all !s = case next0 s of-                      Done                   -> True-                      Skip s'                -> loop_all s'-                      Yield x s' | p x       -> loop_all s'-                                 | otherwise -> False-{-# INLINE [0] all #-}---- | /O(n)/ maximum returns the maximum value from a stream, which must be--- non-empty.-maximum :: Stream Char -> Char-maximum (Stream next0 s0 _len) = loop0_maximum s0-    where-      loop0_maximum !s   = case next0 s of-                             Done       -> emptyError "maximum"-                             Skip s'    -> loop0_maximum s'-                             Yield x s' -> loop_maximum x s'-      loop_maximum !z !s = case next0 s of-                             Done            -> z-                             Skip s'         -> loop_maximum z s'-                             Yield x s'-                                 | x > z     -> loop_maximum x s'-                                 | otherwise -> loop_maximum z s'-{-# INLINE [0] maximum #-}---- | /O(n)/ minimum returns the minimum value from a 'Text', which must be--- non-empty.-minimum :: Stream Char -> Char-minimum (Stream next0 s0 _len) = loop0_minimum s0-    where-      loop0_minimum !s   = case next0 s of-                             Done       -> emptyError "minimum"-                             Skip s'    -> loop0_minimum s'-                             Yield x s' -> loop_minimum x s'-      loop_minimum !z !s = case next0 s of-                             Done            -> z-                             Skip s'         -> loop_minimum z s'-                             Yield x s'-                                 | x < z     -> loop_minimum x s'-                                 | otherwise -> loop_minimum z s'-{-# INLINE [0] minimum #-}---- -------------------------------------------------------------------------------- * Building streams--scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char-scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low-  where-    {-# INLINE next #-}-    next (Scan1 z s) = Yield z (Scan2 z s)-    next (Scan2 z s) = case next0 s of-                         Yield x s' -> let !x' = f z x-                                       in Yield x' (Scan2 x' s')-                         Skip s'    -> Skip (Scan2 z s')-                         Done       -> Done-{-# INLINE [0] scanl #-}---- -------------------------------------------------------------------------------- ** Generating and unfolding streams--replicateCharI :: Integral a => a -> Char -> Stream Char-replicateCharI !n !c-    | n < 0     = empty-    | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low-  where-    next !i | i >= n    = Done-            | otherwise = Yield c (i + 1)-{-# INLINE [0] replicateCharI #-}--data RI s = RI !s {-# UNPACK #-} !Int64--replicateI :: Int64 -> Stream Char -> Stream Char-replicateI n (Stream next0 s0 len) =-    Stream next (RI s0 0) (fromIntegral (max 0 n) * len)-  where-    next (RI s k)-        | k >= n = Done-        | otherwise = case next0 s of-                        Done       -> Skip    (RI s0 (k+1))-                        Skip s'    -> Skip    (RI s' k)-                        Yield x s' -> Yield x (RI s' k)-{-# INLINE [0] replicateI #-}---- | /O(n)/, where @n@ is the length of the result. The unfoldr function--- is analogous to the List 'unfoldr'. unfoldr builds a stream--- from a seed value. The function takes the element and returns--- Nothing if it is done producing the stream or returns Just--- (a,b), in which case, a is the next Char in the string, and b is--- the seed value for further production.-unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char-unfoldr f s0 = Stream next s0 unknownSize-    where-      {-# INLINE next #-}-      next !s = case f s of-                 Nothing      -> Done-                 Just (w, s') -> Yield w s'-{-# INLINE [0] unfoldr #-}---- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed--- value. However, the length of the result is limited by the--- first argument to 'unfoldrNI'. This function is more efficient than--- 'unfoldr' when the length of the result is known.-unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char-unfoldrNI n f s0 | n <  0    = empty-                 | otherwise = Stream next (0 :*: s0) (maxSize $ fromIntegral (n*2))-    where-      {-# INLINE next #-}-      next (z :*: s) = case f s of-          Nothing                  -> Done-          Just (w, s') | z >= n    -> Done-                       | otherwise -> Yield w ((z + 1) :*: s')-{-# INLINE unfoldrNI #-}------------------------------------------------------------------------------------  * Substreams---- | /O(n)/ @'take' n@, applied to a stream, returns the prefix of the--- stream of length @n@, or the stream itself if @n@ is greater than the--- length of the stream.-take :: Integral a => a -> Stream Char -> Stream Char-take n0 (Stream next0 s0 len) =-    Stream next (n0' :*: s0) (smaller len (codePointsSize $ fromIntegral n0'))-    where-      n0' = max n0 0--      {-# INLINE next #-}-      next (n :*: s) | n <= 0    = Done-                     | otherwise = case next0 s of-                                     Done -> Done-                                     Skip s' -> Skip (n :*: s')-                                     Yield x s' -> Yield x ((n-1) :*: s')-{-# INLINE [0] take #-}--data Drop a s = NS !s-              | JS !a !s---- | /O(n)/ @'drop' n@, applied to a stream, returns the suffix of the--- stream after the first @n@ characters, or the empty stream if @n@--- is greater than the length of the stream.-drop :: Integral a => a -> Stream Char -> Stream Char-drop n0 (Stream next0 s0 len) =-    Stream next (JS n0' s0) (len - codePointsSize (fromIntegral n0'))-  where-    n0' = max n0 0--    {-# INLINE next #-}-    next (JS n s)-      | n <= 0    = Skip (NS s)-      | otherwise = case next0 s of-          Done       -> Done-          Skip    s' -> Skip (JS n    s')-          Yield _ s' -> Skip (JS (n-1) s')-    next (NS s) = case next0 s of-      Done       -> Done-      Skip    s' -> Skip    (NS s')-      Yield x s' -> Yield x (NS s')-{-# INLINE [0] drop #-}---- | 'takeWhile', applied to a predicate @p@ and a stream, returns the--- longest prefix (possibly empty) of elements that satisfy @p@.-takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char-takeWhile p (Stream next0 s0 len) = Stream next s0 (len - unknownSize)-    where-      {-# INLINE next #-}-      next !s = case next0 s of-                  Done    -> Done-                  Skip s' -> Skip s'-                  Yield x s' | p x       -> Yield x s'-                             | otherwise -> Done-{-# INLINE [0] takeWhile #-}---- | @'dropWhile' p xs@ returns the suffix remaining after @'takeWhile' p xs@.-dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char-dropWhile p (Stream next0 s0 len) = Stream next (L s0) (len - unknownSize)-    where-    {-# INLINE next #-}-    next (L s)  = case next0 s of-      Done                   -> Done-      Skip    s'             -> Skip    (L s')-      Yield x s' | p x       -> Skip    (L s')-                 | otherwise -> Yield x (R s')-    next (R s) = case next0 s of-      Done       -> Done-      Skip    s' -> Skip    (R s')-      Yield x s' -> Yield x (R s')-{-# INLINE [0] dropWhile #-}---- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns--- 'True' iff the first is a prefix of the second.-isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool-isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)-    where-      loop Done      _ = True-      loop _    Done = False-      loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')-      loop (Skip s1')     x2             = loop (next1 s1') x2-      loop x1             (Skip s2')     = loop x1          (next2 s2')-      loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&-                                           loop (next1 s1') (next2 s2')-{-# INLINE [0] isPrefixOf #-}---- ------------------------------------------------------------------------------- * Searching------------------------------------------------------------------------------------ ** Searching by equality---- | /O(n)/ 'elem' is the stream membership predicate.-elem :: Char -> Stream Char -> Bool-elem w (Stream next s0 _len) = loop_elem s0-    where-      loop_elem !s = case next s of-                       Done -> False-                       Skip s' -> loop_elem s'-                       Yield x s' | x == w -> True-                                  | otherwise -> loop_elem s'-{-# INLINE [0] elem #-}------------------------------------------------------------------------------------ ** Searching with a predicate---- | /O(n)/ The 'findBy' function takes a predicate and a stream,--- and returns the first element in matching the predicate, or 'Nothing'--- if there is no such element.--findBy :: (Char -> Bool) -> Stream Char -> Maybe Char-findBy p (Stream next s0 _len) = loop_find s0-    where-      loop_find !s = case next s of-                       Done -> Nothing-                       Skip s' -> loop_find s'-                       Yield x s' | p x -> Just x-                                  | otherwise -> loop_find s'-{-# INLINE [0] findBy #-}---- | /O(n)/ Stream index (subscript) operator, starting from 0.-indexI :: Integral a => Stream Char -> a -> Char-indexI (Stream next s0 _len) n0-  | n0 < 0    = streamError "index" "Negative index"-  | otherwise = loop_index n0 s0-  where-    loop_index !n !s = case next s of-      Done                   -> streamError "index" "Index too large"-      Skip    s'             -> loop_index  n    s'-      Yield x s' | n == 0    -> x-                 | otherwise -> loop_index (n-1) s'-{-# INLINE [0] indexI #-}---- | /O(n)/ 'filter', applied to a predicate and a stream,--- returns a stream containing those characters that satisfy the--- predicate.-filter :: (Char -> Bool) -> Stream Char -> Stream Char-filter p (Stream next0 s0 len) =-    Stream next s0 (len - unknownSize) -- HINT maybe too high-  where-    next !s = case next0 s of-                Done                   -> Done-                Skip    s'             -> Skip    s'-                Yield x s' | p x       -> Yield x s'-                           | otherwise -> Skip    s'-{-# INLINE [0] filter #-}--{-# RULES-  "STREAM filter/filter fusion" forall p q s.-  filter p (filter q s) = filter (\x -> q x && p x) s-  #-}---- | The 'findIndexI' function takes a predicate and a stream and--- returns the index of the first element in the stream satisfying the--- predicate.-findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a-findIndexI p s = case findIndicesI p s of-                  (i:_) -> Just i-                  _     -> Nothing-{-# INLINE [0] findIndexI #-}---- | The 'findIndicesI' function takes a predicate and a stream and--- returns all indices of the elements in the stream satisfying the--- predicate.-findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]-findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0-  where-    loop_findIndex !i !s = case next s of-      Done                   -> []-      Skip    s'             -> loop_findIndex i     s' -- hmm. not caught by QC-      Yield x s' | p x       -> i : loop_findIndex (i+1) s'-                 | otherwise -> loop_findIndex (i+1) s'-{-# INLINE [0] findIndicesI #-}------------------------------------------------------------------------------------ * Zipping---- | Strict triple.-data Zip a b m = Z1 !a !b-               | Z2 !a !b !m---- | zipWith generalises 'zip' by zipping with the function given as--- the first argument, instead of a tupling function.-zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b-zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =-    Stream next (Z1 sa0 sb0) (smaller len1 len2)-    where-      next (Z1 sa sb) = case next0 sa of-                          Done -> Done-                          Skip sa' -> Skip (Z1 sa' sb)-                          Yield a sa' -> Skip (Z2 sa' sb a)--      next (Z2 sa' sb a) = case next1 sb of-                             Done -> Done-                             Skip sb' -> Skip (Z2 sa' sb' a)-                             Yield b sb' -> Yield (f a b) (Z1 sa' sb')-{-# INLINE [0] zipWith #-}---- | /O(n)/ The 'countCharI' function returns the number of times the--- query element appears in the given stream.-countCharI :: Integral a => Char -> Stream Char -> a-countCharI a (Stream next s0 _len) = loop 0 s0-  where-    loop !i !s = case next s of-      Done                   -> i-      Skip    s'             -> loop i s'-      Yield x s' | a == x    -> loop (i+1) s'-                 | otherwise -> loop i s'-{-# INLINE [0] countCharI #-}--streamError :: String -> String -> a-streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg--emptyError :: String -> a-emptyError func = internalError func "Empty input"--internalError :: String -> a-internalError func = streamError func "Internal error"
− Data/Text/Internal/Fusion/Size.hs 
@@ -1,187 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-missing-methods #-}--- |--- Module      : Data.Text.Internal.Fusion.Internal--- Copyright   : (c) Roman Leshchinskiy 2008,---               (c) Bryan O'Sullivan 2009------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Size hints.--module Data.Text.Internal.Fusion.Size-    (-      Size-      -- * Sizes-    , exactSize-    , maxSize-    , betweenSize-    , unknownSize-    , unionSize-    , charSize-    , codePointsSize-      -- * Querying sizes-    , exactly-    , smaller-    , larger-    , upperBound-    , lowerBound-    , compareSize-    , isEmpty-    ) where--import Data.Char (ord)-import Data.Text.Internal (mul)-#if defined(ASSERTS)-import Control.Exception (assert)-#endif---- | A size in UTF-16 code units.-data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.-          | Unknown                                         -- ^ Unknown size.-            deriving (Eq, Show)--exactly :: Size -> Maybe Int-exactly (Between na nb) | na == nb = Just na-exactly _ = Nothing-{-# INLINE exactly #-}---- | The 'Size' of the given code point.-charSize :: Char -> Size-charSize c-  | ord c < 0x10000 = exactSize 1-  | otherwise       = exactSize 2---- | The 'Size' of @n@ code points.-codePointsSize :: Int -> Size-codePointsSize n =-#if defined(ASSERTS)-    assert (n >= 0)-#endif-    Between n (2*n)-{-# INLINE codePointsSize #-}--exactSize :: Int -> Size-exactSize n =-#if defined(ASSERTS)-    assert (n >= 0)-#endif-    Between n n-{-# INLINE exactSize #-}--maxSize :: Int -> Size-maxSize n =-#if defined(ASSERTS)-    assert (n >= 0)-#endif-    Between 0 n-{-# INLINE maxSize #-}--betweenSize :: Int -> Int -> Size-betweenSize m n =-#if defined(ASSERTS)-    assert (m >= 0)-    assert (n >= m)-#endif-    Between m n-{-# INLINE betweenSize #-}--unionSize :: Size -> Size -> Size-unionSize (Between a b) (Between c d) = Between (min a c) (max b d)-unionSize _ _ = Unknown--unknownSize :: Size-unknownSize = Unknown-{-# INLINE unknownSize #-}--instance Num Size where-    (+) = addSize-    (-) = subtractSize-    (*) = mulSize--    fromInteger = f where f = exactSize . fromInteger-                          {-# INLINE f #-}--add :: Int -> Int -> Int-add m n | mn >=   0 = mn-        | otherwise = overflowError-  where mn = m + n-{-# INLINE add #-}--addSize :: Size -> Size -> Size-addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)-addSize _               _               = Unknown-{-# INLINE addSize #-}--subtractSize :: Size -> Size -> Size-subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)-subtractSize a@(Between 0 _) Unknown         = a-subtractSize (Between _ mb)  Unknown         = Between 0 mb-subtractSize _               _               = Unknown-{-# INLINE subtractSize #-}--mulSize :: Size -> Size -> Size-mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)-mulSize _               _               = Unknown-{-# INLINE mulSize #-}---- | Minimum of two size hints.-smaller :: Size -> Size -> Size-smaller a@(Between ma mb) b@(Between na nb)-    | mb <= na  = a-    | nb <= ma  = b-    | otherwise = Between (ma `min` na) (mb `min` nb)-smaller a@(Between 0 _) Unknown         = a-smaller (Between _ mb)  Unknown         = Between 0 mb-smaller Unknown         b@(Between 0 _) = b-smaller Unknown         (Between _ nb)  = Between 0 nb-smaller Unknown         Unknown         = Unknown-{-# INLINE smaller #-}---- | Maximum of two size hints.-larger :: Size -> Size -> Size-larger a@(Between ma mb) b@(Between na nb)-    | ma >= nb  = a-    | na >= mb  = b-    | otherwise = Between (ma `max` na) (mb `max` nb)-larger _ _ = Unknown-{-# INLINE larger #-}---- | Compute the maximum size from a size hint, if possible.-upperBound :: Int -> Size -> Int-upperBound _ (Between _ n) = n-upperBound k _             = k-{-# INLINE upperBound #-}---- | Compute the maximum size from a size hint, if possible.-lowerBound :: Int -> Size -> Int-lowerBound _ (Between n _) = n-lowerBound k _             = k-{-# INLINE lowerBound #-}---- | Determine the ordering relationship between two 'Size's, or 'Nothing' in--- the indeterminate case.-compareSize :: Size -> Size -> Maybe Ordering-compareSize (Between ma mb) (Between na nb)-  | mb < na            = Just LT-  | ma > nb            = Just GT-  | ma == mb-  , ma == na-  , ma == nb           = Just EQ-compareSize _ _        = Nothing---isEmpty :: Size -> Bool-isEmpty (Between _ n) = n <= 0-isEmpty _             = False-{-# INLINE isEmpty #-}--overflowError :: Int-overflowError = error "Data.Text.Internal.Fusion.Size: size overflow"
− Data/Text/Internal/Fusion/Types.hs 
@@ -1,122 +0,0 @@-{-# LANGUAGE BangPatterns, ExistentialQuantification #-}--- |--- Module      : Data.Text.Internal.Fusion.Types--- Copyright   : (c) Tom Harper 2008-2009,---               (c) Bryan O'Sullivan 2009,---               (c) Duncan Coutts 2009,---               (c) Jasper Van der Jeugt 2011------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Core stream fusion functionality for text.--module Data.Text.Internal.Fusion.Types-    (-      CC(..)-    , PairS(..)-    , Scan(..)-    , RS(..)-    , Step(..)-    , Stream(..)-    , empty-    ) where--import Data.Text.Internal.Fusion.Size-import Data.Word (Word8)---- | Specialised tuple for case conversion.-data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char---- | Restreaming state.-data RS s-    = RS0 !s-    | RS1 !s {-# UNPACK #-} !Word8-    | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8-    | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8---- | Strict pair.-data PairS a b = !a :*: !b-                 -- deriving (Eq, Ord, Show)-infixl 2 :*:---- | An intermediate result in a scan.-data Scan s = Scan1 {-# UNPACK #-} !Char !s-            | Scan2 {-# UNPACK #-} !Char !s---- | Intermediate result in a processing pipeline.-data Step s a = Done-              | Skip !s-              | Yield !a !s--{--instance (Show a) => Show (Step s a)-    where show Done        = "Done"-          show (Skip _)    = "Skip"-          show (Yield x _) = "Yield " ++ show x--}--instance (Eq a) => Eq (Stream a) where-    (==) = eq--instance (Ord a) => Ord (Stream a) where-    compare = cmp---- The length hint in a Stream has two roles.  If its value is zero,--- we trust it, and treat the stream as empty.  Otherwise, we treat it--- as a hint: it should usually be accurate, so we use it when--- unstreaming to decide what size array to allocate.  However, the--- unstreaming functions must be able to cope with the hint being too--- small or too large.------ The size hint tries to track the UTF-16 code units in a stream,--- but often counts the number of code points instead.  It can easily--- undercount if, for instance, a transformed stream contains astral--- plane code points (those above 0x10000).--data Stream a =-    forall s. Stream-    (s -> Step s a)             -- stepper function-    !s                          -- current state-    !Size                       -- size hint in code units---- | /O(n)/ Determines if two streams are equal.-eq :: (Eq a) => Stream a -> Stream a -> Bool-eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)-    where-      loop Done Done                     = True-      loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')-      loop (Skip s1')     x2             = loop (next1 s1') x2-      loop x1             (Skip s2')     = loop x1          (next2 s2')-      loop Done _                        = False-      loop _    Done                     = False-      loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&-                                           loop (next1 s1') (next2 s2')-{-# INLINE [0] eq #-}--cmp :: (Ord a) => Stream a -> Stream a -> Ordering-cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)-    where-      loop Done Done                     = EQ-      loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')-      loop (Skip s1')     x2             = loop (next1 s1') x2-      loop x1             (Skip s2')     = loop x1          (next2 s2')-      loop Done _                        = LT-      loop _    Done                     = GT-      loop (Yield x1 s1') (Yield x2 s2') =-          case compare x1 x2 of-            EQ    -> loop (next1 s1') (next2 s2')-            other -> other-{-# INLINE [0] cmp #-}---- | The empty stream.-empty :: Stream a-empty = Stream next () 0-    where next _ = Done-{-# INLINE [0] empty #-}
− Data/Text/Internal/IO.hs 
@@ -1,166 +0,0 @@-{-# LANGUAGE BangPatterns, RecordWildCards #-}--- |--- Module      : Data.Text.Internal.IO--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,---               (c) 2009 Simon Marlow--- License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Low-level support for text I\/O.--module Data.Text.Internal.IO-    (-      hGetLineWith-    , readChunk-    ) where--import qualified Control.Exception as E-import Data.IORef (readIORef, writeIORef)-import Data.Text (Text)-import Data.Text.Internal.Fusion (unstream)-import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))-import Data.Text.Internal.Fusion.Size (exactSize, maxSize)-import Data.Text.Unsafe (inlinePerformIO)-import Foreign.Storable (peekElemOff)-import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,-                      bufferElems, charSize, isEmptyBuffer, readCharBuf,-                      withRawBuffer, writeCharBuf)-import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)-import GHC.IO.Handle.Types (Handle__(..), Newline(..))-import System.IO (Handle)-import System.IO.Error (isEOFError)-import qualified Data.Text as T---- | Read a single line of input from a handle, constructing a list of--- decoded chunks as we go.  When we're done, transform them into the--- destination type.-hGetLineWith :: ([Text] -> t) -> Handle -> IO t-hGetLineWith f h = wantReadableHandle_ "hGetLine" h go-  where-    go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh []--hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]-hGetLineLoop hh@Handle__{..} = go where- go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do-  let findEOL raw r | r == w    = return (False, w)-                    | otherwise = do-        (c,r') <- readCharBuf raw r-        if c == '\n'-          then return (True, r)-          else findEOL raw r'-  (eol, off) <- findEOL raw0 r0-  (t,r') <- if haInputNL == CRLF-            then unpack_nl raw0 r0 off-            else do t <- unpack raw0 r0 off-                    return (t,off)-  if eol-    then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)-            return $ reverse (t:ts)-    else do-      let buf1 = bufferAdjustL r' buf-      maybe_buf <- maybeFillReadBuffer hh buf1-      case maybe_buf of-         -- Nothing indicates we caught an EOF, and we may have a-         -- partial line to return.-         Nothing -> do-              -- we reached EOF.  There might be a lone \r left-              -- in the buffer, so check for that and-              -- append it to the line if necessary.-              let pre | isEmptyBuffer buf1 = T.empty-                      | otherwise          = T.singleton '\r'-              writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }-              let str = reverse . filter (not . T.null) $ pre:t:ts-              if null str-                then ioe_EOF-                else return str-         Just new_buf -> go (t:ts) new_buf---- This function is lifted almost verbatim from GHC.IO.Handle.Text.-maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)-maybeFillReadBuffer handle_ buf-  = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->-      if isEOFError e-      then return Nothing-      else ioError e--unpack :: RawCharBuffer -> Int -> Int -> IO Text-unpack !buf !r !w- | charSize /= 4 = sizeError "unpack"- | r >= w        = return T.empty- | otherwise     = withRawBuffer buf go- where-  go pbuf = return $! unstream (Stream next r (exactSize (w-r)))-   where-    next !i | i >= w    = Done-            | otherwise = Yield (ix i) (i+1)-    ix i = inlinePerformIO $ peekElemOff pbuf i--unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)-unpack_nl !buf !r !w- | charSize /= 4 = sizeError "unpack_nl"- | r >= w        = return (T.empty, 0)- | otherwise     = withRawBuffer buf $ go- where-  go pbuf = do-    let !t = unstream (Stream next r (maxSize (w-r)))-        w' = w - 1-    return $ if ix w' == '\r'-             then (t,w')-             else (t,w)-   where-    next !i | i >= w = Done-            | c == '\r' = let i' = i + 1-                          in if i' < w-                             then if ix i' == '\n'-                                  then Yield '\n' (i+2)-                                  else Yield '\n' i'-                             else Done-            | otherwise = Yield c (i+1)-            where c = ix i-    ix i = inlinePerformIO $ peekElemOff pbuf i---- This function is completely lifted from GHC.IO.Handle.Text.-getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer-getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =-  case bufferElems buf of-    -- buffer empty: read some more-    0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf--    -- if the buffer has a single '\r' in it and we're doing newline-    -- translation: read some more-    1 | haInputNL == CRLF -> do-      (c,_) <- readCharBuf bufRaw bufL-      if c == '\r'-         then do -- shuffle the '\r' to the beginning.  This is only safe-                 -- if we're about to call readTextDevice, otherwise it-                 -- would mess up flushCharBuffer.-                 -- See [note Buffer Flushing], GHC.IO.Handle.Types-                 _ <- writeCharBuf bufRaw 0 '\r'-                 let buf' = buf{ bufL=0, bufR=1 }-                 readTextDevice handle_ buf'-         else do-                 return buf--    -- buffer has some chars in it already: just return it-    _otherwise -> {-# SCC "otherwise" #-} return buf---- | Read a single chunk of strict text from a buffer. Used by both--- the strict and lazy implementations of hGetContents.-readChunk :: Handle__ -> CharBuffer -> IO Text-readChunk hh@Handle__{..} buf = do-  buf'@Buffer{..} <- getSomeCharacters hh buf-  (t,r) <- if haInputNL == CRLF-           then unpack_nl bufRaw bufL bufR-           else do t <- unpack bufRaw bufL bufR-                   return (t,bufR)-  writeIORef haCharBuffer (bufferAdjustL r buf')-  return t--sizeError :: String -> a-sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
− Data/Text/Internal/Lazy.hs 
@@ -1,119 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}-{-# OPTIONS_HADDOCK not-home #-}---- |--- Module      : Data.Text.Internal.Lazy--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ A module containing private 'Text' internals. This exposes the--- 'Text' representation and low level construction functions.--- Modules which extend the 'Text' system may need to use this module.--module Data.Text.Internal.Lazy-    (-      Text(..)-    , chunk-    , empty-    , foldrChunks-    , foldlChunks-    -- * Data type invariant and abstraction functions--    -- $invariant-    , strictInvariant-    , lazyInvariant-    , showStructure--    -- * Chunk allocation sizes-    , defaultChunkSize-    , smallChunkSize-    , chunkOverhead-    ) where--import Data.Text ()-import Data.Text.Internal.Unsafe.Shift (shiftL)-import Data.Typeable (Typeable)-import Foreign.Storable (sizeOf)-import qualified Data.Text.Internal as T--data Text = Empty-          | Chunk {-# UNPACK #-} !T.Text Text-            deriving (Typeable)---- $invariant------ The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or--- consists of non-null 'T.Text's.  All functions must preserve this,--- and the QC properties must check this.---- | Check the invariant strictly.-strictInvariant :: Text -> Bool-strictInvariant Empty = True-strictInvariant x@(Chunk (T.Text _ _ len) cs)-    | len > 0   = strictInvariant cs-    | otherwise = error $ "Data.Text.Lazy: invariant violation: "-                  ++ showStructure x---- | Check the invariant lazily.-lazyInvariant :: Text -> Text-lazyInvariant Empty = Empty-lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)-    | len > 0   = Chunk c (lazyInvariant cs)-    | otherwise = error $ "Data.Text.Lazy: invariant violation: "-                  ++ showStructure x---- | Display the internal structure of a lazy 'Text'.-showStructure :: Text -> String-showStructure Empty           = "Empty"-showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"-showStructure (Chunk t ts)    =-    "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"---- | Smart constructor for 'Chunk'. Guarantees the data type invariant.-chunk :: T.Text -> Text -> Text-{-# INLINE chunk #-}-chunk t@(T.Text _ _ len) ts | len == 0 = ts-                            | otherwise = Chunk t ts---- | Smart constructor for 'Empty'.-empty :: Text-{-# INLINE [0] empty #-}-empty = Empty---- | Consume the chunks of a lazy 'Text' with a natural right fold.-foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a-foldrChunks f z = go-  where go Empty        = z-        go (Chunk c cs) = f c (go cs)-{-# INLINE foldrChunks #-}---- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,--- accumulating left fold.-foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a-foldlChunks f z = go z-  where go !a Empty        = a-        go !a (Chunk c cs) = go (f a c) cs-{-# INLINE foldlChunks #-}---- | Currently set to 16 KiB, less the memory management overhead.-defaultChunkSize :: Int-defaultChunkSize = 16384 - chunkOverhead-{-# INLINE defaultChunkSize #-}---- | Currently set to 128 bytes, less the memory management overhead.-smallChunkSize :: Int-smallChunkSize = 128 - chunkOverhead-{-# INLINE smallChunkSize #-}---- | The memory management overhead. Currently this is tuned for GHC only.-chunkOverhead :: Int-chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1-{-# INLINE chunkOverhead #-}
− Data/Text/Internal/Lazy/Encoding/Fusion.hs 
@@ -1,324 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}---- |--- Module      : Data.Text.Lazy.Encoding.Fusion--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Fusible 'Stream'-oriented functions for converting between lazy--- 'Text' and several common encodings.--module Data.Text.Internal.Lazy.Encoding.Fusion-    (-    -- * Streaming-    --  streamASCII-      streamUtf8-    , streamUtf16LE-    , streamUtf16BE-    , streamUtf32LE-    , streamUtf32BE--    -- * Unstreaming-    , unstream--    , module Data.Text.Internal.Encoding.Fusion.Common-    ) where--import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)-import qualified Data.ByteString as B-import qualified Data.ByteString.Unsafe as B-import Data.Text.Internal.Encoding.Fusion.Common-import Data.Text.Encoding.Error-import Data.Text.Internal.Fusion (Step(..), Stream(..))-import Data.Text.Internal.Fusion.Size-import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)-import Data.Text.Internal.Unsafe.Shift (shiftL)-import Data.Word (Word8, Word16, Word32)-import qualified Data.Text.Internal.Encoding.Utf8 as U8-import qualified Data.Text.Internal.Encoding.Utf16 as U16-import qualified Data.Text.Internal.Encoding.Utf32 as U32-import Data.Text.Unsafe (unsafeDupablePerformIO)-import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)-import Foreign.Storable (pokeByteOff)-import Data.ByteString.Internal (mallocByteString, memcpy)-#if defined(ASSERTS)-import Control.Exception (assert)-#endif-import qualified Data.ByteString.Internal as B--data S = S0-       | S1 {-# UNPACK #-} !Word8-       | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8-       | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8-       | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8--data T = T !ByteString !S {-# UNPACK #-} !Int---- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using--- UTF-8 encoding.-streamUtf8 :: OnDecodeError -> ByteString -> Stream Char-streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize-  where-    next (T bs@(Chunk ps _) S0 i)-      | i < len && U8.validate1 a =-          Yield (unsafeChr8 a)    (T bs S0 (i+1))-      | i + 1 < len && U8.validate2 a b =-          Yield (U8.chr2 a b)     (T bs S0 (i+2))-      | i + 2 < len && U8.validate3 a b c =-          Yield (U8.chr3 a b c)   (T bs S0 (i+3))-      | i + 3 < len && U8.validate4 a b c d =-          Yield (U8.chr4 a b c d) (T bs S0 (i+4))-      where len = B.length ps-            a = B.unsafeIndex ps i-            b = B.unsafeIndex ps (i+1)-            c = B.unsafeIndex ps (i+2)-            d = B.unsafeIndex ps (i+3)-    next st@(T bs s i) =-      case s of-        S1 a       | U8.validate1 a       -> Yield (unsafeChr8 a)    es-        S2 a b     | U8.validate2 a b     -> Yield (U8.chr2 a b)     es-        S3 a b c   | U8.validate3 a b c   -> Yield (U8.chr3 a b c)   es-        S4 a b c d | U8.validate4 a b c d -> Yield (U8.chr4 a b c d) es-        _ -> consume st-       where es = T bs S0 i-    consume (T bs@(Chunk ps rest) s i)-        | i >= B.length ps = consume (T rest s 0)-        | otherwise =-      case s of-        S0         -> next (T bs (S1 x)       (i+1))-        S1 a       -> next (T bs (S2 a x)     (i+1))-        S2 a b     -> next (T bs (S3 a b x)   (i+1))-        S3 a b c   -> next (T bs (S4 a b c x) (i+1))-        S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)-                           (T bs (S3 b c d)   (i+1))-        where x = B.unsafeIndex ps i-    consume (T Empty S0 _) = Done-    consume st             = decodeError "streamUtf8" "UTF-8" onErr Nothing st-{-# INLINE [0] streamUtf8 #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little--- endian UTF-16 encoding.-streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char-streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize-  where-    next (T bs@(Chunk ps _) S0 i)-      | i + 1 < len && U16.validate1 x1 =-          Yield (unsafeChr x1)         (T bs S0 (i+2))-      | i + 3 < len && U16.validate2 x1 x2 =-          Yield (U16.chr2 x1 x2)       (T bs S0 (i+4))-      where len = B.length ps-            x1   = c (idx  i)      (idx (i + 1))-            x2   = c (idx (i + 2)) (idx (i + 3))-            c w1 w2 = w1 + (w2 `shiftL` 8)-            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16-    next st@(T bs s i) =-      case s of-        S2 w1 w2       | U16.validate1 (c w1 w2)           ->-          Yield (unsafeChr (c w1 w2))   es-        S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->-          Yield (U16.chr2 (c w1 w2) (c w3 w4)) es-        _ -> consume st-       where es = T bs S0 i-             c :: Word8 -> Word8 -> Word16-             c w1 w2 = fromIntegral w1 + (fromIntegral w2 `shiftL` 8)-    consume (T bs@(Chunk ps rest) s i)-        | i >= B.length ps = consume (T rest s 0)-        | otherwise =-      case s of-        S0             -> next (T bs (S1 x)          (i+1))-        S1 w1          -> next (T bs (S2 w1 x)       (i+1))-        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))-        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))-        S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)-                           (T bs (S3 w2 w3 w4)       (i+1))-        where x = B.unsafeIndex ps i-    consume (T Empty S0 _) = Done-    consume st             = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st-{-# INLINE [0] streamUtf16LE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big--- endian UTF-16 encoding.-streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char-streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize-  where-    next (T bs@(Chunk ps _) S0 i)-      | i + 1 < len && U16.validate1 x1 =-          Yield (unsafeChr x1)         (T bs S0 (i+2))-      | i + 3 < len && U16.validate2 x1 x2 =-          Yield (U16.chr2 x1 x2)       (T bs S0 (i+4))-      where len = B.length ps-            x1   = c (idx  i)      (idx (i + 1))-            x2   = c (idx (i + 2)) (idx (i + 3))-            c w1 w2 = (w1 `shiftL` 8) + w2-            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16-    next st@(T bs s i) =-      case s of-        S2 w1 w2       | U16.validate1 (c w1 w2)           ->-          Yield (unsafeChr (c w1 w2))   es-        S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->-          Yield (U16.chr2 (c w1 w2) (c w3 w4)) es-        _ -> consume st-       where es = T bs S0 i-             c :: Word8 -> Word8 -> Word16-             c w1 w2 = (fromIntegral w1 `shiftL` 8) + fromIntegral w2-    consume (T bs@(Chunk ps rest) s i)-        | i >= B.length ps = consume (T rest s 0)-        | otherwise =-      case s of-        S0             -> next (T bs (S1 x)          (i+1))-        S1 w1          -> next (T bs (S2 w1 x)       (i+1))-        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))-        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))-        S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)-                           (T bs (S3 w2 w3 w4)       (i+1))-        where x = B.unsafeIndex ps i-    consume (T Empty S0 _) = Done-    consume st             = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st-{-# INLINE [0] streamUtf16BE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big--- endian UTF-32 encoding.-streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char-streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize-  where-    next (T bs@(Chunk ps _) S0 i)-      | i + 3 < len && U32.validate x =-          Yield (unsafeChr32 x)       (T bs S0 (i+4))-      where len = B.length ps-            x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4-            x1    = idx i-            x2    = idx (i+1)-            x3    = idx (i+2)-            x4    = idx (i+3)-            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32-    next st@(T bs s i) =-      case s of-        S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->-          Yield (unsafeChr32 (c w1 w2 w3 w4)) es-        _ -> consume st-       where es = T bs S0 i-             c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-             c w1 w2 w3 w4 = shifted-              where-               shifted = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4-               x1 = fromIntegral w1-               x2 = fromIntegral w2-               x3 = fromIntegral w3-               x4 = fromIntegral w4-    consume (T bs@(Chunk ps rest) s i)-        | i >= B.length ps = consume (T rest s 0)-        | otherwise =-      case s of-        S0             -> next (T bs (S1 x)          (i+1))-        S1 w1          -> next (T bs (S2 w1 x)       (i+1))-        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))-        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))-        S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)-                           (T bs (S3 w2 w3 w4)       (i+1))-        where x = B.unsafeIndex ps i-    consume (T Empty S0 _) = Done-    consume st             = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st-{-# INLINE [0] streamUtf32BE #-}---- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little--- endian UTF-32 encoding.-streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char-streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize-  where-    next (T bs@(Chunk ps _) S0 i)-      | i + 3 < len && U32.validate x =-          Yield (unsafeChr32 x)       (T bs S0 (i+4))-      where len = B.length ps-            x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1-            x1    = idx i-            x2    = idx (i+1)-            x3    = idx (i+2)-            x4    = idx (i+3)-            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32-    next st@(T bs s i) =-      case s of-        S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->-          Yield (unsafeChr32 (c w1 w2 w3 w4)) es-        _ -> consume st-       where es = T bs S0 i-             c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-             c w1 w2 w3 w4 = shifted-              where-               shifted = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1-               x1 = fromIntegral w1-               x2 = fromIntegral w2-               x3 = fromIntegral w3-               x4 = fromIntegral w4-    consume (T bs@(Chunk ps rest) s i)-        | i >= B.length ps = consume (T rest s 0)-        | otherwise =-      case s of-        S0             -> next (T bs (S1 x)          (i+1))-        S1 w1          -> next (T bs (S2 w1 x)       (i+1))-        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))-        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))-        S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)-                           (T bs (S3 w2 w3 w4)       (i+1))-        where x = B.unsafeIndex ps i-    consume (T Empty S0 _) = Done-    consume st             = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st-{-# INLINE [0] streamUtf32LE #-}---- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.-unstreamChunks :: Int -> Stream Word8 -> ByteString-unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)-  where chunk s1 len1 = unsafeDupablePerformIO $ do-          let len = max 4 (min len1 chunkSize)-          mallocByteString len >>= loop len 0 s1-          where-            loop !n !off !s fp = case next s of-                Done | off == 0 -> return Empty-                     | otherwise -> return $! Chunk (trimUp fp off) Empty-                Skip s' -> loop n off s' fp-                Yield x s'-                    | off == chunkSize -> do-                      let !newLen = n - off-                      return $! Chunk (trimUp fp off) (chunk s newLen)-                    | off == n -> realloc fp n off s' x-                    | otherwise -> do-                      withForeignPtr fp $ \p -> pokeByteOff p off x-                      loop n (off+1) s' fp-            {-# NOINLINE realloc #-}-            realloc fp n off s x = do-              let n' = min (n+n) chunkSize-              fp' <- copy0 fp n n'-              withForeignPtr fp' $ \p -> pokeByteOff p off x-              loop n' (off+1) s fp'-            trimUp fp off = B.PS fp 0 off-            copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)-            copy0 !src !srcLen !destLen =-#if defined(ASSERTS)-              assert (srcLen <= destLen) $-#endif-              do-                dest <- mallocByteString destLen-                withForeignPtr src  $ \src'  ->-                    withForeignPtr dest $ \dest' ->-                        memcpy dest' src' (fromIntegral srcLen)-                return dest---- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.-unstream :: Stream Word8 -> ByteString-unstream = unstreamChunks defaultChunkSize--decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8-            -> s -> Step s Char-decodeError func kind onErr mb i =-    case onErr desc mb of-      Nothing -> Skip i-      Just c  -> Yield c i-    where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " ++-                 kind ++ " stream"
− Data/Text/Internal/Lazy/Fusion.hs 
@@ -1,120 +0,0 @@-{-# LANGUAGE BangPatterns #-}--- |--- Module      : Data.Text.Lazy.Fusion--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Core stream fusion functionality for text.--module Data.Text.Internal.Lazy.Fusion-    (-      stream-    , unstream-    , unstreamChunks-    , length-    , unfoldrN-    , index-    , countChar-    ) where--import Prelude hiding (length)-import qualified Data.Text.Internal.Fusion.Common as S-import Control.Monad.ST (runST)-import Data.Text.Internal.Fusion.Types-import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)-import Data.Text.Internal.Lazy-import qualified Data.Text.Internal as I-import qualified Data.Text.Array as A-import Data.Text.Internal.Unsafe.Char (unsafeWrite)-import Data.Text.Internal.Unsafe.Shift (shiftL)-import Data.Text.Unsafe (Iter(..), iter)-import Data.Int (Int64)--default(Int64)---- | /O(n)/ Convert a 'Text' into a 'Stream Char'.-stream :: Text -> Stream Char-stream text = Stream next (text :*: 0) unknownSize-  where-    next (Empty :*: _) = Done-    next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)-        | i >= len  = next (ts :*: 0)-        | otherwise = Yield c (txt :*: i+d)-        where Iter c d = iter t i-{-# INLINE [0] stream #-}---- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given--- chunk size.-unstreamChunks :: Int -> Stream Char -> Text-unstreamChunks !chunkSize (Stream next s0 len0)-  | isEmpty len0 = Empty-  | otherwise    = outer s0-  where-    outer so = {-# SCC "unstreamChunks/outer" #-}-              case next so of-                Done       -> Empty-                Skip s'    -> outer s'-                Yield x s' -> runST $ do-                                a <- A.new unknownLength-                                unsafeWrite a 0 x >>= inner a unknownLength s'-                    where unknownLength = 4-      where-        inner marr !len s !i-            | i + 1 >= chunkSize = finish marr i s-            | i + 1 >= len       = {-# SCC "unstreamChunks/resize" #-} do-                let newLen = min (len `shiftL` 1) chunkSize-                marr' <- A.new newLen-                A.copyM marr' 0 marr 0 len-                inner marr' newLen s i-            | otherwise =-                {-# SCC "unstreamChunks/inner" #-}-                case next s of-                  Done        -> finish marr i s-                  Skip s'     -> inner marr len s' i-                  Yield x s'  -> do d <- unsafeWrite marr i x-                                    inner marr len s' (i+d)-        finish marr len s' = do-          arr <- A.unsafeFreeze marr-          return (I.Text arr 0 len `Chunk` outer s')-{-# INLINE [0] unstreamChunks #-}---- | /O(n)/ Convert a 'Stream Char' into a 'Text', using--- 'defaultChunkSize'.-unstream :: Stream Char -> Text-unstream = unstreamChunks defaultChunkSize-{-# INLINE [0] unstream #-}---- | /O(n)/ Returns the number of characters in a text.-length :: Stream Char -> Int64-length = S.lengthI-{-# INLINE[0] length #-}--{-# RULES "LAZY STREAM stream/unstream fusion" forall s.-    stream (unstream s) = s #-}---- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed--- value. However, the length of the result is limited by the--- first argument to 'unfoldrN'. This function is more efficient than--- 'unfoldr' when the length of the result is known.-unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char-unfoldrN n = S.unfoldrNI n-{-# INLINE [0] unfoldrN #-}---- | /O(n)/ stream index (subscript) operator, starting from 0.-index :: Stream Char -> Int64 -> Char-index = S.indexI-{-# INLINE [0] index #-}---- | /O(n)/ The 'count' function returns the number of times the query--- element appears in the given stream.-countChar :: Char -> Stream Char -> Int64-countChar = S.countCharI-{-# INLINE [0] countChar #-}
− Data/Text/Internal/Lazy/Search.hs 
@@ -1,134 +0,0 @@-{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}---- |--- Module      : Data.Text.Lazy.Search--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Fast substring search for lazy 'Text', based on work by Boyer,--- Moore, Horspool, Sunday, and Lundh.  Adapted from the strict--- implementation.--module Data.Text.Internal.Lazy.Search-    (-      indices-    ) where--import qualified Data.Text.Array as A-import Data.Int (Int64)-import Data.Word (Word16, Word64)-import qualified Data.Text.Internal as T-import Data.Text.Internal.Fusion.Types (PairS(..))-import Data.Text.Internal.Lazy (Text(..), foldlChunks)-import Data.Bits ((.|.), (.&.))-import Data.Text.Internal.Unsafe.Shift (shiftL)---- | /O(n+m)/ Find the offsets of all non-overlapping indices of--- @needle@ within @haystack@.------ This function is strict in @needle@, and lazy (as far as possible)--- in the chunks of @haystack@.------ In (unlikely) bad cases, this algorithm's complexity degrades--- towards /O(n*m)/.-indices :: Text              -- ^ Substring to search for (@needle@)-        -> Text              -- ^ Text to search in (@haystack@)-        -> [Int64]-indices needle@(Chunk n ns) _haystack@(Chunk k ks)-    | nlen <= 0  = []-    | nlen == 1  = indicesOne (nindex 0) 0 k ks-    | otherwise  = advance k ks 0 0-  where-    advance x@(T.Text _ _ l) xs = scan-     where-      scan !g !i-         | i >= m = case xs of-                      Empty           -> []-                      Chunk y ys      -> advance y ys g (i-m)-         | lackingHay (i + nlen) x xs  = []-         | c == z && candidateMatch 0  = g : scan (g+nlen) (i+nlen)-         | otherwise                   = scan (g+delta) (i+delta)-       where-         m = fromIntegral l-         c = hindex (i + nlast)-         delta | nextInPattern = nlen + 1-               | c == z        = skip + 1-               | otherwise     = 1-         nextInPattern         = mask .&. swizzle (hindex (i+nlen)) == 0-         candidateMatch !j-             | j >= nlast               = True-             | hindex (i+j) /= nindex j = False-             | otherwise                = candidateMatch (j+1)-         hindex                         = index x xs-    nlen      = wordLength needle-    nlast     = nlen - 1-    nindex    = index n ns-    z         = foldlChunks fin 0 needle-        where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)-    (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)-    swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)-    buildTable (T.Text xarr xoff xlen) xs = go-      where-        go !(g::Int64) !i !msk !skp-            | i >= xlast = case xs of-                             Empty      -> (msk .|. swizzle z) :*: skp-                             Chunk y ys -> buildTable y ys g 0 msk' skp'-            | otherwise = go (g+1) (i+1) msk' skp'-            where c                = A.unsafeIndex xarr (xoff+i)-                  msk'             = msk .|. swizzle c-                  skp' | c == z    = nlen - g - 2-                       | otherwise = skp-                  xlast = xlen - 1-    -- | Check whether an attempt to index into the haystack at the-    -- given offset would fail.-    lackingHay q = go 0-      where-        go p (T.Text _ _ l) ps = p' < q && case ps of-                                             Empty      -> True-                                             Chunk r rs -> go p' r rs-            where p' = p + fromIntegral l-indices _ _ = []---- | Fast index into a partly unpacked 'Text'.  We take into account--- the possibility that the caller might try to access one element--- past the end.-index :: T.Text -> Text -> Int64 -> Word16-index (T.Text arr off len) xs !i-    | j < len   = A.unsafeIndex arr (off+j)-    | otherwise = case xs of-                    Empty-                        -- out of bounds, but legal-                        | j == len  -> 0-                        -- should never happen, due to lackingHay above-                        | otherwise -> emptyError "index"-                    Chunk c cs -> index c cs (i-fromIntegral len)-    where j = fromIntegral i---- | A variant of 'indices' that scans linearly for a single 'Word16'.-indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]-indicesOne c = chunk-  where-    chunk !i (T.Text oarr ooff olen) os = go 0-      where-        go h | h >= olen = case os of-                             Empty      -> []-                             Chunk y ys -> chunk (i+fromIntegral olen) y ys-             | on == c = i + fromIntegral h : go (h+1)-             | otherwise = go (h+1)-             where on = A.unsafeIndex oarr (ooff+h)---- | The number of 'Word16' values in a 'Text'.-wordLength :: Text -> Int64-wordLength = foldlChunks sumLength 0-    where sumLength i (T.Text _ _ l) = i + fromIntegral l--emptyError :: String -> a-emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
− Data/Text/Internal/Private.hs 
@@ -1,37 +0,0 @@-{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}---- |--- Module      : Data.Text.Internal.Private--- Copyright   : (c) 2011 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC--module Data.Text.Internal.Private-    (-      runText-    , span_-    ) where--import Control.Monad.ST (ST, runST)-import Data.Text.Internal (Text(..), text)-import Data.Text.Unsafe (Iter(..), iter)-import qualified Data.Text.Array as A--span_ :: (Char -> Bool) -> Text -> (# Text, Text #)-span_ p t@(Text arr off len) = (# hd,tl #)-  where hd = text arr off k-        tl = text arr (off+k) (len-k)-        !k = loop 0-        loop !i | i < len && p c = loop (i+d)-                | otherwise      = i-            where Iter c d       = iter t i-{-# INLINE span_ #-}--runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text-runText act = runST (act $ \ !marr !len -> do-                             arr <- A.unsafeFreeze marr-                             return $! text arr 0 len)-{-# INLINE runText #-}
− Data/Text/Internal/Read.hs 
@@ -1,69 +0,0 @@--- |--- Module      : Data.Text.Internal.Read--- Copyright   : (c) 2014 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ Common internal functions for reading textual data.-module Data.Text.Internal.Read-    (-      IReader-    , IParser(..)-    , T(..)-    , digitToInt-    , hexDigitToInt-    , perhaps-    ) where--import Control.Applicative as App (Applicative(..))-import Control.Arrow (first)-import Control.Monad (ap)-import Data.Char (ord)--type IReader t a = t -> Either String (a,t)--newtype IParser t a = P {-      runP :: IReader t a-    }--instance Functor (IParser t) where-    fmap f m = P $ fmap (first f) . runP m--instance Applicative (IParser t) where-    pure a = P $ \t -> Right (a,t)-    {-# INLINE pure #-}-    (<*>) = ap--instance Monad (IParser t) where-    return = App.pure-    m >>= k  = P $ \t -> case runP m t of-                           Left err     -> Left err-                           Right (a,t') -> runP (k a) t'-    {-# INLINE (>>=) #-}---- If we ever need a `MonadFail` instance the definition below can be used------ > instance MonadFail (IParser t) where--- >   fail msg = P $ \_ -> Left msg------ But given the code compiles fine with a post-MFP GHC 8.6+ we don't need--- one just yet.--data T = T !Integer !Int--perhaps :: a -> IParser t a -> IParser t a-perhaps def m = P $ \t -> case runP m t of-                            Left _      -> Right (def,t)-                            r@(Right _) -> r--hexDigitToInt :: Char -> Int-hexDigitToInt c-    | c >= '0' && c <= '9' = ord c - ord '0'-    | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)-    | otherwise            = ord c - (ord 'A' - 10)--digitToInt :: Char -> Int-digitToInt c = ord c - ord '0'
− Data/Text/Internal/Search.hs 
@@ -1,89 +0,0 @@-{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}---- |--- Module      : Data.Text.Internal.Search--- Copyright   : (c) Bryan O'Sullivan 2009------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ Fast substring search for 'Text', based on work by Boyer, Moore,--- Horspool, Sunday, and Lundh.------ References:------ * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.---   Communications of the ACM, 20, 10, 762-772 (1977)------ * R. N. Horspool: Practical Fast Searching in Strings.  Software ----   Practice and Experience 10, 501-506 (1980)------ * D. M. Sunday: A Very Fast Substring Search Algorithm.---   Communications of the ACM, 33, 8, 132-142 (1990)------ * F. Lundh: The Fast Search Algorithm.---   <http://effbot.org/zone/stringlib.htm> (2006)--module Data.Text.Internal.Search-    (-      indices-    ) where--import qualified Data.Text.Array as A-import Data.Word (Word64)-import Data.Text.Internal (Text(..))-import Data.Bits ((.|.), (.&.))-import Data.Text.Internal.Unsafe.Shift (shiftL)--data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int---- | /O(n+m)/ Find the offsets of all non-overlapping indices of--- @needle@ within @haystack@.  The offsets returned represent--- uncorrected indices in the low-level \"needle\" array, to which its--- offset must be added.------ In (unlikely) bad cases, this algorithm's complexity degrades--- towards /O(n*m)/.-indices :: Text                -- ^ Substring to search for (@needle@)-        -> Text                -- ^ Text to search in (@haystack@)-        -> [Int]-indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)-    | nlen == 1              = scanOne (nindex 0)-    | nlen <= 0 || ldiff < 0 = []-    | otherwise              = scan 0-  where-    ldiff    = hlen - nlen-    nlast    = nlen - 1-    z        = nindex nlast-    nindex k = A.unsafeIndex narr (noff+k)-    hindex k = A.unsafeIndex harr (hoff+k)-    hindex' k | k == hlen  = 0-              | otherwise = A.unsafeIndex harr (hoff+k)-    buildTable !i !msk !skp-        | i >= nlast           = (msk .|. swizzle z) :* skp-        | otherwise            = buildTable (i+1) (msk .|. swizzle c) skp'-        where c                = nindex i-              skp' | c == z    = nlen - i - 2-                   | otherwise = skp-    swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)-    scan !i-        | i > ldiff                  = []-        | c == z && candidateMatch 0 = i : scan (i + nlen)-        | otherwise                  = scan (i + delta)-        where c = hindex (i + nlast)-              candidateMatch !j-                    | j >= nlast               = True-                    | hindex (i+j) /= nindex j = False-                    | otherwise                = candidateMatch (j+1)-              delta | nextInPattern = nlen + 1-                    | c == z        = skip + 1-                    | otherwise     = 1-                where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0-              !(mask :* skip)       = buildTable 0 0 (nlen-2)-    scanOne c = loop 0-        where loop !i | i >= hlen     = []-                      | hindex i == c = i : loop (i+1)-                      | otherwise     = loop (i+1)-{-# INLINE indices #-}
− Data/Text/Internal/Unsafe.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}-{-# OPTIONS_HADDOCK not-home #-}---- |--- Module      : Data.Text.Internal.Unsafe--- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan--- License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : portable------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ A module containing /unsafe/ operations, for /very very careful/ use--- in /heavily tested/ code.-module Data.Text.Internal.Unsafe-    (-      inlineInterleaveST-    , inlinePerformIO-    ) where--import GHC.ST (ST(..))-#if defined(__GLASGOW_HASKELL__)-import GHC.IO (IO(IO))-import GHC.Base (realWorld#)-#endif----- | Just like unsafePerformIO, but we inline it. Big performance gains as--- it exposes lots of things to further inlining. /Very unsafe/. In--- particular, you should do no memory allocation inside an--- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.----{-# INLINE inlinePerformIO #-}-inlinePerformIO :: IO a -> a-#if defined(__GLASGOW_HASKELL__)-inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r-#else-inlinePerformIO = unsafePerformIO-#endif---- | Allow an 'ST' computation to be deferred lazily. When passed an--- action of type 'ST' @s@ @a@, the action will only be performed when--- the value of @a@ is demanded.------ This function is identical to the normal unsafeInterleaveST, but is--- inlined and hence faster.------ /Note/: This operation is highly unsafe, as it can introduce--- externally visible non-determinism into an 'ST' action.-inlineInterleaveST :: ST s a -> ST s a-inlineInterleaveST (ST m) = ST $ \ s ->-    let r = case m s of (# _, res #) -> res in (# s, r #)-{-# INLINE inlineInterleaveST #-}
− Data/Text/Internal/Unsafe/Char.hs 
@@ -1,95 +0,0 @@-{-# LANGUAGE CPP, MagicHash #-}---- |--- Module      : Data.Text.Internal.Unsafe.Char--- Copyright   : (c) 2008, 2009 Tom Harper,---               (c) 2009, 2010 Bryan O'Sullivan,---               (c) 2009 Duncan Coutts------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Fast character manipulation functions.-module Data.Text.Internal.Unsafe.Char-    (-      ord-    , unsafeChr-    , unsafeChr8-    , unsafeChr32-    , unsafeWrite-    -- , unsafeWriteRev-    ) where--#ifdef ASSERTS-import Control.Exception (assert)-#endif-import Control.Monad.ST (ST)-import Data.Bits ((.&.))-import Data.Text.Internal.Unsafe.Shift (shiftR)-import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)-import GHC.Word (Word8(..), Word16(..), Word32(..))-import qualified Data.Text.Array as A--ord :: Char -> Int-ord (C# c#) = I# (ord# c#)-{-# INLINE ord #-}--unsafeChr :: Word16 -> Char-unsafeChr (W16# w#) = C# (chr# (word2Int# w#))-{-# INLINE unsafeChr #-}--unsafeChr8 :: Word8 -> Char-unsafeChr8 (W8# w#) = C# (chr# (word2Int# w#))-{-# INLINE unsafeChr8 #-}--unsafeChr32 :: Word32 -> Char-unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))-{-# INLINE unsafeChr32 #-}---- | Write a character into the array at the given offset.  Returns--- the number of 'Word16's written.-unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int-unsafeWrite marr i c-    | n < 0x10000 = do-#if defined(ASSERTS)-        assert (i >= 0) . assert (i < A.length marr) $ return ()-#endif-        A.unsafeWrite marr i (fromIntegral n)-        return 1-    | otherwise = do-#if defined(ASSERTS)-        assert (i >= 0) . assert (i < A.length marr - 1) $ return ()-#endif-        A.unsafeWrite marr i lo-        A.unsafeWrite marr (i+1) hi-        return 2-    where n = ord c-          m = n - 0x10000-          lo = fromIntegral $ (m `shiftR` 10) + 0xD800-          hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00-{-# INLINE unsafeWrite #-}--{--unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int-unsafeWriteRev marr i c-    | n < 0x10000 = do-        assert (i >= 0) . assert (i < A.length marr) $-          A.unsafeWrite marr i (fromIntegral n)-        return (i-1)-    | otherwise = do-        assert (i >= 1) . assert (i < A.length marr) $-          A.unsafeWrite marr (i-1) lo-        A.unsafeWrite marr i hi-        return (i-2)-    where n = ord c-          m = n - 0x10000-          lo = fromIntegral $ (m `shiftR` 10) + 0xD800-          hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00-{-# INLINE unsafeWriteRev #-}--}
− Data/Text/Internal/Unsafe/Shift.hs 
@@ -1,72 +0,0 @@-{-# LANGUAGE MagicHash #-}---- |--- Module      : Data.Text.Internal.Unsafe.Shift--- Copyright   : (c) Bryan O'Sullivan 2009------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ /Warning/: this is an internal module, and does not have a stable--- API or name. Functions in this module may not check or enforce--- preconditions expected by public modules. Use at your own risk!------ Fast, unchecked bit shifting functions.--module Data.Text.Internal.Unsafe.Shift-    (-      UnsafeShift(..)-    ) where---- import qualified Data.Bits as Bits-import GHC.Base-import GHC.Word---- | This is a workaround for poor optimisation in GHC 6.8.2.  It--- fails to notice constant-width shifts, and adds a test and branch--- to every shift.  This imposes about a 10% performance hit.------ These functions are undefined when the amount being shifted by is--- greater than the size in bits of a machine Int#.-class UnsafeShift a where-    shiftL :: a -> Int -> a-    shiftR :: a -> Int -> a--instance UnsafeShift Word16 where-    {-# INLINE shiftL #-}-    shiftL (W16# x#) (I# i#) = W16# (narrow16Word# (x# `uncheckedShiftL#` i#))--    {-# INLINE shiftR #-}-    shiftR (W16# x#) (I# i#) = W16# (x# `uncheckedShiftRL#` i#)--instance UnsafeShift Word32 where-    {-# INLINE shiftL #-}-    shiftL (W32# x#) (I# i#) = W32# (narrow32Word# (x# `uncheckedShiftL#` i#))--    {-# INLINE shiftR #-}-    shiftR (W32# x#) (I# i#) = W32# (x# `uncheckedShiftRL#` i#)--instance UnsafeShift Word64 where-    {-# INLINE shiftL #-}-    shiftL (W64# x#) (I# i#) = W64# (x# `uncheckedShiftL64#` i#)--    {-# INLINE shiftR #-}-    shiftR (W64# x#) (I# i#) = W64# (x# `uncheckedShiftRL64#` i#)--instance UnsafeShift Int where-    {-# INLINE shiftL #-}-    shiftL (I# x#) (I# i#) = I# (x# `iShiftL#` i#)--    {-# INLINE shiftR #-}-    shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)--{--instance UnsafeShift Integer where-    {-# INLINE shiftL #-}-    shiftL = Bits.shiftL--    {-# INLINE shiftR #-}-    shiftR = Bits.shiftR--}
− Data/Text/Lazy.hs 
@@ -1,1746 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE BangPatterns, MagicHash, CPP, TypeFamilies #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--- Using TemplateHaskell in text unconditionally is unacceptable, as--- it's a GHC boot library. TemplateHaskellQuotes was added in 8.0, so--- this would seem to be a problem. However, GHC's policy of only--- needing to be able to compile itself from the last few releases--- allows us to use full-fat TH on older versions, while using THQ for--- GHC versions that may be used for bootstrapping.-#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE TemplateHaskellQuotes #-}-#else-{-# LANGUAGE TemplateHaskell #-}-#endif---- |--- Module      : Data.Text.Lazy--- Copyright   : (c) 2009, 2010, 2012 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : GHC------ A time and space-efficient implementation of Unicode text using--- lists of packed arrays.------ /Note/: Read below the synopsis for important notes on the use of--- this module.------ The representation used by this module is suitable for high--- performance use and for streaming large quantities of data.  It--- provides a means to manipulate a large body of text without--- requiring that the entire content be resident in memory.------ Some operations, such as 'concat', 'append', 'reverse' and 'cons',--- have better time complexity than their "Data.Text" equivalents, due--- to the underlying representation being a list of chunks. For other--- operations, lazy 'Text's are usually within a few percent of strict--- ones, but often with better heap usage if used in a streaming--- fashion. For data larger than available memory, or if you have--- tight memory constraints, this module will be the only option.------ This module is intended to be imported @qualified@, to avoid name--- clashes with "Prelude" functions.  eg.------ > import qualified Data.Text.Lazy as L--module Data.Text.Lazy-    (-    -- * Fusion-    -- $fusion--    -- * Acceptable data-    -- $replacement--    -- * Types-      Text--    -- * Creation and elimination-    , pack-    , unpack-    , singleton-    , empty-    , fromChunks-    , toChunks-    , toStrict-    , fromStrict-    , foldrChunks-    , foldlChunks--    -- * Basic interface-    , cons-    , snoc-    , append-    , uncons-    , unsnoc-    , head-    , last-    , tail-    , init-    , null-    , length-    , compareLength--    -- * Transformations-    , map-    , intercalate-    , intersperse-    , transpose-    , reverse-    , replace--    -- ** Case conversion-    -- $case-    , toCaseFold-    , toLower-    , toUpper-    , toTitle--    -- ** Justification-    , justifyLeft-    , justifyRight-    , center--    -- * Folds-    , foldl-    , foldl'-    , foldl1-    , foldl1'-    , foldr-    , foldr1--    -- ** Special folds-    , concat-    , concatMap-    , any-    , all-    , maximum-    , minimum--    -- * Construction--    -- ** Scans-    , scanl-    , scanl1-    , scanr-    , scanr1--    -- ** Accumulating maps-    , mapAccumL-    , mapAccumR--    -- ** Generation and unfolding-    , repeat-    , replicate-    , cycle-    , iterate-    , unfoldr-    , unfoldrN--    -- * Substrings--    -- ** Breaking strings-    , take-    , takeEnd-    , drop-    , dropEnd-    , takeWhile-    , takeWhileEnd-    , dropWhile-    , dropWhileEnd-    , dropAround-    , strip-    , stripStart-    , stripEnd-    , splitAt-    , span-    , breakOn-    , breakOnEnd-    , break-    , group-    , groupBy-    , inits-    , tails--    -- ** Breaking into many substrings-    -- $split-    , splitOn-    , split-    , chunksOf-    -- , breakSubstring--    -- ** Breaking into lines and words-    , lines-    , words-    , unlines-    , unwords--    -- * Predicates-    , isPrefixOf-    , isSuffixOf-    , isInfixOf--    -- ** View patterns-    , stripPrefix-    , stripSuffix-    , commonPrefixes--    -- * Searching-    , filter-    , find-    , breakOnAll-    , partition--    -- , findSubstring--    -- * Indexing-    , index-    , count--    -- * Zipping and unzipping-    , zip-    , zipWith--    -- -* Ordered text-    -- , sort-    ) where--import Prelude (Char, Bool(..), Maybe(..), String,-                Eq(..), Ord(..), Ordering(..), Read(..), Show(..),-                (&&), (||), (+), (-), (.), ($), (++),-                error, flip, fmap, fromIntegral, not, otherwise, quot)-import qualified Prelude as P-import Control.DeepSeq (NFData(..))-import Data.Int (Int64)-import qualified Data.List as L-import Data.Char (isSpace)-import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,-                  Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))-import Data.Binary (Binary(get, put))-import Data.Monoid (Monoid(..))-#if MIN_VERSION_base(4,9,0)-import Data.Semigroup (Semigroup(..))-#endif-import Data.String (IsString(..))-import qualified Data.Text as T-import qualified Data.Text.Internal as T-import qualified Data.Text.Internal.Fusion.Common as S-import qualified Data.Text.Unsafe as T-import qualified Data.Text.Internal.Lazy.Fusion as S-import Data.Text.Internal.Fusion.Types (PairS(..))-import Data.Text.Internal.Lazy.Fusion (stream, unstream)-import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,-                                foldrChunks, smallChunkSize)-import Data.Text.Internal (firstf, safe, text)-import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)-import qualified Data.Text.Internal.Functions as F-import Data.Text.Internal.Lazy.Search (indices)-#if __GLASGOW_HASKELL__ >= 702-import qualified GHC.CString as GHC-#else-import qualified GHC.Base as GHC-#endif-#if MIN_VERSION_base(4,7,0)-import qualified GHC.Exts as Exts-#endif-import GHC.Prim (Addr#)-import qualified Language.Haskell.TH.Lib as TH-import Language.Haskell.TH.Syntax (Lift, lift)-#if MIN_VERSION_base(4,7,0)-import Text.Printf (PrintfArg, formatArg, formatString)-#endif---- $fusion------ Most of the functions in this module are subject to /fusion/,--- meaning that a pipeline of such functions will usually allocate at--- most one 'Text' value.------ As an example, consider the following pipeline:------ > import Data.Text.Lazy as T--- > import Data.Text.Lazy.Encoding as E--- > import Data.ByteString.Lazy (ByteString)--- >--- > countChars :: ByteString -> Int--- > countChars = T.length . T.toUpper . E.decodeUtf8------ From the type signatures involved, this looks like it should--- allocate one 'ByteString' value, and two 'Text' values. However,--- when a module is compiled with optimisation enabled under GHC, the--- two intermediate 'Text' values will be optimised away, and the--- function will be compiled down to a single loop over the source--- 'ByteString'.------ Functions that can be fused by the compiler are documented with the--- phrase \"Subject to fusion\".---- $replacement------ A 'Text' value is a sequence of Unicode scalar values, as defined--- in--- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.--- As such, a 'Text' cannot contain values in the range U+D800 to--- U+DFFF inclusive. Haskell implementations admit all Unicode code--- points--- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)--- as 'Char' values, including code points from this invalid range.--- This means that there are some 'Char' values that are not valid--- Unicode scalar values, and the functions in this module must handle--- those cases.------ Within this module, many functions construct a 'Text' from one or--- more 'Char' values. Those functions will substitute 'Char' values--- that are not valid Unicode scalar values with the replacement--- character \"&#xfffd;\" (U+FFFD).  Functions that perform this--- inspection and replacement are documented with the phrase--- \"Performs replacement on invalid scalar values\".------ (One reason for this policy of replacement is that internally, a--- 'Text' value is represented as packed UTF-16 data. Values in the--- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate--- code points, and so cannot be represented. The functions replace--- invalid scalar values, instead of dropping them, as a security--- measure. For details, see--- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)--equal :: Text -> Text -> Bool-equal Empty Empty = True-equal Empty _     = False-equal _ Empty     = False-equal (Chunk a as) (Chunk b bs) =-    case compare lenA lenB of-      LT -> a == (T.takeWord16 lenA b) &&-            as `equal` Chunk (T.dropWord16 lenA b) bs-      EQ -> a == b && as `equal` bs-      GT -> T.takeWord16 lenB a == b &&-            Chunk (T.dropWord16 lenB a) as `equal` bs-  where lenA = T.lengthWord16 a-        lenB = T.lengthWord16 b--instance Eq Text where-    (==) = equal-    {-# INLINE (==) #-}--instance Ord Text where-    compare = compareText--compareText :: Text -> Text -> Ordering-compareText Empty Empty = EQ-compareText Empty _     = LT-compareText _     Empty = GT-compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0- where-  outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0-   where-    go !i !j-      | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)-      | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs-      | a < b     = LT-      | a > b     = GT-      | otherwise = go (i+di) (j+dj)-      where T.Iter a di = T.iter ta i-            T.Iter b dj = T.iter tb j--instance Show Text where-    showsPrec p ps r = showsPrec p (unpack ps) r--instance Read Text where-    readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]--#if MIN_VERSION_base(4,9,0)--- | Non-orphan 'Semigroup' instance only defined for--- @base-4.9.0.0@ and later; orphan instances for older GHCs are--- provided by--- the [semigroups](http://hackage.haskell.org/package/semigroups)--- package------ @since 1.2.2.0-instance Semigroup Text where-    (<>) = append-#endif--instance Monoid Text where-    mempty  = empty-#if MIN_VERSION_base(4,9,0)-    mappend = (<>) -- future-proof definition-#else-    mappend = append-#endif-    mconcat = concat--instance IsString Text where-    fromString = pack--#if MIN_VERSION_base(4,7,0)--- | @since 1.2.0.0-instance Exts.IsList Text where-    type Item Text = Char-    fromList       = pack-    toList         = unpack-#endif--instance NFData Text where-    rnf Empty        = ()-    rnf (Chunk _ ts) = rnf ts---- | @since 1.2.1.0-instance Binary Text where-    put t = put (encodeUtf8 t)-    get   = do-      bs <- get-      case decodeUtf8' bs of-        P.Left exn -> P.fail (P.show exn)-        P.Right a -> P.return a---- | This instance preserves data abstraction at the cost of inefficiency.--- We omit reflection services for the sake of data abstraction.------ This instance was created by copying the updated behavior of--- @"Data.Text".@'Data.Text.Text'-instance Data Text where-  gfoldl f z txt = z pack `f` (unpack txt)-  toConstr _     = packConstr-  gunfold k z c  = case constrIndex c of-    1 -> k (z pack)-    _ -> error "Data.Text.Lazy.Text.gunfold"-  dataTypeOf _   = textDataType---- | This instance has similar considerations to the 'Data' instance:--- it preserves abstraction at the cost of inefficiency.------ @since 1.2.4.0-instance Lift Text where-  lift = TH.appE (TH.varE 'pack) . TH.stringE . unpack--#if MIN_VERSION_base(4,7,0)--- | Only defined for @base-4.7.0.0@ and later------ @since 1.2.2.0-instance PrintfArg Text where-  formatArg txt = formatString $ unpack txt-#endif--packConstr :: Constr-packConstr = mkConstr textDataType "pack" [] Prefix--textDataType :: DataType-textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]---- | /O(n)/ Convert a 'String' into a 'Text'.------ Subject to fusion.  Performs replacement on invalid scalar values.-pack :: String -> Text-pack = unstream . S.streamList . L.map safe-{-# INLINE [1] pack #-}---- | /O(n)/ Convert a 'Text' into a 'String'.--- Subject to fusion.-unpack :: Text -> String-unpack t = S.unstreamList (stream t)-{-# INLINE [1] unpack #-}---- | /O(n)/ Convert a literal string into a Text.-unpackCString# :: Addr# -> Text-unpackCString# addr# = unstream (S.streamCString# addr#)-{-# NOINLINE unpackCString# #-}--{-# RULES "TEXT literal" forall a.-    unstream (S.streamList (L.map safe (GHC.unpackCString# a)))-      = unpackCString# a #-}--{-# RULES "TEXT literal UTF8" forall a.-    unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))-      = unpackCString# a #-}--{-# RULES "LAZY TEXT empty literal"-    unstream (S.streamList (L.map safe []))-      = Empty #-}--{-# RULES "LAZY TEXT empty literal" forall a.-    unstream (S.streamList (L.map safe [a]))-      = Chunk (T.singleton a) Empty #-}---- | /O(1)/ Convert a character into a Text.  Subject to fusion.--- Performs replacement on invalid scalar values.-singleton :: Char -> Text-singleton c = Chunk (T.singleton c) Empty-{-# INLINE [1] singleton #-}--{-# RULES-"LAZY TEXT singleton -> fused" [~1] forall c.-    singleton c = unstream (S.singleton c)-"LAZY TEXT singleton -> unfused" [1] forall c.-    unstream (S.singleton c) = singleton c-  #-}---- | /O(c)/ Convert a list of strict 'T.Text's into a lazy 'Text'.-fromChunks :: [T.Text] -> Text-fromChunks cs = L.foldr chunk Empty cs---- | /O(n)/ Convert a lazy 'Text' into a list of strict 'T.Text's.-toChunks :: Text -> [T.Text]-toChunks cs = foldrChunks (:) [] cs---- | /O(n)/ Convert a lazy 'Text' into a strict 'T.Text'.-toStrict :: Text -> T.Text-toStrict t = T.concat (toChunks t)-{-# INLINE [1] toStrict #-}---- | /O(c)/ Convert a strict 'T.Text' into a lazy 'Text'.-fromStrict :: T.Text -> Text-fromStrict t = chunk t Empty-{-# INLINE [1] fromStrict #-}---- -------------------------------------------------------------------------------- * Basic functions---- | /O(1)/ Adds a character to the front of a 'Text'.  Subject to fusion.-cons :: Char -> Text -> Text-cons c t = Chunk (T.singleton c) t-{-# INLINE [1] cons #-}--infixr 5 `cons`--{-# RULES-"LAZY TEXT cons -> fused" [~1] forall c t.-    cons c t = unstream (S.cons c (stream t))-"LAZY TEXT cons -> unfused" [1] forall c t.-    unstream (S.cons c (stream t)) = cons c t- #-}---- | /O(n)/ Adds a character to the end of a 'Text'.  This copies the--- entire array in the process, unless fused.  Subject to fusion.-snoc :: Text -> Char -> Text-snoc t c = foldrChunks Chunk (singleton c) t-{-# INLINE [1] snoc #-}--{-# RULES-"LAZY TEXT snoc -> fused" [~1] forall t c.-    snoc t c = unstream (S.snoc (stream t) c)-"LAZY TEXT snoc -> unfused" [1] forall t c.-    unstream (S.snoc (stream t) c) = snoc t c- #-}---- | /O(n\/c)/ Appends one 'Text' to another.  Subject to fusion.-append :: Text -> Text -> Text-append xs ys = foldrChunks Chunk ys xs-{-# INLINE [1] append #-}--{-# RULES-"LAZY TEXT append -> fused" [~1] forall t1 t2.-    append t1 t2 = unstream (S.append (stream t1) (stream t2))-"LAZY TEXT append -> unfused" [1] forall t1 t2.-    unstream (S.append (stream t1) (stream t2)) = append t1 t2- #-}---- | /O(1)/ Returns the first character and rest of a 'Text', or--- 'Nothing' if empty. Subject to fusion.-uncons :: Text -> Maybe (Char, Text)-uncons Empty        = Nothing-uncons (Chunk t ts) = Just (T.unsafeHead t, ts')-  where ts' | T.compareLength t 1 == EQ = ts-            | otherwise                 = Chunk (T.unsafeTail t) ts-{-# INLINE uncons #-}---- | /O(1)/ Returns the first character of a 'Text', which must be--- non-empty.  Subject to fusion.-head :: Text -> Char-head t = S.head (stream t)-{-# INLINE head #-}---- | /O(1)/ Returns all characters after the head of a 'Text', which--- must be non-empty.  Subject to fusion.-tail :: Text -> Text-tail (Chunk t ts) = chunk (T.tail t) ts-tail Empty        = emptyError "tail"-{-# INLINE [1] tail #-}--{-# RULES-"LAZY TEXT tail -> fused" [~1] forall t.-    tail t = unstream (S.tail (stream t))-"LAZY TEXT tail -> unfused" [1] forall t.-    unstream (S.tail (stream t)) = tail t- #-}---- | /O(n\/c)/ Returns all but the last character of a 'Text', which must--- be non-empty.  Subject to fusion.-init :: Text -> Text-init (Chunk t0 ts0) = go t0 ts0-    where go t (Chunk t' ts) = Chunk t (go t' ts)-          go t Empty         = chunk (T.init t) Empty-init Empty = emptyError "init"-{-# INLINE [1] init #-}--{-# RULES-"LAZY TEXT init -> fused" [~1] forall t.-    init t = unstream (S.init (stream t))-"LAZY TEXT init -> unfused" [1] forall t.-    unstream (S.init (stream t)) = init t- #-}---- | /O(n\/c)/ Returns the 'init' and 'last' of a 'Text', or 'Nothing' if--- empty.------ * It is no faster than using 'init' and 'last'.------ @since 1.2.3.0-unsnoc :: Text -> Maybe (Text, Char)-unsnoc Empty          = Nothing-unsnoc ts@(Chunk _ _) = Just (init ts, last ts)-{-# INLINE unsnoc #-}---- | /O(1)/ Tests whether a 'Text' is empty or not.  Subject to--- fusion.-null :: Text -> Bool-null Empty = True-null _     = False-{-# INLINE [1] null #-}--{-# RULES-"LAZY TEXT null -> fused" [~1] forall t.-    null t = S.null (stream t)-"LAZY TEXT null -> unfused" [1] forall t.-    S.null (stream t) = null t- #-}---- | /O(1)/ Tests whether a 'Text' contains exactly one character.--- Subject to fusion.-isSingleton :: Text -> Bool-isSingleton = S.isSingleton . stream-{-# INLINE isSingleton #-}---- | /O(n\/c)/ Returns the last character of a 'Text', which must be--- non-empty.  Subject to fusion.-last :: Text -> Char-last Empty        = emptyError "last"-last (Chunk t ts) = go t ts-    where go _ (Chunk t' ts') = go t' ts'-          go t' Empty         = T.last t'-{-# INLINE [1] last #-}--{-# RULES-"LAZY TEXT last -> fused" [~1] forall t.-    last t = S.last (stream t)-"LAZY TEXT last -> unfused" [1] forall t.-    S.last (stream t) = last t-  #-}---- | /O(n)/ Returns the number of characters in a 'Text'.--- Subject to fusion.-length :: Text -> Int64-length = foldlChunks go 0-    where go l t = l + fromIntegral (T.length t)-{-# INLINE [1] length #-}--{-# RULES-"LAZY TEXT length -> fused" [~1] forall t.-    length t = S.length (stream t)-"LAZY TEXT length -> unfused" [1] forall t.-    S.length (stream t) = length t- #-}---- | /O(n)/ Compare the count of characters in a 'Text' to a number.--- Subject to fusion.------ This function gives the same answer as comparing against the result--- of 'length', but can short circuit if the count of characters is--- greater than the number, and hence be more efficient.-compareLength :: Text -> Int64 -> Ordering-compareLength t n = S.compareLengthI (stream t) n-{-# INLINE [1] compareLength #-}---- We don't apply those otherwise appealing length-to-compareLength--- rewrite rules here, because they can change the strictness--- properties of code.---- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to--- each element of @t@.  Subject to fusion.  Performs replacement on--- invalid scalar values.-map :: (Char -> Char) -> Text -> Text-map f t = unstream (S.map (safe . f) (stream t))-{-# INLINE [1] map #-}---- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of--- 'Text's and concatenates the list after interspersing the first--- argument between each element of the list.-intercalate :: Text -> [Text] -> Text-intercalate t = concat . (F.intersperse t)-{-# INLINE intercalate #-}---- | /O(n)/ The 'intersperse' function takes a character and places it--- between the characters of a 'Text'.  Subject to fusion.  Performs--- replacement on invalid scalar values.-intersperse :: Char -> Text -> Text-intersperse c t = unstream (S.intersperse (safe c) (stream t))-{-# INLINE intersperse #-}---- | /O(n)/ Left-justify a string to the given length, using the--- specified fill character on the right. Subject to fusion.  Performs--- replacement on invalid scalar values.------ Examples:------ > justifyLeft 7 'x' "foo"    == "fooxxxx"--- > justifyLeft 3 'x' "foobar" == "foobar"-justifyLeft :: Int64 -> Char -> Text -> Text-justifyLeft k c t-    | len >= k  = t-    | otherwise = t `append` replicateChar (k-len) c-  where len = length t-{-# INLINE [1] justifyLeft #-}--{-# RULES-"LAZY TEXT justifyLeft -> fused" [~1] forall k c t.-    justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))-"LAZY TEXT justifyLeft -> unfused" [1] forall k c t.-    unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t-  #-}---- | /O(n)/ Right-justify a string to the given length, using the--- specified fill character on the left.  Performs replacement on--- invalid scalar values.------ Examples:------ > justifyRight 7 'x' "bar"    == "xxxxbar"--- > justifyRight 3 'x' "foobar" == "foobar"-justifyRight :: Int64 -> Char -> Text -> Text-justifyRight k c t-    | len >= k  = t-    | otherwise = replicateChar (k-len) c `append` t-  where len = length t-{-# INLINE justifyRight #-}---- | /O(n)/ Center a string to the given length, using the specified--- fill character on either side.  Performs replacement on invalid--- scalar values.------ Examples:------ > center 8 'x' "HS" = "xxxHSxxx"-center :: Int64 -> Char -> Text -> Text-center k c t-    | len >= k  = t-    | otherwise = replicateChar l c `append` t `append` replicateChar r c-  where len = length t-        d   = k - len-        r   = d `quot` 2-        l   = d - r-{-# INLINE center #-}---- | /O(n)/ The 'transpose' function transposes the rows and columns--- of its 'Text' argument.  Note that this function uses 'pack',--- 'unpack', and the list version of transpose, and is thus not very--- efficient.-transpose :: [Text] -> [Text]-transpose ts = L.map (\ss -> Chunk (T.pack ss) Empty)-                     (L.transpose (L.map unpack ts))--- TODO: make this fast---- | /O(n)/ 'reverse' @t@ returns the elements of @t@ in reverse order.-reverse :: Text -> Text-reverse = rev Empty-  where rev a Empty        = a-        rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts---- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in--- @haystack@ with @replacement@.------ This function behaves as though it was defined as follows:------ @--- replace needle replacement haystack =---   'intercalate' replacement ('splitOn' needle haystack)--- @------ As this suggests, each occurrence is replaced exactly once.  So if--- @needle@ occurs in @replacement@, that occurrence will /not/ itself--- be replaced recursively:------ > replace "oo" "foo" "oo" == "foo"------ In cases where several instances of @needle@ overlap, only the--- first one will be replaced:------ > replace "ofo" "bar" "ofofo" == "barfo"------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-replace :: Text-        -- ^ @needle@ to search for.  If this string is empty, an-        -- error will occur.-        -> Text-        -- ^ @replacement@ to replace @needle@ with.-        -> Text-        -- ^ @haystack@ in which to search.-        -> Text-replace s d = intercalate d . splitOn s-{-# INLINE replace #-}---- ------------------------------------------------------------------------------- ** Case conversions (folds)---- $case------ With Unicode text, it is incorrect to use combinators like @map--- toUpper@ to case convert each character of a string individually.--- Instead, use the whole-string case conversion functions from this--- module.  For correctness in different writing systems, these--- functions may map one input character to two or three output--- characters.---- | /O(n)/ Convert a string to folded case.  Subject to fusion.------ This function is mainly useful for performing caseless (or case--- insensitive) string comparisons.------ A string @x@ is a caseless match for a string @y@ if and only if:------ @toCaseFold x == toCaseFold y@------ The result string may be longer than the input string, and may--- differ from applying 'toLower' to the input string.  For instance,--- the Armenian small ligature men now (U+FB13) is case folded to the--- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is--- case folded to the Greek small letter letter mu (U+03BC) instead of--- itself.-toCaseFold :: Text -> Text-toCaseFold t = unstream (S.toCaseFold (stream t))-{-# INLINE toCaseFold #-}---- | /O(n)/ Convert a string to lower case, using simple case--- conversion.  Subject to fusion.------ The result string may be longer than the input string.  For--- instance, the Latin capital letter I with dot above (U+0130) maps--- to the sequence Latin small letter i (U+0069) followed by combining--- dot above (U+0307).-toLower :: Text -> Text-toLower t = unstream (S.toLower (stream t))-{-# INLINE toLower #-}---- | /O(n)/ Convert a string to upper case, using simple case--- conversion.  Subject to fusion.------ The result string may be longer than the input string.  For--- instance, the German eszett (U+00DF) maps to the two-letter--- sequence SS.-toUpper :: Text -> Text-toUpper t = unstream (S.toUpper (stream t))-{-# INLINE toUpper #-}----- | /O(n)/ Convert a string to title case, using simple case--- conversion.  Subject to fusion.------ The first letter of the input is converted to title case, as is--- every subsequent letter that immediately follows a non-letter.--- Every letter that immediately follows another letter is converted--- to lower case.------ The result string may be longer than the input string. For example,--- the Latin small ligature &#xfb02; (U+FB02) is converted to the--- sequence Latin capital letter F (U+0046) followed by Latin small--- letter l (U+006C).------ /Note/: this function does not take language or culture specific--- rules into account. For instance, in English, different style--- guides disagree on whether the book name \"The Hill of the Red--- Fox\" is correctly title cased&#x2014;but this function will--- capitalize /every/ word.------ @since 1.0.0.0-toTitle :: Text -> Text-toTitle t = unstream (S.toTitle (stream t))-{-# INLINE toTitle #-}---- | /O(n)/ 'foldl', applied to a binary operator, a starting value--- (typically the left-identity of the operator), and a 'Text',--- reduces the 'Text' using the binary operator, from left to right.--- Subject to fusion.-foldl :: (a -> Char -> a) -> a -> Text -> a-foldl f z t = S.foldl f z (stream t)-{-# INLINE foldl #-}---- | /O(n)/ A strict version of 'foldl'.--- Subject to fusion.-foldl' :: (a -> Char -> a) -> a -> Text -> a-foldl' f z t = S.foldl' f z (stream t)-{-# INLINE foldl' #-}---- | /O(n)/ A variant of 'foldl' that has no starting value argument,--- and thus must be applied to a non-empty 'Text'.  Subject to fusion.-foldl1 :: (Char -> Char -> Char) -> Text -> Char-foldl1 f t = S.foldl1 f (stream t)-{-# INLINE foldl1 #-}---- | /O(n)/ A strict version of 'foldl1'.  Subject to fusion.-foldl1' :: (Char -> Char -> Char) -> Text -> Char-foldl1' f t = S.foldl1' f (stream t)-{-# INLINE foldl1' #-}---- | /O(n)/ 'foldr', applied to a binary operator, a starting value--- (typically the right-identity of the operator), and a 'Text',--- reduces the 'Text' using the binary operator, from right to left.--- Subject to fusion.-foldr :: (Char -> a -> a) -> a -> Text -> a-foldr f z t = S.foldr f z (stream t)-{-# INLINE foldr #-}---- | /O(n)/ A variant of 'foldr' that has no starting value argument,--- and thus must be applied to a non-empty 'Text'.  Subject to--- fusion.-foldr1 :: (Char -> Char -> Char) -> Text -> Char-foldr1 f t = S.foldr1 f (stream t)-{-# INLINE foldr1 #-}---- | /O(n)/ Concatenate a list of 'Text's.-concat :: [Text] -> Text-concat = to-  where-    go Empty        css = to css-    go (Chunk c cs) css = Chunk c (go cs css)-    to []               = Empty-    to (cs:css)         = go cs css-{-# INLINE concat #-}---- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and--- concatenate the results.-concatMap :: (Char -> Text) -> Text -> Text-concatMap f = concat . foldr ((:) . f) []-{-# INLINE concatMap #-}---- | /O(n)/ 'any' @p@ @t@ determines whether any character in the--- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.-any :: (Char -> Bool) -> Text -> Bool-any p t = S.any p (stream t)-{-# INLINE any #-}---- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the--- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.-all :: (Char -> Bool) -> Text -> Bool-all p t = S.all p (stream t)-{-# INLINE all #-}---- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which--- must be non-empty. Subject to fusion.-maximum :: Text -> Char-maximum t = S.maximum (stream t)-{-# INLINE maximum #-}---- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which--- must be non-empty. Subject to fusion.-minimum :: Text -> Char-minimum t = S.minimum (stream t)-{-# INLINE minimum #-}---- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of--- successive reduced values from the left. Subject to fusion.--- Performs replacement on invalid scalar values.------ > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]------ Note that------ > last (scanl f z xs) == foldl f z xs.-scanl :: (Char -> Char -> Char) -> Char -> Text -> Text-scanl f z t = unstream (S.scanl g z (stream t))-    where g a b = safe (f a b)-{-# INLINE scanl #-}---- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting--- value argument.  Performs replacement on invalid scalar values.------ > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]-scanl1 :: (Char -> Char -> Char) -> Text -> Text-scanl1 f t0 = case uncons t0 of-                Nothing -> empty-                Just (t,ts) -> scanl f t ts-{-# INLINE scanl1 #-}---- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.  Performs--- replacement on invalid scalar values.------ > scanr f v == reverse . scanl (flip f) v . reverse-scanr :: (Char -> Char -> Char) -> Char -> Text -> Text-scanr f v = reverse . scanl g v . reverse-    where g a b = safe (f b a)---- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting--- value argument.  Performs replacement on invalid scalar values.-scanr1 :: (Char -> Char -> Char) -> Text -> Text-scanr1 f t | null t    = empty-           | otherwise = scanr f (last t) (init t)---- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a--- function to each element of a 'Text', passing an accumulating--- parameter from left to right, and returns a final 'Text'.  Performs--- replacement on invalid scalar values.-mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)-mapAccumL f = go-  where-    go z (Chunk c cs)    = (z'', Chunk c' cs')-        where (z',  c')  = T.mapAccumL f z c-              (z'', cs') = go z' cs-    go z Empty           = (z, Empty)-{-# INLINE mapAccumL #-}---- | The 'mapAccumR' function behaves like a combination of 'map' and--- a strict 'foldr'; it applies a function to each element of a--- 'Text', passing an accumulating parameter from right to left, and--- returning a final value of this accumulator together with the new--- 'Text'.  Performs replacement on invalid scalar values.-mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)-mapAccumR f = go-  where-    go z (Chunk c cs)   = (z'', Chunk c' cs')-        where (z'', c') = T.mapAccumR f z' c-              (z', cs') = go z cs-    go z Empty          = (z, Empty)-{-# INLINE mapAccumR #-}---- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every--- element.------ @since 1.2.0.5-repeat :: Char -> Text-repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t-            in t---- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input--- @t@ repeated @n@ times.-replicate :: Int64 -> Text -> Text-replicate n t-    | null t || n <= 0 = empty-    | isSingleton t    = replicateChar n (head t)-    | otherwise        = concat (rep 0)-    where rep !i | i >= n    = []-                 | otherwise = t : rep (i+1)-{-# INLINE [1] replicate #-}---- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or--- equivalently, the infinite repetition of the original 'Text'.------ @since 1.2.0.5-cycle :: Text -> Text-cycle Empty = emptyError "cycle"-cycle t     = let t' = foldrChunks Chunk t' t-               in t'---- | @'iterate' f x@ returns an infinite 'Text' of repeated applications--- of @f@ to @x@:------ > iterate f x == [x, f x, f (f x), ...]------ @since 1.2.0.5-iterate :: (Char -> Char) -> Char -> Text-iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))-               in t c---- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the--- value of every element. Subject to fusion.-replicateChar :: Int64 -> Char -> Text-replicateChar n c = unstream (S.replicateCharI n (safe c))-{-# INLINE replicateChar #-}--{-# RULES-"LAZY TEXT replicate/singleton -> replicateChar" [~1] forall n c.-    replicate n (singleton c) = replicateChar n c-"LAZY TEXT replicate/unstream/singleton -> replicateChar" [~1] forall n c.-    replicate n (unstream (S.singleton c)) = replicateChar n c-  #-}---- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'--- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a--- 'Text' from a seed value. The function takes the element and--- returns 'Nothing' if it is done producing the 'Text', otherwise--- 'Just' @(a,b)@.  In this case, @a@ is the next 'Char' in the--- string, and @b@ is the seed value for further production.--- Subject to fusion.--- Performs replacement on invalid scalar values.-unfoldr :: (a -> Maybe (Char,a)) -> a -> Text-unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)-{-# INLINE unfoldr #-}---- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed--- value. However, the length of the result should be limited by the--- first argument to 'unfoldrN'. This function is more efficient than--- 'unfoldr' when the maximum length of the result is known and--- correct, otherwise its performance is similar to 'unfoldr'.--- Subject to fusion.--- Performs replacement on invalid scalar values.-unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text-unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)-{-# INLINE unfoldrN #-}---- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the--- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than--- the length of the Text. Subject to fusion.-take :: Int64 -> Text -> Text-take i _ | i <= 0 = Empty-take i t0         = take' i t0-  where take' 0 _            = Empty-        take' _ Empty        = Empty-        take' n (Chunk t ts)-            | n < len   = Chunk (T.take (fromIntegral n) t) Empty-            | otherwise = Chunk t (take' (n - len) ts)-            where len = fromIntegral (T.length t)-{-# INLINE [1] take #-}--{-# RULES-"LAZY TEXT take -> fused" [~1] forall n t.-    take n t = unstream (S.take n (stream t))-"LAZY TEXT take -> unfused" [1] forall n t.-    unstream (S.take n (stream t)) = take n t-  #-}---- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after--- taking @n@ characters from the end of @t@.------ Examples:------ > takeEnd 3 "foobar" == "bar"------ @since 1.1.1.0-takeEnd :: Int64 -> Text -> Text-takeEnd n t0-    | n <= 0    = empty-    | otherwise = takeChunk n empty . L.reverse . toChunks $ t0-  where takeChunk _ acc [] = acc-        takeChunk i acc (t:ts)-          | i <= l    = chunk (T.takeEnd (fromIntegral i) t) acc-          | otherwise = takeChunk (i-l) (Chunk t acc) ts-          where l = fromIntegral (T.length t)---- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the--- 'Text' after the first @n@ characters, or the empty 'Text' if @n@--- is greater than the length of the 'Text'. Subject to fusion.-drop :: Int64 -> Text -> Text-drop i t0-    | i <= 0    = t0-    | otherwise = drop' i t0-  where drop' 0 ts           = ts-        drop' _ Empty        = Empty-        drop' n (Chunk t ts)-            | n < len   = Chunk (T.drop (fromIntegral n) t) ts-            | otherwise = drop' (n - len) ts-            where len   = fromIntegral (T.length t)-{-# INLINE [1] drop #-}--{-# RULES-"LAZY TEXT drop -> fused" [~1] forall n t.-    drop n t = unstream (S.drop n (stream t))-"LAZY TEXT drop -> unfused" [1] forall n t.-    unstream (S.drop n (stream t)) = drop n t-  #-}---- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after--- dropping @n@ characters from the end of @t@.------ Examples:------ > dropEnd 3 "foobar" == "foo"------ @since 1.1.1.0-dropEnd :: Int64 -> Text -> Text-dropEnd n t0-    | n <= 0    = t0-    | otherwise = dropChunk n . L.reverse . toChunks $ t0-  where dropChunk _ [] = empty-        dropChunk m (t:ts)-          | m >= l    = dropChunk (m-l) ts-          | otherwise = fromChunks . L.reverse $-                        T.dropEnd (fromIntegral m) t : ts-          where l = fromIntegral (T.length t)---- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'--- values dropped, or the empty 'Text' if @n@ is greater than the--- number of 'Word16' values present.-dropWords :: Int64 -> Text -> Text-dropWords i t0-    | i <= 0    = t0-    | otherwise = drop' i t0-  where drop' 0 ts           = ts-        drop' _ Empty        = Empty-        drop' n (Chunk (T.Text arr off len) ts)-            | n < len'  = chunk (text arr (off+n') (len-n')) ts-            | otherwise = drop' (n - len') ts-            where len'  = fromIntegral len-                  n'    = fromIntegral n---- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',--- returns the longest prefix (possibly empty) of elements that--- satisfy @p@.  Subject to fusion.-takeWhile :: (Char -> Bool) -> Text -> Text-takeWhile p t0 = takeWhile' t0-  where takeWhile' Empty        = Empty-        takeWhile' (Chunk t ts) =-          case T.findIndex (not . p) t of-            Just n | n > 0     -> Chunk (T.take n t) Empty-                   | otherwise -> Empty-            Nothing            -> Chunk t (takeWhile' ts)-{-# INLINE [1] takeWhile #-}--{-# RULES-"LAZY TEXT takeWhile -> fused" [~1] forall p t.-    takeWhile p t = unstream (S.takeWhile p (stream t))-"LAZY TEXT takeWhile -> unfused" [1] forall p t.-    unstream (S.takeWhile p (stream t)) = takeWhile p t-  #-}--- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',--- returns the longest suffix (possibly empty) of elements that--- satisfy @p@.--- Examples:------ > takeWhileEnd (=='o') "foo" == "oo"------ @since 1.2.2.0-takeWhileEnd :: (Char -> Bool) -> Text -> Text-takeWhileEnd p = takeChunk empty . L.reverse . toChunks-  where takeChunk acc []     = acc-        takeChunk acc (t:ts)-          | T.lengthWord16 t' < T.lengthWord16 t-                             = chunk t' acc-          | otherwise        = takeChunk (Chunk t' acc) ts-          where t' = T.takeWhileEnd p t-{-# INLINE takeWhileEnd #-}---- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after--- 'takeWhile' @p@ @t@.  Subject to fusion.-dropWhile :: (Char -> Bool) -> Text -> Text-dropWhile p t0 = dropWhile' t0-  where dropWhile' Empty        = Empty-        dropWhile' (Chunk t ts) =-          case T.findIndex (not . p) t of-            Just n  -> Chunk (T.drop n t) ts-            Nothing -> dropWhile' ts-{-# INLINE [1] dropWhile #-}--{-# RULES-"LAZY TEXT dropWhile -> fused" [~1] forall p t.-    dropWhile p t = unstream (S.dropWhile p (stream t))-"LAZY TEXT dropWhile -> unfused" [1] forall p t.-    unstream (S.dropWhile p (stream t)) = dropWhile p t-  #-}---- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after--- dropping characters that satisfy the predicate @p@ from the end of--- @t@.------ Examples:------ > dropWhileEnd (=='.') "foo..." == "foo"-dropWhileEnd :: (Char -> Bool) -> Text -> Text-dropWhileEnd p = go-  where go Empty = Empty-        go (Chunk t Empty) = if T.null t'-                             then Empty-                             else Chunk t' Empty-            where t' = T.dropWhileEnd p t-        go (Chunk t ts) = case go ts of-                            Empty -> go (Chunk t Empty)-                            ts' -> Chunk t ts'-{-# INLINE dropWhileEnd #-}---- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after--- dropping characters that satisfy the predicate @p@ from both the--- beginning and end of @t@.-dropAround :: (Char -> Bool) -> Text -> Text-dropAround p = dropWhile p . dropWhileEnd p-{-# INLINE [1] dropAround #-}---- | /O(n)/ Remove leading white space from a string.  Equivalent to:------ > dropWhile isSpace-stripStart :: Text -> Text-stripStart = dropWhile isSpace-{-# INLINE stripStart #-}---- | /O(n)/ Remove trailing white space from a string.  Equivalent to:------ > dropWhileEnd isSpace-stripEnd :: Text -> Text-stripEnd = dropWhileEnd isSpace-{-# INLINE [1] stripEnd #-}---- | /O(n)/ Remove leading and trailing white space from a string.--- Equivalent to:------ > dropAround isSpace-strip :: Text -> Text-strip = dropAround isSpace-{-# INLINE [1] strip #-}---- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a--- prefix of @t@ of length @n@, and whose second is the remainder of--- the string. It is equivalent to @('take' n t, 'drop' n t)@.-splitAt :: Int64 -> Text -> (Text, Text)-splitAt = loop-  where loop _ Empty      = (empty, empty)-        loop n t | n <= 0 = (empty, t)-        loop n (Chunk t ts)-             | n < len   = let (t',t'') = T.splitAt (fromIntegral n) t-                           in (Chunk t' Empty, Chunk t'' ts)-             | otherwise = let (ts',ts'') = loop (n - len) ts-                           in (Chunk t ts', ts'')-             where len = fromIntegral (T.length t)---- | /O(n)/ 'splitAtWord' @n t@ returns a strict pair whose first--- element is a prefix of @t@ whose chunks contain @n@ 'Word16'--- values, and whose second is the remainder of the string.-splitAtWord :: Int64 -> Text -> PairS Text Text-splitAtWord _ Empty = empty :*: empty-splitAtWord x (Chunk c@(T.Text arr off len) cs)-    | y >= len  = let h :*: t = splitAtWord (x-fromIntegral len) cs-                  in  Chunk c h :*: t-    | otherwise = chunk (text arr off y) empty :*:-                  chunk (text arr (off+y) (len-y)) cs-    where y = fromIntegral x---- | /O(n+m)/ Find the first instance of @needle@ (which must be--- non-'null') in @haystack@.  The first element of the returned tuple--- is the prefix of @haystack@ before @needle@ is matched.  The second--- is the remainder of @haystack@, starting with the match.------ Examples:------ > breakOn "::" "a::b::c" ==> ("a", "::b::c")--- > breakOn "/" "foobar"   ==> ("foobar", "")------ Laws:------ > append prefix match == haystack--- >   where (prefix, match) = breakOn needle haystack------ If you need to break a string by a substring repeatedly (e.g. you--- want to break on every instance of a substring), use 'breakOnAll'--- instead, as it has lower startup overhead.------ This function is strict in its first argument, and lazy in its--- second.------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-breakOn :: Text -> Text -> (Text, Text)-breakOn pat src-    | null pat  = emptyError "breakOn"-    | otherwise = case indices pat src of-                    []    -> (src, empty)-                    (x:_) -> let h :*: t = splitAtWord x src-                             in  (h, t)---- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the string.------ The first element of the returned tuple is the prefix of @haystack@--- up to and including the last match of @needle@.  The second is the--- remainder of @haystack@, following the match.------ > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")-breakOnEnd :: Text -> Text -> (Text, Text)-breakOnEnd pat src = let (a,b) = breakOn (reverse pat) (reverse src)-                   in  (reverse b, reverse a)-{-# INLINE breakOnEnd #-}---- | /O(n+m)/ Find all non-overlapping instances of @needle@ in--- @haystack@.  Each element of the returned list consists of a pair:------ * The entire string prior to the /k/th match (i.e. the prefix)------ * The /k/th match, followed by the remainder of the string------ Examples:------ > breakOnAll "::" ""--- > ==> []--- > breakOnAll "/" "a/b/c/"--- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]------ This function is strict in its first argument, and lazy in its--- second.------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.------ The @needle@ parameter may not be empty.-breakOnAll :: Text              -- ^ @needle@ to search for-           -> Text              -- ^ @haystack@ in which to search-           -> [(Text, Text)]-breakOnAll pat src-    | null pat  = emptyError "breakOnAll"-    | otherwise = go 0 empty src (indices pat src)-  where-    go !n p s (x:xs) = let h :*: t = splitAtWord (x-n) s-                           h'      = append p h-                       in (h',t) : go x h' t xs-    go _  _ _ _      = []---- | /O(n)/ 'break' is like 'span', but the prefix returned is over--- elements that fail the predicate @p@.-break :: (Char -> Bool) -> Text -> (Text, Text)-break p t0 = break' t0-  where break' Empty          = (empty, empty)-        break' c@(Chunk t ts) =-          case T.findIndex p t of-            Nothing      -> let (ts', ts'') = break' ts-                            in (Chunk t ts', ts'')-            Just n | n == 0    -> (Empty, c)-                   | otherwise -> let (a,b) = T.splitAt n t-                                  in (Chunk a Empty, Chunk b ts)---- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns--- a pair whose first element is the longest prefix (possibly empty)--- of @t@ of elements that satisfy @p@, and whose second is the--- remainder of the list.-span :: (Char -> Bool) -> Text -> (Text, Text)-span p = break (not . p)-{-# INLINE span #-}---- | The 'group' function takes a 'Text' and returns a list of 'Text's--- such that the concatenation of the result is equal to the argument.--- Moreover, each sublist in the result contains only equal elements.--- For example,------ > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]------ It is a special case of 'groupBy', which allows the programmer to--- supply their own equality test.-group :: Text -> [Text]-group =  groupBy (==)-{-# INLINE group #-}---- | The 'groupBy' function is the non-overloaded version of 'group'.-groupBy :: (Char -> Char -> Bool) -> Text -> [Text]-groupBy _  Empty        = []-groupBy eq (Chunk t ts) = cons x ys : groupBy eq zs-                          where (ys,zs) = span (eq x) xs-                                x  = T.unsafeHead t-                                xs = chunk (T.unsafeTail t) ts---- | /O(n)/ Return all initial segments of the given 'Text',--- shortest first.-inits :: Text -> [Text]-inits = (Empty :) . inits'-  where inits' Empty        = []-        inits' (Chunk t ts) = L.map (\t' -> Chunk t' Empty) (L.tail (T.inits t))-                           ++ L.map (Chunk t) (inits' ts)---- | /O(n)/ Return all final segments of the given 'Text', longest--- first.-tails :: Text -> [Text]-tails Empty         = Empty : []-tails ts@(Chunk t ts')-  | T.length t == 1 = ts : tails ts'-  | otherwise       = ts : tails (Chunk (T.unsafeTail t) ts')---- $split------ Splitting functions in this library do not perform character-wise--- copies to create substrings; they just construct new 'Text's that--- are slices of the original.---- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'--- argument (which cannot be an empty string), consuming the--- delimiter. An empty delimiter is invalid, and will cause an error--- to be raised.------ Examples:------ > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]--- > splitOn "aaa"  "aaaXaaaXaaaXaaa"  == ["","X","X","X",""]--- > splitOn "x"    "x"                == ["",""]------ and------ > intercalate s . splitOn s         == id--- > splitOn (singleton c)             == split (==c)------ (Note: the string @s@ to split on above cannot be empty.)------ This function is strict in its first argument, and lazy in its--- second.------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-splitOn :: Text-        -- ^ String to split on. If this string is empty, an error-        -- will occur.-        -> Text-        -- ^ Input text.-        -> [Text]-splitOn pat src-    | null pat        = emptyError "splitOn"-    | isSingleton pat = split (== head pat) src-    | otherwise       = go 0 (indices pat src) src-  where-    go  _ []     cs = [cs]-    go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs-                      in  h : go (x+l) xs (dropWords l t)-    l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat-{-# INLINE [1] splitOn #-}--{-# RULES-"LAZY TEXT splitOn/singleton -> split/==" [~1] forall c t.-    splitOn (singleton c) t = split (==c) t-  #-}---- | /O(n)/ Splits a 'Text' into components delimited by separators,--- where the predicate returns True for a separator element.  The--- resulting components do not contain the separators.  Two adjacent--- separators result in an empty component in the output.  eg.------ > split (=='a') "aabbaca" == ["","","bb","c",""]--- > split (=='a') []        == [""]-split :: (Char -> Bool) -> Text -> [Text]-split _ Empty = [Empty]-split p (Chunk t0 ts0) = comb [] (T.split p t0) ts0-  where comb acc (s:[]) Empty        = revChunks (s:acc) : []-        comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.split p t) ts-        comb acc (s:ss) ts           = revChunks (s:acc) : comb [] ss ts-        comb _   []     _            = impossibleError "split"-{-# INLINE split #-}---- | /O(n)/ Splits a 'Text' into components of length @k@.  The last--- element may be shorter than the other chunks, depending on the--- length of the input. Examples:------ > chunksOf 3 "foobarbaz"   == ["foo","bar","baz"]--- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]-chunksOf :: Int64 -> Text -> [Text]-chunksOf k = go-  where-    go t = case splitAt k t of-             (a,b) | null a    -> []-                   | otherwise -> a : go b-{-# INLINE chunksOf #-}---- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at--- newline 'Char's. The resulting strings do not contain newlines.-lines :: Text -> [Text]-lines Empty = []-lines t = let (l,t') = break ((==) '\n') t-          in l : if null t' then []-                 else lines (tail t')---- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's--- representing white space.-words :: Text -> [Text]-words = L.filter (not . null) . split isSpace-{-# INLINE words #-}---- | /O(n)/ Joins lines, after appending a terminating newline to--- each.-unlines :: [Text] -> Text-unlines = concat . L.map (`snoc` '\n')-{-# INLINE unlines #-}---- | /O(n)/ Joins words using single space characters.-unwords :: [Text] -> Text-unwords = intercalate (singleton ' ')-{-# INLINE unwords #-}---- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns--- 'True' iff the first is a prefix of the second.  Subject to fusion.-isPrefixOf :: Text -> Text -> Bool-isPrefixOf Empty _  = True-isPrefixOf _ Empty  = False-isPrefixOf (Chunk x xs) (Chunk y ys)-    | lx == ly  = x == y  && isPrefixOf xs ys-    | lx <  ly  = x == yh && isPrefixOf xs (Chunk yt ys)-    | otherwise = xh == y && isPrefixOf (Chunk xt xs) ys-  where (xh,xt) = T.splitAt ly x-        (yh,yt) = T.splitAt lx y-        lx = T.length x-        ly = T.length y-{-# INLINE [1] isPrefixOf #-}--{-# RULES-"LAZY TEXT isPrefixOf -> fused" [~1] forall s t.-    isPrefixOf s t = S.isPrefixOf (stream s) (stream t)-"LAZY TEXT isPrefixOf -> unfused" [1] forall s t.-    S.isPrefixOf (stream s) (stream t) = isPrefixOf s t-  #-}---- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns--- 'True' iff the first is a suffix of the second.-isSuffixOf :: Text -> Text -> Bool-isSuffixOf x y = reverse x `isPrefixOf` reverse y-{-# INLINE isSuffixOf #-}--- TODO: a better implementation---- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns--- 'True' iff the first is contained, wholly and intact, anywhere--- within the second.------ This function is strict in its first argument, and lazy in its--- second.------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-isInfixOf :: Text -> Text -> Bool-isInfixOf needle haystack-    | null needle        = True-    | isSingleton needle = S.elem (head needle) . S.stream $ haystack-    | otherwise          = not . L.null . indices needle $ haystack-{-# INLINE [1] isInfixOf #-}--{-# RULES-"LAZY TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.-    isInfixOf (singleton n) h = S.elem n (S.stream h)-  #-}------------------------------------------------------------------------------------ * View patterns---- | /O(n)/ Return the suffix of the second string if its prefix--- matches the entire first string.------ Examples:------ > stripPrefix "foo" "foobar" == Just "bar"--- > stripPrefix ""    "baz"    == Just "baz"--- > stripPrefix "foo" "quux"   == Nothing------ This is particularly useful with the @ViewPatterns@ extension to--- GHC, as follows:------ > {-# LANGUAGE ViewPatterns #-}--- > import Data.Text.Lazy as T--- >--- > fnordLength :: Text -> Int--- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf--- > fnordLength _                                 = -1-stripPrefix :: Text -> Text -> Maybe Text-stripPrefix p t-    | null p    = Just t-    | otherwise = case commonPrefixes p t of-                    Just (_,c,r) | null c -> Just r-                    _                     -> Nothing---- | /O(n)/ Find the longest non-empty common prefix of two strings--- and return it, along with the suffixes of each string at which they--- no longer match.------ If the strings do not have a common prefix or either one is empty,--- this function returns 'Nothing'.------ Examples:------ > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")--- > commonPrefixes "veeble" "fetzer"  == Nothing--- > commonPrefixes "" "baz"           == Nothing-commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)-commonPrefixes Empty _ = Nothing-commonPrefixes _ Empty = Nothing-commonPrefixes a0 b0   = Just (go a0 b0 [])-  where-    go t0@(Chunk x xs) t1@(Chunk y ys) ps-        = case T.commonPrefixes x y of-            Just (p,a,b)-              | T.null a  -> go xs (chunk b ys) (p:ps)-              | T.null b  -> go (chunk a xs) ys (p:ps)-              | otherwise -> (fromChunks (L.reverse (p:ps)),chunk a xs, chunk b ys)-            Nothing       -> (fromChunks (L.reverse ps),t0,t1)-    go t0 t1 ps = (fromChunks (L.reverse ps),t0,t1)---- | /O(n)/ Return the prefix of the second string if its suffix--- matches the entire first string.------ Examples:------ > stripSuffix "bar" "foobar" == Just "foo"--- > stripSuffix ""    "baz"    == Just "baz"--- > stripSuffix "foo" "quux"   == Nothing------ This is particularly useful with the @ViewPatterns@ extension to--- GHC, as follows:------ > {-# LANGUAGE ViewPatterns #-}--- > import Data.Text.Lazy as T--- >--- > quuxLength :: Text -> Int--- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre--- > quuxLength _                                = -1-stripSuffix :: Text -> Text -> Maybe Text-stripSuffix p t = reverse `fmap` stripPrefix (reverse p) (reverse t)---- | /O(n)/ 'filter', applied to a predicate and a 'Text',--- returns a 'Text' containing those characters that satisfy the--- predicate.-filter :: (Char -> Bool) -> Text -> Text-filter p t = unstream (S.filter p (stream t))-{-# INLINE filter #-}---- | /O(n)/ The 'find' function takes a predicate and a 'Text', and--- returns the first element in matching the predicate, or 'Nothing'--- if there is no such element. Subject to fusion.-find :: (Char -> Bool) -> Text -> Maybe Char-find p t = S.findBy p (stream t)-{-# INLINE find #-}---- | /O(n)/ The 'partition' function takes a predicate and a 'Text',--- and returns the pair of 'Text's with elements which do and do not--- satisfy the predicate, respectively; i.e.------ > partition p t == (filter p t, filter (not . p) t)-partition :: (Char -> Bool) -> Text -> (Text, Text)-partition p t = (filter p t, filter (not . p) t)-{-# INLINE partition #-}---- | /O(n)/ 'Text' index (subscript) operator, starting from 0.--- Subject to fusion.-index :: Text -> Int64 -> Char-index t n = S.index (stream t) n-{-# INLINE index #-}---- | /O(n+m)/ The 'count' function returns the number of times the--- query string appears in the given 'Text'. An empty query string is--- invalid, and will cause an error to be raised.------ In (unlikely) bad cases, this function's time complexity degrades--- towards /O(n*m)/.-count :: Text -> Text -> Int64-count pat src-    | null pat        = emptyError "count"-    | otherwise       = go 0 (indices pat src)-  where go !n []     = n-        go !n (_:xs) = go (n+1) xs-{-# INLINE [1] count #-}--{-# RULES-"LAZY TEXT count/singleton -> countChar" [~1] forall c t.-    count (singleton c) t = countChar c t-  #-}---- | /O(n)/ The 'countChar' function returns the number of times the--- query element appears in the given 'Text'.  Subject to fusion.-countChar :: Char -> Text -> Int64-countChar c t = S.countChar c (stream t)---- | /O(n)/ 'zip' takes two 'Text's and returns a list of--- corresponding pairs of bytes. If one input 'Text' is short,--- excess elements of the longer 'Text' are discarded. This is--- equivalent to a pair of 'unpack' operations.-zip :: Text -> Text -> [(Char,Char)]-zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)-{-# INLINE [0] zip #-}---- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function--- given as the first argument, instead of a tupling function.--- Performs replacement on invalid scalar values.-zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text-zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))-    where g a b = safe (f a b)-{-# INLINE [0] zipWith #-}--revChunks :: [T.Text] -> Text-revChunks = L.foldl' (flip chunk) Empty--emptyError :: String -> a-emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")--impossibleError :: String -> a-impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
− Data/Text/Lazy/Builder.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif---------------------------------------------------------------------------------- |--- Module      : Data.Text.Lazy.Builder--- Copyright   : (c) 2013 Bryan O'Sullivan---               (c) 2010 Johan Tibell--- License     : BSD-style (see LICENSE)------ Maintainer  : Johan Tibell <johan.tibell@gmail.com>--- Portability : portable to Hugs and GHC------ Efficient construction of lazy @Text@ values.  The principal--- operations on a @Builder@ are @singleton@, @fromText@, and--- @fromLazyText@, which construct new builders, and 'mappend', which--- concatenates two builders.------ To get maximum performance when building lazy @Text@ values using a--- builder, associate @mappend@ calls to the right.  For example,--- prefer------ > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')------ to------ > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'------ as the latter associates @mappend@ to the left. Or, equivalently,--- prefer------  > singleton 'a' <> singleton 'b' <> singleton 'c'------ since the '<>' from recent versions of 'Data.Monoid' associates--- to the right.---------------------------------------------------------------------------------module Data.Text.Lazy.Builder-   ( -- * The Builder type-     Builder-   , toLazyText-   , toLazyTextWith--     -- * Constructing Builders-   , singleton-   , fromText-   , fromLazyText-   , fromString--     -- * Flushing the buffer state-   , flush-   ) where--import Data.Text.Internal.Builder
− Data/Text/Lazy/Builder/Int.hs 
@@ -1,264 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,-    UnboxedTuples #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif---- Module:      Data.Text.Lazy.Builder.Int--- Copyright:   (c) 2013 Bryan O'Sullivan---              (c) 2011 MailRank, Inc.--- License:     BSD-style--- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>--- Portability: portable------ Efficiently write an integral value to a 'Builder'.--module Data.Text.Lazy.Builder.Int-    (-      decimal-    , hexadecimal-    ) where--import Data.Int (Int8, Int16, Int32, Int64)-import Data.Monoid (mempty)-import qualified Data.ByteString.Unsafe as B-import Data.Text.Internal.Builder.Functions ((<>), i2d)-import Data.Text.Internal.Builder-import Data.Text.Internal.Builder.Int.Digits (digits)-import Data.Text.Array-import Data.Word (Word, Word8, Word16, Word32, Word64)-import GHC.Base (quotInt, remInt)-import GHC.Num (quotRemInteger)-import GHC.Types (Int(..))-import Control.Monad.ST-#if MIN_VERSION_base(4,11,0)-import Prelude hiding ((<>))-#endif--#ifdef  __GLASGOW_HASKELL__-# if defined(INTEGER_GMP)-import GHC.Integer.GMP.Internals (Integer(S#))-# elif defined(INTEGER_SIMPLE)-import GHC.Integer-# else-# error "You need to use either GMP or integer-simple."-# endif-#endif--#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)-# define PAIR(a,b) (# a,b #)-#else-# define PAIR(a,b) (a,b)-#endif--decimal :: Integral a => a -> Builder-{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}-{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}-{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}-{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}-{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}-{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}-{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}-{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}-{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}-{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}-{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}-decimal i = decimal' (<= -128) i-{-# NOINLINE decimal #-}--boundedDecimal :: (Integral a, Bounded a) => a -> Builder-{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}-{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}-{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}-{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}-{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}-boundedDecimal i = decimal' (== minBound) i--decimal' :: (Integral a) => (a -> Bool) -> a -> Builder-{-# INLINE decimal' #-}-decimal' p i-    | i < 0 = if p i-              then let (q, r) = i `quotRem` 10-                       qq = -q-                       !n = countDigits qq-                   in writeN (n + 2) $ \marr off -> do-                       unsafeWrite marr off minus-                       posDecimal marr (off+1) n qq-                       unsafeWrite marr (off+n+1) (i2w (-r))-              else let j = -i-                       !n = countDigits j-                   in writeN (n + 1) $ \marr off ->-                       unsafeWrite marr off minus >> posDecimal marr (off+1) n j-    | otherwise = positive i--positive :: (Integral a) => a -> Builder-{-# SPECIALIZE positive :: Int -> Builder #-}-{-# SPECIALIZE positive :: Int8 -> Builder #-}-{-# SPECIALIZE positive :: Int16 -> Builder #-}-{-# SPECIALIZE positive :: Int32 -> Builder #-}-{-# SPECIALIZE positive :: Int64 -> Builder #-}-{-# SPECIALIZE positive :: Word -> Builder #-}-{-# SPECIALIZE positive :: Word8 -> Builder #-}-{-# SPECIALIZE positive :: Word16 -> Builder #-}-{-# SPECIALIZE positive :: Word32 -> Builder #-}-{-# SPECIALIZE positive :: Word64 -> Builder #-}-positive i-    | i < 10    = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)-    | otherwise = let !n = countDigits i-                  in writeN n $ \marr off -> posDecimal marr off n i--posDecimal :: (Integral a) =>-              forall s. MArray s -> Int -> Int -> a -> ST s ()-{-# INLINE posDecimal #-}-posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0-  where go off v-           | v >= 100 = do-               let (q, r) = v `quotRem` 100-               write2 off r-               go (off - 2) q-           | v < 10    = unsafeWrite marr off (i2w v)-           | otherwise = write2 off v-        write2 off i0 = do-          let i = fromIntegral i0; j = i + i-          unsafeWrite marr off $ get (j + 1)-          unsafeWrite marr (off - 1) $ get j-        get = fromIntegral . B.unsafeIndex digits--minus, zero :: Word16-{-# INLINE minus #-}-{-# INLINE zero #-}-minus = 45-zero = 48--i2w :: (Integral a) => a -> Word16-{-# INLINE i2w #-}-i2w v = zero + fromIntegral v--countDigits :: (Integral a) => a -> Int-{-# INLINE countDigits #-}-countDigits v0-  | fromIntegral v64 == v0 = go 1 v64-  | otherwise              = goBig 1 (fromIntegral v0)-  where v64 = fromIntegral v0-        goBig !k (v :: Integer)-           | v > big   = goBig (k + 19) (v `quot` big)-           | otherwise = go k (fromIntegral v)-        big = 10000000000000000000-        go !k (v :: Word64)-           | v < 10    = k-           | v < 100   = k + 1-           | v < 1000  = k + 2-           | v < 1000000000000 =-               k + if v < 100000000-                   then if v < 1000000-                        then if v < 10000-                             then 3-                             else 4 + fin v 100000-                        else 6 + fin v 10000000-                   else if v < 10000000000-                        then 8 + fin v 1000000000-                        else 10 + fin v 100000000000-           | otherwise = go (k + 12) (v `quot` 1000000000000)-        fin v n = if v >= n then 1 else 0--hexadecimal :: Integral a => a -> Builder-{-# SPECIALIZE hexadecimal :: Int -> Builder #-}-{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}-{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}-{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}-{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}-{-# SPECIALIZE hexadecimal :: Word -> Builder #-}-{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}-{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}-{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}-{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}-{-# RULES "hexadecimal/Integer"-    hexadecimal = hexInteger :: Integer -> Builder #-}-hexadecimal i-    | i < 0     = error hexErrMsg-    | otherwise = go i-  where-    go n | n < 16    = hexDigit n-         | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)-{-# NOINLINE[0] hexadecimal #-}--hexInteger :: Integer -> Builder-hexInteger i-    | i < 0     = error hexErrMsg-    | otherwise = integer 16 i--hexErrMsg :: String-hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"--hexDigit :: Integral a => a -> Builder-hexDigit n-    | n <= 9    = singleton $! i2d (fromIntegral n)-    | otherwise = singleton $! toEnum (fromIntegral n + 87)-{-# INLINE hexDigit #-}--data T = T !Integer !Int--integer :: Int -> Integer -> Builder-#ifdef INTEGER_GMP-integer 10 (S# i#) = decimal (I# i#)-integer 16 (S# i#) = hexadecimal (I# i#)-#endif-integer base i-    | i < 0     = singleton '-' <> go (-i)-    | otherwise = go i-  where-    go n | n < maxInt = int (fromInteger n)-         | otherwise  = putH (splitf (maxInt * maxInt) n)--    splitf p n-      | p > n       = [n]-      | otherwise   = splith p (splitf (p*p) n)--    splith p (n:ns) = case n `quotRemInteger` p of-                        PAIR(q,r) | q > 0     -> q : r : splitb p ns-                                  | otherwise -> r : splitb p ns-    splith _ _      = error "splith: the impossible happened."--    splitb p (n:ns) = case n `quotRemInteger` p of-                        PAIR(q,r) -> q : r : splitb p ns-    splitb _ _      = []--    T maxInt10 maxDigits10 =-        until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)-      where mi = fromIntegral (maxBound :: Int)-    T maxInt16 maxDigits16 =-        until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)-      where mi = fromIntegral (maxBound :: Int)--    fstT (T a _) = a--    maxInt | base == 10 = maxInt10-           | otherwise  = maxInt16-    maxDigits | base == 10 = maxDigits10-              | otherwise  = maxDigits16--    putH (n:ns) = case n `quotRemInteger` maxInt of-                    PAIR(x,y)-                        | q > 0     -> int q <> pblock r <> putB ns-                        | otherwise -> int r <> putB ns-                        where q = fromInteger x-                              r = fromInteger y-    putH _ = error "putH: the impossible happened"--    putB (n:ns) = case n `quotRemInteger` maxInt of-                    PAIR(x,y) -> pblock q <> pblock r <> putB ns-                        where q = fromInteger x-                              r = fromInteger y-    putB _ = Data.Monoid.mempty--    int :: Int -> Builder-    int x | base == 10 = decimal x-          | otherwise  = hexadecimal x--    pblock = loop maxDigits-      where-        loop !d !n-            | d == 1    = hexDigit n-            | otherwise = loop (d-1) q <> hexDigit r-            where q = n `quotInt` base-                  r = n `remInt` base
− Data/Text/Lazy/Builder/RealFloat.hs 
@@ -1,253 +0,0 @@-{-# LANGUAGE CPP, OverloadedStrings #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif---- |--- Module:    Data.Text.Lazy.Builder.RealFloat--- Copyright: (c) The University of Glasgow 1994-2002--- License:   see libraries/base/LICENSE------ Write a floating point value to a 'Builder'.--module Data.Text.Lazy.Builder.RealFloat-    (-      FPFormat(..)-    , realFloat-    , formatRealFloat-    ) where--import Data.Array.Base (unsafeAt)-import Data.Array.IArray-import Data.Text.Internal.Builder.Functions ((<>), i2d)-import Data.Text.Lazy.Builder.Int (decimal)-import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)-import Data.Text.Lazy.Builder-import qualified Data.Text as T-#if MIN_VERSION_base(4,11,0)-import Prelude hiding ((<>))-#endif---- | Control the rendering of floating point numbers.-data FPFormat = Exponent-              -- ^ Scientific notation (e.g. @2.3e123@).-              | Fixed-              -- ^ Standard decimal notation.-              | Generic-              -- ^ Use decimal notation for values between @0.1@ and-              -- @9,999,999@, and scientific notation otherwise.-                deriving (Enum, Read, Show)---- | Show a signed 'RealFloat' value to full precision,--- using standard decimal notation for arguments whose absolute value lies--- between @0.1@ and @9,999,999@, and scientific notation otherwise.-realFloat :: (RealFloat a) => a -> Builder-{-# SPECIALIZE realFloat :: Float -> Builder #-}-{-# SPECIALIZE realFloat :: Double -> Builder #-}-realFloat x = formatRealFloat Generic Nothing x---- | Encode a signed 'RealFloat' according to 'FPFormat' and optionally requested precision.------ This corresponds to the @show{E,F,G}Float@ operations provided by @base@'s "Numeric" module.------ __NOTE__: The functions in @base-4.12@ changed the serialisation in--- case of a @Just 0@ precision; this version of @text@ still provides--- the serialisation as implemented in @base-4.11@. The next major--- version of @text@ will switch to the more correct @base-4.12@ serialisation.-formatRealFloat :: (RealFloat a) =>-                   FPFormat-                -> Maybe Int  -- ^ Number of decimal places to render.-                -> a-                -> Builder-{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}-{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}-formatRealFloat fmt decs x-   | isNaN x                   = "NaN"-   | isInfinite x              = if x < 0 then "-Infinity" else "Infinity"-   | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))-   | otherwise                 = doFmt fmt (floatToDigits x)- where-  doFmt format (is, e) =-    let ds = map i2d is in-    case format of-     Generic ->-      doFmt (if e < 0 || e > 7 then Exponent else Fixed)-            (is,e)-     Exponent ->-      case decs of-       Nothing ->-        let show_e' = decimal (e-1) in-        case ds of-          "0"     -> "0.0e0"-          [d]     -> singleton d <> ".0e" <> show_e'-          (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'-          []      -> error "formatRealFloat/doFmt/Exponent/Nothing: []"-       Just dec ->-        let dec' = max dec 1 in-        case is of-         [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"-         _ ->-          let (ei,is') = roundTo (dec'+1) is-              is'' = map i2d (if ei > 0 then init is' else is')-          in case is'' of-               [] -> error "formatRealFloat/doFmt/Exponent/Just: []"-               (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)-     Fixed ->-      let-       mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}-      in-      case decs of-       Nothing-          | e <= 0    -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds-          | otherwise ->-             let-                f 0 s    rs  = mk0 (reverse s) <> singleton '.' <> mk0 rs-                f n s    ""  = f (n-1) ('0':s) ""-                f n s (r:rs) = f (n-1) (r:s) rs-             in-                f e "" ds-       Just dec ->-        let dec' = max dec 0 in-        if e >= 0 then-         let-          (ei,is') = roundTo (dec' + e) is-          (ls,rs)  = splitAt (e+ei) (map i2d is')-         in-         mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)-        else-         let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)-             is'' = map i2d (if ei > 0 then is' else 0:is')-         in case is'' of-              [] -> error "formatRealFloat/doFmt/Fixed: []"-              (d:ds') -> singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')----- Based on "Printing Floating-Point Numbers Quickly and Accurately"--- by R.G. Burger and R.K. Dybvig in PLDI 96.--- This version uses a much slower logarithm estimator. It should be improved.---- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,--- and returns a list of digits and an exponent.--- In particular, if @x>=0@, and------ > floatToDigits base x = ([d1,d2,...,dn], e)------ then------      (1) @n >= 1@------      (2) @x = 0.d1d2...dn * (base**e)@------      (3) @0 <= di <= base-1@--floatToDigits :: (RealFloat a) => a -> ([Int], Int)-{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}-{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}-floatToDigits 0 = ([0], 0)-floatToDigits x =- let-  (f0, e0) = decodeFloat x-  (minExp0, _) = floatRange x-  p = floatDigits x-  b = floatRadix x-  minExp = minExp0 - p -- the real minimum exponent-  -- Haskell requires that f be adjusted so denormalized numbers-  -- will have an impossibly low exponent.  Adjust for this.-  (f, e) =-   let n = minExp - e0 in-   if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)-  (r, s, mUp, mDn) =-   if e >= 0 then-    let be = expt b e in-    if f == expt b (p-1) then-      (f*be*b*2, 2*b, be*b, be)     -- according to Burger and Dybvig-    else-      (f*be*2, 2, be, be)-   else-    if e > minExp && f == expt b (p-1) then-      (f*b*2, expt b (-e+1)*2, b, 1)-    else-      (f*2, expt b (-e)*2, 1, 1)-  k :: Int-  k =-   let-    k0 :: Int-    k0 =-     if b == 2 then-        -- logBase 10 2 is very slightly larger than 8651/28738-        -- (about 5.3558e-10), so if log x >= 0, the approximation-        -- k1 is too small, hence we add one and need one fixup step less.-        -- If log x < 0, the approximation errs rather on the high side.-        -- That is usually more than compensated for by ignoring the-        -- fractional part of logBase 2 x, but when x is a power of 1/2-        -- or slightly larger and the exponent is a multiple of the-        -- denominator of the rational approximation to logBase 10 2,-        -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,-        -- we get a leading zero-digit we don't want.-        -- With the approximation 3/10, this happened for-        -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.-        -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x-        -- for IEEE-ish floating point types with exponent fields-        -- <= 17 bits and mantissae of several thousand bits, earlier-        -- convergents to logBase 10 2 would fail for long double.-        -- Using quot instead of div is a little faster and requires-        -- fewer fixup steps for negative lx.-        let lx = p - 1 + e0-            k1 = (lx * 8651) `quot` 28738-        in if lx >= 0 then k1 + 1 else k1-     else-        -- f :: Integer, log :: Float -> Float,-        --               ceiling :: Float -> Int-        ceiling ((log (fromInteger (f+1) :: Float) +-                 fromIntegral e * log (fromInteger b)) /-                   log 10)---WAS:            fromInt e * log (fromInteger b))--    fixup n =-      if n >= 0 then-        if r + mUp <= expt 10 n * s then n else fixup (n+1)-      else-        if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)-   in-   fixup k0--  gen ds rn sN mUpN mDnN =-   let-    (dn, rn') = (rn * 10) `quotRem` sN-    mUpN' = mUpN * 10-    mDnN' = mDnN * 10-   in-   case (rn' < mDnN', rn' + mUpN' > sN) of-    (True,  False) -> dn : ds-    (False, True)  -> dn+1 : ds-    (True,  True)  -> if rn' * 2 < sN then dn : ds else dn+1 : ds-    (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'--  rds =-   if k >= 0 then-      gen [] r (s * expt 10 k) mUp mDn-   else-     let bk = expt 10 (-k) in-     gen [] (r * bk) s (mUp * bk) (mDn * bk)- in- (map fromIntegral (reverse rds), k)---- Exponentiation with a cache for the most common numbers.-minExpt, maxExpt :: Int-minExpt = 0-maxExpt = 1100--expt :: Integer -> Int -> Integer-expt base n-    | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n-    | base == 10 && n <= maxExpt10              = expts10 `unsafeAt` n-    | otherwise                                 = base^n--expts :: Array Int Integer-expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]--maxExpt10 :: Int-maxExpt10 = 324--expts10 :: Array Int Integer-expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
− Data/Text/Lazy/Encoding.hs 
@@ -1,250 +0,0 @@-{-# LANGUAGE BangPatterns,CPP #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--- |--- Module      : Data.Text.Lazy.Encoding--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : portable------ Functions for converting lazy 'Text' values to and from lazy--- 'ByteString', using several standard encodings.------ To gain access to a much larger family of encodings, use the--- <http://hackage.haskell.org/package/text-icu text-icu package>.--module Data.Text.Lazy.Encoding-    (-    -- * Decoding ByteStrings to Text-    -- $strict-      decodeASCII-    , decodeLatin1-    , decodeUtf8-    , decodeUtf16LE-    , decodeUtf16BE-    , decodeUtf32LE-    , decodeUtf32BE--    -- ** Catchable failure-    , decodeUtf8'--    -- ** Controllable error handling-    , decodeUtf8With-    , decodeUtf16LEWith-    , decodeUtf16BEWith-    , decodeUtf32LEWith-    , decodeUtf32BEWith--    -- * Encoding Text to ByteStrings-    , encodeUtf8-    , encodeUtf16LE-    , encodeUtf16BE-    , encodeUtf32LE-    , encodeUtf32BE--    -- * Encoding Text using ByteString Builders-    , encodeUtf8Builder-    , encodeUtf8BuilderEscaped-    ) where--import Control.Exception (evaluate, try)-import Data.Monoid (Monoid(..))-import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)-import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)-import Data.Word (Word8)-import qualified Data.ByteString as S-import qualified Data.ByteString.Builder as B-import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)-import qualified Data.ByteString.Builder.Prim as BP-import qualified Data.ByteString.Lazy as B-import qualified Data.ByteString.Lazy.Internal as B-import qualified Data.ByteString.Unsafe as B-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E-import qualified Data.Text.Internal.Lazy.Fusion as F-import Data.Text.Unsafe (unsafeDupablePerformIO)---- $strict------ All of the single-parameter functions for decoding bytestrings--- encoded in one of the Unicode Transformation Formats (UTF) operate--- in a /strict/ mode: each will throw an exception if given invalid--- input.------ Each function has a variant, whose name is suffixed with -'With',--- that gives greater control over the handling of decoding errors.--- For instance, 'decodeUtf8' will throw an exception, but--- 'decodeUtf8With' allows the programmer to determine what to do on a--- decoding error.---- | /Deprecated/.  Decode a 'ByteString' containing 7-bit ASCII--- encoded text.-decodeASCII :: B.ByteString -> Text-decodeASCII = decodeUtf8-{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}---- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.-decodeLatin1 :: B.ByteString -> Text-decodeLatin1 = foldr (chunk . TE.decodeLatin1) empty . B.toChunks---- | Decode a 'ByteString' containing UTF-8 encoded text.-decodeUtf8With :: OnDecodeError -> B.ByteString -> Text-decodeUtf8With onErr (B.Chunk b0 bs0) =-    case TE.streamDecodeUtf8With onErr b0 of-      TE.Some t l f -> chunk t (go f l bs0)-  where-    go f0 _ (B.Chunk b bs) =-      case f0 b of-        TE.Some t l f -> chunk t (go f l bs)-    go _ l _-      | S.null l  = empty-      | otherwise = case onErr desc (Just (B.unsafeHead l)) of-                      Nothing -> empty-                      Just c  -> Chunk (T.singleton c) Empty-    desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"-decodeUtf8With _ _ = empty---- | Decode a 'ByteString' containing UTF-8 encoded text that is known--- to be valid.------ If the input contains any invalid UTF-8 data, an exception will be--- thrown that cannot be caught in pure code.  For more control over--- the handling of invalid data, use 'decodeUtf8'' or--- 'decodeUtf8With'.-decodeUtf8 :: B.ByteString -> Text-decodeUtf8 = decodeUtf8With strictDecode-{-# INLINE[0] decodeUtf8 #-}---- This rule seems to cause performance loss.-{- RULES "LAZY STREAM stream/decodeUtf8' fusion" [1]-   forall bs. F.stream (decodeUtf8' bs) = E.streamUtf8 strictDecode bs #-}---- | Decode a 'ByteString' containing UTF-8 encoded text..------ If the input contains any invalid UTF-8 data, the relevant--- exception will be returned, otherwise the decoded text.------ /Note/: this function is /not/ lazy, as it must decode its entire--- input before it can return a result.  If you need lazy (streaming)--- decoding, use 'decodeUtf8With' in lenient mode.-decodeUtf8' :: B.ByteString -> Either UnicodeException Text-decodeUtf8' bs = unsafeDupablePerformIO $ do-                   let t = decodeUtf8 bs-                   try (evaluate (rnf t `seq` t))-  where-    rnf Empty        = ()-    rnf (Chunk _ ts) = rnf ts-{-# INLINE decodeUtf8' #-}---- | Encode text using UTF-8 encoding.-encodeUtf8 :: Text -> B.ByteString-encodeUtf8    Empty       = B.empty-encodeUtf8 lt@(Chunk t _) =-    B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt-  where-    -- To improve our small string performance, we use a strategy that-    -- allocates a buffer that is guaranteed to be large enough for the-    -- encoding of the first chunk, but not larger than the default-    -- B.smallChunkSize. We clamp the firstChunkSize to ensure that we don't-    -- generate too large buffers which hamper streaming.-    firstChunkSize  = min B.smallChunkSize (4 * (T.length t + 1))-    strategy        = B.safeStrategy firstChunkSize B.defaultChunkSize---- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.------ @since 1.1.0.0-encodeUtf8Builder :: Text -> B.Builder-encodeUtf8Builder =-    foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty---- | Encode text using UTF-8 encoding and escape the ASCII characters using--- a 'BP.BoundedPrim'.------ Use this function is to implement efficient encoders for text-based formats--- like JSON or HTML.------ @since 1.1.0.0-{-# INLINE encodeUtf8BuilderEscaped #-}-encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder-encodeUtf8BuilderEscaped prim =-    foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty---- | Decode text from little endian UTF-16 encoding.-decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text-decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)-{-# INLINE decodeUtf16LEWith #-}---- | Decode text from little endian UTF-16 encoding.------ If the input contains any invalid little endian UTF-16 data, an--- exception will be thrown.  For more control over the handling of--- invalid data, use 'decodeUtf16LEWith'.-decodeUtf16LE :: B.ByteString -> Text-decodeUtf16LE = decodeUtf16LEWith strictDecode-{-# INLINE decodeUtf16LE #-}---- | Decode text from big endian UTF-16 encoding.-decodeUtf16BEWith :: OnDecodeError -> B.ByteString -> Text-decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)-{-# INLINE decodeUtf16BEWith #-}---- | Decode text from big endian UTF-16 encoding.------ If the input contains any invalid big endian UTF-16 data, an--- exception will be thrown.  For more control over the handling of--- invalid data, use 'decodeUtf16BEWith'.-decodeUtf16BE :: B.ByteString -> Text-decodeUtf16BE = decodeUtf16BEWith strictDecode-{-# INLINE decodeUtf16BE #-}---- | Encode text using little endian UTF-16 encoding.-encodeUtf16LE :: Text -> B.ByteString-encodeUtf16LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16LE) [] txt)-{-# INLINE encodeUtf16LE #-}---- | Encode text using big endian UTF-16 encoding.-encodeUtf16BE :: Text -> B.ByteString-encodeUtf16BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16BE) [] txt)-{-# INLINE encodeUtf16BE #-}---- | Decode text from little endian UTF-32 encoding.-decodeUtf32LEWith :: OnDecodeError -> B.ByteString -> Text-decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)-{-# INLINE decodeUtf32LEWith #-}---- | Decode text from little endian UTF-32 encoding.------ If the input contains any invalid little endian UTF-32 data, an--- exception will be thrown.  For more control over the handling of--- invalid data, use 'decodeUtf32LEWith'.-decodeUtf32LE :: B.ByteString -> Text-decodeUtf32LE = decodeUtf32LEWith strictDecode-{-# INLINE decodeUtf32LE #-}---- | Decode text from big endian UTF-32 encoding.-decodeUtf32BEWith :: OnDecodeError -> B.ByteString -> Text-decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)-{-# INLINE decodeUtf32BEWith #-}---- | Decode text from big endian UTF-32 encoding.------ If the input contains any invalid big endian UTF-32 data, an--- exception will be thrown.  For more control over the handling of--- invalid data, use 'decodeUtf32BEWith'.-decodeUtf32BE :: B.ByteString -> Text-decodeUtf32BE = decodeUtf32BEWith strictDecode-{-# INLINE decodeUtf32BE #-}---- | Encode text using little endian UTF-32 encoding.-encodeUtf32LE :: Text -> B.ByteString-encodeUtf32LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32LE) [] txt)-{-# INLINE encodeUtf32LE #-}---- | Encode text using big endian UTF-32 encoding.-encodeUtf32BE :: Text -> B.ByteString-encodeUtf32BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32BE) [] txt)-{-# INLINE encodeUtf32BE #-}
− Data/Text/Lazy/IO.hs 
@@ -1,195 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif--- |--- Module      : Data.Text.Lazy.IO--- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,---               (c) 2009 Simon Marlow--- License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : GHC------ Efficient locale-sensitive support for lazy text I\/O.------ Skip past the synopsis for some important notes on performance and--- portability across different versions of GHC.--module Data.Text.Lazy.IO-    (-    -- * Performance-    -- $performance--    -- * Locale support-    -- $locale-    -- * File-at-a-time operations-      readFile-    , writeFile-    , appendFile-    -- * Operations on handles-    , hGetContents-    , hGetLine-    , hPutStr-    , hPutStrLn-    -- * Special cases for standard input and output-    , interact-    , getContents-    , getLine-    , putStr-    , putStrLn-    ) where--import Data.Text.Lazy (Text)-import Prelude hiding (appendFile, getContents, getLine, interact,-                       putStr, putStrLn, readFile, writeFile)-import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,-                  withFile)-import qualified Data.Text.IO as T-import qualified Data.Text.Lazy as L-import qualified Control.Exception as E-import Control.Monad (when)-import Data.IORef (readIORef)-import Data.Text.Internal.IO (hGetLineWith, readChunk)-import Data.Text.Internal.Lazy (chunk, empty)-import GHC.IO.Buffer (isEmptyBuffer)-import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)-import GHC.IO.Handle.Internals (augmentIOError, hClose_help,-                                wantReadableHandle, withHandle)-import GHC.IO.Handle.Types (Handle__(..), HandleType(..))-import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)-import System.IO.Error (isEOFError)-import System.IO.Unsafe (unsafeInterleaveIO)---- $performance------ The functions in this module obey the runtime system's locale,--- character set encoding, and line ending conversion settings.------ If you know in advance that you will be working with data that has--- a specific encoding (e.g. UTF-8), and your application is highly--- performance sensitive, you may find that it is faster to perform--- I\/O with bytestrings and to encode and decode yourself than to use--- the functions in this module.------ Whether this will hold depends on the version of GHC you are using,--- the platform you are working on, the data you are working with, and--- the encodings you are using, so be sure to test for yourself.---- | Read a file and return its contents as a string.  The file is--- read lazily, as with 'getContents'.-readFile :: FilePath -> IO Text-readFile name = openFile name ReadMode >>= hGetContents---- | Write a string to a file.  The file is truncated to zero length--- before writing begins.-writeFile :: FilePath -> Text -> IO ()-writeFile p = withFile p WriteMode . flip hPutStr---- | Write a string the end of a file.-appendFile :: FilePath -> Text -> IO ()-appendFile p = withFile p AppendMode . flip hPutStr---- | Lazily read the remaining contents of a 'Handle'.  The 'Handle'--- will be closed after the read completes, or on error.-hGetContents :: Handle -> IO Text-hGetContents h = do-  chooseGoodBuffering h-  wantReadableHandle "hGetContents" h $ \hh -> do-    ts <- lazyRead h-    return (hh{haType=SemiClosedHandle}, ts)---- | Use a more efficient buffer size if we're reading in--- block-buffered mode with the default buffer size.-chooseGoodBuffering :: Handle -> IO ()-chooseGoodBuffering h = do-  bufMode <- hGetBuffering h-  when (bufMode == BlockBuffering Nothing) $-    hSetBuffering h (BlockBuffering (Just 16384))--lazyRead :: Handle -> IO Text-lazyRead h = unsafeInterleaveIO $-  withHandle "hGetContents" h $ \hh -> do-    case haType hh of-      ClosedHandle     -> return (hh, L.empty)-      SemiClosedHandle -> lazyReadBuffered h hh-      _                -> ioException-                          (IOError (Just h) IllegalOperation "hGetContents"-                           "illegal handle type" Nothing Nothing)--lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, Text)-lazyReadBuffered h hh@Handle__{..} = do-   buf <- readIORef haCharBuffer-   (do t <- readChunk hh buf-       ts <- lazyRead h-       return (hh, chunk t ts)) `E.catch` \e -> do-         (hh', _) <- hClose_help hh-         if isEOFError e-           then return $ if isEmptyBuffer buf-                         then (hh', empty)-                         else (hh', L.singleton '\r')-           else E.throwIO (augmentIOError e "hGetContents" h)---- | Read a single line from a handle.-hGetLine :: Handle -> IO Text-hGetLine = hGetLineWith L.fromChunks---- | Write a string to a handle.-hPutStr :: Handle -> Text -> IO ()-hPutStr h = mapM_ (T.hPutStr h) . L.toChunks---- | Write a string to a handle, followed by a newline.-hPutStrLn :: Handle -> Text -> IO ()-hPutStrLn h t = hPutStr h t >> hPutChar h '\n'---- | The 'interact' function takes a function of type @Text -> Text@--- as its argument. The entire input from the standard input device is--- passed (lazily) to this function as its argument, and the resulting--- string is output on the standard output device.-interact :: (Text -> Text) -> IO ()-interact f = putStr . f =<< getContents---- | Lazily read all user input on 'stdin' as a single string.-getContents :: IO Text-getContents = hGetContents stdin---- | Read a single line of user input from 'stdin'.-getLine :: IO Text-getLine = hGetLine stdin---- | Write a string to 'stdout'.-putStr :: Text -> IO ()-putStr = hPutStr stdout---- | Write a string to 'stdout', followed by a newline.-putStrLn :: Text -> IO ()-putStrLn = hPutStrLn stdout---- $locale------ /Note/: The behaviour of functions in this module depends on the--- version of GHC you are using.------ Beginning with GHC 6.12, text I\/O is performed using the system or--- handle's current locale and line ending conventions.------ Under GHC 6.10 and earlier, the system I\/O libraries /do not--- support/ locale-sensitive I\/O or line ending conversion.  On these--- versions of GHC, functions in this library all use UTF-8.  What--- does this mean in practice?------ * All data that is read will be decoded as UTF-8.------ * Before data is written, it is first encoded as UTF-8.------ * On both reading and writing, the platform's native newline---   conversion is performed.------ If you must use a non-UTF-8 locale on an older version of GHC, you--- will have to perform the transcoding yourself, e.g. as follows:------ > import qualified Data.ByteString.Lazy as B--- > import Data.Text.Lazy (Text)--- > import Data.Text.Lazy.Encoding (encodeUtf16)--- >--- > putStr_Utf16LE :: Text -> IO ()--- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
− Data/Text/Lazy/Internal.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}--- |--- Module      : Data.Text.Lazy.Internal--- Copyright   : (c) 2013 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC------ This module has been renamed to 'Data.Text.Internal.Lazy'. This--- name for the module will be removed in the next major release.--module Data.Text.Lazy.Internal-    {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}-    (-      module Data.Text.Internal.Lazy-    ) where--import Data.Text.Internal.Lazy
− Data/Text/Lazy/Read.hs 
@@ -1,192 +0,0 @@-{-# LANGUAGE OverloadedStrings, CPP #-}-#if __GLASGOW_HASKELL__ >= 704-{-# LANGUAGE Safe #-}-#elif __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif---- |--- Module      : Data.Text.Lazy.Read--- Copyright   : (c) 2010, 2011 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : GHC------ Functions used frequently when reading textual data.-module Data.Text.Lazy.Read-    (-      Reader-    , decimal-    , hexadecimal-    , signed-    , rational-    , double-    ) where--import Control.Monad (liftM)-import Data.Char (isDigit, isHexDigit)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Ratio ((%))-import Data.Text.Internal.Read-import Data.Text.Lazy as T-import Data.Word (Word, Word8, Word16, Word32, Word64)---- | Read some text.  If the read succeeds, return its value and the--- remaining text, otherwise an error message.-type Reader a = IReader Text a-type Parser = IParser Text---- | Read a decimal integer.  The input must begin with at least one--- decimal digit, and is consumed until a non-digit or end of string--- is reached.------ This function does not handle leading sign characters.  If you need--- to handle signed input, use @'signed' 'decimal'@.------ /Note/: For fixed-width integer types, this function does not--- attempt to detect overflow, so a sufficiently long input may give--- incorrect results.  If you are worried about overflow, use--- 'Integer' for your result type.-decimal :: Integral a => Reader a-{-# SPECIALIZE decimal :: Reader Int #-}-{-# SPECIALIZE decimal :: Reader Int8 #-}-{-# SPECIALIZE decimal :: Reader Int16 #-}-{-# SPECIALIZE decimal :: Reader Int32 #-}-{-# SPECIALIZE decimal :: Reader Int64 #-}-{-# SPECIALIZE decimal :: Reader Integer #-}-{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}-{-# SPECIALIZE decimal :: Reader Word8 #-}-{-# SPECIALIZE decimal :: Reader Word16 #-}-{-# SPECIALIZE decimal :: Reader Word32 #-}-{-# SPECIALIZE decimal :: Reader Word64 #-}-decimal txt-    | T.null h  = Left "input does not start with a digit"-    | otherwise = Right (T.foldl' go 0 h, t)-  where (h,t)  = T.span isDigit txt-        go n d = (n * 10 + fromIntegral (digitToInt d))---- | Read a hexadecimal integer, consisting of an optional leading--- @\"0x\"@ followed by at least one hexadecimal digit. Input is--- consumed until a non-hex-digit or end of string is reached.--- This function is case insensitive.------ This function does not handle leading sign characters.  If you need--- to handle signed input, use @'signed' 'hexadecimal'@.------ /Note/: For fixed-width integer types, this function does not--- attempt to detect overflow, so a sufficiently long input may give--- incorrect results.  If you are worried about overflow, use--- 'Integer' for your result type.-hexadecimal :: Integral a => Reader a-{-# SPECIALIZE hexadecimal :: Reader Int #-}-{-# SPECIALIZE hexadecimal :: Reader Integer #-}-hexadecimal txt-    | h == "0x" || h == "0X" = hex t-    | otherwise              = hex txt- where (h,t) = T.splitAt 2 txt--hex :: Integral a => Reader a-{-# SPECIALIZE hexadecimal :: Reader Int #-}-{-# SPECIALIZE hexadecimal :: Reader Int8 #-}-{-# SPECIALIZE hexadecimal :: Reader Int16 #-}-{-# SPECIALIZE hexadecimal :: Reader Int32 #-}-{-# SPECIALIZE hexadecimal :: Reader Int64 #-}-{-# SPECIALIZE hexadecimal :: Reader Integer #-}-{-# SPECIALIZE hexadecimal :: Reader Word #-}-{-# SPECIALIZE hexadecimal :: Reader Word8 #-}-{-# SPECIALIZE hexadecimal :: Reader Word16 #-}-{-# SPECIALIZE hexadecimal :: Reader Word32 #-}-{-# SPECIALIZE hexadecimal :: Reader Word64 #-}-hex txt-    | T.null h  = Left "input does not start with a hexadecimal digit"-    | otherwise = Right (T.foldl' go 0 h, t)-  where (h,t)  = T.span isHexDigit txt-        go n d = (n * 16 + fromIntegral (hexDigitToInt d))---- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and--- apply it to the result of applying the given reader.-signed :: Num a => Reader a -> Reader a-{-# INLINE signed #-}-signed f = runP (signa (P f))---- | Read a rational number.------ This function accepts an optional leading sign character, followed--- by at least one decimal digit.  The syntax similar to that accepted--- by the 'read' function, with the exception that a trailing @\'.\'@--- or @\'e\'@ /not/ followed by a number is not consumed.------ Examples:------ >rational "3"     == Right (3.0, "")--- >rational "3.1"   == Right (3.1, "")--- >rational "3e4"   == Right (30000.0, "")--- >rational "3.1e4" == Right (31000.0, "")--- >rational ".3"    == Left "input does not start with a digit"--- >rational "e3"    == Left "input does not start with a digit"------ Examples of differences from 'read':------ >rational "3.foo" == Right (3.0, ".foo")--- >rational "3e"    == Right (3.0, "e")-rational :: Fractional a => Reader a-{-# SPECIALIZE rational :: Reader Double #-}-rational = floaty $ \real frac fracDenom -> fromRational $-                     real % 1 + frac % fracDenom---- | Read a rational number.------ The syntax accepted by this function is the same as for 'rational'.------ /Note/: This function is almost ten times faster than 'rational',--- but is slightly less accurate.------ The 'Double' type supports about 16 decimal places of accuracy.--- For 94.2% of numbers, this function and 'rational' give identical--- results, but for the remaining 5.8%, this function loses precision--- around the 15th decimal place.  For 0.001% of numbers, this--- function will lose precision at the 13th or 14th decimal place.-double :: Reader Double-double = floaty $ \real frac fracDenom ->-                   fromIntegral real +-                   fromIntegral frac / fromIntegral fracDenom--signa :: Num a => Parser a -> Parser a-{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}-{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}-{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}-{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}-{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}-{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}-signa p = do-  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')-  if sign == '+' then p else negate `liftM` p--char :: (Char -> Bool) -> Parser Char-char p = P $ \t -> case T.uncons t of-                     Just (c,t') | p c -> Right (c,t')-                     _                 -> Left "character does not match"--floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a-{-# INLINE floaty #-}-floaty f = runP $ do-  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')-  real <- P decimal-  T fraction fracDigits <- perhaps (T 0 0) $ do-    _ <- char (=='.')-    digits <- P $ \t -> Right (fromIntegral . T.length $ T.takeWhile isDigit t, t)-    n <- P decimal-    return $ T n digits-  let e c = c == 'e' || c == 'E'-  power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)-  let n = if fracDigits == 0-          then if power == 0-               then fromIntegral real-               else fromIntegral real * (10 ^^ power)-          else if power == 0-               then f real fraction (10 ^ fracDigits)-               else f real fraction (10 ^ fracDigits) * (10 ^^ power)-  return $! if sign == '+'-            then n-            else -n
− Data/Text/Read.hs 
@@ -1,200 +0,0 @@-{-# LANGUAGE OverloadedStrings, UnboxedTuples, CPP #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif---- |--- Module      : Data.Text.Read--- Copyright   : (c) 2010, 2011 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : GHC------ Functions used frequently when reading textual data.-module Data.Text.Read-    (-      Reader-    , decimal-    , hexadecimal-    , signed-    , rational-    , double-    ) where--import Control.Monad (liftM)-import Data.Char (isDigit, isHexDigit)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Ratio ((%))-import Data.Text as T-import Data.Text.Internal.Private (span_)-import Data.Text.Internal.Read-import Data.Word (Word, Word8, Word16, Word32, Word64)---- | Read some text.  If the read succeeds, return its value and the--- remaining text, otherwise an error message.-type Reader a = IReader Text a-type Parser a = IParser Text a---- | Read a decimal integer.  The input must begin with at least one--- decimal digit, and is consumed until a non-digit or end of string--- is reached.------ This function does not handle leading sign characters.  If you need--- to handle signed input, use @'signed' 'decimal'@.------ /Note/: For fixed-width integer types, this function does not--- attempt to detect overflow, so a sufficiently long input may give--- incorrect results.  If you are worried about overflow, use--- 'Integer' for your result type.-decimal :: Integral a => Reader a-{-# SPECIALIZE decimal :: Reader Int #-}-{-# SPECIALIZE decimal :: Reader Int8 #-}-{-# SPECIALIZE decimal :: Reader Int16 #-}-{-# SPECIALIZE decimal :: Reader Int32 #-}-{-# SPECIALIZE decimal :: Reader Int64 #-}-{-# SPECIALIZE decimal :: Reader Integer #-}-{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}-{-# SPECIALIZE decimal :: Reader Word8 #-}-{-# SPECIALIZE decimal :: Reader Word16 #-}-{-# SPECIALIZE decimal :: Reader Word32 #-}-{-# SPECIALIZE decimal :: Reader Word64 #-}-decimal txt-    | T.null h  = Left "input does not start with a digit"-    | otherwise = Right (T.foldl' go 0 h, t)-  where (# h,t #)  = span_ isDigit txt-        go n d = (n * 10 + fromIntegral (digitToInt d))---- | Read a hexadecimal integer, consisting of an optional leading--- @\"0x\"@ followed by at least one hexadecimal digit. Input is--- consumed until a non-hex-digit or end of string is reached.--- This function is case insensitive.------ This function does not handle leading sign characters.  If you need--- to handle signed input, use @'signed' 'hexadecimal'@.------ /Note/: For fixed-width integer types, this function does not--- attempt to detect overflow, so a sufficiently long input may give--- incorrect results.  If you are worried about overflow, use--- 'Integer' for your result type.-hexadecimal :: Integral a => Reader a-{-# SPECIALIZE hexadecimal :: Reader Int #-}-{-# SPECIALIZE hexadecimal :: Reader Int8 #-}-{-# SPECIALIZE hexadecimal :: Reader Int16 #-}-{-# SPECIALIZE hexadecimal :: Reader Int32 #-}-{-# SPECIALIZE hexadecimal :: Reader Int64 #-}-{-# SPECIALIZE hexadecimal :: Reader Integer #-}-{-# SPECIALIZE hexadecimal :: Reader Word #-}-{-# SPECIALIZE hexadecimal :: Reader Word8 #-}-{-# SPECIALIZE hexadecimal :: Reader Word16 #-}-{-# SPECIALIZE hexadecimal :: Reader Word32 #-}-{-# SPECIALIZE hexadecimal :: Reader Word64 #-}-hexadecimal txt-    | h == "0x" || h == "0X" = hex t-    | otherwise              = hex txt- where (h,t) = T.splitAt 2 txt--hex :: Integral a => Reader a-{-# SPECIALIZE hex :: Reader Int #-}-{-# SPECIALIZE hex :: Reader Int8 #-}-{-# SPECIALIZE hex :: Reader Int16 #-}-{-# SPECIALIZE hex :: Reader Int32 #-}-{-# SPECIALIZE hex :: Reader Int64 #-}-{-# SPECIALIZE hex :: Reader Integer #-}-{-# SPECIALIZE hex :: Reader Word #-}-{-# SPECIALIZE hex :: Reader Word8 #-}-{-# SPECIALIZE hex :: Reader Word16 #-}-{-# SPECIALIZE hex :: Reader Word32 #-}-{-# SPECIALIZE hex :: Reader Word64 #-}-hex txt-    | T.null h  = Left "input does not start with a hexadecimal digit"-    | otherwise = Right (T.foldl' go 0 h, t)-  where (# h,t #)  = span_ isHexDigit txt-        go n d = (n * 16 + fromIntegral (hexDigitToInt d))---- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and--- apply it to the result of applying the given reader.-signed :: Num a => Reader a -> Reader a-{-# INLINE signed #-}-signed f = runP (signa (P f))---- | Read a rational number.------ This function accepts an optional leading sign character, followed--- by at least one decimal digit.  The syntax similar to that accepted--- by the 'read' function, with the exception that a trailing @\'.\'@--- or @\'e\'@ /not/ followed by a number is not consumed.------ Examples (with behaviour identical to 'read'):------ >rational "3"     == Right (3.0, "")--- >rational "3.1"   == Right (3.1, "")--- >rational "3e4"   == Right (30000.0, "")--- >rational "3.1e4" == Right (31000.0, "")--- >rational ".3"    == Left "input does not start with a digit"--- >rational "e3"    == Left "input does not start with a digit"------ Examples of differences from 'read':------ >rational "3.foo" == Right (3.0, ".foo")--- >rational "3e"    == Right (3.0, "e")-rational :: Fractional a => Reader a-{-# SPECIALIZE rational :: Reader Double #-}-rational = floaty $ \real frac fracDenom -> fromRational $-                     real % 1 + frac % fracDenom---- | Read a rational number.------ The syntax accepted by this function is the same as for 'rational'.------ /Note/: This function is almost ten times faster than 'rational',--- but is slightly less accurate.------ The 'Double' type supports about 16 decimal places of accuracy.--- For 94.2% of numbers, this function and 'rational' give identical--- results, but for the remaining 5.8%, this function loses precision--- around the 15th decimal place.  For 0.001% of numbers, this--- function will lose precision at the 13th or 14th decimal place.-double :: Reader Double-double = floaty $ \real frac fracDenom ->-                   fromIntegral real +-                   fromIntegral frac / fromIntegral fracDenom--signa :: Num a => Parser a -> Parser a-{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}-{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}-{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}-{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}-{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}-{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}-signa p = do-  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')-  if sign == '+' then p else negate `liftM` p--char :: (Char -> Bool) -> Parser Char-char p = P $ \t -> case T.uncons t of-                     Just (c,t') | p c -> Right (c,t')-                     _                 -> Left "character does not match"--floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a-{-# INLINE floaty #-}-floaty f = runP $ do-  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')-  real <- P decimal-  T fraction fracDigits <- perhaps (T 0 0) $ do-    _ <- char (=='.')-    digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)-    n <- P decimal-    return $ T n digits-  let e c = c == 'e' || c == 'E'-  power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)-  let n = if fracDigits == 0-          then if power == 0-               then fromIntegral real-               else fromIntegral real * (10 ^^ power)-          else if power == 0-               then f real fraction (10 ^ fracDigits)-               else f real fraction (10 ^ fracDigits) * (10 ^^ power)-  return $! if sign == '+'-            then n-            else -n
− Data/Text/Show.hs 
@@ -1,90 +0,0 @@-{-# LANGUAGE CPP, MagicHash #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif---- |--- Module      : Data.Text.Show--- Copyright   : (c) 2009-2015 Bryan O'Sullivan------ License     : BSD-style--- Maintainer  : bos@serpentine.com--- Stability   : experimental--- Portability : GHC--module Data.Text.Show-    (-      singleton-    , unpack-    , unpackCString#-    ) where--import Control.Monad.ST (ST)-import Data.Text.Internal (Text(..), empty_, safe)-import Data.Text.Internal.Fusion (stream, unstream)-import Data.Text.Internal.Unsafe.Char (unsafeWrite)-import GHC.Prim (Addr#)-import qualified Data.Text.Array as A-import qualified Data.Text.Internal.Fusion.Common as S--#if __GLASGOW_HASKELL__ >= 702-import qualified GHC.CString as GHC-#else-import qualified GHC.Base as GHC-#endif--instance Show Text where-    showsPrec p ps r = showsPrec p (unpack ps) r---- | /O(n)/ Convert a 'Text' into a 'String'.  Subject to fusion.-unpack :: Text -> String-unpack = S.unstreamList . stream-{-# INLINE [1] unpack #-}---- | /O(n)/ Convert a literal string into a 'Text'.------ This is exposed solely for people writing GHC rewrite rules.------ @since 1.2.1.1-unpackCString# :: Addr# -> Text-unpackCString# addr# = unstream (S.streamCString# addr#)-{-# NOINLINE unpackCString# #-}--{-# RULES "TEXT literal" [1] forall a.-    unstream (S.map safe (S.streamList (GHC.unpackCString# a)))-      = unpackCString# a #-}--{-# RULES "TEXT literal UTF8" [1] forall a.-    unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))-      = unpackCString# a #-}--{-# RULES "TEXT empty literal" [1]-    unstream (S.map safe (S.streamList []))-      = empty_ #-}--{-# RULES "TEXT singleton literal" [1] forall a.-    unstream (S.map safe (S.streamList [a]))-      = singleton_ a #-}---- | /O(1)/ Convert a character into a Text.  Subject to fusion.--- Performs replacement on invalid scalar values.-singleton :: Char -> Text-singleton = unstream . S.singleton . safe-{-# INLINE [1] singleton #-}--{-# RULES "TEXT singleton" forall a.-    unstream (S.singleton (safe a))-      = singleton_ a #-}---- This is intended to reduce inlining bloat.-singleton_ :: Char -> Text-singleton_ c = Text (A.run x) 0 len-  where x :: ST s (A.MArray s)-        x = do arr <- A.new len-               _ <- unsafeWrite arr 0 d-               return arr-        len | d < '\x10000' = 1-            | otherwise     = 2-        d = safe c-{-# NOINLINE singleton_ #-}
− Data/Text/Unsafe.hs 
@@ -1,124 +0,0 @@-{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}--- |--- Module      : Data.Text.Unsafe--- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan--- License     : BSD-style--- Maintainer  : bos@serpentine.com--- Portability : portable------ A module containing unsafe 'Text' operations, for very very careful--- use in heavily tested code.-module Data.Text.Unsafe-    (-      inlineInterleaveST-    , inlinePerformIO-    , unsafeDupablePerformIO-    , Iter(..)-    , iter-    , iter_-    , reverseIter-    , reverseIter_-    , unsafeHead-    , unsafeTail-    , lengthWord16-    , takeWord16-    , dropWord16-    ) where--#if defined(ASSERTS)-import Control.Exception (assert)-#endif-import Data.Text.Internal.Encoding.Utf16 (chr2)-import Data.Text.Internal (Text(..))-import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)-import Data.Text.Internal.Unsafe.Char (unsafeChr)-import qualified Data.Text.Array as A-import GHC.IO (unsafeDupablePerformIO)---- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'--- omits the check for the empty case, so there is an obligation on--- the programmer to provide a proof that the 'Text' is non-empty.-unsafeHead :: Text -> Char-unsafeHead (Text arr off _len)-    | m < 0xD800 || m > 0xDBFF = unsafeChr m-    | otherwise                = chr2 m n-    where m = A.unsafeIndex arr off-          n = A.unsafeIndex arr (off+1)-{-# INLINE unsafeHead #-}---- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'--- omits the check for the empty case, so there is an obligation on--- the programmer to provide a proof that the 'Text' is non-empty.-unsafeTail :: Text -> Text-unsafeTail t@(Text arr off len) =-#if defined(ASSERTS)-    assert (d <= len) $-#endif-    Text arr (off+d) (len-d)-  where d = iter_ t 0-{-# INLINE unsafeTail #-}--data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int---- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16--- array, returning the current character and the delta to add to give--- the next offset to iterate at.-iter :: Text -> Int -> Iter-iter (Text arr off _len) i-    | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1-    | otherwise                = Iter (chr2 m n) 2-  where m = A.unsafeIndex arr j-        n = A.unsafeIndex arr k-        j = off + i-        k = j + 1-{-# INLINE iter #-}---- | /O(1)/ Iterate one step through a UTF-16 array, returning the--- delta to add to give the next offset to iterate at.-iter_ :: Text -> Int -> Int-iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1-                            | otherwise                = 2-  where m = A.unsafeIndex arr (off+i)-{-# INLINE iter_ #-}---- | /O(1)/ Iterate one step backwards through a UTF-16 array,--- returning the current character and the delta to add (i.e. a--- negative number) to give the next offset to iterate at.-reverseIter :: Text -> Int -> (Char,Int)-reverseIter (Text arr off _len) i-    | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)-    | otherwise                = (chr2 n m,    -2)-  where m = A.unsafeIndex arr j-        n = A.unsafeIndex arr k-        j = off + i-        k = j - 1-{-# INLINE reverseIter #-}---- | /O(1)/ Iterate one step backwards through a UTF-16 array,--- returning the delta to add (i.e. a negative number) to give the--- next offset to iterate at.------ @since 1.1.1.0-reverseIter_ :: Text -> Int -> Int-reverseIter_ (Text arr off _len) i-    | m < 0xDC00 || m > 0xDFFF = -1-    | otherwise                = -2-  where m = A.unsafeIndex arr (off+i)-{-# INLINE reverseIter_ #-}---- | /O(1)/ Return the length of a 'Text' in units of 'Word16'.  This--- is useful for sizing a target array appropriately before using--- 'unsafeCopyToPtr'.-lengthWord16 :: Text -> Int-lengthWord16 (Text _arr _off len) = len-{-# INLINE lengthWord16 #-}---- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.-takeWord16 :: Int -> Text -> Text-takeWord16 k (Text arr off _len) = Text arr off k-{-# INLINE takeWord16 #-}---- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.-dropWord16 :: Int -> Text -> Text-dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)-{-# INLINE dropWord16 #-}
+ benchmarks/cbits-bench/time_iconv.c view
@@ -0,0 +1,35 @@+#include <iconv.h>+#include <stdlib.h>+#include <stdio.h>+#include <stdint.h>++int time_iconv(char *srcbuf, size_t srcbufsize)+{+  uint16_t *destbuf = NULL;+  size_t destbufsize;+  static uint16_t *origdestbuf;+  static size_t origdestbufsize;+  iconv_t ic = (iconv_t) -1;+  int ret = 0;++  if (ic == (iconv_t) -1) {+    ic = iconv_open("UTF-16LE", "UTF-8");+    if (ic == (iconv_t) -1) {+      ret = -1;+      goto done;+    }+  }+  +  destbufsize = srcbufsize * sizeof(uint16_t);+  if (destbufsize > origdestbufsize) {+    free(origdestbuf);+    origdestbuf = destbuf = malloc(origdestbufsize = destbufsize);+  } else {+    destbuf = origdestbuf;+  }++  iconv(ic, &srcbuf, &srcbufsize, (char**) &destbuf, &destbufsize);++ done:+  return ret;+}
− benchmarks/cbits/time_iconv.c 
@@ -1,35 +0,0 @@-#include <iconv.h>-#include <stdlib.h>-#include <stdio.h>-#include <stdint.h>--int time_iconv(char *srcbuf, size_t srcbufsize)-{-  uint16_t *destbuf = NULL;-  size_t destbufsize;-  static uint16_t *origdestbuf;-  static size_t origdestbufsize;-  iconv_t ic = (iconv_t) -1;-  int ret = 0;--  if (ic == (iconv_t) -1) {-    ic = iconv_open("UTF-16LE", "UTF-8");-    if (ic == (iconv_t) -1) {-      ret = -1;-      goto done;-    }-  }-  -  destbufsize = srcbufsize * sizeof(uint16_t);-  if (destbufsize > origdestbufsize) {-    free(origdestbuf);-    origdestbuf = destbuf = malloc(origdestbufsize = destbufsize);-  } else {-    destbuf = origdestbuf;-  }--  iconv(ic, &srcbuf, &srcbufsize, (char**) &destbuf, &destbufsize);-- done:-  return ret;-}
benchmarks/python/cut.py view
@@ -1,4 +1,4 @@-#!/usr/bin/env python+#!/usr/bin/env python3  import utils, sys, codecs
benchmarks/python/multilang.py view
@@ -1,4 +1,4 @@-#!/usr/bin/env python+#!/usr/bin/env python3  import math import sys@@ -12,23 +12,22 @@     a = 1e300     def g():         return-    for i in xrange(3):+    for i in range(3):         start = time.time()-        for j in xrange(count):+        for j in range(count):             g()         a = min(a, (time.time() - start) / count)      b = 1e300-    for i in xrange(3):+    for i in range(3):         start = time.time()-        for j in xrange(count):+        for j in range(count):             f()         b = min(b, (time.time() - start) / count)      return round(b - a, int(round(math.log(count, 10) - math.log(b - a, 10))))  contents = open('../../tests/text-test-data/yiwiki.xml', 'r').read()-contents = contents.decode('utf-8')  benchmarks = (     find_first,@@ -47,4 +46,4 @@ for b in bms:     sys.stdout.write(b.__name__ + ' ')     sys.stdout.flush()-    print b()+    print(b())
benchmarks/python/sort.py view
@@ -1,4 +1,4 @@-#!/usr/bin/env python+#!/usr/bin/env python3  import utils, sys, codecs
benchmarks/python/strip_tags.py view
@@ -1,4 +1,4 @@-#!/usr/bin/env python+#!/usr/bin/env python3  import utils, sys
benchmarks/python/utils.py view
@@ -1,4 +1,4 @@-#!/usr/bin/env python+#!/usr/bin/env python3  import sys, time
benchmarks/text-benchmarks.cabal view
@@ -2,10 +2,10 @@ name:                text-benchmarks version:             0.0.0.0 synopsis:            Benchmarks for the text package-description:         Benchmarks for the text package+description:         Benchmarks for the text package. homepage:            https://bitbucket.org/bos/text license:             BSD2-license-file:        ../LICENSE+license-file:        LICENSE author:              Jasper Van der Jeugt <jaspervdj@gmail.com>,                      Bryan O'Sullivan <bos@serpentine.com>,                      Tom Harper <rtomharper@googlemail.com>,@@ -13,7 +13,12 @@ maintainer:          jaspervdj@gmail.com category:            Text build-type:          Simple+tested-with:    GHC==8.10.2, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4,+                GHC==8.2.2, GHC==8.0.2, GHC==7.10.3 +extra-source-files:+    include/*.h+ flag bytestring-builder   description: Depend on the bytestring-builder package for backwards compatibility.   default: False@@ -54,7 +59,7 @@     build-depends: bytestring         >= 0.10.4    -- modules for benchmark proper-  c-sources:      cbits/time_iconv.c+  c-sources:      cbits-bench/time_iconv.c   hs-source-dirs: haskell   main-is:        Benchmarks.hs   other-modules:@@ -81,9 +86,9 @@    -- Source code for IUT (implementation under test)   -- "borrowed" from parent folder-  include-dirs:   ../include-  c-sources:      ../cbits/cbits.c-  hs-source-dirs: ..+  include-dirs:   include+  c-sources:      cbits/cbits.c+  hs-source-dirs: src   other-modules:     Data.Text     Data.Text.Array@@ -96,6 +101,7 @@     Data.Text.Internal.Builder.Functions     Data.Text.Internal.Builder.Int.Digits     Data.Text.Internal.Builder.RealFloat.Functions+    Data.Text.Internal.ByteStringCompat     Data.Text.Internal.Encoding.Fusion     Data.Text.Internal.Encoding.Fusion.Common     Data.Text.Internal.Encoding.Utf16@@ -132,6 +138,7 @@    default-language: Haskell2010   default-extensions: NondecreasingIndentation+  other-extensions: DeriveAnyClass   executable text-multilang
changelog.md view
@@ -1,3 +1,12 @@+See also http://pvp.haskell.org/faq++#### 1.2.4.1++* Support `template-haskell-2.17.0.0`+* Support `bytestring-0.11`+* Add `take . drop` related RULE+* Add doctest examples for `span` and `break`+ ### 1.2.4.0  * Add TH `Lift` instances for `Data.Text.Text` and `Data.Text.Lazy.Text` (gh-232)@@ -9,7 +18,7 @@  * Support `base-4.13.0.0` -### 1.2.3.1+#### 1.2.3.1  * Make `decodeUtf8With` fail explicitly for unsupported non-BMP   replacement characters instead silent undefined behaviour (gh-213)
+ src/Data/Text.hs view
@@ -0,0 +1,1905 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples, TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-- Using TemplateHaskell in text unconditionally is unacceptable, as+-- it's a GHC boot library. TemplateHaskellQuotes was added in 8.0, so+-- this would seem to be a problem. However, GHC's policy of only+-- needing to be able to compile itself from the last few releases+-- allows us to use full-fat TH on older versions, while using THQ for+-- GHC versions that may be used for bootstrapping.+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TemplateHaskellQuotes #-}+#else+{-# LANGUAGE TemplateHaskell #-}+#endif++-- |+-- Module      : Data.Text+-- Copyright   : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,+--               (c) 2009 Duncan Coutts,+--               (c) 2008, 2009 Tom Harper+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : GHC+--+-- A time and space-efficient implementation of Unicode text.+-- Suitable for performance critical use, both in terms of large data+-- quantities and high speed.+--+-- /Note/: Read below the synopsis for important notes on the use of+-- this module.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions, e.g.+--+-- > import qualified Data.Text as T+--+-- To use an extended and very rich family of functions for working+-- with Unicode text (including normalization, regular expressions,+-- non-standard encodings, text breaking, and locales), see the+-- <http://hackage.haskell.org/package/text-icu text-icu package >.+--++module Data.Text+    (+    -- * Strict vs lazy types+    -- $strict++    -- * Acceptable data+    -- $replacement++    -- * Definition of character+    -- $character_definition++    -- * Fusion+    -- $fusion++    -- * Types+      Text++    -- * Creation and elimination+    , pack+    , unpack+    , singleton+    , empty++    -- * Basic interface+    , cons+    , snoc+    , append+    , uncons+    , unsnoc+    , head+    , last+    , tail+    , init+    , null+    , length+    , compareLength++    -- * Transformations+    , map+    , intercalate+    , intersperse+    , transpose+    , reverse+    , replace++    -- ** Case conversion+    -- $case+    , toCaseFold+    , toLower+    , toUpper+    , toTitle++    -- ** Justification+    , justifyLeft+    , justifyRight+    , center++    -- * Folds+    , foldl+    , foldl'+    , foldl1+    , foldl1'+    , foldr+    , foldr1++    -- ** Special folds+    , concat+    , concatMap+    , any+    , all+    , maximum+    , minimum++    -- * Construction++    -- ** Scans+    , scanl+    , scanl1+    , scanr+    , scanr1++    -- ** Accumulating maps+    , mapAccumL+    , mapAccumR++    -- ** Generation and unfolding+    , replicate+    , unfoldr+    , unfoldrN++    -- * Substrings++    -- ** Breaking strings+    , take+    , takeEnd+    , drop+    , dropEnd+    , takeWhile+    , takeWhileEnd+    , dropWhile+    , dropWhileEnd+    , dropAround+    , strip+    , stripStart+    , stripEnd+    , splitAt+    , breakOn+    , breakOnEnd+    , break+    , span+    , group+    , groupBy+    , inits+    , tails++    -- ** Breaking into many substrings+    -- $split+    , splitOn+    , split+    , chunksOf++    -- ** Breaking into lines and words+    , lines+    --, lines'+    , words+    , unlines+    , unwords++    -- * Predicates+    , isPrefixOf+    , isSuffixOf+    , isInfixOf++    -- ** View patterns+    , stripPrefix+    , stripSuffix+    , commonPrefixes++    -- * Searching+    , filter+    , breakOnAll+    , find+    , partition++    -- , findSubstring++    -- * Indexing+    -- $index+    , index+    , findIndex+    , count++    -- * Zipping+    , zip+    , zipWith++    -- -* Ordered text+    -- , sort++    -- * Low level operations+    , copy+    , unpackCString#+    ) where++import Prelude (Char, Bool(..), Int, Maybe(..), String,+                Eq(..), Ord(..), Ordering(..), (++),+                Read(..),+                (&&), (||), (+), (-), (.), ($), ($!), (>>),+                not, return, otherwise, quot)+import Control.DeepSeq (NFData(rnf))+#if defined(ASSERTS)+import Control.Exception (assert)+#endif+import Data.Char (isSpace)+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,+                  Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))+import Control.Monad (foldM)+import Control.Monad.ST (ST)+import qualified Data.Text.Array as A+import qualified Data.List as L+import Data.Binary (Binary(get, put))+import Data.Monoid (Monoid(..))+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup(..))+#endif+import Data.String (IsString(..))+import qualified Data.Text.Internal.Fusion as S+import qualified Data.Text.Internal.Fusion.Common as S+import Data.Text.Encoding (decodeUtf8', encodeUtf8)+import Data.Text.Internal.Fusion (stream, reverseStream, unstream)+import Data.Text.Internal.Private (span_)+import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)+import Data.Text.Show (singleton, unpack, unpackCString#)+import qualified Prelude as P+import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,+                         reverseIter_, unsafeHead, unsafeTail)+import Data.Text.Internal.Unsafe.Char (unsafeChr)+import qualified Data.Text.Internal.Functions as F+import qualified Data.Text.Internal.Encoding.Utf16 as U16+import Data.Text.Internal.Search (indices)+import Data.Text.Internal.Unsafe.Shift (UnsafeShift(..))+#if defined(__HADDOCK__)+import Data.ByteString (ByteString)+import qualified Data.Text.Lazy as L+import Data.Int (Int64)+#endif+import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)+#if MIN_VERSION_base(4,7,0)+import qualified GHC.Exts as Exts+#endif+import qualified Language.Haskell.TH.Lib as TH+import qualified Language.Haskell.TH.Syntax as TH+#if MIN_VERSION_base(4,7,0)+import Text.Printf (PrintfArg, formatArg, formatString)+#endif++-- $setup+-- >>> import Data.Text+-- >>> import qualified Data.Text as T+-- >>> :seti -XOverloadedStrings++-- $character_definition+--+-- This package uses the term /character/ to denote Unicode /code points/.+--+-- Note that this is not the same thing as a grapheme (e.g. a+-- composition of code points that form one visual symbol). For+-- instance, consider the grapheme \"&#x00e4;\". This symbol has two+-- Unicode representations: a single code-point representation+-- @U+00E4@ (the @LATIN SMALL LETTER A WITH DIAERESIS@ code point),+-- and a two code point representation @U+0061@ (the \"@A@\" code+-- point) and @U+0308@ (the @COMBINING DIAERESIS@ code point).++-- $strict+--+-- This package provides both strict and lazy 'Text' types.  The+-- strict type is provided by the "Data.Text" module, while the lazy+-- type is provided by the "Data.Text.Lazy" module. Internally, the+-- lazy @Text@ type consists of a list of strict chunks.+--+-- The strict 'Text' type requires that an entire string fit into+-- memory at once.  The lazy 'Data.Text.Lazy.Text' type is capable of+-- streaming strings that are larger than memory using a small memory+-- footprint.  In many cases, the overhead of chunked streaming makes+-- the lazy 'Data.Text.Lazy.Text' type slower than its strict+-- counterpart, but this is not always the case.  Sometimes, the time+-- complexity of a function in one module may be different from the+-- other, due to their differing internal structures.+--+-- Each module provides an almost identical API, with the main+-- difference being that the strict module uses 'Int' values for+-- lengths and counts, while the lazy module uses 'Data.Int.Int64'+-- lengths.++-- $replacement+--+-- A 'Text' value is a sequence of Unicode scalar values, as defined+-- in+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.+-- As such, a 'Text' cannot contain values in the range U+D800 to+-- U+DFFF inclusive. Haskell implementations admit all Unicode code+-- points+-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)+-- as 'Char' values, including code points from this invalid range.+-- This means that there are some 'Char' values that are not valid+-- Unicode scalar values, and the functions in this module must handle+-- those cases.+--+-- Within this module, many functions construct a 'Text' from one or+-- more 'Char' values. Those functions will substitute 'Char' values+-- that are not valid Unicode scalar values with the replacement+-- character \"&#xfffd;\" (U+FFFD).  Functions that perform this+-- inspection and replacement are documented with the phrase+-- \"Performs replacement on invalid scalar values\".+--+-- (One reason for this policy of replacement is that internally, a+-- 'Text' value is represented as packed UTF-16 data. Values in the+-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate+-- code points, and so cannot be represented. The functions replace+-- invalid scalar values, instead of dropping them, as a security+-- measure. For details, see+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)++-- $fusion+--+-- Most of the functions in this module are subject to /fusion/,+-- meaning that a pipeline of such functions will usually allocate at+-- most one 'Text' value.+--+-- As an example, consider the following pipeline:+--+-- > import Data.Text as T+-- > import Data.Text.Encoding as E+-- > import Data.ByteString (ByteString)+-- >+-- > countChars :: ByteString -> Int+-- > countChars = T.length . T.toUpper . E.decodeUtf8+--+-- From the type signatures involved, this looks like it should+-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'+-- values. However, when a module is compiled with optimisation+-- enabled under GHC, the two intermediate 'Text' values will be+-- optimised away, and the function will be compiled down to a single+-- loop over the source 'Data.ByteString.ByteString'.+--+-- Functions that can be fused by the compiler are documented with the+-- phrase \"Subject to fusion\".++instance Eq Text where+    Text arrA offA lenA == Text arrB offB lenB+        | lenA == lenB = A.equal arrA offA arrB offB lenA+        | otherwise    = False+    {-# INLINE (==) #-}++instance Ord Text where+    compare = compareText++instance Read Text where+    readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]++#if MIN_VERSION_base(4,9,0)+-- | Non-orphan 'Semigroup' instance only defined for+-- @base-4.9.0.0@ and later; orphan instances for older GHCs are+-- provided by+-- the [semigroups](http://hackage.haskell.org/package/semigroups)+-- package+--+-- @since 1.2.2.0+instance Semigroup Text where+    (<>) = append+#endif++instance Monoid Text where+    mempty  = empty+#if MIN_VERSION_base(4,9,0)+    mappend = (<>) -- future-proof definition+#else+    mappend = append+#endif+    mconcat = concat++instance IsString Text where+    fromString = pack++#if MIN_VERSION_base(4,7,0)+-- | @since 1.2.0.0+instance Exts.IsList Text where+    type Item Text = Char+    fromList       = pack+    toList         = unpack+#endif++instance NFData Text where rnf !_ = ()++-- | @since 1.2.1.0+instance Binary Text where+    put t = put (encodeUtf8 t)+    get   = do+      bs <- get+      case decodeUtf8' bs of+        P.Left exn -> P.fail (P.show exn)+        P.Right a -> P.return a++-- | This instance preserves data abstraction at the cost of inefficiency.+-- We omit reflection services for the sake of data abstraction.+--+-- This instance was created by copying the updated behavior of+-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you+-- feel a mistake has been made, please feel free to submit+-- improvements.+--+-- The original discussion is archived here:+-- <https://mail.haskell.org/pipermail/haskell-cafe/2010-January/072379.html could we get a Data instance for Data.Text.Text? >+--+-- The followup discussion that changed the behavior of 'Data.Set.Set'+-- and 'Data.Map.Map' is archived here:+-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >++instance Data Text where+  gfoldl f z txt = z pack `f` (unpack txt)+  toConstr _ = packConstr+  gunfold k z c = case constrIndex c of+    1 -> k (z pack)+    _ -> P.error "gunfold"+  dataTypeOf _ = textDataType++-- | This instance has similar considerations to the 'Data' instance:+-- it preserves abstraction at the cost of inefficiency.+--+-- @since 1.2.4.0+instance TH.Lift Text where+  lift = TH.appE (TH.varE 'pack) . TH.stringE . unpack+#if MIN_VERSION_template_haskell(2,17,0)+  liftTyped = TH.unsafeCodeCoerce . TH.lift+#elif MIN_VERSION_template_haskell(2,16,0)+  liftTyped = TH.unsafeTExpCoerce . TH.lift+#endif++#if MIN_VERSION_base(4,7,0)+-- | Only defined for @base-4.7.0.0@ and later+--+-- @since 1.2.2.0+instance PrintfArg Text where+  formatArg txt = formatString $ unpack txt+#endif++packConstr :: Constr+packConstr = mkConstr textDataType "pack" [] Prefix++textDataType :: DataType+textDataType = mkDataType "Data.Text.Text" [packConstr]++-- | /O(n)/ Compare two 'Text' values lexicographically.+compareText :: Text -> Text -> Ordering+compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)+    | lenA == 0 && lenB == 0 = EQ+    | otherwise              = go 0 0+  where+    go !i !j+        | i >= lenA || j >= lenB = compare lenA lenB+        | a < b                  = LT+        | a > b                  = GT+        | otherwise              = go (i+di) (j+dj)+      where Iter a di = iter ta i+            Iter b dj = iter tb j++-- -----------------------------------------------------------------------------+-- * Conversion to/from 'Text'++-- | /O(n)/ Convert a 'String' into a 'Text'.  Subject to+-- fusion.  Performs replacement on invalid scalar values.+pack :: String -> Text+pack = unstream . S.map safe . S.streamList+{-# INLINE [1] pack #-}++-- -----------------------------------------------------------------------------+-- * Basic functions++-- | /O(n)/ Adds a character to the front of a 'Text'.  This function+-- is more costly than its 'List' counterpart because it requires+-- copying a new array.  Subject to fusion.  Performs replacement on+-- invalid scalar values.+cons :: Char -> Text -> Text+cons c t = unstream (S.cons (safe c) (stream t))+{-# INLINE cons #-}++infixr 5 `cons`++-- | /O(n)/ Adds a character to the end of a 'Text'.  This copies the+-- entire array in the process, unless fused.  Subject to fusion.+-- Performs replacement on invalid scalar values.+snoc :: Text -> Char -> Text+snoc t c = unstream (S.snoc (stream t) (safe c))+{-# INLINE snoc #-}++-- | /O(n)/ Appends one 'Text' to the other by copying both of them+-- into a new 'Text'.  Subject to fusion.+append :: Text -> Text -> Text+append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)+    | len1 == 0 = b+    | len2 == 0 = a+    | len > 0   = Text (A.run x) 0 len+    | otherwise = overflowError "append"+    where+      len = len1+len2+      x :: ST s (A.MArray s)+      x = do+        arr <- A.new len+        A.copyI arr 0 arr1 off1 len1+        A.copyI arr len1 arr2 off2 len+        return arr+{-# NOINLINE append #-}++{-# RULES+"TEXT append -> fused" [~1] forall t1 t2.+    append t1 t2 = unstream (S.append (stream t1) (stream t2))+"TEXT append -> unfused" [1] forall t1 t2.+    unstream (S.append (stream t1) (stream t2)) = append t1 t2+ #-}++-- | /O(1)/ Returns the first character of a 'Text', which must be+-- non-empty.  Subject to fusion.+head :: Text -> Char+head t = S.head (stream t)+{-# INLINE head #-}++-- | /O(1)/ Returns the first character and rest of a 'Text', or+-- 'Nothing' if empty. Subject to fusion.+uncons :: Text -> Maybe (Char, Text)+uncons t@(Text arr off len)+    | len <= 0  = Nothing+    | otherwise = Just $ let !(Iter c d) = iter t 0+                         in (c, text arr (off+d) (len-d))+{-# INLINE [1] uncons #-}++-- | Lifted from Control.Arrow and specialized.+second :: (b -> c) -> (a,b) -> (a,c)+second f (a, b) = (a, f b)++-- | /O(1)/ Returns the last character of a 'Text', which must be+-- non-empty.  Subject to fusion.+last :: Text -> Char+last (Text arr off len)+    | len <= 0                 = emptyError "last"+    | n < 0xDC00 || n > 0xDFFF = unsafeChr n+    | otherwise                = U16.chr2 n0 n+    where n  = A.unsafeIndex arr (off+len-1)+          n0 = A.unsafeIndex arr (off+len-2)+{-# INLINE [1] last #-}++{-# RULES+"TEXT last -> fused" [~1] forall t.+    last t = S.last (stream t)+"TEXT last -> unfused" [1] forall t.+    S.last (stream t) = last t+  #-}++-- | /O(1)/ Returns all characters after the head of a 'Text', which+-- must be non-empty.  Subject to fusion.+tail :: Text -> Text+tail t@(Text arr off len)+    | len <= 0  = emptyError "tail"+    | otherwise = text arr (off+d) (len-d)+    where d = iter_ t 0+{-# INLINE [1] tail #-}++{-# RULES+"TEXT tail -> fused" [~1] forall t.+    tail t = unstream (S.tail (stream t))+"TEXT tail -> unfused" [1] forall t.+    unstream (S.tail (stream t)) = tail t+ #-}++-- | /O(1)/ Returns all but the last character of a 'Text', which must+-- be non-empty.  Subject to fusion.+init :: Text -> Text+init (Text arr off len) | len <= 0                   = emptyError "init"+                        | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)+                        | otherwise                  = text arr off (len-1)+    where+      n = A.unsafeIndex arr (off+len-1)+{-# INLINE [1] init #-}++{-# RULES+"TEXT init -> fused" [~1] forall t.+    init t = unstream (S.init (stream t))+"TEXT init -> unfused" [1] forall t.+    unstream (S.init (stream t)) = init t+ #-}++-- | /O(1)/ Returns all but the last character and the last character of a+-- 'Text', or 'Nothing' if empty.+--+-- @since 1.2.3.0+unsnoc :: Text -> Maybe (Text, Char)+unsnoc (Text arr off len)+    | len <= 0                 = Nothing+    | n < 0xDC00 || n > 0xDFFF = Just (text arr off (len-1), unsafeChr n)+    | otherwise                = Just (text arr off (len-2), U16.chr2 n0 n)+    where n  = A.unsafeIndex arr (off+len-1)+          n0 = A.unsafeIndex arr (off+len-2)+{-# INLINE [1] unsnoc #-}++-- | /O(1)/ Tests whether a 'Text' is empty or not.  Subject to+-- fusion.+null :: Text -> Bool+null (Text _arr _off len) =+#if defined(ASSERTS)+    assert (len >= 0) $+#endif+    len <= 0+{-# INLINE [1] null #-}++{-# RULES+"TEXT null -> fused" [~1] forall t.+    null t = S.null (stream t)+"TEXT null -> unfused" [1] forall t.+    S.null (stream t) = null t+ #-}++-- | /O(1)/ Tests whether a 'Text' contains exactly one character.+-- Subject to fusion.+isSingleton :: Text -> Bool+isSingleton = S.isSingleton . stream+{-# INLINE isSingleton #-}++-- | /O(n)/ Returns the number of characters in a 'Text'.+-- Subject to fusion.+length :: Text -> Int+length t = S.length (stream t)+{-# INLINE [1] length #-}+-- length needs to be phased after the compareN/length rules otherwise+-- it may inline before the rules have an opportunity to fire.++-- | /O(n)/ Compare the count of characters in a 'Text' to a number.+-- Subject to fusion.+--+-- This function gives the same answer as comparing against the result+-- of 'length', but can short circuit if the count of characters is+-- greater than the number, and hence be more efficient.+compareLength :: Text -> Int -> Ordering+compareLength t n = S.compareLengthI (stream t) n+{-# INLINE [1] compareLength #-}++{-# RULES+"TEXT compareN/length -> compareLength" [~1] forall t n.+    compare (length t) n = compareLength t n+  #-}++{-# RULES+"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.+    eqInt (length t) n = compareLength t n == EQ+  #-}++{-# RULES+"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.+    neInt (length t) n = compareLength t n /= EQ+  #-}++{-# RULES+"TEXT <N/length -> compareLength/==LT" [~1] forall t n.+    ltInt (length t) n = compareLength t n == LT+  #-}++{-# RULES+"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.+    leInt (length t) n = compareLength t n /= GT+  #-}++{-# RULES+"TEXT >N/length -> compareLength/==GT" [~1] forall t n.+    gtInt (length t) n = compareLength t n == GT+  #-}++{-# RULES+"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.+    geInt (length t) n = compareLength t n /= LT+  #-}++-- -----------------------------------------------------------------------------+-- * Transformations+-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to+-- each element of @t@.+--+-- Example:+--+-- >>> let message = pack "I am not angry. Not at all."+-- >>> T.map (\c -> if c == '.' then '!' else c) message+-- "I am not angry! Not at all!"+--+-- Subject to fusion.  Performs replacement on invalid scalar values.+map :: (Char -> Char) -> Text -> Text+map f t = unstream (S.map (safe . f) (stream t))+{-# INLINE [1] map #-}++-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of+-- 'Text's and concatenates the list after interspersing the first+-- argument between each element of the list.+--+-- Example:+--+-- >>> T.intercalate "NI!" ["We", "seek", "the", "Holy", "Grail"]+-- "WeNI!seekNI!theNI!HolyNI!Grail"+intercalate :: Text -> [Text] -> Text+intercalate t = concat . (F.intersperse t)+{-# INLINE intercalate #-}++-- | /O(n)/ The 'intersperse' function takes a character and places it+-- between the characters of a 'Text'.+--+-- Example:+--+-- >>> T.intersperse '.' "SHIELD"+-- "S.H.I.E.L.D"+--+-- Subject to fusion.  Performs replacement on invalid scalar values.+intersperse     :: Char -> Text -> Text+intersperse c t = unstream (S.intersperse (safe c) (stream t))+{-# INLINE intersperse #-}++-- | /O(n)/ Reverse the characters of a string.+--+-- Example:+--+-- >>> T.reverse "desrever"+-- "reversed"+--+-- Subject to fusion (fuses with its argument).+reverse :: Text -> Text+reverse t = S.reverse (stream t)+{-# INLINE reverse #-}++-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in+-- @haystack@ with @replacement@.+--+-- This function behaves as though it was defined as follows:+--+-- @+-- replace needle replacement haystack =+--   'intercalate' replacement ('splitOn' needle haystack)+-- @+--+-- As this suggests, each occurrence is replaced exactly once.  So if+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself+-- be replaced recursively:+--+-- >>> replace "oo" "foo" "oo"+-- "foo"+--+-- In cases where several instances of @needle@ overlap, only the+-- first one will be replaced:+--+-- >>> replace "ofo" "bar" "ofofo"+-- "barfo"+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+replace :: Text+        -- ^ @needle@ to search for.  If this string is empty, an+        -- error will occur.+        -> Text+        -- ^ @replacement@ to replace @needle@ with.+        -> Text+        -- ^ @haystack@ in which to search.+        -> Text+replace needle@(Text _      _      neeLen)+               (Text repArr repOff repLen)+      haystack@(Text hayArr hayOff hayLen)+  | neeLen == 0 = emptyError "replace"+  | L.null ixs  = haystack+  | len > 0     = Text (A.run x) 0 len+  | otherwise   = empty+  where+    ixs = indices needle haystack+    len = hayLen - (neeLen - repLen) `mul` L.length ixs+    x :: ST s (A.MArray s)+    x = do+      marr <- A.new len+      let loop (i:is) o d = do+            let d0 = d + i - o+                d1 = d0 + repLen+            A.copyI marr d  hayArr (hayOff+o) d0+            A.copyI marr d0 repArr repOff d1+            loop is (i + neeLen) d1+          loop []     o d = A.copyI marr d hayArr (hayOff+o) len+      loop ixs 0 0+      return marr++-- ----------------------------------------------------------------------------+-- ** Case conversions (folds)++-- $case+--+-- When case converting 'Text' values, do not use combinators like+-- @map toUpper@ to case convert each character of a string+-- individually, as this gives incorrect results according to the+-- rules of some writing systems.  The whole-string case conversion+-- functions from this module, such as @toUpper@, obey the correct+-- case conversion rules.  As a result, these functions may map one+-- input character to two or three output characters. For examples,+-- see the documentation of each function.+--+-- /Note/: In some languages, case conversion is a locale- and+-- context-dependent operation. The case conversion functions in this+-- module are /not/ locale sensitive. Programs that require locale+-- sensitivity should use appropriate versions of the+-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.++-- | /O(n)/ Convert a string to folded case.  Subject to fusion.+--+-- This function is mainly useful for performing caseless (also known+-- as case insensitive) string comparisons.+--+-- A string @x@ is a caseless match for a string @y@ if and only if:+--+-- @toCaseFold x == toCaseFold y@+--+-- The result string may be longer than the input string, and may+-- differ from applying 'toLower' to the input string.  For instance,+-- the Armenian small ligature \"&#xfb13;\" (men now, U+FB13) is case+-- folded to the sequence \"&#x574;\" (men, U+0574) followed by+-- \"&#x576;\" (now, U+0576), while the Greek \"&#xb5;\" (micro sign,+-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)+-- instead of itself.+toCaseFold :: Text -> Text+toCaseFold t = unstream (S.toCaseFold (stream t))+{-# INLINE toCaseFold #-}++-- | /O(n)/ Convert a string to lower case, using simple case+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, \"&#x130;\" (Latin capital letter I with dot above,+-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)+-- followed by \" &#x307;\" (combining dot above, U+0307).+toLower :: Text -> Text+toLower t = unstream (S.toLower (stream t))+{-# INLINE toLower #-}++-- | /O(n)/ Convert a string to upper case, using simple case+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the+-- two-letter sequence \"SS\".+toUpper :: Text -> Text+toUpper t = unstream (S.toUpper (stream t))+{-# INLINE toUpper #-}++-- | /O(n)/ Convert a string to title case, using simple case+-- conversion. Subject to fusion.+--+-- The first letter of the input is converted to title case, as is+-- every subsequent letter that immediately follows a non-letter.+-- Every letter that immediately follows another letter is converted+-- to lower case.+--+-- The result string may be longer than the input string. For example,+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the+-- sequence Latin capital letter F (U+0046) followed by Latin small+-- letter l (U+006C).+--+-- /Note/: this function does not take language or culture specific+-- rules into account. For instance, in English, different style+-- guides disagree on whether the book name \"The Hill of the Red+-- Fox\" is correctly title cased&#x2014;but this function will+-- capitalize /every/ word.+--+-- @since 1.0.0.0+toTitle :: Text -> Text+toTitle t = unstream (S.toTitle (stream t))+{-# INLINE toTitle #-}++-- | /O(n)/ Left-justify a string to the given length, using the+-- specified fill character on the right. Subject to fusion.+-- Performs replacement on invalid scalar values.+--+-- Examples:+--+-- >>> justifyLeft 7 'x' "foo"+-- "fooxxxx"+--+-- >>> justifyLeft 3 'x' "foobar"+-- "foobar"+justifyLeft :: Int -> Char -> Text -> Text+justifyLeft k c t+    | len >= k  = t+    | otherwise = t `append` replicateChar (k-len) c+  where len = length t+{-# INLINE [1] justifyLeft #-}++{-# RULES+"TEXT justifyLeft -> fused" [~1] forall k c t.+    justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))+"TEXT justifyLeft -> unfused" [1] forall k c t.+    unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t+  #-}++-- | /O(n)/ Right-justify a string to the given length, using the+-- specified fill character on the left.  Performs replacement on+-- invalid scalar values.+--+-- Examples:+--+-- >>> justifyRight 7 'x' "bar"+-- "xxxxbar"+--+-- >>> justifyRight 3 'x' "foobar"+-- "foobar"+justifyRight :: Int -> Char -> Text -> Text+justifyRight k c t+    | len >= k  = t+    | otherwise = replicateChar (k-len) c `append` t+  where len = length t+{-# INLINE justifyRight #-}++-- | /O(n)/ Center a string to the given length, using the specified+-- fill character on either side.  Performs replacement on invalid+-- scalar values.+--+-- Examples:+--+-- >>> center 8 'x' "HS"+-- "xxxHSxxx"+center :: Int -> Char -> Text -> Text+center k c t+    | len >= k  = t+    | otherwise = replicateChar l c `append` t `append` replicateChar r c+  where len = length t+        d   = k - len+        r   = d `quot` 2+        l   = d - r+{-# INLINE center #-}++-- | /O(n)/ The 'transpose' function transposes the rows and columns+-- of its 'Text' argument.  Note that this function uses 'pack',+-- 'unpack', and the list version of transpose, and is thus not very+-- efficient.+--+-- Examples:+--+-- >>> transpose ["green","orange"]+-- ["go","rr","ea","en","ng","e"]+--+-- >>> transpose ["blue","red"]+-- ["br","le","ud","e"]+transpose :: [Text] -> [Text]+transpose ts = P.map pack (L.transpose (P.map unpack ts))++-- -----------------------------------------------------------------------------+-- * Reducing 'Text's (folds)++-- | /O(n)/ 'foldl', applied to a binary operator, a starting value+-- (typically the left-identity of the operator), and a 'Text',+-- reduces the 'Text' using the binary operator, from left to right.+-- Subject to fusion.+foldl :: (a -> Char -> a) -> a -> Text -> a+foldl f z t = S.foldl f z (stream t)+{-# INLINE foldl #-}++-- | /O(n)/ A strict version of 'foldl'.  Subject to fusion.+foldl' :: (a -> Char -> a) -> a -> Text -> a+foldl' f z t = S.foldl' f z (stream t)+{-# INLINE foldl' #-}++-- | /O(n)/ A variant of 'foldl' that has no starting value argument,+-- and thus must be applied to a non-empty 'Text'.  Subject to fusion.+foldl1 :: (Char -> Char -> Char) -> Text -> Char+foldl1 f t = S.foldl1 f (stream t)+{-# INLINE foldl1 #-}++-- | /O(n)/ A strict version of 'foldl1'.  Subject to fusion.+foldl1' :: (Char -> Char -> Char) -> Text -> Char+foldl1' f t = S.foldl1' f (stream t)+{-# INLINE foldl1' #-}++-- | /O(n)/ 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a 'Text',+-- reduces the 'Text' using the binary operator, from right to left.+-- Subject to fusion.+foldr :: (Char -> a -> a) -> a -> Text -> a+foldr f z t = S.foldr f z (stream t)+{-# INLINE foldr #-}++-- | /O(n)/ A variant of 'foldr' that has no starting value argument,+-- and thus must be applied to a non-empty 'Text'.  Subject to+-- fusion.+foldr1 :: (Char -> Char -> Char) -> Text -> Char+foldr1 f t = S.foldr1 f (stream t)+{-# INLINE foldr1 #-}++-- -----------------------------------------------------------------------------+-- ** Special folds++-- | /O(n)/ Concatenate a list of 'Text's.+concat :: [Text] -> Text+concat ts = case ts' of+              [] -> empty+              [t] -> t+              _ -> Text (A.run go) 0 len+  where+    ts' = L.filter (not . null) ts+    len = sumP "concat" $ L.map lengthWord16 ts'+    go :: ST s (A.MArray s)+    go = do+      arr <- A.new len+      let step i (Text a o l) =+            let !j = i + l in A.copyI arr i a o j >> return j+      foldM step 0 ts' >> return arr++-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and+-- concatenate the results.+concatMap :: (Char -> Text) -> Text -> Text+concatMap f = concat . foldr ((:) . f) []+{-# INLINE concatMap #-}++-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.+any :: (Char -> Bool) -> Text -> Bool+any p t = S.any p (stream t)+{-# INLINE any #-}++-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.+all :: (Char -> Bool) -> Text -> Bool+all p t = S.all p (stream t)+{-# INLINE all #-}++-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which+-- must be non-empty. Subject to fusion.+maximum :: Text -> Char+maximum t = S.maximum (stream t)+{-# INLINE maximum #-}++-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which+-- must be non-empty. Subject to fusion.+minimum :: Text -> Char+minimum t = S.minimum (stream t)+{-# INLINE minimum #-}++-- -----------------------------------------------------------------------------+-- * Building 'Text's++-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of+-- successive reduced values from the left. Subject to fusion.+-- Performs replacement on invalid scalar values.+--+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+--+-- Note that+--+-- > last (scanl f z xs) == foldl f z xs.+scanl :: (Char -> Char -> Char) -> Char -> Text -> Text+scanl f z t = unstream (S.scanl g z (stream t))+    where g a b = safe (f a b)+{-# INLINE scanl #-}++-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting+-- value argument. Performs replacement on invalid scalar values.+--+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+scanl1 :: (Char -> Char -> Char) -> Text -> Text+scanl1 f t | null t    = empty+           | otherwise = scanl f (unsafeHead t) (unsafeTail t)+{-# INLINE scanl1 #-}++-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.  Performs+-- replacement on invalid scalar values.+--+-- > scanr f v == reverse . scanl (flip f) v . reverse+scanr :: (Char -> Char -> Char) -> Char -> Text -> Text+scanr f z = S.reverse . S.reverseScanr g z . reverseStream+    where g a b = safe (f a b)+{-# INLINE scanr #-}++-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting+-- value argument. Performs replacement on invalid scalar values.+scanr1 :: (Char -> Char -> Char) -> Text -> Text+scanr1 f t | null t    = empty+           | otherwise = scanr f (last t) (init t)+{-# INLINE scanr1 #-}++-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a+-- function to each element of a 'Text', passing an accumulating+-- parameter from left to right, and returns a final 'Text'.  Performs+-- replacement on invalid scalar values.+mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)+mapAccumL f z0 = S.mapAccumL g z0 . stream+    where g a b = second safe (f a b)+{-# INLINE mapAccumL #-}++-- | The 'mapAccumR' function behaves like a combination of 'map' and+-- a strict 'foldr'; it applies a function to each element of a+-- 'Text', passing an accumulating parameter from right to left, and+-- returning a final value of this accumulator together with the new+-- 'Text'.+-- Performs replacement on invalid scalar values.+mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)+mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream+    where g a b = second safe (f a b)+{-# INLINE mapAccumR #-}++-- -----------------------------------------------------------------------------+-- ** Generating and unfolding 'Text's++-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input+-- @t@ repeated @n@ times.+replicate :: Int -> Text -> Text+replicate n t@(Text a o l)+    | n <= 0 || l <= 0       = empty+    | n == 1                 = t+    | isSingleton t          = replicateChar n (unsafeHead t)+    | otherwise              = Text (A.run x) 0 len+  where+    len = l `mul` n -- TODO: detect overflows+    x :: ST s (A.MArray s)+    x = do+      arr <- A.new len+      A.copyI arr 0 a o l+      let loop !l1 =+            let rest = len - l1 in+            if rest <= l1 then A.copyM arr l1 arr 0 rest >> return arr+            else A.copyM arr l1 arr 0 l1 >> loop (l1 `shiftL` 1)+      loop l+{-# INLINE [1] replicate #-}+++{-# RULES+"TEXT replicate/singleton -> replicateChar" [~1] forall n c.+    replicate n (singleton c) = replicateChar n c+  #-}++-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the+-- value of every element. Subject to fusion.+replicateChar :: Int -> Char -> Text+replicateChar n c = unstream (S.replicateCharI n (safe c))+{-# INLINE replicateChar #-}++-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'+-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a+-- 'Text' from a seed value. The function takes the element and+-- returns 'Nothing' if it is done producing the 'Text', otherwise+-- 'Just' @(a,b)@.  In this case, @a@ is the next 'Char' in the+-- string, and @b@ is the seed value for further production. Subject+-- to fusion.  Performs replacement on invalid scalar values.+unfoldr     :: (a -> Maybe (Char,a)) -> a -> Text+unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)+{-# INLINE unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed+-- value. However, the length of the result should be limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the maximum length of the result is known and+-- correct, otherwise its performance is similar to 'unfoldr'. Subject+-- to fusion.  Performs replacement on invalid scalar values.+unfoldrN     :: Int -> (a -> Maybe (Char,a)) -> a -> Text+unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)+{-# INLINE unfoldrN #-}++-- -----------------------------------------------------------------------------+-- * Substrings++-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the+-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than+-- the length of the Text. Subject to fusion.+take :: Int -> Text -> Text+take n t@(Text arr off len)+    | n <= 0    = empty+    | n >= len  = t+    | otherwise = text arr off (iterN n t)+{-# INLINE [1] take #-}++iterN :: Int -> Text -> Int+iterN n t@(Text _arr _off len) = loop 0 0+  where loop !i !cnt+            | i >= len || cnt >= n = i+            | otherwise            = loop (i+d) (cnt+1)+          where d = iter_ t i++{-# RULES+"TEXT take -> fused" [~1] forall n t.+    take n t = unstream (S.take n (stream t))+"TEXT take -> unfused" [1] forall n t.+    unstream (S.take n (stream t)) = take n t+  #-}++-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after+-- taking @n@ characters from the end of @t@.+--+-- Examples:+--+-- >>> takeEnd 3 "foobar"+-- "bar"+--+-- @since 1.1.1.0+takeEnd :: Int -> Text -> Text+takeEnd n t@(Text arr off len)+    | n <= 0    = empty+    | n >= len  = t+    | otherwise = text arr (off+i) (len-i)+  where i = iterNEnd n t++iterNEnd :: Int -> Text -> Int+iterNEnd n t@(Text _arr _off len) = loop (len-1) n+  where loop i !m+          | m <= 0    = i+1+          | i <= 0    = 0+          | otherwise = loop (i+d) (m-1)+          where d = reverseIter_ t i++-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the+-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@+-- is greater than the length of the 'Text'. Subject to fusion.+drop :: Int -> Text -> Text+drop n t@(Text arr off len)+    | n <= 0    = t+    | n >= len  = empty+    | otherwise = text arr (off+i) (len-i)+  where i = iterN n t+{-# INLINE [1] drop #-}++{-# RULES+"TEXT drop -> fused" [~1] forall n t.+    drop n t = unstream (S.drop n (stream t))+"TEXT drop -> unfused" [1] forall n t.+    unstream (S.drop n (stream t)) = drop n t+"TEXT take . drop -> unfused" [1] forall len off t.+    unstream (S.take len (S.drop off (stream t))) = take len (drop off t)+  #-}++-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after+-- dropping @n@ characters from the end of @t@.+--+-- Examples:+--+-- >>> dropEnd 3 "foobar"+-- "foo"+--+-- @since 1.1.1.0+dropEnd :: Int -> Text -> Text+dropEnd n t@(Text arr off len)+    | n <= 0    = t+    | n >= len  = empty+    | otherwise = text arr off (iterNEnd n t)++-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',+-- returns the longest prefix (possibly empty) of elements that+-- satisfy @p@.  Subject to fusion.+takeWhile :: (Char -> Bool) -> Text -> Text+takeWhile p t@(Text arr off len) = loop 0+  where loop !i | i >= len    = t+                | p c         = loop (i+d)+                | otherwise   = text arr off i+            where Iter c d    = iter t i+{-# INLINE [1] takeWhile #-}++{-# RULES+"TEXT takeWhile -> fused" [~1] forall p t.+    takeWhile p t = unstream (S.takeWhile p (stream t))+"TEXT takeWhile -> unfused" [1] forall p t.+    unstream (S.takeWhile p (stream t)) = takeWhile p t+  #-}++-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',+-- returns the longest suffix (possibly empty) of elements that+-- satisfy @p@.+-- Examples:+--+-- >>> takeWhileEnd (=='o') "foo"+-- "oo"+--+-- @since 1.2.2.0+takeWhileEnd :: (Char -> Bool) -> Text -> Text+takeWhileEnd p t@(Text arr off len) = loop (len-1) len+  where loop !i !l | l <= 0    = t+                   | p c       = loop (i+d) (l+d)+                   | otherwise = text arr (off+l) (len-l)+            where (c,d)        = reverseIter t i+{-# INLINE [1] takeWhileEnd #-}++-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after+-- 'takeWhile' @p@ @t@. Subject to fusion.+dropWhile :: (Char -> Bool) -> Text -> Text+dropWhile p t@(Text arr off len) = loop 0 0+  where loop !i !l | l >= len  = empty+                   | p c       = loop (i+d) (l+d)+                   | otherwise = Text arr (off+i) (len-l)+            where Iter c d     = iter t i+{-# INLINE [1] dropWhile #-}++{-# RULES+"TEXT dropWhile -> fused" [~1] forall p t.+    dropWhile p t = unstream (S.dropWhile p (stream t))+"TEXT dropWhile -> unfused" [1] forall p t.+    unstream (S.dropWhile p (stream t)) = dropWhile p t+  #-}++-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after+-- dropping characters that satisfy the predicate @p@ from the end of+-- @t@.+--+-- Examples:+--+-- >>> dropWhileEnd (=='.') "foo..."+-- "foo"+dropWhileEnd :: (Char -> Bool) -> Text -> Text+dropWhileEnd p t@(Text arr off len) = loop (len-1) len+  where loop !i !l | l <= 0    = empty+                   | p c       = loop (i+d) (l+d)+                   | otherwise = Text arr off l+            where (c,d)        = reverseIter t i+{-# INLINE [1] dropWhileEnd #-}++-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after+-- dropping characters that satisfy the predicate @p@ from both the+-- beginning and end of @t@.  Subject to fusion.+dropAround :: (Char -> Bool) -> Text -> Text+dropAround p = dropWhile p . dropWhileEnd p+{-# INLINE [1] dropAround #-}++-- | /O(n)/ Remove leading white space from a string.  Equivalent to:+--+-- > dropWhile isSpace+stripStart :: Text -> Text+stripStart = dropWhile isSpace+{-# INLINE stripStart #-}++-- | /O(n)/ Remove trailing white space from a string.  Equivalent to:+--+-- > dropWhileEnd isSpace+stripEnd :: Text -> Text+stripEnd = dropWhileEnd isSpace+{-# INLINE [1] stripEnd #-}++-- | /O(n)/ Remove leading and trailing white space from a string.+-- Equivalent to:+--+-- > dropAround isSpace+strip :: Text -> Text+strip = dropAround isSpace+{-# INLINE [1] strip #-}++-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a+-- prefix of @t@ of length @n@, and whose second is the remainder of+-- the string. It is equivalent to @('take' n t, 'drop' n t)@.+splitAt :: Int -> Text -> (Text, Text)+splitAt n t@(Text arr off len)+    | n <= 0    = (empty, t)+    | n >= len  = (t, empty)+    | otherwise = let k = iterN n t+                  in (text arr off k, text arr (off+k) (len-k))++-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns+-- a pair whose first element is the longest prefix (possibly empty)+-- of @t@ of elements that satisfy @p@, and whose second is the+-- remainder of the list.+--+-- >>> T.span (=='0') "000AB"+-- ("000","AB")+span :: (Char -> Bool) -> Text -> (Text, Text)+span p t = case span_ p t of+             (# hd,tl #) -> (hd,tl)+{-# INLINE span #-}++-- | /O(n)/ 'break' is like 'span', but the prefix returned is+-- over elements that fail the predicate @p@.+--+-- >>> T.break (=='c') "180cm"+-- ("180","cm")+break :: (Char -> Bool) -> Text -> (Text, Text)+break p = span (not . p)+{-# INLINE break #-}++-- | /O(n)/ Group characters in a string according to a predicate.+groupBy :: (Char -> Char -> Bool) -> Text -> [Text]+groupBy p = loop+  where+    loop t@(Text arr off len)+        | null t    = []+        | otherwise = text arr off n : loop (text arr (off+n) (len-n))+        where Iter c d = iter t 0+              n     = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))++-- | Returns the /array/ index (in units of 'Word16') at which a+-- character may be found.  This is /not/ the same as the logical+-- index returned by e.g. 'findIndex'.+findAIndexOrEnd :: (Char -> Bool) -> Text -> Int+findAIndexOrEnd q t@(Text _arr _off len) = go 0+    where go !i | i >= len || q c       = i+                | otherwise             = go (i+d)+                where Iter c d          = iter t i++-- | /O(n)/ Group characters in a string by equality.+group :: Text -> [Text]+group = groupBy (==)++-- | /O(n)/ Return all initial segments of the given 'Text', shortest+-- first.+inits :: Text -> [Text]+inits t@(Text arr off len) = loop 0+    where loop i | i >= len = [t]+                 | otherwise = Text arr off i : loop (i + iter_ t i)++-- | /O(n)/ Return all final segments of the given 'Text', longest+-- first.+tails :: Text -> [Text]+tails t | null t    = [empty]+        | otherwise = t : tails (unsafeTail t)++-- $split+--+-- Splitting functions in this library do not perform character-wise+-- copies to create substrings; they just construct new 'Text's that+-- are slices of the original.++-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'+-- argument (which cannot be empty), consuming the delimiter. An empty+-- delimiter is invalid, and will cause an error to be raised.+--+-- Examples:+--+-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"+-- ["a","b","d","e"]+--+-- >>> splitOn "aaa"  "aaaXaaaXaaaXaaa"+-- ["","X","X","X",""]+--+-- >>> splitOn "x"    "x"+-- ["",""]+--+-- and+--+-- > intercalate s . splitOn s         == id+-- > splitOn (singleton c)             == split (==c)+--+-- (Note: the string @s@ to split on above cannot be empty.)+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+splitOn :: Text+        -- ^ String to split on. If this string is empty, an error+        -- will occur.+        -> Text+        -- ^ Input text.+        -> [Text]+splitOn pat@(Text _ _ l) src@(Text arr off len)+    | l <= 0          = emptyError "splitOn"+    | isSingleton pat = split (== unsafeHead pat) src+    | otherwise       = go 0 (indices pat src)+  where+    go !s (x:xs) =  text arr (s+off) (x-s) : go (x+l) xs+    go  s _      = [text arr (s+off) (len-s)]+{-# INLINE [1] splitOn #-}++{-# RULES+"TEXT splitOn/singleton -> split/==" [~1] forall c t.+    splitOn (singleton c) t = split (==c) t+  #-}++-- | /O(n)/ Splits a 'Text' into components delimited by separators,+-- where the predicate returns True for a separator element.  The+-- resulting components do not contain the separators.  Two adjacent+-- separators result in an empty component in the output.  eg.+--+-- >>> split (=='a') "aabbaca"+-- ["","","bb","c",""]+--+-- >>> split (=='a') ""+-- [""]+split :: (Char -> Bool) -> Text -> [Text]+split _ t@(Text _off _arr 0) = [t]+split p t = loop t+    where loop s | null s'   = [l]+                 | otherwise = l : loop (unsafeTail s')+              where (# l, s' #) = span_ (not . p) s+{-# INLINE split #-}++-- | /O(n)/ Splits a 'Text' into components of length @k@.  The last+-- element may be shorter than the other chunks, depending on the+-- length of the input. Examples:+--+-- >>> chunksOf 3 "foobarbaz"+-- ["foo","bar","baz"]+--+-- >>> chunksOf 4 "haskell.org"+-- ["hask","ell.","org"]+chunksOf :: Int -> Text -> [Text]+chunksOf k = go+  where+    go t = case splitAt k t of+             (a,b) | null a    -> []+                   | otherwise -> a : go b+{-# INLINE chunksOf #-}++-- ----------------------------------------------------------------------------+-- * Searching++-------------------------------------------------------------------------------+-- ** Searching with a predicate++-- | /O(n)/ The 'find' function takes a predicate and a 'Text', and+-- returns the first element matching the predicate, or 'Nothing' if+-- there is no such element. Subject to fusion.+find :: (Char -> Bool) -> Text -> Maybe Char+find p t = S.findBy p (stream t)+{-# INLINE find #-}++-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',+-- and returns the pair of 'Text's with elements which do and do not+-- satisfy the predicate, respectively; i.e.+--+-- > partition p t == (filter p t, filter (not . p) t)+partition :: (Char -> Bool) -> Text -> (Text, Text)+partition p t = (filter p t, filter (not . p) t)+{-# INLINE partition #-}++-- | /O(n)/ 'filter', applied to a predicate and a 'Text',+-- returns a 'Text' containing those characters that satisfy the+-- predicate.+filter :: (Char -> Bool) -> Text -> Text+filter p t = unstream (S.filter p (stream t))+{-# INLINE filter #-}++-- | /O(n+m)/ Find the first instance of @needle@ (which must be+-- non-'null') in @haystack@.  The first element of the returned tuple+-- is the prefix of @haystack@ before @needle@ is matched.  The second+-- is the remainder of @haystack@, starting with the match.+--+-- Examples:+--+-- >>> breakOn "::" "a::b::c"+-- ("a","::b::c")+--+-- >>> breakOn "/" "foobar"+-- ("foobar","")+--+-- Laws:+--+-- > append prefix match == haystack+-- >   where (prefix, match) = breakOn needle haystack+--+-- If you need to break a string by a substring repeatedly (e.g. you+-- want to break on every instance of a substring), use 'breakOnAll'+-- instead, as it has lower startup overhead.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+breakOn :: Text -> Text -> (Text, Text)+breakOn pat src@(Text arr off len)+    | null pat  = emptyError "breakOn"+    | otherwise = case indices pat src of+                    []    -> (src, empty)+                    (x:_) -> (text arr off x, text arr (off+x) (len-x))+{-# INLINE breakOn #-}++-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the+-- string.+--+-- The first element of the returned tuple is the prefix of @haystack@+-- up to and including the last match of @needle@.  The second is the+-- remainder of @haystack@, following the match.+--+-- >>> breakOnEnd "::" "a::b::c"+-- ("a::b::","c")+breakOnEnd :: Text -> Text -> (Text, Text)+breakOnEnd pat src = (reverse b, reverse a)+    where (a,b) = breakOn (reverse pat) (reverse src)+{-# INLINE breakOnEnd #-}++-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in+-- @haystack@.  Each element of the returned list consists of a pair:+--+-- * The entire string prior to the /k/th match (i.e. the prefix)+--+-- * The /k/th match, followed by the remainder of the string+--+-- Examples:+--+-- >>> breakOnAll "::" ""+-- []+--+-- >>> breakOnAll "/" "a/b/c/"+-- [("a","/b/c/"),("a/b","/c/"),("a/b/c","/")]+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+--+-- The @needle@ parameter may not be empty.+breakOnAll :: Text              -- ^ @needle@ to search for+           -> Text              -- ^ @haystack@ in which to search+           -> [(Text, Text)]+breakOnAll pat src@(Text arr off slen)+    | null pat  = emptyError "breakOnAll"+    | otherwise = L.map step (indices pat src)+  where+    step       x = (chunk 0 x, chunk x (slen-x))+    chunk !n !l  = text arr (n+off) l+{-# INLINE breakOnAll #-}++-------------------------------------------------------------------------------+-- ** Indexing 'Text's++-- $index+--+-- If you think of a 'Text' value as an array of 'Char' values (which+-- it is not), you run the risk of writing inefficient code.+--+-- An idiom that is common in some languages is to find the numeric+-- offset of a character or substring, then use that number to split+-- or trim the searched string.  With a 'Text' value, this approach+-- would require two /O(n)/ operations: one to perform the search, and+-- one to operate from wherever the search ended.+--+-- For example, suppose you have a string that you want to split on+-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of+-- searching for the index of @\"::\"@ and taking the substrings+-- before and after that index, you would instead use @breakOnAll \"::\"@.++-- | /O(n)/ 'Text' index (subscript) operator, starting from 0. Subject to fusion.+index :: Text -> Int -> Char+index t n = S.index (stream t) n+{-# INLINE index #-}++-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'+-- and returns the index of the first element in the 'Text' satisfying+-- the predicate. Subject to fusion.+findIndex :: (Char -> Bool) -> Text -> Maybe Int+findIndex p t = S.findIndex p (stream t)+{-# INLINE findIndex #-}++-- | /O(n+m)/ The 'count' function returns the number of times the+-- query string appears in the given 'Text'. An empty query string is+-- invalid, and will cause an error to be raised.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+count :: Text -> Text -> Int+count pat src+    | null pat        = emptyError "count"+    | isSingleton pat = countChar (unsafeHead pat) src+    | otherwise       = L.length (indices pat src)+{-# INLINE [1] count #-}++{-# RULES+"TEXT count/singleton -> countChar" [~1] forall c t.+    count (singleton c) t = countChar c t+  #-}++-- | /O(n)/ The 'countChar' function returns the number of times the+-- query element appears in the given 'Text'. Subject to fusion.+countChar :: Char -> Text -> Int+countChar c t = S.countChar c (stream t)+{-# INLINE countChar #-}++-------------------------------------------------------------------------------+-- * Zipping++-- | /O(n)/ 'zip' takes two 'Text's and returns a list of+-- corresponding pairs of bytes. If one input 'Text' is short,+-- excess elements of the longer 'Text' are discarded. This is+-- equivalent to a pair of 'unpack' operations.+zip :: Text -> Text -> [(Char,Char)]+zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)+{-# INLINE zip #-}++-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function+-- given as the first argument, instead of a tupling function.+-- Performs replacement on invalid scalar values.+zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text+zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))+    where g a b = safe (f a b)+{-# INLINE zipWith #-}++-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's+-- representing white space.+words :: Text -> [Text]+words t@(Text arr off len) = loop 0 0+  where+    loop !start !n+        | n >= len = if start == n+                     then []+                     else [Text arr (start+off) (n-start)]+        | isSpace c =+            if start == n+            then loop (start+1) (start+1)+            else Text arr (start+off) (n-start) : loop (n+d) (n+d)+        | otherwise = loop start (n+d)+        where Iter c d = iter t n+{-# INLINE words #-}++-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at+-- newline 'Char's. The resulting strings do not contain newlines.+lines :: Text -> [Text]+lines ps | null ps   = []+         | otherwise = h : if null t+                           then []+                           else lines (unsafeTail t)+    where (# h,t #) = span_ (/= '\n') ps+{-# INLINE lines #-}++{-+-- | /O(n)/ Portably breaks a 'Text' up into a list of 'Text's at line+-- boundaries.+--+-- A line boundary is considered to be either a line feed, a carriage+-- return immediately followed by a line feed, or a carriage return.+-- This accounts for both Unix and Windows line ending conventions,+-- and for the old convention used on Mac OS 9 and earlier.+lines' :: Text -> [Text]+lines' ps | null ps   = []+          | otherwise = h : case uncons t of+                              Nothing -> []+                              Just (c,t')+                                  | c == '\n' -> lines t'+                                  | c == '\r' -> case uncons t' of+                                                   Just ('\n',t'') -> lines t''+                                                   _               -> lines t'+    where (h,t)    = span notEOL ps+          notEOL c = c /= '\n' && c /= '\r'+{-# INLINE lines' #-}+-}++-- | /O(n)/ Joins lines, after appending a terminating newline to+-- each.+unlines :: [Text] -> Text+unlines = concat . L.map (`snoc` '\n')+{-# INLINE unlines #-}++-- | /O(n)/ Joins words using single space characters.+unwords :: [Text] -> Text+unwords = intercalate (singleton ' ')+{-# INLINE unwords #-}++-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns+-- 'True' iff the first is a prefix of the second.  Subject to fusion.+isPrefixOf :: Text -> Text -> Bool+isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =+    alen <= blen && S.isPrefixOf (stream a) (stream b)+{-# INLINE [1] isPrefixOf #-}++{-# RULES+"TEXT isPrefixOf -> fused" [~1] forall s t.+    isPrefixOf s t = S.isPrefixOf (stream s) (stream t)+  #-}++-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns+-- 'True' iff the first is a suffix of the second.+isSuffixOf :: Text -> Text -> Bool+isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =+    d >= 0 && a == b'+  where d              = blen - alen+        b' | d == 0    = b+           | otherwise = Text barr (boff+d) alen+{-# INLINE isSuffixOf #-}++-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns+-- 'True' iff the first is contained, wholly and intact, anywhere+-- within the second.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+isInfixOf :: Text -> Text -> Bool+isInfixOf needle haystack+    | null needle        = True+    | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack+    | otherwise          = not . L.null . indices needle $ haystack+{-# INLINE [1] isInfixOf #-}++{-# RULES+"TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.+    isInfixOf (singleton n) h = S.elem n (S.stream h)+  #-}++-------------------------------------------------------------------------------+-- * View patterns++-- | /O(n)/ Return the suffix of the second string if its prefix+-- matches the entire first string.+--+-- Examples:+--+-- >>> stripPrefix "foo" "foobar"+-- Just "bar"+--+-- >>> stripPrefix ""    "baz"+-- Just "baz"+--+-- >>> stripPrefix "foo" "quux"+-- Nothing+--+-- This is particularly useful with the @ViewPatterns@ extension to+-- GHC, as follows:+--+-- > {-# LANGUAGE ViewPatterns #-}+-- > import Data.Text as T+-- >+-- > fnordLength :: Text -> Int+-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf+-- > fnordLength _                                 = -1+stripPrefix :: Text -> Text -> Maybe Text+stripPrefix p@(Text _arr _off plen) t@(Text arr off len)+    | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)+    | otherwise        = Nothing++-- | /O(n)/ Find the longest non-empty common prefix of two strings+-- and return it, along with the suffixes of each string at which they+-- no longer match.+--+-- If the strings do not have a common prefix or either one is empty,+-- this function returns 'Nothing'.+--+-- Examples:+--+-- >>> commonPrefixes "foobar" "fooquux"+-- Just ("foo","bar","quux")+--+-- >>> commonPrefixes "veeble" "fetzer"+-- Nothing+--+-- >>> commonPrefixes "" "baz"+-- Nothing+commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)+commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0+  where+    go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)+             | i > 0     = Just (Text arr0 off0 i,+                                 text arr0 (off0+i) (len0-i),+                                 text arr1 (off1+j) (len1-j))+             | otherwise = Nothing+      where Iter a d0 = iter t0 i+            Iter b d1 = iter t1 j++-- | /O(n)/ Return the prefix of the second string if its suffix+-- matches the entire first string.+--+-- Examples:+--+-- >>> stripSuffix "bar" "foobar"+-- Just "foo"+--+-- >>> stripSuffix ""    "baz"+-- Just "baz"+--+-- >>> stripSuffix "foo" "quux"+-- Nothing+--+-- This is particularly useful with the @ViewPatterns@ extension to+-- GHC, as follows:+--+-- > {-# LANGUAGE ViewPatterns #-}+-- > import Data.Text as T+-- >+-- > quuxLength :: Text -> Int+-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre+-- > quuxLength _                                = -1+stripSuffix :: Text -> Text -> Maybe Text+stripSuffix p@(Text _arr _off plen) t@(Text arr off len)+    | p `isSuffixOf` t = Just $! text arr off (len-plen)+    | otherwise        = Nothing++-- | Add a list of non-negative numbers.  Errors out on overflow.+sumP :: String -> [Int] -> Int+sumP fun = go 0+  where go !a (x:xs)+            | ax >= 0   = go ax xs+            | otherwise = overflowError fun+          where ax = a + x+        go a  _         = a++emptyError :: String -> a+emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"++overflowError :: String -> a+overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"++-- | /O(n)/ Make a distinct copy of the given string, sharing no+-- storage with the original string.+--+-- As an example, suppose you read a large string, of which you need+-- only a small portion.  If you do not use 'copy', the entire original+-- array will be kept alive in memory by the smaller string. Making a+-- copy \"breaks the link\" to the original array, allowing it to be+-- garbage collected if there are no other live references to it.+copy :: Text -> Text+copy (Text arr off len) = Text (A.run go) 0 len+  where+    go :: ST s (A.MArray s)+    go = do+      marr <- A.new len+      A.copyI marr 0 arr off len+      return marr+++-------------------------------------------------+-- NOTE: the named chunk below used by doctest;+--       verify the doctests via `doctest -fobject-code Data/Text.hs`++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Text as T
+ src/Data/Text/Array.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types,+    RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}+-- |+-- Module      : Data.Text.Array+-- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : portable+--+-- Packed, unboxed, heap-resident arrays.  Suitable for performance+-- critical use, both in terms of large data quantities and high+-- speed.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions, e.g.+--+-- > import qualified Data.Text.Array as A+--+-- The names in this module resemble those in the 'Data.Array' family+-- of modules, but are shorter due to the assumption of qualified+-- naming.+module Data.Text.Array+    (+    -- * Types+      Array(Array, aBA)+    , MArray(MArray, maBA)++    -- * Functions+    , copyM+    , copyI+    , empty+    , equal+#if defined(ASSERTS)+    , length+#endif+    , run+    , run2+    , toList+    , unsafeFreeze+    , unsafeIndex+    , new+    , unsafeWrite+    ) where++#if defined(ASSERTS)+-- This fugly hack is brought by GHC's apparent reluctance to deal+-- with MagicHash and UnboxedTuples when inferring types. Eek!+# define CHECK_BOUNDS(_func_,_len_,_k_) \+if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else+#else+# define CHECK_BOUNDS(_func_,_len_,_k_)+#endif++#include "MachDeps.h"++#if defined(ASSERTS)+import Control.Exception (assert)+#endif+#if MIN_VERSION_base(4,4,0)+import Control.Monad.ST.Unsafe (unsafeIOToST)+#else+import Control.Monad.ST (unsafeIOToST)+#endif+import Data.Bits ((.&.), xor)+import Data.Text.Internal.Unsafe (inlinePerformIO)+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)+#if MIN_VERSION_base(4,5,0)+import Foreign.C.Types (CInt(CInt), CSize(CSize))+#else+import Foreign.C.Types (CInt, CSize)+#endif+import GHC.Base (ByteArray#, MutableByteArray#, Int(..),+                 indexWord16Array#, newByteArray#,+                 unsafeFreezeByteArray#, writeWord16Array#)+import GHC.ST (ST(..), runST)+import GHC.Word (Word16(..))+import Prelude hiding (length, read)++-- | Immutable array type.+--+-- The 'Array' constructor is exposed since @text-1.1.1.3@+data Array = Array {+      aBA :: ByteArray#+#if defined(ASSERTS)+    , aLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)+#endif+    }++-- | Mutable array type, for use in the ST monad.+--+-- The 'MArray' constructor is exposed since @text-1.1.1.3@+data MArray s = MArray {+      maBA :: MutableByteArray# s+#if defined(ASSERTS)+    , maLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)+#endif+    }++#if defined(ASSERTS)+-- | Operations supported by all arrays.+class IArray a where+    -- | Return the length of an array.+    length :: a -> Int++instance IArray Array where+    length = aLen+    {-# INLINE length #-}++instance IArray (MArray s) where+    length = maLen+    {-# INLINE length #-}+#endif++-- | Create an uninitialized mutable array.+new :: forall s. Int -> ST s (MArray s)+new n+  | n < 0 || n .&. highBit /= 0 = array_size_error+  | otherwise = ST $ \s1# ->+       case newByteArray# len# s1# of+         (# s2#, marr# #) -> (# s2#, MArray marr#+#if defined(ASSERTS)+                                n+#endif+                                #)+  where !(I# len#) = bytesInArray n+        highBit    = maxBound `xor` (maxBound `shiftR` 1)+{-# INLINE new #-}++array_size_error :: a+array_size_error = error "Data.Text.Array.new: size overflow"++-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!+unsafeFreeze :: MArray s -> ST s Array+unsafeFreeze MArray{..} = ST $ \s1# ->+    case unsafeFreezeByteArray# maBA s1# of+        (# s2#, ba# #) -> (# s2#, Array ba#+#if defined(ASSERTS)+                             maLen+#endif+                             #)+{-# INLINE unsafeFreeze #-}++-- | Indicate how many bytes would be used for an array of the given+-- size.+bytesInArray :: Int -> Int+bytesInArray n = n `shiftL` 1+{-# INLINE bytesInArray #-}++-- | Unchecked read of an immutable array.  May return garbage or+-- crash on an out-of-bounds access.+unsafeIndex :: Array -> Int -> Word16+unsafeIndex Array{..} i@(I# i#) =+  CHECK_BOUNDS("unsafeIndex",aLen,i)+    case indexWord16Array# aBA i# of r# -> (W16# r#)+{-# INLINE unsafeIndex #-}++-- | Unchecked write of a mutable array.  May return garbage or crash+-- on an out-of-bounds access.+unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()+unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->+  CHECK_BOUNDS("unsafeWrite",maLen,i)+  case writeWord16Array# maBA i# e# s1# of+    s2# -> (# s2#, () #)+{-# INLINE unsafeWrite #-}++-- | Convert an immutable array to a list.+toList :: Array -> Int -> Int -> [Word16]+toList ary off len = loop 0+    where loop i | i < len   = unsafeIndex ary (off+i) : loop (i+1)+                 | otherwise = []++-- | An empty immutable array.+empty :: Array+empty = runST (new 0 >>= unsafeFreeze)++-- | Run an action in the ST monad and return an immutable array of+-- its result.+run :: (forall s. ST s (MArray s)) -> Array+run k = runST (k >>= unsafeFreeze)++-- | Run an action in the ST monad and return an immutable array of+-- its result paired with whatever else the action returns.+run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)+run2 k = runST (do+                 (marr,b) <- k+                 arr <- unsafeFreeze marr+                 return (arr,b))+{-# INLINE run2 #-}++-- | Copy some elements of a mutable array.+copyM :: MArray s               -- ^ Destination+      -> Int                    -- ^ Destination offset+      -> MArray s               -- ^ Source+      -> Int                    -- ^ Source offset+      -> Int                    -- ^ Count+      -> ST s ()+copyM dest didx src sidx count+    | count <= 0 = return ()+    | otherwise =+#if defined(ASSERTS)+    assert (sidx + count <= length src) .+    assert (didx + count <= length dest) .+#endif+    unsafeIOToST $ memcpyM (maBA dest) (fromIntegral didx)+                           (maBA src) (fromIntegral sidx)+                           (fromIntegral count)+{-# INLINE copyM #-}++-- | Copy some elements of an immutable array.+copyI :: MArray s               -- ^ Destination+      -> Int                    -- ^ Destination offset+      -> Array                  -- ^ Source+      -> Int                    -- ^ Source offset+      -> Int                    -- ^ First offset in destination /not/ to+                                -- copy (i.e. /not/ length)+      -> ST s ()+copyI dest i0 src j0 top+    | i0 >= top = return ()+    | otherwise = unsafeIOToST $+                  memcpyI (maBA dest) (fromIntegral i0)+                          (aBA src) (fromIntegral j0)+                          (fromIntegral (top-i0))+{-# INLINE copyI #-}++-- | Compare portions of two arrays for equality.  No bounds checking+-- is performed.+equal :: Array                  -- ^ First+      -> Int                    -- ^ Offset into first+      -> Array                  -- ^ Second+      -> Int                    -- ^ Offset into second+      -> Int                    -- ^ Count+      -> Bool+equal arrA offA arrB offB count = inlinePerformIO $ do+  i <- memcmp (aBA arrA) (fromIntegral offA)+                     (aBA arrB) (fromIntegral offB) (fromIntegral count)+  return $! i == 0+{-# INLINE equal #-}++foreign import ccall unsafe "_hs_text_memcpy" memcpyI+    :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()++foreign import ccall unsafe "_hs_text_memcmp" memcmp+    :: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt++foreign import ccall unsafe "_hs_text_memcpy" memcpyM+    :: MutableByteArray# s -> CSize -> MutableByteArray# s -> CSize -> CSize+    -> IO ()
+ src/Data/Text/Encoding.hs view
@@ -0,0 +1,539 @@+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, MagicHash,+    UnliftedFFITypes #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-- |+-- Module      : Data.Text.Encoding+-- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan,+--               (c) 2009 Duncan Coutts,+--               (c) 2008, 2009 Tom Harper+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : portable+--+-- Functions for converting 'Text' values to and from 'ByteString',+-- using several standard encodings.+--+-- To gain access to a much larger family of encodings, use the+-- <http://hackage.haskell.org/package/text-icu text-icu package>.++module Data.Text.Encoding+    (+    -- * Decoding ByteStrings to Text+    -- $strict+      decodeASCII+    , decodeLatin1+    , decodeUtf8+    , decodeUtf16LE+    , decodeUtf16BE+    , decodeUtf32LE+    , decodeUtf32BE++    -- ** Catchable failure+    , decodeUtf8'++    -- ** Controllable error handling+    , decodeUtf8With+    , decodeUtf16LEWith+    , decodeUtf16BEWith+    , decodeUtf32LEWith+    , decodeUtf32BEWith++    -- ** Stream oriented decoding+    -- $stream+    , streamDecodeUtf8+    , streamDecodeUtf8With+    , Decoding(..)++    -- * Encoding Text to ByteStrings+    , encodeUtf8+    , encodeUtf16LE+    , encodeUtf16BE+    , encodeUtf32LE+    , encodeUtf32BE++    -- * Encoding Text using ByteString Builders+    , encodeUtf8Builder+    , encodeUtf8BuilderEscaped+    ) where++#if MIN_VERSION_base(4,4,0)+import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)+#else+import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)+#endif++import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall))+import Control.Monad.ST (runST)+import Data.Bits ((.&.))+import Data.ByteString as B+import Data.ByteString.Internal as B hiding (c2w)+import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)+import Data.Text.Internal (Text(..), safe, text)+import Data.Text.Internal.Private (runText)+import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)+import Data.Text.Internal.Unsafe.Shift (shiftR)+import Data.Text.Show ()+import Data.Text.Unsafe (unsafeDupablePerformIO)+import Data.Word (Word8, Word32)+#if MIN_VERSION_base(4,5,0)+import Foreign.C.Types (CSize(CSize))+#else+import Foreign.C.Types (CSize)+#endif+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)+import Foreign.Storable (Storable, peek, poke)+import GHC.Base (ByteArray#, MutableByteArray#)+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)+import qualified Data.ByteString.Builder.Prim as BP+import qualified Data.ByteString.Builder.Prim.Internal as BP+import qualified Data.Text.Array as A+import qualified Data.Text.Internal.Encoding.Fusion as E+import qualified Data.Text.Internal.Encoding.Utf16 as U16+import qualified Data.Text.Internal.Fusion as F+import Data.Text.Internal.ByteStringCompat++#include "text_cbits.h"++-- $strict+--+-- All of the single-parameter functions for decoding bytestrings+-- encoded in one of the Unicode Transformation Formats (UTF) operate+-- in a /strict/ mode: each will throw an exception if given invalid+-- input.+--+-- Each function has a variant, whose name is suffixed with -'With',+-- that gives greater control over the handling of decoding errors.+-- For instance, 'decodeUtf8' will throw an exception, but+-- 'decodeUtf8With' allows the programmer to determine what to do on a+-- decoding error.++-- | /Deprecated/.  Decode a 'ByteString' containing 7-bit ASCII+-- encoded text.+decodeASCII :: ByteString -> Text+decodeASCII = decodeUtf8+{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}++-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.+--+-- 'decodeLatin1' is semantically equivalent to+--  @Data.Text.pack . Data.ByteString.Char8.unpack@+decodeLatin1 :: ByteString -> Text+decodeLatin1 bs = withBS bs aux where+  aux fp len = text a 0 len+   where+    a = A.run (A.new len >>= unsafeIOToST . go)+    go dest = withForeignPtr fp $ \ptr -> do+      c_decode_latin1 (A.maBA dest) ptr (ptr `plusPtr` len)+      return dest++-- | Decode a 'ByteString' containing UTF-8 encoded text.+--+-- __NOTE__: The replacement character returned by 'OnDecodeError'+-- MUST be within the BMP plane; surrogate code points will+-- automatically be remapped to the replacement char @U+FFFD@+-- (/since 0.11.3.0/), whereas code points beyond the BMP will throw an+-- 'error' (/since 1.2.3.1/); For earlier versions of @text@ using+-- those unsupported code points would result in undefined behavior.+decodeUtf8With :: OnDecodeError -> ByteString -> Text+decodeUtf8With onErr bs = withBS bs aux+ where+  aux fp len = runText $ \done -> do+    let go dest = withForeignPtr fp $ \ptr ->+          with (0::CSize) $ \destOffPtr -> do+            let end = ptr `plusPtr` len+                loop curPtr = do+                  curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end+                  if curPtr' == end+                    then do+                      n <- peek destOffPtr+                      unsafeSTToIO (done dest (fromIntegral n))+                    else do+                      x <- peek curPtr'+                      case onErr desc (Just x) of+                        Nothing -> loop $ curPtr' `plusPtr` 1+                        Just c+                          | c > '\xFFFF' -> throwUnsupportedReplChar+                          | otherwise -> do+                              destOff <- peek destOffPtr+                              w <- unsafeSTToIO $+                                   unsafeWrite dest (fromIntegral destOff)+                                               (safe c)+                              poke destOffPtr (destOff + fromIntegral w)+                              loop $ curPtr' `plusPtr` 1+            loop ptr+    (unsafeIOToST . go) =<< A.new len+   where+    desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"++    throwUnsupportedReplChar = throwIO $+      ErrorCall "decodeUtf8With: non-BMP replacement characters not supported"+  -- TODO: The code currently assumes that the transcoded UTF-16+  -- stream is at most twice as long (in bytes) as the input UTF-8+  -- stream. To justify this assumption one has to assume that the+  -- error handler replacement character also satisfies this+  -- invariant, by emitting at most one UTF16 code unit.+  --+  -- One easy way to support the full range of code-points for+  -- replacement characters in the error handler is to simply change+  -- the (over-)allocation to `A.new (2*len)` and then shrink back the+  -- `ByteArray#` to the real size (recent GHCs have a cheap+  -- `ByteArray#` resize-primop for that which allow the GC to reclaim+  -- the overallocation). However, this would require 4 times as much+  -- (temporary) storage as the original UTF-8 required.+  --+  -- Another strategy would be to optimistically assume that+  -- replacement characters are within the BMP, and if the case of a+  -- non-BMP replacement occurs reallocate the target buffer (or throw+  -- an exception, and fallback to a pessimistic codepath, like e.g.+  -- `decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)`)+  --+  -- Alternatively, `OnDecodeError` could become a datastructure which+  -- statically encodes the replacement-character range,+  -- e.g. something isomorphic to+  --+  --   Either (... -> Maybe Word16) (... -> Maybe Char)+  --+  -- And allow to statically switch between the BMP/non-BMP+  -- replacement-character codepaths. There's multiple ways to address+  -- this with different tradeoffs; but ideally we should optimise for+  -- the optimistic/error-free case.+{- INLINE[0] decodeUtf8With #-}++-- $stream+--+-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept+-- a 'ByteString' that represents a possibly incomplete input (e.g. a+-- packet from a network stream) that may not end on a UTF-8 boundary.+--+-- 1. The maximal prefix of 'Text' that could be decoded from the+--    given input.+--+-- 2. The suffix of the 'ByteString' that could not be decoded due to+--    insufficient input.+--+-- 3. A function that accepts another 'ByteString'.  That string will+--    be assumed to directly follow the string that was passed as+--    input to the original function, and it will in turn be decoded.+--+-- To help understand the use of these functions, consider the Unicode+-- string @\"hi &#9731;\"@. If encoded as UTF-8, this becomes @\"hi+-- \\xe2\\x98\\x83\"@; the final @\'&#9731;\'@ is encoded as 3 bytes.+--+-- Now suppose that we receive this encoded string as 3 packets that+-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",+-- \"\\x83\"]@. We cannot decode the entire Unicode string until we+-- have received all three packets, but we would like to make progress+-- as we receive each one.+--+-- @+-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"+-- ghci> s0+-- 'Some' \"hi \" \"\\xe2\" _+-- @+--+-- We use the continuation @f0@ to decode our second packet.+--+-- @+-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"+-- ghci> s1+-- 'Some' \"\" \"\\xe2\\x98\"+-- @+--+-- We could not give @f0@ enough input to decode anything, so it+-- returned an empty string. Once we feed our second continuation @f1@+-- the last byte of input, it will make progress.+--+-- @+-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"+-- ghci> s2+-- 'Some' \"\\x2603\" \"\" _+-- @+--+-- If given invalid input, an exception will be thrown by the function+-- or continuation where it is encountered.++-- | A stream oriented decoding result.+--+-- @since 1.0.0.0+data Decoding = Some Text ByteString (ByteString -> Decoding)++instance Show Decoding where+    showsPrec d (Some t bs _) = showParen (d > prec) $+                                showString "Some " . showsPrec prec' t .+                                showChar ' ' . showsPrec prec' bs .+                                showString " _"+      where prec = 10; prec' = prec + 1++newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)+newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)++-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8+-- encoded text that is known to be valid.+--+-- If the input contains any invalid UTF-8 data, an exception will be+-- thrown (either by this function or a continuation) that cannot be+-- caught in pure code.  For more control over the handling of invalid+-- data, use 'streamDecodeUtf8With'.+--+-- @since 1.0.0.0+streamDecodeUtf8 :: ByteString -> Decoding+streamDecodeUtf8 = streamDecodeUtf8With strictDecode++-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8+-- encoded text.+--+-- @since 1.0.0.0+streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding+streamDecodeUtf8With onErr = decodeChunk B.empty 0 0+ where+  -- We create a slightly larger than necessary buffer to accommodate a+  -- potential surrogate pair started in the last buffer+  decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString+              -> Decoding+  decodeChunk undecoded0 codepoint0 state0 bs = withBS bs aux where+    aux fp len = runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)+       where+        decodeChunkToBuffer :: A.MArray s -> IO Decoding+        decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->+          with (0::CSize) $ \destOffPtr ->+          with codepoint0 $ \codepointPtr ->+          with state0 $ \statePtr ->+          with nullPtr $ \curPtrPtr ->+            let end = ptr `plusPtr` len+                loop curPtr = do+                  poke curPtrPtr curPtr+                  curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr+                             curPtrPtr end codepointPtr statePtr+                  state <- peek statePtr+                  case state of+                    UTF8_REJECT -> do+                      -- We encountered an encoding error+                      x <- peek curPtr'+                      poke statePtr 0+                      case onErr desc (Just x) of+                        Nothing -> loop $ curPtr' `plusPtr` 1+                        Just c -> do+                          destOff <- peek destOffPtr+                          w <- unsafeSTToIO $+                               unsafeWrite dest (fromIntegral destOff) (safe c)+                          poke destOffPtr (destOff + fromIntegral w)+                          loop $ curPtr' `plusPtr` 1++                    _ -> do+                      -- We encountered the end of the buffer while decoding+                      n <- peek destOffPtr+                      codepoint <- peek codepointPtr+                      chunkText <- unsafeSTToIO $ do+                          arr <- A.unsafeFreeze dest+                          return $! text arr 0 (fromIntegral n)+                      lastPtr <- peek curPtrPtr+                      let left = lastPtr `minusPtr` curPtr+                          !undecoded = case state of+                            UTF8_ACCEPT -> B.empty+                            _           -> B.append undecoded0 (B.drop left bs)+                      return $ Some chunkText undecoded+                               (decodeChunk undecoded codepoint state)+            in loop ptr+  desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"++-- | Decode a 'ByteString' containing UTF-8 encoded text that is known+-- to be valid.+--+-- If the input contains any invalid UTF-8 data, an exception will be+-- thrown that cannot be caught in pure code.  For more control over+-- the handling of invalid data, use 'decodeUtf8'' or+-- 'decodeUtf8With'.+decodeUtf8 :: ByteString -> Text+decodeUtf8 = decodeUtf8With strictDecode+{-# INLINE[0] decodeUtf8 #-}+{-# RULES "STREAM stream/decodeUtf8 fusion" [1]+    forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}++-- | Decode a 'ByteString' containing UTF-8 encoded text.+--+-- If the input contains any invalid UTF-8 data, the relevant+-- exception will be returned, otherwise the decoded text.+decodeUtf8' :: ByteString -> Either UnicodeException Text+decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode+{-# INLINE decodeUtf8' #-}++-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.+--+-- @since 1.1.0.0+encodeUtf8Builder :: Text -> B.Builder+encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)++-- | Encode text using UTF-8 encoding and escape the ASCII characters using+-- a 'BP.BoundedPrim'.+--+-- Use this function is to implement efficient encoders for text-based formats+-- like JSON or HTML.+--+-- @since 1.1.0.0+{-# INLINE encodeUtf8BuilderEscaped #-}+-- TODO: Extend documentation with references to source code in @blaze-html@+-- or @aeson@ that uses this function.+encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder+encodeUtf8BuilderEscaped be =+    -- manual eta-expansion to ensure inlining works as expected+    \txt -> B.builder (mkBuildstep txt)+  where+    bound = max 4 $ BP.sizeBound be++    mkBuildstep (Text arr off len) !k =+        outerLoop off+      where+        iend = off + len++        outerLoop !i0 !br@(B.BufferRange op0 ope)+          | i0 >= iend       = k br+          | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)+          -- TODO: Use a loop with an integrated bound's check if outRemaining+          -- is smaller than 8, as this will save on divisions.+          | otherwise        = return $ B.bufferFull bound op0 (outerLoop i0)+          where+            outRemaining = (ope `minusPtr` op0) `div` bound+            inpRemaining = iend - i0++            goPartial !iendTmp = go i0 op0+              where+                go !i !op+                  | i < iendTmp = case A.unsafeIndex arr i of+                      w | w <= 0x7F -> do+                            BP.runB be (fromIntegral w) op >>= go (i + 1)+                        | w <= 0x7FF -> do+                            poke8 0 $ (w `shiftR` 6) + 0xC0+                            poke8 1 $ (w .&. 0x3f) + 0x80+                            go (i + 1) (op `plusPtr` 2)+                        | 0xD800 <= w && w <= 0xDBFF -> do+                            let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))+                            poke8 0 $ (c `shiftR` 18) + 0xF0+                            poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80+                            poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80+                            poke8 3 $ (c .&. 0x3F) + 0x80+                            go (i + 2) (op `plusPtr` 4)+                        | otherwise -> do+                            poke8 0 $ (w `shiftR` 12) + 0xE0+                            poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80+                            poke8 2 $ (w .&. 0x3F) + 0x80+                            go (i + 1) (op `plusPtr` 3)+                  | otherwise =+                      outerLoop i (B.BufferRange op ope)+                  where+                    poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)++-- | Encode text using UTF-8 encoding.+encodeUtf8 :: Text -> ByteString+encodeUtf8 (Text arr off len)+  | len == 0  = B.empty+  | otherwise = unsafeDupablePerformIO $ do+  fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough+  withForeignPtr fp $ \ptr ->+    with ptr $ \destPtr -> do+      c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)+      newDest <- peek destPtr+      let utf8len = newDest `minusPtr` ptr+      if utf8len >= len `shiftR` 1+        then return (mkBS fp utf8len)+        else do+          fp' <- mallocByteString utf8len+          withForeignPtr fp' $ \ptr' -> do+            memcpy ptr' ptr (fromIntegral utf8len)+            return (mkBS fp' utf8len)++-- | Decode text from little endian UTF-16 encoding.+decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text+decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)+{-# INLINE decodeUtf16LEWith #-}++-- | Decode text from little endian UTF-16 encoding.+--+-- If the input contains any invalid little endian UTF-16 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf16LEWith'.+decodeUtf16LE :: ByteString -> Text+decodeUtf16LE = decodeUtf16LEWith strictDecode+{-# INLINE decodeUtf16LE #-}++-- | Decode text from big endian UTF-16 encoding.+decodeUtf16BEWith :: OnDecodeError -> ByteString -> Text+decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)+{-# INLINE decodeUtf16BEWith #-}++-- | Decode text from big endian UTF-16 encoding.+--+-- If the input contains any invalid big endian UTF-16 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf16BEWith'.+decodeUtf16BE :: ByteString -> Text+decodeUtf16BE = decodeUtf16BEWith strictDecode+{-# INLINE decodeUtf16BE #-}++-- | Encode text using little endian UTF-16 encoding.+encodeUtf16LE :: Text -> ByteString+encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))+{-# INLINE encodeUtf16LE #-}++-- | Encode text using big endian UTF-16 encoding.+encodeUtf16BE :: Text -> ByteString+encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))+{-# INLINE encodeUtf16BE #-}++-- | Decode text from little endian UTF-32 encoding.+decodeUtf32LEWith :: OnDecodeError -> ByteString -> Text+decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)+{-# INLINE decodeUtf32LEWith #-}++-- | Decode text from little endian UTF-32 encoding.+--+-- If the input contains any invalid little endian UTF-32 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf32LEWith'.+decodeUtf32LE :: ByteString -> Text+decodeUtf32LE = decodeUtf32LEWith strictDecode+{-# INLINE decodeUtf32LE #-}++-- | Decode text from big endian UTF-32 encoding.+decodeUtf32BEWith :: OnDecodeError -> ByteString -> Text+decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)+{-# INLINE decodeUtf32BEWith #-}++-- | Decode text from big endian UTF-32 encoding.+--+-- If the input contains any invalid big endian UTF-32 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf32BEWith'.+decodeUtf32BE :: ByteString -> Text+decodeUtf32BE = decodeUtf32BEWith strictDecode+{-# INLINE decodeUtf32BE #-}++-- | Encode text using little endian UTF-32 encoding.+encodeUtf32LE :: Text -> ByteString+encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))+{-# INLINE encodeUtf32LE #-}++-- | Encode text using big endian UTF-32 encoding.+encodeUtf32BE :: Text -> ByteString+encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))+{-# INLINE encodeUtf32BE #-}++foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8+    :: MutableByteArray# s -> Ptr CSize+    -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state+    :: MutableByteArray# s -> Ptr CSize+    -> Ptr (Ptr Word8) -> Ptr Word8+    -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)++foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1+    :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()++foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8+    :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
+ src/Data/Text/Encoding/Error.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE CPP, DeriveDataTypeable #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#elif __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-- |+-- Module      : Data.Text.Encoding.Error+-- Copyright   : (c) Bryan O'Sullivan 2009+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : GHC+--+-- Types and functions for dealing with encoding and decoding errors+-- in Unicode text.+--+-- The standard functions for encoding and decoding text are strict,+-- which is to say that they throw exceptions on invalid input.  This+-- is often unhelpful on real world input, so alternative functions+-- exist that accept custom handlers for dealing with invalid inputs.+-- These 'OnError' handlers are normal Haskell functions.  You can use+-- one of the presupplied functions in this module, or you can write a+-- custom handler of your own.++module Data.Text.Encoding.Error+    (+    -- * Error handling types+      UnicodeException(..)+    , OnError+    , OnDecodeError+    , OnEncodeError+    -- * Useful error handling functions+    , lenientDecode+    , strictDecode+    , strictEncode+    , ignore+    , replace+    ) where++import Control.DeepSeq (NFData (..))+import Control.Exception (Exception, throw)+import Data.Typeable (Typeable)+import Data.Word (Word8)+import Numeric (showHex)++-- | Function type for handling a coding error.  It is supplied with+-- two inputs:+--+-- * A 'String' that describes the error.+--+-- * The input value that caused the error.  If the error arose+--   because the end of input was reached or could not be identified+--   precisely, this value will be 'Nothing'.+--+-- If the handler returns a value wrapped with 'Just', that value will+-- be used in the output as the replacement for the invalid input.  If+-- it returns 'Nothing', no value will be used in the output.+--+-- Should the handler need to abort processing, it should use 'error'+-- or 'throw' an exception (preferably a 'UnicodeException').  It may+-- use the description provided to construct a more helpful error+-- report.+type OnError a b = String -> Maybe a -> Maybe b++-- | A handler for a decoding error.+type OnDecodeError = OnError Word8 Char++-- | A handler for an encoding error.+{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}+type OnEncodeError = OnError Char Word8++-- | An exception type for representing Unicode encoding errors.+data UnicodeException =+    DecodeError String (Maybe Word8)+    -- ^ Could not decode a byte sequence because it was invalid under+    -- the given encoding, or ran out of input in mid-decode.+  | EncodeError String (Maybe Char)+    -- ^ Tried to encode a character that could not be represented+    -- under the given encoding, or ran out of input in mid-encode.+    deriving (Eq, Typeable)++{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}++showUnicodeException :: UnicodeException -> String+showUnicodeException (DecodeError desc (Just w))+    = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)+showUnicodeException (DecodeError desc Nothing)+    = "Cannot decode input: " ++ desc+showUnicodeException (EncodeError desc (Just c))+    = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)+showUnicodeException (EncodeError desc Nothing)+    = "Cannot encode input: " ++ desc++instance Show UnicodeException where+    show = showUnicodeException++instance Exception UnicodeException++instance NFData UnicodeException where+    rnf (DecodeError desc w) = rnf desc `seq` rnf w `seq` ()+    rnf (EncodeError desc c) = rnf desc `seq` rnf c `seq` ()++-- | Throw a 'UnicodeException' if decoding fails.+strictDecode :: OnDecodeError+strictDecode desc c = throw (DecodeError desc c)++-- | Replace an invalid input byte with the Unicode replacement+-- character U+FFFD.+lenientDecode :: OnDecodeError+lenientDecode _ _ = Just '\xfffd'++-- | Throw a 'UnicodeException' if encoding fails.+{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}+strictEncode :: OnEncodeError+strictEncode desc c = throw (EncodeError desc c)++-- | Ignore an invalid input, substituting nothing in the output.+ignore :: OnError a b+ignore _ _ = Nothing++-- | Replace an invalid input with a valid output.+replace :: b -> OnError a b+replace c _ _ = Just c
+ src/Data/Text/Foreign.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}+-- |+-- Module      : Data.Text.Foreign+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : GHC+--+-- Support for using 'Text' data with native code via the Haskell+-- foreign function interface.++module Data.Text.Foreign+    (+    -- * Interoperability with native code+    -- $interop+      I16+    -- * Safe conversion functions+    , fromPtr+    , useAsPtr+    , asForeignPtr+    -- ** Encoding as UTF-8+    , peekCStringLen+    , withCStringLen+    -- * Unsafe conversion code+    , lengthWord16+    , unsafeCopyToPtr+    -- * Low-level manipulation+    -- $lowlevel+    , dropWord16+    , takeWord16+    ) where++#if defined(ASSERTS)+import Control.Exception (assert)+#endif+#if MIN_VERSION_base(4,4,0)+import Control.Monad.ST.Unsafe (unsafeIOToST)+#else+import Control.Monad.ST (unsafeIOToST)+#endif+import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Data.Text.Internal (Text(..), empty)+import Data.Text.Unsafe (lengthWord16)+import Data.Word (Word16)+import Foreign.C.String (CStringLen)+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Foreign.Storable (peek, poke)+import qualified Data.Text.Array as A++-- $interop+--+-- The 'Text' type is implemented using arrays that are not guaranteed+-- to have a fixed address in the Haskell heap. All communication with+-- native code must thus occur by copying data back and forth.+--+-- The 'Text' type's internal representation is UTF-16, using the+-- platform's native endianness.  This makes copied data suitable for+-- use with native libraries that use a similar representation, such+-- as ICU.  To interoperate with native libraries that use different+-- internal representations, such as UTF-8 or UTF-32, consider using+-- the functions in the 'Data.Text.Encoding' module.++-- | A type representing a number of UTF-16 code units.+newtype I16 = I16 Int+    deriving (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show)++-- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word16' by copying the+-- contents of the array.+fromPtr :: Ptr Word16           -- ^ source array+        -> I16                  -- ^ length of source array (in 'Word16' units)+        -> IO Text+fromPtr _   (I16 0)   = return empty+fromPtr ptr (I16 len) =+#if defined(ASSERTS)+    assert (len > 0) $+#endif+    return $! Text arr 0 len+  where+    arr = A.run (A.new len >>= copy)+    copy marr = loop ptr 0+      where+        loop !p !i | i == len = return marr+                   | otherwise = do+          A.unsafeWrite marr i =<< unsafeIOToST (peek p)+          loop (p `plusPtr` 2) (i + 1)++-- $lowlevel+--+-- Foreign functions that use UTF-16 internally may return indices in+-- units of 'Word16' instead of characters.  These functions may+-- safely be used with such indices, as they will adjust offsets if+-- necessary to preserve the validity of a Unicode string.++-- | /O(1)/ Return the prefix of the 'Text' of @n@ 'Word16' units in+-- length.+--+-- If @n@ would cause the 'Text' to end inside a surrogate pair, the+-- end of the prefix will be advanced by one additional 'Word16' unit+-- to maintain its validity.+takeWord16 :: I16 -> Text -> Text+takeWord16 (I16 n) t@(Text arr off len)+    | n <= 0               = empty+    | n >= len || m >= len = t+    | otherwise            = Text arr off m+  where+    m | w < 0xD800 || w > 0xDBFF = n+      | otherwise                = n+1+    w = A.unsafeIndex arr (off+n-1)++-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units+-- dropped from its beginning.+--+-- If @n@ would cause the 'Text' to begin inside a surrogate pair, the+-- beginning of the suffix will be advanced by one additional 'Word16'+-- unit to maintain its validity.+dropWord16 :: I16 -> Text -> Text+dropWord16 (I16 n) t@(Text arr off len)+    | n <= 0               = t+    | n >= len || m >= len = empty+    | otherwise            = Text arr (off+m) (len-m)+  where+    m | w < 0xD800 || w > 0xDBFF = n+      | otherwise                = n+1+    w = A.unsafeIndex arr (off+n-1)++-- | /O(n)/ Copy a 'Text' to an array.  The array is assumed to be big+-- enough to hold the contents of the entire 'Text'.+unsafeCopyToPtr :: Text -> Ptr Word16 -> IO ()+unsafeCopyToPtr (Text arr off len) ptr = loop ptr off+  where+    end = off + len+    loop !p !i | i == end  = return ()+               | otherwise = do+      poke p (A.unsafeIndex arr i)+      loop (p `plusPtr` 2) (i + 1)++-- | /O(n)/ Perform an action on a temporary, mutable copy of a+-- 'Text'.  The copy is freed as soon as the action returns.+useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a+useAsPtr t@(Text _arr _off len) action =+    allocaBytes (len * 2) $ \buf -> do+      unsafeCopyToPtr t buf+      action (castPtr buf) (fromIntegral len)++-- | /O(n)/ Make a mutable copy of a 'Text'.+asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)+asForeignPtr t@(Text _arr _off len) = do+  fp <- mallocForeignPtrArray len+  withForeignPtr fp $ unsafeCopyToPtr t+  return (fp, I16 len)++-- | /O(n)/ Decode a C string with explicit length, which is assumed+-- to have been encoded as UTF-8. If decoding fails, a+-- 'UnicodeException' is thrown.+--+-- @since 1.0.0.0+peekCStringLen :: CStringLen -> IO Text+peekCStringLen cs = do+  bs <- unsafePackCStringLen cs+  return $! decodeUtf8 bs++-- | Marshal a 'Text' into a C string encoded as UTF-8 in temporary+-- storage, with explicit length information. The encoded string may+-- contain NUL bytes, and is not followed by a trailing NUL byte.+--+-- The temporary storage is freed when the subcomputation terminates+-- (either normally or via an exception), so the pointer to the+-- temporary storage must /not/ be used after this function returns.+--+-- @since 1.0.0.0+withCStringLen :: Text -> (CStringLen -> IO a) -> IO a+withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
+ src/Data/Text/IO.hs view
@@ -0,0 +1,350 @@+{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-- |+-- Module      : Data.Text.IO+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,+--               (c) 2009 Simon Marlow+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : GHC+--+-- Efficient locale-sensitive support for text I\/O.+--+-- Skip past the synopsis for some important notes on performance and+-- portability across different versions of GHC.++module Data.Text.IO+    (+    -- * Performance+    -- $performance++    -- * Locale support+    -- $locale+    -- * File-at-a-time operations+      readFile+    , writeFile+    , appendFile+    -- * Operations on handles+    , hGetContents+    , hGetChunk+    , hGetLine+    , hPutStr+    , hPutStrLn+    -- * Special cases for standard input and output+    , interact+    , getContents+    , getLine+    , putStr+    , putStrLn+    ) where++import Data.Text (Text)+import Prelude hiding (appendFile, getContents, getLine, interact,+                       putStr, putStrLn, readFile, writeFile)+import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,+                  withFile)+import qualified Control.Exception as E+import Control.Monad (liftM2, when)+import Data.IORef (readIORef, writeIORef)+import qualified Data.Text as T+import Data.Text.Internal.Fusion (stream)+import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))+import Data.Text.Internal.IO (hGetLineWith, readChunk)+import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,+                      RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,+                      writeCharBuf)+import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))+import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,+                                wantWritableHandle)+import GHC.IO.Handle.Text (commitBuffer')+import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),+                            HandleType(..), Newline(..))+import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)+import System.IO.Error (isEOFError)++-- $performance+-- #performance#+--+-- The functions in this module obey the runtime system's locale,+-- character set encoding, and line ending conversion settings.+--+-- If you know in advance that you will be working with data that has+-- a specific encoding (e.g. UTF-8), and your application is highly+-- performance sensitive, you may find that it is faster to perform+-- I\/O with bytestrings and to encode and decode yourself than to use+-- the functions in this module.+--+-- Whether this will hold depends on the version of GHC you are using,+-- the platform you are working on, the data you are working with, and+-- the encodings you are using, so be sure to test for yourself.++-- | The 'readFile' function reads a file and returns the contents of+-- the file as a string.  The entire file is read strictly, as with+-- 'getContents'.+readFile :: FilePath -> IO Text+readFile name = openFile name ReadMode >>= hGetContents++-- | Write a string to a file.  The file is truncated to zero length+-- before writing begins.+writeFile :: FilePath -> Text -> IO ()+writeFile p = withFile p WriteMode . flip hPutStr++-- | Write a string the end of a file.+appendFile :: FilePath -> Text -> IO ()+appendFile p = withFile p AppendMode . flip hPutStr++catchError :: String -> Handle -> Handle__ -> IOError -> IO (Text, Bool)+catchError caller h Handle__{..} err+    | isEOFError err = do+        buf <- readIORef haCharBuffer+        return $ if isEmptyBuffer buf+                 then (T.empty, True)+                 else (T.singleton '\r', True)+    | otherwise = E.throwIO (augmentIOError err caller h)++-- | Wrap readChunk and return a value indicating if we're reached the EOF.+-- This is needed because unpack_nl is unable to discern the difference+-- between a buffer with just \r due to EOF or because not enough data was left+-- for decoding. e.g. the final character decoded from the byte buffer was \r.+readChunkEof :: Handle__ -> CharBuffer -> IO (Text, Bool)+readChunkEof hh buf = do t <- readChunk hh buf+                         return (t, False)++-- | /Experimental./ Read a single chunk of strict text from a+-- 'Handle'. The size of the chunk depends on the amount of input+-- currently buffered.+--+-- This function blocks only if there is no data available, and EOF+-- has not yet been reached. Once EOF is reached, this function+-- returns an empty string instead of throwing an exception.+hGetChunk :: Handle -> IO Text+hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk+ where+  readSingleChunk hh@Handle__{..} = do+    buf <- readIORef haCharBuffer+    (t, _) <- readChunkEof hh buf `E.catch` catchError "hGetChunk" h hh+    return (hh, t)++-- | Read the remaining contents of a 'Handle' as a string.  The+-- 'Handle' is closed once the contents have been read, or if an+-- exception is thrown.+--+-- Internally, this function reads a chunk at a time from the+-- lower-level buffering abstraction, and concatenates the chunks into+-- a single string once the entire file has been read.+--+-- As a result, it requires approximately twice as much memory as its+-- result to construct its result.  For files more than a half of+-- available RAM in size, this may result in memory exhaustion.+hGetContents :: Handle -> IO Text+hGetContents h = do+  chooseGoodBuffering h+  wantReadableHandle "hGetContents" h readAll+ where+  readAll hh@Handle__{..} = do+    let readChunks = do+          buf <- readIORef haCharBuffer+          (t, eof) <- readChunkEof hh buf+                         `E.catch` catchError "hGetContents" h hh+          if eof+            then return [t]+            else (t:) `fmap` readChunks+    ts <- readChunks+    (hh', _) <- hClose_help hh+    return (hh'{haType=ClosedHandle}, T.concat ts)++-- | Use a more efficient buffer size if we're reading in+-- block-buffered mode with the default buffer size.  When we can+-- determine the size of the handle we're reading, set the buffer size+-- to that, so that we can read the entire file in one chunk.+-- Otherwise, use a buffer size of at least 16KB.+chooseGoodBuffering :: Handle -> IO ()+chooseGoodBuffering h = do+  bufMode <- hGetBuffering h+  case bufMode of+    BlockBuffering Nothing -> do+      d <- E.catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->+           if ioe_type e == InappropriateType+           then return 16384 -- faster than the 2KB default+           else E.throwIO e+      when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d+    _ -> return ()++-- | Read a single line from a handle.+hGetLine :: Handle -> IO Text+hGetLine = hGetLineWith T.concat++-- | Write a string to a handle.+hPutStr :: Handle -> Text -> IO ()+-- This function is lifted almost verbatim from GHC.IO.Handle.Text.+hPutStr h t = do+  (buffer_mode, nl) <-+       wantWritableHandle "hPutStr" h $ \h_ -> do+                     bmode <- getSpareBuffer h_+                     return (bmode, haOutputNL h_)+  let str = stream t+  case buffer_mode of+     (NoBuffering, _)        -> hPutChars h str+     (LineBuffering, buf)    -> writeLines h nl buf str+     (BlockBuffering _, buf)+         | nl == CRLF        -> writeBlocksCRLF h buf str+         | otherwise         -> writeBlocksRaw h buf str++hPutChars :: Handle -> Stream Char -> IO ()+hPutChars h (Stream next0 s0 _len) = loop s0+  where+    loop !s = case next0 s of+                Done       -> return ()+                Skip s'    -> loop s'+                Yield x s' -> hPutChar h x >> loop s'++-- The following functions are largely lifted from GHC.IO.Handle.Text,+-- but adapted to a coinductive stream of data instead of an inductive+-- list.+--+-- We have several variations of more or less the same code for+-- performance reasons.  Splitting the original buffered write+-- function into line- and block-oriented versions gave us a 2.1x+-- performance improvement.  Lifting out the raw/cooked newline+-- handling gave a few more percent on top.++writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()+writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0+ where+  outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)+   where+    inner !s !n =+      case next0 s of+        Done -> commit n False{-no flush-} True{-release-} >> return ()+        Skip s' -> inner s' n+        Yield x s'+          | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s+          | x == '\n'    -> do+                   n' <- if nl == CRLF+                         then do n1 <- writeCharBuf raw n '\r'+                                 writeCharBuf raw n1 '\n'+                         else writeCharBuf raw n x+                   commit n' True{-needs flush-} False >>= outer s'+          | otherwise    -> writeCharBuf raw n x >>= inner s'+    commit = commitBuffer h raw len++writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()+writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0+ where+  outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)+   where+    inner !s !n =+      case next0 s of+        Done -> commit n False{-no flush-} True{-release-} >> return ()+        Skip s' -> inner s' n+        Yield x s'+          | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s+          | x == '\n'    -> do n1 <- writeCharBuf raw n '\r'+                               writeCharBuf raw n1 '\n' >>= inner s'+          | otherwise    -> writeCharBuf raw n x >>= inner s'+    commit = commitBuffer h raw len++writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()+writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0+ where+  outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)+   where+    inner !s !n =+      case next0 s of+        Done -> commit n False{-no flush-} True{-release-} >> return ()+        Skip s' -> inner s' n+        Yield x s'+          | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s+          | otherwise    -> writeCharBuf raw n x >>= inner s'+    commit = commitBuffer h raw len++-- This function is completely lifted from GHC.IO.Handle.Text.+getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)+getSpareBuffer Handle__{haCharBuffer=ref,+                        haBuffers=spare_ref,+                        haBufferMode=mode}+ = do+   case mode of+     NoBuffering -> return (mode, error "no buffer!")+     _ -> do+          bufs <- readIORef spare_ref+          buf  <- readIORef ref+          case bufs of+            BufferListCons b rest -> do+                writeIORef spare_ref rest+                return ( mode, emptyBuffer b (bufSize buf) WriteBuffer)+            BufferListNil -> do+                new_buf <- newCharBuffer (bufSize buf) WriteBuffer+                return (mode, new_buf)+++-- This function is completely lifted from GHC.IO.Handle.Text.+commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool+             -> IO CharBuffer+commitBuffer hdl !raw !sz !count flush release =+  wantWritableHandle "commitAndReleaseBuffer" hdl $+     commitBuffer' raw sz count flush release+{-# INLINE commitBuffer #-}++-- | Write a string to a handle, followed by a newline.+hPutStrLn :: Handle -> Text -> IO ()+hPutStrLn h t = hPutStr h t >> hPutChar h '\n'++-- | The 'interact' function takes a function of type @Text -> Text@+-- as its argument. The entire input from the standard input device is+-- passed to this function as its argument, and the resulting string+-- is output on the standard output device.+interact :: (Text -> Text) -> IO ()+interact f = putStr . f =<< getContents++-- | Read all user input on 'stdin' as a single string.+getContents :: IO Text+getContents = hGetContents stdin++-- | Read a single line of user input from 'stdin'.+getLine :: IO Text+getLine = hGetLine stdin++-- | Write a string to 'stdout'.+putStr :: Text -> IO ()+putStr = hPutStr stdout++-- | Write a string to 'stdout', followed by a newline.+putStrLn :: Text -> IO ()+putStrLn = hPutStrLn stdout++-- $locale+--+-- /Note/: The behaviour of functions in this module depends on the+-- version of GHC you are using.+--+-- Beginning with GHC 6.12, text I\/O is performed using the system or+-- handle's current locale and line ending conventions.+--+-- Under GHC 6.10 and earlier, the system I\/O libraries do not+-- support locale-sensitive I\/O or line ending conversion.  On these+-- versions of GHC, functions in this library all use UTF-8.  What+-- does this mean in practice?+--+-- * All data that is read will be decoded as UTF-8.+--+-- * Before data is written, it is first encoded as UTF-8.+--+-- * On both reading and writing, the platform's native newline+--   conversion is performed.+--+-- If you must use a non-UTF-8 locale on an older version of GHC, you+-- will have to perform the transcoding yourself, e.g. as follows:+--+-- > import qualified Data.ByteString as B+-- > import Data.Text (Text)+-- > import Data.Text.Encoding (encodeUtf16)+-- >+-- > putStr_Utf16LE :: Text -> IO ()+-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)+--+-- On transcoding errors, an 'IOError' exception is thrown. You can+-- use the API in "Data.Text.Encoding" if you need more control over+-- error handling or transcoding.
+ src/Data/Text/Internal.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}+{-# OPTIONS_HADDOCK not-home #-}++-- |+-- Module      : Data.Text.Internal+-- Copyright   : (c) 2008, 2009 Tom Harper,+--               (c) 2009, 2010 Bryan O'Sullivan,+--               (c) 2009 Duncan Coutts+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- A module containing private 'Text' internals. This exposes the+-- 'Text' representation and low level construction functions.+-- Modules which extend the 'Text' system may need to use this module.+--+-- You should not use this module unless you are determined to monkey+-- with the internals, as the functions here do just about nothing to+-- preserve data invariants.  You have been warned!++#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)+#include "MachDeps.h"+#endif++module Data.Text.Internal+    (+    -- * Types+    -- $internals+      Text(..)+    -- * Construction+    , text+    , textP+    -- * Safety+    , safe+    -- * Code that must be here for accessibility+    , empty+    , empty_+    -- * Utilities+    , firstf+    -- * Checked multiplication+    , mul+    , mul32+    , mul64+    -- * Debugging+    , showText+    ) where++#if defined(ASSERTS)+import Control.Exception (assert)+#endif+import Data.Bits+import Data.Int (Int32, Int64)+import Data.Text.Internal.Unsafe.Char (ord)+import Data.Typeable (Typeable)+import qualified Data.Text.Array as A++-- | A space efficient, packed, unboxed Unicode text type.+data Text = Text+    {-# UNPACK #-} !A.Array          -- payload (Word16 elements)+    {-# UNPACK #-} !Int              -- offset (units of Word16, not Char)+    {-# UNPACK #-} !Int              -- length (units of Word16, not Char)+    deriving (Typeable)++-- | Smart constructor.+text_ :: A.Array -> Int -> Int -> Text+text_ arr off len =+#if defined(ASSERTS)+  let c    = A.unsafeIndex arr off+      alen = A.length arr+  in assert (len >= 0) .+     assert (off >= 0) .+     assert (alen == 0 || len == 0 || off < alen) .+     assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $+#endif+     Text arr off len+{-# INLINE text_ #-}++-- | /O(1)/ The empty 'Text'.+empty :: Text+empty = Text A.empty 0 0+{-# INLINE [1] empty #-}++-- | A non-inlined version of 'empty'.+empty_ :: Text+empty_ = Text A.empty 0 0+{-# NOINLINE empty_ #-}++-- | Construct a 'Text' without invisibly pinning its byte array in+-- memory if its length has dwindled to zero.+text :: A.Array -> Int -> Int -> Text+text arr off len | len == 0  = empty+                 | otherwise = text_ arr off len+{-# INLINE text #-}++textP :: A.Array -> Int -> Int -> Text+{-# DEPRECATED textP "Use text instead" #-}+textP = text++-- | A useful 'show'-like function for debugging purposes.+showText :: Text -> String+showText (Text arr off len) =+    "Text " ++ show (A.toList arr off len) ++ ' ' :+            show off ++ ' ' : show len++-- | Map a 'Char' to a 'Text'-safe value.+--+-- UTF-16 surrogate code points are not included in the set of Unicode+-- scalar values, but are unfortunately admitted as valid 'Char'+-- values by Haskell.  They cannot be represented in a 'Text'.  This+-- function remaps those code points to the Unicode replacement+-- character (U+FFFD, \'&#xfffd;\'), and leaves other code points+-- unchanged.+safe :: Char -> Char+safe c+    | ord c .&. 0x1ff800 /= 0xd800 = c+    | otherwise                    = '\xfffd'+{-# INLINE [0] safe #-}++-- | Apply a function to the first element of an optional pair.+firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)+firstf f (Just (a, b)) = Just (f a, b)+firstf _  Nothing      = Nothing++-- | Checked multiplication.  Calls 'error' if the result would+-- overflow.+mul :: Int -> Int -> Int+#if WORD_SIZE_IN_BITS == 64+mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b+#else+mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b+#endif+{-# INLINE mul #-}+infixl 7 `mul`++-- | Checked multiplication.  Calls 'error' if the result would+-- overflow.+mul64 :: Int64 -> Int64 -> Int64+mul64 a b+  | a >= 0 && b >= 0 =  mul64_ a b+  | a >= 0           = -mul64_ a (-b)+  | b >= 0           = -mul64_ (-a) b+  | otherwise        =  mul64_ (-a) (-b)+{-# INLINE mul64 #-}+infixl 7 `mul64`++mul64_ :: Int64 -> Int64 -> Int64+mul64_ a b+  | ahi > 0 && bhi > 0 = error "overflow"+  | top > 0x7fffffff   = error "overflow"+  | total < 0          = error "overflow"+  | otherwise          = total+  where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)+        (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)+        top            = ahi * blo + alo * bhi+        total          = (top `shiftL` 32) + alo * blo+{-# INLINE mul64_ #-}++-- | Checked multiplication.  Calls 'error' if the result would+-- overflow.+mul32 :: Int32 -> Int32 -> Int32+mul32 a b = case fromIntegral a * fromIntegral b of+              ab | ab < min32 || ab > max32 -> error "overflow"+                 | otherwise                -> fromIntegral ab+  where min32 = -0x80000000 :: Int64+        max32 =  0x7fffffff+{-# INLINE mul32 #-}+infixl 7 `mul32`++-- $internals+--+-- Internally, the 'Text' type is represented as an array of 'Word16'+-- UTF-16 code units. The offset and length fields in the constructor+-- are in these units, /not/ units of 'Char'.+--+-- Invariants that all functions must maintain:+--+-- * Since the 'Text' type uses UTF-16 internally, it cannot represent+--   characters in the reserved surrogate code point range U+D800 to+--   U+DFFF. To maintain this invariant, the 'safe' function maps+--   'Char' values in this range to the replacement character (U+FFFD,+--   \'&#xfffd;\').+--+-- * A leading (or \"high\") surrogate code unit (0xD800–0xDBFF) must+--   always be followed by a trailing (or \"low\") surrogate code unit+--   (0xDC00-0xDFFF). A trailing surrogate code unit must always be+--   preceded by a leading surrogate code unit.
+ src/Data/Text/Internal/Builder.hs view
@@ -0,0 +1,329 @@+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}+{-# OPTIONS_HADDOCK not-home #-}++-----------------------------------------------------------------------------+-- |+-- Module      : Data.Text.Internal.Builder+-- Copyright   : (c) 2013 Bryan O'Sullivan+--               (c) 2010 Johan Tibell+-- License     : BSD-style (see LICENSE)+--+-- Maintainer  : Johan Tibell <johan.tibell@gmail.com>+-- Stability   : experimental+-- Portability : portable to Hugs and GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Efficient construction of lazy @Text@ values.  The principal+-- operations on a @Builder@ are @singleton@, @fromText@, and+-- @fromLazyText@, which construct new builders, and 'mappend', which+-- concatenates two builders.+--+-- To get maximum performance when building lazy @Text@ values using a+-- builder, associate @mappend@ calls to the right.  For example,+-- prefer+--+-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')+--+-- to+--+-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'+--+-- as the latter associates @mappend@ to the left.+--+-----------------------------------------------------------------------------++module Data.Text.Internal.Builder+   ( -- * Public API+     -- ** The Builder type+     Builder+   , toLazyText+   , toLazyTextWith++     -- ** Constructing Builders+   , singleton+   , fromText+   , fromLazyText+   , fromString++     -- ** Flushing the buffer state+   , flush++     -- * Internal functions+   , append'+   , ensureFree+   , writeN+   ) where++import Control.Monad.ST (ST, runST)+import Data.Monoid (Monoid(..))+#if !MIN_VERSION_base(4,11,0) && MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup(..))+#endif+import Data.Text.Internal (Text(..))+import Data.Text.Internal.Lazy (smallChunkSize)+import Data.Text.Unsafe (inlineInterleaveST)+import Data.Text.Internal.Unsafe.Char (unsafeWrite)+import Prelude hiding (map, putChar)++import qualified Data.String as String+import qualified Data.Text as S+import qualified Data.Text.Array as A+import qualified Data.Text.Lazy as L++------------------------------------------------------------------------++-- | A @Builder@ is an efficient way to build lazy @Text@ values.+-- There are several functions for constructing builders, but only one+-- to inspect them: to extract any data, you have to turn them into+-- lazy @Text@ values using @toLazyText@.+--+-- Internally, a builder constructs a lazy @Text@ by filling arrays+-- piece by piece.  As each buffer is filled, it is \'popped\' off, to+-- become a new chunk of the resulting lazy @Text@.  All this is+-- hidden from the user of the @Builder@.+newtype Builder = Builder {+     -- Invariant (from Data.Text.Lazy):+     --      The lists include no null Texts.+     runBuilder :: forall s. (Buffer s -> ST s [S.Text])+                -> Buffer s+                -> ST s [S.Text]+   }++#if MIN_VERSION_base(4,9,0)+instance Semigroup Builder where+   (<>) = append+   {-# INLINE (<>) #-}+#endif++instance Monoid Builder where+   mempty  = empty+   {-# INLINE mempty #-}+#if MIN_VERSION_base(4,9,0)+   mappend = (<>) -- future-proof definition+#else+   mappend = append+#endif+   {-# INLINE mappend #-}+   mconcat = foldr mappend Data.Monoid.mempty+   {-# INLINE mconcat #-}++instance String.IsString Builder where+    fromString = fromString+    {-# INLINE fromString #-}++instance Show Builder where+    show = show . toLazyText++instance Eq Builder where+    a == b = toLazyText a == toLazyText b++instance Ord Builder where+    a <= b = toLazyText a <= toLazyText b++------------------------------------------------------------------------++-- | /O(1)./ The empty @Builder@, satisfying+--+--  * @'toLazyText' 'empty' = 'L.empty'@+--+empty :: Builder+empty = Builder (\ k buf -> k buf)+{-# INLINE empty #-}++-- | /O(1)./ A @Builder@ taking a single character, satisfying+--+--  * @'toLazyText' ('singleton' c) = 'L.singleton' c@+--+singleton :: Char -> Builder+singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c+{-# INLINE singleton #-}++------------------------------------------------------------------------++-- | /O(1)./ The concatenation of two builders, an associative+-- operation with identity 'empty', satisfying+--+--  * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@+--+append :: Builder -> Builder -> Builder+append (Builder f) (Builder g) = Builder (f . g)+{-# INLINE [0] append #-}++-- TODO: Experiment to find the right threshold.+copyLimit :: Int+copyLimit = 128++-- This function attempts to merge small @Text@ values instead of+-- treating each value as its own chunk.  We may not always want this.++-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying+--+--  * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@+--+fromText :: S.Text -> Builder+fromText t@(Text arr off l)+    | S.null t       = empty+    | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)+    | otherwise      = flush `append` mapBuilder (t :)+{-# INLINE [1] fromText #-}++{-# RULES+"fromText/pack" forall s .+        fromText (S.pack s) = fromString s+ #-}++-- | /O(1)./ A Builder taking a @String@, satisfying+--+--  * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@+--+fromString :: String -> Builder+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->+    let loop !marr !o !u !l [] = k (Buffer marr o u l)+        loop marr o u l s@(c:cs)+            | l <= 1 = do+                arr <- A.unsafeFreeze marr+                let !t = Text arr o u+                marr' <- A.new chunkSize+                ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)+                return $ t : ts+            | otherwise = do+                n <- unsafeWrite marr (o+u) c+                loop marr o (u+n) (l-n) cs+    in loop p0 o0 u0 l0 str+  where+    chunkSize = smallChunkSize+{-# INLINE fromString #-}++-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying+--+--  * @'toLazyText' ('fromLazyText' t) = t@+--+fromLazyText :: L.Text -> Builder+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)+{-# INLINE fromLazyText #-}++------------------------------------------------------------------------++-- Our internal buffer type+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)+                       {-# UNPACK #-} !Int  -- offset+                       {-# UNPACK #-} !Int  -- used units+                       {-# UNPACK #-} !Int  -- length left++------------------------------------------------------------------------++-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default+-- buffer size.  The construction work takes place if and when the+-- relevant part of the lazy @Text@ is demanded.+toLazyText :: Builder -> L.Text+toLazyText = toLazyTextWith smallChunkSize++-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given+-- size for the initial buffer.  The construction work takes place if+-- and when the relevant part of the lazy @Text@ is demanded.+--+-- If the initial buffer is too small to hold all data, subsequent+-- buffers will be the default buffer size.+toLazyTextWith :: Int -> Builder -> L.Text+toLazyTextWith chunkSize m = L.fromChunks (runST $+  newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))++-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,+-- yielding a new chunk in the result lazy @Text@.+flush :: Builder+flush = Builder $ \ k buf@(Buffer p o u l) ->+    if u == 0+    then k buf+    else do arr <- A.unsafeFreeze p+            let !b = Buffer p (o+u) 0 l+                !t = Text arr o u+            ts <- inlineInterleaveST (k b)+            return $! t : ts+{-# INLINE [1] flush #-}+-- defer inlining so that flush/flush rule may fire.++------------------------------------------------------------------------++-- | Sequence an ST operation on the buffer+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder+withBuffer f = Builder $ \k buf -> f buf >>= k+{-# INLINE withBuffer #-}++-- | Get the size of the buffer+withSize :: (Int -> Builder) -> Builder+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->+    runBuilder (f l) k buf+{-# INLINE withSize #-}++-- | Map the resulting list of texts.+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder+mapBuilder f = Builder (fmap f .)++------------------------------------------------------------------------++-- | Ensure that there are at least @n@ many elements available.+ensureFree :: Int -> Builder+ensureFree !n = withSize $ \ l ->+    if n <= l+    then empty+    else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))+{-# INLINE [0] ensureFree #-}++writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)+{-# INLINE [0] writeAtMost #-}++-- | Ensure that @n@ many elements are available, and then use @f@ to+-- write some elements into the memory.+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder+writeN n f = writeAtMost n (\ p o -> f p o >> return n)+{-# INLINE writeN #-}++writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)+writeBuffer f (Buffer p o u l) = do+    n <- f p (o+u)+    return $! Buffer p o (u+n) (l-n)+{-# INLINE writeBuffer #-}++newBuffer :: Int -> ST s (Buffer s)+newBuffer size = do+    arr <- A.new size+    return $! Buffer arr 0 0 size+{-# INLINE newBuffer #-}++------------------------------------------------------------------------+-- Some nice rules for Builder++-- This function makes GHC understand that 'writeN' and 'ensureFree'+-- are *not* recursive in the precense of the rewrite rules below.+-- This is not needed with GHC 7+.+append' :: Builder -> Builder -> Builder+append' (Builder f) (Builder g) = Builder (f . g)+{-# INLINE append' #-}++{-# RULES++"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)+                           (g::forall s. A.MArray s -> Int -> ST s Int) ws.+    append (writeAtMost a f) (append (writeAtMost b g) ws) =+        append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->+                                    g marr (o+n) >>= \ m ->+                                    let s = n+m in s `seq` return s)) ws++"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)+                           (g::forall s. A.MArray s -> Int -> ST s Int).+    append (writeAtMost a f) (writeAtMost b g) =+        writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->+                            g marr (o+n) >>= \ m ->+                            let s = n+m in s `seq` return s)++"ensureFree/ensureFree" forall a b .+    append (ensureFree a) (ensureFree b) = ensureFree (max a b)++"flush/flush"+    append flush flush = flush++ #-}
+ src/Data/Text/Internal/Builder/Functions.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE MagicHash #-}++-- |+-- Module      : Data.Text.Internal.Builder.Functions+-- Copyright   : (c) 2011 MailRank, Inc.+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Useful functions and combinators.++module Data.Text.Internal.Builder.Functions+    (+      (<>)+    , i2d+    ) where++import Data.Monoid (mappend)+import Data.Text.Lazy.Builder (Builder)+import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))+import Prelude ()++-- | Unsafe conversion for decimal digits.+{-# INLINE i2d #-}+i2d :: Int -> Char+i2d (I# i#) = C# (chr# (ord# '0'# +# i#))++-- | The normal 'mappend' function with right associativity instead of+-- left.+(<>) :: Builder -> Builder -> Builder+(<>) = mappend+{-# INLINE (<>) #-}++infixr 4 <>
+ src/Data/Text/Internal/Builder/Int/Digits.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}++-- Module:      Data.Text.Internal.Builder.Int.Digits+-- Copyright:   (c) 2013 Bryan O'Sullivan+-- License:     BSD-style+-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>+-- Stability:   experimental+-- Portability: portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- This module exists because the C preprocessor does things that we+-- shall not speak of when confronted with Haskell multiline strings.++module Data.Text.Internal.Builder.Int.Digits (digits) where++import Data.ByteString.Char8 (ByteString)++digits :: ByteString+digits = "0001020304050607080910111213141516171819\+         \2021222324252627282930313233343536373839\+         \4041424344454647484950515253545556575859\+         \6061626364656667686970717273747576777879\+         \8081828384858687888990919293949596979899"
+ src/Data/Text/Internal/Builder/RealFloat/Functions.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE CPP #-}++-- |+-- Module:    Data.Text.Internal.Builder.RealFloat.Functions+-- Copyright: (c) The University of Glasgow 1994-2002+-- License:   see libraries/base/LICENSE+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!++module Data.Text.Internal.Builder.RealFloat.Functions+    (+      roundTo+    ) where++roundTo :: Int -> [Int] -> (Int,[Int])++#if MIN_VERSION_base(4,6,0)++roundTo d is =+  case f d True is of+    x@(0,_) -> x+    (1,xs)  -> (1, 1:xs)+    _       -> error "roundTo: bad Value"+ where+  b2 = base `quot` 2++  f n _ []     = (0, replicate n 0)+  f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, [])   -- Round to even when at exactly half the base+               | otherwise = (if x >= b2 then 1 else 0, [])+  f n _ (i:xs)+     | i' == base = (1,0:ds)+     | otherwise  = (0,i':ds)+      where+       (c,ds) = f (n-1) (even i) xs+       i'     = c + i+  base = 10++#else++roundTo d is =+  case f d is of+    x@(0,_) -> x+    (1,xs)  -> (1, 1:xs)+    _       -> error "roundTo: bad Value"+ where+  f n []     = (0, replicate n 0)+  f 0 (x:_)  = (if x >= 5 then 1 else 0, [])+  f n (i:xs)+     | i' == 10  = (1,0:ds)+     | otherwise = (0,i':ds)+      where+       (c,ds) = f (n-1) xs+       i'     = c + i++#endif
+ src/Data/Text/Internal/ByteStringCompat.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+module Data.Text.Internal.ByteStringCompat (mkBS, withBS) where++import Data.ByteString.Internal (ByteString (..))+import Data.Word (Word8)+import Foreign.ForeignPtr (ForeignPtr)++#if !MIN_VERSION_bytestring(0,11,0)+#if MIN_VERSION_base(4,10,0)+import GHC.ForeignPtr (plusForeignPtr)+#else+import GHC.ForeignPtr (ForeignPtr(ForeignPtr))+import GHC.Types (Int (..))+import GHC.Prim (plusAddr#)+#endif+#endif++mkBS :: ForeignPtr Word8 -> Int -> ByteString+#if MIN_VERSION_bytestring(0,11,0)+mkBS dfp n = BS dfp n+#else+mkBS dfp n = PS dfp 0 n+#endif+{-# INLINE mkBS #-}++withBS :: ByteString -> (ForeignPtr Word8 -> Int -> r) -> r+#if MIN_VERSION_bytestring(0,11,0)+withBS (BS !sfp !slen)       kont = kont sfp slen+#else+withBS (PS !sfp !soff !slen) kont = kont (plusForeignPtr sfp soff) slen+#endif+{-# INLINE withBS #-}++#if !MIN_VERSION_bytestring(0,11,0)+#if !MIN_VERSION_base(4,10,0)+-- |Advances the given address by the given offset in bytes.+--+-- The new 'ForeignPtr' shares the finalizer of the original,+-- equivalent from a finalization standpoint to just creating another+-- reference to the original. That is, the finalizer will not be+-- called before the new 'ForeignPtr' is unreachable, nor will it be+-- called an additional time due to this call, and the finalizer will+-- be called with the same address that it would have had this call+-- not happened, *not* the new address.+plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b+plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts+{-# INLINE [0] plusForeignPtr #-}+{-# RULES+"ByteString plusForeignPtr/0" forall fp .+   plusForeignPtr fp 0 = fp+ #-}+#endif+#endif
+ src/Data/Text/Internal/Encoding/Fusion.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}++-- |+-- Module      : Data.Text.Internal.Encoding.Fusion+-- Copyright   : (c) Tom Harper 2008-2009,+--               (c) Bryan O'Sullivan 2009,+--               (c) Duncan Coutts 2009+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fusible 'Stream'-oriented functions for converting between 'Text'+-- and several common encodings.++module Data.Text.Internal.Encoding.Fusion+    (+    -- * Streaming+      streamASCII+    , streamUtf8+    , streamUtf16LE+    , streamUtf16BE+    , streamUtf32LE+    , streamUtf32BE++    -- * Unstreaming+    , unstream++    , module Data.Text.Internal.Encoding.Fusion.Common+    ) where++#if defined(ASSERTS)+import Control.Exception (assert)+#endif+import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)+import Data.Text.Internal.Fusion (Step(..), Stream(..))+import Data.Text.Internal.Fusion.Size+import Data.Text.Encoding.Error+import Data.Text.Internal.Encoding.Fusion.Common+import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)+import Data.Word (Word8, Word16, Word32)+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)+import Foreign.Storable (pokeByteOff)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import qualified Data.Text.Internal.Encoding.Utf8 as U8+import qualified Data.Text.Internal.Encoding.Utf16 as U16+import qualified Data.Text.Internal.Encoding.Utf32 as U32+import Data.Text.Unsafe (unsafeDupablePerformIO)+import Data.Text.Internal.ByteStringCompat++streamASCII :: ByteString -> Stream Char+streamASCII bs = Stream next 0 (maxSize l)+    where+      l = B.length bs+      {-# INLINE next #-}+      next i+          | i >= l    = Done+          | otherwise = Yield (unsafeChr8 x1) (i+1)+          where+            x1 = B.unsafeIndex bs i+{-# DEPRECATED streamASCII "Do not use this function" #-}+{-# INLINE [0] streamASCII #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8+-- encoding.+streamUtf8 :: OnDecodeError -> ByteString -> Stream Char+streamUtf8 onErr bs = Stream next 0 (maxSize l)+    where+      l = B.length bs+      next i+          | i >= l = Done+          | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)+          | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)+          | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)+          | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)+          | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)+          where+            x1 = idx i+            x2 = idx (i + 1)+            x3 = idx (i + 2)+            x4 = idx (i + 3)+            idx = B.unsafeIndex bs+{-# INLINE [0] streamUtf8 #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-16 encoding.+streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char+streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))+    where+      l = B.length bs+      {-# INLINE next #-}+      next i+          | i >= l                         = Done+          | i+1 < l && U16.validate1 x1    = Yield (unsafeChr x1) (i+2)+          | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)+          | otherwise = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing (i+1)+          where+            x1    = idx i       + (idx (i + 1) `shiftL` 8)+            x2    = idx (i + 2) + (idx (i + 3) `shiftL` 8)+            idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16+{-# INLINE [0] streamUtf16LE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-16 encoding.+streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char+streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))+    where+      l = B.length bs+      {-# INLINE next #-}+      next i+          | i >= l                         = Done+          | i+1 < l && U16.validate1 x1    = Yield (unsafeChr x1) (i+2)+          | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)+          | otherwise = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing (i+1)+          where+            x1    = (idx i `shiftL` 8)       + idx (i + 1)+            x2    = (idx (i + 2) `shiftL` 8) + idx (i + 3)+            idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16+{-# INLINE [0] streamUtf16BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-32 encoding.+streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char+streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))+    where+      l = B.length bs+      {-# INLINE next #-}+      next i+          | i >= l                    = Done+          | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)+          | otherwise = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing (i+1)+          where+            x     = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4+            x1    = idx i+            x2    = idx (i+1)+            x3    = idx (i+2)+            x4    = idx (i+3)+            idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32+{-# INLINE [0] streamUtf32BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-32 encoding.+streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char+streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))+    where+      l = B.length bs+      {-# INLINE next #-}+      next i+          | i >= l                    = Done+          | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)+          | otherwise = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing (i+1)+          where+            x     = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1+            x1    = idx i+            x2    = idx $ i+1+            x3    = idx $ i+2+            x4    = idx $ i+3+            idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32+{-# INLINE [0] streamUtf32LE #-}++-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.+unstream :: Stream Word8 -> ByteString+unstream (Stream next s0 len) = unsafeDupablePerformIO $ do+    let mlen = upperBound 4 len+    mallocByteString mlen >>= loop mlen 0 s0+    where+      loop !n !off !s fp = case next s of+          Done -> trimUp fp n off+          Skip s' -> loop n off s' fp+          Yield x s'+              | off == n -> realloc fp n off s' x+              | otherwise -> do+            withForeignPtr fp $ \p -> pokeByteOff p off x+            loop n (off+1) s' fp+      {-# NOINLINE realloc #-}+      realloc fp n off s x = do+        let n' = n+n+        fp' <- copy0 fp n n'+        withForeignPtr fp' $ \p -> pokeByteOff p off x+        loop n' (off+1) s fp'+      {-# NOINLINE trimUp #-}+      trimUp fp _ off = return $! mkBS fp off+      copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)+      copy0 !src !srcLen !destLen =+#if defined(ASSERTS)+        assert (srcLen <= destLen) $+#endif+        do+          dest <- mallocByteString destLen+          withForeignPtr src  $ \src'  ->+              withForeignPtr dest $ \dest' ->+                  memcpy dest' src' (fromIntegral srcLen)+          return dest++decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8+            -> s -> Step s Char+decodeError func kind onErr mb i =+    case onErr desc mb of+      Nothing -> Skip i+      Just c  -> Yield c i+    where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " +++                 kind ++ " stream"
+ src/Data/Text/Internal/Encoding/Fusion/Common.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE BangPatterns #-}++-- |+-- Module      : Data.Text.Internal.Encoding.Fusion.Common+-- Copyright   : (c) Tom Harper 2008-2009,+--               (c) Bryan O'Sullivan 2009,+--               (c) Duncan Coutts 2009,+--               (c) Jasper Van der Jeugt 2011+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Use at your own risk!+--+-- Fusible 'Stream'-oriented functions for converting between 'Text'+-- and several common encodings.++module Data.Text.Internal.Encoding.Fusion.Common+    (+    -- * Restreaming+    -- Restreaming is the act of converting from one 'Stream'+    -- representation to another.+      restreamUtf16LE+    , restreamUtf16BE+    , restreamUtf32LE+    , restreamUtf32BE+    ) where++import Data.Bits ((.&.))+import Data.Text.Internal.Fusion (Step(..), Stream(..))+import Data.Text.Internal.Fusion.Types (RS(..))+import Data.Text.Internal.Unsafe.Char (ord)+import Data.Text.Internal.Unsafe.Shift (shiftR)+import Data.Word (Word8)++restreamUtf16BE :: Stream Char -> Stream Word8+restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)+  where+    next (RS0 s) = case next0 s of+        Done -> Done+        Skip s' -> Skip (RS0 s')+        Yield x s'+            | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $+                             RS1 s' (fromIntegral n)+            | otherwise   -> Yield c1 $ RS3 s' c2 c3 c4+            where+              n  = ord x+              n1 = n - 0x10000+              c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)+              c2 = fromIntegral (n1 `shiftR` 10)+              n2 = n1 .&. 0x3FF+              c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)+              c4 = fromIntegral n2+    next (RS1 s x2)       = Yield x2 (RS0 s)+    next (RS2 s x2 x3)    = Yield x2 (RS1 s x3)+    next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)+    {-# INLINE next #-}+{-# INLINE restreamUtf16BE #-}++restreamUtf16LE :: Stream Char -> Stream Word8+restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)+  where+    next (RS0 s) = case next0 s of+        Done -> Done+        Skip s' -> Skip (RS0 s')+        Yield x s'+            | n < 0x10000 -> Yield (fromIntegral n) $+                             RS1 s' (fromIntegral $ shiftR n 8)+            | otherwise   -> Yield c1 $ RS3 s' c2 c3 c4+          where+            n  = ord x+            n1 = n - 0x10000+            c2 = fromIntegral (shiftR n1 18 + 0xD8)+            c1 = fromIntegral (shiftR n1 10)+            n2 = n1 .&. 0x3FF+            c4 = fromIntegral (shiftR n2 8 + 0xDC)+            c3 = fromIntegral n2+    next (RS1 s x2)       = Yield x2 (RS0 s)+    next (RS2 s x2 x3)    = Yield x2 (RS1 s x3)+    next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)+    {-# INLINE next #-}+{-# INLINE restreamUtf16LE #-}++restreamUtf32BE :: Stream Char -> Stream Word8+restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)+  where+    next (RS0 s) = case next0 s of+        Done       -> Done+        Skip s'    -> Skip (RS0 s')+        Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)+          where+            n  = ord x+            c1 = fromIntegral $ shiftR n 24+            c2 = fromIntegral $ shiftR n 16+            c3 = fromIntegral $ shiftR n 8+            c4 = fromIntegral n+    next (RS1 s x2)       = Yield x2 (RS0 s)+    next (RS2 s x2 x3)    = Yield x2 (RS1 s x3)+    next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)+    {-# INLINE next #-}+{-# INLINE restreamUtf32BE #-}++restreamUtf32LE :: Stream Char -> Stream Word8+restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)+  where+    next (RS0 s) = case next0 s of+        Done       -> Done+        Skip s'    -> Skip (RS0 s')+        Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)+          where+            n  = ord x+            c4 = fromIntegral $ shiftR n 24+            c3 = fromIntegral $ shiftR n 16+            c2 = fromIntegral $ shiftR n 8+            c1 = fromIntegral n+    next (RS1 s x2)       = Yield x2 (RS0 s)+    next (RS2 s x2 x3)    = Yield x2 (RS1 s x3)+    next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)+    {-# INLINE next #-}+{-# INLINE restreamUtf32LE #-}
+ src/Data/Text/Internal/Encoding/Utf16.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE MagicHash, BangPatterns #-}++-- |+-- Module      : Data.Text.Internal.Encoding.Utf16+-- Copyright   : (c) 2008, 2009 Tom Harper,+--               (c) 2009 Bryan O'Sullivan,+--               (c) 2009 Duncan Coutts+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Basic UTF-16 validation and character manipulation.+module Data.Text.Internal.Encoding.Utf16+    (+      chr2+    , validate1+    , validate2+    ) where++import GHC.Exts+import GHC.Word (Word16(..))++chr2 :: Word16 -> Word16 -> Char+chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))+    where+      !x# = word2Int# a#+      !y# = word2Int# b#+      !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#+      !lower# = y# -# 0xDC00#+{-# INLINE chr2 #-}++validate1    :: Word16 -> Bool+validate1 x1 = x1 < 0xD800 || x1 > 0xDFFF+{-# INLINE validate1 #-}++validate2       ::  Word16 -> Word16 -> Bool+validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&+                  x2 >= 0xDC00 && x2 <= 0xDFFF+{-# INLINE validate2 #-}
+ src/Data/Text/Internal/Encoding/Utf32.hs view
@@ -0,0 +1,26 @@+-- |+-- Module      : Data.Text.Internal.Encoding.Utf32+-- Copyright   : (c) 2008, 2009 Tom Harper,+--               (c) 2009, 2010 Bryan O'Sullivan,+--               (c) 2009 Duncan Coutts+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Basic UTF-32 validation.+module Data.Text.Internal.Encoding.Utf32+    (+      validate+    ) where++import Data.Word (Word32)++validate    :: Word32 -> Bool+validate x1 = x1 < 0xD800 || (x1 > 0xDFFF && x1 <= 0x10FFFF)+{-# INLINE validate #-}
+ src/Data/Text/Internal/Encoding/Utf8.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE CPP, MagicHash, BangPatterns #-}++-- |+-- Module      : Data.Text.Internal.Encoding.Utf8+-- Copyright   : (c) 2008, 2009 Tom Harper,+--               (c) 2009, 2010 Bryan O'Sullivan,+--               (c) 2009 Duncan Coutts+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Basic UTF-8 validation and character manipulation.+module Data.Text.Internal.Encoding.Utf8+    (+    -- Decomposition+      ord2+    , ord3+    , ord4+    -- Construction+    , chr2+    , chr3+    , chr4+    -- * Validation+    , validate1+    , validate2+    , validate3+    , validate4+    ) where++#if defined(TEST_SUITE)+# undef ASSERTS+#endif++#if defined(ASSERTS)+import Control.Exception (assert)+#endif+import Data.Bits ((.&.))+import Data.Text.Internal.Unsafe.Char (ord)+import Data.Text.Internal.Unsafe.Shift (shiftR)+import GHC.Exts+import GHC.Word (Word8(..))++default(Int)++between :: Word8                -- ^ byte to check+        -> Word8                -- ^ lower bound+        -> Word8                -- ^ upper bound+        -> Bool+between x y z = x >= y && x <= z+{-# INLINE between #-}++ord2 :: Char -> (Word8,Word8)+ord2 c =+#if defined(ASSERTS)+    assert (n >= 0x80 && n <= 0x07ff)+#endif+    (x1,x2)+    where+      n  = ord c+      x1 = fromIntegral $ (n `shiftR` 6) + 0xC0+      x2 = fromIntegral $ (n .&. 0x3F)   + 0x80++ord3 :: Char -> (Word8,Word8,Word8)+ord3 c =+#if defined(ASSERTS)+    assert (n >= 0x0800 && n <= 0xffff)+#endif+    (x1,x2,x3)+    where+      n  = ord c+      x1 = fromIntegral $ (n `shiftR` 12) + 0xE0+      x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+      x3 = fromIntegral $ (n .&. 0x3F) + 0x80++ord4 :: Char -> (Word8,Word8,Word8,Word8)+ord4 c =+#if defined(ASSERTS)+    assert (n >= 0x10000)+#endif+    (x1,x2,x3,x4)+    where+      n  = ord c+      x1 = fromIntegral $ (n `shiftR` 18) + 0xF0+      x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80+      x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+      x4 = fromIntegral $ (n .&. 0x3F) + 0x80++chr2 :: Word8 -> Word8 -> Char+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))+    where+      !y1# = word2Int# x1#+      !y2# = word2Int# x2#+      !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#+      !z2# = y2# -# 0x80#+{-# INLINE chr2 #-}++chr3 :: Word8 -> Word8 -> Word8 -> Char+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))+    where+      !y1# = word2Int# x1#+      !y2# = word2Int# x2#+      !y3# = word2Int# x3#+      !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#+      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#+      !z3# = y3# -# 0x80#+{-# INLINE chr3 #-}++chr4             :: Word8 -> Word8 -> Word8 -> Word8 -> Char+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =+    C# (chr# (z1# +# z2# +# z3# +# z4#))+    where+      !y1# = word2Int# x1#+      !y2# = word2Int# x2#+      !y3# = word2Int# x3#+      !y4# = word2Int# x4#+      !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#+      !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#+      !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#+      !z4# = y4# -# 0x80#+{-# INLINE chr4 #-}++validate1 :: Word8 -> Bool+validate1 x1 = x1 <= 0x7F+{-# INLINE validate1 #-}++validate2 :: Word8 -> Word8 -> Bool+validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF+{-# INLINE validate2 #-}++validate3 :: Word8 -> Word8 -> Word8 -> Bool+{-# INLINE validate3 #-}+validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4+  where+    validate3_1 = (x1 == 0xE0) &&+                  between x2 0xA0 0xBF &&+                  between x3 0x80 0xBF+    validate3_2 = between x1 0xE1 0xEC &&+                  between x2 0x80 0xBF &&+                  between x3 0x80 0xBF+    validate3_3 = x1 == 0xED &&+                  between x2 0x80 0x9F &&+                  between x3 0x80 0xBF+    validate3_4 = between x1 0xEE 0xEF &&+                  between x2 0x80 0xBF &&+                  between x3 0x80 0xBF++validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool+{-# INLINE validate4 #-}+validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3+  where+    validate4_1 = x1 == 0xF0 &&+                  between x2 0x90 0xBF &&+                  between x3 0x80 0xBF &&+                  between x4 0x80 0xBF+    validate4_2 = between x1 0xF1 0xF3 &&+                  between x2 0x80 0xBF &&+                  between x3 0x80 0xBF &&+                  between x4 0x80 0xBF+    validate4_3 = x1 == 0xF4 &&+                  between x2 0x80 0x8F &&+                  between x3 0x80 0xBF &&+                  between x4 0x80 0xBF
+ src/Data/Text/Internal/Functions.hs view
@@ -0,0 +1,29 @@+-- |+-- Module      : Data.Text.Internal.Functions+-- Copyright   : 2010 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Useful functions.++module Data.Text.Internal.Functions+    (+      intersperse+    ) where++-- | A lazier version of Data.List.intersperse.  The other version+-- causes space leaks!+intersperse :: a -> [a] -> [a]+intersperse _   []     = []+intersperse sep (x:xs) = x : go xs+  where+    go []     = []+    go (y:ys) = sep : y: go ys+{-# INLINE intersperse #-}
+ src/Data/Text/Internal/Fusion.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE BangPatterns, MagicHash #-}++-- |+-- Module      : Data.Text.Internal.Fusion+-- Copyright   : (c) Tom Harper 2008-2009,+--               (c) Bryan O'Sullivan 2009-2010,+--               (c) Duncan Coutts 2009+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Text manipulation functions represented as fusible operations over+-- streams.+module Data.Text.Internal.Fusion+    (+    -- * Types+      Stream(..)+    , Step(..)++    -- * Creation and elimination+    , stream+    , unstream+    , reverseStream++    , length++    -- * Transformations+    , reverse++    -- * Construction+    -- ** Scans+    , reverseScanr++    -- ** Accumulating maps+    , mapAccumL++    -- ** Generation and unfolding+    , unfoldrN++    -- * Indexing+    , index+    , findIndex+    , countChar+    ) where++import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,+                Num(..), Ord(..), ($), (&&),+                fromIntegral, otherwise)+import Data.Bits ((.&.))+import Data.Text.Internal (Text(..))+import Data.Text.Internal.Private (runText)+import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)+import qualified Data.Text.Array as A+import qualified Data.Text.Internal.Fusion.Common as S+import Data.Text.Internal.Fusion.Types+import Data.Text.Internal.Fusion.Size+import qualified Data.Text.Internal as I+import qualified Data.Text.Internal.Encoding.Utf16 as U16++default(Int)++-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.+stream :: Text -> Stream Char+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)+    where+      !end = off+len+      next !i+          | i >= end                   = Done+          | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)+          | otherwise                  = Yield (unsafeChr n) (i + 1)+          where+            n  = A.unsafeIndex arr i+            n2 = A.unsafeIndex arr (i + 1)+{-# INLINE [0] stream #-}++-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate+-- backwards.+reverseStream :: Text -> Stream Char+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)+    where+      {-# INLINE next #-}+      next !i+          | i < off                    = Done+          | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)+          | otherwise                  = Yield (unsafeChr n) (i - 1)+          where+            n  = A.unsafeIndex arr i+            n2 = A.unsafeIndex arr (i - 1)+{-# INLINE [0] reverseStream #-}++-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.+unstream :: Stream Char -> Text+unstream (Stream next0 s0 len) = runText $ \done -> do+  -- Before encoding each char we perform a buffer realloc check assuming+  -- worst case encoding size of two 16-bit units for the char. Just add an+  -- extra space to the buffer so that we do not end up reallocating even when+  -- all the chars are encoded as single unit.+  let mlen = upperBound 4 len + 1+  arr0 <- A.new mlen+  let outer !arr !maxi = encode+       where+        -- keep the common case loop as small as possible+        encode !si !di =+            case next0 si of+                Done        -> done arr di+                Skip si'    -> encode si' di+                Yield c si'+                    -- simply check for the worst case+                    | maxi < di + 1 -> realloc si di+                    | otherwise -> do+                            n <- unsafeWrite arr di c+                            encode si' (di + n)++        -- keep uncommon case separate from the common case code+        {-# NOINLINE realloc #-}+        realloc !si !di = do+            let newlen = (maxi + 1) * 2+            arr' <- A.new newlen+            A.copyM arr' 0 arr 0 di+            outer arr' (newlen - 1) si di++  outer arr0 (mlen - 1) s0 0+{-# INLINE [0] unstream #-}+{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}+++-- ----------------------------------------------------------------------------+-- * Basic stream functions++length :: Stream Char -> Int+length = S.lengthI+{-# INLINE[0] length #-}++-- | /O(n)/ Reverse the characters of a string.+reverse :: Stream Char -> Text+reverse (Stream next s len0)+    | isEmpty len0 = I.empty+    | otherwise    = I.text arr off' len'+  where+    len0' = upperBound 4 (larger len0 4)+    (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')+    loop !s0 !i !len marr =+        case next s0 of+          Done -> return (marr, (j, len-j))+              where j = i + 1+          Skip s1    -> loop s1 i len marr+          Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do+                       let newLen = len `shiftL` 1+                       marr' <- A.new newLen+                       A.copyM marr' (newLen-len) marr 0 len+                       write s1 (len+i) newLen marr'+                     | otherwise -> write s1 i len marr+            where n = ord x+                  least | n < 0x10000 = 0+                        | otherwise   = 1+                  m = n - 0x10000+                  lo = fromIntegral $ (m `shiftR` 10) + 0xD800+                  hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+                  write t j l mar+                      | n < 0x10000 = do+                          A.unsafeWrite mar j (fromIntegral n)+                          loop t (j-1) l mar+                      | otherwise = do+                          A.unsafeWrite mar (j-1) lo+                          A.unsafeWrite mar j hi+                          loop t (j-2) l mar+{-# INLINE [0] reverse #-}++-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with+-- the input and result reversed.+reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low+  where+    {-# INLINE next #-}+    next (Scan1 z s) = Yield z (Scan2 z s)+    next (Scan2 z s) = case next0 s of+                         Yield x s' -> let !x' = f x z+                                       in Yield x' (Scan2 x' s')+                         Skip s'    -> Skip (Scan2 z s')+                         Done       -> Done+{-# INLINE reverseScanr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldrN n = S.unfoldrNI n+{-# INLINE [0] unfoldrN #-}++-------------------------------------------------------------------------------+-- ** Indexing streams++-- | /O(n)/ stream index (subscript) operator, starting from 0.+index :: Stream Char -> Int -> Char+index = S.indexI+{-# INLINE [0] index #-}++-- | The 'findIndex' function takes a predicate and a stream and+-- returns the index of the first element in the stream+-- satisfying the predicate.+findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int+findIndex = S.findIndexI+{-# INLINE [0] findIndex #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given stream.+countChar :: Char -> Stream Char -> Int+countChar = S.countCharI+{-# INLINE [0] countChar #-}++-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a+-- function to each element of a 'Text', passing an accumulating+-- parameter from left to right, and returns a final 'Text'.+mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)+mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)+  where+    (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)+      where mlen = upperBound 4 len+    outer arr top = loop+      where+        loop !z !s !i =+            case next0 s of+              Done          -> return (arr, (z,i))+              Skip s'       -> loop z s' i+              Yield x s'+                | j >= top  -> {-# SCC "mapAccumL/resize" #-} do+                               let top' = (top + 1) `shiftL` 1+                               arr' <- A.new top'+                               A.copyM arr' 0 arr 0 top+                               outer arr' top' z s i+                | otherwise -> do d <- unsafeWrite arr i c+                                  loop z' s' (i+d)+                where (z',c) = f z x+                      j | ord c < 0x10000 = i+                        | otherwise       = i + 1+{-# INLINE [0] mapAccumL #-}
+ src/Data/Text/Internal/Fusion/CaseMapping.hs view
@@ -0,0 +1,1002 @@+{-# LANGUAGE Rank2Types #-}+-- AUTOMATICALLY GENERATED - DO NOT EDIT+-- Generated by scripts/CaseMapping.hs+-- CaseFolding-9.0.0.txt+-- Date: 2016-03-02, 18:54:54 GMT+-- SpecialCasing-9.0.0.txt+-- Date: 2016-03-02, 18:55:13 GMT++module Data.Text.Internal.Fusion.CaseMapping where+import Data.Char+import Data.Text.Internal.Fusion.Types++upperMapping :: forall s. Char -> s -> Step (CC s) Char+{-# NOINLINE upperMapping #-}+-- LATIN SMALL LETTER SHARP S+upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')+-- LATIN SMALL LIGATURE FF+upperMapping '\xfb00' s = Yield '\x0046' (CC s '\x0046' '\x0000')+-- LATIN SMALL LIGATURE FI+upperMapping '\xfb01' s = Yield '\x0046' (CC s '\x0049' '\x0000')+-- LATIN SMALL LIGATURE FL+upperMapping '\xfb02' s = Yield '\x0046' (CC s '\x004c' '\x0000')+-- LATIN SMALL LIGATURE FFI+upperMapping '\xfb03' s = Yield '\x0046' (CC s '\x0046' '\x0049')+-- LATIN SMALL LIGATURE FFL+upperMapping '\xfb04' s = Yield '\x0046' (CC s '\x0046' '\x004c')+-- LATIN SMALL LIGATURE LONG S T+upperMapping '\xfb05' s = Yield '\x0053' (CC s '\x0054' '\x0000')+-- LATIN SMALL LIGATURE ST+upperMapping '\xfb06' s = Yield '\x0053' (CC s '\x0054' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+upperMapping '\x0587' s = Yield '\x0535' (CC s '\x0552' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+upperMapping '\xfb13' s = Yield '\x0544' (CC s '\x0546' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+upperMapping '\xfb14' s = Yield '\x0544' (CC s '\x0535' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+upperMapping '\xfb15' s = Yield '\x0544' (CC s '\x053b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+upperMapping '\xfb16' s = Yield '\x054e' (CC s '\x0546' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+upperMapping '\xfb17' s = Yield '\x0544' (CC s '\x053d' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+upperMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+upperMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+upperMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- LATIN SMALL LETTER J WITH CARON+upperMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+upperMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+upperMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+upperMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+upperMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+upperMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+upperMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+upperMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+upperMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+upperMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+upperMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+upperMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+upperMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+upperMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+upperMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+upperMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+upperMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+upperMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+upperMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+upperMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+upperMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+upperMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1f80' s = Yield '\x1f08' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1f81' s = Yield '\x1f09' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f82' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f83' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f84' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f85' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f86' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f87' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1f88' s = Yield '\x1f08' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1f89' s = Yield '\x1f09' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f8a' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f8b' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f8c' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f8d' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f8e' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f8f' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1f90' s = Yield '\x1f28' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1f91' s = Yield '\x1f29' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f92' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1f93' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f94' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1f95' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f96' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1f97' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1f98' s = Yield '\x1f28' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1f99' s = Yield '\x1f29' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f9a' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1f9b' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f9c' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1f9d' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f9e' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1f9f' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI+upperMapping '\x1fa0' s = Yield '\x1f68' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI+upperMapping '\x1fa1' s = Yield '\x1f69' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1fa2' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI+upperMapping '\x1fa3' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1fa4' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI+upperMapping '\x1fa5' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fa6' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fa7' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI+upperMapping '\x1fa8' s = Yield '\x1f68' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI+upperMapping '\x1fa9' s = Yield '\x1f69' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1faa' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI+upperMapping '\x1fab' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1fac' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI+upperMapping '\x1fad' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1fae' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+upperMapping '\x1faf' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI+upperMapping '\x1fb3' s = Yield '\x0391' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI+upperMapping '\x1fbc' s = Yield '\x0391' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI+upperMapping '\x1fc3' s = Yield '\x0397' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI+upperMapping '\x1fcc' s = Yield '\x0397' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI+upperMapping '\x1ff3' s = Yield '\x03a9' (CC s '\x0399' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI+upperMapping '\x1ffc' s = Yield '\x03a9' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+upperMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+upperMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0399' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0399')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')+upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')+lowerMapping :: forall s. Char -> s -> Step (CC s) Char+{-# NOINLINE lowerMapping #-}+-- LATIN CAPITAL LETTER I WITH DOT ABOVE+lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')+lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')+titleMapping :: forall s. Char -> s -> Step (CC s) Char+{-# NOINLINE titleMapping #-}+-- LATIN SMALL LETTER SHARP S+titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')+-- LATIN SMALL LIGATURE FF+titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')+-- LATIN SMALL LIGATURE FI+titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')+-- LATIN SMALL LIGATURE FL+titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')+-- LATIN SMALL LIGATURE FFI+titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')+-- LATIN SMALL LIGATURE FFL+titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')+-- LATIN SMALL LIGATURE LONG S T+titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')+-- LATIN SMALL LIGATURE ST+titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- LATIN SMALL LETTER J WITH CARON+titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')+titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')+foldMapping :: forall s. Char -> s -> Step (CC s) Char+{-# NOINLINE foldMapping #-}+-- MICRO SIGN+foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')+-- LATIN SMALL LETTER SHARP S+foldMapping '\x00df' s = Yield '\x0073' (CC s '\x0073' '\x0000')+-- LATIN CAPITAL LETTER I WITH DOT ABOVE+foldMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE+foldMapping '\x0149' s = Yield '\x02bc' (CC s '\x006e' '\x0000')+-- LATIN SMALL LETTER LONG S+foldMapping '\x017f' s = Yield '\x0073' (CC s '\x0000' '\x0000')+-- LATIN SMALL LETTER J WITH CARON+foldMapping '\x01f0' s = Yield '\x006a' (CC s '\x030c' '\x0000')+-- COMBINING GREEK YPOGEGRAMMENI+foldMapping '\x0345' s = Yield '\x03b9' (CC s '\x0000' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS+foldMapping '\x0390' s = Yield '\x03b9' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS+foldMapping '\x03b0' s = Yield '\x03c5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER FINAL SIGMA+foldMapping '\x03c2' s = Yield '\x03c3' (CC s '\x0000' '\x0000')+-- GREEK BETA SYMBOL+foldMapping '\x03d0' s = Yield '\x03b2' (CC s '\x0000' '\x0000')+-- GREEK THETA SYMBOL+foldMapping '\x03d1' s = Yield '\x03b8' (CC s '\x0000' '\x0000')+-- GREEK PHI SYMBOL+foldMapping '\x03d5' s = Yield '\x03c6' (CC s '\x0000' '\x0000')+-- GREEK PI SYMBOL+foldMapping '\x03d6' s = Yield '\x03c0' (CC s '\x0000' '\x0000')+-- GREEK KAPPA SYMBOL+foldMapping '\x03f0' s = Yield '\x03ba' (CC s '\x0000' '\x0000')+-- GREEK RHO SYMBOL+foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')+-- GREEK LUNATE EPSILON SYMBOL+foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')+-- ARMENIAN SMALL LIGATURE ECH YIWN+foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')+-- CHEROKEE SMALL LETTER YE+foldMapping '\x13f8' s = Yield '\x13f0' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER YI+foldMapping '\x13f9' s = Yield '\x13f1' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER YO+foldMapping '\x13fa' s = Yield '\x13f2' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER YU+foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER YV+foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER MV+foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')+-- CYRILLIC SMALL LETTER ROUNDED VE+foldMapping '\x1c80' s = Yield '\x0432' (CC s '\x0000' '\x0000')+-- CYRILLIC SMALL LETTER LONG-LEGGED DE+foldMapping '\x1c81' s = Yield '\x0434' (CC s '\x0000' '\x0000')+-- CYRILLIC SMALL LETTER NARROW O+foldMapping '\x1c82' s = Yield '\x043e' (CC s '\x0000' '\x0000')+-- CYRILLIC SMALL LETTER WIDE ES+foldMapping '\x1c83' s = Yield '\x0441' (CC s '\x0000' '\x0000')+-- CYRILLIC SMALL LETTER TALL TE+foldMapping '\x1c84' s = Yield '\x0442' (CC s '\x0000' '\x0000')+-- CYRILLIC SMALL LETTER THREE-LEGGED TE+foldMapping '\x1c85' s = Yield '\x0442' (CC s '\x0000' '\x0000')+-- CYRILLIC SMALL LETTER TALL HARD SIGN+foldMapping '\x1c86' s = Yield '\x044a' (CC s '\x0000' '\x0000')+-- CYRILLIC SMALL LETTER TALL YAT+foldMapping '\x1c87' s = Yield '\x0463' (CC s '\x0000' '\x0000')+-- CYRILLIC SMALL LETTER UNBLENDED UK+foldMapping '\x1c88' s = Yield '\xa64b' (CC s '\x0000' '\x0000')+-- LATIN SMALL LETTER H WITH LINE BELOW+foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')+-- LATIN SMALL LETTER T WITH DIAERESIS+foldMapping '\x1e97' s = Yield '\x0074' (CC s '\x0308' '\x0000')+-- LATIN SMALL LETTER W WITH RING ABOVE+foldMapping '\x1e98' s = Yield '\x0077' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER Y WITH RING ABOVE+foldMapping '\x1e99' s = Yield '\x0079' (CC s '\x030a' '\x0000')+-- LATIN SMALL LETTER A WITH RIGHT HALF RING+foldMapping '\x1e9a' s = Yield '\x0061' (CC s '\x02be' '\x0000')+-- LATIN SMALL LETTER LONG S WITH DOT ABOVE+foldMapping '\x1e9b' s = Yield '\x1e61' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER SHARP S+foldMapping '\x1e9e' s = Yield '\x0073' (CC s '\x0073' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI+foldMapping '\x1f50' s = Yield '\x03c5' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA+foldMapping '\x1f52' s = Yield '\x03c5' (CC s '\x0313' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA+foldMapping '\x1f54' s = Yield '\x03c5' (CC s '\x0313' '\x0301')+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI+foldMapping '\x1f56' s = Yield '\x03c5' (CC s '\x0313' '\x0342')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1f80' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1f81' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f82' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f83' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f84' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f85' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f86' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f87' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1f88' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1f89' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f8a' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f8b' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f8c' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f8d' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f8e' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f8f' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1f90' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1f91' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f92' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1f93' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f94' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1f95' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f96' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1f97' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1f98' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1f99' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f9a' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1f9b' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f9c' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1f9d' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f9e' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1f9f' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI+foldMapping '\x1fa0' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI+foldMapping '\x1fa1' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1fa2' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI+foldMapping '\x1fa3' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1fa4' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI+foldMapping '\x1fa5' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fa6' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fa7' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI+foldMapping '\x1fa8' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI+foldMapping '\x1fa9' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1faa' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI+foldMapping '\x1fab' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1fac' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI+foldMapping '\x1fad' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1fae' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI+foldMapping '\x1faf' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1fb2' s = Yield '\x1f70' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI+foldMapping '\x1fb3' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1fb4' s = Yield '\x03ac' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI+foldMapping '\x1fb6' s = Yield '\x03b1' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fb7' s = Yield '\x03b1' (CC s '\x0342' '\x03b9')+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI+foldMapping '\x1fbc' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')+-- GREEK PROSGEGRAMMENI+foldMapping '\x1fbe' s = Yield '\x03b9' (CC s '\x0000' '\x0000')+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1fc2' s = Yield '\x1f74' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI+foldMapping '\x1fc3' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1fc4' s = Yield '\x03ae' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI+foldMapping '\x1fc6' s = Yield '\x03b7' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1fc7' s = Yield '\x03b7' (CC s '\x0342' '\x03b9')+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI+foldMapping '\x1fcc' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA+foldMapping '\x1fd2' s = Yield '\x03b9' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA+foldMapping '\x1fd3' s = Yield '\x03b9' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI+foldMapping '\x1fd6' s = Yield '\x03b9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI+foldMapping '\x1fd7' s = Yield '\x03b9' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA+foldMapping '\x1fe2' s = Yield '\x03c5' (CC s '\x0308' '\x0300')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA+foldMapping '\x1fe3' s = Yield '\x03c5' (CC s '\x0308' '\x0301')+-- GREEK SMALL LETTER RHO WITH PSILI+foldMapping '\x1fe4' s = Yield '\x03c1' (CC s '\x0313' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI+foldMapping '\x1fe6' s = Yield '\x03c5' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI+foldMapping '\x1fe7' s = Yield '\x03c5' (CC s '\x0308' '\x0342')+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI+foldMapping '\x1ff2' s = Yield '\x1f7c' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI+foldMapping '\x1ff3' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI+foldMapping '\x1ff4' s = Yield '\x03ce' (CC s '\x03b9' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI+foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI+foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI+foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')+-- LATIN CAPITAL LETTER SMALL CAPITAL I+foldMapping '\xa7ae' s = Yield '\x026a' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL+foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER CHI+foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER BETA+foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER OMEGA+foldMapping '\xa7b6' s = Yield '\xa7b7' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER A+foldMapping '\xab70' s = Yield '\x13a0' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER E+foldMapping '\xab71' s = Yield '\x13a1' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER I+foldMapping '\xab72' s = Yield '\x13a2' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER O+foldMapping '\xab73' s = Yield '\x13a3' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER U+foldMapping '\xab74' s = Yield '\x13a4' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER V+foldMapping '\xab75' s = Yield '\x13a5' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER GA+foldMapping '\xab76' s = Yield '\x13a6' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER KA+foldMapping '\xab77' s = Yield '\x13a7' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER GE+foldMapping '\xab78' s = Yield '\x13a8' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER GI+foldMapping '\xab79' s = Yield '\x13a9' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER GO+foldMapping '\xab7a' s = Yield '\x13aa' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER GU+foldMapping '\xab7b' s = Yield '\x13ab' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER GV+foldMapping '\xab7c' s = Yield '\x13ac' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER HA+foldMapping '\xab7d' s = Yield '\x13ad' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER HE+foldMapping '\xab7e' s = Yield '\x13ae' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER HI+foldMapping '\xab7f' s = Yield '\x13af' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER HO+foldMapping '\xab80' s = Yield '\x13b0' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER HU+foldMapping '\xab81' s = Yield '\x13b1' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER HV+foldMapping '\xab82' s = Yield '\x13b2' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER LA+foldMapping '\xab83' s = Yield '\x13b3' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER LE+foldMapping '\xab84' s = Yield '\x13b4' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER LI+foldMapping '\xab85' s = Yield '\x13b5' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER LO+foldMapping '\xab86' s = Yield '\x13b6' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER LU+foldMapping '\xab87' s = Yield '\x13b7' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER LV+foldMapping '\xab88' s = Yield '\x13b8' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER MA+foldMapping '\xab89' s = Yield '\x13b9' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER ME+foldMapping '\xab8a' s = Yield '\x13ba' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER MI+foldMapping '\xab8b' s = Yield '\x13bb' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER MO+foldMapping '\xab8c' s = Yield '\x13bc' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER MU+foldMapping '\xab8d' s = Yield '\x13bd' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER NA+foldMapping '\xab8e' s = Yield '\x13be' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER HNA+foldMapping '\xab8f' s = Yield '\x13bf' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER NAH+foldMapping '\xab90' s = Yield '\x13c0' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER NE+foldMapping '\xab91' s = Yield '\x13c1' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER NI+foldMapping '\xab92' s = Yield '\x13c2' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER NO+foldMapping '\xab93' s = Yield '\x13c3' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER NU+foldMapping '\xab94' s = Yield '\x13c4' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER NV+foldMapping '\xab95' s = Yield '\x13c5' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER QUA+foldMapping '\xab96' s = Yield '\x13c6' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER QUE+foldMapping '\xab97' s = Yield '\x13c7' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER QUI+foldMapping '\xab98' s = Yield '\x13c8' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER QUO+foldMapping '\xab99' s = Yield '\x13c9' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER QUU+foldMapping '\xab9a' s = Yield '\x13ca' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER QUV+foldMapping '\xab9b' s = Yield '\x13cb' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER SA+foldMapping '\xab9c' s = Yield '\x13cc' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER S+foldMapping '\xab9d' s = Yield '\x13cd' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER SE+foldMapping '\xab9e' s = Yield '\x13ce' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER SI+foldMapping '\xab9f' s = Yield '\x13cf' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER SO+foldMapping '\xaba0' s = Yield '\x13d0' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER SU+foldMapping '\xaba1' s = Yield '\x13d1' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER SV+foldMapping '\xaba2' s = Yield '\x13d2' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER DA+foldMapping '\xaba3' s = Yield '\x13d3' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TA+foldMapping '\xaba4' s = Yield '\x13d4' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER DE+foldMapping '\xaba5' s = Yield '\x13d5' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TE+foldMapping '\xaba6' s = Yield '\x13d6' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER DI+foldMapping '\xaba7' s = Yield '\x13d7' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TI+foldMapping '\xaba8' s = Yield '\x13d8' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER DO+foldMapping '\xaba9' s = Yield '\x13d9' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER DU+foldMapping '\xabaa' s = Yield '\x13da' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER DV+foldMapping '\xabab' s = Yield '\x13db' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER DLA+foldMapping '\xabac' s = Yield '\x13dc' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TLA+foldMapping '\xabad' s = Yield '\x13dd' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TLE+foldMapping '\xabae' s = Yield '\x13de' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TLI+foldMapping '\xabaf' s = Yield '\x13df' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TLO+foldMapping '\xabb0' s = Yield '\x13e0' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TLU+foldMapping '\xabb1' s = Yield '\x13e1' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TLV+foldMapping '\xabb2' s = Yield '\x13e2' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TSA+foldMapping '\xabb3' s = Yield '\x13e3' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TSE+foldMapping '\xabb4' s = Yield '\x13e4' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TSI+foldMapping '\xabb5' s = Yield '\x13e5' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TSO+foldMapping '\xabb6' s = Yield '\x13e6' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TSU+foldMapping '\xabb7' s = Yield '\x13e7' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER TSV+foldMapping '\xabb8' s = Yield '\x13e8' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER WA+foldMapping '\xabb9' s = Yield '\x13e9' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER WE+foldMapping '\xabba' s = Yield '\x13ea' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER WI+foldMapping '\xabbb' s = Yield '\x13eb' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER WO+foldMapping '\xabbc' s = Yield '\x13ec' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER WU+foldMapping '\xabbd' s = Yield '\x13ed' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER WV+foldMapping '\xabbe' s = Yield '\x13ee' (CC s '\x0000' '\x0000')+-- CHEROKEE SMALL LETTER YA+foldMapping '\xabbf' s = Yield '\x13ef' (CC s '\x0000' '\x0000')+-- LATIN SMALL LIGATURE FF+foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')+-- LATIN SMALL LIGATURE FI+foldMapping '\xfb01' s = Yield '\x0066' (CC s '\x0069' '\x0000')+-- LATIN SMALL LIGATURE FL+foldMapping '\xfb02' s = Yield '\x0066' (CC s '\x006c' '\x0000')+-- LATIN SMALL LIGATURE FFI+foldMapping '\xfb03' s = Yield '\x0066' (CC s '\x0066' '\x0069')+-- LATIN SMALL LIGATURE FFL+foldMapping '\xfb04' s = Yield '\x0066' (CC s '\x0066' '\x006c')+-- LATIN SMALL LIGATURE LONG S T+foldMapping '\xfb05' s = Yield '\x0073' (CC s '\x0074' '\x0000')+-- LATIN SMALL LIGATURE ST+foldMapping '\xfb06' s = Yield '\x0073' (CC s '\x0074' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN NOW+foldMapping '\xfb13' s = Yield '\x0574' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN ECH+foldMapping '\xfb14' s = Yield '\x0574' (CC s '\x0565' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN INI+foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')+-- ARMENIAN SMALL LIGATURE VEW NOW+foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')+-- ARMENIAN SMALL LIGATURE MEN XEH+foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')+-- OSAGE CAPITAL LETTER A+foldMapping '\x104b0' s = Yield '\x104d8' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER AI+foldMapping '\x104b1' s = Yield '\x104d9' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER AIN+foldMapping '\x104b2' s = Yield '\x104da' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER AH+foldMapping '\x104b3' s = Yield '\x104db' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER BRA+foldMapping '\x104b4' s = Yield '\x104dc' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER CHA+foldMapping '\x104b5' s = Yield '\x104dd' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER EHCHA+foldMapping '\x104b6' s = Yield '\x104de' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER E+foldMapping '\x104b7' s = Yield '\x104df' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER EIN+foldMapping '\x104b8' s = Yield '\x104e0' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER HA+foldMapping '\x104b9' s = Yield '\x104e1' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER HYA+foldMapping '\x104ba' s = Yield '\x104e2' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER I+foldMapping '\x104bb' s = Yield '\x104e3' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER KA+foldMapping '\x104bc' s = Yield '\x104e4' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER EHKA+foldMapping '\x104bd' s = Yield '\x104e5' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER KYA+foldMapping '\x104be' s = Yield '\x104e6' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER LA+foldMapping '\x104bf' s = Yield '\x104e7' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER MA+foldMapping '\x104c0' s = Yield '\x104e8' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER NA+foldMapping '\x104c1' s = Yield '\x104e9' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER O+foldMapping '\x104c2' s = Yield '\x104ea' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER OIN+foldMapping '\x104c3' s = Yield '\x104eb' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER PA+foldMapping '\x104c4' s = Yield '\x104ec' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER EHPA+foldMapping '\x104c5' s = Yield '\x104ed' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER SA+foldMapping '\x104c6' s = Yield '\x104ee' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER SHA+foldMapping '\x104c7' s = Yield '\x104ef' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER TA+foldMapping '\x104c8' s = Yield '\x104f0' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER EHTA+foldMapping '\x104c9' s = Yield '\x104f1' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER TSA+foldMapping '\x104ca' s = Yield '\x104f2' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER EHTSA+foldMapping '\x104cb' s = Yield '\x104f3' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER TSHA+foldMapping '\x104cc' s = Yield '\x104f4' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER DHA+foldMapping '\x104cd' s = Yield '\x104f5' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER U+foldMapping '\x104ce' s = Yield '\x104f6' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER WA+foldMapping '\x104cf' s = Yield '\x104f7' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER KHA+foldMapping '\x104d0' s = Yield '\x104f8' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER GHA+foldMapping '\x104d1' s = Yield '\x104f9' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER ZA+foldMapping '\x104d2' s = Yield '\x104fa' (CC s '\x0000' '\x0000')+-- OSAGE CAPITAL LETTER ZHA+foldMapping '\x104d3' s = Yield '\x104fb' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER A+foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER AA+foldMapping '\x10c81' s = Yield '\x10cc1' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EB+foldMapping '\x10c82' s = Yield '\x10cc2' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER AMB+foldMapping '\x10c83' s = Yield '\x10cc3' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EC+foldMapping '\x10c84' s = Yield '\x10cc4' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ENC+foldMapping '\x10c85' s = Yield '\x10cc5' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ECS+foldMapping '\x10c86' s = Yield '\x10cc6' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ED+foldMapping '\x10c87' s = Yield '\x10cc7' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER AND+foldMapping '\x10c88' s = Yield '\x10cc8' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER E+foldMapping '\x10c89' s = Yield '\x10cc9' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER CLOSE E+foldMapping '\x10c8a' s = Yield '\x10cca' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EE+foldMapping '\x10c8b' s = Yield '\x10ccb' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EF+foldMapping '\x10c8c' s = Yield '\x10ccc' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EG+foldMapping '\x10c8d' s = Yield '\x10ccd' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EGY+foldMapping '\x10c8e' s = Yield '\x10cce' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EH+foldMapping '\x10c8f' s = Yield '\x10ccf' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER I+foldMapping '\x10c90' s = Yield '\x10cd0' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER II+foldMapping '\x10c91' s = Yield '\x10cd1' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EJ+foldMapping '\x10c92' s = Yield '\x10cd2' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EK+foldMapping '\x10c93' s = Yield '\x10cd3' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER AK+foldMapping '\x10c94' s = Yield '\x10cd4' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER UNK+foldMapping '\x10c95' s = Yield '\x10cd5' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EL+foldMapping '\x10c96' s = Yield '\x10cd6' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ELY+foldMapping '\x10c97' s = Yield '\x10cd7' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EM+foldMapping '\x10c98' s = Yield '\x10cd8' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EN+foldMapping '\x10c99' s = Yield '\x10cd9' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ENY+foldMapping '\x10c9a' s = Yield '\x10cda' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER O+foldMapping '\x10c9b' s = Yield '\x10cdb' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER OO+foldMapping '\x10c9c' s = Yield '\x10cdc' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG OE+foldMapping '\x10c9d' s = Yield '\x10cdd' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA OE+foldMapping '\x10c9e' s = Yield '\x10cde' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER OEE+foldMapping '\x10c9f' s = Yield '\x10cdf' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EP+foldMapping '\x10ca0' s = Yield '\x10ce0' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EMP+foldMapping '\x10ca1' s = Yield '\x10ce1' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ER+foldMapping '\x10ca2' s = Yield '\x10ce2' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER SHORT ER+foldMapping '\x10ca3' s = Yield '\x10ce3' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ES+foldMapping '\x10ca4' s = Yield '\x10ce4' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ESZ+foldMapping '\x10ca5' s = Yield '\x10ce5' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ET+foldMapping '\x10ca6' s = Yield '\x10ce6' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ENT+foldMapping '\x10ca7' s = Yield '\x10ce7' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ETY+foldMapping '\x10ca8' s = Yield '\x10ce8' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ECH+foldMapping '\x10ca9' s = Yield '\x10ce9' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER U+foldMapping '\x10caa' s = Yield '\x10cea' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER UU+foldMapping '\x10cab' s = Yield '\x10ceb' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG UE+foldMapping '\x10cac' s = Yield '\x10cec' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA UE+foldMapping '\x10cad' s = Yield '\x10ced' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EV+foldMapping '\x10cae' s = Yield '\x10cee' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EZ+foldMapping '\x10caf' s = Yield '\x10cef' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER EZS+foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER ENT-SHAPED SIGN+foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')+-- OLD HUNGARIAN CAPITAL LETTER US+foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER ALIF+foldMapping '\x1e900' s = Yield '\x1e922' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER DAALI+foldMapping '\x1e901' s = Yield '\x1e923' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER LAAM+foldMapping '\x1e902' s = Yield '\x1e924' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER MIIM+foldMapping '\x1e903' s = Yield '\x1e925' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER BA+foldMapping '\x1e904' s = Yield '\x1e926' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER SINNYIIYHE+foldMapping '\x1e905' s = Yield '\x1e927' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER PE+foldMapping '\x1e906' s = Yield '\x1e928' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER BHE+foldMapping '\x1e907' s = Yield '\x1e929' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER RA+foldMapping '\x1e908' s = Yield '\x1e92a' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER E+foldMapping '\x1e909' s = Yield '\x1e92b' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER FA+foldMapping '\x1e90a' s = Yield '\x1e92c' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER I+foldMapping '\x1e90b' s = Yield '\x1e92d' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER O+foldMapping '\x1e90c' s = Yield '\x1e92e' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER DHA+foldMapping '\x1e90d' s = Yield '\x1e92f' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER YHE+foldMapping '\x1e90e' s = Yield '\x1e930' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER WAW+foldMapping '\x1e90f' s = Yield '\x1e931' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER NUN+foldMapping '\x1e910' s = Yield '\x1e932' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER KAF+foldMapping '\x1e911' s = Yield '\x1e933' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER YA+foldMapping '\x1e912' s = Yield '\x1e934' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER U+foldMapping '\x1e913' s = Yield '\x1e935' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER JIIM+foldMapping '\x1e914' s = Yield '\x1e936' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER CHI+foldMapping '\x1e915' s = Yield '\x1e937' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER HA+foldMapping '\x1e916' s = Yield '\x1e938' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER QAAF+foldMapping '\x1e917' s = Yield '\x1e939' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER GA+foldMapping '\x1e918' s = Yield '\x1e93a' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER NYA+foldMapping '\x1e919' s = Yield '\x1e93b' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER TU+foldMapping '\x1e91a' s = Yield '\x1e93c' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER NHA+foldMapping '\x1e91b' s = Yield '\x1e93d' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER VA+foldMapping '\x1e91c' s = Yield '\x1e93e' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER KHA+foldMapping '\x1e91d' s = Yield '\x1e93f' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER GBE+foldMapping '\x1e91e' s = Yield '\x1e940' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER ZAL+foldMapping '\x1e91f' s = Yield '\x1e941' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER KPO+foldMapping '\x1e920' s = Yield '\x1e942' (CC s '\x0000' '\x0000')+-- ADLAM CAPITAL LETTER SHA+foldMapping '\x1e921' s = Yield '\x1e943' (CC s '\x0000' '\x0000')+foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
+ src/Data/Text/Internal/Fusion/Common.hs view
@@ -0,0 +1,949 @@+{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}+-- |+-- Module      : Data.Text.Internal.Fusion.Common+-- Copyright   : (c) Bryan O'Sullivan 2009, 2012+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Common stream fusion functionality for text.++module Data.Text.Internal.Fusion.Common+    (+    -- * Creation and elimination+      singleton+    , streamList+    , unstreamList+    , streamCString#++    -- * Basic interface+    , cons+    , snoc+    , append+    , head+    , uncons+    , last+    , tail+    , init+    , null+    , lengthI+    , compareLengthI+    , isSingleton++    -- * Transformations+    , map+    , intercalate+    , intersperse++    -- ** Case conversion+    -- $case+    , toCaseFold+    , toLower+    , toTitle+    , toUpper++    -- ** Justification+    , justifyLeftI++    -- * Folds+    , foldl+    , foldl'+    , foldl1+    , foldl1'+    , foldr+    , foldr1++    -- ** Special folds+    , concat+    , concatMap+    , any+    , all+    , maximum+    , minimum++    -- * Construction+    -- ** Scans+    , scanl++    -- ** Generation and unfolding+    , replicateCharI+    , replicateI+    , unfoldr+    , unfoldrNI++    -- * Substrings+    -- ** Breaking strings+    , take+    , drop+    , takeWhile+    , dropWhile++    -- * Predicates+    , isPrefixOf++    -- * Searching+    , elem+    , filter++    -- * Indexing+    , findBy+    , indexI+    , findIndexI+    , countCharI++    -- * Zipping and unzipping+    , zipWith+    ) where++import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),+                Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),+                (&&), fromIntegral, otherwise)+import qualified Data.List as L+import qualified Prelude as P+import Data.Bits (shiftL)+import Data.Char (isLetter, isSpace)+import Data.Int (Int64)+import Data.Text.Internal.Fusion.Types+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,+                                     upperMapping)+import Data.Text.Internal.Fusion.Size+import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)+import GHC.Types (Char(..), Int(..))++singleton :: Char -> Stream Char+singleton c = Stream next False (codePointsSize 1)+    where next False = Yield c True+          next True  = Done+{-# INLINE [0] singleton #-}++streamList :: [a] -> Stream a+{-# INLINE [0] streamList #-}+streamList s  = Stream next s unknownSize+    where next []       = Done+          next (x:xs)   = Yield x xs++unstreamList :: Stream a -> [a]+unstreamList (Stream next s0 _len) = unfold s0+    where unfold !s = case next s of+                        Done       -> []+                        Skip s'    -> unfold s'+                        Yield x s' -> x : unfold s'+{-# INLINE [0] unstreamList #-}++{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}++-- | Stream the UTF-8-like packed encoding used by GHC to represent+-- constant strings in generated code.+--+-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,+-- and the string is NUL-terminated.+streamCString# :: Addr# -> Stream Char+streamCString# addr = Stream step 0 unknownSize+  where+    step !i+        | b == 0    = Done+        | b <= 0x7f = Yield (C# b#) (i+1)+        | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1+                      in Yield c (i+2)+        | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) ++                                      (next 1  `shiftL` 6) ++                                       next 2+                      in Yield c (i+3)+        | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) ++                                      (next 1  `shiftL` 12) ++                                      (next 2  `shiftL` 6) ++                                       next 3+                      in Yield c (i+4)+      where b      = I# (ord# b#)+            next n = I# (ord# (at# (i+n))) - 0x80+            !b#    = at# i+    at# (I# i#) = indexCharOffAddr# addr i#+    chr (I# i#) = C# (chr# i#)+{-# INLINE [0] streamCString# #-}++-- ----------------------------------------------------------------------------+-- * Basic stream functions++data C s = C0 !s+         | C1 !s++-- | /O(n)/ Adds a character to the front of a Stream Char.+cons :: Char -> Stream Char -> Stream Char+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len + codePointsSize 1)+    where+      next (C1 s) = Yield w (C0 s)+      next (C0 s) = case next0 s of+                          Done -> Done+                          Skip s' -> Skip (C0 s')+                          Yield x s' -> Yield x (C0 s')+{-# INLINE [0] cons #-}++data Snoc a = N+            | J !a++-- | /O(n)/ Adds a character to the end of a stream.+snoc :: Stream Char -> Char -> Stream Char+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len + codePointsSize 1)+  where+    next (J xs) = case next0 xs of+      Done        -> Yield w N+      Skip xs'    -> Skip    (J xs')+      Yield x xs' -> Yield x (J xs')+    next N = Done+{-# INLINE [0] snoc #-}++data E l r = L !l+           | R !r++-- | /O(n)/ Appends one Stream to the other.+append :: Stream Char -> Stream Char -> Stream Char+append (Stream next0 s01 len1) (Stream next1 s02 len2) =+    Stream next (L s01) (len1 + len2)+    where+      next (L s1) = case next0 s1 of+                         Done        -> Skip    (R s02)+                         Skip s1'    -> Skip    (L s1')+                         Yield x s1' -> Yield x (L s1')+      next (R s2) = case next1 s2 of+                          Done        -> Done+                          Skip s2'    -> Skip    (R s2')+                          Yield x s2' -> Yield x (R s2')+{-# INLINE [0] append #-}++-- | /O(1)/ Returns the first character of a Text, which must be non-empty.+-- Subject to array fusion.+head :: Stream Char -> Char+head (Stream next s0 _len) = loop_head s0+    where+      loop_head !s = case next s of+                      Yield x _ -> x+                      Skip s'   -> loop_head s'+                      Done      -> head_empty+{-# INLINE [0] head #-}++head_empty :: a+head_empty = streamError "head" "Empty stream"+{-# NOINLINE head_empty #-}++-- | /O(1)/ Returns the first character and remainder of a 'Stream+-- Char', or 'Nothing' if empty.  Subject to array fusion.+uncons :: Stream Char -> Maybe (Char, Stream Char)+uncons (Stream next s0 len) = loop_uncons s0+    where+      loop_uncons !s = case next s of+                         Yield x s1 -> Just (x, Stream next s1 (len - codePointsSize 1))+                         Skip s'    -> loop_uncons s'+                         Done       -> Nothing+{-# INLINE [0] uncons #-}++-- | /O(n)/ Returns the last character of a 'Stream Char', which must+-- be non-empty.+last :: Stream Char -> Char+last (Stream next s0 _len) = loop0_last s0+    where+      loop0_last !s = case next s of+                        Done       -> emptyError "last"+                        Skip s'    -> loop0_last  s'+                        Yield x s' -> loop_last x s'+      loop_last !x !s = case next s of+                         Done        -> x+                         Skip s'     -> loop_last x  s'+                         Yield x' s' -> loop_last x' s'+{-# INLINE[0] last #-}++-- | /O(1)/ Returns all characters after the head of a Stream Char, which must+-- be non-empty.+tail :: Stream Char -> Stream Char+tail (Stream next0 s0 len) = Stream next (C0 s0) (len - codePointsSize 1)+    where+      next (C0 s) = case next0 s of+                      Done       -> emptyError "tail"+                      Skip s'    -> Skip (C0 s')+                      Yield _ s' -> Skip (C1 s')+      next (C1 s) = case next0 s of+                      Done       -> Done+                      Skip s'    -> Skip    (C1 s')+                      Yield x s' -> Yield x (C1 s')+{-# INLINE [0] tail #-}++data Init s = Init0 !s+            | Init1 {-# UNPACK #-} !Char !s++-- | /O(1)/ Returns all but the last character of a Stream Char, which+-- must be non-empty.+init :: Stream Char -> Stream Char+init (Stream next0 s0 len) = Stream next (Init0 s0) (len - codePointsSize 1)+    where+      next (Init0 s) = case next0 s of+                         Done       -> emptyError "init"+                         Skip s'    -> Skip (Init0 s')+                         Yield x s' -> Skip (Init1 x s')+      next (Init1 x s)  = case next0 s of+                            Done        -> Done+                            Skip s'     -> Skip    (Init1 x s')+                            Yield x' s' -> Yield x (Init1 x' s')+{-# INLINE [0] init #-}++-- | /O(1)/ Tests whether a Stream Char is empty or not.+null :: Stream Char -> Bool+null (Stream next s0 _len) = loop_null s0+    where+      loop_null !s = case next s of+                       Done      -> True+                       Yield _ _ -> False+                       Skip s'   -> loop_null s'+{-# INLINE[0] null #-}++-- | /O(n)/ Returns the number of characters in a string.+lengthI :: Integral a => Stream Char -> a+lengthI (Stream next s0 _len) = loop_length 0 s0+    where+      loop_length !z s  = case next s of+                           Done       -> z+                           Skip    s' -> loop_length z s'+                           Yield _ s' -> loop_length (z + 1) s'+{-# INLINE[0] lengthI #-}++-- | /O(n)/ Compares the count of characters in a string to a number.+-- Subject to fusion.+--+-- This function gives the same answer as comparing against the result+-- of 'lengthI', but can short circuit if the count of characters is+-- greater than the number or if the stream can't possibly be as long+-- as the number supplied, and hence be more efficient.+compareLengthI :: Integral a => Stream Char -> a -> Ordering+compareLengthI (Stream next s0 len) n+    -- Note that @len@ tracks code units whereas we want to compare the length+    -- in code points. Specifically, a stream with hint @len@ may consist of+    -- anywhere from @len/2@ to @len@ code points.+  | Just r <- compareSize len n' = r+  | otherwise = loop_cmp 0 s0+    where+      n' = codePointsSize $ fromIntegral n+      loop_cmp !z s  = case next s of+                         Done       -> compare z n+                         Skip    s' -> loop_cmp z s'+                         Yield _ s' | z > n     -> GT+                                    | otherwise -> loop_cmp (z + 1) s'+{-# INLINE[0] compareLengthI #-}++-- | /O(n)/ Indicate whether a string contains exactly one element.+isSingleton :: Stream Char -> Bool+isSingleton (Stream next s0 _len) = loop 0 s0+    where+      loop !z s  = case next s of+                     Done            -> z == (1::Int)+                     Skip    s'      -> loop z s'+                     Yield _ s'+                         | z >= 1    -> False+                         | otherwise -> loop (z+1) s'+{-# INLINE[0] isSingleton #-}++-- ----------------------------------------------------------------------------+-- * Stream transformations++-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@+-- to each element of @xs@.+map :: (Char -> Char) -> Stream Char -> Stream Char+map f (Stream next0 s0 len) = Stream next s0 len+    where+      next !s = case next0 s of+                  Done       -> Done+                  Skip s'    -> Skip s'+                  Yield x s' -> Yield (f x) s'+{-# INLINE [0] map #-}++{-#+  RULES "STREAM map/map fusion" forall f g s.+     map f (map g s) = map (\x -> f (g x)) s+ #-}++data I s = I1 !s+         | I2 !s {-# UNPACK #-} !Char+         | I3 !s++-- | /O(n)/ Take a character and place it between each of the+-- characters of a 'Stream Char'.+intersperse :: Char -> Stream Char -> Stream Char+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) (len + unknownSize)+    where+      next (I1 s) = case next0 s of+        Done       -> Done+        Skip s'    -> Skip (I1 s')+        Yield x s' -> Skip (I2 s' x)+      next (I2 s x)  = Yield x (I3 s)+      next (I3 s) = case next0 s of+        Done       -> Done+        Skip s'    -> Skip    (I3 s')+        Yield x s' -> Yield c (I2 s' x)+{-# INLINE [0] intersperse #-}++-- ----------------------------------------------------------------------------+-- ** Case conversions (folds)++-- $case+--+-- With Unicode text, it is incorrect to use combinators like @map+-- toUpper@ to case convert each character of a string individually.+-- Instead, use the whole-string case conversion functions from this+-- module.  For correctness in different writing systems, these+-- functions may map one input character to two or three output+-- characters.++-- | Map a 'Stream' through the given case-mapping function.+caseConvert :: (forall s. Char -> s -> Step (CC s) Char)+            -> Stream Char -> Stream Char+caseConvert remap (Stream next0 s0 len) =+    Stream next (CC s0 '\0' '\0') (len `unionSize` (3*len))+  where+    next (CC s '\0' _) =+        case next0 s of+          Done       -> Done+          Skip s'    -> Skip (CC s' '\0' '\0')+          Yield c s' -> remap c s'+    next (CC s a b)  =  Yield a (CC s b '\0')++-- | /O(n)/ Convert a string to folded case.  This function is mainly+-- useful for performing caseless (or case insensitive) string+-- comparisons.+--+-- A string @x@ is a caseless match for a string @y@ if and only if:+--+-- @toCaseFold x == toCaseFold y@+--+-- The result string may be longer than the input string, and may+-- differ from applying 'toLower' to the input string.  For instance,+-- the Armenian small ligature men now (U+FB13) is case folded to the+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is+-- case folded to the Greek small letter letter mu (U+03BC) instead of+-- itself.+toCaseFold :: Stream Char -> Stream Char+toCaseFold = caseConvert foldMapping+{-# INLINE [0] toCaseFold #-}++-- | /O(n)/ Convert a string to upper case, using simple case+-- conversion.  The result string may be longer than the input string.+-- For instance, the German eszett (U+00DF) maps to the two-letter+-- sequence SS.+toUpper :: Stream Char -> Stream Char+toUpper = caseConvert upperMapping+{-# INLINE [0] toUpper #-}++-- | /O(n)/ Convert a string to lower case, using simple case+-- conversion.  The result string may be longer than the input string.+-- For instance, the Latin capital letter I with dot above (U+0130)+-- maps to the sequence Latin small letter i (U+0069) followed by+-- combining dot above (U+0307).+toLower :: Stream Char -> Stream Char+toLower = caseConvert lowerMapping+{-# INLINE [0] toLower #-}++-- | /O(n)/ Convert a string to title case, using simple case+-- conversion.+--+-- The first letter of the input is converted to title case, as is+-- every subsequent letter that immediately follows a non-letter.+-- Every letter that immediately follows another letter is converted+-- to lower case.+--+-- The result string may be longer than the input string. For example,+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the+-- sequence Latin capital letter F (U+0046) followed by Latin small+-- letter l (U+006C).+--+-- /Note/: this function does not take language or culture specific+-- rules into account. For instance, in English, different style+-- guides disagree on whether the book name \"The Hill of the Red+-- Fox\" is correctly title cased&#x2014;but this function will+-- capitalize /every/ word.+toTitle :: Stream Char -> Stream Char+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') (len + unknownSize)+  where+    next (CC (letter :*: s) '\0' _) =+      case next0 s of+        Done            -> Done+        Skip s'         -> Skip (CC (letter :*: s') '\0' '\0')+        Yield c s'+          | nonSpace    -> if letter+                           then lowerMapping c (nonSpace :*: s')+                           else titleMapping c (letter' :*: s')+          | otherwise   -> Yield c (CC (letter' :*: s') '\0' '\0')+          where nonSpace = P.not (isSpace c)+                letter'  = isLetter c+    next (CC s a b)      = Yield a (CC s b '\0')+{-# INLINE [0] toTitle #-}++data Justify i s = Just1 !i !s+                 | Just2 !i !s++justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char+justifyLeftI k c (Stream next0 s0 len) =+    Stream next (Just1 0 s0) (larger (fromIntegral k * charSize c + len) len)+  where+    next (Just1 n s) =+        case next0 s of+          Done       -> next (Just2 n s)+          Skip s'    -> Skip (Just1 n s')+          Yield x s' -> Yield x (Just1 (n+1) s')+    next (Just2 n s)+        | n < k       = Yield c (Just2 (n+1) s)+        | otherwise   = Done+    {-# INLINE next #-}+{-# INLINE [0] justifyLeftI #-}++-- ----------------------------------------------------------------------------+-- * Reducing Streams (folds)++-- | foldl, applied to a binary operator, a starting value (typically the+-- left-identity of the operator), and a Stream, reduces the Stream using the+-- binary operator, from left to right.+foldl :: (b -> Char -> b) -> b -> Stream Char -> b+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0+    where+      loop_foldl z !s = case next s of+                          Done -> z+                          Skip s' -> loop_foldl z s'+                          Yield x s' -> loop_foldl (f z x) s'+{-# INLINE [0] foldl #-}++-- | A strict version of foldl.+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0+    where+      loop_foldl' !z !s = case next s of+                            Done -> z+                            Skip s' -> loop_foldl' z s'+                            Yield x s' -> loop_foldl' (f z x) s'+{-# INLINE [0] foldl' #-}++-- | foldl1 is a variant of foldl that has no starting value argument,+-- and thus must be applied to non-empty Streams.+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0+    where+      loop0_foldl1 !s = case next s of+                          Skip s' -> loop0_foldl1 s'+                          Yield x s' -> loop_foldl1 x s'+                          Done -> emptyError "foldl1"+      loop_foldl1 z !s = case next s of+                           Done -> z+                           Skip s' -> loop_foldl1 z s'+                           Yield x s' -> loop_foldl1 (f z x) s'+{-# INLINE [0] foldl1 #-}++-- | A strict version of foldl1.+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0+    where+      loop0_foldl1' !s = case next s of+                           Skip s' -> loop0_foldl1' s'+                           Yield x s' -> loop_foldl1' x s'+                           Done -> emptyError "foldl1"+      loop_foldl1' !z !s = case next s of+                             Done -> z+                             Skip s' -> loop_foldl1' z s'+                             Yield x s' -> loop_foldl1' (f z x) s'+{-# INLINE [0] foldl1' #-}++-- | 'foldr', applied to a binary operator, a starting value (typically the+-- right-identity of the operator), and a stream, reduces the stream using the+-- binary operator, from right to left.+foldr :: (Char -> b -> b) -> b -> Stream Char -> b+foldr f z (Stream next s0 _len) = loop_foldr s0+    where+      loop_foldr !s = case next s of+                        Done -> z+                        Skip s' -> loop_foldr s'+                        Yield x s' -> f x (loop_foldr s')+{-# INLINE [0] foldr #-}++-- | foldr1 is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty streams.+-- Subject to array fusion.+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0+  where+    loop0_foldr1 !s = case next s of+      Done       -> emptyError "foldr1"+      Skip    s' -> loop0_foldr1  s'+      Yield x s' -> loop_foldr1 x s'++    loop_foldr1 x !s = case next s of+      Done        -> x+      Skip     s' -> loop_foldr1 x s'+      Yield x' s' -> f x (loop_foldr1 x' s')+{-# INLINE [0] foldr1 #-}++intercalate :: Stream Char -> [Stream Char] -> Stream Char+intercalate s = concat . (L.intersperse s)+{-# INLINE [0] intercalate #-}++-- ----------------------------------------------------------------------------+-- ** Special folds++-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.+concat :: [Stream Char] -> Stream Char+concat = L.foldr append empty+{-# INLINE [0] concat #-}++-- | Map a function over a stream that results in a stream and concatenate the+-- results.+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char+concatMap f = foldr (append . f) empty+{-# INLINE [0] concatMap #-}++-- | /O(n)/ any @p @xs determines if any character in the stream+-- @xs@ satisfies the predicate @p@.+any :: (Char -> Bool) -> Stream Char -> Bool+any p (Stream next0 s0 _len) = loop_any s0+    where+      loop_any !s = case next0 s of+                      Done                   -> False+                      Skip s'                -> loop_any s'+                      Yield x s' | p x       -> True+                                 | otherwise -> loop_any s'+{-# INLINE [0] any #-}++-- | /O(n)/ all @p @xs determines if all characters in the 'Text'+-- @xs@ satisfy the predicate @p@.+all :: (Char -> Bool) -> Stream Char -> Bool+all p (Stream next0 s0 _len) = loop_all s0+    where+      loop_all !s = case next0 s of+                      Done                   -> True+                      Skip s'                -> loop_all s'+                      Yield x s' | p x       -> loop_all s'+                                 | otherwise -> False+{-# INLINE [0] all #-}++-- | /O(n)/ maximum returns the maximum value from a stream, which must be+-- non-empty.+maximum :: Stream Char -> Char+maximum (Stream next0 s0 _len) = loop0_maximum s0+    where+      loop0_maximum !s   = case next0 s of+                             Done       -> emptyError "maximum"+                             Skip s'    -> loop0_maximum s'+                             Yield x s' -> loop_maximum x s'+      loop_maximum !z !s = case next0 s of+                             Done            -> z+                             Skip s'         -> loop_maximum z s'+                             Yield x s'+                                 | x > z     -> loop_maximum x s'+                                 | otherwise -> loop_maximum z s'+{-# INLINE [0] maximum #-}++-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be+-- non-empty.+minimum :: Stream Char -> Char+minimum (Stream next0 s0 _len) = loop0_minimum s0+    where+      loop0_minimum !s   = case next0 s of+                             Done       -> emptyError "minimum"+                             Skip s'    -> loop0_minimum s'+                             Yield x s' -> loop_minimum x s'+      loop_minimum !z !s = case next0 s of+                             Done            -> z+                             Skip s'         -> loop_minimum z s'+                             Yield x s'+                                 | x < z     -> loop_minimum x s'+                                 | otherwise -> loop_minimum z s'+{-# INLINE [0] minimum #-}++-- -----------------------------------------------------------------------------+-- * Building streams++scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low+  where+    {-# INLINE next #-}+    next (Scan1 z s) = Yield z (Scan2 z s)+    next (Scan2 z s) = case next0 s of+                         Yield x s' -> let !x' = f z x+                                       in Yield x' (Scan2 x' s')+                         Skip s'    -> Skip (Scan2 z s')+                         Done       -> Done+{-# INLINE [0] scanl #-}++-- -----------------------------------------------------------------------------+-- ** Generating and unfolding streams++replicateCharI :: Integral a => a -> Char -> Stream Char+replicateCharI !n !c+    | n < 0     = empty+    | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low+  where+    next !i | i >= n    = Done+            | otherwise = Yield c (i + 1)+{-# INLINE [0] replicateCharI #-}++data RI s = RI !s {-# UNPACK #-} !Int64++replicateI :: Int64 -> Stream Char -> Stream Char+replicateI n (Stream next0 s0 len) =+    Stream next (RI s0 0) (fromIntegral (max 0 n) * len)+  where+    next (RI s k)+        | k >= n = Done+        | otherwise = case next0 s of+                        Done       -> Skip    (RI s0 (k+1))+                        Skip s'    -> Skip    (RI s' k)+                        Yield x s' -> Yield x (RI s' k)+{-# INLINE [0] replicateI #-}++-- | /O(n)/, where @n@ is the length of the result. The unfoldr function+-- is analogous to the List 'unfoldr'. unfoldr builds a stream+-- from a seed value. The function takes the element and returns+-- Nothing if it is done producing the stream or returns Just+-- (a,b), in which case, a is the next Char in the string, and b is+-- the seed value for further production.+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldr f s0 = Stream next s0 unknownSize+    where+      {-# INLINE next #-}+      next !s = case f s of+                 Nothing      -> Done+                 Just (w, s') -> Yield w s'+{-# INLINE [0] unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrNI'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char+unfoldrNI n f s0 | n <  0    = empty+                 | otherwise = Stream next (0 :*: s0) (maxSize $ fromIntegral (n*2))+    where+      {-# INLINE next #-}+      next (z :*: s) = case f s of+          Nothing                  -> Done+          Just (w, s') | z >= n    -> Done+                       | otherwise -> Yield w ((z + 1) :*: s')+{-# INLINE unfoldrNI #-}++-------------------------------------------------------------------------------+--  * Substreams++-- | /O(n)/ @'take' n@, applied to a stream, returns the prefix of the+-- stream of length @n@, or the stream itself if @n@ is greater than the+-- length of the stream.+take :: Integral a => a -> Stream Char -> Stream Char+take n0 (Stream next0 s0 len) =+    Stream next (n0' :*: s0) (smaller len (codePointsSize $ fromIntegral n0'))+    where+      n0' = max n0 0++      {-# INLINE next #-}+      next (n :*: s) | n <= 0    = Done+                     | otherwise = case next0 s of+                                     Done -> Done+                                     Skip s' -> Skip (n :*: s')+                                     Yield x s' -> Yield x ((n-1) :*: s')+{-# INLINE [0] take #-}++data Drop a s = NS !s+              | JS !a !s++-- | /O(n)/ @'drop' n@, applied to a stream, returns the suffix of the+-- stream after the first @n@ characters, or the empty stream if @n@+-- is greater than the length of the stream.+drop :: Integral a => a -> Stream Char -> Stream Char+drop n0 (Stream next0 s0 len) =+    Stream next (JS n0' s0) (len - codePointsSize (fromIntegral n0'))+  where+    n0' = max n0 0++    {-# INLINE next #-}+    next (JS n s)+      | n <= 0    = Skip (NS s)+      | otherwise = case next0 s of+          Done       -> Done+          Skip    s' -> Skip (JS n    s')+          Yield _ s' -> Skip (JS (n-1) s')+    next (NS s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (NS s')+      Yield x s' -> Yield x (NS s')+{-# INLINE [0] drop #-}++-- | 'takeWhile', applied to a predicate @p@ and a stream, returns the+-- longest prefix (possibly empty) of elements that satisfy @p@.+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char+takeWhile p (Stream next0 s0 len) = Stream next s0 (len - unknownSize)+    where+      {-# INLINE next #-}+      next !s = case next0 s of+                  Done    -> Done+                  Skip s' -> Skip s'+                  Yield x s' | p x       -> Yield x s'+                             | otherwise -> Done+{-# INLINE [0] takeWhile #-}++-- | @'dropWhile' p xs@ returns the suffix remaining after @'takeWhile' p xs@.+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char+dropWhile p (Stream next0 s0 len) = Stream next (L s0) (len - unknownSize)+    where+    {-# INLINE next #-}+    next (L s)  = case next0 s of+      Done                   -> Done+      Skip    s'             -> Skip    (L s')+      Yield x s' | p x       -> Skip    (L s')+                 | otherwise -> Yield x (R s')+    next (R s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (R s')+      Yield x s' -> Yield x (R s')+{-# INLINE [0] dropWhile #-}++-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns+-- 'True' iff the first is a prefix of the second.+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+    where+      loop Done      _ = True+      loop _    Done = False+      loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')+      loop (Skip s1')     x2             = loop (next1 s1') x2+      loop x1             (Skip s2')     = loop x1          (next2 s2')+      loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&+                                           loop (next1 s1') (next2 s2')+{-# INLINE [0] isPrefixOf #-}++-- ----------------------------------------------------------------------------+-- * Searching++-------------------------------------------------------------------------------+-- ** Searching by equality++-- | /O(n)/ 'elem' is the stream membership predicate.+elem :: Char -> Stream Char -> Bool+elem w (Stream next s0 _len) = loop_elem s0+    where+      loop_elem !s = case next s of+                       Done -> False+                       Skip s' -> loop_elem s'+                       Yield x s' | x == w -> True+                                  | otherwise -> loop_elem s'+{-# INLINE [0] elem #-}++-------------------------------------------------------------------------------+-- ** Searching with a predicate++-- | /O(n)/ The 'findBy' function takes a predicate and a stream,+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.++findBy :: (Char -> Bool) -> Stream Char -> Maybe Char+findBy p (Stream next s0 _len) = loop_find s0+    where+      loop_find !s = case next s of+                       Done -> Nothing+                       Skip s' -> loop_find s'+                       Yield x s' | p x -> Just x+                                  | otherwise -> loop_find s'+{-# INLINE [0] findBy #-}++-- | /O(n)/ Stream index (subscript) operator, starting from 0.+indexI :: Integral a => Stream Char -> a -> Char+indexI (Stream next s0 _len) n0+  | n0 < 0    = streamError "index" "Negative index"+  | otherwise = loop_index n0 s0+  where+    loop_index !n !s = case next s of+      Done                   -> streamError "index" "Index too large"+      Skip    s'             -> loop_index  n    s'+      Yield x s' | n == 0    -> x+                 | otherwise -> loop_index (n-1) s'+{-# INLINE [0] indexI #-}++-- | /O(n)/ 'filter', applied to a predicate and a stream,+-- returns a stream containing those characters that satisfy the+-- predicate.+filter :: (Char -> Bool) -> Stream Char -> Stream Char+filter p (Stream next0 s0 len) =+    Stream next s0 (len - unknownSize) -- HINT maybe too high+  where+    next !s = case next0 s of+                Done                   -> Done+                Skip    s'             -> Skip    s'+                Yield x s' | p x       -> Yield x s'+                           | otherwise -> Skip    s'+{-# INLINE [0] filter #-}++{-# RULES+  "STREAM filter/filter fusion" forall p q s.+  filter p (filter q s) = filter (\x -> q x && p x) s+  #-}++-- | The 'findIndexI' function takes a predicate and a stream and+-- returns the index of the first element in the stream satisfying the+-- predicate.+findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a+findIndexI p s = case findIndicesI p s of+                  (i:_) -> Just i+                  _     -> Nothing+{-# INLINE [0] findIndexI #-}++-- | The 'findIndicesI' function takes a predicate and a stream and+-- returns all indices of the elements in the stream satisfying the+-- predicate.+findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]+findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0+  where+    loop_findIndex !i !s = case next s of+      Done                   -> []+      Skip    s'             -> loop_findIndex i     s' -- hmm. not caught by QC+      Yield x s' | p x       -> i : loop_findIndex (i+1) s'+                 | otherwise -> loop_findIndex (i+1) s'+{-# INLINE [0] findIndicesI #-}++-------------------------------------------------------------------------------+-- * Zipping++-- | Strict triple.+data Zip a b m = Z1 !a !b+               | Z2 !a !b !m++-- | zipWith generalises 'zip' by zipping with the function given as+-- the first argument, instead of a tupling function.+zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =+    Stream next (Z1 sa0 sb0) (smaller len1 len2)+    where+      next (Z1 sa sb) = case next0 sa of+                          Done -> Done+                          Skip sa' -> Skip (Z1 sa' sb)+                          Yield a sa' -> Skip (Z2 sa' sb a)++      next (Z2 sa' sb a) = case next1 sb of+                             Done -> Done+                             Skip sb' -> Skip (Z2 sa' sb' a)+                             Yield b sb' -> Yield (f a b) (Z1 sa' sb')+{-# INLINE [0] zipWith #-}++-- | /O(n)/ The 'countCharI' function returns the number of times the+-- query element appears in the given stream.+countCharI :: Integral a => Char -> Stream Char -> a+countCharI a (Stream next s0 _len) = loop 0 s0+  where+    loop !i !s = case next s of+      Done                   -> i+      Skip    s'             -> loop i s'+      Yield x s' | a == x    -> loop (i+1) s'+                 | otherwise -> loop i s'+{-# INLINE [0] countCharI #-}++streamError :: String -> String -> a+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg++emptyError :: String -> a+emptyError func = internalError func "Empty input"++internalError :: String -> a+internalError func = streamError func "Internal error"
+ src/Data/Text/Internal/Fusion/Size.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-missing-methods #-}+-- |+-- Module      : Data.Text.Internal.Fusion.Internal+-- Copyright   : (c) Roman Leshchinskiy 2008,+--               (c) Bryan O'Sullivan 2009+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Size hints.++module Data.Text.Internal.Fusion.Size+    (+      Size+      -- * Sizes+    , exactSize+    , maxSize+    , betweenSize+    , unknownSize+    , unionSize+    , charSize+    , codePointsSize+      -- * Querying sizes+    , exactly+    , smaller+    , larger+    , upperBound+    , lowerBound+    , compareSize+    , isEmpty+    ) where++import Data.Char (ord)+import Data.Text.Internal (mul)+#if defined(ASSERTS)+import Control.Exception (assert)+#endif++-- | A size in UTF-16 code units.+data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.+          | Unknown                                         -- ^ Unknown size.+            deriving (Eq, Show)++exactly :: Size -> Maybe Int+exactly (Between na nb) | na == nb = Just na+exactly _ = Nothing+{-# INLINE exactly #-}++-- | The 'Size' of the given code point.+charSize :: Char -> Size+charSize c+  | ord c < 0x10000 = exactSize 1+  | otherwise       = exactSize 2++-- | The 'Size' of @n@ code points.+codePointsSize :: Int -> Size+codePointsSize n =+#if defined(ASSERTS)+    assert (n >= 0)+#endif+    Between n (2*n)+{-# INLINE codePointsSize #-}++exactSize :: Int -> Size+exactSize n =+#if defined(ASSERTS)+    assert (n >= 0)+#endif+    Between n n+{-# INLINE exactSize #-}++maxSize :: Int -> Size+maxSize n =+#if defined(ASSERTS)+    assert (n >= 0)+#endif+    Between 0 n+{-# INLINE maxSize #-}++betweenSize :: Int -> Int -> Size+betweenSize m n =+#if defined(ASSERTS)+    assert (m >= 0)+    assert (n >= m)+#endif+    Between m n+{-# INLINE betweenSize #-}++unionSize :: Size -> Size -> Size+unionSize (Between a b) (Between c d) = Between (min a c) (max b d)+unionSize _ _ = Unknown++unknownSize :: Size+unknownSize = Unknown+{-# INLINE unknownSize #-}++instance Num Size where+    (+) = addSize+    (-) = subtractSize+    (*) = mulSize++    fromInteger = f where f = exactSize . fromInteger+                          {-# INLINE f #-}++add :: Int -> Int -> Int+add m n | mn >=   0 = mn+        | otherwise = overflowError+  where mn = m + n+{-# INLINE add #-}++addSize :: Size -> Size -> Size+addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)+addSize _               _               = Unknown+{-# INLINE addSize #-}++subtractSize :: Size -> Size -> Size+subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)+subtractSize a@(Between 0 _) Unknown         = a+subtractSize (Between _ mb)  Unknown         = Between 0 mb+subtractSize _               _               = Unknown+{-# INLINE subtractSize #-}++mulSize :: Size -> Size -> Size+mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)+mulSize _               _               = Unknown+{-# INLINE mulSize #-}++-- | Minimum of two size hints.+smaller :: Size -> Size -> Size+smaller a@(Between ma mb) b@(Between na nb)+    | mb <= na  = a+    | nb <= ma  = b+    | otherwise = Between (ma `min` na) (mb `min` nb)+smaller a@(Between 0 _) Unknown         = a+smaller (Between _ mb)  Unknown         = Between 0 mb+smaller Unknown         b@(Between 0 _) = b+smaller Unknown         (Between _ nb)  = Between 0 nb+smaller Unknown         Unknown         = Unknown+{-# INLINE smaller #-}++-- | Maximum of two size hints.+larger :: Size -> Size -> Size+larger a@(Between ma mb) b@(Between na nb)+    | ma >= nb  = a+    | na >= mb  = b+    | otherwise = Between (ma `max` na) (mb `max` nb)+larger _ _ = Unknown+{-# INLINE larger #-}++-- | Compute the maximum size from a size hint, if possible.+upperBound :: Int -> Size -> Int+upperBound _ (Between _ n) = n+upperBound k _             = k+{-# INLINE upperBound #-}++-- | Compute the maximum size from a size hint, if possible.+lowerBound :: Int -> Size -> Int+lowerBound _ (Between n _) = n+lowerBound k _             = k+{-# INLINE lowerBound #-}++-- | Determine the ordering relationship between two 'Size's, or 'Nothing' in+-- the indeterminate case.+compareSize :: Size -> Size -> Maybe Ordering+compareSize (Between ma mb) (Between na nb)+  | mb < na            = Just LT+  | ma > nb            = Just GT+  | ma == mb+  , ma == na+  , ma == nb           = Just EQ+compareSize _ _        = Nothing+++isEmpty :: Size -> Bool+isEmpty (Between _ n) = n <= 0+isEmpty _             = False+{-# INLINE isEmpty #-}++overflowError :: Int+overflowError = error "Data.Text.Internal.Fusion.Size: size overflow"
+ src/Data/Text/Internal/Fusion/Types.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE BangPatterns, ExistentialQuantification #-}+-- |+-- Module      : Data.Text.Internal.Fusion.Types+-- Copyright   : (c) Tom Harper 2008-2009,+--               (c) Bryan O'Sullivan 2009,+--               (c) Duncan Coutts 2009,+--               (c) Jasper Van der Jeugt 2011+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Core stream fusion functionality for text.++module Data.Text.Internal.Fusion.Types+    (+      CC(..)+    , PairS(..)+    , Scan(..)+    , RS(..)+    , Step(..)+    , Stream(..)+    , empty+    ) where++import Data.Text.Internal.Fusion.Size+import Data.Word (Word8)++-- | Specialised tuple for case conversion.+data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char++-- | Restreaming state.+data RS s+    = RS0 !s+    | RS1 !s {-# UNPACK #-} !Word8+    | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+    | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8++-- | Strict pair.+data PairS a b = !a :*: !b+                 -- deriving (Eq, Ord, Show)+infixl 2 :*:++-- | An intermediate result in a scan.+data Scan s = Scan1 {-# UNPACK #-} !Char !s+            | Scan2 {-# UNPACK #-} !Char !s++-- | Intermediate result in a processing pipeline.+data Step s a = Done+              | Skip !s+              | Yield !a !s++{-+instance (Show a) => Show (Step s a)+    where show Done        = "Done"+          show (Skip _)    = "Skip"+          show (Yield x _) = "Yield " ++ show x+-}++instance (Eq a) => Eq (Stream a) where+    (==) = eq++instance (Ord a) => Ord (Stream a) where+    compare = cmp++-- The length hint in a Stream has two roles.  If its value is zero,+-- we trust it, and treat the stream as empty.  Otherwise, we treat it+-- as a hint: it should usually be accurate, so we use it when+-- unstreaming to decide what size array to allocate.  However, the+-- unstreaming functions must be able to cope with the hint being too+-- small or too large.+--+-- The size hint tries to track the UTF-16 code units in a stream,+-- but often counts the number of code points instead.  It can easily+-- undercount if, for instance, a transformed stream contains astral+-- plane code points (those above 0x10000).++data Stream a =+    forall s. Stream+    (s -> Step s a)             -- stepper function+    !s                          -- current state+    !Size                       -- size hint in code units++-- | /O(n)/ Determines if two streams are equal.+eq :: (Eq a) => Stream a -> Stream a -> Bool+eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+    where+      loop Done Done                     = True+      loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')+      loop (Skip s1')     x2             = loop (next1 s1') x2+      loop x1             (Skip s2')     = loop x1          (next2 s2')+      loop Done _                        = False+      loop _    Done                     = False+      loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&+                                           loop (next1 s1') (next2 s2')+{-# INLINE [0] eq #-}++cmp :: (Ord a) => Stream a -> Stream a -> Ordering+cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+    where+      loop Done Done                     = EQ+      loop (Skip s1')     (Skip s2')     = loop (next1 s1') (next2 s2')+      loop (Skip s1')     x2             = loop (next1 s1') x2+      loop x1             (Skip s2')     = loop x1          (next2 s2')+      loop Done _                        = LT+      loop _    Done                     = GT+      loop (Yield x1 s1') (Yield x2 s2') =+          case compare x1 x2 of+            EQ    -> loop (next1 s1') (next2 s2')+            other -> other+{-# INLINE [0] cmp #-}++-- | The empty stream.+empty :: Stream a+empty = Stream next () 0+    where next _ = Done+{-# INLINE [0] empty #-}
+ src/Data/Text/Internal/IO.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE BangPatterns, RecordWildCards #-}+-- |+-- Module      : Data.Text.Internal.IO+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,+--               (c) 2009 Simon Marlow+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Low-level support for text I\/O.++module Data.Text.Internal.IO+    (+      hGetLineWith+    , readChunk+    ) where++import qualified Control.Exception as E+import Data.IORef (readIORef, writeIORef)+import Data.Text (Text)+import Data.Text.Internal.Fusion (unstream)+import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))+import Data.Text.Internal.Fusion.Size (exactSize, maxSize)+import Data.Text.Unsafe (inlinePerformIO)+import Foreign.Storable (peekElemOff)+import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,+                      bufferElems, charSize, isEmptyBuffer, readCharBuf,+                      withRawBuffer, writeCharBuf)+import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)+import GHC.IO.Handle.Types (Handle__(..), Newline(..))+import System.IO (Handle)+import System.IO.Error (isEOFError)+import qualified Data.Text as T++-- | Read a single line of input from a handle, constructing a list of+-- decoded chunks as we go.  When we're done, transform them into the+-- destination type.+hGetLineWith :: ([Text] -> t) -> Handle -> IO t+hGetLineWith f h = wantReadableHandle_ "hGetLine" h go+  where+    go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh []++hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]+hGetLineLoop hh@Handle__{..} = go where+ go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do+  let findEOL raw r | r == w    = return (False, w)+                    | otherwise = do+        (c,r') <- readCharBuf raw r+        if c == '\n'+          then return (True, r)+          else findEOL raw r'+  (eol, off) <- findEOL raw0 r0+  (t,r') <- if haInputNL == CRLF+            then unpack_nl raw0 r0 off+            else do t <- unpack raw0 r0 off+                    return (t,off)+  if eol+    then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)+            return $ reverse (t:ts)+    else do+      let buf1 = bufferAdjustL r' buf+      maybe_buf <- maybeFillReadBuffer hh buf1+      case maybe_buf of+         -- Nothing indicates we caught an EOF, and we may have a+         -- partial line to return.+         Nothing -> do+              -- we reached EOF.  There might be a lone \r left+              -- in the buffer, so check for that and+              -- append it to the line if necessary.+              let pre | isEmptyBuffer buf1 = T.empty+                      | otherwise          = T.singleton '\r'+              writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }+              let str = reverse . filter (not . T.null) $ pre:t:ts+              if null str+                then ioe_EOF+                else return str+         Just new_buf -> go (t:ts) new_buf++-- This function is lifted almost verbatim from GHC.IO.Handle.Text.+maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)+maybeFillReadBuffer handle_ buf+  = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->+      if isEOFError e+      then return Nothing+      else ioError e++unpack :: RawCharBuffer -> Int -> Int -> IO Text+unpack !buf !r !w+ | charSize /= 4 = sizeError "unpack"+ | r >= w        = return T.empty+ | otherwise     = withRawBuffer buf go+ where+  go pbuf = return $! unstream (Stream next r (exactSize (w-r)))+   where+    next !i | i >= w    = Done+            | otherwise = Yield (ix i) (i+1)+    ix i = inlinePerformIO $ peekElemOff pbuf i++unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)+unpack_nl !buf !r !w+ | charSize /= 4 = sizeError "unpack_nl"+ | r >= w        = return (T.empty, 0)+ | otherwise     = withRawBuffer buf $ go+ where+  go pbuf = do+    let !t = unstream (Stream next r (maxSize (w-r)))+        w' = w - 1+    return $ if ix w' == '\r'+             then (t,w')+             else (t,w)+   where+    next !i | i >= w = Done+            | c == '\r' = let i' = i + 1+                          in if i' < w+                             then if ix i' == '\n'+                                  then Yield '\n' (i+2)+                                  else Yield '\n' i'+                             else Done+            | otherwise = Yield c (i+1)+            where c = ix i+    ix i = inlinePerformIO $ peekElemOff pbuf i++-- This function is completely lifted from GHC.IO.Handle.Text.+getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer+getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =+  case bufferElems buf of+    -- buffer empty: read some more+    0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf++    -- if the buffer has a single '\r' in it and we're doing newline+    -- translation: read some more+    1 | haInputNL == CRLF -> do+      (c,_) <- readCharBuf bufRaw bufL+      if c == '\r'+         then do -- shuffle the '\r' to the beginning.  This is only safe+                 -- if we're about to call readTextDevice, otherwise it+                 -- would mess up flushCharBuffer.+                 -- See [note Buffer Flushing], GHC.IO.Handle.Types+                 _ <- writeCharBuf bufRaw 0 '\r'+                 let buf' = buf{ bufL=0, bufR=1 }+                 readTextDevice handle_ buf'+         else do+                 return buf++    -- buffer has some chars in it already: just return it+    _otherwise -> {-# SCC "otherwise" #-} return buf++-- | Read a single chunk of strict text from a buffer. Used by both+-- the strict and lazy implementations of hGetContents.+readChunk :: Handle__ -> CharBuffer -> IO Text+readChunk hh@Handle__{..} buf = do+  buf'@Buffer{..} <- getSomeCharacters hh buf+  (t,r) <- if haInputNL == CRLF+           then unpack_nl bufRaw bufL bufR+           else do t <- unpack bufRaw bufL bufR+                   return (t,bufR)+  writeIORef haCharBuffer (bufferAdjustL r buf')+  return t++sizeError :: String -> a+sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"
+ src/Data/Text/Internal/Lazy.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}+{-# OPTIONS_HADDOCK not-home #-}++-- |+-- Module      : Data.Text.Internal.Lazy+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- A module containing private 'Text' internals. This exposes the+-- 'Text' representation and low level construction functions.+-- Modules which extend the 'Text' system may need to use this module.++module Data.Text.Internal.Lazy+    (+      Text(..)+    , chunk+    , empty+    , foldrChunks+    , foldlChunks+    -- * Data type invariant and abstraction functions++    -- $invariant+    , strictInvariant+    , lazyInvariant+    , showStructure++    -- * Chunk allocation sizes+    , defaultChunkSize+    , smallChunkSize+    , chunkOverhead+    ) where++import Data.Text ()+import Data.Text.Internal.Unsafe.Shift (shiftL)+import Data.Typeable (Typeable)+import Foreign.Storable (sizeOf)+import qualified Data.Text.Internal as T++data Text = Empty+          | Chunk {-# UNPACK #-} !T.Text Text+            deriving (Typeable)++-- $invariant+--+-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or+-- consists of non-null 'T.Text's.  All functions must preserve this,+-- and the QC properties must check this.++-- | Check the invariant strictly.+strictInvariant :: Text -> Bool+strictInvariant Empty = True+strictInvariant x@(Chunk (T.Text _ _ len) cs)+    | len > 0   = strictInvariant cs+    | otherwise = error $ "Data.Text.Lazy: invariant violation: "+                  ++ showStructure x++-- | Check the invariant lazily.+lazyInvariant :: Text -> Text+lazyInvariant Empty = Empty+lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)+    | len > 0   = Chunk c (lazyInvariant cs)+    | otherwise = error $ "Data.Text.Lazy: invariant violation: "+                  ++ showStructure x++-- | Display the internal structure of a lazy 'Text'.+showStructure :: Text -> String+showStructure Empty           = "Empty"+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"+showStructure (Chunk t ts)    =+    "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"++-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.+chunk :: T.Text -> Text -> Text+{-# INLINE chunk #-}+chunk t@(T.Text _ _ len) ts | len == 0 = ts+                            | otherwise = Chunk t ts++-- | Smart constructor for 'Empty'.+empty :: Text+{-# INLINE [0] empty #-}+empty = Empty++-- | Consume the chunks of a lazy 'Text' with a natural right fold.+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a+foldrChunks f z = go+  where go Empty        = z+        go (Chunk c cs) = f c (go cs)+{-# INLINE foldrChunks #-}++-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,+-- accumulating left fold.+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a+foldlChunks f z = go z+  where go !a Empty        = a+        go !a (Chunk c cs) = go (f a c) cs+{-# INLINE foldlChunks #-}++-- | Currently set to 16 KiB, less the memory management overhead.+defaultChunkSize :: Int+defaultChunkSize = 16384 - chunkOverhead+{-# INLINE defaultChunkSize #-}++-- | Currently set to 128 bytes, less the memory management overhead.+smallChunkSize :: Int+smallChunkSize = 128 - chunkOverhead+{-# INLINE smallChunkSize #-}++-- | The memory management overhead. Currently this is tuned for GHC only.+chunkOverhead :: Int+chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1+{-# INLINE chunkOverhead #-}
+ src/Data/Text/Internal/Lazy/Encoding/Fusion.hs view
@@ -0,0 +1,324 @@+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}++-- |+-- Module      : Data.Text.Lazy.Encoding.Fusion+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fusible 'Stream'-oriented functions for converting between lazy+-- 'Text' and several common encodings.++module Data.Text.Internal.Lazy.Encoding.Fusion+    (+    -- * Streaming+    --  streamASCII+      streamUtf8+    , streamUtf16LE+    , streamUtf16BE+    , streamUtf32LE+    , streamUtf32BE++    -- * Unstreaming+    , unstream++    , module Data.Text.Internal.Encoding.Fusion.Common+    ) where++import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import Data.Text.Internal.Encoding.Fusion.Common+import Data.Text.Encoding.Error+import Data.Text.Internal.Fusion (Step(..), Stream(..))+import Data.Text.Internal.Fusion.Size+import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)+import Data.Text.Internal.Unsafe.Shift (shiftL)+import Data.Word (Word8, Word16, Word32)+import qualified Data.Text.Internal.Encoding.Utf8 as U8+import qualified Data.Text.Internal.Encoding.Utf16 as U16+import qualified Data.Text.Internal.Encoding.Utf32 as U32+import Data.Text.Unsafe (unsafeDupablePerformIO)+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)+import Foreign.Storable (pokeByteOff)+import Data.ByteString.Internal (mallocByteString, memcpy)+#if defined(ASSERTS)+import Control.Exception (assert)+#endif+import Data.Text.Internal.ByteStringCompat++data S = S0+       | S1 {-# UNPACK #-} !Word8+       | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+       | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8+       | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8++data T = T !ByteString !S {-# UNPACK #-} !Int++-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using+-- UTF-8 encoding.+streamUtf8 :: OnDecodeError -> ByteString -> Stream Char+streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize+  where+    next (T bs@(Chunk ps _) S0 i)+      | i < len && U8.validate1 a =+          Yield (unsafeChr8 a)    (T bs S0 (i+1))+      | i + 1 < len && U8.validate2 a b =+          Yield (U8.chr2 a b)     (T bs S0 (i+2))+      | i + 2 < len && U8.validate3 a b c =+          Yield (U8.chr3 a b c)   (T bs S0 (i+3))+      | i + 3 < len && U8.validate4 a b c d =+          Yield (U8.chr4 a b c d) (T bs S0 (i+4))+      where len = B.length ps+            a = B.unsafeIndex ps i+            b = B.unsafeIndex ps (i+1)+            c = B.unsafeIndex ps (i+2)+            d = B.unsafeIndex ps (i+3)+    next st@(T bs s i) =+      case s of+        S1 a       | U8.validate1 a       -> Yield (unsafeChr8 a)    es+        S2 a b     | U8.validate2 a b     -> Yield (U8.chr2 a b)     es+        S3 a b c   | U8.validate3 a b c   -> Yield (U8.chr3 a b c)   es+        S4 a b c d | U8.validate4 a b c d -> Yield (U8.chr4 a b c d) es+        _ -> consume st+       where es = T bs S0 i+    consume (T bs@(Chunk ps rest) s i)+        | i >= B.length ps = consume (T rest s 0)+        | otherwise =+      case s of+        S0         -> next (T bs (S1 x)       (i+1))+        S1 a       -> next (T bs (S2 a x)     (i+1))+        S2 a b     -> next (T bs (S3 a b x)   (i+1))+        S3 a b c   -> next (T bs (S4 a b c x) (i+1))+        S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)+                           (T bs (S3 b c d)   (i+1))+        where x = B.unsafeIndex ps i+    consume (T Empty S0 _) = Done+    consume st             = decodeError "streamUtf8" "UTF-8" onErr Nothing st+{-# INLINE [0] streamUtf8 #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-16 encoding.+streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char+streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize+  where+    next (T bs@(Chunk ps _) S0 i)+      | i + 1 < len && U16.validate1 x1 =+          Yield (unsafeChr x1)         (T bs S0 (i+2))+      | i + 3 < len && U16.validate2 x1 x2 =+          Yield (U16.chr2 x1 x2)       (T bs S0 (i+4))+      where len = B.length ps+            x1   = c (idx  i)      (idx (i + 1))+            x2   = c (idx (i + 2)) (idx (i + 3))+            c w1 w2 = w1 + (w2 `shiftL` 8)+            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16+    next st@(T bs s i) =+      case s of+        S2 w1 w2       | U16.validate1 (c w1 w2)           ->+          Yield (unsafeChr (c w1 w2))   es+        S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->+          Yield (U16.chr2 (c w1 w2) (c w3 w4)) es+        _ -> consume st+       where es = T bs S0 i+             c :: Word8 -> Word8 -> Word16+             c w1 w2 = fromIntegral w1 + (fromIntegral w2 `shiftL` 8)+    consume (T bs@(Chunk ps rest) s i)+        | i >= B.length ps = consume (T rest s 0)+        | otherwise =+      case s of+        S0             -> next (T bs (S1 x)          (i+1))+        S1 w1          -> next (T bs (S2 w1 x)       (i+1))+        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))+        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))+        S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)+                           (T bs (S3 w2 w3 w4)       (i+1))+        where x = B.unsafeIndex ps i+    consume (T Empty S0 _) = Done+    consume st             = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st+{-# INLINE [0] streamUtf16LE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-16 encoding.+streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char+streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize+  where+    next (T bs@(Chunk ps _) S0 i)+      | i + 1 < len && U16.validate1 x1 =+          Yield (unsafeChr x1)         (T bs S0 (i+2))+      | i + 3 < len && U16.validate2 x1 x2 =+          Yield (U16.chr2 x1 x2)       (T bs S0 (i+4))+      where len = B.length ps+            x1   = c (idx  i)      (idx (i + 1))+            x2   = c (idx (i + 2)) (idx (i + 3))+            c w1 w2 = (w1 `shiftL` 8) + w2+            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16+    next st@(T bs s i) =+      case s of+        S2 w1 w2       | U16.validate1 (c w1 w2)           ->+          Yield (unsafeChr (c w1 w2))   es+        S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->+          Yield (U16.chr2 (c w1 w2) (c w3 w4)) es+        _ -> consume st+       where es = T bs S0 i+             c :: Word8 -> Word8 -> Word16+             c w1 w2 = (fromIntegral w1 `shiftL` 8) + fromIntegral w2+    consume (T bs@(Chunk ps rest) s i)+        | i >= B.length ps = consume (T rest s 0)+        | otherwise =+      case s of+        S0             -> next (T bs (S1 x)          (i+1))+        S1 w1          -> next (T bs (S2 w1 x)       (i+1))+        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))+        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))+        S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)+                           (T bs (S3 w2 w3 w4)       (i+1))+        where x = B.unsafeIndex ps i+    consume (T Empty S0 _) = Done+    consume st             = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st+{-# INLINE [0] streamUtf16BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-32 encoding.+streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char+streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize+  where+    next (T bs@(Chunk ps _) S0 i)+      | i + 3 < len && U32.validate x =+          Yield (unsafeChr32 x)       (T bs S0 (i+4))+      where len = B.length ps+            x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4+            x1    = idx i+            x2    = idx (i+1)+            x3    = idx (i+2)+            x4    = idx (i+3)+            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32+    next st@(T bs s i) =+      case s of+        S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->+          Yield (unsafeChr32 (c w1 w2 w3 w4)) es+        _ -> consume st+       where es = T bs S0 i+             c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32+             c w1 w2 w3 w4 = shifted+              where+               shifted = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4+               x1 = fromIntegral w1+               x2 = fromIntegral w2+               x3 = fromIntegral w3+               x4 = fromIntegral w4+    consume (T bs@(Chunk ps rest) s i)+        | i >= B.length ps = consume (T rest s 0)+        | otherwise =+      case s of+        S0             -> next (T bs (S1 x)          (i+1))+        S1 w1          -> next (T bs (S2 w1 x)       (i+1))+        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))+        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))+        S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)+                           (T bs (S3 w2 w3 w4)       (i+1))+        where x = B.unsafeIndex ps i+    consume (T Empty S0 _) = Done+    consume st             = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st+{-# INLINE [0] streamUtf32BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-32 encoding.+streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char+streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize+  where+    next (T bs@(Chunk ps _) S0 i)+      | i + 3 < len && U32.validate x =+          Yield (unsafeChr32 x)       (T bs S0 (i+4))+      where len = B.length ps+            x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1+            x1    = idx i+            x2    = idx (i+1)+            x3    = idx (i+2)+            x4    = idx (i+3)+            idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32+    next st@(T bs s i) =+      case s of+        S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->+          Yield (unsafeChr32 (c w1 w2 w3 w4)) es+        _ -> consume st+       where es = T bs S0 i+             c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32+             c w1 w2 w3 w4 = shifted+              where+               shifted = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1+               x1 = fromIntegral w1+               x2 = fromIntegral w2+               x3 = fromIntegral w3+               x4 = fromIntegral w4+    consume (T bs@(Chunk ps rest) s i)+        | i >= B.length ps = consume (T rest s 0)+        | otherwise =+      case s of+        S0             -> next (T bs (S1 x)          (i+1))+        S1 w1          -> next (T bs (S2 w1 x)       (i+1))+        S2 w1 w2       -> next (T bs (S3 w1 w2 x)    (i+1))+        S3 w1 w2 w3    -> next (T bs (S4 w1 w2 w3 x) (i+1))+        S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)+                           (T bs (S3 w2 w3 w4)       (i+1))+        where x = B.unsafeIndex ps i+    consume (T Empty S0 _) = Done+    consume st             = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st+{-# INLINE [0] streamUtf32LE #-}++-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.+unstreamChunks :: Int -> Stream Word8 -> ByteString+unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)+  where chunk s1 len1 = unsafeDupablePerformIO $ do+          let len = max 4 (min len1 chunkSize)+          mallocByteString len >>= loop len 0 s1+          where+            loop !n !off !s fp = case next s of+                Done | off == 0 -> return Empty+                     | otherwise -> return $! Chunk (trimUp fp off) Empty+                Skip s' -> loop n off s' fp+                Yield x s'+                    | off == chunkSize -> do+                      let !newLen = n - off+                      return $! Chunk (trimUp fp off) (chunk s newLen)+                    | off == n -> realloc fp n off s' x+                    | otherwise -> do+                      withForeignPtr fp $ \p -> pokeByteOff p off x+                      loop n (off+1) s' fp+            {-# NOINLINE realloc #-}+            realloc fp n off s x = do+              let n' = min (n+n) chunkSize+              fp' <- copy0 fp n n'+              withForeignPtr fp' $ \p -> pokeByteOff p off x+              loop n' (off+1) s fp'+            trimUp fp off = mkBS fp off+            copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)+            copy0 !src !srcLen !destLen =+#if defined(ASSERTS)+              assert (srcLen <= destLen) $+#endif+              do+                dest <- mallocByteString destLen+                withForeignPtr src  $ \src'  ->+                    withForeignPtr dest $ \dest' ->+                        memcpy dest' src' (fromIntegral srcLen)+                return dest++-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.+unstream :: Stream Word8 -> ByteString+unstream = unstreamChunks defaultChunkSize++decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8+            -> s -> Step s Char+decodeError func kind onErr mb i =+    case onErr desc mb of+      Nothing -> Skip i+      Just c  -> Yield c i+    where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " +++                 kind ++ " stream"
+ src/Data/Text/Internal/Lazy/Fusion.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module      : Data.Text.Lazy.Fusion+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Core stream fusion functionality for text.++module Data.Text.Internal.Lazy.Fusion+    (+      stream+    , unstream+    , unstreamChunks+    , length+    , unfoldrN+    , index+    , countChar+    ) where++import Prelude hiding (length)+import qualified Data.Text.Internal.Fusion.Common as S+import Control.Monad.ST (runST)+import Data.Text.Internal.Fusion.Types+import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)+import Data.Text.Internal.Lazy+import qualified Data.Text.Internal as I+import qualified Data.Text.Array as A+import Data.Text.Internal.Unsafe.Char (unsafeWrite)+import Data.Text.Internal.Unsafe.Shift (shiftL)+import Data.Text.Unsafe (Iter(..), iter)+import Data.Int (Int64)++default(Int64)++-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.+stream :: Text -> Stream Char+stream text = Stream next (text :*: 0) unknownSize+  where+    next (Empty :*: _) = Done+    next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)+        | i >= len  = next (ts :*: 0)+        | otherwise = Yield c (txt :*: i+d)+        where Iter c d = iter t i+{-# INLINE [0] stream #-}++-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given+-- chunk size.+unstreamChunks :: Int -> Stream Char -> Text+unstreamChunks !chunkSize (Stream next s0 len0)+  | isEmpty len0 = Empty+  | otherwise    = outer s0+  where+    outer so = {-# SCC "unstreamChunks/outer" #-}+              case next so of+                Done       -> Empty+                Skip s'    -> outer s'+                Yield x s' -> runST $ do+                                a <- A.new unknownLength+                                unsafeWrite a 0 x >>= inner a unknownLength s'+                    where unknownLength = 4+      where+        inner marr !len s !i+            | i + 1 >= chunkSize = finish marr i s+            | i + 1 >= len       = {-# SCC "unstreamChunks/resize" #-} do+                let newLen = min (len `shiftL` 1) chunkSize+                marr' <- A.new newLen+                A.copyM marr' 0 marr 0 len+                inner marr' newLen s i+            | otherwise =+                {-# SCC "unstreamChunks/inner" #-}+                case next s of+                  Done        -> finish marr i s+                  Skip s'     -> inner marr len s' i+                  Yield x s'  -> do d <- unsafeWrite marr i x+                                    inner marr len s' (i+d)+        finish marr len s' = do+          arr <- A.unsafeFreeze marr+          return (I.Text arr 0 len `Chunk` outer s')+{-# INLINE [0] unstreamChunks #-}++-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using+-- 'defaultChunkSize'.+unstream :: Stream Char -> Text+unstream = unstreamChunks defaultChunkSize+{-# INLINE [0] unstream #-}++-- | /O(n)/ Returns the number of characters in a text.+length :: Stream Char -> Int64+length = S.lengthI+{-# INLINE[0] length #-}++{-# RULES "LAZY STREAM stream/unstream fusion" forall s.+    stream (unstream s) = s #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldrN n = S.unfoldrNI n+{-# INLINE [0] unfoldrN #-}++-- | /O(n)/ stream index (subscript) operator, starting from 0.+index :: Stream Char -> Int64 -> Char+index = S.indexI+{-# INLINE [0] index #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given stream.+countChar :: Char -> Stream Char -> Int64+countChar = S.countCharI+{-# INLINE [0] countChar #-}
+ src/Data/Text/Internal/Lazy/Search.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}++-- |+-- Module      : Data.Text.Lazy.Search+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fast substring search for lazy 'Text', based on work by Boyer,+-- Moore, Horspool, Sunday, and Lundh.  Adapted from the strict+-- implementation.++module Data.Text.Internal.Lazy.Search+    (+      indices+    ) where++import qualified Data.Text.Array as A+import Data.Int (Int64)+import Data.Word (Word16, Word64)+import qualified Data.Text.Internal as T+import Data.Text.Internal.Fusion.Types (PairS(..))+import Data.Text.Internal.Lazy (Text(..), foldlChunks)+import Data.Bits ((.|.), (.&.))+import Data.Text.Internal.Unsafe.Shift (shiftL)++-- | /O(n+m)/ Find the offsets of all non-overlapping indices of+-- @needle@ within @haystack@.+--+-- This function is strict in @needle@, and lazy (as far as possible)+-- in the chunks of @haystack@.+--+-- In (unlikely) bad cases, this algorithm's complexity degrades+-- towards /O(n*m)/.+indices :: Text              -- ^ Substring to search for (@needle@)+        -> Text              -- ^ Text to search in (@haystack@)+        -> [Int64]+indices needle@(Chunk n ns) _haystack@(Chunk k ks)+    | nlen <= 0  = []+    | nlen == 1  = indicesOne (nindex 0) 0 k ks+    | otherwise  = advance k ks 0 0+  where+    advance x@(T.Text _ _ l) xs = scan+     where+      scan !g !i+         | i >= m = case xs of+                      Empty           -> []+                      Chunk y ys      -> advance y ys g (i-m)+         | lackingHay (i + nlen) x xs  = []+         | c == z && candidateMatch 0  = g : scan (g+nlen) (i+nlen)+         | otherwise                   = scan (g+delta) (i+delta)+       where+         m = fromIntegral l+         c = hindex (i + nlast)+         delta | nextInPattern = nlen + 1+               | c == z        = skip + 1+               | otherwise     = 1+         nextInPattern         = mask .&. swizzle (hindex (i+nlen)) == 0+         candidateMatch !j+             | j >= nlast               = True+             | hindex (i+j) /= nindex j = False+             | otherwise                = candidateMatch (j+1)+         hindex                         = index x xs+    nlen      = wordLength needle+    nlast     = nlen - 1+    nindex    = index n ns+    z         = foldlChunks fin 0 needle+        where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)+    (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)+    swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)+    buildTable (T.Text xarr xoff xlen) xs = go+      where+        go !(g::Int64) !i !msk !skp+            | i >= xlast = case xs of+                             Empty      -> (msk .|. swizzle z) :*: skp+                             Chunk y ys -> buildTable y ys g 0 msk' skp'+            | otherwise = go (g+1) (i+1) msk' skp'+            where c                = A.unsafeIndex xarr (xoff+i)+                  msk'             = msk .|. swizzle c+                  skp' | c == z    = nlen - g - 2+                       | otherwise = skp+                  xlast = xlen - 1+    -- | Check whether an attempt to index into the haystack at the+    -- given offset would fail.+    lackingHay q = go 0+      where+        go p (T.Text _ _ l) ps = p' < q && case ps of+                                             Empty      -> True+                                             Chunk r rs -> go p' r rs+            where p' = p + fromIntegral l+indices _ _ = []++-- | Fast index into a partly unpacked 'Text'.  We take into account+-- the possibility that the caller might try to access one element+-- past the end.+index :: T.Text -> Text -> Int64 -> Word16+index (T.Text arr off len) xs !i+    | j < len   = A.unsafeIndex arr (off+j)+    | otherwise = case xs of+                    Empty+                        -- out of bounds, but legal+                        | j == len  -> 0+                        -- should never happen, due to lackingHay above+                        | otherwise -> emptyError "index"+                    Chunk c cs -> index c cs (i-fromIntegral len)+    where j = fromIntegral i++-- | A variant of 'indices' that scans linearly for a single 'Word16'.+indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]+indicesOne c = chunk+  where+    chunk !i (T.Text oarr ooff olen) os = go 0+      where+        go h | h >= olen = case os of+                             Empty      -> []+                             Chunk y ys -> chunk (i+fromIntegral olen) y ys+             | on == c = i + fromIntegral h : go (h+1)+             | otherwise = go (h+1)+             where on = A.unsafeIndex oarr (ooff+h)++-- | The number of 'Word16' values in a 'Text'.+wordLength :: Text -> Int64+wordLength = foldlChunks sumLength 0+    where sumLength i (T.Text _ _ l) = i + fromIntegral l++emptyError :: String -> a+emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
+ src/Data/Text/Internal/Private.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}++-- |+-- Module      : Data.Text.Internal.Private+-- Copyright   : (c) 2011 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC++module Data.Text.Internal.Private+    (+      runText+    , span_+    ) where++import Control.Monad.ST (ST, runST)+import Data.Text.Internal (Text(..), text)+import Data.Text.Unsafe (Iter(..), iter)+import qualified Data.Text.Array as A++span_ :: (Char -> Bool) -> Text -> (# Text, Text #)+span_ p t@(Text arr off len) = (# hd,tl #)+  where hd = text arr off k+        tl = text arr (off+k) (len-k)+        !k = loop 0+        loop !i | i < len && p c = loop (i+d)+                | otherwise      = i+            where Iter c d       = iter t i+{-# INLINE span_ #-}++runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text+runText act = runST (act $ \ !marr !len -> do+                             arr <- A.unsafeFreeze marr+                             return $! text arr 0 len)+{-# INLINE runText #-}
+ src/Data/Text/Internal/Read.hs view
@@ -0,0 +1,69 @@+-- |+-- Module      : Data.Text.Internal.Read+-- Copyright   : (c) 2014 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- Common internal functions for reading textual data.+module Data.Text.Internal.Read+    (+      IReader+    , IParser(..)+    , T(..)+    , digitToInt+    , hexDigitToInt+    , perhaps+    ) where++import Control.Applicative as App (Applicative(..))+import Control.Arrow (first)+import Control.Monad (ap)+import Data.Char (ord)++type IReader t a = t -> Either String (a,t)++newtype IParser t a = P {+      runP :: IReader t a+    }++instance Functor (IParser t) where+    fmap f m = P $ fmap (first f) . runP m++instance Applicative (IParser t) where+    pure a = P $ \t -> Right (a,t)+    {-# INLINE pure #-}+    (<*>) = ap++instance Monad (IParser t) where+    return = App.pure+    m >>= k  = P $ \t -> case runP m t of+                           Left err     -> Left err+                           Right (a,t') -> runP (k a) t'+    {-# INLINE (>>=) #-}++-- If we ever need a `MonadFail` instance the definition below can be used+--+-- > instance MonadFail (IParser t) where+-- >   fail msg = P $ \_ -> Left msg+--+-- But given the code compiles fine with a post-MFP GHC 8.6+ we don't need+-- one just yet.++data T = T !Integer !Int++perhaps :: a -> IParser t a -> IParser t a+perhaps def m = P $ \t -> case runP m t of+                            Left _      -> Right (def,t)+                            r@(Right _) -> r++hexDigitToInt :: Char -> Int+hexDigitToInt c+    | c >= '0' && c <= '9' = ord c - ord '0'+    | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)+    | otherwise            = ord c - (ord 'A' - 10)++digitToInt :: Char -> Int+digitToInt c = ord c - ord '0'
+ src/Data/Text/Internal/Search.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}++-- |+-- Module      : Data.Text.Internal.Search+-- Copyright   : (c) Bryan O'Sullivan 2009+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- Fast substring search for 'Text', based on work by Boyer, Moore,+-- Horspool, Sunday, and Lundh.+--+-- References:+--+-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.+--   Communications of the ACM, 20, 10, 762-772 (1977)+--+-- * R. N. Horspool: Practical Fast Searching in Strings.  Software -+--   Practice and Experience 10, 501-506 (1980)+--+-- * D. M. Sunday: A Very Fast Substring Search Algorithm.+--   Communications of the ACM, 33, 8, 132-142 (1990)+--+-- * F. Lundh: The Fast Search Algorithm.+--   <http://effbot.org/zone/stringlib.htm> (2006)++module Data.Text.Internal.Search+    (+      indices+    ) where++import qualified Data.Text.Array as A+import Data.Word (Word64)+import Data.Text.Internal (Text(..))+import Data.Bits ((.|.), (.&.))+import Data.Text.Internal.Unsafe.Shift (shiftL)++data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int++-- | /O(n+m)/ Find the offsets of all non-overlapping indices of+-- @needle@ within @haystack@.  The offsets returned represent+-- uncorrected indices in the low-level \"needle\" array, to which its+-- offset must be added.+--+-- In (unlikely) bad cases, this algorithm's complexity degrades+-- towards /O(n*m)/.+indices :: Text                -- ^ Substring to search for (@needle@)+        -> Text                -- ^ Text to search in (@haystack@)+        -> [Int]+indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)+    | nlen == 1              = scanOne (nindex 0)+    | nlen <= 0 || ldiff < 0 = []+    | otherwise              = scan 0+  where+    ldiff    = hlen - nlen+    nlast    = nlen - 1+    z        = nindex nlast+    nindex k = A.unsafeIndex narr (noff+k)+    hindex k = A.unsafeIndex harr (hoff+k)+    hindex' k | k == hlen  = 0+              | otherwise = A.unsafeIndex harr (hoff+k)+    buildTable !i !msk !skp+        | i >= nlast           = (msk .|. swizzle z) :* skp+        | otherwise            = buildTable (i+1) (msk .|. swizzle c) skp'+        where c                = nindex i+              skp' | c == z    = nlen - i - 2+                   | otherwise = skp+    swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)+    scan !i+        | i > ldiff                  = []+        | c == z && candidateMatch 0 = i : scan (i + nlen)+        | otherwise                  = scan (i + delta)+        where c = hindex (i + nlast)+              candidateMatch !j+                    | j >= nlast               = True+                    | hindex (i+j) /= nindex j = False+                    | otherwise                = candidateMatch (j+1)+              delta | nextInPattern = nlen + 1+                    | c == z        = skip + 1+                    | otherwise     = 1+                where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0+              !(mask :* skip)       = buildTable 0 0 (nlen-2)+    scanOne c = loop 0+        where loop !i | i >= hlen     = []+                      | hindex i == c = i : loop (i+1)+                      | otherwise     = loop (i+1)+{-# INLINE indices #-}
+ src/Data/Text/Internal/Unsafe.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}+{-# OPTIONS_HADDOCK not-home #-}++-- |+-- Module      : Data.Text.Internal.Unsafe+-- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : portable+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- A module containing /unsafe/ operations, for /very very careful/ use+-- in /heavily tested/ code.+module Data.Text.Internal.Unsafe+    (+      inlineInterleaveST+    , inlinePerformIO+    ) where++import GHC.ST (ST(..))+#if defined(__GLASGOW_HASKELL__)+import GHC.IO (IO(IO))+import GHC.Base (realWorld#)+#endif+++-- | Just like unsafePerformIO, but we inline it. Big performance gains as+-- it exposes lots of things to further inlining. /Very unsafe/. In+-- particular, you should do no memory allocation inside an+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.+--+{-# INLINE inlinePerformIO #-}+inlinePerformIO :: IO a -> a+#if defined(__GLASGOW_HASKELL__)+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r+#else+inlinePerformIO = unsafePerformIO+#endif++-- | Allow an 'ST' computation to be deferred lazily. When passed an+-- action of type 'ST' @s@ @a@, the action will only be performed when+-- the value of @a@ is demanded.+--+-- This function is identical to the normal unsafeInterleaveST, but is+-- inlined and hence faster.+--+-- /Note/: This operation is highly unsafe, as it can introduce+-- externally visible non-determinism into an 'ST' action.+inlineInterleaveST :: ST s a -> ST s a+inlineInterleaveST (ST m) = ST $ \ s ->+    let r = case m s of (# _, res #) -> res in (# s, r #)+{-# INLINE inlineInterleaveST #-}
+ src/Data/Text/Internal/Unsafe/Char.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE CPP, MagicHash #-}++-- |+-- Module      : Data.Text.Internal.Unsafe.Char+-- Copyright   : (c) 2008, 2009 Tom Harper,+--               (c) 2009, 2010 Bryan O'Sullivan,+--               (c) 2009 Duncan Coutts+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fast character manipulation functions.+module Data.Text.Internal.Unsafe.Char+    (+      ord+    , unsafeChr+    , unsafeChr8+    , unsafeChr32+    , unsafeWrite+    -- , unsafeWriteRev+    ) where++#ifdef ASSERTS+import Control.Exception (assert)+#endif+import Control.Monad.ST (ST)+import Data.Bits ((.&.))+import Data.Text.Internal.Unsafe.Shift (shiftR)+import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)+import GHC.Word (Word8(..), Word16(..), Word32(..))+import qualified Data.Text.Array as A++ord :: Char -> Int+ord (C# c#) = I# (ord# c#)+{-# INLINE ord #-}++unsafeChr :: Word16 -> Char+unsafeChr (W16# w#) = C# (chr# (word2Int# w#))+{-# INLINE unsafeChr #-}++unsafeChr8 :: Word8 -> Char+unsafeChr8 (W8# w#) = C# (chr# (word2Int# w#))+{-# INLINE unsafeChr8 #-}++unsafeChr32 :: Word32 -> Char+unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))+{-# INLINE unsafeChr32 #-}++-- | Write a character into the array at the given offset.  Returns+-- the number of 'Word16's written.+unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int+unsafeWrite marr i c+    | n < 0x10000 = do+#if defined(ASSERTS)+        assert (i >= 0) . assert (i < A.length marr) $ return ()+#endif+        A.unsafeWrite marr i (fromIntegral n)+        return 1+    | otherwise = do+#if defined(ASSERTS)+        assert (i >= 0) . assert (i < A.length marr - 1) $ return ()+#endif+        A.unsafeWrite marr i lo+        A.unsafeWrite marr (i+1) hi+        return 2+    where n = ord c+          m = n - 0x10000+          lo = fromIntegral $ (m `shiftR` 10) + 0xD800+          hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+{-# INLINE unsafeWrite #-}++{-+unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int+unsafeWriteRev marr i c+    | n < 0x10000 = do+        assert (i >= 0) . assert (i < A.length marr) $+          A.unsafeWrite marr i (fromIntegral n)+        return (i-1)+    | otherwise = do+        assert (i >= 1) . assert (i < A.length marr) $+          A.unsafeWrite marr (i-1) lo+        A.unsafeWrite marr i hi+        return (i-2)+    where n = ord c+          m = n - 0x10000+          lo = fromIntegral $ (m `shiftR` 10) + 0xD800+          hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+{-# INLINE unsafeWriteRev #-}+-}
+ src/Data/Text/Internal/Unsafe/Shift.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE MagicHash #-}++-- |+-- Module      : Data.Text.Internal.Unsafe.Shift+-- Copyright   : (c) Bryan O'Sullivan 2009+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- /Warning/: this is an internal module, and does not have a stable+-- API or name. Functions in this module may not check or enforce+-- preconditions expected by public modules. Use at your own risk!+--+-- Fast, unchecked bit shifting functions.++module Data.Text.Internal.Unsafe.Shift+    (+      UnsafeShift(..)+    ) where++-- import qualified Data.Bits as Bits+import GHC.Base+import GHC.Word++-- | This is a workaround for poor optimisation in GHC 6.8.2.  It+-- fails to notice constant-width shifts, and adds a test and branch+-- to every shift.  This imposes about a 10% performance hit.+--+-- These functions are undefined when the amount being shifted by is+-- greater than the size in bits of a machine Int#.+class UnsafeShift a where+    shiftL :: a -> Int -> a+    shiftR :: a -> Int -> a++instance UnsafeShift Word16 where+    {-# INLINE shiftL #-}+    shiftL (W16# x#) (I# i#) = W16# (narrow16Word# (x# `uncheckedShiftL#` i#))++    {-# INLINE shiftR #-}+    shiftR (W16# x#) (I# i#) = W16# (x# `uncheckedShiftRL#` i#)++instance UnsafeShift Word32 where+    {-# INLINE shiftL #-}+    shiftL (W32# x#) (I# i#) = W32# (narrow32Word# (x# `uncheckedShiftL#` i#))++    {-# INLINE shiftR #-}+    shiftR (W32# x#) (I# i#) = W32# (x# `uncheckedShiftRL#` i#)++instance UnsafeShift Word64 where+    {-# INLINE shiftL #-}+    shiftL (W64# x#) (I# i#) = W64# (x# `uncheckedShiftL64#` i#)++    {-# INLINE shiftR #-}+    shiftR (W64# x#) (I# i#) = W64# (x# `uncheckedShiftRL64#` i#)++instance UnsafeShift Int where+    {-# INLINE shiftL #-}+    shiftL (I# x#) (I# i#) = I# (x# `iShiftL#` i#)++    {-# INLINE shiftR #-}+    shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)++{-+instance UnsafeShift Integer where+    {-# INLINE shiftL #-}+    shiftL = Bits.shiftL++    {-# INLINE shiftR #-}+    shiftR = Bits.shiftR+-}
+ src/Data/Text/Lazy.hs view
@@ -0,0 +1,1762 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns, MagicHash, CPP, TypeFamilies #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-- Using TemplateHaskell in text unconditionally is unacceptable, as+-- it's a GHC boot library. TemplateHaskellQuotes was added in 8.0, so+-- this would seem to be a problem. However, GHC's policy of only+-- needing to be able to compile itself from the last few releases+-- allows us to use full-fat TH on older versions, while using THQ for+-- GHC versions that may be used for bootstrapping.+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TemplateHaskellQuotes #-}+#else+{-# LANGUAGE TemplateHaskell #-}+#endif++-- |+-- Module      : Data.Text.Lazy+-- Copyright   : (c) 2009, 2010, 2012 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : GHC+--+-- A time and space-efficient implementation of Unicode text using+-- lists of packed arrays.+--+-- /Note/: Read below the synopsis for important notes on the use of+-- this module.+--+-- The representation used by this module is suitable for high+-- performance use and for streaming large quantities of data.  It+-- provides a means to manipulate a large body of text without+-- requiring that the entire content be resident in memory.+--+-- Some operations, such as 'concat', 'append', 'reverse' and 'cons',+-- have better time complexity than their "Data.Text" equivalents, due+-- to the underlying representation being a list of chunks. For other+-- operations, lazy 'Text's are usually within a few percent of strict+-- ones, but often with better heap usage if used in a streaming+-- fashion. For data larger than available memory, or if you have+-- tight memory constraints, this module will be the only option.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions.  eg.+--+-- > import qualified Data.Text.Lazy as L++module Data.Text.Lazy+    (+    -- * Fusion+    -- $fusion++    -- * Acceptable data+    -- $replacement++    -- * Types+      Text++    -- * Creation and elimination+    , pack+    , unpack+    , singleton+    , empty+    , fromChunks+    , toChunks+    , toStrict+    , fromStrict+    , foldrChunks+    , foldlChunks++    -- * Basic interface+    , cons+    , snoc+    , append+    , uncons+    , unsnoc+    , head+    , last+    , tail+    , init+    , null+    , length+    , compareLength++    -- * Transformations+    , map+    , intercalate+    , intersperse+    , transpose+    , reverse+    , replace++    -- ** Case conversion+    -- $case+    , toCaseFold+    , toLower+    , toUpper+    , toTitle++    -- ** Justification+    , justifyLeft+    , justifyRight+    , center++    -- * Folds+    , foldl+    , foldl'+    , foldl1+    , foldl1'+    , foldr+    , foldr1++    -- ** Special folds+    , concat+    , concatMap+    , any+    , all+    , maximum+    , minimum++    -- * Construction++    -- ** Scans+    , scanl+    , scanl1+    , scanr+    , scanr1++    -- ** Accumulating maps+    , mapAccumL+    , mapAccumR++    -- ** Generation and unfolding+    , repeat+    , replicate+    , cycle+    , iterate+    , unfoldr+    , unfoldrN++    -- * Substrings++    -- ** Breaking strings+    , take+    , takeEnd+    , drop+    , dropEnd+    , takeWhile+    , takeWhileEnd+    , dropWhile+    , dropWhileEnd+    , dropAround+    , strip+    , stripStart+    , stripEnd+    , splitAt+    , span+    , breakOn+    , breakOnEnd+    , break+    , group+    , groupBy+    , inits+    , tails++    -- ** Breaking into many substrings+    -- $split+    , splitOn+    , split+    , chunksOf+    -- , breakSubstring++    -- ** Breaking into lines and words+    , lines+    , words+    , unlines+    , unwords++    -- * Predicates+    , isPrefixOf+    , isSuffixOf+    , isInfixOf++    -- ** View patterns+    , stripPrefix+    , stripSuffix+    , commonPrefixes++    -- * Searching+    , filter+    , find+    , breakOnAll+    , partition++    -- , findSubstring++    -- * Indexing+    , index+    , count++    -- * Zipping and unzipping+    , zip+    , zipWith++    -- -* Ordered text+    -- , sort+    ) where++import Prelude (Char, Bool(..), Maybe(..), String,+                Eq(..), Ord(..), Ordering(..), Read(..), Show(..),+                (&&), (||), (+), (-), (.), ($), (++),+                error, flip, fmap, fromIntegral, not, otherwise, quot)+import qualified Prelude as P+import Control.DeepSeq (NFData(..))+import Data.Int (Int64)+import qualified Data.List as L+import Data.Char (isSpace)+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,+                  Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))+import Data.Binary (Binary(get, put))+import Data.Monoid (Monoid(..))+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup(..))+#endif+import Data.String (IsString(..))+import qualified Data.Text as T+import qualified Data.Text.Internal as T+import qualified Data.Text.Internal.Fusion.Common as S+import qualified Data.Text.Unsafe as T+import qualified Data.Text.Internal.Lazy.Fusion as S+import Data.Text.Internal.Fusion.Types (PairS(..))+import Data.Text.Internal.Lazy.Fusion (stream, unstream)+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,+                                foldrChunks, smallChunkSize)+import Data.Text.Internal (firstf, safe, text)+import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)+import qualified Data.Text.Internal.Functions as F+import Data.Text.Internal.Lazy.Search (indices)+#if __GLASGOW_HASKELL__ >= 702+import qualified GHC.CString as GHC+#else+import qualified GHC.Base as GHC+#endif+#if MIN_VERSION_base(4,7,0)+import qualified GHC.Exts as Exts+#endif+import GHC.Prim (Addr#)+import qualified Language.Haskell.TH.Lib as TH+import qualified Language.Haskell.TH.Syntax as TH+#if MIN_VERSION_base(4,7,0)+import Text.Printf (PrintfArg, formatArg, formatString)+#endif++-- $fusion+--+-- Most of the functions in this module are subject to /fusion/,+-- meaning that a pipeline of such functions will usually allocate at+-- most one 'Text' value.+--+-- As an example, consider the following pipeline:+--+-- > import Data.Text.Lazy as T+-- > import Data.Text.Lazy.Encoding as E+-- > import Data.ByteString.Lazy (ByteString)+-- >+-- > countChars :: ByteString -> Int+-- > countChars = T.length . T.toUpper . E.decodeUtf8+--+-- From the type signatures involved, this looks like it should+-- allocate one 'ByteString' value, and two 'Text' values. However,+-- when a module is compiled with optimisation enabled under GHC, the+-- two intermediate 'Text' values will be optimised away, and the+-- function will be compiled down to a single loop over the source+-- 'ByteString'.+--+-- Functions that can be fused by the compiler are documented with the+-- phrase \"Subject to fusion\".++-- $replacement+--+-- A 'Text' value is a sequence of Unicode scalar values, as defined+-- in+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.+-- As such, a 'Text' cannot contain values in the range U+D800 to+-- U+DFFF inclusive. Haskell implementations admit all Unicode code+-- points+-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)+-- as 'Char' values, including code points from this invalid range.+-- This means that there are some 'Char' values that are not valid+-- Unicode scalar values, and the functions in this module must handle+-- those cases.+--+-- Within this module, many functions construct a 'Text' from one or+-- more 'Char' values. Those functions will substitute 'Char' values+-- that are not valid Unicode scalar values with the replacement+-- character \"&#xfffd;\" (U+FFFD).  Functions that perform this+-- inspection and replacement are documented with the phrase+-- \"Performs replacement on invalid scalar values\".+--+-- (One reason for this policy of replacement is that internally, a+-- 'Text' value is represented as packed UTF-16 data. Values in the+-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate+-- code points, and so cannot be represented. The functions replace+-- invalid scalar values, instead of dropping them, as a security+-- measure. For details, see+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)++-- $setup+-- >>> import Data.Text+-- >>> import qualified Data.Text as T+-- >>> :seti -XOverloadedStrings++equal :: Text -> Text -> Bool+equal Empty Empty = True+equal Empty _     = False+equal _ Empty     = False+equal (Chunk a as) (Chunk b bs) =+    case compare lenA lenB of+      LT -> a == (T.takeWord16 lenA b) &&+            as `equal` Chunk (T.dropWord16 lenA b) bs+      EQ -> a == b && as `equal` bs+      GT -> T.takeWord16 lenB a == b &&+            Chunk (T.dropWord16 lenB a) as `equal` bs+  where lenA = T.lengthWord16 a+        lenB = T.lengthWord16 b++instance Eq Text where+    (==) = equal+    {-# INLINE (==) #-}++instance Ord Text where+    compare = compareText++compareText :: Text -> Text -> Ordering+compareText Empty Empty = EQ+compareText Empty _     = LT+compareText _     Empty = GT+compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0+ where+  outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0+   where+    go !i !j+      | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)+      | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs+      | a < b     = LT+      | a > b     = GT+      | otherwise = go (i+di) (j+dj)+      where T.Iter a di = T.iter ta i+            T.Iter b dj = T.iter tb j++instance Show Text where+    showsPrec p ps r = showsPrec p (unpack ps) r++instance Read Text where+    readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]++#if MIN_VERSION_base(4,9,0)+-- | Non-orphan 'Semigroup' instance only defined for+-- @base-4.9.0.0@ and later; orphan instances for older GHCs are+-- provided by+-- the [semigroups](http://hackage.haskell.org/package/semigroups)+-- package+--+-- @since 1.2.2.0+instance Semigroup Text where+    (<>) = append+#endif++instance Monoid Text where+    mempty  = empty+#if MIN_VERSION_base(4,9,0)+    mappend = (<>) -- future-proof definition+#else+    mappend = append+#endif+    mconcat = concat++instance IsString Text where+    fromString = pack++#if MIN_VERSION_base(4,7,0)+-- | @since 1.2.0.0+instance Exts.IsList Text where+    type Item Text = Char+    fromList       = pack+    toList         = unpack+#endif++instance NFData Text where+    rnf Empty        = ()+    rnf (Chunk _ ts) = rnf ts++-- | @since 1.2.1.0+instance Binary Text where+    put t = put (encodeUtf8 t)+    get   = do+      bs <- get+      case decodeUtf8' bs of+        P.Left exn -> P.fail (P.show exn)+        P.Right a -> P.return a++-- | This instance preserves data abstraction at the cost of inefficiency.+-- We omit reflection services for the sake of data abstraction.+--+-- This instance was created by copying the updated behavior of+-- @"Data.Text".@'Data.Text.Text'+instance Data Text where+  gfoldl f z txt = z pack `f` (unpack txt)+  toConstr _     = packConstr+  gunfold k z c  = case constrIndex c of+    1 -> k (z pack)+    _ -> error "Data.Text.Lazy.Text.gunfold"+  dataTypeOf _   = textDataType++-- | This instance has similar considerations to the 'Data' instance:+-- it preserves abstraction at the cost of inefficiency.+--+-- @since 1.2.4.0+instance TH.Lift Text where+  lift = TH.appE (TH.varE 'pack) . TH.stringE . unpack+#if MIN_VERSION_template_haskell(2,17,0)+  liftTyped = TH.unsafeCodeCoerce . TH.lift+#elif MIN_VERSION_template_haskell(2,16,0)+  liftTyped = TH.unsafeTExpCoerce . TH.lift+#endif++#if MIN_VERSION_base(4,7,0)+-- | Only defined for @base-4.7.0.0@ and later+--+-- @since 1.2.2.0+instance PrintfArg Text where+  formatArg txt = formatString $ unpack txt+#endif++packConstr :: Constr+packConstr = mkConstr textDataType "pack" [] Prefix++textDataType :: DataType+textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]++-- | /O(n)/ Convert a 'String' into a 'Text'.+--+-- Subject to fusion.  Performs replacement on invalid scalar values.+pack :: String -> Text+pack = unstream . S.streamList . L.map safe+{-# INLINE [1] pack #-}++-- | /O(n)/ Convert a 'Text' into a 'String'.+-- Subject to fusion.+unpack :: Text -> String+unpack t = S.unstreamList (stream t)+{-# INLINE [1] unpack #-}++-- | /O(n)/ Convert a literal string into a Text.+unpackCString# :: Addr# -> Text+unpackCString# addr# = unstream (S.streamCString# addr#)+{-# NOINLINE unpackCString# #-}++{-# RULES "TEXT literal" forall a.+    unstream (S.streamList (L.map safe (GHC.unpackCString# a)))+      = unpackCString# a #-}++{-# RULES "TEXT literal UTF8" forall a.+    unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))+      = unpackCString# a #-}++{-# RULES "LAZY TEXT empty literal"+    unstream (S.streamList (L.map safe []))+      = Empty #-}++{-# RULES "LAZY TEXT empty literal" forall a.+    unstream (S.streamList (L.map safe [a]))+      = Chunk (T.singleton a) Empty #-}++-- | /O(1)/ Convert a character into a Text.  Subject to fusion.+-- Performs replacement on invalid scalar values.+singleton :: Char -> Text+singleton c = Chunk (T.singleton c) Empty+{-# INLINE [1] singleton #-}++{-# RULES+"LAZY TEXT singleton -> fused" [~1] forall c.+    singleton c = unstream (S.singleton c)+"LAZY TEXT singleton -> unfused" [1] forall c.+    unstream (S.singleton c) = singleton c+  #-}++-- | /O(c)/ Convert a list of strict 'T.Text's into a lazy 'Text'.+fromChunks :: [T.Text] -> Text+fromChunks cs = L.foldr chunk Empty cs++-- | /O(n)/ Convert a lazy 'Text' into a list of strict 'T.Text's.+toChunks :: Text -> [T.Text]+toChunks cs = foldrChunks (:) [] cs++-- | /O(n)/ Convert a lazy 'Text' into a strict 'T.Text'.+toStrict :: Text -> T.Text+toStrict t = T.concat (toChunks t)+{-# INLINE [1] toStrict #-}++-- | /O(c)/ Convert a strict 'T.Text' into a lazy 'Text'.+fromStrict :: T.Text -> Text+fromStrict t = chunk t Empty+{-# INLINE [1] fromStrict #-}++-- -----------------------------------------------------------------------------+-- * Basic functions++-- | /O(1)/ Adds a character to the front of a 'Text'.  Subject to fusion.+cons :: Char -> Text -> Text+cons c t = Chunk (T.singleton c) t+{-# INLINE [1] cons #-}++infixr 5 `cons`++{-# RULES+"LAZY TEXT cons -> fused" [~1] forall c t.+    cons c t = unstream (S.cons c (stream t))+"LAZY TEXT cons -> unfused" [1] forall c t.+    unstream (S.cons c (stream t)) = cons c t+ #-}++-- | /O(n)/ Adds a character to the end of a 'Text'.  This copies the+-- entire array in the process, unless fused.  Subject to fusion.+snoc :: Text -> Char -> Text+snoc t c = foldrChunks Chunk (singleton c) t+{-# INLINE [1] snoc #-}++{-# RULES+"LAZY TEXT snoc -> fused" [~1] forall t c.+    snoc t c = unstream (S.snoc (stream t) c)+"LAZY TEXT snoc -> unfused" [1] forall t c.+    unstream (S.snoc (stream t) c) = snoc t c+ #-}++-- | /O(n\/c)/ Appends one 'Text' to another.  Subject to fusion.+append :: Text -> Text -> Text+append xs ys = foldrChunks Chunk ys xs+{-# INLINE [1] append #-}++{-# RULES+"LAZY TEXT append -> fused" [~1] forall t1 t2.+    append t1 t2 = unstream (S.append (stream t1) (stream t2))+"LAZY TEXT append -> unfused" [1] forall t1 t2.+    unstream (S.append (stream t1) (stream t2)) = append t1 t2+ #-}++-- | /O(1)/ Returns the first character and rest of a 'Text', or+-- 'Nothing' if empty. Subject to fusion.+uncons :: Text -> Maybe (Char, Text)+uncons Empty        = Nothing+uncons (Chunk t ts) = Just (T.unsafeHead t, ts')+  where ts' | T.compareLength t 1 == EQ = ts+            | otherwise                 = Chunk (T.unsafeTail t) ts+{-# INLINE uncons #-}++-- | /O(1)/ Returns the first character of a 'Text', which must be+-- non-empty.  Subject to fusion.+head :: Text -> Char+head t = S.head (stream t)+{-# INLINE head #-}++-- | /O(1)/ Returns all characters after the head of a 'Text', which+-- must be non-empty.  Subject to fusion.+tail :: Text -> Text+tail (Chunk t ts) = chunk (T.tail t) ts+tail Empty        = emptyError "tail"+{-# INLINE [1] tail #-}++{-# RULES+"LAZY TEXT tail -> fused" [~1] forall t.+    tail t = unstream (S.tail (stream t))+"LAZY TEXT tail -> unfused" [1] forall t.+    unstream (S.tail (stream t)) = tail t+ #-}++-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must+-- be non-empty.  Subject to fusion.+init :: Text -> Text+init (Chunk t0 ts0) = go t0 ts0+    where go t (Chunk t' ts) = Chunk t (go t' ts)+          go t Empty         = chunk (T.init t) Empty+init Empty = emptyError "init"+{-# INLINE [1] init #-}++{-# RULES+"LAZY TEXT init -> fused" [~1] forall t.+    init t = unstream (S.init (stream t))+"LAZY TEXT init -> unfused" [1] forall t.+    unstream (S.init (stream t)) = init t+ #-}++-- | /O(n\/c)/ Returns the 'init' and 'last' of a 'Text', or 'Nothing' if+-- empty.+--+-- * It is no faster than using 'init' and 'last'.+--+-- @since 1.2.3.0+unsnoc :: Text -> Maybe (Text, Char)+unsnoc Empty          = Nothing+unsnoc ts@(Chunk _ _) = Just (init ts, last ts)+{-# INLINE unsnoc #-}++-- | /O(1)/ Tests whether a 'Text' is empty or not.  Subject to+-- fusion.+null :: Text -> Bool+null Empty = True+null _     = False+{-# INLINE [1] null #-}++{-# RULES+"LAZY TEXT null -> fused" [~1] forall t.+    null t = S.null (stream t)+"LAZY TEXT null -> unfused" [1] forall t.+    S.null (stream t) = null t+ #-}++-- | /O(1)/ Tests whether a 'Text' contains exactly one character.+-- Subject to fusion.+isSingleton :: Text -> Bool+isSingleton = S.isSingleton . stream+{-# INLINE isSingleton #-}++-- | /O(n\/c)/ Returns the last character of a 'Text', which must be+-- non-empty.  Subject to fusion.+last :: Text -> Char+last Empty        = emptyError "last"+last (Chunk t ts) = go t ts+    where go _ (Chunk t' ts') = go t' ts'+          go t' Empty         = T.last t'+{-# INLINE [1] last #-}++{-# RULES+"LAZY TEXT last -> fused" [~1] forall t.+    last t = S.last (stream t)+"LAZY TEXT last -> unfused" [1] forall t.+    S.last (stream t) = last t+  #-}++-- | /O(n)/ Returns the number of characters in a 'Text'.+-- Subject to fusion.+length :: Text -> Int64+length = foldlChunks go 0+    where go l t = l + fromIntegral (T.length t)+{-# INLINE [1] length #-}++{-# RULES+"LAZY TEXT length -> fused" [~1] forall t.+    length t = S.length (stream t)+"LAZY TEXT length -> unfused" [1] forall t.+    S.length (stream t) = length t+ #-}++-- | /O(n)/ Compare the count of characters in a 'Text' to a number.+-- Subject to fusion.+--+-- This function gives the same answer as comparing against the result+-- of 'length', but can short circuit if the count of characters is+-- greater than the number, and hence be more efficient.+compareLength :: Text -> Int64 -> Ordering+compareLength t n = S.compareLengthI (stream t) n+{-# INLINE [1] compareLength #-}++-- We don't apply those otherwise appealing length-to-compareLength+-- rewrite rules here, because they can change the strictness+-- properties of code.++-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to+-- each element of @t@.  Subject to fusion.  Performs replacement on+-- invalid scalar values.+map :: (Char -> Char) -> Text -> Text+map f t = unstream (S.map (safe . f) (stream t))+{-# INLINE [1] map #-}++-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of+-- 'Text's and concatenates the list after interspersing the first+-- argument between each element of the list.+intercalate :: Text -> [Text] -> Text+intercalate t = concat . (F.intersperse t)+{-# INLINE intercalate #-}++-- | /O(n)/ The 'intersperse' function takes a character and places it+-- between the characters of a 'Text'.  Subject to fusion.  Performs+-- replacement on invalid scalar values.+intersperse :: Char -> Text -> Text+intersperse c t = unstream (S.intersperse (safe c) (stream t))+{-# INLINE intersperse #-}++-- | /O(n)/ Left-justify a string to the given length, using the+-- specified fill character on the right. Subject to fusion.  Performs+-- replacement on invalid scalar values.+--+-- Examples:+--+-- > justifyLeft 7 'x' "foo"    == "fooxxxx"+-- > justifyLeft 3 'x' "foobar" == "foobar"+justifyLeft :: Int64 -> Char -> Text -> Text+justifyLeft k c t+    | len >= k  = t+    | otherwise = t `append` replicateChar (k-len) c+  where len = length t+{-# INLINE [1] justifyLeft #-}++{-# RULES+"LAZY TEXT justifyLeft -> fused" [~1] forall k c t.+    justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))+"LAZY TEXT justifyLeft -> unfused" [1] forall k c t.+    unstream (S.justifyLeftI k c (stream t)) = justifyLeft k c t+  #-}++-- | /O(n)/ Right-justify a string to the given length, using the+-- specified fill character on the left.  Performs replacement on+-- invalid scalar values.+--+-- Examples:+--+-- > justifyRight 7 'x' "bar"    == "xxxxbar"+-- > justifyRight 3 'x' "foobar" == "foobar"+justifyRight :: Int64 -> Char -> Text -> Text+justifyRight k c t+    | len >= k  = t+    | otherwise = replicateChar (k-len) c `append` t+  where len = length t+{-# INLINE justifyRight #-}++-- | /O(n)/ Center a string to the given length, using the specified+-- fill character on either side.  Performs replacement on invalid+-- scalar values.+--+-- Examples:+--+-- > center 8 'x' "HS" = "xxxHSxxx"+center :: Int64 -> Char -> Text -> Text+center k c t+    | len >= k  = t+    | otherwise = replicateChar l c `append` t `append` replicateChar r c+  where len = length t+        d   = k - len+        r   = d `quot` 2+        l   = d - r+{-# INLINE center #-}++-- | /O(n)/ The 'transpose' function transposes the rows and columns+-- of its 'Text' argument.  Note that this function uses 'pack',+-- 'unpack', and the list version of transpose, and is thus not very+-- efficient.+transpose :: [Text] -> [Text]+transpose ts = L.map (\ss -> Chunk (T.pack ss) Empty)+                     (L.transpose (L.map unpack ts))+-- TODO: make this fast++-- | /O(n)/ 'reverse' @t@ returns the elements of @t@ in reverse order.+reverse :: Text -> Text+reverse = rev Empty+  where rev a Empty        = a+        rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts++-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in+-- @haystack@ with @replacement@.+--+-- This function behaves as though it was defined as follows:+--+-- @+-- replace needle replacement haystack =+--   'intercalate' replacement ('splitOn' needle haystack)+-- @+--+-- As this suggests, each occurrence is replaced exactly once.  So if+-- @needle@ occurs in @replacement@, that occurrence will /not/ itself+-- be replaced recursively:+--+-- > replace "oo" "foo" "oo" == "foo"+--+-- In cases where several instances of @needle@ overlap, only the+-- first one will be replaced:+--+-- > replace "ofo" "bar" "ofofo" == "barfo"+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+replace :: Text+        -- ^ @needle@ to search for.  If this string is empty, an+        -- error will occur.+        -> Text+        -- ^ @replacement@ to replace @needle@ with.+        -> Text+        -- ^ @haystack@ in which to search.+        -> Text+replace s d = intercalate d . splitOn s+{-# INLINE replace #-}++-- ----------------------------------------------------------------------------+-- ** Case conversions (folds)++-- $case+--+-- With Unicode text, it is incorrect to use combinators like @map+-- toUpper@ to case convert each character of a string individually.+-- Instead, use the whole-string case conversion functions from this+-- module.  For correctness in different writing systems, these+-- functions may map one input character to two or three output+-- characters.++-- | /O(n)/ Convert a string to folded case.  Subject to fusion.+--+-- This function is mainly useful for performing caseless (or case+-- insensitive) string comparisons.+--+-- A string @x@ is a caseless match for a string @y@ if and only if:+--+-- @toCaseFold x == toCaseFold y@+--+-- The result string may be longer than the input string, and may+-- differ from applying 'toLower' to the input string.  For instance,+-- the Armenian small ligature men now (U+FB13) is case folded to the+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is+-- case folded to the Greek small letter letter mu (U+03BC) instead of+-- itself.+toCaseFold :: Text -> Text+toCaseFold t = unstream (S.toCaseFold (stream t))+{-# INLINE toCaseFold #-}++-- | /O(n)/ Convert a string to lower case, using simple case+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, the Latin capital letter I with dot above (U+0130) maps+-- to the sequence Latin small letter i (U+0069) followed by combining+-- dot above (U+0307).+toLower :: Text -> Text+toLower t = unstream (S.toLower (stream t))+{-# INLINE toLower #-}++-- | /O(n)/ Convert a string to upper case, using simple case+-- conversion.  Subject to fusion.+--+-- The result string may be longer than the input string.  For+-- instance, the German eszett (U+00DF) maps to the two-letter+-- sequence SS.+toUpper :: Text -> Text+toUpper t = unstream (S.toUpper (stream t))+{-# INLINE toUpper #-}+++-- | /O(n)/ Convert a string to title case, using simple case+-- conversion.  Subject to fusion.+--+-- The first letter of the input is converted to title case, as is+-- every subsequent letter that immediately follows a non-letter.+-- Every letter that immediately follows another letter is converted+-- to lower case.+--+-- The result string may be longer than the input string. For example,+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the+-- sequence Latin capital letter F (U+0046) followed by Latin small+-- letter l (U+006C).+--+-- /Note/: this function does not take language or culture specific+-- rules into account. For instance, in English, different style+-- guides disagree on whether the book name \"The Hill of the Red+-- Fox\" is correctly title cased&#x2014;but this function will+-- capitalize /every/ word.+--+-- @since 1.0.0.0+toTitle :: Text -> Text+toTitle t = unstream (S.toTitle (stream t))+{-# INLINE toTitle #-}++-- | /O(n)/ 'foldl', applied to a binary operator, a starting value+-- (typically the left-identity of the operator), and a 'Text',+-- reduces the 'Text' using the binary operator, from left to right.+-- Subject to fusion.+foldl :: (a -> Char -> a) -> a -> Text -> a+foldl f z t = S.foldl f z (stream t)+{-# INLINE foldl #-}++-- | /O(n)/ A strict version of 'foldl'.+-- Subject to fusion.+foldl' :: (a -> Char -> a) -> a -> Text -> a+foldl' f z t = S.foldl' f z (stream t)+{-# INLINE foldl' #-}++-- | /O(n)/ A variant of 'foldl' that has no starting value argument,+-- and thus must be applied to a non-empty 'Text'.  Subject to fusion.+foldl1 :: (Char -> Char -> Char) -> Text -> Char+foldl1 f t = S.foldl1 f (stream t)+{-# INLINE foldl1 #-}++-- | /O(n)/ A strict version of 'foldl1'.  Subject to fusion.+foldl1' :: (Char -> Char -> Char) -> Text -> Char+foldl1' f t = S.foldl1' f (stream t)+{-# INLINE foldl1' #-}++-- | /O(n)/ 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a 'Text',+-- reduces the 'Text' using the binary operator, from right to left.+-- Subject to fusion.+foldr :: (Char -> a -> a) -> a -> Text -> a+foldr f z t = S.foldr f z (stream t)+{-# INLINE foldr #-}++-- | /O(n)/ A variant of 'foldr' that has no starting value argument,+-- and thus must be applied to a non-empty 'Text'.  Subject to+-- fusion.+foldr1 :: (Char -> Char -> Char) -> Text -> Char+foldr1 f t = S.foldr1 f (stream t)+{-# INLINE foldr1 #-}++-- | /O(n)/ Concatenate a list of 'Text's.+concat :: [Text] -> Text+concat = to+  where+    go Empty        css = to css+    go (Chunk c cs) css = Chunk c (go cs css)+    to []               = Empty+    to (cs:css)         = go cs css+{-# INLINE concat #-}++-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and+-- concatenate the results.+concatMap :: (Char -> Text) -> Text -> Text+concatMap f = concat . foldr ((:) . f) []+{-# INLINE concatMap #-}++-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.+any :: (Char -> Bool) -> Text -> Bool+any p t = S.any p (stream t)+{-# INLINE any #-}++-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.+all :: (Char -> Bool) -> Text -> Bool+all p t = S.all p (stream t)+{-# INLINE all #-}++-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which+-- must be non-empty. Subject to fusion.+maximum :: Text -> Char+maximum t = S.maximum (stream t)+{-# INLINE maximum #-}++-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which+-- must be non-empty. Subject to fusion.+minimum :: Text -> Char+minimum t = S.minimum (stream t)+{-# INLINE minimum #-}++-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of+-- successive reduced values from the left. Subject to fusion.+-- Performs replacement on invalid scalar values.+--+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+--+-- Note that+--+-- > last (scanl f z xs) == foldl f z xs.+scanl :: (Char -> Char -> Char) -> Char -> Text -> Text+scanl f z t = unstream (S.scanl g z (stream t))+    where g a b = safe (f a b)+{-# INLINE scanl #-}++-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting+-- value argument.  Performs replacement on invalid scalar values.+--+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+scanl1 :: (Char -> Char -> Char) -> Text -> Text+scanl1 f t0 = case uncons t0 of+                Nothing -> empty+                Just (t,ts) -> scanl f t ts+{-# INLINE scanl1 #-}++-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.  Performs+-- replacement on invalid scalar values.+--+-- > scanr f v == reverse . scanl (flip f) v . reverse+scanr :: (Char -> Char -> Char) -> Char -> Text -> Text+scanr f v = reverse . scanl g v . reverse+    where g a b = safe (f b a)++-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting+-- value argument.  Performs replacement on invalid scalar values.+scanr1 :: (Char -> Char -> Char) -> Text -> Text+scanr1 f t | null t    = empty+           | otherwise = scanr f (last t) (init t)++-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a+-- function to each element of a 'Text', passing an accumulating+-- parameter from left to right, and returns a final 'Text'.  Performs+-- replacement on invalid scalar values.+mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)+mapAccumL f = go+  where+    go z (Chunk c cs)    = (z'', Chunk c' cs')+        where (z',  c')  = T.mapAccumL f z c+              (z'', cs') = go z' cs+    go z Empty           = (z, Empty)+{-# INLINE mapAccumL #-}++-- | The 'mapAccumR' function behaves like a combination of 'map' and+-- a strict 'foldr'; it applies a function to each element of a+-- 'Text', passing an accumulating parameter from right to left, and+-- returning a final value of this accumulator together with the new+-- 'Text'.  Performs replacement on invalid scalar values.+mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)+mapAccumR f = go+  where+    go z (Chunk c cs)   = (z'', Chunk c' cs')+        where (z'', c') = T.mapAccumR f z' c+              (z', cs') = go z cs+    go z Empty          = (z, Empty)+{-# INLINE mapAccumR #-}++-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every+-- element.+--+-- @since 1.2.0.5+repeat :: Char -> Text+repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t+            in t++-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input+-- @t@ repeated @n@ times.+replicate :: Int64 -> Text -> Text+replicate n t+    | null t || n <= 0 = empty+    | isSingleton t    = replicateChar n (head t)+    | otherwise        = concat (rep 0)+    where rep !i | i >= n    = []+                 | otherwise = t : rep (i+1)+{-# INLINE [1] replicate #-}++-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or+-- equivalently, the infinite repetition of the original 'Text'.+--+-- @since 1.2.0.5+cycle :: Text -> Text+cycle Empty = emptyError "cycle"+cycle t     = let t' = foldrChunks Chunk t' t+               in t'++-- | @'iterate' f x@ returns an infinite 'Text' of repeated applications+-- of @f@ to @x@:+--+-- > iterate f x == [x, f x, f (f x), ...]+--+-- @since 1.2.0.5+iterate :: (Char -> Char) -> Char -> Text+iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))+               in t c++-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the+-- value of every element. Subject to fusion.+replicateChar :: Int64 -> Char -> Text+replicateChar n c = unstream (S.replicateCharI n (safe c))+{-# INLINE replicateChar #-}++{-# RULES+"LAZY TEXT replicate/singleton -> replicateChar" [~1] forall n c.+    replicate n (singleton c) = replicateChar n c+"LAZY TEXT replicate/unstream/singleton -> replicateChar" [~1] forall n c.+    replicate n (unstream (S.singleton c)) = replicateChar n c+  #-}++-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'+-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a+-- 'Text' from a seed value. The function takes the element and+-- returns 'Nothing' if it is done producing the 'Text', otherwise+-- 'Just' @(a,b)@.  In this case, @a@ is the next 'Char' in the+-- string, and @b@ is the seed value for further production.+-- Subject to fusion.+-- Performs replacement on invalid scalar values.+unfoldr :: (a -> Maybe (Char,a)) -> a -> Text+unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)+{-# INLINE unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed+-- value. However, the length of the result should be limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the maximum length of the result is known and+-- correct, otherwise its performance is similar to 'unfoldr'.+-- Subject to fusion.+-- Performs replacement on invalid scalar values.+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text+unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)+{-# INLINE unfoldrN #-}++-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the+-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than+-- the length of the Text. Subject to fusion.+take :: Int64 -> Text -> Text+take i _ | i <= 0 = Empty+take i t0         = take' i t0+  where take' 0 _            = Empty+        take' _ Empty        = Empty+        take' n (Chunk t ts)+            | n < len   = Chunk (T.take (fromIntegral n) t) Empty+            | otherwise = Chunk t (take' (n - len) ts)+            where len = fromIntegral (T.length t)+{-# INLINE [1] take #-}++{-# RULES+"LAZY TEXT take -> fused" [~1] forall n t.+    take n t = unstream (S.take n (stream t))+"LAZY TEXT take -> unfused" [1] forall n t.+    unstream (S.take n (stream t)) = take n t+  #-}++-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after+-- taking @n@ characters from the end of @t@.+--+-- Examples:+--+-- > takeEnd 3 "foobar" == "bar"+--+-- @since 1.1.1.0+takeEnd :: Int64 -> Text -> Text+takeEnd n t0+    | n <= 0    = empty+    | otherwise = takeChunk n empty . L.reverse . toChunks $ t0+  where takeChunk _ acc [] = acc+        takeChunk i acc (t:ts)+          | i <= l    = chunk (T.takeEnd (fromIntegral i) t) acc+          | otherwise = takeChunk (i-l) (Chunk t acc) ts+          where l = fromIntegral (T.length t)++-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the+-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@+-- is greater than the length of the 'Text'. Subject to fusion.+drop :: Int64 -> Text -> Text+drop i t0+    | i <= 0    = t0+    | otherwise = drop' i t0+  where drop' 0 ts           = ts+        drop' _ Empty        = Empty+        drop' n (Chunk t ts)+            | n < len   = Chunk (T.drop (fromIntegral n) t) ts+            | otherwise = drop' (n - len) ts+            where len   = fromIntegral (T.length t)+{-# INLINE [1] drop #-}++{-# RULES+"LAZY TEXT drop -> fused" [~1] forall n t.+    drop n t = unstream (S.drop n (stream t))+"LAZY TEXT drop -> unfused" [1] forall n t.+    unstream (S.drop n (stream t)) = drop n t+  #-}++-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after+-- dropping @n@ characters from the end of @t@.+--+-- Examples:+--+-- > dropEnd 3 "foobar" == "foo"+--+-- @since 1.1.1.0+dropEnd :: Int64 -> Text -> Text+dropEnd n t0+    | n <= 0    = t0+    | otherwise = dropChunk n . L.reverse . toChunks $ t0+  where dropChunk _ [] = empty+        dropChunk m (t:ts)+          | m >= l    = dropChunk (m-l) ts+          | otherwise = fromChunks . L.reverse $+                        T.dropEnd (fromIntegral m) t : ts+          where l = fromIntegral (T.length t)++-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'+-- values dropped, or the empty 'Text' if @n@ is greater than the+-- number of 'Word16' values present.+dropWords :: Int64 -> Text -> Text+dropWords i t0+    | i <= 0    = t0+    | otherwise = drop' i t0+  where drop' 0 ts           = ts+        drop' _ Empty        = Empty+        drop' n (Chunk (T.Text arr off len) ts)+            | n < len'  = chunk (text arr (off+n') (len-n')) ts+            | otherwise = drop' (n - len') ts+            where len'  = fromIntegral len+                  n'    = fromIntegral n++-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',+-- returns the longest prefix (possibly empty) of elements that+-- satisfy @p@.  Subject to fusion.+takeWhile :: (Char -> Bool) -> Text -> Text+takeWhile p t0 = takeWhile' t0+  where takeWhile' Empty        = Empty+        takeWhile' (Chunk t ts) =+          case T.findIndex (not . p) t of+            Just n | n > 0     -> Chunk (T.take n t) Empty+                   | otherwise -> Empty+            Nothing            -> Chunk t (takeWhile' ts)+{-# INLINE [1] takeWhile #-}++{-# RULES+"LAZY TEXT takeWhile -> fused" [~1] forall p t.+    takeWhile p t = unstream (S.takeWhile p (stream t))+"LAZY TEXT takeWhile -> unfused" [1] forall p t.+    unstream (S.takeWhile p (stream t)) = takeWhile p t+  #-}+-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',+-- returns the longest suffix (possibly empty) of elements that+-- satisfy @p@.+-- Examples:+--+-- > takeWhileEnd (=='o') "foo" == "oo"+--+-- @since 1.2.2.0+takeWhileEnd :: (Char -> Bool) -> Text -> Text+takeWhileEnd p = takeChunk empty . L.reverse . toChunks+  where takeChunk acc []     = acc+        takeChunk acc (t:ts)+          | T.lengthWord16 t' < T.lengthWord16 t+                             = chunk t' acc+          | otherwise        = takeChunk (Chunk t' acc) ts+          where t' = T.takeWhileEnd p t+{-# INLINE takeWhileEnd #-}++-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after+-- 'takeWhile' @p@ @t@.  Subject to fusion.+dropWhile :: (Char -> Bool) -> Text -> Text+dropWhile p t0 = dropWhile' t0+  where dropWhile' Empty        = Empty+        dropWhile' (Chunk t ts) =+          case T.findIndex (not . p) t of+            Just n  -> Chunk (T.drop n t) ts+            Nothing -> dropWhile' ts+{-# INLINE [1] dropWhile #-}++{-# RULES+"LAZY TEXT dropWhile -> fused" [~1] forall p t.+    dropWhile p t = unstream (S.dropWhile p (stream t))+"LAZY TEXT dropWhile -> unfused" [1] forall p t.+    unstream (S.dropWhile p (stream t)) = dropWhile p t+  #-}++-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after+-- dropping characters that satisfy the predicate @p@ from the end of+-- @t@.+--+-- Examples:+--+-- > dropWhileEnd (=='.') "foo..." == "foo"+dropWhileEnd :: (Char -> Bool) -> Text -> Text+dropWhileEnd p = go+  where go Empty = Empty+        go (Chunk t Empty) = if T.null t'+                             then Empty+                             else Chunk t' Empty+            where t' = T.dropWhileEnd p t+        go (Chunk t ts) = case go ts of+                            Empty -> go (Chunk t Empty)+                            ts' -> Chunk t ts'+{-# INLINE dropWhileEnd #-}++-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after+-- dropping characters that satisfy the predicate @p@ from both the+-- beginning and end of @t@.+dropAround :: (Char -> Bool) -> Text -> Text+dropAround p = dropWhile p . dropWhileEnd p+{-# INLINE [1] dropAround #-}++-- | /O(n)/ Remove leading white space from a string.  Equivalent to:+--+-- > dropWhile isSpace+stripStart :: Text -> Text+stripStart = dropWhile isSpace+{-# INLINE stripStart #-}++-- | /O(n)/ Remove trailing white space from a string.  Equivalent to:+--+-- > dropWhileEnd isSpace+stripEnd :: Text -> Text+stripEnd = dropWhileEnd isSpace+{-# INLINE [1] stripEnd #-}++-- | /O(n)/ Remove leading and trailing white space from a string.+-- Equivalent to:+--+-- > dropAround isSpace+strip :: Text -> Text+strip = dropAround isSpace+{-# INLINE [1] strip #-}++-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a+-- prefix of @t@ of length @n@, and whose second is the remainder of+-- the string. It is equivalent to @('take' n t, 'drop' n t)@.+splitAt :: Int64 -> Text -> (Text, Text)+splitAt = loop+  where loop _ Empty      = (empty, empty)+        loop n t | n <= 0 = (empty, t)+        loop n (Chunk t ts)+             | n < len   = let (t',t'') = T.splitAt (fromIntegral n) t+                           in (Chunk t' Empty, Chunk t'' ts)+             | otherwise = let (ts',ts'') = loop (n - len) ts+                           in (Chunk t ts', ts'')+             where len = fromIntegral (T.length t)++-- | /O(n)/ 'splitAtWord' @n t@ returns a strict pair whose first+-- element is a prefix of @t@ whose chunks contain @n@ 'Word16'+-- values, and whose second is the remainder of the string.+splitAtWord :: Int64 -> Text -> PairS Text Text+splitAtWord _ Empty = empty :*: empty+splitAtWord x (Chunk c@(T.Text arr off len) cs)+    | y >= len  = let h :*: t = splitAtWord (x-fromIntegral len) cs+                  in  Chunk c h :*: t+    | otherwise = chunk (text arr off y) empty :*:+                  chunk (text arr (off+y) (len-y)) cs+    where y = fromIntegral x++-- | /O(n+m)/ Find the first instance of @needle@ (which must be+-- non-'null') in @haystack@.  The first element of the returned tuple+-- is the prefix of @haystack@ before @needle@ is matched.  The second+-- is the remainder of @haystack@, starting with the match.+--+-- Examples:+--+-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")+-- > breakOn "/" "foobar"   ==> ("foobar", "")+--+-- Laws:+--+-- > append prefix match == haystack+-- >   where (prefix, match) = breakOn needle haystack+--+-- If you need to break a string by a substring repeatedly (e.g. you+-- want to break on every instance of a substring), use 'breakOnAll'+-- instead, as it has lower startup overhead.+--+-- This function is strict in its first argument, and lazy in its+-- second.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+breakOn :: Text -> Text -> (Text, Text)+breakOn pat src+    | null pat  = emptyError "breakOn"+    | otherwise = case indices pat src of+                    []    -> (src, empty)+                    (x:_) -> let h :*: t = splitAtWord x src+                             in  (h, t)++-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the string.+--+-- The first element of the returned tuple is the prefix of @haystack@+-- up to and including the last match of @needle@.  The second is the+-- remainder of @haystack@, following the match.+--+-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")+breakOnEnd :: Text -> Text -> (Text, Text)+breakOnEnd pat src = let (a,b) = breakOn (reverse pat) (reverse src)+                   in  (reverse b, reverse a)+{-# INLINE breakOnEnd #-}++-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in+-- @haystack@.  Each element of the returned list consists of a pair:+--+-- * The entire string prior to the /k/th match (i.e. the prefix)+--+-- * The /k/th match, followed by the remainder of the string+--+-- Examples:+--+-- > breakOnAll "::" ""+-- > ==> []+-- > breakOnAll "/" "a/b/c/"+-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]+--+-- This function is strict in its first argument, and lazy in its+-- second.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+--+-- The @needle@ parameter may not be empty.+breakOnAll :: Text              -- ^ @needle@ to search for+           -> Text              -- ^ @haystack@ in which to search+           -> [(Text, Text)]+breakOnAll pat src+    | null pat  = emptyError "breakOnAll"+    | otherwise = go 0 empty src (indices pat src)+  where+    go !n p s (x:xs) = let h :*: t = splitAtWord (x-n) s+                           h'      = append p h+                       in (h',t) : go x h' t xs+    go _  _ _ _      = []++-- | /O(n)/ 'break' is like 'span', but the prefix returned is over+-- elements that fail the predicate @p@.+--+-- >>> T.break (=='c') "180cm"+-- ("180","cm")+break :: (Char -> Bool) -> Text -> (Text, Text)+break p t0 = break' t0+  where break' Empty          = (empty, empty)+        break' c@(Chunk t ts) =+          case T.findIndex p t of+            Nothing      -> let (ts', ts'') = break' ts+                            in (Chunk t ts', ts'')+            Just n | n == 0    -> (Empty, c)+                   | otherwise -> let (a,b) = T.splitAt n t+                                  in (Chunk a Empty, Chunk b ts)++-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns+-- a pair whose first element is the longest prefix (possibly empty)+-- of @t@ of elements that satisfy @p@, and whose second is the+-- remainder of the list.+--+-- >>> T.span (=='0') "000AB"+-- ("000","AB")+span :: (Char -> Bool) -> Text -> (Text, Text)+span p = break (not . p)+{-# INLINE span #-}++-- | The 'group' function takes a 'Text' and returns a list of 'Text's+-- such that the concatenation of the result is equal to the argument.+-- Moreover, each sublist in the result contains only equal elements.+-- For example,+--+-- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]+--+-- It is a special case of 'groupBy', which allows the programmer to+-- supply their own equality test.+group :: Text -> [Text]+group =  groupBy (==)+{-# INLINE group #-}++-- | The 'groupBy' function is the non-overloaded version of 'group'.+groupBy :: (Char -> Char -> Bool) -> Text -> [Text]+groupBy _  Empty        = []+groupBy eq (Chunk t ts) = cons x ys : groupBy eq zs+                          where (ys,zs) = span (eq x) xs+                                x  = T.unsafeHead t+                                xs = chunk (T.unsafeTail t) ts++-- | /O(n)/ Return all initial segments of the given 'Text',+-- shortest first.+inits :: Text -> [Text]+inits = (Empty :) . inits'+  where inits' Empty        = []+        inits' (Chunk t ts) = L.map (\t' -> Chunk t' Empty) (L.tail (T.inits t))+                           ++ L.map (Chunk t) (inits' ts)++-- | /O(n)/ Return all final segments of the given 'Text', longest+-- first.+tails :: Text -> [Text]+tails Empty         = Empty : []+tails ts@(Chunk t ts')+  | T.length t == 1 = ts : tails ts'+  | otherwise       = ts : tails (Chunk (T.unsafeTail t) ts')++-- $split+--+-- Splitting functions in this library do not perform character-wise+-- copies to create substrings; they just construct new 'Text's that+-- are slices of the original.++-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'+-- argument (which cannot be an empty string), consuming the+-- delimiter. An empty delimiter is invalid, and will cause an error+-- to be raised.+--+-- Examples:+--+-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]+-- > splitOn "aaa"  "aaaXaaaXaaaXaaa"  == ["","X","X","X",""]+-- > splitOn "x"    "x"                == ["",""]+--+-- and+--+-- > intercalate s . splitOn s         == id+-- > splitOn (singleton c)             == split (==c)+--+-- (Note: the string @s@ to split on above cannot be empty.)+--+-- This function is strict in its first argument, and lazy in its+-- second.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+splitOn :: Text+        -- ^ String to split on. If this string is empty, an error+        -- will occur.+        -> Text+        -- ^ Input text.+        -> [Text]+splitOn pat src+    | null pat        = emptyError "splitOn"+    | isSingleton pat = split (== head pat) src+    | otherwise       = go 0 (indices pat src) src+  where+    go  _ []     cs = [cs]+    go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs+                      in  h : go (x+l) xs (dropWords l t)+    l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat+{-# INLINE [1] splitOn #-}++{-# RULES+"LAZY TEXT splitOn/singleton -> split/==" [~1] forall c t.+    splitOn (singleton c) t = split (==c) t+  #-}++-- | /O(n)/ Splits a 'Text' into components delimited by separators,+-- where the predicate returns True for a separator element.  The+-- resulting components do not contain the separators.  Two adjacent+-- separators result in an empty component in the output.  eg.+--+-- > split (=='a') "aabbaca" == ["","","bb","c",""]+-- > split (=='a') []        == [""]+split :: (Char -> Bool) -> Text -> [Text]+split _ Empty = [Empty]+split p (Chunk t0 ts0) = comb [] (T.split p t0) ts0+  where comb acc (s:[]) Empty        = revChunks (s:acc) : []+        comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.split p t) ts+        comb acc (s:ss) ts           = revChunks (s:acc) : comb [] ss ts+        comb _   []     _            = impossibleError "split"+{-# INLINE split #-}++-- | /O(n)/ Splits a 'Text' into components of length @k@.  The last+-- element may be shorter than the other chunks, depending on the+-- length of the input. Examples:+--+-- > chunksOf 3 "foobarbaz"   == ["foo","bar","baz"]+-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]+chunksOf :: Int64 -> Text -> [Text]+chunksOf k = go+  where+    go t = case splitAt k t of+             (a,b) | null a    -> []+                   | otherwise -> a : go b+{-# INLINE chunksOf #-}++-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at+-- newline 'Char's. The resulting strings do not contain newlines.+lines :: Text -> [Text]+lines Empty = []+lines t = let (l,t') = break ((==) '\n') t+          in l : if null t' then []+                 else lines (tail t')++-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's+-- representing white space.+words :: Text -> [Text]+words = L.filter (not . null) . split isSpace+{-# INLINE words #-}++-- | /O(n)/ Joins lines, after appending a terminating newline to+-- each.+unlines :: [Text] -> Text+unlines = concat . L.map (`snoc` '\n')+{-# INLINE unlines #-}++-- | /O(n)/ Joins words using single space characters.+unwords :: [Text] -> Text+unwords = intercalate (singleton ' ')+{-# INLINE unwords #-}++-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns+-- 'True' iff the first is a prefix of the second.  Subject to fusion.+isPrefixOf :: Text -> Text -> Bool+isPrefixOf Empty _  = True+isPrefixOf _ Empty  = False+isPrefixOf (Chunk x xs) (Chunk y ys)+    | lx == ly  = x == y  && isPrefixOf xs ys+    | lx <  ly  = x == yh && isPrefixOf xs (Chunk yt ys)+    | otherwise = xh == y && isPrefixOf (Chunk xt xs) ys+  where (xh,xt) = T.splitAt ly x+        (yh,yt) = T.splitAt lx y+        lx = T.length x+        ly = T.length y+{-# INLINE [1] isPrefixOf #-}++{-# RULES+"LAZY TEXT isPrefixOf -> fused" [~1] forall s t.+    isPrefixOf s t = S.isPrefixOf (stream s) (stream t)+"LAZY TEXT isPrefixOf -> unfused" [1] forall s t.+    S.isPrefixOf (stream s) (stream t) = isPrefixOf s t+  #-}++-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns+-- 'True' iff the first is a suffix of the second.+isSuffixOf :: Text -> Text -> Bool+isSuffixOf x y = reverse x `isPrefixOf` reverse y+{-# INLINE isSuffixOf #-}+-- TODO: a better implementation++-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns+-- 'True' iff the first is contained, wholly and intact, anywhere+-- within the second.+--+-- This function is strict in its first argument, and lazy in its+-- second.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+isInfixOf :: Text -> Text -> Bool+isInfixOf needle haystack+    | null needle        = True+    | isSingleton needle = S.elem (head needle) . S.stream $ haystack+    | otherwise          = not . L.null . indices needle $ haystack+{-# INLINE [1] isInfixOf #-}++{-# RULES+"LAZY TEXT isInfixOf/singleton -> S.elem/S.stream" [~1] forall n h.+    isInfixOf (singleton n) h = S.elem n (S.stream h)+  #-}++-------------------------------------------------------------------------------+-- * View patterns++-- | /O(n)/ Return the suffix of the second string if its prefix+-- matches the entire first string.+--+-- Examples:+--+-- > stripPrefix "foo" "foobar" == Just "bar"+-- > stripPrefix ""    "baz"    == Just "baz"+-- > stripPrefix "foo" "quux"   == Nothing+--+-- This is particularly useful with the @ViewPatterns@ extension to+-- GHC, as follows:+--+-- > {-# LANGUAGE ViewPatterns #-}+-- > import Data.Text.Lazy as T+-- >+-- > fnordLength :: Text -> Int+-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf+-- > fnordLength _                                 = -1+stripPrefix :: Text -> Text -> Maybe Text+stripPrefix p t+    | null p    = Just t+    | otherwise = case commonPrefixes p t of+                    Just (_,c,r) | null c -> Just r+                    _                     -> Nothing++-- | /O(n)/ Find the longest non-empty common prefix of two strings+-- and return it, along with the suffixes of each string at which they+-- no longer match.+--+-- If the strings do not have a common prefix or either one is empty,+-- this function returns 'Nothing'.+--+-- Examples:+--+-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")+-- > commonPrefixes "veeble" "fetzer"  == Nothing+-- > commonPrefixes "" "baz"           == Nothing+commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)+commonPrefixes Empty _ = Nothing+commonPrefixes _ Empty = Nothing+commonPrefixes a0 b0   = Just (go a0 b0 [])+  where+    go t0@(Chunk x xs) t1@(Chunk y ys) ps+        = case T.commonPrefixes x y of+            Just (p,a,b)+              | T.null a  -> go xs (chunk b ys) (p:ps)+              | T.null b  -> go (chunk a xs) ys (p:ps)+              | otherwise -> (fromChunks (L.reverse (p:ps)),chunk a xs, chunk b ys)+            Nothing       -> (fromChunks (L.reverse ps),t0,t1)+    go t0 t1 ps = (fromChunks (L.reverse ps),t0,t1)++-- | /O(n)/ Return the prefix of the second string if its suffix+-- matches the entire first string.+--+-- Examples:+--+-- > stripSuffix "bar" "foobar" == Just "foo"+-- > stripSuffix ""    "baz"    == Just "baz"+-- > stripSuffix "foo" "quux"   == Nothing+--+-- This is particularly useful with the @ViewPatterns@ extension to+-- GHC, as follows:+--+-- > {-# LANGUAGE ViewPatterns #-}+-- > import Data.Text.Lazy as T+-- >+-- > quuxLength :: Text -> Int+-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre+-- > quuxLength _                                = -1+stripSuffix :: Text -> Text -> Maybe Text+stripSuffix p t = reverse `fmap` stripPrefix (reverse p) (reverse t)++-- | /O(n)/ 'filter', applied to a predicate and a 'Text',+-- returns a 'Text' containing those characters that satisfy the+-- predicate.+filter :: (Char -> Bool) -> Text -> Text+filter p t = unstream (S.filter p (stream t))+{-# INLINE filter #-}++-- | /O(n)/ The 'find' function takes a predicate and a 'Text', and+-- returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element. Subject to fusion.+find :: (Char -> Bool) -> Text -> Maybe Char+find p t = S.findBy p (stream t)+{-# INLINE find #-}++-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',+-- and returns the pair of 'Text's with elements which do and do not+-- satisfy the predicate, respectively; i.e.+--+-- > partition p t == (filter p t, filter (not . p) t)+partition :: (Char -> Bool) -> Text -> (Text, Text)+partition p t = (filter p t, filter (not . p) t)+{-# INLINE partition #-}++-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.+-- Subject to fusion.+index :: Text -> Int64 -> Char+index t n = S.index (stream t) n+{-# INLINE index #-}++-- | /O(n+m)/ The 'count' function returns the number of times the+-- query string appears in the given 'Text'. An empty query string is+-- invalid, and will cause an error to be raised.+--+-- In (unlikely) bad cases, this function's time complexity degrades+-- towards /O(n*m)/.+count :: Text -> Text -> Int64+count pat src+    | null pat        = emptyError "count"+    | otherwise       = go 0 (indices pat src)+  where go !n []     = n+        go !n (_:xs) = go (n+1) xs+{-# INLINE [1] count #-}++{-# RULES+"LAZY TEXT count/singleton -> countChar" [~1] forall c t.+    count (singleton c) t = countChar c t+  #-}++-- | /O(n)/ The 'countChar' function returns the number of times the+-- query element appears in the given 'Text'.  Subject to fusion.+countChar :: Char -> Text -> Int64+countChar c t = S.countChar c (stream t)++-- | /O(n)/ 'zip' takes two 'Text's and returns a list of+-- corresponding pairs of bytes. If one input 'Text' is short,+-- excess elements of the longer 'Text' are discarded. This is+-- equivalent to a pair of 'unpack' operations.+zip :: Text -> Text -> [(Char,Char)]+zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)+{-# INLINE [0] zip #-}++-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function+-- given as the first argument, instead of a tupling function.+-- Performs replacement on invalid scalar values.+zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text+zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))+    where g a b = safe (f a b)+{-# INLINE [0] zipWith #-}++revChunks :: [T.Text] -> Text+revChunks = L.foldl' (flip chunk) Empty++emptyError :: String -> a+emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")++impossibleError :: String -> a+impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
+ src/Data/Text/Lazy/Builder.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Module      : Data.Text.Lazy.Builder+-- Copyright   : (c) 2013 Bryan O'Sullivan+--               (c) 2010 Johan Tibell+-- License     : BSD-style (see LICENSE)+--+-- Maintainer  : Johan Tibell <johan.tibell@gmail.com>+-- Portability : portable to Hugs and GHC+--+-- Efficient construction of lazy @Text@ values.  The principal+-- operations on a @Builder@ are @singleton@, @fromText@, and+-- @fromLazyText@, which construct new builders, and 'mappend', which+-- concatenates two builders.+--+-- To get maximum performance when building lazy @Text@ values using a+-- builder, associate @mappend@ calls to the right.  For example,+-- prefer+--+-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')+--+-- to+--+-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'+--+-- as the latter associates @mappend@ to the left. Or, equivalently,+-- prefer+--+--  > singleton 'a' <> singleton 'b' <> singleton 'c'+--+-- since the '<>' from recent versions of 'Data.Monoid' associates+-- to the right.++-----------------------------------------------------------------------------++module Data.Text.Lazy.Builder+   ( -- * The Builder type+     Builder+   , toLazyText+   , toLazyTextWith++     -- * Constructing Builders+   , singleton+   , fromText+   , fromLazyText+   , fromString++     -- * Flushing the buffer state+   , flush+   ) where++import Data.Text.Internal.Builder
+ src/Data/Text/Lazy/Builder/Int.hs view
@@ -0,0 +1,272 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,+    UnboxedTuples #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif++-- Module:      Data.Text.Lazy.Builder.Int+-- Copyright:   (c) 2013 Bryan O'Sullivan+--              (c) 2011 MailRank, Inc.+-- License:     BSD-style+-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>+-- Portability: portable+--+-- Efficiently write an integral value to a 'Builder'.++module Data.Text.Lazy.Builder.Int+    (+      decimal+    , hexadecimal+    ) where++import Data.Int (Int8, Int16, Int32, Int64)+import Data.Monoid (mempty)+import qualified Data.ByteString.Unsafe as B+import Data.Text.Internal.Builder.Functions ((<>), i2d)+import Data.Text.Internal.Builder+import Data.Text.Internal.Builder.Int.Digits (digits)+import Data.Text.Array+import Data.Word (Word, Word8, Word16, Word32, Word64)+import GHC.Base (quotInt, remInt)+import GHC.Types (Int(..))+import Control.Monad.ST+#if MIN_VERSION_base(4,11,0)+import Prelude hiding ((<>))+#endif++#ifdef  __GLASGOW_HASKELL__++#if __GLASGOW_HASKELL__ >= 811++import GHC.Num.Integer+#define HAS_INTEGER_CONSTR 1+#define quotRemInteger integerQuotRem#++#else++import GHC.Num (quotRemInteger)++# if defined(INTEGER_GMP)+import GHC.Integer.GMP.Internals (Integer(S#))+#define IS S#+#define HAS_INTEGER_CONSTR 1+# elif defined(INTEGER_SIMPLE)+import GHC.Integer ()+# else+# error "You need to use either GMP or integer-simple."+# endif+#endif++#endif++decimal :: Integral a => a -> Builder+{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}+{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}+{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}+{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}+{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}+{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}+{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}+{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}+{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}+{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}+decimal i = decimal' (<= -128) i+{-# NOINLINE decimal #-}++boundedDecimal :: (Integral a, Bounded a) => a -> Builder+{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}+{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}+{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}+{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}+{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}+boundedDecimal i = decimal' (== minBound) i++decimal' :: (Integral a) => (a -> Bool) -> a -> Builder+{-# INLINE decimal' #-}+decimal' p i+    | i < 0 = if p i+              then let (q, r) = i `quotRem` 10+                       qq = -q+                       !n = countDigits qq+                   in writeN (n + 2) $ \marr off -> do+                       unsafeWrite marr off minus+                       posDecimal marr (off+1) n qq+                       unsafeWrite marr (off+n+1) (i2w (-r))+              else let j = -i+                       !n = countDigits j+                   in writeN (n + 1) $ \marr off ->+                       unsafeWrite marr off minus >> posDecimal marr (off+1) n j+    | otherwise = positive i++positive :: (Integral a) => a -> Builder+{-# SPECIALIZE positive :: Int -> Builder #-}+{-# SPECIALIZE positive :: Int8 -> Builder #-}+{-# SPECIALIZE positive :: Int16 -> Builder #-}+{-# SPECIALIZE positive :: Int32 -> Builder #-}+{-# SPECIALIZE positive :: Int64 -> Builder #-}+{-# SPECIALIZE positive :: Word -> Builder #-}+{-# SPECIALIZE positive :: Word8 -> Builder #-}+{-# SPECIALIZE positive :: Word16 -> Builder #-}+{-# SPECIALIZE positive :: Word32 -> Builder #-}+{-# SPECIALIZE positive :: Word64 -> Builder #-}+positive i+    | i < 10    = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)+    | otherwise = let !n = countDigits i+                  in writeN n $ \marr off -> posDecimal marr off n i++posDecimal :: (Integral a) =>+              forall s. MArray s -> Int -> Int -> a -> ST s ()+{-# INLINE posDecimal #-}+posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0+  where go off v+           | v >= 100 = do+               let (q, r) = v `quotRem` 100+               write2 off r+               go (off - 2) q+           | v < 10    = unsafeWrite marr off (i2w v)+           | otherwise = write2 off v+        write2 off i0 = do+          let i = fromIntegral i0; j = i + i+          unsafeWrite marr off $ get (j + 1)+          unsafeWrite marr (off - 1) $ get j+        get = fromIntegral . B.unsafeIndex digits++minus, zero :: Word16+{-# INLINE minus #-}+{-# INLINE zero #-}+minus = 45+zero = 48++i2w :: (Integral a) => a -> Word16+{-# INLINE i2w #-}+i2w v = zero + fromIntegral v++countDigits :: (Integral a) => a -> Int+{-# INLINE countDigits #-}+countDigits v0+  | fromIntegral v64 == v0 = go 1 v64+  | otherwise              = goBig 1 (fromIntegral v0)+  where v64 = fromIntegral v0+        goBig !k (v :: Integer)+           | v > big   = goBig (k + 19) (v `quot` big)+           | otherwise = go k (fromIntegral v)+        big = 10000000000000000000+        go !k (v :: Word64)+           | v < 10    = k+           | v < 100   = k + 1+           | v < 1000  = k + 2+           | v < 1000000000000 =+               k + if v < 100000000+                   then if v < 1000000+                        then if v < 10000+                             then 3+                             else 4 + fin v 100000+                        else 6 + fin v 10000000+                   else if v < 10000000000+                        then 8 + fin v 1000000000+                        else 10 + fin v 100000000000+           | otherwise = go (k + 12) (v `quot` 1000000000000)+        fin v n = if v >= n then 1 else 0++hexadecimal :: Integral a => a -> Builder+{-# SPECIALIZE hexadecimal :: Int -> Builder #-}+{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}+{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}+{-# RULES "hexadecimal/Integer"+    hexadecimal = hexInteger :: Integer -> Builder #-}+hexadecimal i+    | i < 0     = error hexErrMsg+    | otherwise = go i+  where+    go n | n < 16    = hexDigit n+         | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)+{-# NOINLINE[0] hexadecimal #-}++hexInteger :: Integer -> Builder+hexInteger i+    | i < 0     = error hexErrMsg+    | otherwise = integer 16 i++hexErrMsg :: String+hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"++hexDigit :: Integral a => a -> Builder+hexDigit n+    | n <= 9    = singleton $! i2d (fromIntegral n)+    | otherwise = singleton $! toEnum (fromIntegral n + 87)+{-# INLINE hexDigit #-}++data T = T !Integer !Int++integer :: Int -> Integer -> Builder+#ifdef HAS_INTEGER_CONSTR+integer 10 (IS i#) = decimal (I# i#)+integer 16 (IS i#) = hexadecimal (I# i#)+#endif+integer base i+    | i < 0     = singleton '-' <> go (-i)+    | otherwise = go i+  where+    go n | n < maxInt = int (fromInteger n)+         | otherwise  = putH (splitf (maxInt * maxInt) n)++    splitf p n+      | p > n       = [n]+      | otherwise   = splith p (splitf (p*p) n)++    splith p (n:ns) = case n `quotRemInteger` p of+                        (# q,r #) | q > 0     -> q : r : splitb p ns+                                  | otherwise -> r : splitb p ns+    splith _ _      = error "splith: the impossible happened."++    splitb p (n:ns) = case n `quotRemInteger` p of+                        (# q,r #) -> q : r : splitb p ns+    splitb _ _      = []++    T maxInt10 maxDigits10 =+        until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)+      where mi = fromIntegral (maxBound :: Int)+    T maxInt16 maxDigits16 =+        until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)+      where mi = fromIntegral (maxBound :: Int)++    fstT (T a _) = a++    maxInt | base == 10 = maxInt10+           | otherwise  = maxInt16+    maxDigits | base == 10 = maxDigits10+              | otherwise  = maxDigits16++    putH (n:ns) = case n `quotRemInteger` maxInt of+                    (# x,y #)+                        | q > 0     -> int q <> pblock r <> putB ns+                        | otherwise -> int r <> putB ns+                        where q = fromInteger x+                              r = fromInteger y+    putH _ = error "putH: the impossible happened"++    putB (n:ns) = case n `quotRemInteger` maxInt of+                    (# x,y #) -> pblock q <> pblock r <> putB ns+                        where q = fromInteger x+                              r = fromInteger y+    putB _ = Data.Monoid.mempty++    int :: Int -> Builder+    int x | base == 10 = decimal x+          | otherwise  = hexadecimal x++    pblock = loop maxDigits+      where+        loop !d !n+            | d == 1    = hexDigit n+            | otherwise = loop (d-1) q <> hexDigit r+            where q = n `quotInt` base+                  r = n `remInt` base
+ src/Data/Text/Lazy/Builder/RealFloat.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE CPP, OverloadedStrings #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif++-- |+-- Module:    Data.Text.Lazy.Builder.RealFloat+-- Copyright: (c) The University of Glasgow 1994-2002+-- License:   see libraries/base/LICENSE+--+-- Write a floating point value to a 'Builder'.++module Data.Text.Lazy.Builder.RealFloat+    (+      FPFormat(..)+    , realFloat+    , formatRealFloat+    ) where++import Data.Array.Base (unsafeAt)+import Data.Array.IArray+import Data.Text.Internal.Builder.Functions ((<>), i2d)+import Data.Text.Lazy.Builder.Int (decimal)+import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)+import Data.Text.Lazy.Builder+import qualified Data.Text as T+#if MIN_VERSION_base(4,11,0)+import Prelude hiding ((<>))+#endif++-- | Control the rendering of floating point numbers.+data FPFormat = Exponent+              -- ^ Scientific notation (e.g. @2.3e123@).+              | Fixed+              -- ^ Standard decimal notation.+              | Generic+              -- ^ Use decimal notation for values between @0.1@ and+              -- @9,999,999@, and scientific notation otherwise.+                deriving (Enum, Read, Show)++-- | Show a signed 'RealFloat' value to full precision,+-- using standard decimal notation for arguments whose absolute value lies+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.+realFloat :: (RealFloat a) => a -> Builder+{-# SPECIALIZE realFloat :: Float -> Builder #-}+{-# SPECIALIZE realFloat :: Double -> Builder #-}+realFloat x = formatRealFloat Generic Nothing x++-- | Encode a signed 'RealFloat' according to 'FPFormat' and optionally requested precision.+--+-- This corresponds to the @show{E,F,G}Float@ operations provided by @base@'s "Numeric" module.+--+-- __NOTE__: The functions in @base-4.12@ changed the serialisation in+-- case of a @Just 0@ precision; this version of @text@ still provides+-- the serialisation as implemented in @base-4.11@. The next major+-- version of @text@ will switch to the more correct @base-4.12@ serialisation.+formatRealFloat :: (RealFloat a) =>+                   FPFormat+                -> Maybe Int  -- ^ Number of decimal places to render.+                -> a+                -> Builder+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}+{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}+formatRealFloat fmt decs x+   | isNaN x                   = "NaN"+   | isInfinite x              = if x < 0 then "-Infinity" else "Infinity"+   | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))+   | otherwise                 = doFmt fmt (floatToDigits x)+ where+  doFmt format (is, e) =+    let ds = map i2d is in+    case format of+     Generic ->+      doFmt (if e < 0 || e > 7 then Exponent else Fixed)+            (is,e)+     Exponent ->+      case decs of+       Nothing ->+        let show_e' = decimal (e-1) in+        case ds of+          "0"     -> "0.0e0"+          [d]     -> singleton d <> ".0e" <> show_e'+          (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'+          []      -> error "formatRealFloat/doFmt/Exponent/Nothing: []"+       Just dec ->+        let dec' = max dec 1 in+        case is of+         [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"+         _ ->+          let (ei,is') = roundTo (dec'+1) is+              is'' = map i2d (if ei > 0 then init is' else is')+          in case is'' of+               [] -> error "formatRealFloat/doFmt/Exponent/Just: []"+               (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)+     Fixed ->+      let+       mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}+      in+      case decs of+       Nothing+          | e <= 0    -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds+          | otherwise ->+             let+                f 0 s    rs  = mk0 (reverse s) <> singleton '.' <> mk0 rs+                f n s    ""  = f (n-1) ('0':s) ""+                f n s (r:rs) = f (n-1) (r:s) rs+             in+                f e "" ds+       Just dec ->+        let dec' = max dec 0 in+        if e >= 0 then+         let+          (ei,is') = roundTo (dec' + e) is+          (ls,rs)  = splitAt (e+ei) (map i2d is')+         in+         mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)+        else+         let (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)+             is'' = map i2d (if ei > 0 then is' else 0:is')+         in case is'' of+              [] -> error "formatRealFloat/doFmt/Fixed: []"+              (d:ds') -> singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')+++-- Based on "Printing Floating-Point Numbers Quickly and Accurately"+-- by R.G. Burger and R.K. Dybvig in PLDI 96.+-- This version uses a much slower logarithm estimator. It should be improved.++-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,+-- and returns a list of digits and an exponent.+-- In particular, if @x>=0@, and+--+-- > floatToDigits base x = ([d1,d2,...,dn], e)+--+-- then+--+--      (1) @n >= 1@+--+--      (2) @x = 0.d1d2...dn * (base**e)@+--+--      (3) @0 <= di <= base-1@++floatToDigits :: (RealFloat a) => a -> ([Int], Int)+{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}+{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}+floatToDigits 0 = ([0], 0)+floatToDigits x =+ let+  (f0, e0) = decodeFloat x+  (minExp0, _) = floatRange x+  p = floatDigits x+  b = floatRadix x+  minExp = minExp0 - p -- the real minimum exponent+  -- Haskell requires that f be adjusted so denormalized numbers+  -- will have an impossibly low exponent.  Adjust for this.+  (f, e) =+   let n = minExp - e0 in+   if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)+  (r, s, mUp, mDn) =+   if e >= 0 then+    let be = expt b e in+    if f == expt b (p-1) then+      (f*be*b*2, 2*b, be*b, be)     -- according to Burger and Dybvig+    else+      (f*be*2, 2, be, be)+   else+    if e > minExp && f == expt b (p-1) then+      (f*b*2, expt b (-e+1)*2, b, 1)+    else+      (f*2, expt b (-e)*2, 1, 1)+  k :: Int+  k =+   let+    k0 :: Int+    k0 =+     if b == 2 then+        -- logBase 10 2 is very slightly larger than 8651/28738+        -- (about 5.3558e-10), so if log x >= 0, the approximation+        -- k1 is too small, hence we add one and need one fixup step less.+        -- If log x < 0, the approximation errs rather on the high side.+        -- That is usually more than compensated for by ignoring the+        -- fractional part of logBase 2 x, but when x is a power of 1/2+        -- or slightly larger and the exponent is a multiple of the+        -- denominator of the rational approximation to logBase 10 2,+        -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,+        -- we get a leading zero-digit we don't want.+        -- With the approximation 3/10, this happened for+        -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.+        -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x+        -- for IEEE-ish floating point types with exponent fields+        -- <= 17 bits and mantissae of several thousand bits, earlier+        -- convergents to logBase 10 2 would fail for long double.+        -- Using quot instead of div is a little faster and requires+        -- fewer fixup steps for negative lx.+        let lx = p - 1 + e0+            k1 = (lx * 8651) `quot` 28738+        in if lx >= 0 then k1 + 1 else k1+     else+        -- f :: Integer, log :: Float -> Float,+        --               ceiling :: Float -> Int+        ceiling ((log (fromInteger (f+1) :: Float) ++                 fromIntegral e * log (fromInteger b)) /+                   log 10)+--WAS:            fromInt e * log (fromInteger b))++    fixup n =+      if n >= 0 then+        if r + mUp <= expt 10 n * s then n else fixup (n+1)+      else+        if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)+   in+   fixup k0++  gen ds rn sN mUpN mDnN =+   let+    (dn, rn') = (rn * 10) `quotRem` sN+    mUpN' = mUpN * 10+    mDnN' = mDnN * 10+   in+   case (rn' < mDnN', rn' + mUpN' > sN) of+    (True,  False) -> dn : ds+    (False, True)  -> dn+1 : ds+    (True,  True)  -> if rn' * 2 < sN then dn : ds else dn+1 : ds+    (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'++  rds =+   if k >= 0 then+      gen [] r (s * expt 10 k) mUp mDn+   else+     let bk = expt 10 (-k) in+     gen [] (r * bk) s (mUp * bk) (mDn * bk)+ in+ (map fromIntegral (reverse rds), k)++-- Exponentiation with a cache for the most common numbers.+minExpt, maxExpt :: Int+minExpt = 0+maxExpt = 1100++expt :: Integer -> Int -> Integer+expt base n+    | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n+    | base == 10 && n <= maxExpt10              = expts10 `unsafeAt` n+    | otherwise                                 = base^n++expts :: Array Int Integer+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]++maxExpt10 :: Int+maxExpt10 = 324++expts10 :: Array Int Integer+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
+ src/Data/Text/Lazy/Encoding.hs view
@@ -0,0 +1,250 @@+{-# LANGUAGE BangPatterns,CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-- |+-- Module      : Data.Text.Lazy.Encoding+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : portable+--+-- Functions for converting lazy 'Text' values to and from lazy+-- 'ByteString', using several standard encodings.+--+-- To gain access to a much larger family of encodings, use the+-- <http://hackage.haskell.org/package/text-icu text-icu package>.++module Data.Text.Lazy.Encoding+    (+    -- * Decoding ByteStrings to Text+    -- $strict+      decodeASCII+    , decodeLatin1+    , decodeUtf8+    , decodeUtf16LE+    , decodeUtf16BE+    , decodeUtf32LE+    , decodeUtf32BE++    -- ** Catchable failure+    , decodeUtf8'++    -- ** Controllable error handling+    , decodeUtf8With+    , decodeUtf16LEWith+    , decodeUtf16BEWith+    , decodeUtf32LEWith+    , decodeUtf32BEWith++    -- * Encoding Text to ByteStrings+    , encodeUtf8+    , encodeUtf16LE+    , encodeUtf16BE+    , encodeUtf32LE+    , encodeUtf32BE++    -- * Encoding Text using ByteString Builders+    , encodeUtf8Builder+    , encodeUtf8BuilderEscaped+    ) where++import Control.Exception (evaluate, try)+import Data.Monoid (Monoid(..))+import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)+import Data.Word (Word8)+import qualified Data.ByteString as S+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)+import qualified Data.ByteString.Builder.Prim as BP+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Internal as B+import qualified Data.ByteString.Unsafe as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E+import qualified Data.Text.Internal.Lazy.Fusion as F+import Data.Text.Unsafe (unsafeDupablePerformIO)++-- $strict+--+-- All of the single-parameter functions for decoding bytestrings+-- encoded in one of the Unicode Transformation Formats (UTF) operate+-- in a /strict/ mode: each will throw an exception if given invalid+-- input.+--+-- Each function has a variant, whose name is suffixed with -'With',+-- that gives greater control over the handling of decoding errors.+-- For instance, 'decodeUtf8' will throw an exception, but+-- 'decodeUtf8With' allows the programmer to determine what to do on a+-- decoding error.++-- | /Deprecated/.  Decode a 'ByteString' containing 7-bit ASCII+-- encoded text.+decodeASCII :: B.ByteString -> Text+decodeASCII = decodeUtf8+{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}++-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.+decodeLatin1 :: B.ByteString -> Text+decodeLatin1 = foldr (chunk . TE.decodeLatin1) empty . B.toChunks++-- | Decode a 'ByteString' containing UTF-8 encoded text.+decodeUtf8With :: OnDecodeError -> B.ByteString -> Text+decodeUtf8With onErr (B.Chunk b0 bs0) =+    case TE.streamDecodeUtf8With onErr b0 of+      TE.Some t l f -> chunk t (go f l bs0)+  where+    go f0 _ (B.Chunk b bs) =+      case f0 b of+        TE.Some t l f -> chunk t (go f l bs)+    go _ l _+      | S.null l  = empty+      | otherwise = case onErr desc (Just (B.unsafeHead l)) of+                      Nothing -> empty+                      Just c  -> Chunk (T.singleton c) Empty+    desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"+decodeUtf8With _ _ = empty++-- | Decode a 'ByteString' containing UTF-8 encoded text that is known+-- to be valid.+--+-- If the input contains any invalid UTF-8 data, an exception will be+-- thrown that cannot be caught in pure code.  For more control over+-- the handling of invalid data, use 'decodeUtf8'' or+-- 'decodeUtf8With'.+decodeUtf8 :: B.ByteString -> Text+decodeUtf8 = decodeUtf8With strictDecode+{-# INLINE[0] decodeUtf8 #-}++-- This rule seems to cause performance loss.+{- RULES "LAZY STREAM stream/decodeUtf8' fusion" [1]+   forall bs. F.stream (decodeUtf8' bs) = E.streamUtf8 strictDecode bs #-}++-- | Decode a 'ByteString' containing UTF-8 encoded text..+--+-- If the input contains any invalid UTF-8 data, the relevant+-- exception will be returned, otherwise the decoded text.+--+-- /Note/: this function is /not/ lazy, as it must decode its entire+-- input before it can return a result.  If you need lazy (streaming)+-- decoding, use 'decodeUtf8With' in lenient mode.+decodeUtf8' :: B.ByteString -> Either UnicodeException Text+decodeUtf8' bs = unsafeDupablePerformIO $ do+                   let t = decodeUtf8 bs+                   try (evaluate (rnf t `seq` t))+  where+    rnf Empty        = ()+    rnf (Chunk _ ts) = rnf ts+{-# INLINE decodeUtf8' #-}++-- | Encode text using UTF-8 encoding.+encodeUtf8 :: Text -> B.ByteString+encodeUtf8    Empty       = B.empty+encodeUtf8 lt@(Chunk t _) =+    B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt+  where+    -- To improve our small string performance, we use a strategy that+    -- allocates a buffer that is guaranteed to be large enough for the+    -- encoding of the first chunk, but not larger than the default+    -- B.smallChunkSize. We clamp the firstChunkSize to ensure that we don't+    -- generate too large buffers which hamper streaming.+    firstChunkSize  = min B.smallChunkSize (4 * (T.length t + 1))+    strategy        = B.safeStrategy firstChunkSize B.defaultChunkSize++-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.+--+-- @since 1.1.0.0+encodeUtf8Builder :: Text -> B.Builder+encodeUtf8Builder =+    foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty++-- | Encode text using UTF-8 encoding and escape the ASCII characters using+-- a 'BP.BoundedPrim'.+--+-- Use this function is to implement efficient encoders for text-based formats+-- like JSON or HTML.+--+-- @since 1.1.0.0+{-# INLINE encodeUtf8BuilderEscaped #-}+encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder+encodeUtf8BuilderEscaped prim =+    foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty++-- | Decode text from little endian UTF-16 encoding.+decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text+decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)+{-# INLINE decodeUtf16LEWith #-}++-- | Decode text from little endian UTF-16 encoding.+--+-- If the input contains any invalid little endian UTF-16 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf16LEWith'.+decodeUtf16LE :: B.ByteString -> Text+decodeUtf16LE = decodeUtf16LEWith strictDecode+{-# INLINE decodeUtf16LE #-}++-- | Decode text from big endian UTF-16 encoding.+decodeUtf16BEWith :: OnDecodeError -> B.ByteString -> Text+decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)+{-# INLINE decodeUtf16BEWith #-}++-- | Decode text from big endian UTF-16 encoding.+--+-- If the input contains any invalid big endian UTF-16 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf16BEWith'.+decodeUtf16BE :: B.ByteString -> Text+decodeUtf16BE = decodeUtf16BEWith strictDecode+{-# INLINE decodeUtf16BE #-}++-- | Encode text using little endian UTF-16 encoding.+encodeUtf16LE :: Text -> B.ByteString+encodeUtf16LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16LE) [] txt)+{-# INLINE encodeUtf16LE #-}++-- | Encode text using big endian UTF-16 encoding.+encodeUtf16BE :: Text -> B.ByteString+encodeUtf16BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16BE) [] txt)+{-# INLINE encodeUtf16BE #-}++-- | Decode text from little endian UTF-32 encoding.+decodeUtf32LEWith :: OnDecodeError -> B.ByteString -> Text+decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)+{-# INLINE decodeUtf32LEWith #-}++-- | Decode text from little endian UTF-32 encoding.+--+-- If the input contains any invalid little endian UTF-32 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf32LEWith'.+decodeUtf32LE :: B.ByteString -> Text+decodeUtf32LE = decodeUtf32LEWith strictDecode+{-# INLINE decodeUtf32LE #-}++-- | Decode text from big endian UTF-32 encoding.+decodeUtf32BEWith :: OnDecodeError -> B.ByteString -> Text+decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)+{-# INLINE decodeUtf32BEWith #-}++-- | Decode text from big endian UTF-32 encoding.+--+-- If the input contains any invalid big endian UTF-32 data, an+-- exception will be thrown.  For more control over the handling of+-- invalid data, use 'decodeUtf32BEWith'.+decodeUtf32BE :: B.ByteString -> Text+decodeUtf32BE = decodeUtf32BEWith strictDecode+{-# INLINE decodeUtf32BE #-}++-- | Encode text using little endian UTF-32 encoding.+encodeUtf32LE :: Text -> B.ByteString+encodeUtf32LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32LE) [] txt)+{-# INLINE encodeUtf32LE #-}++-- | Encode text using big endian UTF-32 encoding.+encodeUtf32BE :: Text -> B.ByteString+encodeUtf32BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32BE) [] txt)+{-# INLINE encodeUtf32BE #-}
+ src/Data/Text/Lazy/IO.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-- |+-- Module      : Data.Text.Lazy.IO+-- Copyright   : (c) 2009, 2010 Bryan O'Sullivan,+--               (c) 2009 Simon Marlow+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : GHC+--+-- Efficient locale-sensitive support for lazy text I\/O.+--+-- Skip past the synopsis for some important notes on performance and+-- portability across different versions of GHC.++module Data.Text.Lazy.IO+    (+    -- * Performance+    -- $performance++    -- * Locale support+    -- $locale+    -- * File-at-a-time operations+      readFile+    , writeFile+    , appendFile+    -- * Operations on handles+    , hGetContents+    , hGetLine+    , hPutStr+    , hPutStrLn+    -- * Special cases for standard input and output+    , interact+    , getContents+    , getLine+    , putStr+    , putStrLn+    ) where++import Data.Text.Lazy (Text)+import Prelude hiding (appendFile, getContents, getLine, interact,+                       putStr, putStrLn, readFile, writeFile)+import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,+                  withFile)+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as L+import qualified Control.Exception as E+import Control.Monad (when)+import Data.IORef (readIORef)+import Data.Text.Internal.IO (hGetLineWith, readChunk)+import Data.Text.Internal.Lazy (chunk, empty)+import GHC.IO.Buffer (isEmptyBuffer)+import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)+import GHC.IO.Handle.Internals (augmentIOError, hClose_help,+                                wantReadableHandle, withHandle)+import GHC.IO.Handle.Types (Handle__(..), HandleType(..))+import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)+import System.IO.Error (isEOFError)+import System.IO.Unsafe (unsafeInterleaveIO)++-- $performance+--+-- The functions in this module obey the runtime system's locale,+-- character set encoding, and line ending conversion settings.+--+-- If you know in advance that you will be working with data that has+-- a specific encoding (e.g. UTF-8), and your application is highly+-- performance sensitive, you may find that it is faster to perform+-- I\/O with bytestrings and to encode and decode yourself than to use+-- the functions in this module.+--+-- Whether this will hold depends on the version of GHC you are using,+-- the platform you are working on, the data you are working with, and+-- the encodings you are using, so be sure to test for yourself.++-- | Read a file and return its contents as a string.  The file is+-- read lazily, as with 'getContents'.+readFile :: FilePath -> IO Text+readFile name = openFile name ReadMode >>= hGetContents++-- | Write a string to a file.  The file is truncated to zero length+-- before writing begins.+writeFile :: FilePath -> Text -> IO ()+writeFile p = withFile p WriteMode . flip hPutStr++-- | Write a string the end of a file.+appendFile :: FilePath -> Text -> IO ()+appendFile p = withFile p AppendMode . flip hPutStr++-- | Lazily read the remaining contents of a 'Handle'.  The 'Handle'+-- will be closed after the read completes, or on error.+hGetContents :: Handle -> IO Text+hGetContents h = do+  chooseGoodBuffering h+  wantReadableHandle "hGetContents" h $ \hh -> do+    ts <- lazyRead h+    return (hh{haType=SemiClosedHandle}, ts)++-- | Use a more efficient buffer size if we're reading in+-- block-buffered mode with the default buffer size.+chooseGoodBuffering :: Handle -> IO ()+chooseGoodBuffering h = do+  bufMode <- hGetBuffering h+  when (bufMode == BlockBuffering Nothing) $+    hSetBuffering h (BlockBuffering (Just 16384))++lazyRead :: Handle -> IO Text+lazyRead h = unsafeInterleaveIO $+  withHandle "hGetContents" h $ \hh -> do+    case haType hh of+      ClosedHandle     -> return (hh, L.empty)+      SemiClosedHandle -> lazyReadBuffered h hh+      _                -> ioException+                          (IOError (Just h) IllegalOperation "hGetContents"+                           "illegal handle type" Nothing Nothing)++lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, Text)+lazyReadBuffered h hh@Handle__{..} = do+   buf <- readIORef haCharBuffer+   (do t <- readChunk hh buf+       ts <- lazyRead h+       return (hh, chunk t ts)) `E.catch` \e -> do+         (hh', _) <- hClose_help hh+         if isEOFError e+           then return $ if isEmptyBuffer buf+                         then (hh', empty)+                         else (hh', L.singleton '\r')+           else E.throwIO (augmentIOError e "hGetContents" h)++-- | Read a single line from a handle.+hGetLine :: Handle -> IO Text+hGetLine = hGetLineWith L.fromChunks++-- | Write a string to a handle.+hPutStr :: Handle -> Text -> IO ()+hPutStr h = mapM_ (T.hPutStr h) . L.toChunks++-- | Write a string to a handle, followed by a newline.+hPutStrLn :: Handle -> Text -> IO ()+hPutStrLn h t = hPutStr h t >> hPutChar h '\n'++-- | The 'interact' function takes a function of type @Text -> Text@+-- as its argument. The entire input from the standard input device is+-- passed (lazily) to this function as its argument, and the resulting+-- string is output on the standard output device.+interact :: (Text -> Text) -> IO ()+interact f = putStr . f =<< getContents++-- | Lazily read all user input on 'stdin' as a single string.+getContents :: IO Text+getContents = hGetContents stdin++-- | Read a single line of user input from 'stdin'.+getLine :: IO Text+getLine = hGetLine stdin++-- | Write a string to 'stdout'.+putStr :: Text -> IO ()+putStr = hPutStr stdout++-- | Write a string to 'stdout', followed by a newline.+putStrLn :: Text -> IO ()+putStrLn = hPutStrLn stdout++-- $locale+--+-- /Note/: The behaviour of functions in this module depends on the+-- version of GHC you are using.+--+-- Beginning with GHC 6.12, text I\/O is performed using the system or+-- handle's current locale and line ending conventions.+--+-- Under GHC 6.10 and earlier, the system I\/O libraries /do not+-- support/ locale-sensitive I\/O or line ending conversion.  On these+-- versions of GHC, functions in this library all use UTF-8.  What+-- does this mean in practice?+--+-- * All data that is read will be decoded as UTF-8.+--+-- * Before data is written, it is first encoded as UTF-8.+--+-- * On both reading and writing, the platform's native newline+--   conversion is performed.+--+-- If you must use a non-UTF-8 locale on an older version of GHC, you+-- will have to perform the transcoding yourself, e.g. as follows:+--+-- > import qualified Data.ByteString.Lazy as B+-- > import Data.Text.Lazy (Text)+-- > import Data.Text.Lazy.Encoding (encodeUtf16)+-- >+-- > putStr_Utf16LE :: Text -> IO ()+-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
+ src/Data/Text/Lazy/Internal.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}+-- |+-- Module      : Data.Text.Lazy.Internal+-- Copyright   : (c) 2013 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- This module has been renamed to 'Data.Text.Internal.Lazy'. This+-- name for the module will be removed in the next major release.++module Data.Text.Lazy.Internal+    {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}+    (+      module Data.Text.Internal.Lazy+    ) where++import Data.Text.Internal.Lazy
+ src/Data/Text/Lazy/Read.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE OverloadedStrings, CPP #-}+#if __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#elif __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif++-- |+-- Module      : Data.Text.Lazy.Read+-- Copyright   : (c) 2010, 2011 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : GHC+--+-- Functions used frequently when reading textual data.+module Data.Text.Lazy.Read+    (+      Reader+    , decimal+    , hexadecimal+    , signed+    , rational+    , double+    ) where++import Control.Monad (liftM)+import Data.Char (isDigit, isHexDigit)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Ratio ((%))+import Data.Text.Internal.Read+import Data.Text.Lazy as T+import Data.Word (Word, Word8, Word16, Word32, Word64)++-- | Read some text.  If the read succeeds, return its value and the+-- remaining text, otherwise an error message.+type Reader a = IReader Text a+type Parser = IParser Text++-- | Read a decimal integer.  The input must begin with at least one+-- decimal digit, and is consumed until a non-digit or end of string+-- is reached.+--+-- This function does not handle leading sign characters.  If you need+-- to handle signed input, use @'signed' 'decimal'@.+--+-- /Note/: For fixed-width integer types, this function does not+-- attempt to detect overflow, so a sufficiently long input may give+-- incorrect results.  If you are worried about overflow, use+-- 'Integer' for your result type.+decimal :: Integral a => Reader a+{-# SPECIALIZE decimal :: Reader Int #-}+{-# SPECIALIZE decimal :: Reader Int8 #-}+{-# SPECIALIZE decimal :: Reader Int16 #-}+{-# SPECIALIZE decimal :: Reader Int32 #-}+{-# SPECIALIZE decimal :: Reader Int64 #-}+{-# SPECIALIZE decimal :: Reader Integer #-}+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}+{-# SPECIALIZE decimal :: Reader Word8 #-}+{-# SPECIALIZE decimal :: Reader Word16 #-}+{-# SPECIALIZE decimal :: Reader Word32 #-}+{-# SPECIALIZE decimal :: Reader Word64 #-}+decimal txt+    | T.null h  = Left "input does not start with a digit"+    | otherwise = Right (T.foldl' go 0 h, t)+  where (h,t)  = T.span isDigit txt+        go n d = (n * 10 + fromIntegral (digitToInt d))++-- | Read a hexadecimal integer, consisting of an optional leading+-- @\"0x\"@ followed by at least one hexadecimal digit. Input is+-- consumed until a non-hex-digit or end of string is reached.+-- This function is case insensitive.+--+-- This function does not handle leading sign characters.  If you need+-- to handle signed input, use @'signed' 'hexadecimal'@.+--+-- /Note/: For fixed-width integer types, this function does not+-- attempt to detect overflow, so a sufficiently long input may give+-- incorrect results.  If you are worried about overflow, use+-- 'Integer' for your result type.+hexadecimal :: Integral a => Reader a+{-# SPECIALIZE hexadecimal :: Reader Int #-}+{-# SPECIALIZE hexadecimal :: Reader Integer #-}+hexadecimal txt+    | h == "0x" || h == "0X" = hex t+    | otherwise              = hex txt+ where (h,t) = T.splitAt 2 txt++hex :: Integral a => Reader a+{-# SPECIALIZE hexadecimal :: Reader Int #-}+{-# SPECIALIZE hexadecimal :: Reader Int8 #-}+{-# SPECIALIZE hexadecimal :: Reader Int16 #-}+{-# SPECIALIZE hexadecimal :: Reader Int32 #-}+{-# SPECIALIZE hexadecimal :: Reader Int64 #-}+{-# SPECIALIZE hexadecimal :: Reader Integer #-}+{-# SPECIALIZE hexadecimal :: Reader Word #-}+{-# SPECIALIZE hexadecimal :: Reader Word8 #-}+{-# SPECIALIZE hexadecimal :: Reader Word16 #-}+{-# SPECIALIZE hexadecimal :: Reader Word32 #-}+{-# SPECIALIZE hexadecimal :: Reader Word64 #-}+hex txt+    | T.null h  = Left "input does not start with a hexadecimal digit"+    | otherwise = Right (T.foldl' go 0 h, t)+  where (h,t)  = T.span isHexDigit txt+        go n d = (n * 16 + fromIntegral (hexDigitToInt d))++-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and+-- apply it to the result of applying the given reader.+signed :: Num a => Reader a -> Reader a+{-# INLINE signed #-}+signed f = runP (signa (P f))++-- | Read a rational number.+--+-- This function accepts an optional leading sign character, followed+-- by at least one decimal digit.  The syntax similar to that accepted+-- by the 'read' function, with the exception that a trailing @\'.\'@+-- or @\'e\'@ /not/ followed by a number is not consumed.+--+-- Examples:+--+-- >rational "3"     == Right (3.0, "")+-- >rational "3.1"   == Right (3.1, "")+-- >rational "3e4"   == Right (30000.0, "")+-- >rational "3.1e4" == Right (31000.0, "")+-- >rational ".3"    == Left "input does not start with a digit"+-- >rational "e3"    == Left "input does not start with a digit"+--+-- Examples of differences from 'read':+--+-- >rational "3.foo" == Right (3.0, ".foo")+-- >rational "3e"    == Right (3.0, "e")+rational :: Fractional a => Reader a+{-# SPECIALIZE rational :: Reader Double #-}+rational = floaty $ \real frac fracDenom -> fromRational $+                     real % 1 + frac % fracDenom++-- | Read a rational number.+--+-- The syntax accepted by this function is the same as for 'rational'.+--+-- /Note/: This function is almost ten times faster than 'rational',+-- but is slightly less accurate.+--+-- The 'Double' type supports about 16 decimal places of accuracy.+-- For 94.2% of numbers, this function and 'rational' give identical+-- results, but for the remaining 5.8%, this function loses precision+-- around the 15th decimal place.  For 0.001% of numbers, this+-- function will lose precision at the 13th or 14th decimal place.+double :: Reader Double+double = floaty $ \real frac fracDenom ->+                   fromIntegral real ++                   fromIntegral frac / fromIntegral fracDenom++signa :: Num a => Parser a -> Parser a+{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}+{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}+{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}+{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}+{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}+{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}+signa p = do+  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')+  if sign == '+' then p else negate `liftM` p++char :: (Char -> Bool) -> Parser Char+char p = P $ \t -> case T.uncons t of+                     Just (c,t') | p c -> Right (c,t')+                     _                 -> Left "character does not match"++floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a+{-# INLINE floaty #-}+floaty f = runP $ do+  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')+  real <- P decimal+  T fraction fracDigits <- perhaps (T 0 0) $ do+    _ <- char (=='.')+    digits <- P $ \t -> Right (fromIntegral . T.length $ T.takeWhile isDigit t, t)+    n <- P decimal+    return $ T n digits+  let e c = c == 'e' || c == 'E'+  power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)+  let n = if fracDigits == 0+          then if power == 0+               then fromIntegral real+               else fromIntegral real * (10 ^^ power)+          else if power == 0+               then f real fraction (10 ^ fracDigits)+               else f real fraction (10 ^ fracDigits) * (10 ^^ power)+  return $! if sign == '+'+            then n+            else -n
+ src/Data/Text/Read.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE OverloadedStrings, UnboxedTuples, CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif++-- |+-- Module      : Data.Text.Read+-- Copyright   : (c) 2010, 2011 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : GHC+--+-- Functions used frequently when reading textual data.+module Data.Text.Read+    (+      Reader+    , decimal+    , hexadecimal+    , signed+    , rational+    , double+    ) where++import Control.Monad (liftM)+import Data.Char (isDigit, isHexDigit)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Ratio ((%))+import Data.Text as T+import Data.Text.Internal.Private (span_)+import Data.Text.Internal.Read+import Data.Word (Word, Word8, Word16, Word32, Word64)++-- | Read some text.  If the read succeeds, return its value and the+-- remaining text, otherwise an error message.+type Reader a = IReader Text a+type Parser a = IParser Text a++-- | Read a decimal integer.  The input must begin with at least one+-- decimal digit, and is consumed until a non-digit or end of string+-- is reached.+--+-- This function does not handle leading sign characters.  If you need+-- to handle signed input, use @'signed' 'decimal'@.+--+-- /Note/: For fixed-width integer types, this function does not+-- attempt to detect overflow, so a sufficiently long input may give+-- incorrect results.  If you are worried about overflow, use+-- 'Integer' for your result type.+decimal :: Integral a => Reader a+{-# SPECIALIZE decimal :: Reader Int #-}+{-# SPECIALIZE decimal :: Reader Int8 #-}+{-# SPECIALIZE decimal :: Reader Int16 #-}+{-# SPECIALIZE decimal :: Reader Int32 #-}+{-# SPECIALIZE decimal :: Reader Int64 #-}+{-# SPECIALIZE decimal :: Reader Integer #-}+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}+{-# SPECIALIZE decimal :: Reader Word8 #-}+{-# SPECIALIZE decimal :: Reader Word16 #-}+{-# SPECIALIZE decimal :: Reader Word32 #-}+{-# SPECIALIZE decimal :: Reader Word64 #-}+decimal txt+    | T.null h  = Left "input does not start with a digit"+    | otherwise = Right (T.foldl' go 0 h, t)+  where (# h,t #)  = span_ isDigit txt+        go n d = (n * 10 + fromIntegral (digitToInt d))++-- | Read a hexadecimal integer, consisting of an optional leading+-- @\"0x\"@ followed by at least one hexadecimal digit. Input is+-- consumed until a non-hex-digit or end of string is reached.+-- This function is case insensitive.+--+-- This function does not handle leading sign characters.  If you need+-- to handle signed input, use @'signed' 'hexadecimal'@.+--+-- /Note/: For fixed-width integer types, this function does not+-- attempt to detect overflow, so a sufficiently long input may give+-- incorrect results.  If you are worried about overflow, use+-- 'Integer' for your result type.+hexadecimal :: Integral a => Reader a+{-# SPECIALIZE hexadecimal :: Reader Int #-}+{-# SPECIALIZE hexadecimal :: Reader Int8 #-}+{-# SPECIALIZE hexadecimal :: Reader Int16 #-}+{-# SPECIALIZE hexadecimal :: Reader Int32 #-}+{-# SPECIALIZE hexadecimal :: Reader Int64 #-}+{-# SPECIALIZE hexadecimal :: Reader Integer #-}+{-# SPECIALIZE hexadecimal :: Reader Word #-}+{-# SPECIALIZE hexadecimal :: Reader Word8 #-}+{-# SPECIALIZE hexadecimal :: Reader Word16 #-}+{-# SPECIALIZE hexadecimal :: Reader Word32 #-}+{-# SPECIALIZE hexadecimal :: Reader Word64 #-}+hexadecimal txt+    | h == "0x" || h == "0X" = hex t+    | otherwise              = hex txt+ where (h,t) = T.splitAt 2 txt++hex :: Integral a => Reader a+{-# SPECIALIZE hex :: Reader Int #-}+{-# SPECIALIZE hex :: Reader Int8 #-}+{-# SPECIALIZE hex :: Reader Int16 #-}+{-# SPECIALIZE hex :: Reader Int32 #-}+{-# SPECIALIZE hex :: Reader Int64 #-}+{-# SPECIALIZE hex :: Reader Integer #-}+{-# SPECIALIZE hex :: Reader Word #-}+{-# SPECIALIZE hex :: Reader Word8 #-}+{-# SPECIALIZE hex :: Reader Word16 #-}+{-# SPECIALIZE hex :: Reader Word32 #-}+{-# SPECIALIZE hex :: Reader Word64 #-}+hex txt+    | T.null h  = Left "input does not start with a hexadecimal digit"+    | otherwise = Right (T.foldl' go 0 h, t)+  where (# h,t #)  = span_ isHexDigit txt+        go n d = (n * 16 + fromIntegral (hexDigitToInt d))++-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and+-- apply it to the result of applying the given reader.+signed :: Num a => Reader a -> Reader a+{-# INLINE signed #-}+signed f = runP (signa (P f))++-- | Read a rational number.+--+-- This function accepts an optional leading sign character, followed+-- by at least one decimal digit.  The syntax similar to that accepted+-- by the 'read' function, with the exception that a trailing @\'.\'@+-- or @\'e\'@ /not/ followed by a number is not consumed.+--+-- Examples (with behaviour identical to 'read'):+--+-- >rational "3"     == Right (3.0, "")+-- >rational "3.1"   == Right (3.1, "")+-- >rational "3e4"   == Right (30000.0, "")+-- >rational "3.1e4" == Right (31000.0, "")+-- >rational ".3"    == Left "input does not start with a digit"+-- >rational "e3"    == Left "input does not start with a digit"+--+-- Examples of differences from 'read':+--+-- >rational "3.foo" == Right (3.0, ".foo")+-- >rational "3e"    == Right (3.0, "e")+rational :: Fractional a => Reader a+{-# SPECIALIZE rational :: Reader Double #-}+rational = floaty $ \real frac fracDenom -> fromRational $+                     real % 1 + frac % fracDenom++-- | Read a rational number.+--+-- The syntax accepted by this function is the same as for 'rational'.+--+-- /Note/: This function is almost ten times faster than 'rational',+-- but is slightly less accurate.+--+-- The 'Double' type supports about 16 decimal places of accuracy.+-- For 94.2% of numbers, this function and 'rational' give identical+-- results, but for the remaining 5.8%, this function loses precision+-- around the 15th decimal place.  For 0.001% of numbers, this+-- function will lose precision at the 13th or 14th decimal place.+double :: Reader Double+double = floaty $ \real frac fracDenom ->+                   fromIntegral real ++                   fromIntegral frac / fromIntegral fracDenom++signa :: Num a => Parser a -> Parser a+{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}+{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}+{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}+{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}+{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}+{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}+signa p = do+  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')+  if sign == '+' then p else negate `liftM` p++char :: (Char -> Bool) -> Parser Char+char p = P $ \t -> case T.uncons t of+                     Just (c,t') | p c -> Right (c,t')+                     _                 -> Left "character does not match"++floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a+{-# INLINE floaty #-}+floaty f = runP $ do+  sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')+  real <- P decimal+  T fraction fracDigits <- perhaps (T 0 0) $ do+    _ <- char (=='.')+    digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)+    n <- P decimal+    return $ T n digits+  let e c = c == 'e' || c == 'E'+  power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)+  let n = if fracDigits == 0+          then if power == 0+               then fromIntegral real+               else fromIntegral real * (10 ^^ power)+          else if power == 0+               then f real fraction (10 ^ fracDigits)+               else f real fraction (10 ^ fracDigits) * (10 ^^ power)+  return $! if sign == '+'+            then n+            else -n
+ src/Data/Text/Show.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP, MagicHash #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif++-- |+-- Module      : Data.Text.Show+-- Copyright   : (c) 2009-2015 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC++module Data.Text.Show+    (+      singleton+    , unpack+    , unpackCString#+    ) where++import Control.Monad.ST (ST)+import Data.Text.Internal (Text(..), empty_, safe)+import Data.Text.Internal.Fusion (stream, unstream)+import Data.Text.Internal.Unsafe.Char (unsafeWrite)+import GHC.Prim (Addr#)+import qualified Data.Text.Array as A+import qualified Data.Text.Internal.Fusion.Common as S++#if __GLASGOW_HASKELL__ >= 702+import qualified GHC.CString as GHC+#else+import qualified GHC.Base as GHC+#endif++instance Show Text where+    showsPrec p ps r = showsPrec p (unpack ps) r++-- | /O(n)/ Convert a 'Text' into a 'String'.  Subject to fusion.+unpack :: Text -> String+unpack = S.unstreamList . stream+{-# INLINE [1] unpack #-}++-- | /O(n)/ Convert a literal string into a 'Text'.+--+-- This is exposed solely for people writing GHC rewrite rules.+--+-- @since 1.2.1.1+unpackCString# :: Addr# -> Text+unpackCString# addr# = unstream (S.streamCString# addr#)+{-# NOINLINE unpackCString# #-}++{-# RULES "TEXT literal" [1] forall a.+    unstream (S.map safe (S.streamList (GHC.unpackCString# a)))+      = unpackCString# a #-}++{-# RULES "TEXT literal UTF8" [1] forall a.+    unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))+      = unpackCString# a #-}++{-# RULES "TEXT empty literal" [1]+    unstream (S.map safe (S.streamList []))+      = empty_ #-}++{-# RULES "TEXT singleton literal" [1] forall a.+    unstream (S.map safe (S.streamList [a]))+      = singleton_ a #-}++-- | /O(1)/ Convert a character into a Text.  Subject to fusion.+-- Performs replacement on invalid scalar values.+singleton :: Char -> Text+singleton = unstream . S.singleton . safe+{-# INLINE [1] singleton #-}++{-# RULES "TEXT singleton" forall a.+    unstream (S.singleton (safe a))+      = singleton_ a #-}++-- This is intended to reduce inlining bloat.+singleton_ :: Char -> Text+singleton_ c = Text (A.run x) 0 len+  where x :: ST s (A.MArray s)+        x = do arr <- A.new len+               _ <- unsafeWrite arr 0 d+               return arr+        len | d < '\x10000' = 1+            | otherwise     = 2+        d = safe c+{-# NOINLINE singleton_ #-}
+ src/Data/Text/Unsafe.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}+-- |+-- Module      : Data.Text.Unsafe+-- Copyright   : (c) 2009, 2010, 2011 Bryan O'Sullivan+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Portability : portable+--+-- A module containing unsafe 'Text' operations, for very very careful+-- use in heavily tested code.+module Data.Text.Unsafe+    (+      inlineInterleaveST+    , inlinePerformIO+    , unsafeDupablePerformIO+    , Iter(..)+    , iter+    , iter_+    , reverseIter+    , reverseIter_+    , unsafeHead+    , unsafeTail+    , lengthWord16+    , takeWord16+    , dropWord16+    ) where++#if defined(ASSERTS)+import Control.Exception (assert)+#endif+import Data.Text.Internal.Encoding.Utf16 (chr2)+import Data.Text.Internal (Text(..))+import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)+import Data.Text.Internal.Unsafe.Char (unsafeChr)+import qualified Data.Text.Array as A+import GHC.IO (unsafeDupablePerformIO)++-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'+-- omits the check for the empty case, so there is an obligation on+-- the programmer to provide a proof that the 'Text' is non-empty.+unsafeHead :: Text -> Char+unsafeHead (Text arr off _len)+    | m < 0xD800 || m > 0xDBFF = unsafeChr m+    | otherwise                = chr2 m n+    where m = A.unsafeIndex arr off+          n = A.unsafeIndex arr (off+1)+{-# INLINE unsafeHead #-}++-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'+-- omits the check for the empty case, so there is an obligation on+-- the programmer to provide a proof that the 'Text' is non-empty.+unsafeTail :: Text -> Text+unsafeTail t@(Text arr off len) =+#if defined(ASSERTS)+    assert (d <= len) $+#endif+    Text arr (off+d) (len-d)+  where d = iter_ t 0+{-# INLINE unsafeTail #-}++data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int++-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16+-- array, returning the current character and the delta to add to give+-- the next offset to iterate at.+iter :: Text -> Int -> Iter+iter (Text arr off _len) i+    | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1+    | otherwise                = Iter (chr2 m n) 2+  where m = A.unsafeIndex arr j+        n = A.unsafeIndex arr k+        j = off + i+        k = j + 1+{-# INLINE iter #-}++-- | /O(1)/ Iterate one step through a UTF-16 array, returning the+-- delta to add to give the next offset to iterate at.+iter_ :: Text -> Int -> Int+iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1+                            | otherwise                = 2+  where m = A.unsafeIndex arr (off+i)+{-# INLINE iter_ #-}++-- | /O(1)/ Iterate one step backwards through a UTF-16 array,+-- returning the current character and the delta to add (i.e. a+-- negative number) to give the next offset to iterate at.+reverseIter :: Text -> Int -> (Char,Int)+reverseIter (Text arr off _len) i+    | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)+    | otherwise                = (chr2 n m,    -2)+  where m = A.unsafeIndex arr j+        n = A.unsafeIndex arr k+        j = off + i+        k = j - 1+{-# INLINE reverseIter #-}++-- | /O(1)/ Iterate one step backwards through a UTF-16 array,+-- returning the delta to add (i.e. a negative number) to give the+-- next offset to iterate at.+--+-- @since 1.1.1.0+reverseIter_ :: Text -> Int -> Int+reverseIter_ (Text arr off _len) i+    | m < 0xDC00 || m > 0xDFFF = -1+    | otherwise                = -2+  where m = A.unsafeIndex arr (off+i)+{-# INLINE reverseIter_ #-}++-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'.  This+-- is useful for sizing a target array appropriately before using+-- 'unsafeCopyToPtr'.+lengthWord16 :: Text -> Int+lengthWord16 (Text _arr _off len) = len+{-# INLINE lengthWord16 #-}++-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.+takeWord16 :: Int -> Text -> Text+takeWord16 k (Text arr off _len) = Text arr off k+{-# INLINE takeWord16 #-}++-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.+dropWord16 :: Int -> Text -> Text+dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)+{-# INLINE dropWord16 #-}
tests/Tests/Regressions.hs view
@@ -14,7 +14,9 @@ import Data.ByteString.Char8 () import qualified Data.ByteString.Lazy as LB import qualified Data.Text as T+import qualified Data.Text.Array as TA import qualified Data.Text.Encoding as TE+import qualified Data.Text.Internal as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LE@@ -95,6 +97,24 @@                 (T.length $ T.filter isLetter $ T.take (-3) "Hello! How are you doing today?")                 0 +-- See GitHub issue #301+-- This tests whether the "TEXT take . drop -> unfused" rule is applied to the+-- slice function. When the slice function is fused, a new array will be+-- constructed that is shorter than the original array. Without fusion the+-- array remains unmodified.+t301 :: IO ()+t301 = do+    assertEqual "The length of the array remains the same despite slicing"+                (TA.length originalArr)+                (TA.length newArr)++    assertEqual "The new array still contains the original value"+                (T.Text newArr originalOff originalLen)+                original+  where+    original@(T.Text originalArr originalOff originalLen) = T.pack "1234567890"+    T.Text newArr _off _len = T.take 1 $ T.drop 1 original+ tests :: F.Test tests = F.testGroup "Regressions"     [ F.testCase "hGetContents_crash" hGetContents_crash@@ -105,4 +125,5 @@     , F.testCase "t197" t197     , F.testCase "t221" t221     , F.testCase "t227" t227+    , F.testCase "t301" t301     ]
tests/text-tests.cabal view
@@ -1,33 +1,96 @@-name:          text-tests-version:       0.0.0.0-synopsis:      Functional tests for the text package-description:   Functional tests for the text package-homepage:      https://github.com/bos/text-license:       BSD2-license-file:  ../LICENSE-author:        Jasper Van der Jeugt <jaspervdj@gmail.com>,-               Bryan O'Sullivan <bos@serpentine.com>,-               Tom Harper <rtomharper@googlemail.com>,-               Duncan Coutts <duncan@haskell.org>-maintainer:    Bryan O'Sullivan <bos@serpentine.com>-category:      Text-build-type:    Simple+cabal-version:  >= 1.10+name:           text-tests+version:        1.2.4.1 -cabal-version: >=1.8+homepage:       https://github.com/haskell/text+bug-reports:    https://github.com/haskell/text/issues+synopsis:       An efficient packed Unicode text type.+description:+    .+    An efficient packed, immutable Unicode text type (both strict and+    lazy), with a powerful loop fusion optimization framework.+    .+    The 'Text' type represents Unicode character strings, in a time and+    space-efficient manner. This package provides text processing+    capabilities that are optimized for performance critical use, both+    in terms of large data quantities and high speed.+    .+    The 'Text' type provides character-encoding, type-safe case+    conversion via whole-string case conversion functions (see "Data.Text").+    It also provides a range of functions for converting 'Text' values to+    and from 'ByteStrings', using several standard encodings+    (see "Data.Text.Encoding").+    .+    Efficient locale-sensitive support for text IO is also supported+    (see "Data.Text.IO").+    .+    These modules are intended to be imported qualified, to avoid name+    clashes with Prelude functions, e.g.+    .+    > import qualified Data.Text as T+    .+    == ICU Support+    .+    To use an extended and very rich family of functions for working+    with Unicode text (including normalization, regular expressions,+    non-standard encodings, text breaking, and locales), see+    the [text-icu package](https://hackage.haskell.org/package/text-icu)+    based on the well-respected and liberally+    licensed [ICU library](http://site.icu-project.org/).+    .+    == Internal Representation: UTF-16 vs. UTF-8+    .+    Currently the @text@ library uses UTF-16 as its internal representation+    which is [neither a fixed-width nor always the most dense representation](http://utf8everywhere.org/)+    for Unicode text. We're currently investigating the feasibility+    of [changing Text's internal representation to UTF-8](https://github.com/text-utf8)+    and if you need such a 'Text' type right now you might be interested in using the spin-off+    packages <https://hackage.haskell.org/package/text-utf8 text-utf8> and+    <https://hackage.haskell.org/package/text-short text-short>. -flag hpc-  description: Enable HPC to generate coverage reports-  default:     False-  manual:      True +license:        BSD2+license-file:   LICENSE+author:         Bryan O'Sullivan <bos@serpentine.com>+maintainer:     Bryan O'Sullivan <bos@serpentine.com>, Herbert Valerio Riedel <hvr@gnu.org>+copyright:      2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper+category:       Data, Text+build-type:     Simple+tested-with:    GHC==8.10.2, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4,+                GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4,+                GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4+extra-source-files:+    include/*.h+ flag bytestring-builder-  description: Depend on the bytestring-builder package for backwards compatibility.+  description:+    Depend on the [bytestring-builder](https://hackage.haskell.org/package/bytestring-builder)+    package for backwards compatibility.   default: False   manual: False -executable text-tests-  main-is: Tests.hs+flag integer-simple+  description:+    Use the [simple integer library](http://hackage.haskell.org/package/integer-simple)+    instead of [integer-gmp](http://hackage.haskell.org/package/integer-gmp)+  default: False+  manual: False +test-suite tests+  type:           exitcode-stdio-1.0+  c-sources:      cbits/cbits.c+  include-dirs:   include+  hs-source-dirs: src++  ghc-options:+    -Wall -threaded -rtsopts++  cpp-options:+    -DASSERTS -DTEST_SUITE++  -- modules specific to test-suite+  hs-source-dirs: .+  main-is:        Tests.hs   other-modules:     Tests.Properties     Tests.Properties.Mul@@ -36,121 +99,103 @@     Tests.SlowFunctions     Tests.Utils -  ghc-options:-    -Wall -threaded -O0 -rtsopts--  if flag(hpc)-    ghc-options:-      -fhpc--  cpp-options:-    -DTEST_SUITE-    -DASSERTS--  build-depends:-    HUnit >= 1.2,-    QuickCheck >= 2.7,-    base == 4.*,-    deepseq,-    directory,-    quickcheck-unicode >= 1.0.1.0,-    random,-    test-framework >= 0.4,-    test-framework-hunit >= 0.2,-    test-framework-quickcheck2 >= 0.2,-    text-tests--  if flag(bytestring-builder)-    build-depends: bytestring         >= 0.9    && < 0.10.4,-                   bytestring-builder >= 0.10.4-  else-    build-depends: bytestring         >= 0.10.4--executable text-tests-stdio-  main-is:        Tests/IO.hs--  ghc-options:-    -Wall -threaded -rtsopts--  -- Optional HPC support-  if flag(hpc)-    ghc-options:-      -fhpc--  build-depends:-    text-tests,-    base >= 4 && < 5--library-  hs-source-dirs: ..-  c-sources: ../cbits/cbits.c-  include-dirs: ../include-  ghc-options: -Wall-  exposed-modules:+  -- This can be merged back to `text` package, when cabal+  -- will support per-component solving. Otherwise we have loops.+  --+  -- Same as in `library` stanza; this is needed by cabal for accurate+  -- file-monitoring as well as to avoid `-Wmissing-home-modules`+  -- warnings We can't use an inter-package library dependency because+  -- of different `ghc-options`/`cpp-options` (as a side-benefitt,+  -- this enables per-component build parallelism in `cabal+  -- new-build`!); We could, however, use cabal-version:2.2's `common`+  -- blocks at some point in the future to reduce the duplication.+  other-modules:     Data.Text     Data.Text.Array     Data.Text.Encoding     Data.Text.Encoding.Error+    Data.Text.Foreign+    Data.Text.IO+    Data.Text.Internal+    Data.Text.Internal.Builder+    Data.Text.Internal.Builder.Functions+    Data.Text.Internal.Builder.Int.Digits+    Data.Text.Internal.Builder.RealFloat.Functions+    Data.Text.Internal.ByteStringCompat     Data.Text.Internal.Encoding.Fusion     Data.Text.Internal.Encoding.Fusion.Common     Data.Text.Internal.Encoding.Utf16     Data.Text.Internal.Encoding.Utf32     Data.Text.Internal.Encoding.Utf8-    Data.Text.Foreign+    Data.Text.Internal.Functions     Data.Text.Internal.Fusion     Data.Text.Internal.Fusion.CaseMapping     Data.Text.Internal.Fusion.Common     Data.Text.Internal.Fusion.Size     Data.Text.Internal.Fusion.Types-    Data.Text.IO     Data.Text.Internal.IO-    Data.Text.Internal-    Data.Text.Lazy-    Data.Text.Lazy.Builder-    Data.Text.Internal.Builder.Functions-    Data.Text.Lazy.Builder.Int-    Data.Text.Internal.Builder.Int.Digits-    Data.Text.Internal.Builder-    Data.Text.Lazy.Builder.RealFloat-    Data.Text.Internal.Builder.RealFloat.Functions-    Data.Text.Lazy.Encoding+    Data.Text.Internal.Lazy     Data.Text.Internal.Lazy.Encoding.Fusion     Data.Text.Internal.Lazy.Fusion-    Data.Text.Lazy.IO-    Data.Text.Internal.Lazy-    Data.Text.Lazy.Read     Data.Text.Internal.Lazy.Search     Data.Text.Internal.Private-    Data.Text.Read-    Data.Text.Show     Data.Text.Internal.Read     Data.Text.Internal.Search-    Data.Text.Unsafe     Data.Text.Internal.Unsafe     Data.Text.Internal.Unsafe.Char     Data.Text.Internal.Unsafe.Shift-    Data.Text.Internal.Functions--  if flag(hpc)-    ghc-options:-      -fhpc--  cpp-options:-    -DTEST_SUITE-    -DASSERTS-    -DINTEGER_GMP+    Data.Text.Lazy+    Data.Text.Lazy.Builder+    Data.Text.Lazy.Builder.Int+    Data.Text.Lazy.Builder.RealFloat+    Data.Text.Lazy.Encoding+    Data.Text.Lazy.IO+    Data.Text.Lazy.Internal+    Data.Text.Lazy.Read+    Data.Text.Read+    Data.Text.Unsafe+    Data.Text.Show    build-depends:+    HUnit >= 1.2,+    QuickCheck >= 2.14.1 && < 2.15,     array,-    base == 4.*,+    base <5,     binary,     deepseq,+    directory,     ghc-prim,-    integer-gmp,-    template-haskell+    quickcheck-unicode >= 1.0.1.0,+    random,+    template-haskell,+    test-framework >= 0.4,+    test-framework-hunit >= 0.2,+    test-framework-quickcheck2 >= 0.2    if flag(bytestring-builder)     build-depends: bytestring         >= 0.9    && < 0.10.4,                    bytestring-builder >= 0.10.4   else     build-depends: bytestring         >= 0.10.4++  if impl(ghc >= 8.11)+    build-depends: ghc-bignum++  if impl(ghc < 8.11)+    if flag(integer-simple)+      cpp-options: -DINTEGER_SIMPLE+      build-depends: integer-simple >= 0.1 && < 0.5+    else+      cpp-options: -DINTEGER_GMP+      build-depends: integer-gmp >= 0.2++  default-language: Haskell2010+  default-extensions: NondecreasingIndentation++source-repository head+  type:     git+  location: https://github.com/haskell/text++source-repository head+  type:     mercurial+  location: https://bitbucket.org/bos/text
text.cabal view
@@ -1,6 +1,6 @@ cabal-version:  >= 1.10 name:           text-version:        1.2.4.0+version:        1.2.4.1  homepage:       https://github.com/haskell/text bug-reports:    https://github.com/haskell/text/issues@@ -56,7 +56,7 @@ copyright:      2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper category:       Data, Text build-type:     Simple-tested-with:    GHC==8.6.5, GHC==8.4.4,+tested-with:    GHC==8.10.2, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4,                 GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4,                 GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 extra-source-files:@@ -64,7 +64,7 @@     -- scripts/SpecialCasing.txt     README.markdown     benchmarks/Setup.hs-    benchmarks/cbits/*.c+    benchmarks/cbits-bench/*.c     benchmarks/haskell/*.hs     benchmarks/haskell/Benchmarks/*.hs     benchmarks/haskell/Benchmarks/Programs/*.hs@@ -106,6 +106,7 @@ library   c-sources:    cbits/cbits.c   include-dirs: include+  hs-source-dirs: src    exposed-modules:     Data.Text@@ -119,6 +120,7 @@     Data.Text.Internal.Builder.Functions     Data.Text.Internal.Builder.Int.Digits     Data.Text.Internal.Builder.RealFloat.Functions+    Data.Text.Internal.ByteStringCompat     Data.Text.Internal.Encoding.Fusion     Data.Text.Internal.Encoding.Fusion.Common     Data.Text.Internal.Encoding.Utf16@@ -157,17 +159,17 @@    build-depends:     array            >= 0.3 && < 0.6,-    base             >= 4.3 && < 5,+    base             >= 4.3 && < 4.16,     binary           >= 0.5 && < 0.9,     deepseq          >= 1.1 && < 1.5,-    ghc-prim         >= 0.2 && < 0.6,-    template-haskell >= 2.5 && < 2.16+    ghc-prim         >= 0.2 && < 0.8,+    template-haskell >= 2.5 && < 2.18    if flag(bytestring-builder)     build-depends: bytestring         >= 0.9    && < 0.10.4,                    bytestring-builder >= 0.10.4.0.2 && < 0.11   else-    build-depends: bytestring         >= 0.10.4 && < 0.11+    build-depends: bytestring         >= 0.10.4 && < 0.12    ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2   if flag(developer)@@ -175,12 +177,16 @@     ghc-options: -Werror     cpp-options: -DASSERTS -  if flag(integer-simple)-    cpp-options: -DINTEGER_SIMPLE-    build-depends: integer-simple >= 0.1 && < 0.5+  if impl(ghc >= 9.0)+    build-depends: ghc-bignum >= 1.0 && < 1.1+   else-    cpp-options: -DINTEGER_GMP-    build-depends: integer-gmp >= 0.2 && < 1.1+    if flag(integer-simple)+      cpp-options: -DINTEGER_SIMPLE+      build-depends: integer-simple >= 0.1 && < 0.5+    else+      cpp-options: -DINTEGER_GMP+      build-depends: integer-gmp >= 0.2 && < 1.1    -- compiler specification   default-language: Haskell2010@@ -211,114 +217,6 @@     other-extensions: TemplateHaskellQuotes   else     other-extensions: TemplateHaskell--test-suite tests-  type:           exitcode-stdio-1.0-  c-sources:      cbits/cbits.c-  include-dirs:   include--  ghc-options:-    -Wall -threaded -rtsopts--  cpp-options:-    -DASSERTS -DTEST_SUITE--  -- modules specific to test-suite-  hs-source-dirs: tests-  main-is:        Tests.hs-  other-modules:-    Tests.Properties-    Tests.Properties.Mul-    Tests.QuickCheckUtils-    Tests.Regressions-    Tests.SlowFunctions-    Tests.Utils--  -- Same as in `library` stanza; this is needed by cabal for accurate-  -- file-monitoring as well as to avoid `-Wmissing-home-modules`-  -- warnings We can't use an inter-package library dependency because-  -- of different `ghc-options`/`cpp-options` (as a side-benefitt,-  -- this enables per-component build parallelism in `cabal-  -- new-build`!); We could, however, use cabal-version:2.2's `common`-  -- blocks at some point in the future to reduce the duplication.-  hs-source-dirs: .-  other-modules:-    Data.Text-    Data.Text.Array-    Data.Text.Encoding-    Data.Text.Encoding.Error-    Data.Text.Foreign-    Data.Text.IO-    Data.Text.Internal-    Data.Text.Internal.Builder-    Data.Text.Internal.Builder.Functions-    Data.Text.Internal.Builder.Int.Digits-    Data.Text.Internal.Builder.RealFloat.Functions-    Data.Text.Internal.Encoding.Fusion-    Data.Text.Internal.Encoding.Fusion.Common-    Data.Text.Internal.Encoding.Utf16-    Data.Text.Internal.Encoding.Utf32-    Data.Text.Internal.Encoding.Utf8-    Data.Text.Internal.Functions-    Data.Text.Internal.Fusion-    Data.Text.Internal.Fusion.CaseMapping-    Data.Text.Internal.Fusion.Common-    Data.Text.Internal.Fusion.Size-    Data.Text.Internal.Fusion.Types-    Data.Text.Internal.IO-    Data.Text.Internal.Lazy-    Data.Text.Internal.Lazy.Encoding.Fusion-    Data.Text.Internal.Lazy.Fusion-    Data.Text.Internal.Lazy.Search-    Data.Text.Internal.Private-    Data.Text.Internal.Read-    Data.Text.Internal.Search-    Data.Text.Internal.Unsafe-    Data.Text.Internal.Unsafe.Char-    Data.Text.Internal.Unsafe.Shift-    Data.Text.Lazy-    Data.Text.Lazy.Builder-    Data.Text.Lazy.Builder.Int-    Data.Text.Lazy.Builder.RealFloat-    Data.Text.Lazy.Encoding-    Data.Text.Lazy.IO-    Data.Text.Lazy.Internal-    Data.Text.Lazy.Read-    Data.Text.Read-    Data.Text.Unsafe-    Data.Text.Show--  build-depends:-    HUnit >= 1.2,-    QuickCheck >= 2.7 && < 2.11,-    array,-    base,-    binary,-    deepseq,-    directory,-    ghc-prim,-    quickcheck-unicode >= 1.0.1.0,-    random,-    template-haskell,-    test-framework >= 0.4,-    test-framework-hunit >= 0.2,-    test-framework-quickcheck2 >= 0.2--  if flag(bytestring-builder)-    build-depends: bytestring         >= 0.9    && < 0.10.4,-                   bytestring-builder >= 0.10.4-  else-    build-depends: bytestring         >= 0.10.4--  if flag(integer-simple)-    cpp-options: -DINTEGER_SIMPLE-    build-depends: integer-simple >= 0.1 && < 0.5-  else-    cpp-options: -DINTEGER_GMP-    build-depends: integer-gmp >= 0.2--  default-language: Haskell2010-  default-extensions: NondecreasingIndentation  source-repository head   type:     git