August 2017 - openSUSE Commits - openSUSE Mailing Lists

commit ghc-irc-client for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-irc-client for openSUSE:Factory checked in at 2017-08-31 20:56:46 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-irc-client (Old) and /work/SRC/openSUSE:Factory/.ghc-irc-client.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-irc-client" Thu Aug 31 20:56:46 2017 rev:2 rq:513407 version:0.4.4.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-irc-client/ghc-irc-client.changes 2017-05-16 14:40:26.762829301 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-irc-client.new/ghc-irc-client.changes 2017-08-31 20:56:46.776751604 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:05 UTC 2017 - psimons(a)suse.com + +- Update to version 0.4.4.2. + +------------------------------------------------------------------- Old: ---- irc-client-0.4.4.1.tar.gz New: ---- irc-client-0.4.4.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-irc-client.spec ++++++ --- /var/tmp/diff_new_pack.KqdbV5/_old 2017-08-31 20:56:47.456656075 +0200 +++ /var/tmp/diff_new_pack.KqdbV5/_new 2017-08-31 20:56:47.460655514 +0200 @@ -18,7 +18,7 @@ %global pkg_name irc-client Name: ghc-%{pkg_name} -Version: 0.4.4.1 +Version: 0.4.4.2 Release: 0 Summary: An IRC client library License: MIT ++++++ irc-client-0.4.4.1.tar.gz -> irc-client-0.4.4.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/irc-client-0.4.4.1/irc-client.cabal new/irc-client-0.4.4.2/irc-client.cabal --- old/irc-client-0.4.4.1/irc-client.cabal 2016-10-28 14:41:11.000000000 +0200 +++ new/irc-client-0.4.4.2/irc-client.cabal 2017-07-23 11:19:22.000000000 +0200 @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.4.4.1 +version: 0.4.4.2 -- A short (one-line) description of the package. synopsis: An IRC client library. @@ -97,7 +97,7 @@ , time >=1.4 && <1.7 , tls >=1.3 && <1.4 , transformers >=0.3 && <0.6 - , x509 >=1.6 && <1.7 + , x509 >=1.6 && <1.8 , x509-store >=1.6 && <1.7 , x509-validation >=1.6 && <1.7 @@ -114,4 +114,4 @@ source-repository this type: git location: https://github.com/barrucadu/irc-client.git - tag: 0.4.4.1 + tag: 0.4.4.2

1 0

commit ghc-io-streams for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-io-streams for openSUSE:Factory checked in at 2017-08-31 20:56:44 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-io-streams (Old) and /work/SRC/openSUSE:Factory/.ghc-io-streams.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-io-streams" Thu Aug 31 20:56:44 2017 rev:4 rq:513406 version:1.4.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-io-streams/ghc-io-streams.changes 2017-04-11 09:42:41.382045770 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-io-streams.new/ghc-io-streams.changes 2017-08-31 20:56:45.640911193 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:26 UTC 2017 - psimons(a)suse.com + +- Update to version 1.4.0.0. + +------------------------------------------------------------------- Old: ---- io-streams-1.3.6.1.tar.gz New: ---- io-streams-1.4.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-io-streams.spec ++++++ --- /var/tmp/diff_new_pack.nUZiQ6/_old 2017-08-31 20:56:46.508789254 +0200 +++ /var/tmp/diff_new_pack.nUZiQ6/_new 2017-08-31 20:56:46.508789254 +0200 @@ -19,7 +19,7 @@ %global pkg_name io-streams %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.3.6.1 +Version: 1.4.0.0 Release: 0 Summary: Simple, composable, and easy-to-use stream I/O License: BSD-3-Clause ++++++ io-streams-1.3.6.1.tar.gz -> io-streams-1.4.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/changelog.md new/io-streams-1.4.0.0/changelog.md --- old/io-streams-1.3.6.1/changelog.md 2017-03-24 22:43:21.000000000 +0100 +++ new/io-streams-1.4.0.0/changelog.md 2017-05-09 20:33:10.000000000 +0200 @@ -1,3 +1,9 @@ +# Version 1.4.0.0 + +- Added support for Text with Attoparsec, courtesy Kevin Brubeck Unhammer. Adds + modules `System.IO.Streams.Attoparsec.{ByteString, Text}` and deprecates + `System.IO.Streams.Attoparsec`, which is now a thin wrapper. + # Version 1.3.6.1 - Bumped dependencies on `time` and `process`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/io-streams.cabal new/io-streams-1.4.0.0/io-streams.cabal --- old/io-streams-1.3.6.1/io-streams.cabal 2017-03-24 22:43:21.000000000 +0100 +++ new/io-streams-1.4.0.0/io-streams.cabal 2017-05-09 20:33:10.000000000 +0200 @@ -1,5 +1,5 @@ Name: io-streams -Version: 1.3.6.1 +Version: 1.4.0.0 License: BSD3 License-file: LICENSE Category: Data, Network, IO-Streams @@ -96,6 +96,8 @@ Exposed-modules: System.IO.Streams, System.IO.Streams.Attoparsec, + System.IO.Streams.Attoparsec.ByteString, + System.IO.Streams.Attoparsec.Text, System.IO.Streams.Builder, System.IO.Streams.ByteString, System.IO.Streams.Combinators, @@ -153,7 +155,8 @@ Main-is: TestSuite.hs Default-language: Haskell2010 - Other-modules: System.IO.Streams.Tests.Attoparsec, + Other-modules: System.IO.Streams.Tests.Attoparsec.ByteString, + System.IO.Streams.Tests.Attoparsec.Text, System.IO.Streams.Tests.Builder, System.IO.Streams.Tests.ByteString, System.IO.Streams.Tests.Combinators, @@ -170,7 +173,8 @@ System.IO.Streams.Tests.Vector, System.IO.Streams.Tests.Zlib, System.IO.Streams, - System.IO.Streams.Attoparsec, + System.IO.Streams.Attoparsec.ByteString, + System.IO.Streams.Attoparsec.Text, System.IO.Streams.Builder, System.IO.Streams.ByteString, System.IO.Streams.Combinators, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/src/System/IO/Streams/Attoparsec/ByteString.hs new/io-streams-1.4.0.0/src/System/IO/Streams/Attoparsec/ByteString.hs --- old/io-streams-1.3.6.1/src/System/IO/Streams/Attoparsec/ByteString.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/io-streams-1.4.0.0/src/System/IO/Streams/Attoparsec/ByteString.hs 2017-05-09 20:33:10.000000000 +0200 @@ -0,0 +1,75 @@ +-- | This module provides support for parsing values from ByteString +-- 'InputStream's using @attoparsec@. /Since: 1.4.0.0./ + +module System.IO.Streams.Attoparsec.ByteString + ( -- * Parsing + parseFromStream + , parserToInputStream + , ParseException(..) + ) where + +------------------------------------------------------------------------------ +import Data.Attoparsec.ByteString.Char8 (Parser) +import Data.ByteString (ByteString) +------------------------------------------------------------------------------ +import System.IO.Streams.Internal (InputStream) +import qualified System.IO.Streams.Internal as Streams +import System.IO.Streams.Internal.Attoparsec (ParseData (..), ParseException (..), parseFromStreamInternal) + +------------------------------------------------------------------------------ +-- | Supplies an @attoparsec@ 'Parser' with an 'InputStream', returning the +-- final parsed value or throwing a 'ParseException' if parsing fails. +-- +-- 'parseFromStream' consumes only as much input as necessary to satisfy the +-- 'Parser': any unconsumed input is pushed back onto the 'InputStream'. +-- +-- If the 'Parser' exhausts the 'InputStream', the end-of-stream signal is sent +-- to attoparsec. +-- +-- Example: +-- +-- @ +-- ghci> import "Data.Attoparsec.ByteString.Char8" +-- ghci> is <- 'System.IO.Streams.fromList' [\"12345xxx\" :: 'ByteString'] +-- ghci> 'parseFromStream' ('Data.Attoparsec.ByteString.Char8.takeWhile' 'Data.Attoparsec.ByteString.Char8.isDigit') is +-- \"12345\" +-- ghci> 'System.IO.Streams.read' is +-- Just \"xxx\" +-- @ +parseFromStream :: Parser r + -> InputStream ByteString + -> IO r +parseFromStream = parseFromStreamInternal parse feed + +------------------------------------------------------------------------------ +-- | Given a 'Parser' yielding values of type @'Maybe' r@, transforms an +-- 'InputStream' over byte strings to an 'InputStream' yielding values of type +-- @r@. +-- +-- If the parser yields @Just x@, then @x@ will be passed along downstream, and +-- if the parser yields @Nothing@, that will be interpreted as end-of-stream. +-- +-- Upon a parse error, 'parserToInputStream' will throw a 'ParseException'. +-- +-- Example: +-- +-- @ +-- ghci> import "Control.Applicative" +-- ghci> import "Data.Attoparsec.ByteString.Char8" +-- ghci> is <- 'System.IO.Streams.fromList' [\"1 2 3 4 5\" :: 'ByteString'] +-- ghci> let parser = ('Data.Attoparsec.ByteString.Char8.endOfInput' >> 'Control.Applicative.pure' 'Nothing') \<|\> (Just \<$\> ('Data.Attoparsec.ByteString.Char8.skipWhile' 'Data.Attoparsec.ByteString.Char8.isSpace' *> 'Data.Attoparsec.ByteString.Char8.decimal')) +-- ghci> 'parserToInputStream' parser is >>= 'System.IO.Streams.toList' +-- [1,2,3,4,5] +-- ghci> is' \<- 'System.IO.Streams.fromList' [\"1 2xx3 4 5\" :: 'ByteString'] >>= 'parserToInputStream' parser +-- ghci> 'read' is' +-- Just 1 +-- ghci> 'read' is' +-- Just 2 +-- ghci> 'read' is' +-- *** Exception: Parse exception: Failed reading: takeWhile1 +-- @ +parserToInputStream :: Parser (Maybe r) + -> InputStream ByteString + -> IO (InputStream r) +parserToInputStream = (Streams.makeInputStream .) . parseFromStream +{-# INLINE parserToInputStream #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/src/System/IO/Streams/Attoparsec/Text.hs new/io-streams-1.4.0.0/src/System/IO/Streams/Attoparsec/Text.hs --- old/io-streams-1.3.6.1/src/System/IO/Streams/Attoparsec/Text.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/io-streams-1.4.0.0/src/System/IO/Streams/Attoparsec/Text.hs 2017-05-09 20:33:10.000000000 +0200 @@ -0,0 +1,76 @@ +-- | This module provides support for parsing values from Text +-- 'InputStream's using @attoparsec@. /Since: 1.4.0.0./ + +module System.IO.Streams.Attoparsec.Text + ( -- * Parsing + parseFromStream + , parserToInputStream + , ParseException(..) + ) where + +------------------------------------------------------------------------------ +import Data.Attoparsec.Text (Parser) +import Data.Text (Text) +------------------------------------------------------------------------------ +import System.IO.Streams.Internal (InputStream) +import qualified System.IO.Streams.Internal as Streams +import System.IO.Streams.Internal.Attoparsec (ParseData (..), ParseException (..), parseFromStreamInternal) + + +------------------------------------------------------------------------------ +-- | Supplies an @attoparsec@ 'Parser' with an 'InputStream', returning the +-- final parsed value or throwing a 'ParseException' if parsing fails. +-- +-- 'parseFromStream' consumes only as much input as necessary to satisfy the +-- 'Parser': any unconsumed input is pushed back onto the 'InputStream'. +-- +-- If the 'Parser' exhausts the 'InputStream', the end-of-stream signal is sent +-- to attoparsec. +-- +-- Example: +-- +-- @ +-- ghci> import "Data.Attoparsec.Text" +-- ghci> is <- 'System.IO.Streams.fromList' [\"12345xxx\" :: 'Text'] +-- ghci> 'parseFromStream' ('Data.Attoparsec.Text.takeWhile' 'Data.Char.isDigit') is +-- \"12345\" +-- ghci> 'System.IO.Streams.read' is +-- Just \"xxx\" +-- @ +parseFromStream :: Parser r + -> InputStream Text + -> IO r +parseFromStream = parseFromStreamInternal parse feed + +------------------------------------------------------------------------------ +-- | Given a 'Parser' yielding values of type @'Maybe' r@, transforms an +-- 'InputStream' over byte strings to an 'InputStream' yielding values of type +-- @r@. +-- +-- If the parser yields @Just x@, then @x@ will be passed along downstream, and +-- if the parser yields @Nothing@, that will be interpreted as end-of-stream. +-- +-- Upon a parse error, 'parserToInputStream' will throw a 'ParseException'. +-- +-- Example: +-- +-- @ +-- ghci> import "Control.Applicative" +-- ghci> import "Data.Attoparsec.Text" +-- ghci> is <- 'System.IO.Streams.fromList' [\"1 2 3 4 5\" :: 'Text'] +-- ghci> let parser = ('Data.Attoparsec.Text.endOfInput' >> 'Control.Applicative.pure' 'Nothing') \<|\> (Just \<$\> ('Data.Attoparsec.Text.skipWhile' 'Data.Attoparsec.Text.isSpace' *> 'Data.Attoparsec.Text.decimal')) +-- ghci> 'parserToInputStream' parser is >>= 'System.IO.Streams.toList' +-- [1,2,3,4,5] +-- ghci> is' \<- 'System.IO.Streams.fromList' [\"1 2xx3 4 5\" :: 'Text'] >>= 'parserToInputStream' parser +-- ghci> 'read' is' +-- Just 1 +-- ghci> 'read' is' +-- Just 2 +-- ghci> 'read' is' +-- *** Exception: Parse exception: Failed reading: takeWhile1 +-- @ +parserToInputStream :: Parser (Maybe r) + -> InputStream Text + -> IO (InputStream r) +parserToInputStream = (Streams.makeInputStream .) . parseFromStream +{-# INLINE parserToInputStream #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/src/System/IO/Streams/Attoparsec.hs new/io-streams-1.4.0.0/src/System/IO/Streams/Attoparsec.hs --- old/io-streams-1.3.6.1/src/System/IO/Streams/Attoparsec.hs 2017-03-24 22:43:21.000000000 +0100 +++ new/io-streams-1.4.0.0/src/System/IO/Streams/Attoparsec.hs 2017-05-09 20:33:10.000000000 +0200 @@ -1,5 +1,6 @@ --- | This module provides support for parsing values from 'InputStream's using --- @attoparsec@. +-- | This module is deprecated -- use +-- System.IO.Streams.Attoparsec.ByteString instead (this module simply +-- re-exports that one). module System.IO.Streams.Attoparsec ( -- * Parsing @@ -9,4 +10,4 @@ ) where ------------------------------------------------------------------------------ -import System.IO.Streams.Internal.Attoparsec (ParseException (..), parseFromStream, parserToInputStream) +import System.IO.Streams.Attoparsec.ByteString (ParseException (..), parseFromStream, parserToInputStream) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/src/System/IO/Streams/Internal/Attoparsec.hs new/io-streams-1.4.0.0/src/System/IO/Streams/Internal/Attoparsec.hs --- old/io-streams-1.3.6.1/src/System/IO/Streams/Internal/Attoparsec.hs 2017-03-24 22:43:21.000000000 +0100 +++ new/io-streams-1.4.0.0/src/System/IO/Streams/Internal/Attoparsec.hs 2017-05-09 20:33:10.000000000 +0200 @@ -8,9 +8,9 @@ module System.IO.Streams.Internal.Attoparsec ( -- * Parsing - parseFromStream - , parseFromStreamInternal - , parserToInputStream + parseFromStreamInternal + + , ParseData(..) -- * Parse Exceptions , ParseException(..) @@ -20,14 +20,16 @@ ------------------------------------------------------------------------------ import Control.Exception (Exception, throwIO) -import Control.Monad (when) -import Data.Attoparsec.ByteString.Char8 (Parser, Result, feed, parse) -import Data.Attoparsec.Types (IResult (..)) -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as S +import Control.Monad (unless) +import qualified Data.Attoparsec.ByteString.Char8 as S +import qualified Data.Attoparsec.Text as T +import Data.Attoparsec.Types (IResult (..), Parser) +import qualified Data.ByteString as S import Data.List (intercalate) +import Data.String (IsString) +import qualified Data.Text as T import Data.Typeable (Typeable) -import Prelude hiding (read) +import Prelude hiding (null, read) ------------------------------------------------------------------------------ import System.IO.Streams.Internal (InputStream) import qualified System.IO.Streams.Internal as Streams @@ -45,48 +47,43 @@ ------------------------------------------------------------------------------ --- | Supplies an @attoparsec@ 'Parser' with an 'InputStream', returning the --- final parsed value or throwing a 'ParseException' if parsing fails. --- --- 'parseFromStream' consumes only as much input as necessary to satisfy the --- 'Parser': any unconsumed input is pushed back onto the 'InputStream'. --- --- If the 'Parser' exhausts the 'InputStream', the end-of-stream signal is sent --- to attoparsec. --- --- Example: --- --- @ --- ghci> import "Data.Attoparsec.ByteString.Char8" --- ghci> is <- 'System.IO.Streams.fromList' [\"12345xxx\" :: 'ByteString'] --- ghci> 'parseFromStream' ('Data.Attoparsec.ByteString.Char8.takeWhile' 'Data.Attoparsec.ByteString.Char8.isDigit') is --- \"12345\" --- ghci> 'System.IO.Streams.read' is --- Just \"xxx\" --- @ -parseFromStream :: Parser r - -> InputStream ByteString - -> IO r -parseFromStream = parseFromStreamInternal parse feed -{-# INLINE parseFromStream #-} +class (IsString i) => ParseData i where + parse :: Parser i a -> i -> IResult i a + feed :: IResult i r -> i -> IResult i r + null :: i -> Bool + + +------------------------------------------------------------------------------ +instance ParseData S.ByteString where + parse = S.parse + feed = S.feed + null = S.null + + +------------------------------------------------------------------------------ +instance ParseData T.Text where + parse = T.parse + feed = T.feed + null = T.null ------------------------------------------------------------------------------ -- | Internal version of parseFromStream allowing dependency injection of the -- parse functions for testing. -parseFromStreamInternal :: (Parser r -> ByteString -> Result r) - -> (Result r -> ByteString -> Result r) - -> Parser r - -> InputStream ByteString +parseFromStreamInternal :: ParseData i + => (Parser i r -> i -> IResult i r) + -> (IResult i r -> i -> IResult i r) + -> Parser i r + -> InputStream i -> IO r parseFromStreamInternal parseFunc feedFunc parser is = Streams.read is >>= maybe (finish $ parseFunc parser "") - (\s -> if S.null s + (\s -> if null s then parseFromStreamInternal parseFunc feedFunc parser is else go $! parseFunc parser s) where - leftover x = when (not $ S.null x) $ Streams.unRead x is + leftover x = unless (null x) $ Streams.unRead x is finish k = let k' = feedFunc (feedFunc k "") "" in case k' of @@ -104,49 +101,15 @@ go (Done x r) = leftover x >> return r go r = Streams.read is >>= maybe (finish r) - (\s -> if S.null s + (\s -> if null s then go r else go $! feedFunc r s) ------------------------------------------------------------------------------ --- | Given a 'Parser' yielding values of type @'Maybe' r@, transforms an --- 'InputStream' over byte strings to an 'InputStream' yielding values of type --- @r@. --- --- If the parser yields @Just x@, then @x@ will be passed along downstream, and --- if the parser yields @Nothing@, that will be interpreted as end-of-stream. --- --- Upon a parse error, 'parserToInputStream' will throw a 'ParseException'. --- --- Example: --- --- @ --- ghci> import "Control.Applicative" --- ghci> import "Data.Attoparsec.ByteString.Char8" --- ghci> is <- 'System.IO.Streams.fromList' [\"1 2 3 4 5\" :: 'ByteString'] --- ghci> let parser = ('Data.Attoparsec.ByteString.Char8.endOfInput' >> 'Control.Applicative.pure' 'Nothing') \<|\> (Just \<$\> ('Data.Attoparsec.ByteString.Char8.skipWhile' 'Data.Attoparsec.ByteString.Char8.isSpace' *> 'Data.Attoparsec.ByteString.Char8.decimal')) --- ghci> 'parserToInputStream' parser is >>= 'System.IO.Streams.toList' --- [1,2,3,4,5] --- ghci> is' \<- 'System.IO.Streams.fromList' [\"1 2xx3 4 5\" :: 'ByteString'] >>= 'parserToInputStream' parser --- ghci> 'read' is' --- Just 1 --- ghci> 'read' is' --- Just 2 --- ghci> 'read' is' --- *** Exception: Parse exception: Failed reading: takeWhile1 --- @ -parserToInputStream :: Parser (Maybe r) - -> InputStream ByteString - -> IO (InputStream r) -parserToInputStream = (Streams.makeInputStream .) . parseFromStream -{-# INLINE parserToInputStream #-} - - ------------------------------------------------------------------------------- -- A replacement for attoparsec's 'eitherResult', which discards information -- about the context of the failed parse. -eitherResult :: Result r -> Either (ByteString, [String], String) r +eitherResult :: IsString i => IResult i r -> Either (i, [String], String) r eitherResult (Done _ r) = Right r eitherResult (Fail residual ctx msg) = Left (residual, ctx, msg) eitherResult _ = Left ("", [], "Result: incomplete input") diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/test/System/IO/Streams/Tests/Attoparsec/ByteString.hs new/io-streams-1.4.0.0/test/System/IO/Streams/Tests/Attoparsec/ByteString.hs --- old/io-streams-1.3.6.1/test/System/IO/Streams/Tests/Attoparsec/ByteString.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/io-streams-1.4.0.0/test/System/IO/Streams/Tests/Attoparsec/ByteString.hs 2017-05-09 20:33:10.000000000 +0200 @@ -0,0 +1,113 @@ +{-# LANGUAGE OverloadedStrings #-} + +module System.IO.Streams.Tests.Attoparsec.ByteString (tests) where + +------------------------------------------------------------------------------ +import Control.Monad +import Data.Attoparsec.ByteString.Char8 hiding (eitherResult) +import Data.ByteString.Char8 (ByteString) +import Prelude hiding (takeWhile) +import System.IO.Streams +import System.IO.Streams.Attoparsec.ByteString +import System.IO.Streams.Internal.Attoparsec (eitherResult, parseFromStreamInternal) +import System.IO.Streams.Tests.Common +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) +------------------------------------------------------------------------------ + +tests :: [Test] +tests = [ testParseFromStream + , testParseFromStreamError + , testParseFromStreamError2 + , testPartialParse + , testEmbeddedNull + , testTrivials + ] + + +------------------------------------------------------------------------------ +testParser :: Parser (Maybe Int) +testParser = do + end <- atEnd + if end + then return Nothing + else do + _ <- takeWhile (\c -> isSpace c || c == ',') + liftM Just decimal + + +------------------------------------------------------------------------------ +testParser2 :: Parser (Maybe ByteString) +testParser2 = do + end <- atEnd + if end + then return Nothing + else liftM Just $ string "bork" + + +------------------------------------------------------------------------------ +testParseFromStream :: Test +testParseFromStream = testCase "attoparsec/parseFromStream" $ do + is <- fromList ["1", "23", ", 4", ", 5, 6, 7"] + x0 <- parseFromStream testParser is + + assertEqual "first parse" (Just 123) x0 + + l <- parserToInputStream testParser is >>= toList + + assertEqual "rest" [4, 5, 6, 7] l + toList is >>= assertEqual "double eof" [] + + +------------------------------------------------------------------------------ +testParseFromStreamError :: Test +testParseFromStreamError = testCase "attoparsec/parseFromStreamError" $ do + is <- fromList ["1", "23", ", 4", ",xxxx 5, 6, 7"] >>= + parserToInputStream testParser + + expectExceptionH $ toList is + + +------------------------------------------------------------------------------ +testParseFromStreamError2 :: Test +testParseFromStreamError2 = testCase "attoparsec/parseFromStreamError2" $ do + l <- fromList ["borkbork", "bork"] >>= p + assertEqual "ok" ["bork", "bork", "bork"] l + + expectExceptionH $ fromList ["bork", "bo"] >>= p + expectExceptionH $ fromList ["xxxxx"] >>= p + + where + p = parserToInputStream ((testParser2 <?> "foo") <?> "bar") >=> toList + + +------------------------------------------------------------------------------ +testPartialParse :: Test +testPartialParse = testCase "attoparsec/partialParse" $ do + is <- fromList ["1,", "2,", "3"] + expectExceptionH $ parseFromStreamInternal parseFunc feedFunc testParser is + + where + result = Partial (const result) + parseFunc = const $ const $ result + feedFunc = const $ const $ result + +------------------------------------------------------------------------------ +testTrivials :: Test +testTrivials = testCase "attoparsec/trivials" $ do + coverTypeableInstance (undefined :: ParseException) + let (Right x) = eitherResult $ Done undefined 4 :: Either (ByteString, [String], String) Int + assertEqual "eitherResult" 4 x + +------------------------------------------------------------------------------ +testEmbeddedNull :: Test +testEmbeddedNull = testCase "attoparsec/embeddedNull" $ do + is <- fromList ["", "1", "23", "", ", 4", ", 5, 6, 7"] + x0 <- parseFromStream testParser is + + assertEqual "first parse" (Just 123) x0 + + l <- parserToInputStream testParser is >>= toList + + assertEqual "rest" [4, 5, 6, 7] l diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/test/System/IO/Streams/Tests/Attoparsec/Text.hs new/io-streams-1.4.0.0/test/System/IO/Streams/Tests/Attoparsec/Text.hs --- old/io-streams-1.3.6.1/test/System/IO/Streams/Tests/Attoparsec/Text.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/io-streams-1.4.0.0/test/System/IO/Streams/Tests/Attoparsec/Text.hs 2017-05-09 20:33:10.000000000 +0200 @@ -0,0 +1,140 @@ +{-# LANGUAGE OverloadedStrings #-} + +module System.IO.Streams.Tests.Attoparsec.Text (tests, testParserU) where + +------------------------------------------------------------------------------ +import Control.Monad +import Data.Attoparsec.Text hiding (eitherResult) +import Data.Char (isAlpha, isSpace) +import Data.Text (Text) +import Prelude hiding (takeWhile) +import System.IO.Streams +import System.IO.Streams.Attoparsec.Text +import System.IO.Streams.Internal.Attoparsec (eitherResult, parseFromStreamInternal) +import System.IO.Streams.Tests.Common +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) +------------------------------------------------------------------------------ + +tests :: [Test] +tests = [ testParseFromStream + , testParseFromStreamError + , testParseFromStreamError2 + , testPartialParse + , testEmbeddedNull + , testTrivials + , testParseFromStreamU + ] + + +------------------------------------------------------------------------------ +testParser :: Parser (Maybe Int) +testParser = do + end <- atEnd + if end + then return Nothing + else do + _ <- takeWhile (\c -> isSpace c || c == ',') + liftM Just decimal + + +------------------------------------------------------------------------------ +testParser2 :: Parser (Maybe Text) +testParser2 = do + end <- atEnd + if end + then return Nothing + else liftM Just $ string "bork" + + +------------------------------------------------------------------------------ +testParserU :: Parser (Maybe Text) +testParserU = do + end <- atEnd + if end + then return Nothing + else do + _ <- takeWhile (not . isAlpha) + liftM Just (takeWhile isAlpha) + + +------------------------------------------------------------------------------ +testParseFromStream :: Test +testParseFromStream = testCase "attoparsec/parseFromStream" $ do + is <- fromList ["1", "23", ", 4", ", 5, 6, 7"] + x0 <- parseFromStream testParser is + + assertEqual "first parse" (Just 123) x0 + + l <- parserToInputStream testParser is >>= toList + + assertEqual "rest" [4, 5, 6, 7] l + toList is >>= assertEqual "double eof" [] + + +------------------------------------------------------------------------------ +testParseFromStreamError :: Test +testParseFromStreamError = testCase "attoparsec/parseFromStreamError" $ do + is <- fromList ["1", "23", ", 4", ",xxxx 5, 6, 7"] >>= + parserToInputStream testParser + + expectExceptionH $ toList is + + +------------------------------------------------------------------------------ +testParseFromStreamError2 :: Test +testParseFromStreamError2 = testCase "attoparsec/parseFromStreamError2" $ do + l <- fromList ["borkbork", "bork"] >>= p + assertEqual "ok" ["bork", "bork", "bork"] l + + expectExceptionH $ fromList ["bork", "bo"] >>= p + expectExceptionH $ fromList ["xxxxx"] >>= p + + where + p = parserToInputStream ((testParser2 <?> "foo") <?> "bar") >=> toList + + +------------------------------------------------------------------------------ +testPartialParse :: Test +testPartialParse = testCase "attoparsec/partialParse" $ do + is <- fromList ["1,", "2,", "3"] + expectExceptionH $ parseFromStreamInternal parseFunc feedFunc testParser is + + where + result = Partial (const result) + parseFunc = const $ const $ result + feedFunc = const $ const $ result + +------------------------------------------------------------------------------ +testTrivials :: Test +testTrivials = testCase "attoparsec/trivials" $ do + coverTypeableInstance (undefined :: ParseException) + let (Right x) = eitherResult $ Done undefined 4 :: Either (Text, [String], String) Int + assertEqual "eitherResult" 4 x + +------------------------------------------------------------------------------ +testEmbeddedNull :: Test +testEmbeddedNull = testCase "attoparsec/embeddedNull" $ do + is <- fromList ["", "1", "23", "", ", 4", ", 5, 6, 7"] + x0 <- parseFromStream testParser is + + assertEqual "first parse" (Just 123) x0 + + l <- parserToInputStream testParser is >>= toList + + assertEqual "rest" [4, 5, 6, 7] l + +------------------------------------------------------------------------------ +testParseFromStreamU :: Test +testParseFromStreamU = testCase "attoparsec/parseFromStreamU" $ do + is <- fromList ["123æø", "å", "💻⛇⛄☃Š", "š5ŧđ6naå7"] + x0 <- parseFromStream testParserU is + + assertEqual "first parse" (Just "æøå") x0 + + l <- parserToInputStream testParserU is >>= toList + + assertEqual "rest" ["Šš", "ŧđ", "naå", ""] l + toList is >>= assertEqual "double eof" [] + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/test/System/IO/Streams/Tests/Attoparsec.hs new/io-streams-1.4.0.0/test/System/IO/Streams/Tests/Attoparsec.hs --- old/io-streams-1.3.6.1/test/System/IO/Streams/Tests/Attoparsec.hs 2017-03-24 22:43:21.000000000 +0100 +++ new/io-streams-1.4.0.0/test/System/IO/Streams/Tests/Attoparsec.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,112 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module System.IO.Streams.Tests.Attoparsec (tests) where - ------------------------------------------------------------------------------- -import Control.Monad -import Data.Attoparsec.ByteString.Char8 hiding (eitherResult) -import Data.ByteString.Char8 (ByteString) -import Prelude hiding (takeWhile) -import System.IO.Streams -import System.IO.Streams.Internal.Attoparsec -import System.IO.Streams.Tests.Common -import Test.Framework -import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test) ------------------------------------------------------------------------------- - -tests :: [Test] -tests = [ testParseFromStream - , testParseFromStreamError - , testParseFromStreamError2 - , testPartialParse - , testEmbeddedNull - , testTrivials - ] - - ------------------------------------------------------------------------------- -testParser :: Parser (Maybe Int) -testParser = do - end <- atEnd - if end - then return Nothing - else do - _ <- takeWhile (\c -> isSpace c || c == ',') - liftM Just decimal - - ------------------------------------------------------------------------------- -testParser2 :: Parser (Maybe ByteString) -testParser2 = do - end <- atEnd - if end - then return Nothing - else liftM Just $ string "bork" - - ------------------------------------------------------------------------------- -testParseFromStream :: Test -testParseFromStream = testCase "attoparsec/parseFromStream" $ do - is <- fromList ["1", "23", ", 4", ", 5, 6, 7"] - x0 <- parseFromStream testParser is - - assertEqual "first parse" (Just 123) x0 - - l <- parserToInputStream testParser is >>= toList - - assertEqual "rest" [4, 5, 6, 7] l - toList is >>= assertEqual "double eof" [] - - ------------------------------------------------------------------------------- -testParseFromStreamError :: Test -testParseFromStreamError = testCase "attoparsec/parseFromStreamError" $ do - is <- fromList ["1", "23", ", 4", ",xxxx 5, 6, 7"] >>= - parserToInputStream testParser - - expectExceptionH $ toList is - - ------------------------------------------------------------------------------- -testParseFromStreamError2 :: Test -testParseFromStreamError2 = testCase "attoparsec/parseFromStreamError2" $ do - l <- fromList ["borkbork", "bork"] >>= p - assertEqual "ok" ["bork", "bork", "bork"] l - - expectExceptionH $ fromList ["bork", "bo"] >>= p - expectExceptionH $ fromList ["xxxxx"] >>= p - - where - p = parserToInputStream ((testParser2 <?> "foo") <?> "bar") >=> toList - - ------------------------------------------------------------------------------- -testPartialParse :: Test -testPartialParse = testCase "attoparsec/partialParse" $ do - is <- fromList ["1,", "2,", "3"] - expectExceptionH $ parseFromStreamInternal parseFunc feedFunc testParser is - - where - result = Partial (const result) - parseFunc = const $ const $ result - feedFunc = const $ const $ result - ------------------------------------------------------------------------------- -testTrivials :: Test -testTrivials = testCase "attoparsec/trivials" $ do - coverTypeableInstance (undefined :: ParseException) - let (Right x) = eitherResult $ Done undefined (4 :: Int) - assertEqual "eitherResult" 4 x - ------------------------------------------------------------------------------- -testEmbeddedNull :: Test -testEmbeddedNull = testCase "attoparsec/embeddedNull" $ do - is <- fromList ["", "1", "23", "", ", 4", ", 5, 6, 7"] - x0 <- parseFromStream testParser is - - assertEqual "first parse" (Just 123) x0 - - l <- parserToInputStream testParser is >>= toList - - assertEqual "rest" [4, 5, 6, 7] l diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/io-streams-1.3.6.1/test/TestSuite.hs new/io-streams-1.4.0.0/test/TestSuite.hs --- old/io-streams-1.3.6.1/test/TestSuite.hs 2017-03-24 22:43:21.000000000 +0100 +++ new/io-streams-1.4.0.0/test/TestSuite.hs 2017-05-09 20:33:10.000000000 +0200 @@ -1,28 +1,30 @@ module Main where -import qualified System.IO.Streams.Tests.Attoparsec as Attoparsec -import qualified System.IO.Streams.Tests.Builder as Builder -import qualified System.IO.Streams.Tests.ByteString as ByteString -import qualified System.IO.Streams.Tests.Combinators as Combinators -import qualified System.IO.Streams.Tests.Concurrent as Concurrent -import qualified System.IO.Streams.Tests.Debug as Debug -import qualified System.IO.Streams.Tests.File as File -import qualified System.IO.Streams.Tests.Handle as Handle -import qualified System.IO.Streams.Tests.Internal as Internal -import qualified System.IO.Streams.Tests.List as List -import qualified System.IO.Streams.Tests.Network as Network -import qualified System.IO.Streams.Tests.Process as Process -import qualified System.IO.Streams.Tests.Text as Text -import qualified System.IO.Streams.Tests.Vector as Vector -import qualified System.IO.Streams.Tests.Zlib as Zlib -import Test.Framework (defaultMain, testGroup) +import qualified System.IO.Streams.Tests.Attoparsec.ByteString as AttoparsecByteString +import qualified System.IO.Streams.Tests.Attoparsec.Text as AttoparsecText +import qualified System.IO.Streams.Tests.Builder as Builder +import qualified System.IO.Streams.Tests.ByteString as ByteString +import qualified System.IO.Streams.Tests.Combinators as Combinators +import qualified System.IO.Streams.Tests.Concurrent as Concurrent +import qualified System.IO.Streams.Tests.Debug as Debug +import qualified System.IO.Streams.Tests.File as File +import qualified System.IO.Streams.Tests.Handle as Handle +import qualified System.IO.Streams.Tests.Internal as Internal +import qualified System.IO.Streams.Tests.List as List +import qualified System.IO.Streams.Tests.Network as Network +import qualified System.IO.Streams.Tests.Process as Process +import qualified System.IO.Streams.Tests.Text as Text +import qualified System.IO.Streams.Tests.Vector as Vector +import qualified System.IO.Streams.Tests.Zlib as Zlib +import Test.Framework (defaultMain, testGroup) ------------------------------------------------------------------------------ main :: IO () main = defaultMain tests where - tests = [ testGroup "Tests.Attoparsec" Attoparsec.tests + tests = [ testGroup "Tests.Attoparsec.ByteString" AttoparsecByteString.tests + , testGroup "Tests.Attoparsec.Text" AttoparsecText.tests , testGroup "Tests.Builder" Builder.tests , testGroup "Tests.ByteString" ByteString.tests , testGroup "Tests.Debug" Debug.tests

