diff --git a/src/Data/Text/Lazy/Manipulate.hs b/src/Data/Text/Lazy/Manipulate.hs --- a/src/Data/Text/Lazy/Manipulate.hs +++ b/src/Data/Text/Lazy/Manipulate.hs @@ -47,6 +47,10 @@ , indentLines , prependLines + -- * Ellipsis + , toEllipsis + , toEllipsisWith + -- * Acronyms , toAcronym @@ -67,16 +71,17 @@ , isWordBoundary ) where -import qualified Data.Char as Char -import Data.List (intersperse) +import qualified Data.Char as Char +import Data.Int +import Data.List (intersperse) import Data.Monoid import Data.Text.Buildable -import Data.Text.Manipulate.Fusion (lazy) -import qualified Data.Text.Manipulate.Fusion as Fusion -import Data.Text.Manipulate.Types -import Data.Text.Lazy (Text) -import qualified Data.Text.Lazy as LText -import Data.Text.Lazy.Builder (toLazyText) +import Data.Text.Lazy (Text) +import qualified Data.Text.Lazy as LText +import Data.Text.Lazy.Builder (toLazyText) +import Data.Text.Manipulate.Internal.Fusion (lazy) +import qualified Data.Text.Manipulate.Internal.Fusion as Fusion +import Data.Text.Manipulate.Internal.Types -- $strict -- This library provides functions for manipulating both strict and lazy Text types. @@ -124,6 +129,23 @@ -- | Prepend newlines with the given separator prependLines :: Text -> Text -> Text prependLines sep = mappend sep . LText.unlines . intersperse sep . LText.lines + +-- | O(n) Truncate text to a specific length. +-- If the text was truncated the ellipsis sign "..." will be appended. +-- +-- /See:/ 'toEllipsisWith' +toEllipsis :: Int64 -> Text -> Text +toEllipsis n = toEllipsisWith n "..." + +-- | O(n) Truncate text to a specific length. +-- If the text was truncated the given ellipsis sign will be appended. +toEllipsisWith :: Int64 -- ^ Length. + -> Text -- ^ Ellipsis. + -> Text + -> Text +toEllipsisWith n suf x + | LText.length x > n = LText.take n x <> suf + | otherwise = x -- | O(n) Returns the first word, or the original text if no word -- boundary is encountered. /Subject to fusion./ diff --git a/src/Data/Text/Manipulate.hs b/src/Data/Text/Manipulate.hs --- a/src/Data/Text/Manipulate.hs +++ b/src/Data/Text/Manipulate.hs @@ -47,6 +47,10 @@ , indentLines , prependLines + -- * Ellipsis + , toEllipsis + , toEllipsisWith + -- * Acronyms , toAcronym @@ -67,16 +71,16 @@ , isWordBoundary ) where -import qualified Data.Char as Char -import Data.List (intersperse) +import qualified Data.Char as Char +import Data.List (intersperse) import Data.Monoid -import Data.Text (Text) -import qualified Data.Text as Text -import qualified Data.Text.Lazy as LText -import qualified Data.Text.Lazy.Manipulate as LMan -import Data.Text.Manipulate.Fusion (strict) -import qualified Data.Text.Manipulate.Fusion as Fusion -import Data.Text.Manipulate.Types +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Lazy as LText +import qualified Data.Text.Lazy.Manipulate as LMan +import Data.Text.Manipulate.Internal.Fusion (strict) +import qualified Data.Text.Manipulate.Internal.Fusion as Fusion +import Data.Text.Manipulate.Internal.Types -- $strict -- This library provides functions for manipulating both strict and lazy Text types. @@ -86,7 +90,7 @@ -- $unicode -- While this library supports Unicode in a similar fashion to the -- underlying library, --- more Unicode specific handling of word boundaries can be found in the +-- more explicit Unicode handling of word boundaries can be found in the -- library. -- $fusion @@ -126,12 +130,31 @@ Nothing -> x -- | Indent newlines by the given number of spaces. +-- +-- /See:/ 'prependLines' indentLines :: Int -> Text -> Text indentLines n = prependLines (Text.replicate n " ") -- | Prepend newlines with the given separator prependLines :: Text -> Text -> Text prependLines sep = mappend sep . Text.unlines . intersperse sep . Text.lines + +-- | O(n) Truncate text to a specific length. +-- If the text was truncated the ellipsis sign "..." will be appended. +-- +-- /See:/ 'toEllipsisWith' +toEllipsis :: Int -> Text -> Text +toEllipsis n = toEllipsisWith n "..." + +-- | O(n) Truncate text to a specific length. +-- If the text was truncated the given ellipsis sign will be appended. +toEllipsisWith :: Int -- ^ Length. + -> Text -- ^ Ellipsis. + -> Text + -> Text +toEllipsisWith n suf x + | Text.length x > n = Text.take n x <> suf + | otherwise = x -- | O(n) Returns the first word, or the original text if no word -- boundary is encountered. /Subject to fusion./ diff --git a/src/Data/Text/Manipulate/Fusion.hs b/src/Data/Text/Manipulate/Fusion.hs deleted file mode 100644 --- a/src/Data/Text/Manipulate/Fusion.hs +++ /dev/null @@ -1,177 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE RankNTypes #-} - --- Module : Data.Text.Manipulate.Fusion --- Copyright : (c) 2014 Brendan Hay --- License : This Source Code Form is subject to the terms of --- the Mozilla Public License, v. 2.0. --- A copy of the MPL can be found in the LICENSE file or --- you can obtain it at http://mozilla.org/MPL/2.0/. --- Maintainer : Brendan Hay --- Stability : experimental --- Portability : non-portable (GHC extensions) - -module Data.Text.Manipulate.Fusion where - -import qualified Data.Char as Char -import Data.Text (Text) -import qualified Data.Text.Internal.Fusion as Fusion -import Data.Text.Internal.Fusion.CaseMapping (upperMapping, lowerMapping) -import Data.Text.Internal.Fusion.Common -import Data.Text.Internal.Fusion.Types -import qualified Data.Text.Internal.Lazy.Fusion as LFusion -import qualified Data.Text.Lazy as LText -import Data.Text.Manipulate.Types - -takeWord :: Stream Char -> Stream Char -takeWord = transform (const Done) yield . tokenise -{-# INLINE [0] takeWord #-} - -dropWord :: Stream Char -> Stream Char -dropWord (tokenise -> Stream next0 s0 len) = Stream next (True :*: s0) len - where - next (skip :*: s) = - case next0 s of - Done -> Done - Skip s' -> Skip (skip :*: s') - Yield t s' -> - case t of - B '\0' -> Skip (False :*: s') - B _ | skip -> Skip (False :*: s') - B c -> Yield c (False :*: s') - _ | skip -> Skip (skip :*: s') - U c -> Yield c (skip :*: s') - L c -> Yield c (skip :*: s') -{-# INLINE [0] dropWord #-} - -toTitle :: Stream Char -> Stream Char -toTitle = mapHead toUpper . transformWith (yield ' ') upper lower . tokenise -{-# INLINE [0] toTitle #-} - -toCamel :: Stream Char -> Stream Char -toCamel = mapHead toLower . transformWith skip' upper lower . tokenise -{-# INLINE [0] toCamel #-} - -toPascal :: Stream Char -> Stream Char -toPascal = mapHead toUpper . transformWith skip' upper lower . tokenise -{-# INLINE [0] toPascal #-} - -toSnake :: Stream Char -> Stream Char -toSnake = transform (yield '_') lower . tokenise -{-# INLINE [0] toSnake #-} - -toSpinal :: Stream Char -> Stream Char -toSpinal = transform (yield '-') lower . tokenise -{-# INLINE [0] toSpinal #-} - -toTrain :: Stream Char -> Stream Char -toTrain = mapHead toUpper . transformWith (yield '-') upper lower . tokenise -{-# INLINE [0] toTrain #-} - -strict :: (Stream Char -> Stream Char) -> Text -> Text -strict f t = Fusion.unstream (f (Fusion.stream t)) -{-# INLINE [0] strict #-} - -lazy :: (Stream Char -> Stream Char) -> LText.Text -> LText.Text -lazy f t = LFusion.unstream (f (LFusion.stream t)) -{-# INLINE [0] lazy #-} - -skip' :: forall s. s -> Step (CC s) Char -skip' s = Skip (CC s '\0' '\0') - -yield, upper, lower :: forall s. Char -> s -> Step (CC s) Char -yield !c s = Yield c (CC s '\0' '\0') -upper !c s = upperMapping c s -lower !c s = lowerMapping c s - --- | Step across word boundaries using a custom action, and transform --- both subsequent uppercase and lowercase characters uniformly. --- --- /See:/ 'transformWith' -transform :: (forall s. s -> Step (CC s) Char) -- ^ Boundary action. - -> (forall s. Char -> s -> Step (CC s) Char) -- ^ Character mapping. - -> Stream Token -- ^ Input stream. - -> Stream Char -transform s m = transformWith s m m -{-# INLINE [0] transform #-} - --- | Step across word boundaries using a custom action, and transform --- subsequent characters after the word boundary is encountered with a mapping --- depending on case. -transformWith :: (forall s. s -> Step (CC s) Char) -- ^ Boundary action. - -> (forall s. Char -> s -> Step (CC s) Char) -- ^ Boundary mapping. - -> (forall s. Char -> s -> Step (CC s) Char) -- ^ Subsequent character mapping. - -> Stream Token -- ^ Input stream. - -> Stream Char -transformWith md mu mc (Stream next0 s0 len) = - -- HINT: len incorrect when the boundary replacement yields a char. - Stream next (CC (False :*: False :*: s0) '\0' '\0') len - where - next (CC (up :*: prev :*: s) '\0' _) = - case next0 s of - Done -> Done - Skip s' -> Skip (CC (up :*: prev :*: s') '\0' '\0') - Yield t s' -> - case t of - B _ -> md (False :*: True :*: s') - U c | prev -> mu c (True :*: False :*: s') - L c | prev -> mu c (False :*: False :*: s') - U c | up -> mu c (True :*: False :*: s') - U c -> mc c (True :*: False :*: s') - L c -> mc c (False :*: False :*: s') - - next (CC s a b) = Yield a (CC s b '\0') -{-# INLINE [0] transformWith #-} - --- | A token representing characters and boundaries in a stream. -data Token - = B {-# UNPACK #-} !Char -- ^ Word boundary. - | U {-# UNPACK #-} !Char -- ^ Upper case character. - | L {-# UNPACK #-} !Char -- ^ Lower case character. - deriving (Show) - --- | Tokenise a character stream using the default 'isBoundary' predicate. --- --- /See:/ 'tokeniseWith' -tokenise :: Stream Char -- ^ Input stream. - -> Stream Token -tokenise = tokeniseWith isBoundary -{-# INLINE [0] tokenise #-} - --- | Tokenise a character stream using a custom boundary predicate. -tokeniseWith :: (Char -> Bool) -- ^ Boundary predicate. - -> Stream Char -- ^ Input stream. - -> Stream Token -tokeniseWith f (Stream next0 s0 len) = - -- HINT: len incorrect if there are adjacent boundaries, which are skipped. - Stream next (CC (True :*: False :*: False :*: s0) '\0' '\0') len - where - next (CC (start :*: up :*: prev :*: s) '\0' _) = - case next0 s of - Done -> Done - Skip s' -> Skip (CC (start :*: up :*: prev :*: s') '\0' '\0') - Yield c s' - | not b, start -> push - | up -> push - | b, prev -> Skip (step start) - | otherwise -> push - where - push | b = Yield (B c) (step False) - | u, skip = Yield (U c) (step False) - | u = Yield (B '\0') (CC (False :*: u :*: b :*: s') c '\0') - | otherwise = Yield (L c) (step False) - - step p = CC (p :*: u :*: b :*: s') '\0' '\0' - - skip = up || start || prev - - b = f c - u = Char.isUpper c - - next (CC s a b) = Yield (U a) (CC s b '\0') -{-# INLINE [0] tokeniseWith #-} - -mapHead :: (Stream Char -> Stream Char) -> Stream Char -> Stream Char -mapHead f s = maybe s (\(x, s') -> f (singleton x) `append` s') (uncons s) -{-# INLINE [0] mapHead #-} diff --git a/src/Data/Text/Manipulate/Internal/Fusion.hs b/src/Data/Text/Manipulate/Internal/Fusion.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Manipulate/Internal/Fusion.hs @@ -0,0 +1,177 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RankNTypes #-} + +-- Module : Data.Text.Manipulate.Internal.Fusion +-- Copyright : (c) 2014 Brendan Hay +-- License : This Source Code Form is subject to the terms of +-- the Mozilla Public License, v. 2.0. +-- A copy of the MPL can be found in the LICENSE file or +-- you can obtain it at http://mozilla.org/MPL/2.0/. +-- Maintainer : Brendan Hay +-- Stability : experimental +-- Portability : non-portable (GHC extensions) + +module Data.Text.Manipulate.Internal.Fusion where + +import qualified Data.Char as Char +import Data.Text (Text) +import qualified Data.Text.Internal.Fusion as Fusion +import Data.Text.Internal.Fusion.CaseMapping (upperMapping, lowerMapping) +import Data.Text.Internal.Fusion.Common +import Data.Text.Internal.Fusion.Types +import qualified Data.Text.Internal.Lazy.Fusion as LFusion +import qualified Data.Text.Lazy as LText +import Data.Text.Manipulate.Internal.Types + +takeWord :: Stream Char -> Stream Char +takeWord = transform (const Done) yield . tokenise +{-# INLINE [0] takeWord #-} + +dropWord :: Stream Char -> Stream Char +dropWord (tokenise -> Stream next0 s0 len) = Stream next (True :*: s0) len + where + next (skip :*: s) = + case next0 s of + Done -> Done + Skip s' -> Skip (skip :*: s') + Yield t s' -> + case t of + B '\0' -> Skip (False :*: s') + B _ | skip -> Skip (False :*: s') + B c -> Yield c (False :*: s') + _ | skip -> Skip (skip :*: s') + U c -> Yield c (skip :*: s') + L c -> Yield c (skip :*: s') +{-# INLINE [0] dropWord #-} + +toTitle :: Stream Char -> Stream Char +toTitle = mapHead toUpper . transformWith (yield ' ') upper lower . tokenise +{-# INLINE [0] toTitle #-} + +toCamel :: Stream Char -> Stream Char +toCamel = mapHead toLower . transformWith skip' upper lower . tokenise +{-# INLINE [0] toCamel #-} + +toPascal :: Stream Char -> Stream Char +toPascal = mapHead toUpper . transformWith skip' upper lower . tokenise +{-# INLINE [0] toPascal #-} + +toSnake :: Stream Char -> Stream Char +toSnake = transform (yield '_') lower . tokenise +{-# INLINE [0] toSnake #-} + +toSpinal :: Stream Char -> Stream Char +toSpinal = transform (yield '-') lower . tokenise +{-# INLINE [0] toSpinal #-} + +toTrain :: Stream Char -> Stream Char +toTrain = mapHead toUpper . transformWith (yield '-') upper lower . tokenise +{-# INLINE [0] toTrain #-} + +strict :: (Stream Char -> Stream Char) -> Text -> Text +strict f t = Fusion.unstream (f (Fusion.stream t)) +{-# INLINE [0] strict #-} + +lazy :: (Stream Char -> Stream Char) -> LText.Text -> LText.Text +lazy f t = LFusion.unstream (f (LFusion.stream t)) +{-# INLINE [0] lazy #-} + +skip' :: forall s. s -> Step (CC s) Char +skip' s = Skip (CC s '\0' '\0') + +yield, upper, lower :: forall s. Char -> s -> Step (CC s) Char +yield !c s = Yield c (CC s '\0' '\0') +upper !c s = upperMapping c s +lower !c s = lowerMapping c s + +-- | Step across word boundaries using a custom action, and transform +-- both subsequent uppercase and lowercase characters uniformly. +-- +-- /See:/ 'transformWith' +transform :: (forall s. s -> Step (CC s) Char) -- ^ Boundary action. + -> (forall s. Char -> s -> Step (CC s) Char) -- ^ Character mapping. + -> Stream Token -- ^ Input stream. + -> Stream Char +transform s m = transformWith s m m +{-# INLINE [0] transform #-} + +-- | Step across word boundaries using a custom action, and transform +-- subsequent characters after the word boundary is encountered with a mapping +-- depending on case. +transformWith :: (forall s. s -> Step (CC s) Char) -- ^ Boundary action. + -> (forall s. Char -> s -> Step (CC s) Char) -- ^ Boundary mapping. + -> (forall s. Char -> s -> Step (CC s) Char) -- ^ Subsequent character mapping. + -> Stream Token -- ^ Input stream. + -> Stream Char +transformWith md mu mc (Stream next0 s0 len) = + -- HINT: len incorrect when the boundary replacement yields a char. + Stream next (CC (False :*: False :*: s0) '\0' '\0') len + where + next (CC (up :*: prev :*: s) '\0' _) = + case next0 s of + Done -> Done + Skip s' -> Skip (CC (up :*: prev :*: s') '\0' '\0') + Yield t s' -> + case t of + B _ -> md (False :*: True :*: s') + U c | prev -> mu c (True :*: False :*: s') + L c | prev -> mu c (False :*: False :*: s') + U c | up -> mu c (True :*: False :*: s') + U c -> mc c (True :*: False :*: s') + L c -> mc c (False :*: False :*: s') + + next (CC s a b) = Yield a (CC s b '\0') +{-# INLINE [0] transformWith #-} + +-- | A token representing characters and boundaries in a stream. +data Token + = B {-# UNPACK #-} !Char -- ^ Word boundary. + | U {-# UNPACK #-} !Char -- ^ Upper case character. + | L {-# UNPACK #-} !Char -- ^ Lower case character. + deriving (Show) + +-- | Tokenise a character stream using the default 'isBoundary' predicate. +-- +-- /See:/ 'tokeniseWith' +tokenise :: Stream Char -- ^ Input stream. + -> Stream Token +tokenise = tokeniseWith isBoundary +{-# INLINE [0] tokenise #-} + +-- | Tokenise a character stream using a custom boundary predicate. +tokeniseWith :: (Char -> Bool) -- ^ Boundary predicate. + -> Stream Char -- ^ Input stream. + -> Stream Token +tokeniseWith f (Stream next0 s0 len) = + -- HINT: len incorrect if there are adjacent boundaries, which are skipped. + Stream next (CC (True :*: False :*: False :*: s0) '\0' '\0') len + where + next (CC (start :*: up :*: prev :*: s) '\0' _) = + case next0 s of + Done -> Done + Skip s' -> Skip (CC (start :*: up :*: prev :*: s') '\0' '\0') + Yield c s' + | not b, start -> push + | up -> push + | b, prev -> Skip (step start) + | otherwise -> push + where + push | b = Yield (B c) (step False) + | u, skip = Yield (U c) (step False) + | u = Yield (B '\0') (CC (False :*: u :*: b :*: s') c '\0') + | otherwise = Yield (L c) (step False) + + step p = CC (p :*: u :*: b :*: s') '\0' '\0' + + skip = up || start || prev + + b = f c + u = Char.isUpper c + + next (CC s a b) = Yield (U a) (CC s b '\0') +{-# INLINE [0] tokeniseWith #-} + +mapHead :: (Stream Char -> Stream Char) -> Stream Char -> Stream Char +mapHead f s = maybe s (\(x, s') -> f (singleton x) `append` s') (uncons s) +{-# INLINE [0] mapHead #-} diff --git a/src/Data/Text/Manipulate/Internal/Types.hs b/src/Data/Text/Manipulate/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Manipulate/Internal/Types.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +-- Module : Data.Text.Manipulate.Internal.Types +-- Copyright : (c) 2014 Brendan Hay +-- License : This Source Code Form is subject to the terms of +-- the Mozilla Public License, v. 2.0. +-- A copy of the MPL can be found in the LICENSE file or +-- you can obtain it at http://mozilla.org/MPL/2.0/. +-- Maintainer : Brendan Hay +-- Stability : experimental +-- Portability : non-portable (GHC extensions) + +module Data.Text.Manipulate.Internal.Types where + +import Control.Monad +import qualified Data.Char as Char +import Data.Monoid +import Data.Text.Buildable + +newtype Ordinal a = Ordinal a + +instance Integral a => Buildable (Ordinal a) where + build (Ordinal (toInteger -> n)) = build n <> suf + where + suf | x `elem` [11..13] = "th" + | y == 1 = "st" + | y == 2 = "nd" + | y == 3 = "rd" + | otherwise = "th" + + (flip mod 100 -> x, flip mod 10 -> y) = join (,) (abs n) + +-- | Returns 'True' for any boundary or uppercase character. +isWordBoundary :: Char -> Bool +isWordBoundary c = Char.isUpper c || isBoundary c + +-- | Returns 'True' for any boundary character. +isBoundary :: Char -> Bool +isBoundary = not . Char.isAlphaNum diff --git a/src/Data/Text/Manipulate/Types.hs b/src/Data/Text/Manipulate/Types.hs deleted file mode 100644 --- a/src/Data/Text/Manipulate/Types.hs +++ /dev/null @@ -1,40 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} - --- Module : Data.Text.Manipulate.Types --- Copyright : (c) 2014 Brendan Hay --- License : This Source Code Form is subject to the terms of --- the Mozilla Public License, v. 2.0. --- A copy of the MPL can be found in the LICENSE file or --- you can obtain it at http://mozilla.org/MPL/2.0/. --- Maintainer : Brendan Hay --- Stability : experimental --- Portability : non-portable (GHC extensions) - -module Data.Text.Manipulate.Types where - -import Control.Monad -import qualified Data.Char as Char -import Data.Monoid -import Data.Text.Buildable - -newtype Ordinal a = Ordinal a - -instance Integral a => Buildable (Ordinal a) where - build (Ordinal (toInteger -> n)) = build n <> suf - where - suf | x `elem` [11..13] = "th" - | y == 1 = "st" - | y == 2 = "nd" - | y == 3 = "rd" - | otherwise = "th" - - (flip mod 100 -> x, flip mod 10 -> y) = join (,) (abs n) - --- | Returns 'True' for any boundary or uppercase character. -isWordBoundary :: Char -> Bool -isWordBoundary c = Char.isUpper c || isBoundary c - --- | Returns 'True' for any boundary character. -isBoundary :: Char -> Bool -isBoundary = not . Char.isAlphaNum diff --git a/text-manipulate.cabal b/text-manipulate.cabal --- a/text-manipulate.cabal +++ b/text-manipulate.cabal @@ -1,6 +1,6 @@ name: text-manipulate -version: 0.1.1 -synopsis: Case conversion, word boundary manipulation, and miscellanous textual subjugation. +version: 0.1.2 +synopsis: Case conversion, word boundary manipulation, and textual subjugation. homepage: https://github.com/brendanhay/text-manipulate license: OtherLicense license-file: LICENSE @@ -40,8 +40,8 @@ , Data.Text.Lazy.Manipulate other-modules: - Data.Text.Manipulate.Fusion - , Data.Text.Manipulate.Types + Data.Text.Manipulate.Internal.Fusion + , Data.Text.Manipulate.Internal.Types build-depends: base >= 4.5 && < 5.0