packages feed

text-manipulate 0.1.1 → 0.1.2

raw patch · 7 files changed

+284/−239 lines, 7 files

Files

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