1 0

commit ghc-intro for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-intro for openSUSE:Factory checked in at 2017-08-31 20:56:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-intro (Old) and /work/SRC/openSUSE:Factory/.ghc-intro.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-intro" Thu Aug 31 20:56:42 2017 rev:3 rq:513405 version:0.3.0.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-intro/ghc-intro.changes 2017-05-03 15:56:11.320708681 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-intro.new/ghc-intro.changes 2017-08-31 20:56:43.401225877 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:03:05 UTC 2017 - psimons(a)suse.com + +- Update to version 0.3.0.1. + +------------------------------------------------------------------- Old: ---- intro-0.1.0.10.tar.gz New: ---- intro-0.3.0.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-intro.spec ++++++ --- /var/tmp/diff_new_pack.Eb4SrP/_old 2017-08-31 20:56:44.201113490 +0200 +++ /var/tmp/diff_new_pack.Eb4SrP/_new 2017-08-31 20:56:44.205112928 +0200 @@ -19,7 +19,7 @@ %global pkg_name intro %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.0.10 +Version: 0.3.0.1 Release: 0 Summary: "Fixed Prelude" - Mostly total and safe, provides Text and Monad transformers License: MIT @@ -38,14 +38,13 @@ BuildRequires: ghc-mtl-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-safe-devel -BuildRequires: ghc-string-conversions-devel -BuildRequires: ghc-tagged-devel BuildRequires: ghc-text-devel BuildRequires: ghc-transformers-devel BuildRequires: ghc-unordered-containers-devel BuildRequires: ghc-writer-cps-mtl-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} +BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-lens-devel %endif ++++++ intro-0.1.0.10.tar.gz -> intro-0.3.0.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/intro-0.1.0.10/LICENSE new/intro-0.3.0.1/LICENSE --- old/intro-0.1.0.10/LICENSE 2017-02-04 15:07:23.000000000 +0100 +++ new/intro-0.3.0.1/LICENSE 2017-03-07 03:08:15.000000000 +0100 @@ -1,6 +1,6 @@ The MIT License (MIT) -Copyright (c) 2016 Daniel Mendler +Copyright (c) 2016-2017 Daniel Mendler Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/intro-0.1.0.10/README.md new/intro-0.3.0.1/README.md --- old/intro-0.1.0.10/README.md 2017-02-14 16:42:53.000000000 +0100 +++ new/intro-0.3.0.1/README.md 2017-04-05 10:15:15.000000000 +0200 @@ -15,16 +15,16 @@ List of design decisions: -* Keep everything at one place (There are one two modules and Intro.Trustworthy is only there for Safe Haskell) +* Keep everything at one place (There are three modules and Intro.Trustworthy is only there for Safe Haskell) * Conservative extension over the base Prelude * Rely only on very common external libraries * Avoid writing custom functions * Export everything explicitly to provide a stable interface and for good documentation * Export only total functions or provide safe alternatives (Very few exceptions like div etc.) -* Prefer Text over String, provide ConvertibleStrings +* Prefer Text over String, provide ConvertString and EncodeString * Provide Monad transformers * Provide container types * Prefer generic functions * Debugging functions, like 'Intro.Trustworthy.trace' and 'undefined' are available but produce compile time warnings * Don't provide error, only panic instead -* Compatibility with Control.Lens +* Compatibility with unqualified import of Control.Lens diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/intro-0.1.0.10/intro.cabal new/intro-0.3.0.1/intro.cabal --- old/intro-0.1.0.10/intro.cabal 2017-03-03 06:18:06.000000000 +0100 +++ new/intro-0.3.0.1/intro.cabal 2017-06-18 10:57:22.000000000 +0200 @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.15.0. +-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: intro -version: 0.1.0.10 +version: 0.3.0.1 synopsis: "Fixed Prelude" - Mostly total and safe, provides Text and Monad transformers description: Intro is a modern Prelude which provides safe alternatives for most of the partial functions and follows other @@ -22,10 +22,10 @@ bug-reports: https://github.com/minad/intro/issues author: Daniel Mendler <mail(a)daniel-mendler.de> maintainer: Daniel Mendler <mail(a)daniel-mendler.de> -copyright: 2016 Daniel Mendler +copyright: 2016-2017 Daniel Mendler license: MIT license-file: LICENSE -tested-with: GHC == 7.10.3, GHC == 8.0.1 +tested-with: GHC == 7.10.3, GHC == 8.0.1, GHC == 8.2.1 build-type: Simple cabal-version: >= 1.10 @@ -42,18 +42,15 @@ ghc-options: -Wall build-depends: base >= 4.8 && < 5.0 - , bifunctors >= 5.2 && < 5.5 , binary >= 0.7 && < 0.9 , bytestring >= 0.9 && < 0.11 , containers >= 0.5 && < 0.6 , deepseq >= 1.4 && < 1.5 , dlist >= 0.7 && < 0.9 - , extra >= 1.5.1 && < 1.6 + , extra >= 1.5.1 && < 1.7 , hashable >= 1.2.5 && < 1.3 , mtl >= 2.2 && < 2.3 , safe >= 0.3.11 && < 0.4 - , string-conversions >= 0.4 && < 0.5 - , tagged >= 0.8 && < 0.9 , text >= 0.7 && < 1.3 , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2 && < 0.3 @@ -61,42 +58,47 @@ if impl(ghc < 8.0) build-depends: semigroups >= 0.9 && < 1 + if impl(ghc < 8.1) + build-depends: + bifunctors >= 5.2 && < 5.5 exposed-modules: Intro other-modules: + Intro.ConvertString Intro.Trustworthy Paths_intro default-language: Haskell2010 -test-suite compat +test-suite test type: exitcode-stdio-1.0 - main-is: compat.hs + main-is: test.hs hs-source-dirs: test ghc-options: -Wall build-depends: base >= 4.8 && < 5.0 - , bifunctors >= 5.2 && < 5.5 , binary >= 0.7 && < 0.9 , bytestring >= 0.9 && < 0.11 , containers >= 0.5 && < 0.6 , deepseq >= 1.4 && < 1.5 , dlist >= 0.7 && < 0.9 - , extra >= 1.5.1 && < 1.6 + , extra >= 1.5.1 && < 1.7 , hashable >= 1.2.5 && < 1.3 , mtl >= 2.2 && < 2.3 , safe >= 0.3.11 && < 0.4 - , string-conversions >= 0.4 && < 0.5 - , tagged >= 0.8 && < 0.9 , text >= 0.7 && < 1.3 , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2 && < 0.3 , writer-cps-mtl >= 0.1.1.2 && < 0.2 , intro + , QuickCheck , lens if impl(ghc < 8.0) build-depends: semigroups >= 0.9 && < 1 + if impl(ghc < 8.1) + build-depends: + bifunctors >= 5.2 && < 5.5 other-modules: BaseCompat LensCompat diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/intro-0.1.0.10/src/Intro/ConvertString.hs new/intro-0.3.0.1/src/Intro/ConvertString.hs --- old/intro-0.1.0.10/src/Intro/ConvertString.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/intro-0.3.0.1/src/Intro/ConvertString.hs 2017-03-22 16:48:46.000000000 +0100 @@ -0,0 +1,176 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Intro.ConvertString +-- Copyright : (c) Daniel Mendler 2017 +-- License : MIT +-- +-- Maintainer : mail(a)daniel-mendler.de +-- Stability : experimental +-- Portability : portable +-- +-- String conversion and decoding +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE Safe #-} + +module Intro.ConvertString ( + ConvertString(..) + , EncodeString(..) + , Lenient(..) +) where + +import Control.DeepSeq (NFData) +import Data.Binary (Binary) +import Data.ByteString (ByteString) +import Data.ByteString.Short (ShortByteString) +import Data.Either.Extra (eitherToMaybe) +import Data.Eq (Eq) +import Data.Foldable (Foldable) +import Data.Function (id, (.)) +import Data.Functor (Functor(fmap)) +import Data.Maybe (Maybe) +import Data.Ord (Ord) +import Data.String (String) +import Data.Text (Text) +import Data.Text.Encoding.Error (lenientDecode) +import Data.Traversable (Traversable) +import Data.Word (Word8) +import GHC.Generics (Generic, Generic1) +import Text.Read (Read) +import Text.Show (Show) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Short as S +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE + +-- | Conversion of strings to other string types +-- +-- @ +-- ('convertString' :: b -> a) . ('convertString' :: a -> b) ≡ ('id' :: a -> a) +-- ('convertString' :: b -> 'Maybe' a) . ('convertString' :: a -> b) ≡ ('Just' :: a -> 'Maybe' a) +-- ('convertString' :: b -> 'Lenient' a) . ('convertString' :: a -> b) ≡ ('Lenient' :: a -> 'Lenient' a) +-- @ +class ConvertString a b where + -- | Convert a string to another string type + convertString :: a -> b + +-- | Encode and decode strings as a byte sequence +-- +-- @ +-- 'decodeString' . 'encodeString' ≡ 'Just' +-- 'decodeStringLenient' . 'encodeString' ≡ 'id' +-- @ +class (ConvertString a b, ConvertString b (Maybe a), ConvertString b (Lenient a)) => EncodeString a b where + -- | Encode a string as a byte sequence + encodeString :: a -> b + encodeString = convertString + {-# INLINE encodeString #-} + + -- | Lenient decoding of byte sequence + -- + -- Lenient means that invalid characters are replaced + -- by the Unicode replacement character '\FFFD'. + decodeStringLenient :: b -> a + decodeStringLenient = getLenient . convertString + {-# INLINE decodeStringLenient #-} + + -- | Decode byte sequence + -- + -- If the decoding fails, return Nothing. + decodeString :: b -> Maybe a + decodeString = convertString + {-# INLINE decodeString #-} + +-- | Newtype wrapper for a string which was decoded leniently. +newtype Lenient a = Lenient { getLenient :: a } + deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable, Generic, Generic1) + +instance Binary a => Binary (Lenient a) +instance NFData a => NFData (Lenient a) + +instance ConvertString BL.ByteString (Lenient String) where {-# INLINE convertString #-}; convertString = Lenient . TL.unpack . TLE.decodeUtf8With lenientDecode +instance ConvertString BL.ByteString (Lenient TL.Text) where {-# INLINE convertString #-}; convertString = Lenient . TLE.decodeUtf8With lenientDecode +instance ConvertString BL.ByteString (Lenient Text) where {-# INLINE convertString #-}; convertString = Lenient . TE.decodeUtf8With lenientDecode . BL.toStrict +instance ConvertString BL.ByteString (Maybe String) where {-# INLINE convertString #-}; convertString = fmap TL.unpack . eitherToMaybe . TLE.decodeUtf8' +instance ConvertString BL.ByteString (Maybe TL.Text) where {-# INLINE convertString #-}; convertString = eitherToMaybe . TLE.decodeUtf8' +instance ConvertString BL.ByteString (Maybe Text) where {-# INLINE convertString #-}; convertString = eitherToMaybe . TE.decodeUtf8' . BL.toStrict +instance ConvertString BL.ByteString BL.ByteString where {-# INLINE convertString #-}; convertString = id +instance ConvertString BL.ByteString ByteString where {-# INLINE convertString #-}; convertString = BL.toStrict +instance ConvertString BL.ByteString ShortByteString where {-# INLINE convertString #-}; convertString = S.toShort . BL.toStrict +instance ConvertString BL.ByteString [Word8] where {-# INLINE convertString #-}; convertString = BL.unpack +instance ConvertString ByteString (Lenient String) where {-# INLINE convertString #-}; convertString = Lenient . T.unpack . TE.decodeUtf8With lenientDecode +instance ConvertString ByteString (Lenient TL.Text) where {-# INLINE convertString #-}; convertString = Lenient . TLE.decodeUtf8With lenientDecode . BL.fromStrict +instance ConvertString ByteString (Lenient Text) where {-# INLINE convertString #-}; convertString = Lenient . TE.decodeUtf8With lenientDecode +instance ConvertString ByteString (Maybe String) where {-# INLINE convertString #-}; convertString = fmap T.unpack . eitherToMaybe . TE.decodeUtf8' +instance ConvertString ByteString (Maybe TL.Text) where {-# INLINE convertString #-}; convertString = eitherToMaybe . TLE.decodeUtf8' . BL.fromStrict +instance ConvertString ByteString (Maybe Text) where {-# INLINE convertString #-}; convertString = eitherToMaybe . TE.decodeUtf8' +instance ConvertString ByteString BL.ByteString where {-# INLINE convertString #-}; convertString = BL.fromStrict +instance ConvertString ByteString ByteString where {-# INLINE convertString #-}; convertString = id +instance ConvertString ByteString ShortByteString where {-# INLINE convertString #-}; convertString = S.toShort +instance ConvertString ByteString [Word8] where {-# INLINE convertString #-}; convertString = B.unpack +instance ConvertString ShortByteString (Lenient String) where {-# INLINE convertString #-}; convertString = Lenient . T.unpack . TE.decodeUtf8With lenientDecode . S.fromShort +instance ConvertString ShortByteString (Lenient TL.Text) where {-# INLINE convertString #-}; convertString = Lenient . TLE.decodeUtf8With lenientDecode . BL.fromStrict . S.fromShort +instance ConvertString ShortByteString (Lenient Text) where {-# INLINE convertString #-}; convertString = Lenient . TE.decodeUtf8With lenientDecode . S.fromShort +instance ConvertString ShortByteString (Maybe String) where {-# INLINE convertString #-}; convertString = fmap T.unpack . eitherToMaybe . TE.decodeUtf8' . S.fromShort +instance ConvertString ShortByteString (Maybe TL.Text) where {-# INLINE convertString #-}; convertString = eitherToMaybe . TLE.decodeUtf8' . BL.fromStrict . S.fromShort +instance ConvertString ShortByteString (Maybe Text) where {-# INLINE convertString #-}; convertString = eitherToMaybe . TE.decodeUtf8' . S.fromShort +instance ConvertString ShortByteString BL.ByteString where {-# INLINE convertString #-}; convertString = BL.fromStrict . S.fromShort +instance ConvertString ShortByteString ByteString where {-# INLINE convertString #-}; convertString = S.fromShort +instance ConvertString ShortByteString ShortByteString where {-# INLINE convertString #-}; convertString = id +instance ConvertString ShortByteString [Word8] where {-# INLINE convertString #-}; convertString = S.unpack +instance ConvertString String BL.ByteString where {-# INLINE convertString #-}; convertString = TLE.encodeUtf8 . TL.pack +instance ConvertString String ByteString where {-# INLINE convertString #-}; convertString = TE.encodeUtf8 . T.pack +instance ConvertString String ShortByteString where {-# INLINE convertString #-}; convertString = S.toShort . TE.encodeUtf8 . T.pack +instance ConvertString String String where {-# INLINE convertString #-}; convertString = id +instance ConvertString String TL.Text where {-# INLINE convertString #-}; convertString = TL.pack +instance ConvertString String Text where {-# INLINE convertString #-}; convertString = T.pack +instance ConvertString String [Word8] where {-# INLINE convertString #-}; convertString = BL.unpack . TLE.encodeUtf8 . TL.pack +instance ConvertString TL.Text BL.ByteString where {-# INLINE convertString #-}; convertString = TLE.encodeUtf8 +instance ConvertString TL.Text ByteString where {-# INLINE convertString #-}; convertString = BL.toStrict . TLE.encodeUtf8 +instance ConvertString TL.Text ShortByteString where {-# INLINE convertString #-}; convertString = S.toShort . BL.toStrict . TLE.encodeUtf8 +instance ConvertString TL.Text String where {-# INLINE convertString #-}; convertString = TL.unpack +instance ConvertString TL.Text TL.Text where {-# INLINE convertString #-}; convertString = id +instance ConvertString TL.Text Text where {-# INLINE convertString #-}; convertString = TL.toStrict +instance ConvertString TL.Text [Word8] where {-# INLINE convertString #-}; convertString = BL.unpack . TLE.encodeUtf8 +instance ConvertString Text BL.ByteString where {-# INLINE convertString #-}; convertString = BL.fromStrict . TE.encodeUtf8 +instance ConvertString Text ByteString where {-# INLINE convertString #-}; convertString = TE.encodeUtf8 +instance ConvertString Text ShortByteString where {-# INLINE convertString #-}; convertString = S.toShort . TE.encodeUtf8 +instance ConvertString Text String where {-# INLINE convertString #-}; convertString = T.unpack +instance ConvertString Text TL.Text where {-# INLINE convertString #-}; convertString = TL.fromStrict +instance ConvertString Text Text where {-# INLINE convertString #-}; convertString = id +instance ConvertString Text [Word8] where {-# INLINE convertString #-}; convertString = BL.unpack . BL.fromStrict . TE.encodeUtf8 +instance ConvertString [Word8] (Lenient String) where {-# INLINE convertString #-}; convertString = Lenient . TL.unpack . TLE.decodeUtf8With lenientDecode . BL.pack +instance ConvertString [Word8] (Lenient TL.Text) where {-# INLINE convertString #-}; convertString = Lenient . TLE.decodeUtf8With lenientDecode . BL.pack +instance ConvertString [Word8] (Lenient Text) where {-# INLINE convertString #-}; convertString = Lenient . TE.decodeUtf8With lenientDecode . B.pack +instance ConvertString [Word8] (Maybe String) where {-# INLINE convertString #-}; convertString = fmap TL.unpack . eitherToMaybe . TLE.decodeUtf8' . BL.pack +instance ConvertString [Word8] (Maybe TL.Text) where {-# INLINE convertString #-}; convertString = eitherToMaybe . TLE.decodeUtf8' . BL.pack +instance ConvertString [Word8] (Maybe Text) where {-# INLINE convertString #-}; convertString = eitherToMaybe . TE.decodeUtf8' . B.pack +instance ConvertString [Word8] BL.ByteString where {-# INLINE convertString #-}; convertString = BL.pack +instance ConvertString [Word8] ByteString where {-# INLINE convertString #-}; convertString = B.pack +instance ConvertString [Word8] ShortByteString where {-# INLINE convertString #-}; convertString = S.pack +instance ConvertString [Word8] [Word8] where {-# INLINE convertString #-}; convertString = id + +instance EncodeString String BL.ByteString +instance EncodeString String ByteString +instance EncodeString String ShortByteString +instance EncodeString String [Word8] +instance EncodeString TL.Text BL.ByteString +instance EncodeString TL.Text ByteString +instance EncodeString TL.Text ShortByteString +instance EncodeString TL.Text [Word8] +instance EncodeString Text BL.ByteString +instance EncodeString Text ByteString +instance EncodeString Text ShortByteString +instance EncodeString Text [Word8] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/intro-0.1.0.10/src/Intro/Trustworthy.hs new/intro-0.3.0.1/src/Intro/Trustworthy.hs --- old/intro-0.1.0.10/src/Intro/Trustworthy.hs 2017-03-03 05:57:48.000000000 +0100 +++ new/intro-0.3.0.1/src/Intro/Trustworthy.hs 2017-03-29 01:18:47.000000000 +0200 @@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Intro.Trustworthy --- Copyright : (c) Daniel Mendler 2016 +-- Copyright : (c) Daniel Mendler 2016-2017 -- License : MIT -- -- Maintainer : mail(a)daniel-mendler.de @@ -29,8 +29,10 @@ , HasCallStack , trace , traceIO + , traceId , traceM , traceShow + , traceShowId , traceShowM , Data.Hashable.Lifted.Hashable1 , Data.Hashable.Lifted.Hashable2 @@ -122,3 +124,13 @@ traceIO :: MonadIO m => Text -> m () traceIO = liftIO . Debug.Trace.traceIO . unpack {-# WARNING traceIO "'traceIO' remains in code" #-} + +-- | Like 'traceShow' but returns the shown value instead of a third value. +traceShowId :: Show a => a -> a +traceShowId = Debug.Trace.traceShowId +{-# WARNING traceShowId "'traceShowId' remains in code" #-} + +-- | Like 'trace' but returns the message instead of a third value. +traceId :: Text -> Text +traceId a = Debug.Trace.trace (unpack a) a +{-# WARNING traceId "'traceId' remains in code" #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/intro-0.1.0.10/src/Intro.hs new/intro-0.3.0.1/src/Intro.hs --- old/intro-0.1.0.10/src/Intro.hs 2017-03-03 06:13:47.000000000 +0100 +++ new/intro-0.3.0.1/src/Intro.hs 2017-04-05 10:45:06.000000000 +0200 @@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Intro --- Copyright : (c) Daniel Mendler 2016 +-- Copyright : (c) Daniel Mendler 2016-2017 -- License : MIT -- -- Maintainer : mail(a)daniel-mendler.de @@ -28,19 +28,19 @@ -- -- List of design decisions: -- --- * Keep everything at one place (There are one two modules and Intro.Trustworthy is only there for Safe Haskell) +-- * Keep everything at one place (There are only three modules and Intro.Trustworthy is only there for Safe Haskell) -- * Conservative extension over the base Prelude -- * Rely only on very common external libraries -- * Avoid writing custom functions -- * Export everything explicitly to provide a stable interface and for good documentation -- * Export only total functions or provide safe alternatives (Very few exceptions like div etc.) --- * Prefer Text over String, provide ConvertibleStrings +-- * Prefer Text over String, provide 'ConvertString' and 'EncodeString' -- * Provide Monad transformers -- * Provide container types -- * Prefer generic functions --- * Debugging functions, like 'Intro.Trustworthy.trace' and 'undefined' are available but produce compile time warnings +-- * Debugging functions, like 'trace' and 'undefined' are available but produce compile time warnings -- * Don't provide error, only panic instead --- * Compatibility with Control.Lens +-- * Compatibility with unqualified import of Control.Lens -- -- Some 'Prelude' functions are missing from 'Intro'. More general variants are available for the following functions: -- @@ -70,7 +70,7 @@ -- * 'gcd' and 'lcm' are not commonly used. -- * 'error' and 'errorWithoutStackTrace' are not provided. Use 'panic' instead. -- * 'ioError' and 'userError' are not provided. Import modules for exception handling separately if needed. --- * Some 'Read' and 'Show' class functions are not provided. Don't write these instances yourself. +-- * Some 'Text.Read.Read' and 'Show' class functions are not provided. Don't write these instances yourself. -- -- Additional types and functions: -- @@ -187,7 +187,6 @@ , Data.List.zip3 , Data.List.zipWith , Data.List.zipWith3 - -- , Data.List.cycle -- partial , Safe.headDef , Safe.headMay -- prefer pattern match , Safe.initDef @@ -242,10 +241,13 @@ -- ** ByteString , Data.ByteString.ByteString , LByteString + , Data.ByteString.Short.ShortByteString - -- ** Conversion + -- ** String conversion , Data.String.IsString(fromString) - , Data.String.Conversions.ConvertibleStrings(convertString) + , Intro.ConvertString.ConvertString(convertString) + , Intro.ConvertString.EncodeString(encodeString, decodeString, decodeStringLenient) + , Lenient(..) -- * Container types @@ -262,11 +264,9 @@ , Intro.Trustworthy.Hashable1 , Intro.Trustworthy.Hashable2 - -- ** Seq - , Data.Sequence.Seq - - -- ** DList + -- ** DList and Seq , Intro.Trustworthy.DList + , Data.Sequence.Seq -- * Numeric types @@ -363,7 +363,7 @@ #endif , readMaybe - -- * Equality and Ordering + -- * Equality and ordering -- ** Eq , Data.Eq.Eq((==), (/=)) @@ -493,15 +493,10 @@ -- ** Monad , Control.Monad.Monad((>>=)) -#if MIN_VERSION_base(4,9,0) - , Control.Monad.Fail.MonadFail -#endif - , fail , Control.Monad.Fix.MonadFix(mfix) , (Control.Monad.=<<) , (Control.Monad.<=<) , (Control.Monad.>=>) - , Control.Monad.MonadPlus(mzero, mplus) , Control.Monad.join , Control.Monad.guard , Control.Monad.when @@ -538,10 +533,11 @@ , Data.Bitraversable.bifor , Data.Bitraversable.bisequenceA - -- * Monad transformer + -- * Effects and monad transformers , Control.Monad.Trans.MonadTrans(lift) - -- ** MaybeT + -- ** MonadPlus and MaybeT + , Control.Monad.MonadPlus , Control.Monad.Trans.Maybe.MaybeT(MaybeT, runMaybeT) , Control.Monad.Trans.Maybe.mapMaybeT @@ -624,8 +620,8 @@ #endif , Intro.Trustworthy.Constraint , Data.Proxy.Proxy(Proxy) - , Data.Tagged.Tagged(Tagged) - , Data.Tagged.unTagged + --, Data.Tagged.Tagged(Tagged) + --, Data.Tagged.unTagged -- * IO , System.IO.IO @@ -650,13 +646,19 @@ , writeFileUtf8 , appendFileUtf8 - -- * Error and Debugging + -- * Error handling and debugging +#if MIN_VERSION_base(4,9,0) + , Control.Monad.Fail.MonadFail +#endif + , fail , panic , undefined , Intro.Trustworthy.trace , Intro.Trustworthy.traceIO + , Intro.Trustworthy.traceId , Intro.Trustworthy.traceM , Intro.Trustworthy.traceShow + , Intro.Trustworthy.traceShowId , Intro.Trustworthy.traceShowM ) where @@ -668,11 +670,10 @@ import Data.Maybe (Maybe, fromMaybe) import Data.Semigroup (Semigroup((<>))) import Data.String (IsString(fromString), String) -import Data.String.Conversions (ConvertibleStrings(convertString)) import Data.Text (Text) -import Intro.Trustworthy (HasCallStack, IsList(Item, toList, fromList)) +import Intro.ConvertString +import Intro.Trustworthy import System.IO (FilePath) -import Text.Read (Read) import Text.Show (Show) import qualified Control.Applicative import qualified Control.Category @@ -695,6 +696,7 @@ import qualified Data.Bool import qualified Data.ByteString import qualified Data.ByteString.Lazy +import qualified Data.ByteString.Short import qualified Data.Either import qualified Data.Either.Extra import qualified Data.Eq @@ -720,7 +722,6 @@ import qualified Data.Semigroup import qualified Data.Sequence import qualified Data.Set -import qualified Data.Tagged import qualified Data.Text.IO import qualified Data.Text.Lazy import qualified Data.Traversable @@ -729,7 +730,6 @@ import qualified Data.Void import qualified Data.Word import qualified GHC.Generics -import qualified Intro.Trustworthy import qualified Numeric.Natural import qualified Prelude import qualified Safe @@ -769,9 +769,9 @@ map = fmap {-# INLINE map #-} --- | Convert a value to a readable string type supported by 'ConvertibleStrings' using the 'Show' instance. -show :: (Show a, IsString s) => a -> s -show = fromString . showS +-- | Convert a value to a readable string type supported by 'ConvertString' using the 'Show' instance. +show :: (Show a, ConvertString String s) => a -> s +show = convertString . showS {-# INLINE show #-} -- | Convert a value to a readable 'Text' using the 'Show' instance. @@ -786,7 +786,7 @@ -- | Parse a string type using the 'Text.Read.Read' instance. -- Succeeds if there is exactly one valid result. -readMaybe :: (Text.Read.Read b, ConvertibleStrings a String) => a -> Maybe b +readMaybe :: (Text.Read.Read b, ConvertString a String) => a -> Maybe b readMaybe = Text.Read.readMaybe . convertString {-# INLINE readMaybe #-} @@ -870,10 +870,12 @@ {-# INLINE appendFile #-} -- | Read an entire file strictly into a 'Text' using UTF-8 encoding. +-- The decoding is done using 'decodeStringLenient'. Invalid characters are replaced +-- by the Unicode replacement character '\FFFD'. -- -- __Note__: This function is lifted to the 'MonadIO' class. readFileUtf8 :: MonadIO m => FilePath -> m Text -readFileUtf8 = map convertString . readFile +readFileUtf8 = map decodeStringLenient . readFile {-# INLINE readFileUtf8 #-} -- | Write a 'Text' to a file using UTF-8 encoding. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/intro-0.1.0.10/test/compat.hs new/intro-0.3.0.1/test/compat.hs --- old/intro-0.1.0.10/test/compat.hs 2017-01-09 20:20:17.000000000 +0100 +++ new/intro-0.3.0.1/test/compat.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,9 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -module Main where - -import BaseCompat -import LensCompat - -main :: IO () -main = pure () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/intro-0.1.0.10/test/test.hs new/intro-0.3.0.1/test/test.hs --- old/intro-0.1.0.10/test/test.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/intro-0.3.0.1/test/test.hs 2017-04-05 10:34:40.000000000 +0200 @@ -0,0 +1,73 @@ +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Main where + +import BaseCompat () +import Data.ByteString.Short (ShortByteString) +import Intro +import LensCompat () +import Test.QuickCheck +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as LB +import qualified Data.ByteString.Short as SB +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT + +instance Arbitrary ByteString where arbitrary = B.pack <$> arbitrary +instance Arbitrary LB.ByteString where arbitrary = LB.pack <$> arbitrary +instance Arbitrary ShortByteString where arbitrary = SB.pack <$> arbitrary +instance Arbitrary Text where arbitrary = T.pack <$> arbitrary +instance Arbitrary LT.Text where arbitrary = LT.pack <$> arbitrary + +main :: IO () +main = do + encode (Proxy :: Proxy LText) (Proxy :: Proxy ByteString) + encode (Proxy :: Proxy LText) (Proxy :: Proxy LByteString) + encode (Proxy :: Proxy LText) (Proxy :: Proxy ShortByteString) + encode (Proxy :: Proxy LText) (Proxy :: Proxy [Word8]) + encode (Proxy :: Proxy String) (Proxy :: Proxy ByteString) + encode (Proxy :: Proxy String) (Proxy :: Proxy LByteString) + encode (Proxy :: Proxy String) (Proxy :: Proxy ShortByteString) + encode (Proxy :: Proxy String) (Proxy :: Proxy [Word8]) + encode (Proxy :: Proxy Text) (Proxy :: Proxy ByteString) + encode (Proxy :: Proxy Text) (Proxy :: Proxy LByteString) + encode (Proxy :: Proxy Text) (Proxy :: Proxy ShortByteString) + encode (Proxy :: Proxy Text) (Proxy :: Proxy [Word8]) + iso (Proxy :: Proxy ByteString) (Proxy :: Proxy ByteString) + iso (Proxy :: Proxy ByteString) (Proxy :: Proxy LByteString) + iso (Proxy :: Proxy ByteString) (Proxy :: Proxy ShortByteString) + iso (Proxy :: Proxy ByteString) (Proxy :: Proxy [Word8]) + iso (Proxy :: Proxy ShortByteString) (Proxy :: Proxy ByteString) + iso (Proxy :: Proxy ShortByteString) (Proxy :: Proxy LByteString) + iso (Proxy :: Proxy ShortByteString) (Proxy :: Proxy ShortByteString) + iso (Proxy :: Proxy ShortByteString) (Proxy :: Proxy [Word8]) + iso (Proxy :: Proxy LByteString) (Proxy :: Proxy ByteString) + iso (Proxy :: Proxy LByteString) (Proxy :: Proxy LByteString) + iso (Proxy :: Proxy LByteString) (Proxy :: Proxy ShortByteString) + iso (Proxy :: Proxy LByteString) (Proxy :: Proxy [Word8]) + iso (Proxy :: Proxy LText) (Proxy :: Proxy LText) + iso (Proxy :: Proxy LText) (Proxy :: Proxy String) + iso (Proxy :: Proxy LText) (Proxy :: Proxy Text) + iso (Proxy :: Proxy String) (Proxy :: Proxy LText) + iso (Proxy :: Proxy String) (Proxy :: Proxy String) + iso (Proxy :: Proxy String) (Proxy :: Proxy Text) + iso (Proxy :: Proxy Text) (Proxy :: Proxy LText) + iso (Proxy :: Proxy Text) (Proxy :: Proxy String) + iso (Proxy :: Proxy Text) (Proxy :: Proxy Text) + iso (Proxy :: Proxy [Word8]) (Proxy :: Proxy ByteString) + iso (Proxy :: Proxy [Word8]) (Proxy :: Proxy LByteString) + iso (Proxy :: Proxy [Word8]) (Proxy :: Proxy ShortByteString) + iso (Proxy :: Proxy [Word8]) (Proxy :: Proxy [Word8]) + +iso :: forall a b proxy. (Eq a, Eq b, Show a, Show b, Arbitrary a, Arbitrary b, ConvertString a b, ConvertString b a) => proxy a -> proxy b -> IO () +iso _ _ = do + quickCheck $ \(a :: a) -> convertString (convertString a :: b) == a + quickCheck $ \(b :: b) -> convertString (convertString b :: a) == b + +encode :: forall a b proxy. (Eq a, Show a, Arbitrary a, EncodeString a b) => proxy a -> proxy b -> IO () +encode _ _ = do + quickCheck $ \(a :: a) -> decodeString (encodeString a :: b) == Just a + quickCheck $ \(a :: a) -> decodeStringLenient (encodeString a :: b) == a

