diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,22 @@ # Text Manipulate +[![MPL2][license-badge]][license] +[![Build][build-badge]][build] +[![Hackage][hackage-badge]][hackage] +[![Nix][nix-badge]][nix] +[![Cachix][cachix-badge]][cachix] + +[license]: https://opensource.org/licenses/MPL-2.0 +[license-badge]: https://img.shields.io/badge/license-MPL%202.0-blue.svg +[build]: https://github.com/brendanhay/text-manipulate/actions +[build-badge]: https://github.com/brendanhay/text-manipulate/workflows/build/badge.svg +[hackage]: http://hackage.haskell.org/package/text-manipulate +[hackage-badge]: https://img.shields.io/hackage/v/text-manipulate.svg +[nix]: https://nixos.org +[nix-badge]: https://img.shields.io/badge/builtwith-nix-purple.svg +[cachix]: https://amazonka.cachix.org +[cachix-badge]: https://img.shields.io/badge/cachix-amazonka-purple.svg + Manipulate identifiers and structurally non-complex pieces of text by delimiting word boundaries via a combination of whitespace, control-characters, and case-sensitivity. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,3 +0,0 @@ -import Distribution.Simple - -main = defaultMain diff --git a/lib/Data/Text/Lazy/Manipulate.hs b/lib/Data/Text/Lazy/Manipulate.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Text/Lazy/Manipulate.hs @@ -0,0 +1,247 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +-- Module : Data.Text.Lazy.Manipulate +-- Copyright : (c) 2014-2020 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) + +-- | Manipulate identifiers and structurally non-complex pieces +-- of text by delimiting word boundaries via a combination of whitespace, +-- control-characters, and case-sensitivity. +-- +-- Assumptions have been made about word boundary characteristics inherint +-- in predominantely English text, please see individual function documentation +-- for further details and behaviour. +module Data.Text.Lazy.Manipulate + ( -- * Strict vs lazy types + -- $strict + + -- * Unicode + -- $unicode + + -- * Fusion + -- $fusion + + -- * Subwords + + -- ** Removing words + takeWord, + dropWord, + stripWord, + + -- ** Breaking on words + breakWord, + splitWords, + + -- * Character manipulation + lowerHead, + upperHead, + mapHead, + + -- * Line manipulation + indentLines, + prependLines, + + -- * Ellipsis + toEllipsis, + toEllipsisWith, + + -- * Acronyms + toAcronym, + + -- * Ordinals + toOrdinal, + + -- * Casing + toTitle, + toCamel, + toPascal, + toSnake, + toSpinal, + toTrain, + + -- * Boundary predicates + isBoundary, + isWordBoundary, + ) +where + +import qualified Data.Char as Char +import Data.Int +import Data.List (intersperse) +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. +-- The strict functions are provided by the "Data.Text.Manipulate" module, while the lazy +-- functions are provided by the "Data.Text.Lazy.Manipulate" module. + +-- $unicode +-- While this library supports Unicode in a similar fashion to the +-- underlying library, +-- more explicit Unicode specific handling of word boundaries can be found in the +-- library. + +-- $fusion +-- Many functions in this module are subject to fusion, meaning that +-- a pipeline of such functions will usually allocate at most one Text value. +-- +-- Functions that can be fused by the compiler are documented with the +-- phrase /Subject to fusion/. + +-- | Lowercase the first character of a piece of text. +-- +-- >>> lowerHead "Title Cased" +-- "title Cased" +lowerHead :: Text -> Text +lowerHead = mapHead Char.toLower + +-- | Uppercase the first character of a piece of text. +-- +-- >>> upperHead "snake_cased" +-- "Snake_cased" +upperHead :: Text -> Text +upperHead = mapHead Char.toUpper + +-- | Apply a function to the first character of a piece of text. +mapHead :: (Char -> Char) -> Text -> Text +mapHead f x = + case LText.uncons x of + Just (c, cs) -> LText.singleton (f c) <> cs + Nothing -> x + +-- | Indent newlines by the given number of spaces. +indentLines :: Int -> Text -> Text +indentLines n = prependLines (LText.replicate (fromIntegral n) " ") + +-- | 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 :: + -- | Length. + Int64 -> + -- | Ellipsis. + Text -> + 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./ +takeWord :: Text -> Text +takeWord = lazy Fusion.takeWord + +-- | O(n) Return the suffix after dropping the first word. If no word +-- boundary is encountered, the result will be empty. /Subject to fusion./ +dropWord :: Text -> Text +dropWord = lazy Fusion.dropWord + +-- | Break a piece of text after the first word boundary is encountered. +-- +-- >>> breakWord "PascalCasedVariable" +-- ("Pacal", "CasedVariable") +-- +-- >>> breakWord "spinal-cased-variable" +-- ("spinal", "cased-variable") +breakWord :: Text -> (Text, Text) +breakWord x = (takeWord x, dropWord x) + +-- | O(n) Return the suffix after removing the first word, or 'Nothing' +-- if no word boundary is encountered. +-- +-- >>> stripWord "HTML5Spaghetti" +-- Just "Spaghetti" +-- +-- >>> stripWord "noboundaries" +-- Nothing +stripWord :: Text -> Maybe Text +stripWord x + | LText.length y < LText.length x = Just y + | otherwise = Nothing + where + y = dropWord x + +-- | O(n) Split into a list of words delimited by boundaries. +-- +-- >>> splitWords "SupercaliFrag_ilistic" +-- ["Supercali","Frag","ilistic"] +splitWords :: Text -> [Text] +splitWords = go + where + go x = case breakWord x of + (h, t) + | LText.null h -> go t + | LText.null t -> [h] + | otherwise -> h : go t + +-- | O(n) Create an adhoc acronym from a piece of cased text. +-- +-- >>> toAcronym "AmazonWebServices" +-- Just "AWS" +-- +-- >>> toAcronym "Learn-You Some_Haskell" +-- Just "LYSH" +-- +-- >>> toAcronym "this_is_all_lowercase" +-- Nothing +toAcronym :: Text -> Maybe Text +toAcronym (LText.filter Char.isUpper -> x) + | LText.length x > 1 = Just x + | otherwise = Nothing + +-- | Render an ordinal used to denote the position in an ordered sequence. +-- +-- >>> toOrdinal (101 :: Int) +-- "101st" +-- +-- >>> toOrdinal (12 :: Int) +-- "12th" +toOrdinal :: Integral a => a -> Text +toOrdinal = toLazyText . ordinal + +-- | O(n) Convert casing to @Title Cased Phrase@. /Subject to fusion./ +toTitle :: Text -> Text +toTitle = lazy Fusion.toTitle + +-- | O(n) Convert casing to @camelCasedPhrase@. /Subject to fusion./ +toCamel :: Text -> Text +toCamel = lazy Fusion.toCamel + +-- | O(n) Convert casing to @PascalCasePhrase@. /Subject to fusion./ +toPascal :: Text -> Text +toPascal = lazy Fusion.toPascal + +-- | O(n) Convert casing to @snake_cased_phrase@. /Subject to fusion./ +toSnake :: Text -> Text +toSnake = lazy Fusion.toSnake + +-- | O(n) Convert casing to @spinal-cased-phrase@. /Subject to fusion./ +toSpinal :: Text -> Text +toSpinal = lazy Fusion.toSpinal + +-- | O(n) Convert casing to @Train-Cased-Phrase@. /Subject to fusion./ +toTrain :: Text -> Text +toTrain = lazy Fusion.toTrain diff --git a/lib/Data/Text/Manipulate.hs b/lib/Data/Text/Manipulate.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Text/Manipulate.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +-- Module : Data.Text.Manipulate +-- Copyright : (c) 2014-2020 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) + +-- | Manipulate identifiers and structurally non-complex pieces +-- of text by delimiting word boundaries via a combination of whitespace, +-- control-characters, and case-sensitivity. +-- +-- Assumptions have been made about word boundary characteristics inherint +-- in predominantely English text, please see individual function documentation +-- for further details and behaviour. +module Data.Text.Manipulate + ( -- * Strict vs lazy types + -- $strict + + -- * Unicode + -- $unicode + + -- * Fusion + -- $fusion + + -- * Subwords + + -- ** Removing words + takeWord, + dropWord, + stripWord, + + -- ** Breaking on words + breakWord, + splitWords, + + -- * Character manipulation + lowerHead, + upperHead, + mapHead, + + -- * Line manipulation + indentLines, + prependLines, + + -- * Ellipsis + toEllipsis, + toEllipsisWith, + + -- * Acronyms + toAcronym, + + -- * Ordinals + toOrdinal, + + -- * Casing + toTitle, + toCamel, + toPascal, + toSnake, + toSpinal, + toTrain, + + -- * Boundary predicates + isBoundary, + isWordBoundary, + ) +where + +import qualified Data.Char as Char +import Data.List (intersperse) +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. +-- The strict functions are provided by the "Data.Text.Manipulate" module, while the lazy +-- functions are provided by the "Data.Text.Lazy.Manipulate" module. + +-- $unicode +-- While this library supports Unicode in a similar fashion to the +-- underlying library, +-- more explicit Unicode handling of word boundaries can be found in the +-- library. + +-- $fusion +-- Many functions in this module are subject to fusion, meaning that +-- a pipeline of such functions will usually allocate at most one Text value. +-- +-- Functions that can be fused by the compiler are documented with the +-- phrase /Subject to fusion/. + +-- DEBUG: +-- import Data.Text.Internal.Fusion (stream) +-- import Data.Text.Internal.Fusion.Common (unstreamList) +-- tokens = unstreamList . Fusion.tokenise . stream + +-- FIXME: +-- dropWord "ALong" == "" + +-- | Lowercase the first character of a piece of text. +-- +-- >>> lowerHead "Title Cased" +-- "title Cased" +lowerHead :: Text -> Text +lowerHead = mapHead Char.toLower + +-- | Uppercase the first character of a piece of text. +-- +-- >>> upperHead "snake_cased" +-- "Snake_cased" +upperHead :: Text -> Text +upperHead = mapHead Char.toUpper + +-- | Apply a function to the first character of a piece of text. +mapHead :: (Char -> Char) -> Text -> Text +mapHead f x = + case Text.uncons x of + Just (c, cs) -> Text.singleton (f c) <> cs + 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 :: + -- | Length. + Int -> + -- | Ellipsis. + Text -> + 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./ +takeWord :: Text -> Text +takeWord = strict Fusion.takeWord + +-- | O(n) Return the suffix after dropping the first word. If no word +-- boundary is encountered, the result will be empty. /Subject to fusion./ +dropWord :: Text -> Text +dropWord = strict Fusion.dropWord + +-- | Break a piece of text after the first word boundary is encountered. +-- +-- >>> breakWord "PascalCasedVariable" +-- ("Pacal", "CasedVariable") +-- +-- >>> breakWord "spinal-cased-variable" +-- ("spinal", "cased-variable") +breakWord :: Text -> (Text, Text) +breakWord x = (takeWord x, dropWord x) + +-- | O(n) Return the suffix after removing the first word, or 'Nothing' +-- if no word boundary is encountered. +-- +-- >>> stripWord "HTML5Spaghetti" +-- Just "Spaghetti" +-- +-- >>> stripWord "noboundaries" +-- Nothing +stripWord :: Text -> Maybe Text +stripWord x + | Text.length y < Text.length x = Just y + | otherwise = Nothing + where + y = dropWord x + +-- | O(n) Split into a list of words delimited by boundaries. +-- +-- >>> splitWords "SupercaliFrag_ilistic" +-- ["Supercali","Frag","ilistic"] +splitWords :: Text -> [Text] +splitWords = go + where + go x = case breakWord x of + (h, t) + | Text.null h -> go t + | Text.null t -> [h] + | otherwise -> h : go t + +-- | O(n) Create an adhoc acronym from a piece of cased text. +-- +-- >>> toAcronym "AmazonWebServices" +-- Just "AWS" +-- +-- >>> toAcronym "Learn-You Some_Haskell" +-- Just "LYSH" +-- +-- >>> toAcronym "this_is_all_lowercase" +-- Nothing +toAcronym :: Text -> Maybe Text +toAcronym (Text.filter Char.isUpper -> x) + | Text.length x > 1 = Just x + | otherwise = Nothing + +-- | Render an ordinal used to denote the position in an ordered sequence. +-- +-- >>> toOrdinal (101 :: Int) +-- "101st" +-- +-- >>> toOrdinal (12 :: Int) +-- "12th" +toOrdinal :: Integral a => a -> Text +toOrdinal = LText.toStrict . LMan.toOrdinal + +-- | O(n) Convert casing to @Title Cased Phrase@. /Subject to fusion./ +toTitle :: Text -> Text +toTitle = strict Fusion.toTitle + +-- | O(n) Convert casing to @camelCasedPhrase@. /Subject to fusion./ +toCamel :: Text -> Text +toCamel = strict Fusion.toCamel + +-- | O(n) Convert casing to @PascalCasePhrase@. /Subject to fusion./ +toPascal :: Text -> Text +toPascal = strict Fusion.toPascal + +-- | O(n) Convert casing to @snake_cased_phrase@. /Subject to fusion./ +toSnake :: Text -> Text +toSnake = strict Fusion.toSnake + +-- | O(n) Convert casing to @spinal-cased-phrase@. /Subject to fusion./ +toSpinal :: Text -> Text +toSpinal = strict Fusion.toSpinal + +-- | O(n) Convert casing to @Train-Cased-Phrase@. /Subject to fusion./ +toTrain :: Text -> Text +toTrain = strict Fusion.toTrain diff --git a/lib/Data/Text/Manipulate/Internal/Fusion.hs b/lib/Data/Text/Manipulate/Internal/Fusion.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Text/Manipulate/Internal/Fusion.hs @@ -0,0 +1,270 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} + +-- Module : Data.Text.Manipulate.Internal.Fusion +-- Copyright : (c) 2014-2020 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 (lowerMapping, upperMapping) +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 + +#if MIN_VERSION_text(2,0,0) +import Data.Bits (shiftL, shiftR, (.&.)) +import GHC.Exts (Char(..), Int(..), chr#) +import GHC.Int (Int64(..)) +#endif + +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 +#if MIN_VERSION_text(2,0,0) +skip' s = Skip (CC s 0) +#else +skip' s = Skip (CC s '\0' '\0') +#endif + +yield, upper, lower :: forall s. Char -> s -> Step (CC s) Char +#if MIN_VERSION_text(2,0,0) + +yield !c s = Yield c (CC s 0) + +upper !c@(C# c#) s = case I64# (upperMapping c#) of + 0 -> Yield c (CC s 0) + ab -> let (a, b) = chopOffChar ab in + Yield a (CC s b) + +lower !c@(C# c#) s = case I64# (lowerMapping c#) of + 0 -> Yield c (CC s 0) + ab -> let (a, b) = chopOffChar ab in + Yield a (CC s b) + +chopOffChar :: Int64 -> (Char, Int64) +chopOffChar ab = (chr a, ab `shiftR` 21) + where + chr (I# n) = C# (chr# n) + mask = (1 `shiftL` 21) - 1 + a = fromIntegral $ ab .&. mask + +#else + +yield !c s = Yield c (CC s '\0' '\0') +upper !c s = upperMapping c s +lower !c s = lowerMapping c s + +#endif + +-- | Step across word boundaries using a custom action, and transform +-- both subsequent uppercase and lowercase characters uniformly. +-- +-- /See:/ 'transformWith' +transform :: + -- | Boundary action. + (forall s. s -> Step (CC s) Char) -> + -- | Character mapping. + (forall s. Char -> s -> Step (CC s) Char) -> + -- | Input stream. + Stream Token -> + 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 :: + -- | Boundary action. + (forall s. s -> Step (CC s) Char) -> + -- | Boundary mapping. + (forall s. Char -> s -> Step (CC s) Char) -> + -- | Subsequent character mapping. + (forall s. Char -> s -> Step (CC s) Char) -> + -- | Input stream. + Stream Token -> + Stream Char +transformWith md mu mc (Stream next0 s0 len) = + -- HINT: len incorrect when the boundary replacement yields a char. +#if MIN_VERSION_text(2,0,0) + Stream next (CC (False :*: False :*: s0) 0) len +#else + Stream next (CC (False :*: False :*: s0) '\0' '\0') len +#endif + where +#if MIN_VERSION_text(2,0,0) + next (CC (up :*: prev :*: s) 0) = +#else + next (CC (up :*: prev :*: s) '\0' _) = +#endif + case next0 s of + Done -> Done +#if MIN_VERSION_text(2,0,0) + Skip s' -> Skip (CC (up :*: prev :*: s') 0) +#else + Skip s' -> Skip (CC (up :*: prev :*: s') '\0' '\0') +#endif + 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') +#if MIN_VERSION_text(2,0,0) + next (CC s ab) = let (a, b) = chopOffChar ab in Yield a (CC s b) +#else + next (CC s a b) = Yield a (CC s b '\0') +#endif +{-# INLINE [0] transformWith #-} + +-- | A token representing characters and boundaries in a stream. +data Token + = -- | Word boundary. + B {-# UNPACK #-} !Char + | -- | Upper case character. + U {-# UNPACK #-} !Char + | -- | Lower case character. + L {-# UNPACK #-} !Char + deriving (Show) + +-- | Tokenise a character stream using the default 'isBoundary' predicate. +-- +-- /See:/ 'tokeniseWith' +tokenise :: + -- | Input stream. + Stream Char -> + Stream Token +tokenise = tokeniseWith isBoundary +{-# INLINE [0] tokenise #-} + +-- | Tokenise a character stream using a custom boundary predicate. +tokeniseWith :: + -- | Boundary predicate. + (Char -> Bool) -> + -- | Input stream. + Stream Char -> + Stream Token +tokeniseWith f (Stream next0 s0 len) = + -- HINT: len incorrect if there are adjacent boundaries, which are skipped. +#if MIN_VERSION_text(2,0,0) + Stream next (CC (True :*: False :*: False :*: s0) 0) len +#else + Stream next (CC (True :*: False :*: False :*: s0) '\0' '\0') len +#endif + where +#if MIN_VERSION_text(2,0,0) + next (CC (start :*: up :*: prev :*: s) 0) = +#else + next (CC (start :*: up :*: prev :*: s) '\0' _) = +#endif + case next0 s of + Done -> Done +#if MIN_VERSION_text(2,0,0) + Skip s' -> Skip (CC (start :*: up :*: prev :*: s') 0) +#else + Skip s' -> Skip (CC (start :*: up :*: prev :*: s') '\0' '\0') +#endif + 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) +#if MIN_VERSION_text(2,0,0) + | u = Yield (B '\0') (CC (False :*: u :*: b :*: s') (fromIntegral (Char.ord c))) +#else + | u = Yield (B '\0') (CC (False :*: u :*: b :*: s') c '\0') +#endif + | otherwise = Yield (L c) (step False) + +#if MIN_VERSION_text(2,0,0) + step p = CC (p :*: u :*: b :*: s') 0 +#else + step p = CC (p :*: u :*: b :*: s') '\0' '\0' +#endif + + skip = up || start || prev + + b = f c + u = Char.isUpper c +#if MIN_VERSION_text(2,0,0) + next (CC s ab) = let (a, b) = chopOffChar ab in Yield (U a) (CC s b) +#else + next (CC s a b) = Yield (U a) (CC s b '\0') +#endif +{-# 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/lib/Data/Text/Manipulate/Internal/Types.hs b/lib/Data/Text/Manipulate/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Text/Manipulate/Internal/Types.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} + +-- Module : Data.Text.Manipulate.Internal.Types +-- Copyright : (c) 2014-2020 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.Text.Lazy.Builder (Builder, singleton) +import GHC.Base + +-- | 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 + +ordinal :: Integral a => a -> Builder +ordinal (toInteger -> n) = decimal 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) +{-# NOINLINE [0] ordinal #-} + +decimal :: Integral a => a -> Builder +{-# SPECIALIZE decimal :: Int -> Builder #-} +decimal i + | i < 0 = singleton '-' <> go (- i) + | otherwise = go i + where + go n + | n < 10 = digit n + | otherwise = go (n `quot` 10) <> digit (n `rem` 10) +{-# NOINLINE [0] decimal #-} + +digit :: Integral a => a -> Builder +digit n = singleton $! i2d (fromIntegral n) +{-# INLINE digit #-} + +i2d :: Int -> Char +i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) +{-# INLINE i2d #-} diff --git a/src/Data/Text/Lazy/Manipulate.hs b/src/Data/Text/Lazy/Manipulate.hs deleted file mode 100644 --- a/src/Data/Text/Lazy/Manipulate.hs +++ /dev/null @@ -1,247 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} - --- Module : Data.Text.Lazy.Manipulate --- Copyright : (c) 2014-2020 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) - --- | Manipulate identifiers and structurally non-complex pieces --- of text by delimiting word boundaries via a combination of whitespace, --- control-characters, and case-sensitivity. --- --- Assumptions have been made about word boundary characteristics inherint --- in predominantely English text, please see individual function documentation --- for further details and behaviour. -module Data.Text.Lazy.Manipulate - ( -- * Strict vs lazy types - -- $strict - - -- * Unicode - -- $unicode - - -- * Fusion - -- $fusion - - -- * Subwords - - -- ** Removing words - takeWord, - dropWord, - stripWord, - - -- ** Breaking on words - breakWord, - splitWords, - - -- * Character manipulation - lowerHead, - upperHead, - mapHead, - - -- * Line manipulation - indentLines, - prependLines, - - -- * Ellipsis - toEllipsis, - toEllipsisWith, - - -- * Acronyms - toAcronym, - - -- * Ordinals - toOrdinal, - - -- * Casing - toTitle, - toCamel, - toPascal, - toSnake, - toSpinal, - toTrain, - - -- * Boundary predicates - isBoundary, - isWordBoundary, - ) -where - -import qualified Data.Char as Char -import Data.Int -import Data.List (intersperse) -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. --- The strict functions are provided by the "Data.Text.Manipulate" module, while the lazy --- functions are provided by the "Data.Text.Lazy.Manipulate" module. - --- $unicode --- While this library supports Unicode in a similar fashion to the --- underlying library, --- more explicit Unicode specific handling of word boundaries can be found in the --- library. - --- $fusion --- Many functions in this module are subject to fusion, meaning that --- a pipeline of such functions will usually allocate at most one Text value. --- --- Functions that can be fused by the compiler are documented with the --- phrase /Subject to fusion/. - --- | Lowercase the first character of a piece of text. --- --- >>> lowerHead "Title Cased" --- "title Cased" -lowerHead :: Text -> Text -lowerHead = mapHead Char.toLower - --- | Uppercase the first character of a piece of text. --- --- >>> upperHead "snake_cased" --- "Snake_cased" -upperHead :: Text -> Text -upperHead = mapHead Char.toUpper - --- | Apply a function to the first character of a piece of text. -mapHead :: (Char -> Char) -> Text -> Text -mapHead f x = - case LText.uncons x of - Just (c, cs) -> LText.singleton (f c) <> cs - Nothing -> x - --- | Indent newlines by the given number of spaces. -indentLines :: Int -> Text -> Text -indentLines n = prependLines (LText.replicate (fromIntegral n) " ") - --- | 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 :: - -- | Length. - Int64 -> - -- | Ellipsis. - Text -> - 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./ -takeWord :: Text -> Text -takeWord = lazy Fusion.takeWord - --- | O(n) Return the suffix after dropping the first word. If no word --- boundary is encountered, the result will be empty. /Subject to fusion./ -dropWord :: Text -> Text -dropWord = lazy Fusion.dropWord - --- | Break a piece of text after the first word boundary is encountered. --- --- >>> breakWord "PascalCasedVariable" --- ("Pacal", "CasedVariable") --- --- >>> breakWord "spinal-cased-variable" --- ("spinal", "cased-variable") -breakWord :: Text -> (Text, Text) -breakWord x = (takeWord x, dropWord x) - --- | O(n) Return the suffix after removing the first word, or 'Nothing' --- if no word boundary is encountered. --- --- >>> stripWord "HTML5Spaghetti" --- Just "Spaghetti" --- --- >>> stripWord "noboundaries" --- Nothing -stripWord :: Text -> Maybe Text -stripWord x - | LText.length y < LText.length x = Just y - | otherwise = Nothing - where - y = dropWord x - --- | O(n) Split into a list of words delimited by boundaries. --- --- >>> splitWords "SupercaliFrag_ilistic" --- ["Supercali","Frag","ilistic"] -splitWords :: Text -> [Text] -splitWords = go - where - go x = case breakWord x of - (h, t) - | LText.null h -> go t - | LText.null t -> [h] - | otherwise -> h : go t - --- | O(n) Create an adhoc acronym from a piece of cased text. --- --- >>> toAcronym "AmazonWebServices" --- Just "AWS" --- --- >>> toAcronym "Learn-You Some_Haskell" --- Just "LYSH" --- --- >>> toAcronym "this_is_all_lowercase" --- Nothing -toAcronym :: Text -> Maybe Text -toAcronym (LText.filter Char.isUpper -> x) - | LText.length x > 1 = Just x - | otherwise = Nothing - --- | Render an ordinal used to denote the position in an ordered sequence. --- --- >>> toOrdinal (101 :: Int) --- "101st" --- --- >>> toOrdinal (12 :: Int) --- "12th" -toOrdinal :: Integral a => a -> Text -toOrdinal = toLazyText . ordinal - --- | O(n) Convert casing to @Title Cased Phrase@. /Subject to fusion./ -toTitle :: Text -> Text -toTitle = lazy Fusion.toTitle - --- | O(n) Convert casing to @camelCasedPhrase@. /Subject to fusion./ -toCamel :: Text -> Text -toCamel = lazy Fusion.toCamel - --- | O(n) Convert casing to @PascalCasePhrase@. /Subject to fusion./ -toPascal :: Text -> Text -toPascal = lazy Fusion.toPascal - --- | O(n) Convert casing to @snake_cased_phrase@. /Subject to fusion./ -toSnake :: Text -> Text -toSnake = lazy Fusion.toSnake - --- | O(n) Convert casing to @spinal-cased-phrase@. /Subject to fusion./ -toSpinal :: Text -> Text -toSpinal = lazy Fusion.toSpinal - --- | O(n) Convert casing to @Train-Cased-Phrase@. /Subject to fusion./ -toTrain :: Text -> Text -toTrain = lazy Fusion.toTrain diff --git a/src/Data/Text/Manipulate.hs b/src/Data/Text/Manipulate.hs deleted file mode 100644 --- a/src/Data/Text/Manipulate.hs +++ /dev/null @@ -1,257 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} - --- Module : Data.Text.Manipulate --- Copyright : (c) 2014-2020 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) - --- | Manipulate identifiers and structurally non-complex pieces --- of text by delimiting word boundaries via a combination of whitespace, --- control-characters, and case-sensitivity. --- --- Assumptions have been made about word boundary characteristics inherint --- in predominantely English text, please see individual function documentation --- for further details and behaviour. -module Data.Text.Manipulate - ( -- * Strict vs lazy types - -- $strict - - -- * Unicode - -- $unicode - - -- * Fusion - -- $fusion - - -- * Subwords - - -- ** Removing words - takeWord, - dropWord, - stripWord, - - -- ** Breaking on words - breakWord, - splitWords, - - -- * Character manipulation - lowerHead, - upperHead, - mapHead, - - -- * Line manipulation - indentLines, - prependLines, - - -- * Ellipsis - toEllipsis, - toEllipsisWith, - - -- * Acronyms - toAcronym, - - -- * Ordinals - toOrdinal, - - -- * Casing - toTitle, - toCamel, - toPascal, - toSnake, - toSpinal, - toTrain, - - -- * Boundary predicates - isBoundary, - isWordBoundary, - ) -where - -import qualified Data.Char as Char -import Data.List (intersperse) -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. --- The strict functions are provided by the "Data.Text.Manipulate" module, while the lazy --- functions are provided by the "Data.Text.Lazy.Manipulate" module. - --- $unicode --- While this library supports Unicode in a similar fashion to the --- underlying library, --- more explicit Unicode handling of word boundaries can be found in the --- library. - --- $fusion --- Many functions in this module are subject to fusion, meaning that --- a pipeline of such functions will usually allocate at most one Text value. --- --- Functions that can be fused by the compiler are documented with the --- phrase /Subject to fusion/. - --- DEBUG: --- import Data.Text.Internal.Fusion (stream) --- import Data.Text.Internal.Fusion.Common (unstreamList) --- tokens = unstreamList . Fusion.tokenise . stream - --- FIXME: --- dropWord "ALong" == "" - --- | Lowercase the first character of a piece of text. --- --- >>> lowerHead "Title Cased" --- "title Cased" -lowerHead :: Text -> Text -lowerHead = mapHead Char.toLower - --- | Uppercase the first character of a piece of text. --- --- >>> upperHead "snake_cased" --- "Snake_cased" -upperHead :: Text -> Text -upperHead = mapHead Char.toUpper - --- | Apply a function to the first character of a piece of text. -mapHead :: (Char -> Char) -> Text -> Text -mapHead f x = - case Text.uncons x of - Just (c, cs) -> Text.singleton (f c) <> cs - 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 :: - -- | Length. - Int -> - -- | Ellipsis. - Text -> - 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./ -takeWord :: Text -> Text -takeWord = strict Fusion.takeWord - --- | O(n) Return the suffix after dropping the first word. If no word --- boundary is encountered, the result will be empty. /Subject to fusion./ -dropWord :: Text -> Text -dropWord = strict Fusion.dropWord - --- | Break a piece of text after the first word boundary is encountered. --- --- >>> breakWord "PascalCasedVariable" --- ("Pacal", "CasedVariable") --- --- >>> breakWord "spinal-cased-variable" --- ("spinal", "cased-variable") -breakWord :: Text -> (Text, Text) -breakWord x = (takeWord x, dropWord x) - --- | O(n) Return the suffix after removing the first word, or 'Nothing' --- if no word boundary is encountered. --- --- >>> stripWord "HTML5Spaghetti" --- Just "Spaghetti" --- --- >>> stripWord "noboundaries" --- Nothing -stripWord :: Text -> Maybe Text -stripWord x - | Text.length y < Text.length x = Just y - | otherwise = Nothing - where - y = dropWord x - --- | O(n) Split into a list of words delimited by boundaries. --- --- >>> splitWords "SupercaliFrag_ilistic" --- ["Supercali","Frag","ilistic"] -splitWords :: Text -> [Text] -splitWords = go - where - go x = case breakWord x of - (h, t) - | Text.null h -> go t - | Text.null t -> [h] - | otherwise -> h : go t - --- | O(n) Create an adhoc acronym from a piece of cased text. --- --- >>> toAcronym "AmazonWebServices" --- Just "AWS" --- --- >>> toAcronym "Learn-You Some_Haskell" --- Just "LYSH" --- --- >>> toAcronym "this_is_all_lowercase" --- Nothing -toAcronym :: Text -> Maybe Text -toAcronym (Text.filter Char.isUpper -> x) - | Text.length x > 1 = Just x - | otherwise = Nothing - --- | Render an ordinal used to denote the position in an ordered sequence. --- --- >>> toOrdinal (101 :: Int) --- "101st" --- --- >>> toOrdinal (12 :: Int) --- "12th" -toOrdinal :: Integral a => a -> Text -toOrdinal = LText.toStrict . LMan.toOrdinal - --- | O(n) Convert casing to @Title Cased Phrase@. /Subject to fusion./ -toTitle :: Text -> Text -toTitle = strict Fusion.toTitle - --- | O(n) Convert casing to @camelCasedPhrase@. /Subject to fusion./ -toCamel :: Text -> Text -toCamel = strict Fusion.toCamel - --- | O(n) Convert casing to @PascalCasePhrase@. /Subject to fusion./ -toPascal :: Text -> Text -toPascal = strict Fusion.toPascal - --- | O(n) Convert casing to @snake_cased_phrase@. /Subject to fusion./ -toSnake :: Text -> Text -toSnake = strict Fusion.toSnake - --- | O(n) Convert casing to @spinal-cased-phrase@. /Subject to fusion./ -toSpinal :: Text -> Text -toSpinal = strict Fusion.toSpinal - --- | O(n) Convert casing to @Train-Cased-Phrase@. /Subject to fusion./ -toTrain :: Text -> Text -toTrain = strict Fusion.toTrain diff --git a/src/Data/Text/Manipulate/Internal/Fusion.hs b/src/Data/Text/Manipulate/Internal/Fusion.hs deleted file mode 100644 --- a/src/Data/Text/Manipulate/Internal/Fusion.hs +++ /dev/null @@ -1,193 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ViewPatterns #-} - --- Module : Data.Text.Manipulate.Internal.Fusion --- Copyright : (c) 2014-2020 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 (lowerMapping, upperMapping) -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 :: - -- | Boundary action. - (forall s. s -> Step (CC s) Char) -> - -- | Character mapping. - (forall s. Char -> s -> Step (CC s) Char) -> - -- | Input stream. - Stream Token -> - 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 :: - -- | Boundary action. - (forall s. s -> Step (CC s) Char) -> - -- | Boundary mapping. - (forall s. Char -> s -> Step (CC s) Char) -> - -- | Subsequent character mapping. - (forall s. Char -> s -> Step (CC s) Char) -> - -- | Input stream. - Stream Token -> - 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 - = -- | Word boundary. - B {-# UNPACK #-} !Char - | -- | Upper case character. - U {-# UNPACK #-} !Char - | -- | Lower case character. - L {-# UNPACK #-} !Char - deriving (Show) - --- | Tokenise a character stream using the default 'isBoundary' predicate. --- --- /See:/ 'tokeniseWith' -tokenise :: - -- | Input stream. - Stream Char -> - Stream Token -tokenise = tokeniseWith isBoundary -{-# INLINE [0] tokenise #-} - --- | Tokenise a character stream using a custom boundary predicate. -tokeniseWith :: - -- | Boundary predicate. - (Char -> Bool) -> - -- | Input stream. - Stream Char -> - 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 deleted file mode 100644 --- a/src/Data/Text/Manipulate/Internal/Types.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} - --- Module : Data.Text.Manipulate.Internal.Types --- Copyright : (c) 2014-2020 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.Text.Lazy.Builder (Builder, singleton) -import GHC.Base - --- | 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 - -ordinal :: Integral a => a -> Builder -ordinal (toInteger -> n) = decimal 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) -{-# NOINLINE [0] ordinal #-} - -decimal :: Integral a => a -> Builder -{-# SPECIALIZE decimal :: Int -> Builder #-} -decimal i - | i < 0 = singleton '-' <> go (- i) - | otherwise = go i - where - go n - | n < 10 = digit n - | otherwise = go (n `quot` 10) <> digit (n `rem` 10) -{-# NOINLINE [0] decimal #-} - -digit :: Integral a => a -> Builder -digit n = singleton $! i2d (fromIntegral n) -{-# INLINE digit #-} - -i2d :: Int -> Char -i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) -{-# INLINE i2d #-} diff --git a/text-manipulate.cabal b/text-manipulate.cabal --- a/text-manipulate.cabal +++ b/text-manipulate.cabal @@ -1,18 +1,16 @@ +cabal-version: 2.2 name: text-manipulate -version: 0.3.0.0 -synopsis: - Case conversion, word boundary manipulation, and textual subjugation. - +version: 0.3.1.0 +synopsis: Case conversion, word boundary manipulation, and textual subjugation. homepage: https://github.com/brendanhay/text-manipulate license: MPL-2.0 license-file: LICENSE author: Brendan Hay maintainer: Brendan Hay -copyright: Copyright (c) 2014-2020 Brendan Hay +copyright: Copyright (c) 2014-2022 Brendan Hay category: Data, Text build-type: Simple extra-source-files: README.md -cabal-version: >=2.0 description: Manipulate identifiers and structurally non-complex pieces of text by delimiting word boundaries via a combination of whitespace, @@ -21,20 +19,22 @@ Has support for common idioms like casing of programmatic variable names, taking, dropping, and splitting by word, and modifying the first character of a piece of text. - . - /Caution:/ this library makes heavy use of the - library's internal loop optimisation framework. Since internal modules are not - guaranteed to have a stable API there is potential for build breakage when - the text dependency is upgraded. Consider yourself warned! source-repository head type: git location: git://github.com/brendanhay/text-manipulate.git -library +common base default-language: Haskell2010 - hs-source-dirs: src - ghc-options: -Wall + ghc-options: + -Wall -funbox-strict-fields -fwarn-incomplete-uni-patterns + -fwarn-incomplete-record-updates + + build-depends: base >=4.6 && <5 + +library + import: base + hs-source-dirs: lib exposed-modules: Data.Text.Lazy.Manipulate Data.Text.Manipulate @@ -43,30 +43,26 @@ Data.Text.Manipulate.Internal.Fusion Data.Text.Manipulate.Internal.Types - build-depends: - base >=4.12 && <5 - , text >=1.1 + build-depends: text >=1.1 -benchmark benchmarks - type: exitcode-stdio-1.0 - default-language: Haskell2010 - main-is: Main.hs - hs-source-dirs: bench - ghc-options: -Wall -O2 -threaded -with-rtsopts=-T +benchmark bench + import: base + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: bench + ghc-options: -O2 -threaded -with-rtsopts=-T build-depends: - base >=4.12 && <5 , criterion >=1.0.0.2 , text , text-manipulate test-suite tests - type: exitcode-stdio-1.0 - default-language: Haskell2010 - hs-source-dirs: test - main-is: Main.hs - ghc-options: -Wall -threaded + import: base + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + ghc-options: -threaded build-depends: - base >=4.12 && <5 , tasty >=0.8 , tasty-hunit >=0.8 , text