diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -- Module : Main --- Copyright : (c) 2014-2015 Brendan Hay +-- 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 @@ -12,38 +12,40 @@ module Main (main) where -import Criterion -import Criterion.Main -import Data.List (intersperse) -import Data.Monoid -import Data.Text (Text) -import qualified Data.Text as Text -import Data.Text.Manipulate +import Criterion +import Criterion.Main +import Data.List (intersperse) +import Data.Monoid +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Text.Manipulate main :: IO () -main = defaultMain - [ bgroup "Data.Text" - [ bench "takeWord" - $ whnf (Text.takeWhile (not . isWordBoundary)) phrase - , bench "toCamel" - $ whnf (lowerHead . mconcat . group Text.toTitle) phrase - , bench "toPascal" - $ whnf (upperHead . mconcat . group Text.toTitle) phrase - , bench "toSnake" - $ whnf (mconcat . intersperse "_" . group Text.toLower) phrase - , bench "toSpinal" - $ whnf (mconcat . intersperse "-" . group Text.toLower) phrase - , bench "toTrain" - $ whnf (mconcat . intersperse "-" . group Text.toTitle) phrase - ] - - , bgroup "Data.Text.Case" - [ bench "takeWord" $ whnf takeWord phrase - , bench "toCamel" $ whnf toCamel phrase - , bench "toPacal" $ whnf toPascal phrase - , bench "toSnake" $ whnf toSnake phrase - , bench "toSpinal" $ whnf toSpinal phrase - , bench "toTrain" $ whnf toTrain phrase +main = + defaultMain + [ bgroup + "Data.Text" + [ bench "takeWord" $ + whnf (Text.takeWhile (not . isWordBoundary)) phrase, + bench "toCamel" $ + whnf (lowerHead . mconcat . group Text.toTitle) phrase, + bench "toPascal" $ + whnf (upperHead . mconcat . group Text.toTitle) phrase, + bench "toSnake" $ + whnf (mconcat . intersperse "_" . group Text.toLower) phrase, + bench "toSpinal" $ + whnf (mconcat . intersperse "-" . group Text.toLower) phrase, + bench "toTrain" $ + whnf (mconcat . intersperse "-" . group Text.toTitle) phrase + ], + bgroup + "Data.Text.Case" + [ bench "takeWord" $ whnf takeWord phrase, + bench "toCamel" $ whnf toCamel phrase, + bench "toPacal" $ whnf toPascal phrase, + bench "toSnake" $ whnf toSnake phrase, + bench "toSpinal" $ whnf toSpinal phrase, + bench "toTrain" $ whnf toTrain phrase ] ] @@ -51,5 +53,6 @@ phrase = "Supercalifragilistic, world! This-is A multipleDelimiter_String" group :: (Text -> Text) -> Text -> [Text] -group f = map (f . Text.dropWhile isBoundary) +group f = + map (f . Text.dropWhile isBoundary) . Text.groupBy (const (not . isWordBoundary)) diff --git a/src/Data/Text/Lazy/Manipulate.hs b/src/Data/Text/Lazy/Manipulate.hs --- a/src/Data/Text/Lazy/Manipulate.hs +++ b/src/Data/Text/Lazy/Manipulate.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns #-} -- Module : Data.Text.Lazy.Manipulate --- Copyright : (c) 2014-2015 Brendan Hay +-- 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 @@ -19,8 +19,7 @@ -- in predominantely English text, please see individual function documentation -- for further details and behaviour. module Data.Text.Lazy.Manipulate - ( - -- * Strict vs lazy types + ( -- * Strict vs lazy types -- $strict -- * Unicode @@ -30,56 +29,58 @@ -- $fusion -- * Subwords + -- ** Removing words - takeWord - , dropWord - , stripWord + takeWord, + dropWord, + stripWord, + -- ** Breaking on words - , breakWord - , splitWords + breakWord, + splitWords, -- * Character manipulation - , lowerHead - , upperHead - , mapHead + lowerHead, + upperHead, + mapHead, -- * Line manipulation - , indentLines - , prependLines + indentLines, + prependLines, -- * Ellipsis - , toEllipsis - , toEllipsisWith + toEllipsis, + toEllipsisWith, -- * Acronyms - , toAcronym + toAcronym, -- * Ordinals - , toOrdinal + toOrdinal, -- * Casing - , toTitle - , toCamel - , toPascal - , toSnake - , toSpinal - , toTrain + toTitle, + toCamel, + toPascal, + toSnake, + toSpinal, + toTrain, -- * Boundary predicates - , isBoundary - , isWordBoundary - ) where + isBoundary, + isWordBoundary, + ) +where -import qualified Data.Char as Char -import Data.Int -import Data.List (intersperse) -import Data.Monoid -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.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 +import Data.Text.Manipulate.Internal.Types -- $strict -- This library provides functions for manipulating both strict and lazy Text types. @@ -116,9 +117,9 @@ -- | 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 + 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 @@ -137,13 +138,16 @@ -- | 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 :: + -- | Length. + Int64 -> + -- | Ellipsis. + Text -> + Text -> + Text toEllipsisWith n suf x - | LText.length x > n = LText.take n x <> suf - | otherwise = 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./ @@ -175,8 +179,8 @@ -- Nothing stripWord :: Text -> Maybe Text stripWord x - | LText.length y < LText.length x = Just y - | otherwise = Nothing + | LText.length y < LText.length x = Just y + | otherwise = Nothing where y = dropWord x @@ -188,9 +192,10 @@ splitWords = go where go x = case breakWord x of - (h, t) | LText.null h -> go t - | LText.null t -> [h] - | otherwise -> h : go t + (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. -- @@ -204,8 +209,8 @@ -- Nothing toAcronym :: Text -> Maybe Text toAcronym (LText.filter Char.isUpper -> x) - | LText.length x > 1 = Just x - | otherwise = Nothing + | LText.length x > 1 = Just x + | otherwise = Nothing -- | Render an ordinal used to denote the position in an ordered sequence. -- diff --git a/src/Data/Text/Manipulate.hs b/src/Data/Text/Manipulate.hs --- a/src/Data/Text/Manipulate.hs +++ b/src/Data/Text/Manipulate.hs @@ -1,8 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns #-} -- Module : Data.Text.Manipulate --- Copyright : (c) 2014-2015 Brendan Hay +-- 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 @@ -18,9 +18,8 @@ -- 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 +module Data.Text.Manipulate + ( -- * Strict vs lazy types -- $strict -- * Unicode @@ -30,56 +29,58 @@ -- $fusion -- * Subwords + -- ** Removing words - takeWord - , dropWord - , stripWord + takeWord, + dropWord, + stripWord, + -- ** Breaking on words - , breakWord - , splitWords + breakWord, + splitWords, -- * Character manipulation - , lowerHead - , upperHead - , mapHead + lowerHead, + upperHead, + mapHead, -- * Line manipulation - , indentLines - , prependLines + indentLines, + prependLines, -- * Ellipsis - , toEllipsis - , toEllipsisWith + toEllipsis, + toEllipsisWith, -- * Acronyms - , toAcronym + toAcronym, -- * Ordinals - , toOrdinal + toOrdinal, -- * Casing - , toTitle - , toCamel - , toPascal - , toSnake - , toSpinal - , toTrain + toTitle, + toCamel, + toPascal, + toSnake, + toSpinal, + toTrain, -- * Boundary predicates - , isBoundary - , isWordBoundary - ) where + isBoundary, + isWordBoundary, + ) +where -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.Internal.Fusion (strict) +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 +import Data.Text.Manipulate.Internal.Types -- $strict -- This library provides functions for manipulating both strict and lazy Text types. @@ -124,9 +125,9 @@ -- | 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 + case Text.uncons x of + Just (c, cs) -> Text.singleton (f c) <> cs + Nothing -> x -- | Indent newlines by the given number of spaces. -- @@ -147,13 +148,16 @@ -- | 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 :: + -- | Length. + Int -> + -- | Ellipsis. + Text -> + Text -> + Text toEllipsisWith n suf x - | Text.length x > n = Text.take n x <> suf - | otherwise = 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./ @@ -185,8 +189,8 @@ -- Nothing stripWord :: Text -> Maybe Text stripWord x - | Text.length y < Text.length x = Just y - | otherwise = Nothing + | Text.length y < Text.length x = Just y + | otherwise = Nothing where y = dropWord x @@ -198,9 +202,10 @@ splitWords = go where go x = case breakWord x of - (h, t) | Text.null h -> go t - | Text.null t -> [h] - | otherwise -> h : go t + (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. -- @@ -214,8 +219,8 @@ -- Nothing toAcronym :: Text -> Maybe Text toAcronym (Text.filter Char.isUpper -> x) - | Text.length x > 1 = Just x - | otherwise = Nothing + | Text.length x > 1 = Just x + | otherwise = Nothing -- | Render an ordinal used to denote the position in an ordered sequence. -- diff --git a/src/Data/Text/Manipulate/Internal/Fusion.hs b/src/Data/Text/Manipulate/Internal/Fusion.hs --- a/src/Data/Text/Manipulate/Internal/Fusion.hs +++ b/src/Data/Text/Manipulate/Internal/Fusion.hs @@ -1,9 +1,9 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE RankNTypes #-} -- Module : Data.Text.Manipulate.Internal.Fusion --- Copyright : (c) 2014-2015 Brendan Hay +-- 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 @@ -14,15 +14,15 @@ 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 +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 @@ -32,17 +32,17 @@ 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') + 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 @@ -89,86 +89,102 @@ -- 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 :: + -- | 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 :: (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 :: + -- | 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 + -- 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') - + 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) + = -- | 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 :: Stream Char -- ^ Input stream. - -> Stream Token +tokenise :: + -- | Input stream. + Stream Char -> + 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 :: + -- | 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 + -- 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' + 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) - skip = up || start || prev + step p = CC (p :*: u :*: b :*: s') '\0' '\0' - b = f c - u = Char.isUpper c + 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 #-} diff --git a/src/Data/Text/Manipulate/Internal/Types.hs b/src/Data/Text/Manipulate/Internal/Types.hs --- a/src/Data/Text/Manipulate/Internal/Types.hs +++ b/src/Data/Text/Manipulate/Internal/Types.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns #-} -- Module : Data.Text.Manipulate.Internal.Types --- Copyright : (c) 2014-2015 Brendan Hay +-- 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 @@ -14,11 +14,10 @@ module Data.Text.Manipulate.Internal.Types where -import Control.Monad -import qualified Data.Char as Char -import Data.Monoid -import Data.Text.Lazy.Builder (Builder, singleton) -import GHC.Base +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 @@ -30,25 +29,27 @@ 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" + 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 #-} + (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 + | 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 #-} + 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) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,9 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} - {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- Module : Main --- Copyright : (c) 2014-2015 Brendan Hay +-- 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 @@ -14,202 +13,214 @@ module Main (main) where -import Data.Text (Text) -import Data.Text.Manipulate -import Test.Tasty -import Test.Tasty.HUnit +import Data.Text (Text) +import Data.Text.Manipulate +import Test.Tasty +import Test.Tasty.HUnit main :: IO () -main = defaultMain $ testGroup "tests" - [ exampleGroup "lowerHead" lowerHead - [ "" - , "title cased phrase" - , "camelCasedPhrase" - , "pascalCasedPhrase" - , "snake_cased_phrase" - , "spinal-cased-phrase" - , "train-Cased-Phrase" - , "1-Mixed_string AOK" - , "a double--stop__phrase" - , "hTML5" - , "είναιΥπάρχουν πολλές-Αντίθετα" - , "je_obecněÚvodní-Španěl" - ] - - , exampleGroup "upperHead" upperHead - [ "" - , "Title cased phrase" - , "CamelCasedPhrase" - , "PascalCasedPhrase" - , "Snake_cased_phrase" - , "Spinal-cased-phrase" - , "Train-Cased-Phrase" - , "1-Mixed_string AOK" - , "A double--stop__phrase" - , "HTML5" - , "ΕίναιΥπάρχουν πολλές-Αντίθετα" - , "Je_obecněÚvodní-Španěl" - ] - - , exampleGroup "takeWord" takeWord - [ "" - , "Title" - , "camel" - , "Pascal" - , "snake" - , "spinal" - , "Train" - , "1" - , "a" - , "HTML5" - , "Είναι" - , "Je" - ] - - , exampleGroup "dropWord" dropWord - [ "" - , "cased phrase" - , "CasedPhrase" - , "CasedPhrase" - , "cased_phrase" - , "cased-phrase" - , "Cased-Phrase" - , "Mixed_string AOK" - , "double-stop_phrase" - , "" - , "Υπάρχουν πολλές-Αντίθετα" - , "obecněÚvodní-Španěl" - ] - - , exampleGroup "stripWord" stripWord - [ Nothing - , Just "cased phrase" - , Just "CasedPhrase" - , Just "CasedPhrase" - , Just "cased_phrase" - , Just "cased-phrase" - , Just "Cased-Phrase" - , Just "Mixed_string AOK" - , Just "double-stop_phrase" - , Just "" - , Just "Υπάρχουν πολλές-Αντίθετα" - , Just "obecněÚvodní-Španěl" - ] - - , testGroup "splitWords" - [ - ] - - , testGroup "indentLines" - [ - ] - - , testGroup "toAcronym" - [ - ] - - , testGroup "toOrdinal" - [ testCase "1st" ("1st" @=? toOrdinal 1) - , testCase "2nd" ("2nd" @=? toOrdinal 2) - , testCase "3rd" ("3rd" @=? toOrdinal 3) - , testCase "4th" ("4th" @=? toOrdinal 4) - , testCase "5th" ("5th" @=? toOrdinal 5) - , testCase "21st" ("21st" @=? toOrdinal 21) - , testCase "33rd" ("33rd" @=? toOrdinal 33) - , testCase "102nd" ("102nd" @=? toOrdinal 102) - , testCase "203rd" ("203rd" @=? toOrdinal 203) - ] - - , exampleGroup "toCamel" toCamel - [ "" - , "titleCasedPhrase" - , "camelCasedPhrase" - , "pascalCasedPhrase" - , "snakeCasedPhrase" - , "spinalCasedPhrase" - , "trainCasedPhrase" - , "1MixedStringAOK" - , "aDoubleStopPhrase" - , "hTML5" - , "είναιΥπάρχουνΠολλέςΑντίθετα" - , "jeObecněÚvodníŠpaněl" - ] - - , exampleGroup "toPascal" toPascal - [ "" - , "TitleCasedPhrase" - , "CamelCasedPhrase" - , "PascalCasedPhrase" - , "SnakeCasedPhrase" - , "SpinalCasedPhrase" - , "TrainCasedPhrase" - , "1MixedStringAOK" - , "ADoubleStopPhrase" - , "HTML5" - , "ΕίναιΥπάρχουνΠολλέςΑντίθετα" - , "JeObecněÚvodníŠpaněl" - ] - - , exampleGroup "toSnake" toSnake - [ "" - , "title_cased_phrase" - , "camel_cased_phrase" - , "pascal_cased_phrase" - , "snake_cased_phrase" - , "spinal_cased_phrase" - , "train_cased_phrase" - , "1_mixed_string_aok" - , "a_double_stop_phrase" - , "html5" - , "είναι_υπάρχουν_πολλές_αντίθετα" - , "je_obecně_úvodní_španěl" - ] - - , exampleGroup "toSpinal" toSpinal - [ "" - , "title-cased-phrase" - , "camel-cased-phrase" - , "pascal-cased-phrase" - , "snake-cased-phrase" - , "spinal-cased-phrase" - , "train-cased-phrase" - , "1-mixed-string-aok" - , "a-double-stop-phrase" - , "html5" - , "είναι-υπάρχουν-πολλές-αντίθετα" - , "je-obecně-úvodní-španěl" - ] - - , exampleGroup "toTrain" toTrain - [ "" - , "Title-Cased-Phrase" - , "Camel-Cased-Phrase" - , "Pascal-Cased-Phrase" - , "Snake-Cased-Phrase" - , "Spinal-Cased-Phrase" - , "Train-Cased-Phrase" - , "1-Mixed-String-AOK" - , "A-Double-Stop-Phrase" - , "HTML5" - , "Είναι-Υπάρχουν-Πολλές-Αντίθετα" - , "Je-Obecně-Úvodní-Španěl" - ] - - , exampleGroup "toTitle" toTitle - [ "" - , "Title Cased Phrase" - , "Camel Cased Phrase" - , "Pascal Cased Phrase" - , "Snake Cased Phrase" - , "Spinal Cased Phrase" - , "Train Cased Phrase" - , "1 Mixed String AOK" - , "A Double Stop Phrase" - , "HTML5" - , "Είναι Υπάρχουν Πολλές Αντίθετα" - , "Je Obecně Úvodní Španěl" - ] - ] +main = + defaultMain $ + testGroup + "tests" + [ exampleGroup + "lowerHead" + lowerHead + [ "", + "title cased phrase", + "camelCasedPhrase", + "pascalCasedPhrase", + "snake_cased_phrase", + "spinal-cased-phrase", + "train-Cased-Phrase", + "1-Mixed_string AOK", + "a double--stop__phrase", + "hTML5", + "είναιΥπάρχουν πολλές-Αντίθετα", + "je_obecněÚvodní-Španěl" + ], + exampleGroup + "upperHead" + upperHead + [ "", + "Title cased phrase", + "CamelCasedPhrase", + "PascalCasedPhrase", + "Snake_cased_phrase", + "Spinal-cased-phrase", + "Train-Cased-Phrase", + "1-Mixed_string AOK", + "A double--stop__phrase", + "HTML5", + "ΕίναιΥπάρχουν πολλές-Αντίθετα", + "Je_obecněÚvodní-Španěl" + ], + exampleGroup + "takeWord" + takeWord + [ "", + "Title", + "camel", + "Pascal", + "snake", + "spinal", + "Train", + "1", + "a", + "HTML5", + "Είναι", + "Je" + ], + exampleGroup + "dropWord" + dropWord + [ "", + "cased phrase", + "CasedPhrase", + "CasedPhrase", + "cased_phrase", + "cased-phrase", + "Cased-Phrase", + "Mixed_string AOK", + "double-stop_phrase", + "", + "Υπάρχουν πολλές-Αντίθετα", + "obecněÚvodní-Španěl" + ], + exampleGroup + "stripWord" + stripWord + [ Nothing, + Just "cased phrase", + Just "CasedPhrase", + Just "CasedPhrase", + Just "cased_phrase", + Just "cased-phrase", + Just "Cased-Phrase", + Just "Mixed_string AOK", + Just "double-stop_phrase", + Just "", + Just "Υπάρχουν πολλές-Αντίθετα", + Just "obecněÚvodní-Španěl" + ], + testGroup + "splitWords" + [], + testGroup + "indentLines" + [], + testGroup + "toAcronym" + [], + testGroup + "toOrdinal" + [ testCase "1st" ("1st" @=? toOrdinal 1), + testCase "2nd" ("2nd" @=? toOrdinal 2), + testCase "3rd" ("3rd" @=? toOrdinal 3), + testCase "4th" ("4th" @=? toOrdinal 4), + testCase "5th" ("5th" @=? toOrdinal 5), + testCase "21st" ("21st" @=? toOrdinal 21), + testCase "33rd" ("33rd" @=? toOrdinal 33), + testCase "102nd" ("102nd" @=? toOrdinal 102), + testCase "203rd" ("203rd" @=? toOrdinal 203) + ], + exampleGroup + "toCamel" + toCamel + [ "", + "titleCasedPhrase", + "camelCasedPhrase", + "pascalCasedPhrase", + "snakeCasedPhrase", + "spinalCasedPhrase", + "trainCasedPhrase", + "1MixedStringAOK", + "aDoubleStopPhrase", + "hTML5", + "είναιΥπάρχουνΠολλέςΑντίθετα", + "jeObecněÚvodníŠpaněl" + ], + exampleGroup + "toPascal" + toPascal + [ "", + "TitleCasedPhrase", + "CamelCasedPhrase", + "PascalCasedPhrase", + "SnakeCasedPhrase", + "SpinalCasedPhrase", + "TrainCasedPhrase", + "1MixedStringAOK", + "ADoubleStopPhrase", + "HTML5", + "ΕίναιΥπάρχουνΠολλέςΑντίθετα", + "JeObecněÚvodníŠpaněl" + ], + exampleGroup + "toSnake" + toSnake + [ "", + "title_cased_phrase", + "camel_cased_phrase", + "pascal_cased_phrase", + "snake_cased_phrase", + "spinal_cased_phrase", + "train_cased_phrase", + "1_mixed_string_aok", + "a_double_stop_phrase", + "html5", + "είναι_υπάρχουν_πολλές_αντίθετα", + "je_obecně_úvodní_španěl" + ], + exampleGroup + "toSpinal" + toSpinal + [ "", + "title-cased-phrase", + "camel-cased-phrase", + "pascal-cased-phrase", + "snake-cased-phrase", + "spinal-cased-phrase", + "train-cased-phrase", + "1-mixed-string-aok", + "a-double-stop-phrase", + "html5", + "είναι-υπάρχουν-πολλές-αντίθετα", + "je-obecně-úvodní-španěl" + ], + exampleGroup + "toTrain" + toTrain + [ "", + "Title-Cased-Phrase", + "Camel-Cased-Phrase", + "Pascal-Cased-Phrase", + "Snake-Cased-Phrase", + "Spinal-Cased-Phrase", + "Train-Cased-Phrase", + "1-Mixed-String-AOK", + "A-Double-Stop-Phrase", + "HTML5", + "Είναι-Υπάρχουν-Πολλές-Αντίθετα", + "Je-Obecně-Úvodní-Španěl" + ], + exampleGroup + "toTitle" + toTitle + [ "", + "Title Cased Phrase", + "Camel Cased Phrase", + "Pascal Cased Phrase", + "Snake Cased Phrase", + "Spinal Cased Phrase", + "Train Cased Phrase", + "1 Mixed String AOK", + "A Double Stop Phrase", + "HTML5", + "Είναι Υπάρχουν Πολλές Αντίθετα", + "Je Obecně Úvodní Španěl" + ] + ] exampleGroup :: (Show a, Eq a) => TestName -> (Text -> a) -> [a] -> TestTree exampleGroup n f = testGroup n . zipWith run reference @@ -217,16 +228,16 @@ run (c, x) y = testCase c (f x @=? y) reference = - [ ("Empty", "") - , ("Title", "Title cased phrase") - , ("Camel", "camelCasedPhrase") - , ("Pascal", "PascalCasedPhrase") - , ("Snake", "snake_cased_phrase") - , ("Spinal", "spinal-cased-phrase") - , ("Train", "Train-Cased-Phrase") - , ("Mixed", "1-Mixed_string AOK") - , ("Double Stop", "a double--stop__phrase") - , ("Acronym", "HTML5") - , ("Greek", "ΕίναιΥπάρχουν πολλές-Αντίθετα") - , ("Czech", "Je_obecněÚvodní-Španěl") - ] + [ ("Empty", ""), + ("Title", "Title cased phrase"), + ("Camel", "camelCasedPhrase"), + ("Pascal", "PascalCasedPhrase"), + ("Snake", "snake_cased_phrase"), + ("Spinal", "spinal-cased-phrase"), + ("Train", "Train-Cased-Phrase"), + ("Mixed", "1-Mixed_string AOK"), + ("Double Stop", "a double--stop__phrase"), + ("Acronym", "HTML5"), + ("Greek", "ΕίναιΥπάρχουν πολλές-Αντίθετα"), + ("Czech", "Je_obecněÚvodní-Španěl") + ] diff --git a/text-manipulate.cabal b/text-manipulate.cabal --- a/text-manipulate.cabal +++ b/text-manipulate.cabal @@ -1,75 +1,73 @@ -name: text-manipulate -version: 0.2.0.1 -synopsis: Case conversion, word boundary manipulation, and textual subjugation. -homepage: https://github.com/brendanhay/text-manipulate -license: OtherLicense -license-file: LICENSE -author: Brendan Hay -maintainer: Brendan Hay -copyright: Copyright (c) 2014-2015 Brendan Hay -category: Data, Text -build-type: Simple -extra-source-files: README.md -cabal-version: >= 1.10 +name: text-manipulate +version: 0.3.0.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 +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, - control-characters, and case-sensitivity. - . - 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! + Manipulate identifiers and structurally non-complex pieces + of text by delimiting word boundaries via a combination of whitespace, + control-characters, and case-sensitivity. + . + 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 + type: git + location: git://github.com/brendanhay/text-manipulate.git library - default-language: Haskell2010 - hs-source-dirs: src - ghc-options: -Wall - - exposed-modules: - Data.Text.Manipulate - , Data.Text.Lazy.Manipulate + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + exposed-modules: + Data.Text.Lazy.Manipulate + Data.Text.Manipulate - other-modules: - Data.Text.Manipulate.Internal.Fusion - , Data.Text.Manipulate.Internal.Types + other-modules: + Data.Text.Manipulate.Internal.Fusion + Data.Text.Manipulate.Internal.Types - build-depends: - base >= 4.5 && < 5 - , text >= 1.1 + build-depends: + base >=4.12 && <5 + , 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 - - build-depends: - base - , criterion >= 1.0.0.2 - , text-manipulate - , text + type: exitcode-stdio-1.0 + default-language: Haskell2010 + main-is: Main.hs + hs-source-dirs: bench + ghc-options: -Wall -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 - - build-depends: - base - , text-manipulate - , tasty >= 0.8 - , tasty-hunit >= 0.8 - , text + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + ghc-options: -Wall -threaded + build-depends: + base >=4.12 && <5 + , tasty >=0.8 + , tasty-hunit >=0.8 + , text + , text-manipulate