1 0

commit ghc-indentation-parsec for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-indentation-parsec for openSUSE:Factory checked in at 2017-08-31 20:56:36 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-indentation-parsec (Old) and /work/SRC/openSUSE:Factory/.ghc-indentation-parsec.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-indentation-parsec" Thu Aug 31 20:56:36 2017 rev:2 rq:513401 version:0.0.0.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-indentation-parsec/ghc-indentation-parsec.changes 2017-04-12 18:07:16.705786159 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-indentation-parsec.new/ghc-indentation-parsec.changes 2017-08-31 20:56:38.245950210 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:14 UTC 2017 - psimons(a)suse.com + +- Update to version 0.0.0.1. + +------------------------------------------------------------------- Old: ---- indentation-parsec-0.0.tar.gz New: ---- indentation-parsec-0.0.0.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-indentation-parsec.spec ++++++ --- /var/tmp/diff_new_pack.1hPNVs/_old 2017-08-31 20:56:40.597619793 +0200 +++ /var/tmp/diff_new_pack.1hPNVs/_new 2017-08-31 20:56:40.609618107 +0200 @@ -19,7 +19,7 @@ %global pkg_name indentation-parsec %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.0 +Version: 0.0.0.1 Release: 0 Summary: Indentation sensitive parsing combinators for Parsec License: BSD-3-Clause ++++++ indentation-parsec-0.0.tar.gz -> indentation-parsec-0.0.0.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/indentation-parsec-0.0/CHANGELOG.md new/indentation-parsec-0.0.0.1/CHANGELOG.md --- old/indentation-parsec-0.0/CHANGELOG.md 2016-05-28 04:24:44.000000000 +0200 +++ new/indentation-parsec-0.0.0.1/CHANGELOG.md 2017-07-23 18:48:42.000000000 +0200 @@ -1,3 +1,7 @@ +# 0.0.0.1 + +* Bump `base` bounds to support GHC 8.2.1 + # 0.0 * Split `indentation` into separate `indentation-core`, `indentation-parsec` and `indentation-trifecta` packages. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/indentation-parsec-0.0/indentation-parsec.cabal new/indentation-parsec-0.0.0.1/indentation-parsec.cabal --- old/indentation-parsec-0.0/indentation-parsec.cabal 2016-05-28 04:24:44.000000000 +0200 +++ new/indentation-parsec-0.0.0.1/indentation-parsec.cabal 2017-07-23 18:48:42.000000000 +0200 @@ -1,5 +1,5 @@ name: indentation-parsec -version: 0.0 +version: 0.0.0.1 synopsis: Indentation sensitive parsing combinators for Parsec description: Indentation sensitive parsing combinators for Parsec . @@ -31,7 +31,7 @@ homepage: https://bitbucket.org/adamsmd/indentation bug-reports: https://bitbucket.org/adamsmd/indentation/issues -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.2.1 source-repository head type: git @@ -39,9 +39,9 @@ library hs-source-dirs: src - build-depends: base >=4.6 && <4.10, + build-depends: base >=4.6 && <4.12, mtl >=2.1, - indentation-core == 0.0, + indentation-core == 0.0.0.1, parsec >=3.1.5 exposed-modules: Text.Parsec.Indentation , Text.Parsec.Indentation.Char

