Commits

Bryan O'Sullivan  committed 0c65b90

Add lazy justification.

  • Participants
  • Parent commits 8ce987e

Comments (0)

Files changed (4)

File Data/Text.hs

 
 {-# RULES
 "TEXT justifyLeft -> fused" [~1] forall k c t.
-    justifyLeft k c t = unstream (S.justifyLeft k c (stream t))
+    justifyLeft k c t = unstream (S.justifyLeftI k c (stream t))
 "TEXT justifyLeft -> unfused" [1] forall k c t.
-    unstream (S.justifyLeft k c (stream t)) = justifyLeft 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
 -- | /O(n)/ 'replicate' @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.replicate n c)
+replicate n c = unstream (S.replicateI n c)
 {-# INLINE replicate #-}
 
 -- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'

File Data/Text/Fusion/Common.hs

     , toUpper
 
     -- ** Justification
-    , justifyLeft
+    , justifyLeftI
 
     -- * Folds
     , foldl
     -- , mapAccumL
 
     -- ** Generation and unfolding
-    , replicate
+    , replicateI
     , unfoldr
     , unfoldrNI
 
 toLower = caseConvert lowerMapping
 {-# INLINE [0] toLower #-}
 
-justifyLeft :: Int -> Char -> Stream Char -> Stream Char
-justifyLeft k c (Stream next0 s0 len) = Stream next (s0 :!: S1 :!: 0) newLen
+justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
+justifyLeftI k c (Stream next0 s0 len) = Stream next (s0 :!: S1 :!: 0) newLen
   where
-    newLen | k > len   = k
+    j = fromIntegral k
+    newLen | j > len   = j
            | otherwise = len
     next (s :!: S1 :!: n) =
         case next0 s of
         | n < k       = Yield c (s :!: S2 :!: n+1)
         | otherwise   = Done
     {-# INLINE next #-}
-{-# INLINE justifyLeft #-}
+{-# INLINE [0] justifyLeftI #-}
 
 -- ----------------------------------------------------------------------------
 -- * Reducing Streams (folds)
 -- -----------------------------------------------------------------------------
 -- ** Generating and unfolding streams
 
-replicate :: Int -> Char -> Stream Char
-replicate n c
+replicateI :: Integral a => a -> Char -> Stream Char
+replicateI n c
     | n < 0     = empty
-    | otherwise = Stream next 0 n -- HINT maybe too low
+    | 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] replicate #-}
+{-# 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

File Data/Text/Lazy.hs

     , toLower
     , toUpper
 
+    -- ** Justification
+    , justifyLeft
+    , justifyRight
+    , center
+
     -- * Folds
     , foldl
     , foldl'
 import Prelude (Char, Bool(..), Int, Maybe(..), String,
                 Eq(..), Ord(..), Read(..), Show(..),
                 (&&), (+), (-), (.), ($), (++),
-                flip, fromIntegral, not, otherwise)
+                div, flip, fromIntegral, not, otherwise)
 import qualified Prelude as P
 import Data.Int (Int64)
 import qualified Data.List as L
 intersperse c t = unstream (S.intersperse 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. 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` replicate (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. Examples:
+--
+-- > justifyRight 7 'x' "bar"    == "xxxxbar"
+-- > justifyRight 3 'x' "foobar" == "foobar"
+justifyRight :: Int64 -> Char -> Text -> Text
+justifyRight k c t
+    | len >= k  = t
+    | otherwise = replicate (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. Examples:
+--
+-- > center 8 'x' "HS" = "xxxHSxxx"
+center :: Int64 -> Char -> Text -> Text
+center k c t
+    | len >= k  = t
+    | otherwise = replicate l c `append` t `append` replicate r c
+  where len = length t
+        d   = k - len
+        r   = d `div` 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
 
 -- | /O(n)/ 'replicate' @n@ @c@ is a 'Text' of length @n@ with @c@ the
 -- value of every element.
-replicate :: Int -> Char -> Text
-replicate n c = unstream (S.replicate n c)
+replicate :: Int64 -> Char -> Text
+replicate n c = unstream (S.replicateI n c)
 {-# INLINE replicate #-}
 
 -- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'

File tests/Properties.hs

 t_toUpper_upper t = p (T.toUpper t) >= p t
     where p = T.length . T.filter isUpper
 
-justifyLeft k c s = s ++ replicate (k - length s) c
+justifyLeft k c s  = s ++ replicate (k - length s) c
+justifyRight m n s = replicate (m - length s) n ++ s
 
-s_justifyLeft k c = justifyLeft k c `eqP` (unpackS . S.justifyLeft k c)
+s_justifyLeft k c = justifyLeft k c `eqP` (unpackS . S.justifyLeftI k c)
 sf_justifyLeft p k c =
-    (justifyLeft k c . L.filter p) `eqP` (unpackS . S.justifyLeft k c . S.filter p)
+    (justifyLeft k c . L.filter p) `eqP` (unpackS . S.justifyLeftI k c . S.filter p)
 t_justifyLeft k c = justifyLeft k c `eqP` (unpackS . T.justifyLeft k c)
-t_justifyRight k c = jr k c `eqP` (unpackS . T.justifyRight k c)
-    where jr m n s = replicate (m - length s) n ++ s
+tl_justifyLeft k c = justifyLeft k c `eqP` (unpackS . TL.justifyLeft (fromIntegral k) c)
+t_justifyRight k c = justifyRight k c `eqP` (unpackS . T.justifyRight k c)
+tl_justifyRight k c = justifyRight k c `eqP` (unpackS . TL.justifyRight (fromIntegral k) c)
 
 sf_foldl p f z     = (L.foldl f z . L.filter p)  `eqP` (S.foldl f z . S.filter p)
     where _types  = f :: Char -> Char -> Char
     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 n)
+tl_replicate n    = L.replicate n `eq` (unpackS . TL.replicate (fromIntegral n))
 
 unf :: Int -> Char -> Maybe (Char, Char)
 unf n c | fromEnum c * 100 > n = Nothing
       testProperty "s_justifyLeft" s_justifyLeft,
       testProperty "sf_justifyLeft" sf_justifyLeft,
       testProperty "t_justifyLeft" t_justifyLeft,
-      testProperty "t_justifyRight" t_justifyRight
+      testProperty "tl_justifyLeft" tl_justifyLeft,
+      testProperty "t_justifyRight" t_justifyRight,
+      testProperty "tl_justifyRight" tl_justifyRight
     ]
   ],