1. Bryan O'Sullivan
  2. text

Commits

Bryan O'Sullivan  committed 935c3e1

Add justifyLeft, justifyRight, and center functions, with tests (save for center).

  • Participants
  • Parent commits 8647e4c
  • Branches default

Comments (0)

Files changed (3)

File Data/Text.hs

View file
  • Ignore whitespace
     , reverse
     , replace
 
-    -- * Case conversion
+    -- ** Case conversion
     -- $case
     , toCaseFold
     , toLower
     , toUpper
 
+    -- ** Justification
+    , justifyLeft
+    , justifyRight
+    , center
+
     -- * Folds
     , foldl
     , foldl'
                 Eq(..), Ord(..), (++),
                 Read(..), Show(..),
                 (&&), (||), (+), (-), (.), ($),
-                not, return, otherwise)
+                div, not, return, otherwise)
 import Control.Exception (assert)
 import Data.Char (isSpace)
 import Control.Monad.ST (ST)
 toUpper t = unstream (S.toUpper (stream t))
 {-# INLINE toUpper #-}
 
+-- | /O(n)/ Left-justify a string to the given length, using the
+-- specified fill character on the right. This function is subject to
+-- array fusion. 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` 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.justifyLeft k c (stream t))
+"TEXT justifyLeft -> unfused" [1] forall k c t.
+    unstream (S.justifyLeft 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 :: Int -> 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 :: Int -> 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

File Data/Text/Fusion/Common.hs

View file
  • Ignore whitespace
     , toLower
     , toUpper
 
+    -- ** Justification
+    , justifyLeft
+
     -- * Folds
     , foldl
     , foldl'
 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
+  where
+    newLen | k > len   = k
+           | otherwise = len
+    next (s :!: S1 :!: n) =
+        case next0 s of
+          Done       -> next (s :!: S2 :!: n)
+          Skip s'    -> Skip (s' :!: S1 :!: n)
+          Yield x s' -> Yield x (s' :!: S1 :!: n+1)
+    next (s :!: S2 :!: n)
+        | n < k       = Yield c (s :!: S2 :!: n+1)
+        | otherwise   = Done
+    {-# INLINE next #-}
+{-# INLINE justifyLeft #-}
+
 -- ----------------------------------------------------------------------------
 -- * Reducing Streams (folds)
 

File tests/Properties.hs

View file
  • Ignore whitespace
 prop_T_toUpper_length t = T.length (T.toUpper t) >= T.length t
 prop_T_toUpper_upper t = p (T.toUpper t) >= p t
     where p = T.length . T.filter isUpper
+
+prop_T_justifyLeft k c = jl k c `eqP` (unpackS . T.justifyLeft k c)
+    where jl k c s = s ++ replicate (k - length s) c
+prop_T_justifyRight k c = jr k c `eqP` (unpackS . T.justifyRight k c)
+    where jr k c s = replicate (k - length s) c ++ s
+
 prop_T_foldl f z       = L.foldl f z  `eqP`  (T.foldl f z)
     where types        = f :: Char -> Char -> Char
 prop_TL_foldl f z      = L.foldl f z  `eqP`  (TL.foldl f z)
   ("prop_T_toUpper_length", mytest prop_T_toUpper_length),
   ("prop_T_toUpper_upper", mytest prop_T_toUpper_upper),
 
+  ("prop_T_justifyLeft", mytest prop_T_justifyLeft),
+  ("prop_T_justifyRight", mytest prop_T_justifyRight),
+
   ("prop_T_foldl", mytest prop_T_foldl),
   ("prop_TL_foldl", mytest prop_TL_foldl),
   ("prop_T_foldl'", mytest prop_T_foldl'),