1 0

commit ghc-indentation-core for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-indentation-core for openSUSE:Factory checked in at 2017-08-31 20:56:34 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-indentation-core (Old) and /work/SRC/openSUSE:Factory/.ghc-indentation-core.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-indentation-core" Thu Aug 31 20:56:34 2017 rev:2 rq:513400 version:0.0.0.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-indentation-core/ghc-indentation-core.changes 2017-04-12 18:07:15.837908872 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-indentation-core.new/ghc-indentation-core.changes 2017-08-31 20:56:35.298364355 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:07 UTC 2017 - psimons(a)suse.com + +- Update to version 0.0.0.1. + +------------------------------------------------------------------- Old: ---- indentation-core-0.0.tar.gz New: ---- indentation-core-0.0.0.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-indentation-core.spec ++++++ --- /var/tmp/diff_new_pack.OM41Pb/_old 2017-08-31 20:56:36.426205890 +0200 +++ /var/tmp/diff_new_pack.OM41Pb/_new 2017-08-31 20:56:36.446203081 +0200 @@ -18,7 +18,7 @@ %global pkg_name indentation-core Name: ghc-%{pkg_name} -Version: 0.0 +Version: 0.0.0.1 Release: 0 Summary: Indentation sensitive parsing combinators core library License: BSD-3-Clause ++++++ indentation-core-0.0.tar.gz -> indentation-core-0.0.0.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/indentation-core-0.0/CHANGELOG.md new/indentation-core-0.0.0.1/CHANGELOG.md --- old/indentation-core-0.0/CHANGELOG.md 2016-05-28 04:12:50.000000000 +0200 +++ new/indentation-core-0.0.0.1/CHANGELOG.md 2017-07-23 18:48:30.000000000 +0200 @@ -1,3 +1,7 @@ +# 0.0.0.1 + +* Bump `base` bounds to support GHC 8.2.1 + # 0.0 * Split `indentation` into separate `indentation-core`, `indentation-parsec` and `indentation-trifecta` packages. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/indentation-core-0.0/indentation-core.cabal new/indentation-core-0.0.0.1/indentation-core.cabal --- old/indentation-core-0.0/indentation-core.cabal 2016-05-28 04:12:50.000000000 +0200 +++ new/indentation-core-0.0.0.1/indentation-core.cabal 2017-07-23 18:48:30.000000000 +0200 @@ -1,5 +1,5 @@ name: indentation-core -version: 0.0 +version: 0.0.0.1 synopsis: Indentation sensitive parsing combinators core library description: Indentation sensitive parsing combinators core library . @@ -21,7 +21,7 @@ homepage: https://bitbucket.org/adamsmd/indentation bug-reports: https://bitbucket.org/adamsmd/indentation/issues -tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 +tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.2.1 source-repository head type: git @@ -30,7 +30,7 @@ library hs-source-dirs: src exposed-modules: Text.Parser.Indentation.Implementation - build-depends: base >=4.6 && <4.10, + build-depends: base >=4.6 && <4.12, mtl >=2.1 default-language: Haskell2010

1 0

