72f51cc · text · git.iko.soy

git.iko.soy/text

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

--HG-- extra : convert_revision : dc8d2300f158edc2befd0a51c8235457b008ffbb

commit72f51ccbf864f281b441e8e2915b4406f65aef2e authorBryan O'Sullivan <bos@serpentine.com> dateWed 8 Jul 2009, 04:48 (17 years ago) parent0809f18

3 files changed+81−2

compare with master

unifiedsplit

Data/Text.hs+53−2 Data/Text/Fusion/Common.hs+19 tests/Properties.hs+9

Data/Text.hs+53−2

@@ -56,12 +56,17 @@ module Data.Text

5656 , reverse

5757 , replace

5858

59− -- * Case conversion

59+ -- ** Case conversion

6060 -- $case

6161 , toCaseFold

6262 , toLower

6363 , toUpper

6464

65+ -- ** Justification

66+ , justifyLeft

67+ , justifyRight

68+ , center

69+

6570 -- * Folds

6671 , foldl

6772 , foldl'

@@ -163,7 +168,7 @@ import Prelude (Char, Bool(..), Functor(..), Int, Maybe(..), String,

163168 Eq(..), Ord(..), (++),

164169 Read(..), Show(..),

165170 (&&), (||), (+), (-), (.), ($),

166− not, return, otherwise)

171+ div, not, return, otherwise)

167172import Control.Exception (assert)

168173import Data.Char (isSpace)

169174import Control.Monad.ST (ST)

@@ -452,6 +457,52 @@ toUpper :: Text -> Text

452457toUpper t = unstream (S.toUpper (stream t))

453458{-# INLINE toUpper #-}

454459

460+-- | /O(n)/ Left-justify a string to the given length, using the

461+-- specified fill character on the right. This function is subject to

462+-- array fusion. Examples:

463+--

464+-- > justifyLeft 7 'x' "foo" == "fooxxxx"

465+-- > justifyLeft 3 'x' "foobar" == "foobar"

466+justifyLeft :: Int -> Char -> Text -> Text

467+justifyLeft k c t

468+ | len >= k = t

469+ | otherwise = t `append` replicate (k-len) c

470+ where len = length t

471+{-# INLINE [1] justifyLeft #-}

472+

473+{-# RULES

474+"TEXT justifyLeft -> fused" [~1] forall k c t.

475+ justifyLeft k c t = unstream (S.justifyLeft k c (stream t))

476+"TEXT justifyLeft -> unfused" [1] forall k c t.

477+ unstream (S.justifyLeft k c (stream t)) = justifyLeft k c t

478+ #-}

479+

480+-- | /O(n)/ Right-justify a string to the given length, using the

481+-- specified fill character on the left. Examples:

482+--

483+-- > justifyRight 7 'x' "bar" == "xxxxbar"

484+-- > justifyRight 3 'x' "foobar" == "foobar"

485+justifyRight :: Int -> Char -> Text -> Text

486+justifyRight k c t

487+ | len >= k = t

488+ | otherwise = replicate (k-len) c `append` t

489+ where len = length t

490+{-# INLINE justifyRight #-}

491+

492+-- | /O(n)/ Center a string to the given length, using the

493+-- specified fill character on either side. Examples:

494+--

495+-- > center 8 'x' "HS" = "xxxHSxxx"

496+center :: Int -> Char -> Text -> Text

497+center k c t

498+ | len >= k = t

499+ | otherwise = replicate l c `append` t `append` replicate r c

500+ where len = length t

501+ d = k - len

502+ r = d `div` 2

503+ l = d - r

504+{-# INLINE center #-}

505+

455506-- | /O(n)/ The 'transpose' function transposes the rows and columns

456507-- of its 'Text' argument. Note that this function uses 'pack',

457508-- 'unpack', and the list version of transpose, and is thus not very

Data/Text/Fusion/Common.hs+19

@@ -41,6 +41,9 @@ module Data.Text.Fusion.Common

4141 , toLower

4242 , toUpper

4343

44+ -- ** Justification

45+ , justifyLeft

46+

4447 -- * Folds

4548 , foldl

4649 , foldl'

@@ -358,6 +361,22 @@ toLower :: Stream Char -> Stream Char

358361toLower = caseConvert lowerMapping

359362{-# INLINE [0] toLower #-}

360363

364+justifyLeft :: Int -> Char -> Stream Char -> Stream Char

365+justifyLeft k c (Stream next0 s0 len) = Stream next (s0 :!: S1 :!: 0) newLen

366+ where

367+ newLen | k > len = k

368+ | otherwise = len

369+ next (s :!: S1 :!: n) =

370+ case next0 s of

371+ Done -> next (s :!: S2 :!: n)

372+ Skip s' -> Skip (s' :!: S1 :!: n)

373+ Yield x s' -> Yield x (s' :!: S1 :!: n+1)

374+ next (s :!: S2 :!: n)

375+ | n < k = Yield c (s :!: S2 :!: n+1)

376+ | otherwise = Done

377+ {-# INLINE next #-}

378+{-# INLINE justifyLeft #-}

379+

361380-- ----------------------------------------------------------------------------

362381-- * Reducing Streams (folds)

363382

tests/Properties.hs+9

@@ -192,6 +192,12 @@ prop_T_toLower_lower t = p (T.toLower t) >= p t

192192prop_T_toUpper_length t = T.length (T.toUpper t) >= T.length t

193193prop_T_toUpper_upper t = p (T.toUpper t) >= p t

194194 where p = T.length . T.filter isUpper

195+

196+prop_T_justifyLeft k c = jl k c `eqP` (unpackS . T.justifyLeft k c)

197+ where jl k c s = s ++ replicate (k - length s) c

198+prop_T_justifyRight k c = jr k c `eqP` (unpackS . T.justifyRight k c)

199+ where jr k c s = replicate (k - length s) c ++ s

200+

195201prop_T_foldl f z = L.foldl f z `eqP` (T.foldl f z)

196202 where types = f :: Char -> Char -> Char

197203prop_TL_foldl f z = L.foldl f z `eqP` (TL.foldl f z)

@@ -473,6 +479,9 @@ tests = [

473479 ("prop_T_toUpper_length", mytest prop_T_toUpper_length),

474480 ("prop_T_toUpper_upper", mytest prop_T_toUpper_upper),

475481

482+ ("prop_T_justifyLeft", mytest prop_T_justifyLeft),

483+ ("prop_T_justifyRight", mytest prop_T_justifyRight),

484+

476485 ("prop_T_foldl", mytest prop_T_foldl),

477486 ("prop_TL_foldl", mytest prop_TL_foldl),

478487 ("prop_T_foldl'", mytest prop_T_foldl'),