packages feed

text-manipulate 0.3.0.0 → 0.3.1.0

raw patch · 11 files changed

+877/−790 lines, 11 filesdep ~basedep ~textsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, text

API changes (from Hackage documentation)

Files

README.md view
@@ -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.
− Setup.hs 
@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain
+ lib/Data/Text/Lazy/Manipulate.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- Module      : Data.Text.Lazy.Manipulate+-- Copyright   : (c) 2014-2020 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- 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 <http://hackage.haskell.org/package/text text> library,+-- more explicit Unicode specific handling of word boundaries can be found in the+-- <http://hackage.haskell.org/package/text-icu text-icu> 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
+ lib/Data/Text/Manipulate.hs view
@@ -0,0 +1,257 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- Module      : Data.Text.Manipulate+-- Copyright   : (c) 2014-2020 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- 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 <http://hackage.haskell.org/package/text text> library,+-- more explicit Unicode handling of word boundaries can be found in the+-- <http://hackage.haskell.org/package/text-icu text-icu> 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
+ lib/Data/Text/Manipulate/Internal/Fusion.hs view
@@ -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 <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- 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 #-}
+ lib/Data/Text/Manipulate/Internal/Types.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- Module      : Data.Text.Manipulate.Internal.Types+-- Copyright   : (c) 2014-2020 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- 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 #-}
− src/Data/Text/Lazy/Manipulate.hs 
@@ -1,247 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}---- Module      : Data.Text.Lazy.Manipulate--- Copyright   : (c) 2014-2020 Brendan Hay <brendan.g.hay@gmail.com>--- 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 <brendan.g.hay@gmail.com>--- 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 <http://hackage.haskell.org/package/text text> library,--- more explicit Unicode specific handling of word boundaries can be found in the--- <http://hackage.haskell.org/package/text-icu text-icu> 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
− src/Data/Text/Manipulate.hs 
@@ -1,257 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}---- Module      : Data.Text.Manipulate--- Copyright   : (c) 2014-2020 Brendan Hay <brendan.g.hay@gmail.com>--- 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 <brendan.g.hay@gmail.com>--- 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 <http://hackage.haskell.org/package/text text> library,--- more explicit Unicode handling of word boundaries can be found in the--- <http://hackage.haskell.org/package/text-icu text-icu> 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
− src/Data/Text/Manipulate/Internal/Fusion.hs 
@@ -1,193 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ViewPatterns #-}---- Module      : Data.Text.Manipulate.Internal.Fusion--- Copyright   : (c) 2014-2020 Brendan Hay <brendan.g.hay@gmail.com>--- 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 <brendan.g.hay@gmail.com>--- 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 #-}
− src/Data/Text/Manipulate/Internal/Types.hs 
@@ -1,60 +0,0 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ViewPatterns #-}---- Module      : Data.Text.Manipulate.Internal.Types--- Copyright   : (c) 2014-2020 Brendan Hay <brendan.g.hay@gmail.com>--- 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 <brendan.g.hay@gmail.com>--- 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 #-}
text-manipulate.cabal view
@@ -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 <brendan.g.hay@gmail.com>-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 <http://hackage.haskell.org/package/text text>-  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