commit ghc-imm for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-imm for openSUSE:Factory checked in at 2017-08-31 20:56:32 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-imm (Old) and /work/SRC/openSUSE:Factory/.ghc-imm.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-imm" Thu Aug 31 20:56:32 2017 rev:2 rq:513399 version:1.2.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-imm/ghc-imm.changes 2017-05-17 10:51:04.022572947 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-imm.new/ghc-imm.changes 2017-08-31 20:56:32.714727365 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:10 UTC 2017 - psimons(a)suse.com + +- Update to version 1.2.0.0. + +------------------------------------------------------------------- Old: ---- imm-1.1.0.0.tar.gz New: ---- imm-1.2.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-imm.spec ++++++ --- /var/tmp/diff_new_pack.6Y5Bf8/_old 2017-08-31 20:56:33.570607111 +0200 +++ /var/tmp/diff_new_pack.6Y5Bf8/_new 2017-08-31 20:56:33.582605426 +0200 @@ -18,7 +18,7 @@ %global pkg_name imm Name: ghc-%{pkg_name} -Version: 1.1.0.0 +Version: 1.2.0.0 Release: 0 Summary: Execute arbitrary actions for each unread element of RSS/Atom feeds License: WTFPL @@ -71,6 +71,7 @@ BuildRequires: ghc-uri-bytestring-devel BuildRequires: ghc-xml-conduit-devel BuildRequires: ghc-xml-devel +BuildRequires: ghc-xml-types-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %description ++++++ imm-1.1.0.0.tar.gz -> imm-1.2.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/imm.cabal new/imm-1.2.0.0/imm.cabal --- old/imm-1.1.0.0/imm.cabal 2016-10-24 22:15:11.000000000 +0200 +++ new/imm-1.2.0.0/imm.cabal 2017-03-19 10:26:16.000000000 +0100 @@ -1,9 +1,9 @@ name: imm -version: 1.1.0.0 +version: 1.2.0.0 synopsis: Execute arbitrary actions for each unread element of RSS/Atom feeds description: Cf README file homepage: https://github.com/k0ral/imm -license: OtherLicense +license: PublicDomain license-file: LICENSE author: kamaradclimber, koral maintainer: koral <koral(a)mailoo.org> @@ -33,6 +33,8 @@ Imm.Logger Imm.Logger.Simple Imm.Prelude + Imm.XML + Imm.XML.Simple other-modules: Imm.Aeson Imm.Dyre @@ -40,7 +42,7 @@ Imm.Options Imm.Pretty Paths_imm - build-depends: aeson, atom-conduit >= 0.4, base == 4.*, blaze-html, blaze-markup, bytestring, case-insensitive, chunked-data >= 0.3.0, comonad, conduit, conduit-combinators, connection, containers, directory >= 1.2.3.0, dyre, fast-logger, filepath, free, hashable, HaskellNet, HaskellNet-SSL >= 0.3.3.0, http-client >= 0.4.30, http-client-tls, http-types, mime-mail, monoid-subclasses, mono-traversable >= 1.0.0, network, opml-conduit >= 0.6, optparse-applicative, rainbow, rainbox, rss-conduit >= 0.3, safe-exceptions, tagged, text, transformers, time, timerep >= 2.0.0.0, tls, uri-bytestring, xml, xml-conduit, ansi-wl-pprint + build-depends: aeson, ansi-wl-pprint, atom-conduit >= 0.4, base == 4.*, blaze-html, blaze-markup, bytestring, case-insensitive, chunked-data >= 0.3.0, comonad, conduit, conduit-combinators, connection, containers, directory >= 1.2.3.0, dyre, fast-logger, filepath, free, hashable, HaskellNet, HaskellNet-SSL >= 0.3.3.0, http-client >= 0.4.30, http-client-tls, http-types, mime-mail, monoid-subclasses, mono-traversable >= 1.0.0, network, opml-conduit >= 0.6, optparse-applicative, rainbow, rainbox, rss-conduit >= 0.3.1, safe-exceptions, tagged, text, transformers, time, timerep >= 2.0.0.0, tls, uri-bytestring, xml, xml-conduit >= 1.5, xml-types -- Build-tools: hs-source-dirs: src/lib ghc-options: -Wall -fno-warn-unused-do-bind diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/bin/Executable.hs new/imm-1.2.0.0/src/bin/Executable.hs --- old/imm-1.1.0.0/src/bin/Executable.hs 2016-08-23 12:03:21.000000000 +0200 +++ new/imm-1.2.0.0/src/bin/Executable.hs 2017-03-19 10:26:16.000000000 +0100 @@ -5,19 +5,19 @@ -- {{{ Imports import Imm import Imm.Database.JsonFile -import qualified Imm.Hooks.WriteFile as WriteFile import Imm.HTTP.Simple import Imm.Logger.Simple import Imm.Prelude +import Imm.XML.Simple import System.Exit -- }}} --- mkDummyCoHooks :: (MonadIO m, MonadThrow m) => () -> CoHooksF m () --- mkDummyCoHooks _ = CoHooksF coOnNewElement where --- coOnNewElement _ _ = do --- io $ putStrLn "No hook defined." --- throwM $ ExitFailure 1 +mkDummyCoHooks :: (MonadIO m, MonadThrow m) => () -> CoHooksF m () +mkDummyCoHooks _ = CoHooksF coOnNewElement where + coOnNewElement _ _ = do + io $ putStrLn "No hook defined." + throwM $ ExitFailure 1 main :: IO () @@ -26,4 +26,4 @@ manager <- defaultManager database <- defaultDatabase - imm (mkCoHttpClient, manager) (mkCoDatabase, database) (mkCoLogger, logger) (WriteFile.mkCoHooks, WriteFile.defaultSettings "/home/koral/feeds") + imm (mkCoHttpClient, manager) (mkCoDatabase, database) (mkCoLogger, logger) (mkDummyCoHooks, ()) (mkCoXmlParser, defaultPreProcess) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Boot.hs new/imm-1.2.0.0/src/lib/Imm/Boot.hs --- old/imm-1.1.0.0/src/lib/Imm/Boot.hs 2016-10-24 22:08:58.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Boot.hs 2017-03-19 10:26:16.000000000 +0100 @@ -37,6 +37,7 @@ import Imm.Options as Options hiding(logLevel) import Imm.Prelude import Imm.Pretty +import Imm.XML import Control.Comonad.Cofree import Control.Monad.Trans.Free @@ -58,6 +59,7 @@ -- > import Imm.Hooks.SendMail -- > import Imm.HTTP.Simple -- > import Imm.Logger.Simple +-- > import Imm.XML.Simple -- > -- > main :: IO () -- > main = do @@ -65,7 +67,7 @@ -- > manager <- defaultManager -- > database <- defaultDatabase -- > --- > imm (mkCoHttpClient, manager) (mkCoDatabase, database) (mkCoLogger, logger) (mkCoHooks, sendmail) +-- > imm (mkCoHttpClient, manager) (mkCoDatabase, database) (mkCoLogger, logger) (mkCoHooks, sendmail) (mkCoXmlParser, defaultPreProcess) -- > -- > sendmail :: SendMailSettings -- > sendmail = SendMailSettings smtpServer formatMail @@ -82,14 +84,15 @@ -- > (Just $ Authentication PLAIN "user" "password") -- > (StartTls "smtp.host" defaultSettingsSMTPSTARTTLS) imm :: (a -> CoHttpClientF IO a, a) -- ^ HTTP client interpreter (cf "Imm.HTTP") - -> (b -> CoDatabaseF' IO b, b) -- ^ Database interpreter (cf "Imm.Database") - -> (c -> CoLoggerF IO c, c) -- ^ Logger interpreter (cf "Imm.Logger") - -> (d -> CoHooksF IO d, d) -- ^ Hooks interpreter (cf "Imm.Hooks") + -> (b -> CoDatabaseF' IO b, b) -- ^ Database interpreter (cf "Imm.Database") + -> (c -> CoLoggerF IO c, c) -- ^ Logger interpreter (cf "Imm.Logger") + -> (d -> CoHooksF IO d, d) -- ^ Hooks interpreter (cf "Imm.Hooks") + -> (e -> CoXmlParserF IO e, e) -- ^ XML parsing interpreter (cf "Imm.XML") -> IO () -imm coHttpClient coDatabase coLogger coHooks = void $ do +imm coHttpClient coDatabase coLogger coHooks coXmlParser = void $ do options <- parseOptions Dyre.wrap (optionDyreMode options) realMain (optionCommand options, optionLogLevel options, optionColorizeLogs options, coiter next start) - where (next, start) = mkCoImm coHttpClient coDatabase coLogger coHooks + where (next, start) = mkCoImm coHttpClient coDatabase coLogger coHooks coXmlParser realMain :: (MonadIO m, PairingM (CoImmF m) ImmF m, MonadCatch m) => (Command, LogLevel, Bool, Cofree (CoImmF m) a) -> m () @@ -117,14 +120,22 @@ -- * DSL/interpreter model -type CoImmF m = Product (CoHttpClientF m) (Product (CoDatabaseF' m) (Product (CoLoggerF m) (CoHooksF m))) -type ImmF = Sum HttpClientF (Sum DatabaseF' (Sum LoggerF HooksF)) +type CoImmF m = Product (CoHttpClientF m) + (Product (CoDatabaseF' m) + (Product (CoLoggerF m) + (Product (CoHooksF m) (CoXmlParserF m) + ))) +type ImmF = Sum HttpClientF (Sum DatabaseF' (Sum LoggerF (Sum HooksF XmlParserF))) mkCoImm :: (Functor m) - => (a -> CoHttpClientF m a, a) -> (b -> CoDatabaseF' m b, b) -> (c -> CoLoggerF m c, c) -> (d -> CoHooksF m d, d) - -> ((a ::: b ::: c ::: d) -> CoImmF m (a ::: b ::: c ::: d), a ::: b ::: c ::: d) -mkCoImm (coHttpClient, a) (coDatabase, b) (coLogger, c) (coHooks, d) = - (coHttpClient *:* coDatabase *:* coLogger *:* coHooks, a >: b >: c >: d) + => (a -> CoHttpClientF m a, a) + -> (b -> CoDatabaseF' m b, b) + -> (c -> CoLoggerF m c, c) + -> (d -> CoHooksF m d, d) + -> (e -> CoXmlParserF m e, e) + -> ((a ::: b ::: c ::: d ::: e) -> CoImmF m (a ::: b ::: c ::: d ::: e), a ::: b ::: c ::: d ::: e) +mkCoImm (coHttpClient, a) (coDatabase, b) (coLogger, c) (coHooks, d) (coXmlParser, e) = + (coHttpClient *: coDatabase *: coLogger *: coHooks *: coXmlParser, a +: b +: c +: d +: e) -- * Util @@ -144,7 +155,7 @@ unless (null x || x == ("Y" :: Text)) $ throwM InterruptedException -resolveTarget :: (MonadIO m, MonadThrow m, Functor f, MonadFree f m, DatabaseF' :<: f) +resolveTarget :: (MonadIO m, MonadThrow m, MonadFree f m, DatabaseF' :<: f) => SafeGuard -> Maybe Core.FeedRef -> m [FeedID] resolveTarget s Nothing = do result <- keys <$> Database.fetchAll FeedTable diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Core.hs new/imm-1.2.0.0/src/lib/Imm/Core.hs --- old/imm-1.1.0.0/src/lib/Imm/Core.hs 2016-09-28 00:05:51.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Core.hs 2017-03-19 10:26:16.000000000 +0100 @@ -29,6 +29,7 @@ import Imm.Logger import Imm.Prelude import Imm.Pretty +import Imm.XML -- import Control.Concurrent.Async.Lifted (Async, async, mapConcurrently, waitAny) -- import Control.Concurrent.Async.Pool @@ -51,12 +52,8 @@ import System.Info -import Text.Atom.Conduit.Parse -import Text.Atom.Types import Text.OPML.Conduit.Parse import Text.OPML.Types as OPML -import Text.RSS.Conduit.Parse -import Text.RSS.Types import Text.XML as XML () import Text.XML.Stream.Parse as XML @@ -70,7 +67,7 @@ putStrLn $ "compiled by " ++ compilerName ++ "-" ++ showVersion compilerVersion -- | Print database status for given feed(s) -showFeed :: (MonadIO m, LoggerF :<: f, MonadThrow m, Functor f, MonadFree f m, DatabaseF' :<: f) +showFeed :: (MonadIO m, LoggerF :<: f, MonadThrow m, MonadFree f m, DatabaseF' :<: f) => [FeedID] -> m () showFeed feedIDs = do feeds <- Database.fetchList FeedTable feedIDs @@ -78,38 +75,41 @@ if null feeds then logWarning "No subscription" else putBox $ entryTableToBox feeds -- | Register the given feed URI in database -subscribe :: (LoggerF :<: f, Functor f, MonadFree f m, DatabaseF' :<: f, MonadCatch m) +subscribe :: (LoggerF :<: f, MonadFree f m, DatabaseF' :<: f, MonadCatch m) => URI -> Maybe Text -> m () subscribe uri category = Database.register (FeedID uri) $ fromMaybe "default" category -- | Check for unread elements without processing them -check :: (MonadIO m, MonadCatch m, LoggerF :<: f, Functor f, MonadFree f m, DatabaseF' :<: f, HttpClientF :<: f) +check :: (MonadIO m, MonadCatch m, LoggerF :<: f, MonadFree f m, DatabaseF' :<: f, HttpClientF :<: f, XmlParserF :<: f) => [FeedID] -> m () check feedIDs = do - results <- forM (zip ([1..] :: [Int]) feedIDs) $ \(i, feedID) -> do + results <- for (zip ([1..] :: [Int]) feedIDs) $ \(i, feedID) -> do logInfo $ brackets (fill width (bold $ cyan $ pretty i) <+> "/" <+> pretty total) <+> "Checking" <+> magenta (pretty feedID) <> "..." try $ checkOne feedID + flushLogs + putBox $ statusTableToBox $ mapFromList $ zip feedIDs results + + let (failures, successes) = partitionEithers $ zipWith (\a -> bimap (a,) (a,)) feedIDs results + unless (null failures) $ logError $ bold (pretty $ length failures) <+> "feeds in error" + forM_ failures $ \(feedID, e) -> + logError $ indent 2 (pretty feedID <++> indent 2 (pretty $ displayException e)) + where width = length (show total :: String) total = length feedIDs -checkOne :: (MonadIO m, MonadCatch m, LoggerF :<: f, Functor f, MonadFree f m, DatabaseF' :<: f, HttpClientF :<: f) +checkOne :: (MonadIO m, MonadCatch m, LoggerF :<: f, MonadFree f m, DatabaseF' :<: f, HttpClientF :<: f, XmlParserF :<: f) => FeedID -> m Int -checkOne feedID@(FeedID uri) = do - body <- HTTP.get uri - feed <- runConduit $ parseLBS def body =$= force "Invalid feed" ((fmap Left <$> atomFeed) `orE` (fmap Right <$> rssDocument)) - +checkOne feedID = do + feed <- getFeed feedID case feed of - Left _ -> logDebug $ "Parsed Atom feed: " <> pretty feedID - Right _ -> logDebug $ "Parsed RSS feed: " <> pretty feedID + Atom _ -> logDebug $ "Parsed Atom feed: " <> pretty feedID + Rss _ -> logDebug $ "Parsed RSS feed: " <> pretty feedID - let dates = either - (map entryUpdated . feedEntries) - (mapMaybe itemPubDate . channelItems) - feed + let dates = mapMaybe getDate $ getElements feed - logDebug $ vsep $ either (map prettyEntry . feedEntries) (map prettyItem . channelItems) feed + logDebug $ vsep $ map prettyElement $ getElements feed status <- Database.getStatus feedID return $ length $ filter (unread status) dates @@ -117,10 +117,10 @@ unread _ _ = True -run :: (MonadIO m, MonadCatch m, HooksF :<: f, LoggerF :<: f, Functor f, MonadFree f m, DatabaseF' :<: f, HttpClientF :<: f) +run :: (MonadIO m, MonadCatch m, HooksF :<: f, LoggerF :<: f, MonadFree f m, DatabaseF' :<: f, HttpClientF :<: f, XmlParserF :<: f) => [FeedID] -> m () run feedIDs = do - results <- forM (zip ([1..] :: [Int]) feedIDs) $ \(i, feedID) -> do + results <- for (zip ([1..] :: [Int]) feedIDs) $ \(i, feedID) -> do logInfo $ brackets (fill width (bold $ cyan $ pretty i) <+> "/" <+> pretty total) <+> "Processing" <+> magenta (pretty feedID) <> "..." result <- tryAny $ runOne feedID return $ bimap (feedID,) (feedID,) result @@ -136,14 +136,13 @@ where width = length (show total :: String) total = length feedIDs -runOne :: (MonadIO m, MonadCatch m, HooksF :<: f, LoggerF :<: f, Functor f, MonadFree f m, DatabaseF' :<: f, HttpClientF :<: f) +runOne :: (MonadIO m, MonadCatch m, HooksF :<: f, LoggerF :<: f, MonadFree f m, DatabaseF' :<: f, HttpClientF :<: f, XmlParserF :<: f) => FeedID -> m () -runOne feedID@(FeedID uri) = do - body <- HTTP.get uri - feed <- runConduit $ parseLBS def body =$= force "Invalid feed" ((fmap Atom <$> atomFeed) `orE` (fmap Rss <$> rssDocument)) +runOne feedID = do + feed <- getFeed feedID unreadElements <- filterM (fmap not . isRead feedID) $ getElements feed - unless (null unreadElements) $ logInfo $ indent 2 $ green (pretty $ length unreadElements) <+> "unread element(s)" + unless (null unreadElements) $ logInfo $ indent 2 $ green (pretty $ length unreadElements) <+> "new element(s)" forM_ unreadElements $ \element -> do onNewElement feed element @@ -152,7 +151,7 @@ Database.markAsRead feedID -isRead :: (Functor f, MonadCatch m, DatabaseF' :<: f, MonadFree f m) => FeedID -> FeedElement -> m Bool +isRead :: (MonadCatch m, DatabaseF' :<: f, MonadFree f m) => FeedID -> FeedElement -> m Bool isRead feedID element = do DatabaseEntry _ _ readHashes lastCheck <- Database.fetch FeedTable feedID let matchHash = not $ null $ (setFromList (getHashes element) :: Set Int) `intersection` readHashes @@ -163,18 +162,23 @@ return $ matchHash || matchDate -- | 'subscribe' to all feeds described by the OPML document provided in input (stdin) -importOPML :: (MonadIO m, LoggerF :<: f, Functor f, MonadFree f m, DatabaseF' :<: f, MonadCatch m) => m () +importOPML :: (MonadIO m, LoggerF :<: f, MonadFree f m, DatabaseF' :<: f, MonadCatch m) => m () importOPML = do opml <- runConduit $ Conduit.stdin =$= XML.parseBytes def =$= force "Invalid OPML" parseOpml forM_ (opmlOutlines opml) $ importOPML' mempty -importOPML' :: (MonadIO m, LoggerF :<: f, Functor f, MonadFree f m, DatabaseF' :<: f, MonadCatch m) +importOPML' :: (MonadIO m, LoggerF :<: f, MonadFree f m, DatabaseF' :<: f, MonadCatch m) => Maybe Text -> Tree OpmlOutline -> m () importOPML' _ (Node (OpmlOutlineGeneric b _) sub) = mapM_ (importOPML' (Just . toNullable $ OPML.text b)) sub importOPML' c (Node (OpmlOutlineSubscription _ s) _) = subscribe (xmlUri s) c importOPML' _ _ = return () +getFeed :: (MonadIO m, MonadCatch m, MonadFree f m, HttpClientF :<: f, LoggerF :<: f, XmlParserF :<: f) + => FeedID -> m Feed +getFeed (FeedID uri) = HTTP.get uri >>= parseXml uri + + -- * Boxes putBox :: (Orientation a, MonadIO m) => Box a -> m () @@ -202,6 +206,6 @@ statusTableToBox t = tableByColumns $ Rainbox.intersperse sep $ fromList [col1, col2, col3] where result = sortBy (comparing fst) $ Map.toList t col1 = fromList $ cell "# UNREAD" : map (cell . either (const "?") show . snd) result - col2 = fromList $ cell "STATUS" : map (cell . either (fromString . displayException) (const "OK") . snd) result + col2 = fromList $ cell "STATUS" : map (cell . either (const "ERROR") (const "OK") . snd) result col3 = fromList $ cell "FEED" : map (cell . show . pretty . fst) result sep = fromList [separator mempty 2] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Database/FeedTable.hs new/imm-1.2.0.0/src/lib/Imm/Database/FeedTable.hs --- old/imm-1.1.0.0/src/lib/Imm/Database/FeedTable.hs 2016-10-01 00:18:43.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Database/FeedTable.hs 2017-03-19 10:26:16.000000000 +0100 @@ -95,19 +95,19 @@ -- * Primitives -register :: (MonadThrow m, LoggerF :<: f, DatabaseF' :<: f, Functor f, MonadFree f m) +register :: (MonadThrow m, LoggerF :<: f, DatabaseF' :<: f, MonadFree f m) => FeedID -> Text -> m () register feedID category = do logInfo $ "Registering feed " <> magenta (pretty feedID) <> "..." insert FeedTable feedID $ newDatabaseEntry feedID category -getStatus :: (DatabaseF' :<: f, Functor f, MonadFree f m, MonadCatch m) +getStatus :: (DatabaseF' :<: f, MonadFree f m, MonadCatch m) => FeedID -> m FeedStatus getStatus feedID = handleAny (\_ -> return Unknown) $ do result <- fmap Just (fetch FeedTable feedID) `catchAny` (\_ -> return Nothing) return $ maybe New LastUpdate $ entryLastCheck =<< result -addReadHash :: (DatabaseF' :<: f, Functor f, MonadFree f m, MonadThrow m, LoggerF :<: f) +addReadHash :: (DatabaseF' :<: f, MonadFree f m, MonadThrow m, LoggerF :<: f) => FeedID -> Int -> m () addReadHash feedID hash = do logDebug $ "Adding read hash: " <> pretty hash <> "..." @@ -115,7 +115,7 @@ where f a = a { entryReadHashes = insertSet hash $ entryReadHashes a } -- | Set the last check time to now -markAsRead :: (MonadIO m, DatabaseF' :<: f, Functor f, MonadFree f m, MonadThrow m, LoggerF :<: f) +markAsRead :: (MonadIO m, DatabaseF' :<: f, MonadFree f m, MonadThrow m, LoggerF :<: f) => FeedID -> m () markAsRead feedID = do logDebug $ "Marking feed as read: " <> pretty feedID <> "..." @@ -124,7 +124,7 @@ where f time a = a { entryLastCheck = Just time } -- | Unset feed's last update and remove all read hashes -markAsUnread :: (DatabaseF' :<: f, Functor f, MonadFree f m, MonadThrow m, LoggerF :<: f) +markAsUnread :: (DatabaseF' :<: f, MonadFree f m, MonadThrow m, LoggerF :<: f) => FeedID -> m () markAsUnread feedID = do logInfo $ "Marking feed as unread: " <> show (pretty feedID) <> "..." diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Database/JsonFile.hs new/imm-1.2.0.0/src/lib/Imm/Database/JsonFile.hs --- old/imm-1.1.0.0/src/lib/Imm/Database/JsonFile.hs 2016-08-22 15:15:42.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Database/JsonFile.hs 2017-03-19 10:26:16.000000000 +0100 @@ -39,9 +39,9 @@ mkJsonFileDatabase :: (Table t) => FilePath -> JsonFileDatabase t mkJsonFileDatabase file = JsonFileDatabase file mempty Empty --- | Default database is stored in @$XDG_DATA_HOME\/imm\/feeds.json@ +-- | Default database is stored in @$XDG_CONFIG_HOME\/imm\/feeds.json@ defaultDatabase :: Table t => IO (JsonFileDatabase t) -defaultDatabase = mkJsonFileDatabase <$> getXdgDirectory XdgData "imm/feeds.json" +defaultDatabase = mkJsonFileDatabase <$> getXdgDirectory XdgConfig "imm/feeds.json" data JsonException = UnableDecode diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Database.hs new/imm-1.2.0.0/src/lib/Imm/Database.hs --- old/imm-1.1.0.0/src/lib/Imm/Database.hs 2016-09-27 23:01:07.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Database.hs 2017-03-19 10:26:16.000000000 +0100 @@ -111,62 +111,62 @@ -- * Primitives -describeDatabase :: (Functor f, MonadFree f m, DatabaseF t :<: f) +describeDatabase :: (MonadFree f m, DatabaseF t :<: f) => t -> m Doc describeDatabase t = liftF . inj $ Describe t id -fetch :: (Functor f, MonadFree f m, DatabaseF t :<: f, Table t, MonadThrow m) +fetch :: (MonadFree f m, DatabaseF t :<: f, Table t, MonadThrow m) => t -> Key t -> m (Entry t) fetch t k = do results <- liftF . inj $ FetchList t [k] id result <- lookup k <$> liftE results maybe (throwM $ NotFound t [k]) return result -fetchList :: (Functor f, MonadFree f m, DatabaseF t :<: f, MonadThrow m) +fetchList :: (MonadFree f m, DatabaseF t :<: f, MonadThrow m) => t -> [Key t] -> m (Map (Key t) (Entry t)) fetchList t k = do result <- liftF . inj $ FetchList t k id liftE result -fetchAll :: (MonadThrow m, Functor f, MonadFree f m, DatabaseF t :<: f) => t -> m (Map (Key t) (Entry t)) +fetchAll :: (MonadThrow m, MonadFree f m, DatabaseF t :<: f) => t -> m (Map (Key t) (Entry t)) fetchAll t = do result <- liftF . inj $ FetchAll t id liftE result -update :: (Functor f, MonadFree f m, DatabaseF t :<: f, MonadThrow m) +update :: (MonadFree f m, DatabaseF t :<: f, MonadThrow m) => t -> Key t -> (Entry t -> Entry t) -> m () update t k f = do result <- liftF . inj $ Update t k f id liftE result -insert :: (MonadThrow m, Functor f, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) +insert :: (MonadThrow m, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) => t -> Key t -> Entry t -> m () insert t k v = insertList t [(k, v)] -insertList :: (MonadThrow m, Functor f, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) +insertList :: (MonadThrow m, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) => t -> [(Key t, Entry t)] -> m () insertList t i = do logInfo $ "Inserting " <> yellow (pretty $ length i) <> " entries..." result <- liftF . inj $ InsertList t i id liftE result -delete :: (MonadThrow m, Functor f, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) => t -> Key t -> m () +delete :: (MonadThrow m, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) => t -> Key t -> m () delete t k = deleteList t [k] -deleteList :: (MonadThrow m, Functor f, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) +deleteList :: (MonadThrow m, MonadFree f m, LoggerF :<: f, DatabaseF t :<: f) => t -> [Key t] -> m () deleteList t k = do logInfo $ "Deleting " <> yellow (pretty $ length k) <> " entries..." result <- liftF . inj $ DeleteList t k id liftE result -purge :: (MonadThrow m, Functor f, MonadFree f m, DatabaseF t :<: f, LoggerF :<: f) => t -> m () +purge :: (MonadThrow m, MonadFree f m, DatabaseF t :<: f, LoggerF :<: f) => t -> m () purge t = do logInfo "Purging database..." result <- liftF . inj $ Purge t id liftE result -commit :: (MonadThrow m, Functor f, MonadFree f m, DatabaseF t :<: f, LoggerF :<: f) => t -> m () +commit :: (MonadThrow m, MonadFree f m, DatabaseF t :<: f, LoggerF :<: f) => t -> m () commit t = do logDebug "Committing database transaction..." result <- liftF . inj $ Commit t id diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Feed.hs new/imm-1.2.0.0/src/lib/Imm/Feed.hs --- old/imm-1.1.0.0/src/lib/Imm/Feed.hs 2016-10-09 14:19:07.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Feed.hs 2017-03-19 10:26:16.000000000 +0100 @@ -7,7 +7,6 @@ import Imm.Pretty import Data.Hashable -import Data.NonNull import Data.Time import Text.Atom.Types @@ -57,3 +56,10 @@ <> [hash $ itemTitle item] <> [hash $ itemDescription item] getHashes (AtomElement entry) = [hash $ entryId entry, (hash :: String -> Int) $ show $ prettyAtomText $ entryTitle entry] + + +-- * Misc + +prettyElement :: FeedElement -> Doc +prettyElement (RssElement item) = prettyItem item +prettyElement (AtomElement entry) = prettyEntry entry diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/HTTP.hs new/imm-1.2.0.0/src/lib/Imm/HTTP.hs --- old/imm-1.1.0.0/src/lib/Imm/HTTP.hs 2016-09-27 23:51:58.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/HTTP.hs 2017-03-19 10:26:16.000000000 +0100 @@ -40,7 +40,7 @@ -- * Primitives -- | Perform an HTTP GET request -get :: (MonadFree f m, Functor f, HttpClientF :<: f, LoggerF :<: f, MonadThrow m) +get :: (MonadFree f m, HttpClientF :<: f, LoggerF :<: f, MonadThrow m) => URI -> m LByteString get uri = do logDebug $ "Fetching " <> prettyURI uri diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Hooks/WriteFile.hs new/imm-1.2.0.0/src/lib/Imm/Hooks/WriteFile.hs --- old/imm-1.1.0.0/src/lib/Imm/Hooks/WriteFile.hs 2016-10-16 22:24:40.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Hooks/WriteFile.hs 2017-03-19 10:26:16.000000000 +0100 @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} @@ -11,7 +12,9 @@ import Imm.Prelude import Imm.Pretty -import Data.Monoid.Textual hiding (map) +import Control.Arrow + +import Data.Monoid.Textual hiding (elem, map) import qualified Data.Text.Lazy as Text import Data.Time @@ -19,9 +22,10 @@ import System.FilePath import Text.Atom.Types -import qualified Text.Blaze as Blaze import Text.Blaze.Html.Renderer.Text -import Text.Blaze.Html5 as H hiding (map) +import Text.Blaze.Html5 (Html, docTypeHtml, + preEscapedToHtml, (!)) +import qualified Text.Blaze.Html5 as H hiding (map) import Text.Blaze.Html5.Attributes as H (charset, href) import Text.RSS.Types @@ -57,9 +61,12 @@ defaultFilePath :: FilePath -> Feed -> FeedElement -> FilePath defaultFilePath root feed element = makeValid $ root </> feedTitle </> fileName <.> "html" where date = maybe "" (formatTime defaultTimeLocale "%F-") $ getDate element - fileName = date <> convertText (sanitizePath $ getTitle element) - feedTitle = convertText $ sanitizePath $ getFeedTitle feed - sanitizePath = intercalate "-" . split isPathSeparator + fileName = date <> sanitize (convertText $ getTitle element) + feedTitle = sanitize $ convertText $ getFeedTitle feed + sanitize = replaceIf isPathSeparator '-' >>> replaceAny ".?!#" '_' + replaceAny :: [Char] -> Char -> String -> String + replaceAny list = replaceIf (`elem` list) + replaceIf f b = map (\c -> if f c then b else c) -- | Generate an HTML page, with a title, a header and an article that contains the feed element defaultFileContent :: Feed -> FeedElement -> ByteString @@ -67,9 +74,9 @@ H.head $ do H.meta ! H.charset "utf-8" H.title $ convertText $ getFeedTitle feed <> " | " <> getTitle element - body $ do + H.body $ do H.h1 $ convertText $ getFeedTitle feed - article $ do + H.article $ do defaultHeader feed element defaultBody feed element @@ -78,29 +85,29 @@ -- | Generate an HTML @<header>@ for a given feed element defaultHeader :: Feed -> FeedElement -> Html -defaultHeader _ element@(RssElement item) = header $ do +defaultHeader _ element@(RssElement item) = H.header $ do H.h2 $ maybe id (\uri -> H.a ! H.href uri) link $ convertText $ getTitle element - unless (null author) $ address $ "Published by " >> convertText author - forM_ (itemPubDate item) $ \date -> p $ " on " >> time (convertDoc $ prettyTime date) + unless (null author) $ H.address $ "Published by " >> convertText author + forM_ (itemPubDate item) $ \date -> H.p $ " on " >> H.time (convertDoc $ prettyTime date) where link = withRssURI (convertDoc . prettyURI) <$> itemLink item author = itemAuthor item -defaultHeader _ element@(AtomElement entry) = header $ do +defaultHeader _ element@(AtomElement entry) = H.header $ do H.h2 $ convertText $ getTitle element - address $ do + H.address $ do "Published by " forM_ (entryAuthors entry) $ \author -> do convertDoc $ prettyPerson author ", " - p $ "on " >> time (convertDoc $ prettyTime $ entryUpdated entry) + H.p $ "on " >> H.time (convertDoc $ prettyTime $ entryUpdated entry) -- | Generate the HTML content for a given feed element defaultBody :: Feed -> FeedElement -> Html -defaultBody _ (RssElement item) = p $ preEscapedToHtml $ itemDescription item +defaultBody _ (RssElement item) = H.p $ preEscapedToHtml $ itemDescription item defaultBody _ (AtomElement entry) = do - unless (null links) $ p $ do + unless (null links) $ H.p $ do "Related links:" H.ul $ forM_ links $ \uri -> H.li (H.a ! H.href (convertAtomURI uri) $ convertAtomURI uri) - p $ preEscapedToHtml $ fromMaybe "<empty>" $ content <|> summary + H.p $ preEscapedToHtml $ fromMaybe "<empty>" $ content <|> summary where links = map linkHref $ entryLinks entry content = show . prettyAtomContent <$> entryContent entry :: Maybe Text summary = show . prettyAtomText <$> entrySummary entry :: Maybe Text diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Hooks.hs new/imm-1.2.0.0/src/lib/Imm/Hooks.hs --- old/imm-1.1.0.0/src/lib/Imm/Hooks.hs 2016-08-21 10:48:44.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Hooks.hs 2017-03-19 10:26:16.000000000 +0100 @@ -37,7 +37,7 @@ -- * Primitives -onNewElement :: (Functor f, MonadFree f m, LoggerF :<: f, HooksF :<: f) => Feed -> FeedElement -> m () +onNewElement :: (MonadFree f m, LoggerF :<: f, HooksF :<: f) => Feed -> FeedElement -> m () onNewElement feed element = do logDebug $ "Unread element:" <+> textual (getTitle element) liftF . inj $ OnNewElement feed element () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Logger.hs new/imm-1.2.0.0/src/lib/Imm/Logger.hs --- old/imm-1.1.0.0/src/lib/Imm/Logger.hs 2016-10-23 17:50:25.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Logger.hs 2017-03-19 10:26:16.000000000 +0100 @@ -64,24 +64,24 @@ -- * Primitives -log :: (Functor f, MonadFree f m, LoggerF :<: f) => LogLevel -> Doc -> m () +log :: (MonadFree f m, LoggerF :<: f) => LogLevel -> Doc -> m () log level message = liftF . inj $ Log level message () -getLogLevel :: (Functor f, MonadFree f m, LoggerF :<: f) => m LogLevel +getLogLevel :: (MonadFree f m, LoggerF :<: f) => m LogLevel getLogLevel = liftF . inj $ GetLevel id -setLogLevel :: (Functor f, MonadFree f m, LoggerF :<: f) => LogLevel -> m () +setLogLevel :: (MonadFree f m, LoggerF :<: f) => LogLevel -> m () setLogLevel level = liftF . inj $ SetLevel level () -setColorizeLogs :: (Functor f, MonadFree f m, LoggerF :<: f) => Bool -> m () +setColorizeLogs :: (MonadFree f m, LoggerF :<: f) => Bool -> m () setColorizeLogs colorize = liftF . inj $ SetColorize colorize () -flushLogs :: (Functor f, MonadFree f m, LoggerF :<: f) => m () +flushLogs :: (MonadFree f m, LoggerF :<: f) => m () flushLogs = liftF . inj $ Flush () -- * Helpers -logDebug, logInfo, logWarning, logError :: (Functor f, MonadFree f m, LoggerF :<: f) => Doc -> m () +logDebug, logInfo, logWarning, logError :: (MonadFree f m, LoggerF :<: f) => Doc -> m () logDebug = log Debug logInfo = log Info logWarning = log Warning diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Options.hs new/imm-1.2.0.0/src/lib/Imm/Options.hs --- old/imm-1.1.0.0/src/lib/Imm/Options.hs 2016-10-12 20:21:56.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Options.hs 2017-03-19 10:26:16.000000000 +0100 @@ -68,7 +68,7 @@ -- ++ catMaybes [("CONFIG=" ++) <$> opts^.configurationLabel_] parseOptions :: (MonadIO m) => m CliOptions -parseOptions = io $ customExecParser (defaultPrefs {- noBacktrack -} ) (info parser $ progDesc "Fetch elements from RSS/Atom feeds and execute arbitrary actions for each of them.") +parseOptions = io $ customExecParser (prefs noBacktrack) (info parser $ progDesc "Convert items from RSS/Atom feeds to mails.") where parser = helper <*> optional dyreMasterBinary *> optional dyreDebug *> cliOptions diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Prelude.hs new/imm-1.2.0.0/src/lib/Imm/Prelude.hs --- old/imm-1.1.0.0/src/lib/Imm/Prelude.hs 2016-10-23 19:10:49.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Prelude.hs 2017-03-19 10:26:16.000000000 +0100 @@ -45,7 +45,7 @@ import Data.Tagged import qualified Data.Text as T (Text ()) import qualified Data.Text.Lazy as LT (Text ()) -import Data.Traversable as X (forM) +import Data.Traversable as X (for, forM) import Data.Typeable as X import qualified GHC.Show as Show @@ -81,13 +81,13 @@ infixr 0 ::: -- | Right-associative tuple data-constructor -(>:) :: a -> b -> (a,b) -(>:) a b = (a, b) -infixr 0 >: - -(*:*) :: (Functor f, Functor g) => (a -> f a) -> (b -> g b) -> (a, b) -> Product f g (a, b) -(*:*) f g (a,b) = Pair ((,b) <$> f a) ((a,) <$> g b) -infixr 0 *:* +(+:) :: a -> b -> (a,b) +(+:) a b = (a, b) +infixr 0 +: + +(*:) :: (Functor f, Functor g) => (a -> f a) -> (b -> g b) -> (a, b) -> Product f g (a, b) +(*:) f g (a,b) = Pair ((,b) <$> f a) ((a,) <$> g b) +infixr 0 *: data HLeft diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/Pretty.hs new/imm-1.2.0.0/src/lib/Imm/Pretty.hs --- old/imm-1.1.0.0/src/lib/Imm/Pretty.hs 2016-08-23 01:04:31.000000000 +0200 +++ new/imm-1.2.0.0/src/lib/Imm/Pretty.hs 2017-03-19 10:26:16.000000000 +0100 @@ -16,7 +16,8 @@ import Text.Atom.Types as Atom -- import Text.OPML.Types as OPML hiding (text) -- import qualified Text.OPML.Types as OPML -import Text.PrettyPrint.ANSI.Leijen as X hiding ((<$>), (</>), (<>)) +import Text.PrettyPrint.ANSI.Leijen as X hiding (sep, width, (<$>), + (</>), (<>)) import Text.RSS.Types as RSS import URI.ByteString diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/XML/Simple.hs new/imm-1.2.0.0/src/lib/Imm/XML/Simple.hs --- old/imm-1.1.0.0/src/lib/Imm/XML/Simple.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/imm-1.2.0.0/src/lib/Imm/XML/Simple.hs 2017-03-19 10:26:16.000000000 +0100 @@ -0,0 +1,37 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +-- | Simple interpreter to parse XML into 'Feed', based on 'Conduit'. +module Imm.XML.Simple where + +-- {{{ Imports +import Imm.Feed +import Imm.Prelude +import Imm.XML + +import Control.Monad +import Control.Monad.Fix + +import Data.Conduit +import Data.XML.Types + +import Text.Atom.Conduit.Parse +import Text.RSS.Conduit.Parse +import Text.RSS1.Conduit.Parse +import Text.XML.Stream.Parse + +import URI.ByteString +-- }}} + +-- | A 'Conduit' to alter the raw XML before feeding it to the parser, depending on the feed 'URI' +type PreProcess m = URI -> Conduit Event m Event + +-- | Interpreter for 'XmlParserF' +mkCoXmlParser :: (MonadIO m, MonadCatch m) => PreProcess m -> CoXmlParserF m (PreProcess m) +mkCoXmlParser preProcess = CoXmlParserF coParse where + coParse uri bytestring = handleAny (\e -> return (Left e, preProcess)) $ do + result <- runConduit $ parseLBS def bytestring =$= preProcess uri =$= force "Invalid feed" ((fmap Atom <$> atomFeed) `orE` (fmap Rss <$> rssDocument) `orE` (fmap Rss <$> rss1Document)) + return (Right result, preProcess) + +-- | Default pre-process always forwards all 'Event's +defaultPreProcess :: Monad m => PreProcess m +defaultPreProcess _ = fix $ \loop -> await >>= maybe (return ()) (yield >=> const loop) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/imm-1.1.0.0/src/lib/Imm/XML.hs new/imm-1.2.0.0/src/lib/Imm/XML.hs --- old/imm-1.1.0.0/src/lib/Imm/XML.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/imm-1.2.0.0/src/lib/Imm/XML.hs 2017-03-19 10:26:16.000000000 +0100 @@ -0,0 +1,45 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeOperators #-} +-- | DSL/interpreter model for parsing XML into a 'Feed' +module Imm.XML where + +-- {{{ Imports +import Imm.Error +import Imm.Feed +import Imm.Prelude + +import Control.Monad.Trans.Free + +import URI.ByteString +-- }}} + +-- * Types + +-- | XML parsing DSL +data XmlParserF next + = ParseXml URI LByteString (Either SomeException Feed -> next) + deriving(Functor) + +-- | XML parsing interpreter +newtype CoXmlParserF m a = CoXmlParserF + { parseXmlH :: URI -> LByteString -> m (Either SomeException Feed, a) + } deriving(Functor) + +instance Monad m => PairingM (CoXmlParserF m) XmlParserF m where + -- pairM :: (a -> b -> m r) -> f a -> g b -> m r + pairM f (CoXmlParserF p) (ParseXml uri bytestring next) = do + (result, a) <- p uri bytestring + f a $ next result + +-- * Primitives + +-- | Parse XML into a 'Feed' +parseXml :: (MonadFree f m, XmlParserF :<: f, MonadThrow m) + => URI -> LByteString -> m Feed +parseXml uri bytestring = do + result <- liftF . inj $ ParseXml uri bytestring id + liftE result

