Bryan O'Sullivan avatar Bryan O'Sullivan committed 9ebd9d4

Improve the type of replicate. Get rid of the Compat module.

Comments (0)

Files changed (7)

 
     -- ** Generation and unfolding
     , replicate
+    , replicateChar
     , unfoldr
     , unfoldrN
 
                 Eq(..), Ord(..), (++),
                 Read(..), Show(..),
                 (&&), (||), (+), (-), (.), ($),
-                div, not, return, otherwise)
+                fromIntegral, div, not, return, otherwise)
 import Control.Exception (assert)
 import Data.Char (isSpace)
 import Control.Monad.ST (ST)
 justifyLeft :: Int -> Char -> Text -> Text
 justifyLeft k c t
     | len >= k  = t
-    | otherwise = t `append` replicate (k-len) c
+    | otherwise = t `append` replicateChar (k-len) c
   where len = length t
 {-# INLINE [1] justifyLeft #-}
 
 justifyRight :: Int -> Char -> Text -> Text
 justifyRight k c t
     | len >= k  = t
-    | otherwise = replicate (k-len) c `append` t
+    | otherwise = replicateChar (k-len) c `append` t
   where len = length t
 {-# INLINE justifyRight #-}
 
 center :: Int -> Char -> Text -> Text
 center k c t
     | len >= k  = t
-    | otherwise = replicate l c `append` t `append` replicate r c
+    | otherwise = replicateChar l c `append` t `append` replicateChar r c
   where len = length t
         d   = k - len
         r   = d `div` 2
 -- -----------------------------------------------------------------------------
 -- ** Generating and unfolding 'Text's
 
--- | /O(n)/ 'replicate' @n@ @c@ is a 'Text' of length @n@ with @c@ the
+-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
+-- @t@ repeated @n@ times. Subject to fusion.
+replicate :: Int -> Text -> Text
+replicate n t = unstream (S.replicateI (fromIntegral n) (S.stream t))
+{-# 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.
-replicate :: Int -> Char -> Text
-replicate n c = unstream (S.replicateI n c)
-{-# INLINE replicate #-}
+replicateChar :: Int -> Char -> Text
+replicateChar n c = unstream (S.replicateCharI 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

Data/Text/Compat.hs

-{-# LANGUAGE BangPatterns #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
--- |
--- Module      : Data.Text.Compat
--- Copyright   : (c) Bryan O'Sullivan 2009
---
--- License     : BSD-style
--- Maintainer  : bos@serpentine.com, rtharper@aftereternity.co.uk,
---               duncan@haskell.org
--- Stability   : experimental
--- Portability : GHC
---
--- A text API for which function names closely resemble those of the
--- list and 'ByteString' types.
---
--- This module is intended to be imported @qualified@, to avoid name
--- clashes with "Prelude" functions, e.g.
---
--- > import qualified Data.Text.Compat as T
-
-module Data.Text.Compat
-    (
-    -- * Types
-      Text
-
-    -- * Creation and elimination
-    , pack
-    , unpack
-    , singleton
-    , empty
-
-    -- * Basic interface
-    , cons
-    , snoc
-    , append
-    , uncons
-    , head
-    , last
-    , tail
-    , init
-    , null
-    , length
-
-    -- * Transformations
-    , map
-    , intercalate
-    , intersperse
-    , transpose
-    , reverse
-
-    -- * Case conversion
-    -- $case
-    , toCaseFold
-    , toLower
-    , toUpper
-
-    -- * 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
-    , drop
-    , takeWhile
-    , dropWhile
-    , splitAt
-    , span
-    , break
-    , group
-    , groupBy
-    , inits
-    , tails
-
-    -- ** Breaking into many substrings
-    , split
-    , splitWith
-    , breakSubstring
-
-    -- ** Breaking into lines and words
-    , lines
-    --, lines'
-    , words
-    , unlines
-    , unwords
-
-    -- * Predicates
-    , isPrefixOf
-    , isSuffixOf
-    , isInfixOf
-
-    -- * Searching
-    , elem
-    , filter
-    , find
-    , partition
-
-    -- , findSubstring
-    
-    -- * Indexing
-    , index
-    , findIndex
-    , findIndices
-    , elemIndex
-    , elemIndices
-    , count
-
-    -- * Zipping and unzipping
-    , zip
-    , zipWith
-
-    -- -* Ordered text
-    -- , sort
-    ) where
-
-import Data.ByteString (ByteString)
-import Data.Text hiding (split)
-import qualified Data.Text as T
-import Data.Text.Unsafe (unsafeTail)
-import Prelude (Char, (+), otherwise)
-
-split :: Char -> Text -> [Text]
-split c = T.split (singleton c)
-{-# INLINE split #-}
-
--- | /O(n)/ Break a string on a substring, returning a pair of the
--- part of the string prior to the match, and the rest of the string.
---
--- The following relationship holds:
---
--- > break (==c) l == breakSubstring (singleton c) l
---
--- For example, to tokenise a string, dropping delimiters:
---
--- > tokenise x y = h : if null t then [] else tokenise x (drop (length x) t)
--- >     where (h,t) = breakSubstring x y
---
--- To skip to the first occurence of a string:
---
--- > snd (breakSubstring x y)
---
--- To take the parts of a string before a delimiter:
---
--- > fst (breakSubstring x y)
---
-breakSubstring :: Text -- ^ String to search for
-               -> Text -- ^ String to search in
-               -> (Text,Text) -- ^ Head and tail of string broken at substring
-
-breakSubstring pat src = search 0 src
-  where
-    search !n !s
-        | null s             = (src,empty)      -- not found
-        | pat `isPrefixOf` s = (take n src,s)
-        | otherwise          = search (n+1) (unsafeTail s)
-{-# INLINE breakSubstring #-}

Data/Text/Fusion/Common.hs

     -- , mapAccumL
 
     -- ** Generation and unfolding
+    , replicateCharI
     , replicateI
     , unfoldr
     , unfoldrNI
                 fromIntegral, otherwise)
 import qualified Data.List as L
 import qualified Prelude as P
+import Data.Int (Int64)
 import Data.Text.Fusion.Internal
 import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)
 
 -- -----------------------------------------------------------------------------
 -- ** Generating and unfolding streams
 
-replicateI :: Integral a => a -> Char -> Stream Char
-replicateI n c
+replicateCharI :: Integral a => a -> Char -> Stream Char
+replicateCharI n c
     | n < 0     = empty
     | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
   where
     {-# INLINE next #-}
     next i | i >= n    = Done
            | otherwise = Yield c (i + 1)
+{-# INLINE [0] replicateCharI #-}
+
+replicateI :: Int64 -> Stream Char -> Stream Char
+replicateI n (Stream next0 s0 len) =
+    Stream next (0 :!: s0) (max 0 (fromIntegral n * len))
+  where
+    next (k :!: s)
+        | k >= n = Done
+        | otherwise = case next0 s of
+                        Done       -> Skip    (k+1 :!: s0)
+                        Skip s'    -> Skip    (k :!: s')
+                        Yield x s' -> Yield x (k :!: s')
 {-# INLINE [0] replicateI #-}
 
 -- | /O(n)/, where @n@ is the length of the result. The unfoldr function

Data/Text/Lazy.hs

 
     -- ** Generation and unfolding
     , replicate
+    , replicateChar
     , unfoldr
     , unfoldrN
 
 justifyLeft :: Int64 -> Char -> Text -> Text
 justifyLeft k c t
     | len >= k  = t
-    | otherwise = t `append` replicate (k-len) c
+    | otherwise = t `append` replicateChar (k-len) c
   where len = length t
 {-# INLINE [1] justifyLeft #-}
 
 justifyRight :: Int64 -> Char -> Text -> Text
 justifyRight k c t
     | len >= k  = t
-    | otherwise = replicate (k-len) c `append` t
+    | otherwise = replicateChar (k-len) c `append` t
   where len = length t
 {-# INLINE justifyRight #-}
 
 center :: Int64 -> Char -> Text -> Text
 center k c t
     | len >= k  = t
-    | otherwise = replicate l c `append` t `append` replicate r c
+    | otherwise = replicateChar l c `append` t `append` replicateChar r c
   where len = length t
         d   = k - len
         r   = d `div` 2
                         where (s'',y ) = f s' x
                               (s', ys) = mapAccumR f s xs
 
--- | /O(n)/ 'replicate' @n@ @c@ is a 'Text' of length @n@ with @c@ the
--- value of every element.
-replicate :: Int64 -> Char -> Text
-replicate n c = unstream (S.replicateI n c)
+-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
+-- @t@ repeated @n@ times. Subject to fusion.
+replicate :: Int64 -> Text -> Text
+replicate n t = unstream (S.replicateI (fromIntegral n) (S.stream t))
 {-# INLINE replicate #-}
 
+-- | /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 c)
+
+{-# RULES
+"LAZY TEXT replicate/singleton -> replicateChar" [~1] forall n c.
+    replicate n (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

Data/Text/UnsafeShift.hs

       UnsafeShift(..)
     ) where
 
-import qualified Data.Bits as Bits
+-- import qualified Data.Bits as Bits
 import GHC.Base
 import GHC.Word
 

tests/Properties.hs

 import Control.Arrow ((***), second)
 import Data.Word (Word8, Word16, Word32)
 import qualified Data.Text as T
-import qualified Data.Text.Compat as C
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Encoding as E
 import Control.Exception (SomeException, try)
 import qualified Data.Text.Lazy.Fusion as SL
 import qualified Data.Text.UnsafeShift as U
 import qualified Data.List as L
+import Prelude hiding (replicate)
 import System.IO.Unsafe (unsafePerformIO)
 import Test.Framework (defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck (testProperty)
 tl_toUpper_upper t = p (TL.toUpper t) >= p t
     where p = TL.length . TL.filter isUpper
 
-justifyLeft k c s  = s ++ replicate (k - length s) c
-justifyRight m n s = replicate (m - length s) n ++ s
+justifyLeft k c s  = s ++ L.replicate (k - length s) c
+justifyRight m n s = L.replicate (m - length s) n ++ s
 
 s_justifyLeft k c = justifyLeft k c `eqP` (unpackS . S.justifyLeftI k c)
 sf_justifyLeft p k c =
 tl_mapAccumR f z   = unsquare (L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z))
     where _types = f :: Int -> Char -> (Int,Char)
 
-t_replicate n     = L.replicate n `eq` (unpackS . T.replicate n)
-tl_replicate n    = L.replicate n `eq` (unpackS . TL.replicate (fromIntegral n))
+replicate n l = concat (L.replicate n l)
+
+t_replicate n     = replicate n `eq` (unpackS . T.replicate n . packS)
+tl_replicate n    = replicate n `eq` (unpackS . TL.replicate (fromIntegral n) . packS)
+t_replicateChar n = L.replicate n `eq` (unpackS . T.replicateChar n)
+tl_replicateChar n= L.replicate n `eq` (unpackS . TL.replicateChar (fromIntegral n))
 
 unf :: Int -> Char -> Maybe (Char, Char)
 unf n c | fromEnum c * 100 > n = Nothing
 t_splitWith p     = splitWith p `eqP` (map unpackS . T.splitWith p)
 t_splitWith_count c = (L.length . T.splitWith (==c)) `eq` ((1+) . T.count c)
 t_splitWith_split c = T.splitWith (==c) `eq` T.split (T.singleton c)
-t_splitWith_Csplit c = T.splitWith (==c) `eq` C.split c
 tl_splitWith p    = splitWith p `eqP` (map unpackS . TL.splitWith p)
 
 splitWith :: (a -> Bool) -> [a] -> [[a]]
 
 tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) . TL.chunksOf (fromIntegral k) . TL.fromChunks . (:[]))
 
-t_breakSubstring_isInfixOf s l
-                     = T.isInfixOf s l ==
-                       T.null s || (not . T.null . snd $ C.breakSubstring s l)
-t_breakSubstringC c
-                     = L.break (==c) `eqP`
-                       (unpack2 . C.breakSubstring (T.singleton c))
-
 t_lines           = L.lines       `eqP` (map unpackS . T.lines)
 tl_lines          = L.lines       `eqP` (map unpackS . TL.lines)
 {-
     testGroup "unfolds" [
       testProperty "t_replicate" t_replicate,
       testProperty "tl_replicate" tl_replicate,
+      testProperty "t_replicateChar" t_replicateChar,
+      testProperty "tl_replicateChar" tl_replicateChar,
       testProperty "t_unfoldr" t_unfoldr,
       testProperty "tl_unfoldr" tl_unfoldr,
       testProperty "t_unfoldrN" t_unfoldrN,
       testProperty "t_splitWith" t_splitWith,
       testProperty "t_splitWith_count" t_splitWith_count,
       testProperty "t_splitWith_split" t_splitWith_split,
-      testProperty "t_splitWith_Csplit" t_splitWith_Csplit,
       testProperty "tl_splitWith" tl_splitWith,
       testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,
       testProperty "t_chunksOf_length" t_chunksOf_length,
-      testProperty "tl_chunksOf" tl_chunksOf,
-      testProperty "t_breakSubstringC" t_breakSubstringC,
-      testProperty "t_breakSubstring_isInfixOf" t_breakSubstring_isInfixOf
+      testProperty "tl_chunksOf" tl_chunksOf
     ],
 
     testGroup "lines and words" [
 library
   exposed-modules:
     Data.Text
-    Data.Text.Compat
     Data.Text.Encoding
     Data.Text.Encoding.Error
     Data.Text.Foreign
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.