text-plus (empty) → 0.1.0.1
raw patch · 7 files changed
+512/−0 lines, 7 filesdep +HTFdep +QuickCheckdep +basesetup-changed
Dependencies added: HTF, QuickCheck, base, bytestring, doctest, pretty, strict-data, text, text-plus, util-plus
Files
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- src/Data/Text/Plus.hs +289/−0
- test/Data/Text/PlusSpec.hs +135/−0
- test/Spec.hs +12/−0
- text-plus.cabal +43/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright factis research GmbH (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Kierán Meinhardt nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# text-plus
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Text/Plus.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing #-}+module Data.Text.Plus+ ( module Data.Text+ , module Data.Text.Encoding+ , decodeUtf8M+ , showText+ , readText+ , groupOn+ , withoutTags+ , showTable+ , showTableRaw+ , filename+ , splitOnNoEmpty+ , nothingIfEmpty+ , noneIfEmpty+ , emptyIfNone+ , limitTo+ , sep, unsep, unsep'+ , shorten+ , shortenL+ , firstToUpper+ , shortenLinesL+ , lenientDecodeUtf8, lenientDecodeUtf8L+ , toLazy+ , fromLazy+ , indicesOfOccurences+ , tokenize+ , commonPrefixTotal+ , firstLine+ , firstParagraph+ , escapeXml+ , fixed+ , fixed'+ )+where++import Data.Fail+import Data.Option+import Safe.Plus++import Data.Char (isSpace)+import Data.Function+import Data.Maybe+import Data.Monoid+import Data.Text+import Data.Text.Encoding hiding (Decoding(Some))+import Test.QuickCheck+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Char as C+import qualified Data.Foldable as F+import qualified Data.Text as T+import qualified Data.Text.Encoding.Error as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE++fixed :: Int -> T.Text -> T.Text+fixed = fixed' '0'++fixed' :: Char -> Int -> T.Text -> T.Text+fixed' ch i s =+ let n = i - T.length s+ in T.replicate n (T.singleton ch) `T.append` s++instance Arbitrary T.Text where+ arbitrary = T.pack <$> arbitrary+ shrink t = T.pack <$> shrink (T.unpack t)++fromLazy :: TL.Text -> T.Text+fromLazy = TL.toStrict++toLazy :: T.Text -> TL.Text+toLazy = TL.fromStrict++showText :: Show a => a -> T.Text+showText = T.pack . show++showTextL :: Show a => a -> TL.Text+showTextL = TL.pack . show++readText :: Read a => T.Text -> a+readText = read . T.unpack++limitTo :: Int -> T.Text -> T.Text+limitTo lim t+ | lim <= 5 = t+ | T.length t <= lim = t+ | otherwise =+ T.take (lim - 4) t+ <> "..."+ <> T.drop (T.length t - 1) t++groupOn :: Eq a => (Char -> a) -> Text -> [(a, T.Text)]+groupOn _ "" = []+groupOn proj t = (x', x `T.cons` ys) : groupOn proj zs+ where+ x = T.head t+ xs = T.tail t+ x' = proj x+ (ys,zs) = T.span ((==x') . proj) xs++firstToUpper :: T.Text -> T.Text+firstToUpper t =+ case T.uncons t of+ Nothing -> ""+ Just (fstChr, rstText) ->+ C.toUpper fstChr `cons` rstText++-- |Removes HTML Tags+withoutTags :: T.Text -> T.Text+withoutTags =+ let betweenTags ('<':xs) = inTag xs+ betweenTags (x:xs) = x:betweenTags xs+ betweenTags [] = []+ inTag ('>':xs) = betweenTags xs+ inTag ('\'':xs) = inSingQuot xs+ inTag ('"':xs) = inDoubleQuot xs+ inTag (_:xs) = inTag xs+ inTag [] = [] -- incorrect HTML+ inSingQuot ('\'':xs) = inTag xs+ inSingQuot (_:xs) = inSingQuot xs+ inSingQuot [] = [] -- incorrect HTML+ inDoubleQuot ('\"':xs) = inTag xs+ inDoubleQuot (_:xs) = inDoubleQuot xs+ inDoubleQuot [] = [] -- incorrect HTML+ in T.pack . betweenTags . T.unpack++-- indicesOfOccurences needle haystack returns all indices i s.t.+--+-- prop> needle `T.isPrefixOf` (T.drop i haystack)+--+-- Note that: T.breakOnAll - does not return overlapping matches, e.g.+--+-- prop> indicesOfOccurences "edited" "editedited" == [0,4]+--+-- but+--+-- prop> map (T.length . fst) (T.breakOnAll "edited" "editedited") == [0]+--+indicesOfOccurences :: T.Text -> T.Text -> [Int]+indicesOfOccurences needle = go 0+ where+ go off haystack+ | Just (_, matchTail) <- T.uncons match = newOff:go (newOff+1) matchTail+ | otherwise = []+ where+ newOff = off + T.length prefix+ (prefix, match) = T.breakOn needle haystack++-- | Simple tokenizer - that doesn't destroy delimiters, e.g.+--+-- >>> tokenize (T.pack "This is blind-text, with punctuation.")+-- ["This"," ","is"," ","blind","-","text",", ","with"," ","punctuation","."]+--+-- prop> T.concat (tokenize x) == x+--+-- Note: URLs, numbers won't be handled very well.+tokenize :: T.Text -> [T.Text]+tokenize = T.groupBy ((==) `on` C.isAlphaNum)++-- | @commonPrefixTotal s t@ returns a trippel @(r,st,tt)@ s.t.+-- @+-- s = r `T.append` st, t = r `T.append` tt+-- @+-- such that @r@ is longest possible.+--+-- Note: Contrary to Data.commonPrefix there is no special case when @T.null r@.+commonPrefixTotal :: T.Text -> T.Text -> (T.Text, T.Text, T.Text)+commonPrefixTotal s t = fromMaybe ("", s, t) $ T.commonPrefixes s t++showTable :: (Traversable t) => [(T.Text, a -> T.Text)] -> t a -> T.Text+showTable headersAccessors rows =+ showTableRaw (fmap fst headersAccessors) (fmap (\x -> fmap (($ x) . snd) headersAccessors) rows)++showTableRaw :: (Traversable t1, Traversable t2) => [T.Text] -> t1 (t2 T.Text) -> T.Text+showTableRaw headers rows = table+ where+ rows' = fmap (fmap (wrap ' ')) rows+ columnHeaders =+ fmap (wrap ' ') headers+ header = renderRow columnHeaders+ headerBodySeperator =+ wrap '|' (T.intercalate "+" (fmap (`T.replicate` "-") fieldWidths))+ renderRow rowElems =+ wrap '|' (T.intercalate "|" (adjust (F.toList rowElems)))+ wrap char = T.cons char . (`T.snoc` char)+ table =+ flip T.snoc '\n' . T.intercalate "\n" $+ header : headerBodySeperator : F.toList (fmap renderRow rows')+ adjust = Prelude.zipWith (`T.justifyLeft` ' ') fieldWidths+ fieldWidths =+ Prelude.foldr (Prelude.zipWith (\a b -> max (T.length a) b))+ (F.toList (fmap T.length columnHeaders)) (fmap F.toList rows')++nothingIfEmpty :: T.Text -> Maybe T.Text+nothingIfEmpty t =+ if T.null $ T.strip t then Nothing else Just t++noneIfEmpty :: T.Text -> Option T.Text+noneIfEmpty = maybeToOption . nothingIfEmpty++emptyIfNone :: Option T.Text -> T.Text+emptyIfNone None = T.empty+emptyIfNone (Some t) = t++sep :: T.Text -> Char -> T.Text -> T.Text+sep prefix ch suffix+ | T.any (==ch) prefix =+ safeError ("Oh dear! Won't separate `" ++ T.unpack prefix ++ "' with `" ++ show ch+ ++ "' because it contains that character!")+ | otherwise = T.concat [prefix, T.singleton ch, suffix]++unsep' :: Monad m => Char -> T.Text -> m (T.Text, T.Text)+unsep' ch full =+ case T.span (/=ch) full of+ (prefix, T.uncons -> Just (ch', suffix)) | ch == ch' -> return (prefix, suffix)+ _ -> safeFail ("Can't unsep `" ++ T.unpack full ++ "' using `" ++ show ch ++ "'.")++unsep :: Char -> T.Text -> (T.Text, T.Text)+unsep ch x = safeFromOk (unsep' ch x)++shorten :: Int -> T.Text -> T.Text+shorten len = TL.toStrict . shortenL len . TL.fromStrict++shortenL :: Int -> TL.Text -> TL.Text+shortenL (fromIntegral -> maxLen) s =+ let actualLen = TL.length s+ skipMsg = TL.concat ["... (", showTextL (actualLen - maxLen), " more chars)"]+ skipMsgLen = TL.length skipMsg+ in if actualLen <= maxLen + skipMsgLen+ then s+ else TL.concat [TL.take maxLen s, skipMsg]++shortenLinesL :: Int -> Int -> TL.Text -> TL.Text+shortenLinesL maxLines maxLineLength (Prelude.map (shortenL maxLineLength) . TL.lines -> xs) =+ let actualLines = Prelude.length xs+ skipMsg = TL.concat ["(", showTextL (actualLines - maxLines), " more lines)"]+ lines+ | actualLines <= maxLines + 1 = xs+ | otherwise = Prelude.take maxLines xs ++ [skipMsg]+ in TL.unlines lines++filename :: T.Text -> T.Text+filename = T.replace "?" "_" . T.replace "/" "_" . T.replace "." "_" . T.replace " " "_"++splitOnNoEmpty :: T.Text -> T.Text -> [T.Text]+splitOnNoEmpty break t =+ Prelude.filter (/= "") $ T.splitOn break t++lenientDecodeUtf8 :: BS.ByteString -> T.Text+lenientDecodeUtf8 = decodeUtf8With TE.lenientDecode++lenientDecodeUtf8L :: BSL.ByteString -> TL.Text+lenientDecodeUtf8L = TLE.decodeUtf8With TE.lenientDecode++decodeUtf8M :: BS.ByteString -> Fail T.Text+decodeUtf8M bs =+ case decodeUtf8' bs of+ Left (TE.DecodeError err (Just w8)) ->+ Fail $+ "Failed decoding " ++ show bs ++ " as UTF-8 on character " ++ show w8 ++ ": " ++ err+ Left (TE.DecodeError err Nothing) ->+ Fail $ "Failed decoding " ++ show bs ++ " as UTF-8: " ++ err+ Left _ -> safeError "Never used according to documentation."+ Right txt -> Ok txt++firstParagraph :: T.Text -> T.Text+firstParagraph =+ T.unlines . Prelude.takeWhile (not . endOfParagraph) . T.lines+ where+ endOfParagraph = T.all isSpace++firstLine :: T.Text -> T.Text+firstLine = T.takeWhile (/='\n')++escapeXml :: T.Text -> T.Text+escapeXml = T.concatMap escape+ where+ escape c =+ case c of+ '<' -> "<"+ '>' -> ">"+ '&' -> "&"+ '"' -> """+ '\'' -> "'"+ c -> T.singleton c
+ test/Data/Text/PlusSpec.hs view
@@ -0,0 +1,135 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+{-# LANGUAGE OverloadedStrings #-}+module Data.Text.PlusSpec (htf_thisModulesTests) where++import Data.Text.Plus++import Test.Framework+import qualified Data.Char as C+import qualified Data.Text as T++test_groupOn :: IO ()+test_groupOn =+ do assertEqual [] $ groupOn id ""+ assertEqual [(False, "abc"), (True, "123"), (False, "def")] $ groupOn C.isDigit "abc123def"++test_firstToUpper :: IO ()+test_firstToUpper =+ do assertEqual "Hallo" $ firstToUpper "hallo"+ assertEqual "HAllo" $ firstToUpper "HAllo"+ assertEqual "" $ firstToUpper ""++test_withoutTags :: IO ()+test_withoutTags =+ do assertEqual "Hello laboratory report!"+ (withoutTags $ "<p class=\"x\">Hello <pre>laboratory</pre> report!</p>")+ assertEqual "Hello laboratory report!"+ (withoutTags $ "<p class=\"x>x<\">Hello <pre>laboratory</pre> report!</p>")+ assertEqual "Hello report!"+ (withoutTags $ "<p class='s>x<'>Hello report!</p>")++prop_indicesOverlapping :: Property+prop_indicesOverlapping = once $ prop_indices "aba" "ababa"++prop_indicesThree :: Property+prop_indicesThree = once $ prop_indices "a" "ababa"++prop_indicesNone :: Property+prop_indicesNone = once $ prop_indices "foo" "ababa"++prop_indicesSingle :: Property+prop_indicesSingle = once $ prop_indices "bab" "ababa"++prop_indices :: T.Text -> T.Text -> Property+prop_indices n h = not (T.null n) ==>+ (indicesOfOccurences n h === [ i | i <- [0..(T.length h - 1)], n `T.isPrefixOf` (T.drop i h)])++test_tokenize :: IO ()+test_tokenize =+ assertEqual ["This"," ","is"," ","blind","-","text",", ","with", " ", "punctuation", "."] $+ tokenize "This is blind-text, with punctuation."++test_tokenizeWithNum :: IO ()+test_tokenizeWithNum =+ assertEqual ["100"," ","sheep"] $ tokenize "100 sheep"++test_tokenizeEmpty :: IO ()+test_tokenizeEmpty =+ assertEqual [] $ tokenize ""++test_showTableRaw :: IO ()+test_showTableRaw =+ let header = ["Col1", "Col2", "Col3"]+ table = [["longfield", "-", ""], ["short", "longfield", ""]]+ in assertEqual (showTableRaw header table) $+ T.concat+ [ "| Col1 | Col2 | Col3 |\n"+ , "|-----------+-----------+------|\n"+ , "| longfield | - | |\n"+ , "| short | longfield | |\n"+ ]++test_shortenL :: IO ()+test_shortenL =+ do assertEqual "123456789012345678901" (shortenL 20 "123456789012345678901")+ assertEqual "123456789012345678901" (shortenL 21 "123456789012345678901")+ assertEqual "123456789012345678901" (shortenL 22 "123456789012345678901")+ assertEqual "123456789012345678901" (shortenL 2 "123456789012345678901")+ assertEqual "1... (20 more chars)" (shortenL 1 "123456789012345678901")+ assertEqual "... (21 more chars)" (shortenL 0 "123456789012345678901")++test_shortenLinesL1 :: IO ()+test_shortenLinesL1 =+ assertEqual outp (shortenLinesL 2 1 inp)+ where+ outp =+ "1... (20 more chars)\n\+ \1... (20 more chars)\n\+ \(4 more lines)\n"+ inp =+ "123456789012345678901\n123456789012345678901\n123456789012345678901\n\+ \123456789012345678901\n123456789012345678901\n123456789012345678901"++test_shortenLinesL2 :: IO ()+test_shortenLinesL2 =+ assertEqual outp (shortenLinesL 0 0 inp)+ where+ outp = "(6 more lines)\n"+ inp =+ "123456789012345678901\n123456789012345678901\n123456789012345678901\n\+ \123456789012345678901\n123456789012345678901\n123456789012345678901"++test_filename :: IO ()+test_filename =+ do assertEqual "Foo" (filename "Foo")+ assertEqual "Foo_Bar" (filename "Foo Bar")+ assertEqual "Foo_Bar" (filename "Foo/Bar")+ assertEqual "Foo_Bar" (filename "Foo.Bar")+ assertEqual "Foo_Bar" (filename "Foo?Bar")++test_sepUnsep :: IO ()+test_sepUnsep =+ do assertEqual ("foo|bar") (sep "foo" '|' "bar")+ assertEqual ("foo", "bar") (unsep '|' "foo|bar")+ assertEqual ("foo", "bar|baz") (unsep '|' "foo|bar|baz")++test_firstLine :: IO ()+test_firstLine =+ do assertEqual "Hello World" (firstLine "Hello World")+ assertEqual "Hello World" (firstLine "Hello World\nsecond line")+ assertEqual "Hello World " (firstLine "Hello World \nsecond line")++test_firstParagraph :: IO ()+test_firstParagraph =+ do assertEqual "Hello\nWorld\n" $ firstParagraph "Hello\nWorld"+ assertEqual "Hello\nWorld\n" $ firstParagraph "Hello\nWorld\n"+ assertEqual "Hello\nWorld\n" $ firstParagraph "Hello\nWorld\n\nSecond paragraph.\n"+ assertEqual "Hello\nWorld\n" $ firstParagraph "Hello\nWorld\n\nSecond paragraph."+ assertEqual "Hello\nWorld\n" $ firstParagraph "Hello\nWorld\n\nSecond paragraph.\n\nThird."+ assertEqual "Hello\nWorld\n" $ firstParagraph "Hello\nWorld\n \nSecond paragraph."++test_escapeXml :: IO ()+test_escapeXml =+ do assertEqual "foobar" (escapeXml "foobar")+ assertEqual "Hallo <Welt>" (escapeXml "Hallo <Welt>")+ assertEqual "Hallo 'Welt>" (escapeXml "Hallo 'Welt>")
+ test/Spec.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Main where++import {-@ HTF_TESTS @-} Data.Text.PlusSpec++import Test.DocTest+import Test.Framework++main :: IO ()+main =+ do doctest ["src"]+ htfMain htf_importedTests
+ text-plus.cabal view
@@ -0,0 +1,43 @@+name: text-plus+version: 0.1.0.1+synopsis: Utils for text+description: Utils for text+homepage: https://github.com/factisresearch/opensource-mono#readme+license: BSD3+license-file: LICENSE+author: factis research GmbH+maintainer: kieran.meinhardt@gmail.com+copyright: 2017 factis research GmbH+category: Data+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Data.Text.Plus+ build-depends: base >= 4.7 && < 5+ , QuickCheck+ , bytestring+ , pretty+ , strict-data+ , text+ , util-plus+ default-language: Haskell2010++test-suite text-plus-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: Data.Text.PlusSpec+ build-depends: base+ , HTF+ , doctest+ , text+ , text-plus+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/kmein/text-plus