1 0

commit ghc-ilist for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-ilist for openSUSE:Factory checked in at 2017-08-31 20:56:30 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-ilist (Old) and /work/SRC/openSUSE:Factory/.ghc-ilist.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-ilist" Thu Aug 31 20:56:30 2017 rev:2 rq:513398 version:0.3.1.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-ilist/ghc-ilist.changes 2017-04-12 18:07:14.694070606 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-ilist.new/ghc-ilist.changes 2017-08-31 20:56:31.442906060 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:04:45 UTC 2017 - psimons(a)suse.com + +- Update to version 0.3.1.0. + +------------------------------------------------------------------- Old: ---- ilist-0.2.0.0.tar.gz New: ---- ilist-0.3.1.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-ilist.spec ++++++ --- /var/tmp/diff_new_pack.Hks5hj/_old 2017-08-31 20:56:32.282788054 +0200 +++ /var/tmp/diff_new_pack.Hks5hj/_new 2017-08-31 20:56:32.310784120 +0200 @@ -19,7 +19,7 @@ %global pkg_name ilist %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.2.0.0 +Version: 0.3.1.0 Release: 0 Summary: Optimised list functions for doing index-related things License: BSD-3-Clause @@ -36,7 +36,9 @@ %description Optimised list functions for doing index-related things. They're faster than -common idioms in all cases, and sometimes they fuse better as well. +common idioms in all cases, they avoid +<https://ghc.haskell.org/trac/ghc/ticket/12620 space leaks>, and sometimes they +fuse better as well. %package devel Summary: Haskell %{pkg_name} library development files ++++++ ilist-0.2.0.0.tar.gz -> ilist-0.3.1.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ilist-0.2.0.0/CHANGELOG.md new/ilist-0.3.1.0/CHANGELOG.md --- old/ilist-0.2.0.0/CHANGELOG.md 2016-05-24 23:12:55.000000000 +0200 +++ new/ilist-0.3.1.0/CHANGELOG.md 2017-06-19 23:55:08.000000000 +0200 @@ -1,3 +1,11 @@ +# 0.3.1.0 + +* Added `ireplicateM` and `ireplicateM_`. + +# 0.3.0.0 + +* `ifind` now returns the index alongside with the value (same as in `lens`). + # 0.2.0.0 * `izipWithM` and `izipWithM_` have been generalised from `Monad` to `Applicative` (which mimics what was done in base-4.9). diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ilist-0.2.0.0/bench/Functions.hs new/ilist-0.3.1.0/bench/Functions.hs --- old/ilist-0.2.0.0/bench/Functions.hs 2016-05-24 23:12:55.000000000 +0200 +++ new/ilist-0.3.1.0/bench/Functions.hs 2017-06-19 23:55:08.000000000 +0200 @@ -1,6 +1,7 @@ {-# LANGUAGE MagicHash, -BangPatterns +BangPatterns, +CPP #-} @@ -16,6 +17,7 @@ import Data.List import Data.List.Index import Control.Monad +import qualified Control.Loop as Loop indexed_zip :: [a] -> [(Int, a)] @@ -94,6 +96,20 @@ go (i +# 1#) xs {-# INLINE imapM__rec #-} +#if __GLASGOW_HASKELL__ < 710 +ireplicateM__loop + :: (Monad m, Functor m) => Int -> (Int -> m a) -> m () +#else +ireplicateM__loop + :: Monad m => Int -> (Int -> m a) -> m () +#endif +ireplicateM__loop n f = Loop.numLoop 0 (n-1) (void . f) +{-# INLINE ireplicateM__loop #-} + +ireplicateM__for :: Monad m => Int -> (Int -> m a) -> m () +ireplicateM__for n f = forM_ [0..n-1] f +{-# INLINE ireplicateM__for #-} + iall_zip :: (Int -> a -> Bool) -> [a] -> Bool iall_zip p xs = and (zipWith p [0..] xs) {-# INLINE iall_zip #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ilist-0.2.0.0/bench/Main.hs new/ilist-0.3.1.0/bench/Main.hs --- old/ilist-0.2.0.0/bench/Main.hs 2016-05-24 23:12:55.000000000 +0200 +++ new/ilist-0.3.1.0/bench/Main.hs 2017-06-19 23:55:08.000000000 +0200 @@ -106,6 +106,16 @@ bench "lens" $ nf (\n -> flip runState [] $ L.imapM_ (\i x -> modify ((i+x):) >> return (i-x)) [0..n]) 100000, bench "our" $ nf (\n -> flip runState [] $ imapM_ (\i x -> modify ((i+x):) >> return (i-x)) [0..n]) 100000 ] ], + bgroup "ireplicateM_" [ + bgroup "Just" [ + bench "loop" $ nf (\n -> ireplicateM__loop n (\i -> if i<50000 then Just i else Nothing)) 100000, + bench "for" $ nf (\n -> ireplicateM__for n (\i -> if i<50000 then Just i else Nothing)) 100000, + bench "our" $ nf (\n -> ireplicateM_ n (\i -> if i<50000 then Just i else Nothing)) 100000 ], + bgroup "State" [ + bench "loop" $ nf (\n -> flip runState 0 $ ireplicateM__loop n (\i -> modify' (i+))) 100000, + bench "for" $ nf (\n -> flip runState 0 $ ireplicateM__for n (\i -> modify' (i+))) 100000, + bench "our" $ nf (\n -> flip runState 0 $ ireplicateM_ n (\i -> modify' (i+))) 100000 ] ], + bgroup "ifilter" [ bgroup "consume" [ bench "rec" $ nf (\n -> sum $ ifilter_rec (\i x -> rem (i+x) 5000 == 0) [0..n]) 100000, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ilist-0.2.0.0/ilist.cabal new/ilist-0.3.1.0/ilist.cabal --- old/ilist-0.2.0.0/ilist.cabal 2016-05-24 23:12:55.000000000 +0200 +++ new/ilist-0.3.1.0/ilist.cabal 2017-06-19 23:55:08.000000000 +0200 @@ -1,8 +1,8 @@ name: ilist -version: 0.2.0.0 +version: 0.3.1.0 synopsis: Optimised list functions for doing index-related things description: - Optimised list functions for doing index-related things. They're faster than common idioms in all cases, and sometimes they fuse better as well. + Optimised list functions for doing index-related things. They're faster than common idioms in all cases, they avoid <https://ghc.haskell.org/trac/ghc/ticket/12620 space leaks>, and sometimes they fuse better as well. homepage: http://github.com/aelve/ilist bug-reports: http://github.com/aelve/ilist/issues license: BSD3 @@ -49,6 +49,7 @@ , ilist -- imapM_ is broken in 4.13.2 , lens >= 4.13.2.1 + , loop , transformers , vector ghc-options: -O2 -Wall -fno-warn-unused-do-bind diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ilist-0.2.0.0/lib/Data/List/Index.hs new/ilist-0.3.1.0/lib/Data/List/Index.hs --- old/ilist-0.2.0.0/lib/Data/List/Index.hs 2016-05-24 23:12:55.000000000 +0200 +++ new/ilist-0.3.1.0/lib/Data/List/Index.hs 2017-06-19 23:55:08.000000000 +0200 @@ -58,6 +58,7 @@ -- ** Monadic functions iforM, iforM_, itraverse, itraverse_, + ireplicateM, ireplicateM_, ifoldrM, ifoldlM, @@ -342,6 +343,31 @@ ifor_ = flip itraverse_ {-# INLINE ifor_ #-} +{- | +Perform a given action @n@ times. Behaves like @for_ [0..n-1]@, but avoids <https://ghc.haskell.org/trac/ghc/ticket/12620 space leaks>. + +If you want more complicated loops (e.g. counting downwards), consider the <https://hackage.haskell.org/package/loop loop> package. +-} +ireplicateM :: Applicative m => Int -> (Int -> m a) -> m [a] +ireplicateM cnt f = go 0 + where + go !i | i >= cnt = pure [] + | otherwise = (:) <$> f i <*> go (i + 1) +{-# INLINE ireplicateM #-} + +{- | +NB. This function intentionally uses 'Monad' even though 'Applicative' is enough. That's because the @transformers@ package didn't have an optimized definition of ('*>') for 'StateT' prior to 0.5.3.0, so for a common case of 'StateT' this function would be 40 times slower with the 'Applicative' constraint. +-} +ireplicateM_ :: Monad m => Int -> (Int -> m a) -> m () +ireplicateM_ cnt f = if cnt > 0 then go 0 else return () + where + -- this is 30% faster for Maybe than the simpler + -- go i | i == cnt = return () + -- | otherwise = f i >> go (i + 1) + cnt_ = cnt-1 + go !i = if i == cnt_ then f i >> return () else f i >> go (i + 1) +{-# INLINE ireplicateM_ #-} + -- Using unboxed ints here doesn't seem to result in any benefit ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b ifoldr f z xs = foldr (\x g i -> f i x (g (i+1))) (const z) xs 0 @@ -493,8 +519,13 @@ iselect p i x ~(ts,fs) | p i x = (x:ts,fs) | otherwise = (ts, x:fs) -ifind :: (Int -> a -> Bool) -> [a] -> Maybe a -ifind p = listToMaybe . ifilter p +ifind :: (Int -> a -> Bool) -> [a] -> Maybe (Int, a) +ifind p ls = go 0# ls + where + go i (x:xs) | p (I# i) x = Just (I# i, x) + | otherwise = go (i +# 1#) xs + go _ _ = Nothing +{-# INLINE ifind #-} ifindIndex :: (Int -> a -> Bool) -> [a] -> Maybe Int ifindIndex p = listToMaybe . ifindIndices p diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/ilist-0.2.0.0/tests/Main.hs new/ilist-0.3.1.0/tests/Main.hs --- old/ilist-0.2.0.0/tests/Main.hs 2016-05-24 23:12:55.000000000 +0200 +++ new/ilist-0.3.1.0/tests/Main.hs 2017-06-19 23:55:08.000000000 +0200 @@ -136,7 +136,7 @@ specify "basic" $ do let f i x = modify ((i,x):) >> return (i-x) let (resA, stA) = runState (imapM f [1,3..9]) [] - let (resB, stB) = runState (itraverse f [1,3..9]) [] + (resB, stB) = runState (itraverse f [1,3..9]) [] resA `shouldBe` [0-1,1-3,2-5,3-7,4-9] resB `shouldBe` [0-1,1-3,2-5,3-7,4-9] stA `shouldBe` reverse (zip [0..4] [1,3..9]) @@ -154,10 +154,25 @@ specify "basic" $ do let f i x = modify ((i,x):) >> return (i-x) let stA = execState (imapM_ f [1,3..9]) [] - let stB = execState (itraverse_ f [1,3..9]) [] + stB = execState (itraverse_ f [1,3..9]) [] stA `shouldBe` reverse (zip [0..4] [1,3..9]) stB `shouldBe` reverse (zip [0..4] [1,3..9]) + describe "ireplicateM" $ do + describe "State" $ do + specify "basic" $ do + let f i = modify (i:) >> return ((i+1)*2) + let (res, st) = runState (ireplicateM 5 f) [] + res `shouldBe` [2,4..10] + st `shouldBe` reverse [0..4] + + describe "ireplicateM_" $ do + describe "State" $ do + specify "basic" $ do + let f i = modify (i:) >> return ((i+1)*2) + let st = execState (ireplicateM_ 5 f) [] + st `shouldBe` reverse [0..4] + specialFolds :: Spec specialFolds = describe "special folds" $ do describe "iall" $ do @@ -245,11 +260,13 @@ search = describe "search" $ do describe "ifind" $ do specify "found" $ do - ifind (\i x -> i*2==x) [1,3,4,7] `shouldBe` Just 4 + ifind (\i x -> i*2==x) [1,3,4,7] `shouldBe` Just (2, 4) + specify "found twice" $ do + ifind (\i x -> i*2==x) [1,3,4,6] `shouldBe` Just (2, 4) specify "not found" $ do ifind (\i x -> i*2==x) [1,3,5,7] `shouldBe` Nothing specify "empty" $ do - ifind undefined [] `shouldBe` (Nothing :: Maybe Bool) + ifind undefined [] `shouldBe` (Nothing :: Maybe (Int, Bool)) describe "ifindIndex" $ do specify "found" $ do

