extra 1.6.5 → 1.6.6

raw patch · 6 files changed

+86/−2 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.txt +3/−0
• extra.cabal +1/−1
• src/Data/List/Extra.hs +70/−0
• src/Extra.hs +1/−1
• test/TestGen.hs +8/−0
• test/TestUtil.hs +3/−0

@@ -1,5 +1,8 @@ Changelog for Extra +1.6.6, released 2018-04-16+    Add escapeJSON and unescapeJSON+    Add escapeHTML and unescapeHTML 1.6.5, released 2018-03-24     #33, improve error messages on test suite failures 1.6.4, released 2018-02-23

@@ -1,7 +1,7 @@ cabal-version:      >= 1.18 build-type:         Simple name:               extra-version:            1.6.5+version:            1.6.6 license:            BSD3 license-file:       LICENSE category:           Development

@@ -9,6 +9,8 @@     module Data.List,     -- * String operations     lower, upper, trim, trimStart, trimEnd, word1, line1,+    escapeHTML, escapeJSON,+    unescapeHTML, unescapeJSON,     -- * Splitting     dropEnd, takeEnd, splitAtEnd, breakEnd, spanEnd,     dropWhileEnd, dropWhileEnd', takeWhileEnd,@@ -38,6 +40,7 @@ import Data.Char import Data.Tuple.Extra import Data.Monoid+import Numeric import Data.Functor import Prelude @@ -271,6 +274,73 @@ -- > line1 "test\nrest\nmore" == ("test","rest\nmore") line1 :: String -> (String, String) line1 = second drop1 . break (== '\n')++-- | Escape a string such that it can be inserted into an HTML document or @\"@ attribute+--   without any special interpretation. This requires escaping the @<@, @>@, @&@ and @\"@ characters.+--   Note that it does /not/ escape @\'@, so will not work when placed in a @\'@ delimited attribute.+--   Also note that it will escape @\"@ even though that is not required in an HTML body (but is not harmful).+--+-- > escapeHTML "this is a test" == "this is a test"+-- > escapeHTML "<b>\"g&t\"</n>" == "&lt;b&gt;&quot;g&amp;t&quot;&lt;/n&gt;"+-- > escapeHTML "don't" == "don't"+escapeHTML :: String -> String+escapeHTML = concatMap f+    where+        f '>' = "&gt;"+        f '<' = "&lt;"+        f '&' = "&amp;"+        f '\"' = "&quot;"+        f x = [x]++-- | Invert of 'escapeHTML' (does not do general HTML unescaping)+--+-- > \xs -> unescapeHTML (escapeHTML xs) == xs+unescapeHTML :: String -> String+unescapeHTML ('&':xs)+    | Just xs <- stripPrefix "lt;" xs = '<' : unescapeHTML xs+    | Just xs <- stripPrefix "gt;" xs = '>' : unescapeHTML xs+    | Just xs <- stripPrefix "amp;" xs = '&' : unescapeHTML xs+    | Just xs <- stripPrefix "quot;" xs = '\"' : unescapeHTML xs+unescapeHTML (x:xs) = x : unescapeHTML xs+unescapeHTML [] = []+++-- | Escape a string so it can form part of a JSON literal.+--   This requires escaping the special whitespace and control characters. Additionally,+--   Note that it does /not/ add quote characters around the string.+--+-- > escapeJSON "this is a test" == "this is a test"+-- > escapeJSON "\ttab\nnewline\\" == "\\ttab\\nnewline\\\\"+-- > escapeJSON "\ESC[0mHello" == "\\u001b[0mHello"+escapeJSON :: String -> String+escapeJSON x = concatMap f x+    where f '\"' = "\\\""+          f '\\' = "\\\\"+          -- the spaces are technically optional, but we include them so the JSON is readable+          f '\b' = "\\b"+          f '\f' = "\\f"+          f '\n' = "\\n"+          f '\r' = "\\r"+          f '\t' = "\\t"+          f x | isControl x = "\\u" ++ takeEnd 4 ("0000" ++ showHex (ord x) "")+          f x = [x]++-- | General JSON unescaping, inversion of 'escapeJSON' and all other JSON escapes.+--+-- > \xs -> unescapeJSON (escapeJSON xs) == xs+unescapeJSON :: String -> String+unescapeJSON ('\\':x:xs)+    | x == '\"' = '\"' : unescapeJSON xs+    | x == '\\' = '\\' : unescapeJSON xs+    | x == '/' = '/' : unescapeJSON xs+    | x == 'b' = '\b' : unescapeJSON xs+    | x == 'f' = '\f' : unescapeJSON xs+    | x == 'n' = '\n' : unescapeJSON xs+    | x == 'r' = '\r' : unescapeJSON xs+    | x == 't' = '\t' : unescapeJSON xs+    | x == 'u', let (a,b) = splitAt 4 xs, length a == 4, [(i, "")] <- readHex a = chr i : unescapeJSON b+unescapeJSON (x:xs) = x : unescapeJSON xs+unescapeJSON [] = []   #if __GLASGOW_HASKELL__ < 709

@@ -23,7 +23,7 @@     modifyIORef', writeIORef', atomicModifyIORef', atomicWriteIORef, atomicWriteIORef',     -- * Data.List.Extra     -- | Extra functions available in @"Data.List.Extra"@.-    lower, upper, trim, trimStart, trimEnd, word1, line1, dropEnd, takeEnd, splitAtEnd, breakEnd, spanEnd, dropWhileEnd, dropWhileEnd', takeWhileEnd, stripSuffix, stripInfix, stripInfixEnd, dropPrefix, dropSuffix, wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split, chunksOf, list, uncons, unsnoc, cons, snoc, drop1, mconcatMap, groupSort, groupSortOn, groupSortBy, nubOrd, nubOrdBy, nubOrdOn, nubOn, groupOn, sortOn, nubSort, nubSortBy, nubSortOn, maximumOn, minimumOn, disjoint, allSame, anySame, repeatedly, for, firstJust, concatUnzip, concatUnzip3, zipFrom, zipWithFrom, replace, merge, mergeBy,+    lower, upper, trim, trimStart, trimEnd, word1, line1, escapeHTML, escapeJSON, unescapeHTML, unescapeJSON, dropEnd, takeEnd, splitAtEnd, breakEnd, spanEnd, dropWhileEnd, dropWhileEnd', takeWhileEnd, stripSuffix, stripInfix, stripInfixEnd, dropPrefix, dropSuffix, wordsBy, linesBy, breakOn, breakOnEnd, splitOn, split, chunksOf, list, uncons, unsnoc, cons, snoc, drop1, mconcatMap, groupSort, groupSortOn, groupSortBy, nubOrd, nubOrdBy, nubOrdOn, nubOn, groupOn, sortOn, nubSort, nubSortBy, nubSortOn, maximumOn, minimumOn, disjoint, allSame, anySame, repeatedly, for, firstJust, concatUnzip, concatUnzip3, zipFrom, zipWithFrom, replace, merge, mergeBy,     -- * Data.Tuple.Extra     -- | Extra functions available in @"Data.Tuple.Extra"@.     first, second, (***), (&&&), dupe, both, fst3, snd3, thd3,

@@ -132,6 +132,14 @@     testGen "line1 \"test\\n\" == (\"test\",\"\")" $ line1 "test\n" == ("test","")     testGen "line1 \"test\\nrest\" == (\"test\",\"rest\")" $ line1 "test\nrest" == ("test","rest")     testGen "line1 \"test\\nrest\\nmore\" == (\"test\",\"rest\\nmore\")" $ line1 "test\nrest\nmore" == ("test","rest\nmore")+    testGen "escapeHTML \"this is a test\" == \"this is a test\"" $ escapeHTML "this is a test" == "this is a test"+    testGen "escapeHTML \"<b>\\\"g&t\\\"</n>\" == \"&lt;b&gt;&quot;g&amp;t&quot;&lt;/n&gt;\"" $ escapeHTML "<b>\"g&t\"</n>" == "&lt;b&gt;&quot;g&amp;t&quot;&lt;/n&gt;"+    testGen "escapeHTML \"don't\" == \"don't\"" $ escapeHTML "don't" == "don't"+    testGen "\\xs -> unescapeHTML (escapeHTML xs) == xs" $ \xs -> unescapeHTML (escapeHTML xs) == xs+    testGen "escapeJSON \"this is a test\" == \"this is a test\"" $ escapeJSON "this is a test" == "this is a test"+    testGen "escapeJSON \"\\ttab\\nnewline\\\\\" == \"\\\\ttab\\\\nnewline\\\\\\\\\"" $ escapeJSON "\ttab\nnewline\\" == "\\ttab\\nnewline\\\\"+    testGen "escapeJSON \"\\ESC[0mHello\" == \"\\\\u001b[0mHello\"" $ escapeJSON "\ESC[0mHello" == "\\u001b[0mHello"+    testGen "\\xs -> unescapeJSON (escapeJSON xs) == xs" $ \xs -> unescapeJSON (escapeJSON xs) == xs     testGen "sortOn fst [(3,\"z\"),(1,\"\"),(3,\"a\")] == [(1,\"\"),(3,\"z\"),(3,\"a\")]" $ sortOn fst [(3,"z"),(1,""),(3,"a")] == [(1,""),(3,"z"),(3,"a")]     testGen "groupSort [(1,'t'),(3,'t'),(2,'e'),(2,'s')] == [(1,\"t\"),(2,\"es\"),(3,\"t\")]" $ groupSort [(1,'t'),(3,'t'),(2,'e'),(2,'s')] == [(1,"t"),(2,"es"),(3,"t")]     testGen "\\xs -> map fst (groupSort xs) == sort (nub (map fst xs))" $ \xs -> map fst (groupSort xs) == sort (nub (map fst xs))

@@ -71,6 +71,9 @@  runTests :: IO () -> IO () runTests t = do+    -- ensure that capturing output is robust+    hSetBuffering stdout NoBuffering+    hSetBuffering stderr NoBuffering     writeIORef testCount 0     t     n <- readIORef testCount