Hello community,
here is the log from the commit of package ghc-attoparsec for openSUSE:Factory checked in at 2016-04-30 23:30:08
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-attoparsec (Old)
and /work/SRC/openSUSE:Factory/.ghc-attoparsec.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-attoparsec"
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-attoparsec/ghc-attoparsec.changes 2016-01-08 15:22:39.000000000 +0100
+++ /work/SRC/openSUSE:Factory/.ghc-attoparsec.new/ghc-attoparsec.changes 2016-04-30 23:30:09.000000000 +0200
@@ -1,0 +2,9 @@
+Tue Apr 26 07:59:37 UTC 2016 - mimi.vx@gmail.com
+
+- update to 0.13.0.2
+- remove useless _service
+* Restore the fast specialised character set implementation for Text
+* Move testsuite from test-framework to tasty
+* Performance optimization of takeWhile and takeWhile1
+
+-------------------------------------------------------------------
Old:
----
_service
attoparsec-0.13.0.1.tar.gz
New:
----
attoparsec-0.13.0.2.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-attoparsec.spec ++++++
--- /var/tmp/diff_new_pack.2CO8XX/_old 2016-04-30 23:30:10.000000000 +0200
+++ /var/tmp/diff_new_pack.2CO8XX/_new 2016-04-30 23:30:10.000000000 +0200
@@ -20,15 +20,15 @@
%bcond_with tests
-Name: ghc-%{pkg_name}
-Version: 0.13.0.1
+Name: ghc-attoparsec
+Version: 0.13.0.2
Release: 0
Summary: Fast combinator parsing for bytestrings and text
License: BSD-3-Clause
Group: System/Libraries
-Url: http://hackage.haskell.org/package/%{pkg_name}
-Source0: http://hackage.haskell.org/packages/archive/%{pkg_name}/%{version}/%{pkg_name}-%{version}.tar.gz
+Url: https://hackage.haskell.org/package/%{pkg_name}
+Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: ghc-Cabal-devel
@@ -44,8 +44,8 @@
%if %{with tests}
BuildRequires: ghc-QuickCheck-devel
BuildRequires: ghc-quickcheck-unicode-devel
-BuildRequires: ghc-test-framework-devel
-BuildRequires: ghc-test-framework-quickcheck2-devel
+BuildRequires: ghc-tasty-devel
+BuildRequires: ghc-tasty-quickcheck-devel
BuildRequires: ghc-vector-devel
%endif
# End cabal-rpm deps
@@ -58,7 +58,6 @@
%package devel
Summary: Haskell %{pkg_name} library development files
Group: Development/Libraries/Other
-Provides: %{name}-static = %{version}-%{release}
Requires: ghc-compiler = %{ghc_version}
Requires(post): ghc-compiler = %{ghc_version}
Requires(postun): ghc-compiler = %{ghc_version}
++++++ attoparsec-0.13.0.1.tar.gz -> attoparsec-0.13.0.2.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/ByteString/Internal.hs new/attoparsec-0.13.0.2/Data/Attoparsec/ByteString/Internal.hs
--- old/attoparsec-0.13.0.1/Data/Attoparsec/ByteString/Internal.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/Data/Attoparsec/ByteString/Internal.hs 2016-04-22 02:38:31.000000000 +0200
@@ -257,15 +257,24 @@
-- parsers loop until a failure occurs. Careless use will thus result
-- in an infinite loop.
takeWhile :: (Word8 -> Bool) -> Parser ByteString
-takeWhile p = (B.concat . reverse) `fmap` go []
+takeWhile p = do
+ s <- B8.takeWhile p <$> get
+ continue <- inputSpansChunks (B.length s)
+ if continue
+ then takeWhileAcc p [s]
+ else return s
+{-# INLINE takeWhile #-}
+
+takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
+takeWhileAcc p = go
where
go acc = do
s <- B8.takeWhile p <$> get
continue <- inputSpansChunks (B.length s)
if continue
then go (s:acc)
- else return (s:acc)
-{-# INLINE takeWhile #-}
+ else return $ concatReverse (s:acc)
+{-# INLINE takeWhileAcc #-}
takeRest :: Parser [ByteString]
takeRest = go []
@@ -329,16 +338,13 @@
-- parsers loop until a failure occurs. Careless use will thus result
-- in an infinite loop.
scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
-scan = scan_ $ \_ chunks ->
- case chunks of
- [x] -> return x
- xs -> return $! B.concat $ reverse xs
+scan = scan_ $ \_ chunks -> return $! concatReverse chunks
{-# INLINE scan #-}
-- | Like 'scan', but generalized to return the final state of the
-- scanner.
runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
-runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
+runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
{-# INLINE runScanner #-}
-- | Consume input as long as the predicate returns 'True', and return
@@ -358,8 +364,9 @@
advance len
eoc <- endOfChunk
if eoc
- then (s<>) `fmap` takeWhile p
+ then takeWhileAcc p [s]
else return s
+{-# INLINE takeWhile1 #-}
-- | Match any byte in a set.
--
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/Internal.hs new/attoparsec-0.13.0.2/Data/Attoparsec/Internal.hs
--- old/attoparsec-0.13.0.1/Data/Attoparsec/Internal.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/Data/Attoparsec/Internal.hs 2016-04-22 02:38:31.000000000 +0200
@@ -20,10 +20,12 @@
, endOfInput
, atEnd
, satisfyElem
+ , concatReverse
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
+import Data.Monoid (Monoid, mconcat)
#endif
import Data.Attoparsec.Internal.Types
import Data.ByteString (ByteString)
@@ -159,3 +161,11 @@
| otherwise -> lose t pos more [] "satisfyElem"
Nothing -> satisfySuspended p t pos more lose succ
{-# INLINE satisfyElem #-}
+
+-- | Concatenate a monoid after reversing its elements. Used to
+-- glue together a series of textual chunks that have been accumulated
+-- \"backwards\".
+concatReverse :: Monoid m => [m] -> m
+concatReverse [x] = x
+concatReverse xs = mconcat (reverse xs)
+{-# INLINE concatReverse #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/Text/Buffer.hs new/attoparsec-0.13.0.2/Data/Attoparsec/Text/Buffer.hs
--- old/attoparsec-0.13.0.1/Data/Attoparsec/Text/Buffer.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/Data/Attoparsec/Text/Buffer.hs 2016-04-22 02:38:31.000000000 +0200
@@ -82,10 +82,12 @@
instance Monoid Buffer where
mempty = Buf A.empty 0 0 0 0
+ {-# INLINE mempty #-}
mappend (Buf _ _ _ 0 _) b = b
mappend a (Buf _ _ _ 0 _) = a
mappend buf (Buf arr off len _ _) = append buf arr off len
+ {-# INLINE mappend #-}
mconcat [] = mempty
mconcat xs = foldl1' mappend xs
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/Text/FastSet.hs new/attoparsec-0.13.0.2/Data/Attoparsec/Text/FastSet.hs
--- old/attoparsec-0.13.0.1/Data/Attoparsec/Text/FastSet.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/Data/Attoparsec/Text/FastSet.hs 2016-04-22 02:38:31.000000000 +0200
@@ -1,38 +1,118 @@
+{-# LANGUAGE BangPatterns #-}
+
+------------------------------------------------------------------------------
-- |
--- Module : Data.Attoparsec.Text.FastSet
--- Copyright : Bryan O'Sullivan 2015
+-- Module : Data.Attoparsec.FastSet
+-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015
-- License : BSD3
--
--- Maintainer : bos@serpentine.com
+-- Maintainer : felipe.lessa@gmail.com
-- Stability : experimental
-- Portability : unknown
--
--- Fast set membership tests for 'Char' values.
-
+-- Fast set membership tests for 'Char' values. We test for
+-- membership using a hashtable implemented with Robin Hood
+-- collision resolution. The set representation is unboxed,
+-- and the characters and hashes interleaved, for efficiency.
+--
+--
+-----------------------------------------------------------------------------
module Data.Attoparsec.Text.FastSet
(
-- * Data type
FastSet
-- * Construction
, fromList
+ , set
-- * Lookup
, member
-- * Handy interface
, charClass
) where
-import qualified Data.IntSet as I
-import Data.Char (ord)
+import Data.Bits ((.|.), (.&.), shiftR)
+import Data.Function (on)
+import Data.List (sort, sortBy)
+import qualified Data.Array.Base as AB
+import qualified Data.Array.Unboxed as A
+import qualified Data.Text as T
+
+data FastSet = FastSet {
+ table :: {-# UNPACK #-} !(A.UArray Int Int)
+ , mask :: {-# UNPACK #-} !Int
+ }
+
+data Entry = Entry {
+ key :: {-# UNPACK #-} !Char
+ , initialIndex :: {-# UNPACK #-} !Int
+ , index :: {-# UNPACK #-} !Int
+ }
+
+offset :: Entry -> Int
+offset e = index e - initialIndex e
+
+resolveCollisions :: [Entry] -> [Entry]
+resolveCollisions [] = []
+resolveCollisions [e] = [e]
+resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries)
+ where (a', b')
+ | index a < index b = (a, b)
+ | offset a < offset b = (b { index=index a }, a { index=index a + 1 })
+ | otherwise = (a, b { index=index a + 1 })
+
+pad :: Int -> [Entry] -> [Entry]
+pad = go 0
+ where -- ensure that we pad enough so that lookups beyond the
+ -- last hash in the table fall within the array
+ go !_ !m [] = replicate (max 1 m + 1) empty
+ go k m (e:entries) = map (const empty) [k..i - 1] ++ e :
+ go (i + 1) (m + i - k - 1) entries
+ where i = index e
+ empty = Entry '\0' maxBound 0
+
+nextPowerOf2 :: Int -> Int
+nextPowerOf2 0 = 1
+nextPowerOf2 x = go (x - 1) 1
+ where go y 32 = y + 1
+ go y k = go (y .|. (y `shiftR` k)) $ k * 2
-newtype FastSet = FastSet I.IntSet
+fastHash :: Char -> Int
+fastHash = fromEnum
fromList :: String -> FastSet
-fromList = FastSet . I.fromList . map ord
+fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved)
+ mask'
+ where s' = ordNub (sort s)
+ l = length s'
+ mask' = nextPowerOf2 ((5 * l) `div` 4) - 1
+ entries = pad mask' .
+ resolveCollisions .
+ sortBy (compare `on` initialIndex) .
+ zipWith (\c i -> Entry c i i) s' .
+ map ((.&. mask') . fastHash) $ s'
+ interleaved = concatMap (\e -> [fromEnum $ key e, initialIndex e])
+ entries
+
+ordNub :: Eq a => [a] -> [a]
+ordNub [] = []
+ordNub (y:ys) = go y ys
+ where go x (z:zs)
+ | x == z = go x zs
+ | otherwise = x : go z zs
+ go x [] = [x]
+
+set :: T.Text -> FastSet
+set = fromList . T.unpack
-- | Check the set for membership.
member :: Char -> FastSet -> Bool
-member c (FastSet s) = I.member (ord c) s
-{-# INLINE member #-}
+member c a = go (2 * i)
+ where i = fastHash c .&. mask a
+ lookupAt j b = (i' <= i) && (c == c' || b)
+ where c' = toEnum $ AB.unsafeAt (table a) j
+ i' = AB.unsafeAt (table a) $ j + 1
+ go j = lookupAt j . lookupAt (j + 2) . lookupAt (j + 4) .
+ lookupAt (j + 6) . go $ j + 8
charClass :: String -> FastSet
charClass = fromList . go
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/Data/Attoparsec/Text/Internal.hs new/attoparsec-0.13.0.2/Data/Attoparsec/Text/Internal.hs
--- old/attoparsec-0.13.0.1/Data/Attoparsec/Text/Internal.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/Data/Attoparsec/Text/Internal.hs 2016-04-22 02:38:31.000000000 +0200
@@ -269,14 +269,25 @@
-- parsers loop until a failure occurs. Careless use will thus result
-- in an infinite loop.
takeWhile :: (Char -> Bool) -> Parser Text
-takeWhile p = (T.concat . reverse) `fmap` go []
+takeWhile p = do
+ h <- T.takeWhile p <$> get
+ continue <- inputSpansChunks (size h)
+ -- only use slow concat path if necessary
+ if continue
+ then takeWhileAcc p [h]
+ else return h
+{-# INLINE takeWhile #-}
+
+takeWhileAcc :: (Char -> Bool) -> [Text] -> Parser Text
+takeWhileAcc p = go
where
go acc = do
h <- T.takeWhile p <$> get
continue <- inputSpansChunks (size h)
if continue
then go (h:acc)
- else return (h:acc)
+ else return $ concatReverse (h:acc)
+{-# INLINE takeWhileAcc #-}
takeRest :: Parser [Text]
takeRest = go []
@@ -334,16 +345,13 @@
-- parsers loop until a failure occurs. Careless use will thus result
-- in an infinite loop.
scan :: s -> (s -> Char -> Maybe s) -> Parser Text
-scan = scan_ $ \_ chunks ->
- case chunks of
- [x] -> return x
- xs -> return . T.concat . reverse $ xs
+scan = scan_ $ \_ chunks -> return $! concatReverse chunks
{-# INLINE scan #-}
-- | Like 'scan', but generalized to return the final state of the
-- scanner.
runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
-runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)
+runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
{-# INLINE runScanner #-}
-- | Consume input as long as the predicate returns 'True', and return
@@ -361,8 +369,9 @@
advance size'
eoc <- endOfChunk
if eoc
- then (h<>) `fmap` takeWhile p
+ then takeWhileAcc p [h]
else return h
+{-# INLINE takeWhile1 #-}
-- | Match any character in a set.
--
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/attoparsec.cabal new/attoparsec-0.13.0.2/attoparsec.cabal
--- old/attoparsec-0.13.0.1/attoparsec.cabal 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/attoparsec.cabal 2016-04-22 02:38:31.000000000 +0200
@@ -1,12 +1,12 @@
name: attoparsec
-version: 0.13.0.1
+version: 0.13.0.2
license: BSD3
license-file: LICENSE
category: Text, Parsing
author: Bryan O'Sullivan
maintainer: Bryan O'Sullivan
stability: experimental
-tested-with: GHC == 7.0, GHC == 7.2, GHC == 7.4, GHC == 7.6, GHC == 7.8, GHC == 7.10
+tested-with: GHC == 7.0.1, GHC == 7.2.1, GHC == 7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3
synopsis: Fast combinator parsing for bytestrings and text
cabal-version: >= 1.8
homepage: https://github.com/bos/attoparsec
@@ -89,6 +89,7 @@
QC.Rechunked
QC.Simple
QC.Text
+ QC.Text.FastSet
ghc-options:
-Wall -threaded -rtsopts
@@ -100,13 +101,12 @@
array,
base >= 4 && < 5,
bytestring,
- containers,
deepseq >= 1.1,
QuickCheck >= 2.7,
quickcheck-unicode,
scientific,
- test-framework >= 0.8.0.2,
- test-framework-quickcheck2 >= 0.3.0.3,
+ tasty >= 0.11,
+ tasty-quickcheck >= 0.8,
text,
transformers,
vector
@@ -136,7 +136,6 @@
base == 4.*,
bytestring >= 0.10.4.0,
case-insensitive,
- containers,
criterion >= 1.0,
deepseq >= 1.1,
directory,
@@ -146,6 +145,7 @@
parsec >= 3.1.2,
scientific,
text >= 1.1.1.0,
+ transformers,
unordered-containers,
vector
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/benchmarks/Benchmarks.hs new/attoparsec-0.13.0.2/benchmarks/Benchmarks.hs
--- old/attoparsec-0.13.0.1/benchmarks/Benchmarks.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/benchmarks/Benchmarks.hs 2016-04-22 02:38:31.000000000 +0200
@@ -71,10 +71,14 @@
, bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl
, bench "isAlpha_iso8859_15" $
nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl
+ , bench "T isAlpha" $ nf (AT.parse (AT.takeWhile isAlpha)) t
+ , bench "TL isAlpha" $ nf (ATL.parse (AT.takeWhile isAlpha)) tl
]
, bgroup "takeWhile1" [
bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl
, bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile1 AC.isAlpha_ascii)) bl
+ , bench "T isAlpha" $ nf (AT.parse (AT.takeWhile1 isAlpha)) t
+ , bench "TL isAlpha" $ nf (ATL.parse (AT.takeWhile1 isAlpha)) tl
]
, bench "word32LE" $ nf (AB.parse word32LE) b
, bgroup "scan" [
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/benchmarks/Main.hs new/attoparsec-0.13.0.2/benchmarks/Main.hs
--- old/attoparsec-0.13.0.1/benchmarks/Main.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/attoparsec-0.13.0.2/benchmarks/Main.hs 2016-04-22 02:38:31.000000000 +0200
@@ -0,0 +1,4 @@
+import Sets
+import Criterion.Main
+
+main = defaultMain [Sets.benchmarks]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/benchmarks/TextFastSet.hs new/attoparsec-0.13.0.2/benchmarks/TextFastSet.hs
--- old/attoparsec-0.13.0.1/benchmarks/TextFastSet.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/benchmarks/TextFastSet.hs 2016-04-22 02:38:31.000000000 +0200
@@ -62,7 +62,9 @@
pad :: Int -> [Entry] -> [Entry]
pad = go 0
- where go !_ !m [] = replicate (max 1 m) empty
+ where -- ensure that we pad enough so that lookups beyond the
+ -- last hash in the table fall within the array
+ go !_ !m [] = replicate (max 1 m + 1) empty
go k m (e:entries) = map (const empty) [k..i - 1] ++ e :
go (i + 1) (m + i - k - 1) entries
where i = index e
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/benchmarks/attoparsec-benchmarks.cabal new/attoparsec-0.13.0.2/benchmarks/attoparsec-benchmarks.cabal
--- old/attoparsec-0.13.0.1/benchmarks/attoparsec-benchmarks.cabal 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/benchmarks/attoparsec-benchmarks.cabal 2016-04-22 02:38:31.000000000 +0200
@@ -17,6 +17,7 @@
Numbers
Network.Wai.Handler.Warp.ReadInt
Sets
+ TextFastSet
Warp
hs-source-dirs: .. . warp-3.0.1.1
ghc-options: -O2 -Wall -rtsopts
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/changelog.md new/attoparsec-0.13.0.2/changelog.md
--- old/attoparsec-0.13.0.1/changelog.md 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/changelog.md 2016-04-22 02:38:31.000000000 +0200
@@ -1,3 +1,9 @@
+0.13.0.2
+
+* Restore the fast specialised character set implementation for Text
+* Move testsuite from test-framework to tasty
+* Performance optimization of takeWhile and takeWhile1
+
0.13.0.1
* Fixed a bug in the implementations of inClass and notInClass for
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Buffer.hs new/attoparsec-0.13.0.2/tests/QC/Buffer.hs
--- old/attoparsec-0.13.0.1/tests/QC/Buffer.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/tests/QC/Buffer.hs 2016-04-22 02:38:31.000000000 +0200
@@ -8,8 +8,8 @@
import Data.Monoid (Monoid(mconcat))
#endif
import QC.Common ()
-import Test.Framework (Test)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.Tasty (TestTree)
+import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck
import qualified Data.Attoparsec.ByteString.Buffer as BB
import qualified Data.Attoparsec.Text.Buffer as BT
@@ -82,7 +82,7 @@
i <- choose (0, T.lengthWord16 t)
return $ T.dropWord16 i t === BT.dropWord16 i buf
-tests :: [Test]
+tests :: [TestTree]
tests = [
testProperty "b_unbuffer" b_unbuffer
, testProperty "t_unbuffer" t_unbuffer
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/ByteString.hs new/attoparsec-0.13.0.2/tests/QC/ByteString.hs
--- old/attoparsec-0.13.0.1/tests/QC/ByteString.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/tests/QC/ByteString.hs 2016-04-22 02:38:31.000000000 +0200
@@ -9,8 +9,8 @@
import Data.Word (Word8)
import Prelude hiding (take, takeWhile)
import QC.Common (ASCII(..), liftOp, parseBS, toStrictBS)
-import Test.Framework (Test)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.Tasty (TestTree)
+import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck
import qualified Data.Attoparsec.ByteString as P
import qualified Data.Attoparsec.ByteString.Char8 as P8
@@ -155,7 +155,7 @@
nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s'
where set = S.fromList s
-tests :: [Test]
+tests :: [TestTree]
tests = [
testProperty "anyWord8" anyWord8
, testProperty "endOfInput" endOfInput
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Combinator.hs new/attoparsec-0.13.0.2/tests/QC/Combinator.hs
--- old/attoparsec-0.13.0.1/tests/QC/Combinator.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/tests/QC/Combinator.hs 2016-04-22 02:38:31.000000000 +0200
@@ -8,8 +8,8 @@
import Data.Maybe (fromJust, isJust)
import Data.Word (Word8)
import QC.Common (Repack, parseBS, repackBS, toLazyBS)
-import Test.Framework (Test)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.Tasty (TestTree)
+import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck
import qualified Data.Attoparsec.ByteString.Char8 as P
import qualified Data.Attoparsec.Combinator as C
@@ -43,7 +43,7 @@
B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'
]
-tests :: [Test]
+tests :: [TestTree]
tests = [
testProperty "choice" choice
, testProperty "count" count
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/IPv6.hs new/attoparsec-0.13.0.2/tests/QC/IPv6.hs
--- old/attoparsec-0.13.0.1/tests/QC/IPv6.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/tests/QC/IPv6.hs 1970-01-01 01:00:00.000000000 +0100
@@ -1,322 +0,0 @@
--- -----------------------------------------------------------------------------
-
--- |
--- Module : Text.IPv6Addr
--- Copyright : Copyright © Michel Boucey 2011-2015
--- License : BSD-Style
--- Maintainer : michel.boucey@gmail.com
---
--- Dealing with IPv6 address text representations, canonization and manipulations.
---
-
--- -----------------------------------------------------------------------------
-
-{-# LANGUAGE OverloadedStrings #-}
-
-module Text.IPv6Addr.Internal
- ( expandTokens
- , macAddr
- , maybeIPv6AddrTokens
- , ipv4AddrToIPv6AddrTokens
- , ipv6TokensToText
- , ipv6TokensToIPv6Addr
- , isIPv6Addr
- , maybeTokIPv6Addr
- , maybeTokPureIPv6Addr
- , fromDoubleColon
- , fromIPv6Addr
- , toDoubleColon
- , networkInterfacesIPv6AddrList
- ) where
-
-import Control.Monad (replicateM)
-import Data.Attoparsec.Text
-import Data.Char (isDigit,isHexDigit,toLower)
-import Data.Monoid ((<>))
-import Control.Applicative ((<|>),(<*))
-import Data.List (group,isSuffixOf,elemIndex,elemIndices,intersperse)
-import Numeric (showHex)
-import qualified Data.Text as T
-import qualified Data.Text.Read as R (decimal)
-import Data.Maybe (fromJust)
-import Network.Info
-
-import Text.IPv6Addr.Types
-
-tok0 = "0"
-
--- | Returns the 'T.Text' of an IPv6 address.
-fromIPv6Addr :: IPv6Addr -> T.Text
-fromIPv6Addr (IPv6Addr t) = t
-
--- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'T.Text'.
-ipv6TokensToText :: [IPv6AddrToken] -> T.Text
-ipv6TokensToText l = T.concat $ map ipv6TokenToText l
-
--- | Returns the corresponding 'T.Text' of an IPv6 address token.
-ipv6TokenToText :: IPv6AddrToken -> T.Text
-ipv6TokenToText (SixteenBit s) = s
-ipv6TokenToText Colon = ":"
-ipv6TokenToText DoubleColon = "::"
-ipv6TokenToText AllZeros = tok0 -- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1)
-ipv6TokenToText (IPv4Addr a) = a
-
--- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address.
-isIPv6Addr :: [IPv6AddrToken] -> Bool
-isIPv6Addr [] = False
-isIPv6Addr [DoubleColon] = True
-isIPv6Addr [DoubleColon,SixteenBit tok1] = True
-isIPv6Addr tks =
- diffNext tks && (do
- let cdctks = countDoubleColon tks
- let lentks = length tks
- let lasttk = last tks
- let lenconst = (lentks == 15 && cdctks == 0) || (lentks < 15 && cdctks == 1)
- firstValidToken tks &&
- (case countIPv4Addr tks of
- 0 -> case lasttk of
- SixteenBit _ -> lenconst
- DoubleColon -> lenconst
- AllZeros -> lenconst
- _ -> False
- 1 -> case lasttk of
- IPv4Addr _ -> (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)
- _ -> False
- otherwise -> False))
- where diffNext [] = False
- diffNext [_] = True
- diffNext (t:ts) = do
- let h = head ts
- case t of
- SixteenBit _ -> case h of
- SixteenBit _ -> False
- AllZeros -> False
- _ -> diffNext ts
- AllZeros -> case h of
- SixteenBit _ -> False
- AllZeros -> False
- _ -> diffNext ts
- _ -> diffNext ts
- firstValidToken l =
- case head l of
- SixteenBit _ -> True
- DoubleColon -> True
- AllZeros -> True
- _ -> False
- countDoubleColon l = length $ elemIndices DoubleColon l
- tok1 = "1"
-
-countIPv4Addr = foldr oneMoreIPv4Addr 0
- where
- oneMoreIPv4Addr t c = case t of
- IPv4Addr _ -> c + 1
- otherwise -> c
-
--- | This is the main function which returns 'Just' the list of a tokenized IPv6
--- address text representation validated against RFC 4291 and canonized
--- in conformation with RFC 5952, or 'Nothing'.
-maybeTokIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]
-maybeTokIPv6Addr t =
- case maybeIPv6AddrTokens t of
- Just ltks -> if isIPv6Addr ltks
- then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks
- else Nothing
- Nothing -> Nothing
- where
- ipv4AddrReplacement ltks =
- if ipv4AddrRewrite ltks
- then init ltks ++ ipv4AddrToIPv6AddrTokens (last ltks)
- else ltks
-
--- | Returns 'Just' the list of tokenized pure IPv6 address, always rewriting an
--- embedded IPv4 address if present.
-maybeTokPureIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]
-maybeTokPureIPv6Addr t = do
- ltks <- maybeIPv6AddrTokens t
- if isIPv6Addr ltks
- then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks
- else Nothing
- where
- ipv4AddrReplacement ltks' = init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks')
-
--- | Tokenize a 'T.Text' into 'Just' a list of 'IPv6AddrToken', or 'Nothing'.
-maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]
-maybeIPv6AddrTokens s =
- case readText s of
- Done r l -> if r==T.empty then Just l else Nothing
- Fail {} -> Nothing
- where
- readText s = feed (parse (many1 $ ipv4Addr <|> sixteenBit <|> doubleColon <|> colon) s) T.empty
-
--- | An embedded IPv4 address have to be rewritten to output a pure IPv6 Address
--- text representation in hexadecimal digits. But some well-known prefixed IPv6
--- addresses have to keep visible in their text representation the fact that
--- they deals with IPv4 to IPv6 transition process (RFC 5952 Section 5):
---
--- IPv4-compatible IPv6 address like "::1.2.3.4"
---
--- IPv4-mapped IPv6 address like "::ffff:1.2.3.4"
---
--- IPv4-translated address like "::ffff:0:1.2.3.4"
---
--- IPv4-translatable address like "64:ff9b::1.2.3.4"
---
--- ISATAP address like "fe80::5efe:1.2.3.4"
---
-ipv4AddrRewrite :: [IPv6AddrToken] -> Bool
-ipv4AddrRewrite tks =
- case last tks of
- IPv4Addr _ -> do
- let itks = init tks
- not (itks == [DoubleColon]
- || itks == [DoubleColon,SixteenBit tokffff,Colon]
- || itks == [DoubleColon,SixteenBit tokffff,Colon,AllZeros,Colon]
- || itks == [SixteenBit "64",Colon,SixteenBit "ff9b",DoubleColon]
- || [SixteenBit "200",Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks
- || [AllZeros,Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks
- || [DoubleColon,SixteenBit tok5efe,Colon] `isSuffixOf` itks)
- _ -> False
- where
- tokffff = "ffff"
- tok5efe = "5efe"
-
--- | Rewrites an embedded 'IPv4Addr' into the corresponding list of pure 'IPv6Addr' tokens.
---
--- > ipv4AddrToIPv6AddrTokens (IPv4Addr "127.0.0.1") == [SixteenBits "7f0",Colon,SixteenBits "1"]
---
-ipv4AddrToIPv6AddrTokens :: IPv6AddrToken -> [IPv6AddrToken]
-ipv4AddrToIPv6AddrTokens t =
- case t of
- IPv4Addr a -> do
- let m = toHex a
- [ SixteenBit ((!!) m 0 <> addZero ((!!) m 1))
- , Colon
- , SixteenBit ((!!) m 2 <> addZero ((!!) m 3)) ]
- _ -> [t]
- where
- toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a
- addZero d = if T.length d == 1 then tok0 <> d else d
-
-expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]
-expandTokens = map expandToken
- where expandToken (SixteenBit s) = SixteenBit $ T.justifyRight 4 '0' s
- expandToken AllZeros = SixteenBit "0000"
- expandToken t = t
-
-fromDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
-fromDoubleColon tks =
- if DoubleColon `notElem` tks
- then tks
- else do let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks
- let fsts = fst s
- let snds = if not (null (snd s)) then tail(snd s) else []
- let fste = if null fsts then [] else fsts ++ [Colon]
- let snde = if null snds then [] else Colon : snds
- fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace tks) ++ snde
- where
- allZerosTokensReplacement x = intersperse Colon (replicate x AllZeros)
- quantityOfAllZerosTokenToReplace x =
- ntks tks - foldl (\c x -> if (x /= DoubleColon) && (x /= Colon) then c+1 else c) 0 x
- where
- ntks tks = if countIPv4Addr tks == 1 then 7 else 8
-
-toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]
-toDoubleColon tks =
- zerosToDoubleColon tks (zerosRunToReplace $ zerosRunsList tks)
- where
- zerosToDoubleColon :: [IPv6AddrToken] -> (Int,Int) -> [IPv6AddrToken]
- -- No all zeros token, so no double colon replacement...
- zerosToDoubleColon ls (_,0) = ls
- -- "The symbol '::' MUST NOT be used to shorten just one 16-bit 0 field" (RFC 5952 4.2.2)
- zerosToDoubleColon ls (_,1) = ls
- zerosToDoubleColon ls (i,l) =
- let ls' = filter (/= Colon) ls
- in intersperse Colon (Prelude.take i ls') ++ [DoubleColon] ++ intersperse Colon (drop (i+l) ls')
- zerosRunToReplace t =
- let l = longestLengthZerosRun t
- in (firstLongestZerosRunIndex t l,l)
- where
- firstLongestZerosRunIndex x y = sum . snd . unzip $ Prelude.takeWhile (/=(True,y)) x
- longestLengthZerosRun x =
- maximum $ map longest x
- where longest t = case t of
- (True,i) -> i
- _ -> 0
- zerosRunsList x = map helper $ groupZerosRuns x
- where
- helper h = (head h == AllZeros, lh) where lh = length h
- groupZerosRuns = group . filter (/= Colon)
-
-ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr
-ipv6TokensToIPv6Addr l = Just $ IPv6Addr $ ipv6TokensToText l
-
-networkInterfacesIPv6AddrList :: IO [(String,IPv6)]
-networkInterfacesIPv6AddrList =
- getNetworkInterfaces >>= \n -> return $ map networkInterfacesIPv6Addr n
- where
- networkInterfacesIPv6Addr (NetworkInterface n _ a _) = (n,a)
-
-fullSixteenBit :: T.Text -> Maybe IPv6AddrToken
-fullSixteenBit t =
- case parse ipv6AddrFullChunk t of
- Done a b -> if a==T.empty then Just $ SixteenBit $ T.pack b else Nothing
- _ -> Nothing
-
-macAddr :: Parser (Maybe [IPv6AddrToken])
-macAddr = do
- n1 <- count 2 hexaChar <* ":"
- n2 <- count 2 hexaChar <* ":"
- n3 <- count 2 hexaChar <* ":"
- n4 <- count 2 hexaChar <* ":"
- n5 <- count 2 hexaChar <* ":"
- n6 <- count 2 hexaChar
- return $ maybeIPv6AddrTokens $ T.pack $ concat [n1,n2,n3,n4,n5,n6]
-
-sixteenBit :: Parser IPv6AddrToken
-sixteenBit = do
- r <- ipv6AddrFullChunk <|> count 3 hexaChar <|> count 2 hexaChar <|> count 1 hexaChar
- -- "Leading zeros MUST be suppressed" (RFC 5952, 4.1)
- let r' = T.dropWhile (=='0') $ T.pack r
- return $ if T.null r'
- then AllZeros
- -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3)
- else SixteenBit $ T.toLower r'
-
-ipv4Addr :: Parser IPv6AddrToken
-ipv4Addr = do
- n1 <- manyDigits <* "."
- if n1 /= T.empty
- then do n2 <- manyDigits <* "."
- if n2 /= T.empty
- then do n3 <- manyDigits <* "."
- if n3 /= T.empty
- then do n4 <- manyDigits
- if n4 /= T.empty
- then return $ IPv4Addr $ T.intercalate "." [n1,n2,n3,n4]
- else parserFailure
- else parserFailure
- else parserFailure
- else parserFailure
- where
- parserFailure = fail "ipv4Addr parsing failure"
- manyDigits = do
- ds <- takeWhile1 isDigit
- case R.decimal ds of
- Right (n,_) -> return (if n < 256 then T.pack $ show n else T.empty)
- Left _ -> return T.empty
-
-doubleColon :: Parser IPv6AddrToken
-doubleColon = do
- string "::"
- return DoubleColon
-
-colon :: Parser IPv6AddrToken
-colon = do
- string ":"
- return Colon
-
-ipv6AddrFullChunk :: Parser String
-ipv6AddrFullChunk = count 4 hexaChar
-
-hexaChar :: Parser Char
-hexaChar = satisfy (inClass "0-9a-fA-F")
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Simple.hs new/attoparsec-0.13.0.2/tests/QC/Simple.hs
--- old/attoparsec-0.13.0.1/tests/QC/Simple.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/tests/QC/Simple.hs 2016-04-22 02:38:31.000000000 +0200
@@ -10,8 +10,8 @@
import Data.List (foldl')
import Data.Maybe (fromMaybe)
import QC.Rechunked (rechunkBS)
-import Test.Framework (Test)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.Tasty (TestTree)
+import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck (Property, counterexample, forAll)
import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -31,7 +31,7 @@
parse p (x:xs) = foldl' A.feed (A.parse p x) xs
parse p [] = A.parse p ""
-tests :: [Test]
+tests :: [TestTree]
tests = [
testProperty "issue75" t_issue75
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Text/FastSet.hs new/attoparsec-0.13.0.2/tests/QC/Text/FastSet.hs
--- old/attoparsec-0.13.0.1/tests/QC/Text/FastSet.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/attoparsec-0.13.0.2/tests/QC/Text/FastSet.hs 2016-04-22 02:38:31.000000000 +0200
@@ -0,0 +1,15 @@
+module QC.Text.FastSet where
+
+import Test.Tasty (TestTree)
+import Test.Tasty.QuickCheck (testProperty)
+import Test.QuickCheck
+import qualified Data.Attoparsec.Text.FastSet as FastSet
+
+membershipCorrect :: String -> String -> Property
+membershipCorrect members others =
+ let fs = FastSet.fromList members
+ correct c = (c `FastSet.member` fs) == (c `elem` members)
+ in property $ all correct (members ++ others)
+
+tests :: [TestTree]
+tests = [ testProperty "membership is correct" membershipCorrect ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC/Text.hs new/attoparsec-0.13.0.2/tests/QC/Text.hs
--- old/attoparsec-0.13.0.1/tests/QC/Text.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/tests/QC/Text.hs 2016-04-22 02:38:31.000000000 +0200
@@ -8,8 +8,9 @@
import Data.Int (Int64)
import Prelude hiding (take, takeWhile)
import QC.Common (liftOp, parseT)
-import Test.Framework (Test)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
+import qualified QC.Text.FastSet as FastSet
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck
import qualified Data.Attoparsec.Text as P
import qualified Data.Attoparsec.Text.Lazy as PL
@@ -160,7 +161,7 @@
nonmembers s s' = property . not . any (`S.member` set) $ filter (not . (`elem` s)) s'
where set = S.fromList s
-tests :: [Test]
+tests :: [TestTree]
tests = [
testProperty "anyChar" anyChar
, testProperty "asciiCI" asciiCI
@@ -188,4 +189,5 @@
, testProperty "takeWhile1_empty" takeWhile1_empty
, testProperty "members" members
, testProperty "nonmembers" nonmembers
+ , testGroup "FastSet" FastSet.tests
]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/attoparsec-0.13.0.1/tests/QC.hs new/attoparsec-0.13.0.2/tests/QC.hs
--- old/attoparsec-0.13.0.1/tests/QC.hs 2015-07-09 02:08:52.000000000 +0200
+++ new/attoparsec-0.13.0.2/tests/QC.hs 2016-04-22 02:38:31.000000000 +0200
@@ -6,11 +6,11 @@
import qualified QC.Combinator as Combinator
import qualified QC.Simple as Simple
import qualified QC.Text as Text
-import Test.Framework (defaultMain, testGroup)
+import Test.Tasty (defaultMain, testGroup)
main = defaultMain tests
-tests = [
+tests = testGroup "tests" [
testGroup "bs" ByteString.tests
, testGroup "buf" Buffer.tests
, testGroup "combinator" Combinator.tests