1 0

commit ghc-hunit-dejafu for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-hunit-dejafu for openSUSE:Factory checked in at 2017-08-31 20:56:28 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hunit-dejafu (Old) and /work/SRC/openSUSE:Factory/.ghc-hunit-dejafu.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hunit-dejafu" Thu Aug 31 20:56:28 2017 rev:2 rq:513395 version:0.6.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hunit-dejafu/ghc-hunit-dejafu.changes 2017-05-16 14:40:21.139619373 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-hunit-dejafu.new/ghc-hunit-dejafu.changes 2017-08-31 20:56:29.687152749 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:05:46 UTC 2017 - psimons(a)suse.com + +- Update to version 0.6.0.0. + +------------------------------------------------------------------- Old: ---- hunit-dejafu-0.3.0.3.tar.gz New: ---- hunit-dejafu-0.6.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hunit-dejafu.spec ++++++ --- /var/tmp/diff_new_pack.N466fs/_old 2017-08-31 20:56:30.735005522 +0200 +++ /var/tmp/diff_new_pack.N466fs/_new 2017-08-31 20:56:30.751003275 +0200 @@ -18,7 +18,7 @@ %global pkg_name hunit-dejafu Name: ghc-%{pkg_name} -Version: 0.3.0.3 +Version: 0.6.0.0 Release: 0 Summary: Deja Fu support for the HUnit test framework License: MIT @@ -38,8 +38,6 @@ HUnit>. This lets you easily incorporate concurrency testing into your existing test suites. -See the <https://github.com/barrucadu/dejafu README> for more details. - %package devel Summary: Haskell %{pkg_name} library development files Group: Development/Libraries/Other @@ -72,5 +70,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) +%doc CHANGELOG.markdown README.markdown %changelog ++++++ hunit-dejafu-0.3.0.3.tar.gz -> hunit-dejafu-0.6.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hunit-dejafu-0.3.0.3/CHANGELOG.markdown new/hunit-dejafu-0.6.0.0/CHANGELOG.markdown --- old/hunit-dejafu-0.3.0.3/CHANGELOG.markdown 1970-01-01 01:00:00.000000000 +0100 +++ new/hunit-dejafu-0.6.0.0/CHANGELOG.markdown 2017-06-07 18:06:17.000000000 +0200 @@ -0,0 +1,181 @@ +Release Notes +============= + +All notable changes to this project will be documented in this file. + +This project is versioned according to the [Package Versioning Policy](https://pvp.haskell.org), the +*de facto* standard Haskell versioning scheme. + + +0.6.0.0 [2017-06-07] (git tag: [hunit-dejafu-0.6.0.0][]) +------- + +https://hackage.haskell.org/package/hunit-dejafu-0.6.0.0 + +### Test.HUnit.DejaFu + +- The refinement property testing functionality of dejafu is exposed in the new `testProperty` + function, and re-exported values. +- Due to changes in dejafu, the `Way` type is now abstract and exposes smart constructor functions: + - `systematically`, corresponding to the old `Systematically`. + - `randomly`, corresponding to the old `Randomly`. + - `uniformly`, a new uniform random (as opposed to weighted random) scheduler. + - `swarmy`, corresponding to the old `Randomly` and specifying how many executions to use the + same weights for. +- The `defaultWay`, `defaultMemType`, and `defaultBounds` values are all now re-exported. + +### Miscellaneous + +- Only dejafu 0.7 is supported. + +[hunit-dejafu-0.6.0.0]: https://github.com/barrucadu/dejafu/releases/tag/hunit-dejafu-0.6.0.0 + + +--------------------------------------------------------------------------------------------------- + + +0.5.0.0 [2017-04-08] (git tag: [hunit-dejafu-0.5.0.0][]) +------- + +https://hackage.haskell.org/package/hunit-dejafu-0.5.0.0 + +### Test.HUnit.DejaFu + +- Due to changes in dejafu, the `Way` type no longer takes a parameter; it is now a GADT. + +### Miscellaneous + +- There is now a changelog. +- Every definition and instance now has a Haddock "@since" annotation. +- Only dejafu 0.6 is supported. + +[hunit-dejafu-0.5.0.0]: https://github.com/barrucadu/dejafu/releases/tag/hunit-dejafu-0.5.0.0 + + +--------------------------------------------------------------------------------------------------- + + +0.4.0.1 [2017-03-20] (git tag: [hunit-dejafu-0.4.0.1][]) +------- + +https://hackage.haskell.org/package/hunit-dejafu-0.4.0.1 + +### Miscellaneous + +- Now supports HUnit 1.6. + +[hunit-dejafu-0.4.0.1]: https://github.com/barrucadu/dejafu/releases/tag/hunit-dejafu-0.4.0.1 + + +--------------------------------------------------------------------------------------------------- + + +0.4.0.0 [2017-02-21] (git tag: [hunit-dejafu-0.4.0.0][]) +------- + +https://hackage.haskell.org/package/hunit-dejafu-0.4.0.0 + +### Test.HUnit.DejaFu + +- All the functions which did take a `Bounds` now take a `Way` instead and support random scheduling + as well. +- The `Way` type from dejafu is now re-exported. + +### Miscellaneous + +- The minimum supported version of dejafu has been increased to 0.5 (from 0.2) + +[hunit-dejafu-0.4.0.0]: https://github.com/barrucadu/dejafu/releases/tag/hunit-dejafu-0.4.0.0 + + +--------------------------------------------------------------------------------------------------- + + +0.3.0.3 [2016-10-22] (git tag: [hunit-dejafu-0.3.0.3][]) +------- + +https://hackage.haskell.org/package/hunit-dejafu-0.3.0.3 + +### Miscellaneous + +- Now supports HUnit 1.4 and 1.5. + +[hunit-dejafu-0.3.0.3]: https://github.com/barrucadu/dejafu/releases/tag/hunit-dejafu-0.3.0.3 + + +--------------------------------------------------------------------------------------------------- + + +0.3.0.2 [2016-09-10] (git tag: [hunit-dejafu-0.3.0.2][]) +------- + +https://hackage.haskell.org/package/hunit-dejafu-0.3.0.2 + +### Miscellaneous + +- Now supports concurrency 1.0.0.0 and dejafu 0.4.0.0 + +[hunit-dejafu-0.3.0.2]: https://github.com/barrucadu/dejafu/releases/tag/hunit-dejafu-0.3.0.2 + + +--------------------------------------------------------------------------------------------------- + + +0.3.0.1 [2016-05-26] (git tag: [hunit-dejafu-0.3.0.1][]) +------- + +https://hackage.haskell.org/package/hunit-dejafu-0.3.0.1 + +### Miscellaneous + +- Now supports GHC 8. + +[hunit-dejafu-0.3.0.1]: https://github.com/barrucadu/dejafu/releases/tag/hunit-dejafu-0.3.0.1 + + +--------------------------------------------------------------------------------------------------- + + +0.3.0.0 [2016-04-28] (git tag: [hunit-dejafu-0.3.0.0][]) +------- + +https://hackage.haskell.org/package/hunit-dejafu-0.3.0.0 + +### Test.HUnit.DejaFu + +- New `Assertable` and `Testable` instances for `ConcST t ()` and `ConcIO ()`. +- The `Bounds` type from dejafu is now re-exported. + +### Miscellaneous + +- Now supports dejafu 0.2 (again). + +[hunit-dejafu-0.3.0.0]: https://github.com/barrucadu/dejafu/releases/tag/hunit-dejafu-0.3.0.0 + + +--------------------------------------------------------------------------------------------------- + + +0.2.1.0 [2016-04-03] (git tag: [hunit-dejafu-0.2.1.0][]) +------- + +**This version was never pushed to hackage, whoops!** + +### Miscellaneous + +- Now supports dejafu 0.3, but drops support for dejafu 0.2. + +[hunit-dejafu-0.2.1.0]: https://github.com/barrucadu/dejafu/releases/tag/hunit-dejafu-0.2.1.0 + + +--------------------------------------------------------------------------------------------------- + + +0.2.0.0 [2015-12-01] (git tag: [0.2.0.0][]) +------- + +https://hackage.haskell.org/package/hunit-dejafu-0.2.0.0 + +Initial release. Go read the API docs. + +[0.2.0.0]: https://github.com/barrucadu/dejafu/releases/tag/0.2.0.0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hunit-dejafu-0.3.0.3/README.markdown new/hunit-dejafu-0.6.0.0/README.markdown --- old/hunit-dejafu-0.3.0.3/README.markdown 1970-01-01 01:00:00.000000000 +0100 +++ new/hunit-dejafu-0.6.0.0/README.markdown 2016-05-26 17:52:10.000000000 +0200 @@ -0,0 +1,21 @@ +hunit-dejafu +============ + +Integration between the [dejafu][] library for concurrency testing and +[HUnit][]. This lets you easily incorporate concurrency testing into +your existing test suites. + +The documentation of the latest developmental version is +[available online][docs]. + +Contributing +------------ + +Bug reports, pull requests, and comments are very welcome! + +Feel free to contact me on GitHub, through IRC (#haskell on freenode), +or email (mike(a)barrucadu.co.uk) + +[docs]: https://docs.barrucadu.co.uk/hunit-dejafu +[dejafu]: https://hackage.haskell.org/package/dejafu +[HUnit]: https://hackage.haskell.org/package/HUnit diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hunit-dejafu-0.3.0.3/Setup.hs new/hunit-dejafu-0.6.0.0/Setup.hs --- old/hunit-dejafu-0.3.0.3/Setup.hs 2016-06-04 11:02:54.000000000 +0200 +++ new/hunit-dejafu-0.6.0.0/Setup.hs 2017-04-08 06:43:07.000000000 +0200 @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hunit-dejafu-0.3.0.3/Test/HUnit/DejaFu.hs new/hunit-dejafu-0.6.0.0/Test/HUnit/DejaFu.hs --- old/hunit-dejafu-0.3.0.3/Test/HUnit/DejaFu.hs 2016-10-22 15:23:28.000000000 +0200 +++ new/hunit-dejafu-0.6.0.0/Test/HUnit/DejaFu.hs 2017-06-07 18:07:28.000000000 +0200 @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -12,11 +13,11 @@ -- | -- Module : Test.HUnit.DejaFu --- Copyright : (c) 2016 Michael Walker +-- Copyright : (c) 2017 Michael Walker -- License : MIT -- Maintainer : Michael Walker <mike(a)barrucadu.co.uk> -- Stability : stable --- Portability : CPP, FlexibleInstances, ImpredicativeTypes, RankNTypes, ScopedTypeVariables, TypeSynonymInstances +-- Portability : CPP, FlexibleContexts, FlexibleInstances, ImpredicativeTypes, RankNTypes, ScopedTypeVariables, TypeSynonymInstances -- -- This module allows using Deja Fu predicates with HUnit to test the -- behaviour of concurrent systems. @@ -33,99 +34,112 @@ -- @instance Testable (ConcIO ())@ -- @instance Assertable (ConcIO ())@ -- - -- These instances use the default memory model and schedule bounds. + -- These instances use 'defaultWay' and 'defaultMemType'. - -- * Property testing + -- * Unit testing testAuto , testDejafu , testDejafus - , testAuto' - , testDejafu' - , testDejafus' + , testAutoWay + , testDejafuWay + , testDejafusWay -- ** @IO@ , testAutoIO , testDejafuIO , testDejafusIO - , testAutoIO' - , testDejafuIO' - , testDejafusIO' - - -- * Re-exports + , testAutoWayIO + , testDejafuWayIO + , testDejafusWayIO + + -- ** Re-exports + , Way + , defaultWay + , systematically + , randomly + , uniformly + , swarmy , Bounds(..) + , defaultBounds , MemType(..) + , defaultMemType + + -- * Refinement property testing + , testProperty + + -- ** Re-exports + , R.Sig(..) + , R.RefinementProperty + , R.Testable(..) + , R.Listable(..) + , R.expectFailure + , R.refines, (R.=>=) + , R.strictlyRefines, (R.->-) + , R.equivalentTo, (R.===) ) where -import Control.Monad.Catch (try) -import Control.Monad.ST (runST) -import Data.List (intercalate, intersperse) -import Test.DejaFu -import qualified Test.DejaFu.SCT as SCT -import Test.HUnit (Assertable(..), Test(..), Testable(..), assertString) -import Test.HUnit.Lang (HUnitFailure(..)) - -#if MIN_VERSION_dejafu(0,4,0) -import qualified Test.DejaFu.Conc as Conc -#else -import qualified Test.DejaFu.Deterministic as Conc -#endif +import Control.Monad.Catch (try) +import Control.Monad.ST (runST) +import qualified Data.Foldable as F +import Data.List (intercalate, intersperse) +import Test.DejaFu hiding (Testable(..)) +import qualified Test.DejaFu.Conc as Conc +import qualified Test.DejaFu.Refinement as R +import qualified Test.DejaFu.SCT as SCT +import Test.HUnit (Assertable(..), Test(..), Testable(..), + assertFailure, assertString) +import Test.HUnit.Lang (HUnitFailure(..)) -- Can't put the necessary forall in the @Assertable Conc.ConcST t@ -- instance :( -import Unsafe.Coerce (unsafeCoerce) +import Unsafe.Coerce (unsafeCoerce) -#if MIN_VERSION_dejafu(0,3,0) -type Trc = Conc.Trace Conc.ThreadId Conc.ThreadAction Conc.Lookahead -#else -type Trc = Conc.Trace -#endif - -sctBoundST :: MemType -> Bounds -> (forall t. Conc.ConcST t a) -> [(Either Failure a, Trc)] -sctBoundIO :: MemType -> Bounds -> Conc.ConcIO a -> IO [(Either Failure a, Trc)] +runSCTst :: Way -> MemType -> (forall t. Conc.ConcST t a) -> [(Either Failure a, Conc.Trace)] +runSCTst way memtype conc = runST (SCT.runSCT way memtype conc) -#if MIN_VERSION_dejafu(0,4,0) -sctBoundST memtype cb conc = runST (SCT.sctBound memtype cb conc) -sctBoundIO = SCT.sctBound -#else -sctBoundST = SCT.sctBound -sctBoundIO = SCT.sctBoundIO -#endif +runSCTio :: Way -> MemType -> Conc.ConcIO a -> IO [(Either Failure a, Conc.Trace)] +runSCTio = SCT.runSCT -------------------------------------------------------------------------------- --- Unit testing +-- HUnit-style unit testing +-- | @since 0.3.0.0 instance Testable (Conc.ConcST t ()) where test conc = TestCase (assert conc) +-- | @since 0.3.0.0 instance Testable (Conc.ConcIO ()) where test conc = TestCase (assert conc) +-- | @since 0.3.0.0 instance Assertable (Conc.ConcST t ()) where assert conc = do - let traces = sctBound' conc' + let traces = runSCTst' conc' assertString . showErr $ assertableP traces where conc' :: Conc.ConcST t (Either HUnitFailure ()) conc' = try conc - sctBound' :: Conc.ConcST t (Either HUnitFailure ()) -> [(Either Failure (Either HUnitFailure ()), Trc)] - sctBound' = unsafeCoerce $ sctBoundST defaultMemType defaultBounds + runSCTst' :: Conc.ConcST t (Either HUnitFailure ()) -> [(Either Failure (Either HUnitFailure ()), Conc.Trace)] + runSCTst' = unsafeCoerce $ runSCTst defaultWay defaultMemType +-- | @since 0.3.0.0 instance Assertable (Conc.ConcIO ()) where assert conc = do - traces <- sctBoundIO defaultMemType defaultBounds (try conc) + traces <- runSCTio defaultWay defaultMemType (try conc) assertString . showErr $ assertableP traces assertableP :: Predicate (Either HUnitFailure ()) assertableP = alwaysTrue $ \r -> case r of - Right (Left (HUnitFailure {})) -> False + Right (Left HUnitFailure {}) -> False _ -> True + -------------------------------------------------------------------------------- --- Property testing +-- DejaFu-style unit testing -- | Automatically test a computation. In particular, look for -- deadlocks, uncaught exceptions, and multiple return values. @@ -133,29 +147,42 @@ -- This uses the 'Conc' monad for testing, which is an instance of -- 'MonadConc'. If you need to test something which also uses -- 'MonadIO', use 'testAutoIO'. +-- +-- @since 0.2.0.0 testAuto :: (Eq a, Show a) => (forall t. Conc.ConcST t a) -- ^ The computation to test -> Test -testAuto = testAuto' defaultMemType +testAuto = testAutoWay defaultWay defaultMemType -- | Variant of 'testAuto' which tests a computation under a given --- memory model. -testAuto' :: (Eq a, Show a) - => MemType +-- execution way and memory model. +-- +-- @since 0.5.0.0 +testAutoWay :: (Eq a, Show a) + => Way + -- ^ How to execute the concurrent program. + -> MemType -- ^ The memory model to use for non-synchronised @CRef@ operations. -> (forall t. Conc.ConcST t a) -- ^ The computation to test -> Test -testAuto' memtype conc = testDejafus' memtype defaultBounds conc autocheckCases +testAutoWay way memtype conc = + testDejafusWay way memtype conc autocheckCases -- | Variant of 'testAuto' for computations which do 'IO'. +-- +-- @since 0.2.0.0 testAutoIO :: (Eq a, Show a) => Conc.ConcIO a -> Test -testAutoIO = testAutoIO' defaultMemType +testAutoIO = testAutoWayIO defaultWay defaultMemType --- | Variant of 'testAuto'' for computations which do 'IO'. -testAutoIO' :: (Eq a, Show a) => MemType -> Conc.ConcIO a -> Test -testAutoIO' memtype concio = testDejafusIO' memtype defaultBounds concio autocheckCases +-- | Variant of 'testAutoWay' for computations which do 'IO'. +-- +-- @since 0.5.0.0 +testAutoWayIO :: (Eq a, Show a) + => Way -> MemType -> Conc.ConcIO a -> Test +testAutoWayIO way memtype concio = + testDejafusWayIO way memtype concio autocheckCases -- | Predicates for the various autocheck functions. autocheckCases :: Eq a => [(String, Predicate a)] @@ -166,6 +193,8 @@ ] -- | Check that a predicate holds. +-- +-- @since 0.2.0.0 testDejafu :: Show a => (forall t. Conc.ConcST t a) -- ^ The computation to test @@ -174,15 +203,17 @@ -> Predicate a -- ^ The predicate to check -> Test -testDejafu = testDejafu' defaultMemType defaultBounds +testDejafu = testDejafuWay defaultWay defaultMemType --- | Variant of 'testDejafu' which takes a memory model and --- schedule bounds. -testDejafu' :: Show a - => MemType +-- | Variant of 'testDejafu' which takes a way to execute the program +-- and a memory model. +-- +-- @since 0.5.0.0 +testDejafuWay :: Show a + => Way + -- ^ How to execute the concurrent program. + -> MemType -- ^ The memory model to use for non-synchronised @CRef@ operations. - -> Bounds - -- ^ The schedule bound. -> (forall t. Conc.ConcST t a) -- ^ The computation to test -> String @@ -190,55 +221,89 @@ -> Predicate a -- ^ The predicate to check -> Test -testDejafu' memtype cb conc name p = testDejafus' memtype cb conc [(name, p)] +testDejafuWay way memtype conc name p = + testDejafusWay way memtype conc [(name, p)] -- | Variant of 'testDejafu' which takes a collection of predicates to -- test. This will share work between the predicates, rather than -- running the concurrent computation many times for each predicate. +-- +-- @since 0.2.0.0 testDejafus :: Show a => (forall t. Conc.ConcST t a) -- ^ The computation to test -> [(String, Predicate a)] -- ^ The list of predicates (with names) to check -> Test -testDejafus = testDejafus' defaultMemType defaultBounds +testDejafus = testDejafusWay defaultWay defaultMemType --- | Variant of 'testDejafus' which takes a memory model and schedule --- bounds. -testDejafus' :: Show a - => MemType +-- | Variant of 'testDejafus' which takes a way to execute the program +-- and a memory model. +-- +-- @since 0.5.0.0 +testDejafusWay :: Show a + => Way + -- ^ How to execute the concurrent program. + -> MemType -- ^ The memory model to use for non-synchronised @CRef@ operations. - -> Bounds - -- ^ The schedule bounds -> (forall t. Conc.ConcST t a) -- ^ The computation to test -> [(String, Predicate a)] -- ^ The list of predicates (with names) to check -> Test -testDejafus' = testst +testDejafusWay = testst -- | Variant of 'testDejafu' for computations which do 'IO'. +-- +-- @since 0.2.0.0 testDejafuIO :: Show a => Conc.ConcIO a -> String -> Predicate a -> Test -testDejafuIO = testDejafuIO' defaultMemType defaultBounds +testDejafuIO = testDejafuWayIO defaultWay defaultMemType --- | Variant of 'testDejafu'' for computations which do 'IO'. -testDejafuIO' :: Show a => MemType -> Bounds -> Conc.ConcIO a -> String -> Predicate a -> Test -testDejafuIO' memtype cb concio name p = testDejafusIO' memtype cb concio [(name, p)] +-- | Variant of 'testDejafuWay' for computations which do 'IO'. +-- +-- @since 0.5.0.0 +testDejafuWayIO :: Show a + => Way -> MemType -> Conc.ConcIO a -> String -> Predicate a -> Test +testDejafuWayIO way memtype concio name p = + testDejafusWayIO way memtype concio [(name, p)] -- | Variant of 'testDejafus' for computations which do 'IO'. +-- +-- @since 0.2.0.0 testDejafusIO :: Show a => Conc.ConcIO a -> [(String, Predicate a)] -> Test -testDejafusIO = testDejafusIO' defaultMemType defaultBounds +testDejafusIO = testDejafusWayIO defaultWay defaultMemType + +-- | Variant of 'dejafusWay' for computations which do 'IO'. +-- +-- @since 0.5.0.0 +testDejafusWayIO :: Show a + => Way -> MemType -> Conc.ConcIO a -> [(String, Predicate a)] -> Test +testDejafusWayIO = testio + + +------------------------------------------------------------------------------- +-- Refinement property testing + +-- | Check a refinement property with a variety of seed values and +-- variable assignments. +-- +-- @since 0.6.0.0 +testProperty :: (R.Testable p, R.Listable (R.X p), Eq (R.X p), Show (R.X p), Show (R.O p)) + => String + -- ^ The name of the test. + -> p + -- ^ The property to check. + -> Test +testProperty = testprop --- | Variant of 'dejafus'' for computations which do 'IO'. -testDejafusIO' :: Show a => MemType -> Bounds -> Conc.ConcIO a -> [(String, Predicate a)] -> Test -testDejafusIO' = testio -------------------------------------------------------------------------------- -- HUnit integration -- | Produce a HUnit 'Test' from a Deja Fu test. -testst :: Show a => MemType -> Bounds -> (forall t. Conc.ConcST t a) -> [(String, Predicate a)] -> Test -testst memtype cb conc tests = case map toTest tests of +testst :: Show a + => Way -> MemType -> (forall t. Conc.ConcST t a) -> [(String, Predicate a)] -> Test +testst way memtype conc tests = case map toTest tests of [t] -> t ts -> TestList ts @@ -246,11 +311,12 @@ toTest (name, p) = TestLabel name . TestCase $ assertString . showErr $ p traces - traces = sctBoundST memtype cb conc + traces = runSCTst way memtype conc -- | Produce a HUnit 'Test' from an IO-using Deja Fu test. -testio :: Show a => MemType -> Bounds -> Conc.ConcIO a -> [(String, Predicate a)] -> Test -testio memtype cb concio tests = case map toTest tests of +testio :: Show a + => Way -> MemType -> Conc.ConcIO a -> [(String, Predicate a)] -> Test +testio way memtype concio tests = case map toTest tests of [t] -> t ts -> TestList ts @@ -260,9 +326,25 @@ -- really unsafe) here, as 'test' doesn't allow side-effects -- (eg, constructing an 'MVar' to share the traces after one -- test computed them). - traces <- sctBoundIO memtype cb concio + traces <- runSCTio way memtype concio assertString . showErr $ p traces +-- | Produce a HUnit 'Test' from a Deja Fu refinement property test. +testprop :: (R.Testable p, R.Listable (R.X p), Eq (R.X p), Show (R.X p), Show (R.O p)) + => String -> p -> Test +testprop name p = TestLabel name . TestCase $ do + ce <- R.check' p + case ce of + Just c -> assertFailure . init $ unlines + [ "*** Failure: " ++ + (if null (R.failingArgs c) then "" else unwords (R.failingArgs c) ++ " ") ++ + "(seed " ++ show (R.failingSeed c) ++ ")" + , " left: " ++ show (F.toList $ R.leftResults c) + , " right: " ++ show (F.toList $ R.rightResults c) + ] + Nothing -> pure () + + -------------------------------------------------------------------------------- -- Utilities diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hunit-dejafu-0.3.0.3/hunit-dejafu.cabal new/hunit-dejafu-0.6.0.0/hunit-dejafu.cabal --- old/hunit-dejafu-0.3.0.3/hunit-dejafu.cabal 2016-10-22 15:33:42.000000000 +0200 +++ new/hunit-dejafu-0.6.0.0/hunit-dejafu.cabal 2017-06-07 18:05:36.000000000 +0200 @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hunit-dejafu -version: 0.3.0.3 +version: 0.6.0.0 synopsis: Deja Fu support for the HUnit test framework. description: @@ -11,9 +11,6 @@ <https://hackage.haskell.org/package/HUnit HUnit>. This lets you easily incorporate concurrency testing into your existing test suites. - . - See the <https://github.com/barrucadu/dejafu README> for more - details. homepage: https://github.com/barrucadu/dejafu license: MIT @@ -23,7 +20,7 @@ -- copyright: category: Testing build-type: Simple --- extra-source-files: +extra-source-files: README.markdown CHANGELOG.markdown cabal-version: >=1.10 source-repository head @@ -33,7 +30,7 @@ source-repository this type: git location: https://github.com/barrucadu/dejafu.git - tag: hunit-dejafu-0.3.0.3 + tag: hunit-dejafu-0.6.0.0 library exposed-modules: Test.HUnit.DejaFu @@ -41,7 +38,7 @@ -- other-extensions: build-depends: base >=4.8 && <5 , exceptions >=0.7 && <0.9 - , dejafu >=0.2 && <0.5 - , HUnit >=1.2 && <1.6 + , dejafu >=0.7 && <0.8 + , HUnit >=1.2 && <1.7 -- hs-source-dirs: default-language: Haskell2010

1 0

commit ghc-hspec-meta for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-hspec-meta for openSUSE:Factory checked in at 2017-08-31 20:56:26 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hspec-meta (Old) and /work/SRC/openSUSE:Factory/.ghc-hspec-meta.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hspec-meta" Thu Aug 31 20:56:26 2017 rev:3 rq:513392 version:2.4.4 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hspec-meta/ghc-hspec-meta.changes 2017-03-28 15:21:48.577072025 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-hspec-meta.new/ghc-hspec-meta.changes 2017-08-31 20:56:28.211360103 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:09 UTC 2017 - psimons(a)suse.com + +- Update to version 2.4.4. + +------------------------------------------------------------------- Old: ---- hspec-meta-2.3.2.tar.gz New: ---- hspec-meta-2.4.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hspec-meta.spec ++++++ --- /var/tmp/diff_new_pack.gUC0a0/_old 2017-08-31 20:56:29.175224677 +0200 +++ /var/tmp/diff_new_pack.gUC0a0/_new 2017-08-31 20:56:29.183223553 +0200 @@ -18,7 +18,7 @@ %global pkg_name hspec-meta Name: ghc-%{pkg_name} -Version: 2.3.2 +Version: 2.4.4 Release: 0 Summary: A version of Hspec which is used to test Hspec itself License: MIT @@ -29,6 +29,7 @@ BuildRequires: ghc-HUnit-devel BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-ansi-terminal-devel +BuildRequires: ghc-array-devel BuildRequires: ghc-async-devel BuildRequires: ghc-call-stack-devel BuildRequires: ghc-deepseq-devel @@ -80,6 +81,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) -%doc changelog +%doc CHANGES.markdown %changelog ++++++ hspec-meta-2.3.2.tar.gz -> hspec-meta-2.4.4.tar.gz ++++++ ++++ 3270 lines of diff (skipped)

1 0

commit ghc-hspec for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-hspec for openSUSE:Factory checked in at 2017-08-31 20:56:24 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hspec (Old) and /work/SRC/openSUSE:Factory/.ghc-hspec.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hspec" Thu Aug 31 20:56:24 2017 rev:2 rq:513389 version:2.4.4 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hspec/ghc-hspec.changes 2017-05-09 18:04:36.908469761 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-hspec.new/ghc-hspec.changes 2017-08-31 20:56:26.767562962 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:06:52 UTC 2017 - psimons(a)suse.com + +- Update to version 2.4.4. + +------------------------------------------------------------------- Old: ---- hspec-2.4.3.tar.gz New: ---- hspec-2.4.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hspec.spec ++++++ --- /var/tmp/diff_new_pack.UkJCaA/_old 2017-08-31 20:56:27.675435403 +0200 +++ /var/tmp/diff_new_pack.UkJCaA/_new 2017-08-31 20:56:27.683434279 +0200 @@ -19,7 +19,7 @@ %global pkg_name hspec %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.4.3 +Version: 2.4.4 Release: 0 Summary: A Testing Framework for Haskell License: MIT ++++++ hspec-2.4.3.tar.gz -> hspec-2.4.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-2.4.3/hspec.cabal new/hspec-2.4.4/hspec.cabal --- old/hspec-2.4.3/hspec.cabal 2017-03-25 12:28:00.000000000 +0100 +++ new/hspec-2.4.4/hspec.cabal 2017-06-16 11:08:37.000000000 +0200 @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.17.0. +-- This file has been generated from package.yaml by hpack version 0.18.0. -- -- see: https://github.com/sol/hpack name: hspec -version: 2.4.3 +version: 2.4.4 license: MIT license-file: LICENSE copyright: (c) 2011-2017 Simon Hengel, @@ -44,8 +44,8 @@ src build-depends: base == 4.* - , hspec-core == 2.4.3 - , hspec-discover == 2.4.3 + , hspec-core == 2.4.4 + , hspec-discover == 2.4.4 , hspec-expectations == 0.8.2.* , transformers >= 0.2.2.0 , QuickCheck >= 2.5.1 @@ -75,8 +75,8 @@ Test.Hspec.DiscoverSpec build-depends: base == 4.* - , hspec-core == 2.4.3 - , hspec-discover == 2.4.3 + , hspec-core == 2.4.4 + , hspec-discover == 2.4.4 , hspec-expectations == 0.8.2.* , transformers >= 0.2.2.0 , QuickCheck >= 2.5.1

1 0