August 2022 - openSUSE Commits - openSUSE Mailing Lists

commit ghc-turtle for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-turtle for openSUSE:Factory checked in at 2022-08-01 21:30:44 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-turtle (Old) and /work/SRC/openSUSE:Factory/.ghc-turtle.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-turtle" Mon Aug 1 21:30:44 2022 rev:19 rq:987105 version:1.6.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-turtle/ghc-turtle.changes 2022-02-11 23:11:52.255373117 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-turtle.new.1533/ghc-turtle.changes 2022-08-01 21:31:15.989805800 +0200 @@ -1,0 +2,84 @@ +Fri Jun 17 21:38:49 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update turtle to version 1.6.1. + 1.6.1. + + * BUG FIX: Fix `turtle` to build on Windows + * BUG FIX: `stripPrefix` and `commonPrefix` now correctly handle files with + extensions + * For example, before this fix `stripPrefix "./" "./foo.bar"` would + return `Just "foo/.bar"` + + 1.6.0 + + * BREAKING CHANGE: Switch to the `FilePath` type from `base` instead of + `system-filepath` + * This is a breaking change for a couple of reasons: + * The `FilePath` type has changed, so the API is not backwards-compatible + * The thing most likely to break is if you directly imported utilities + from the `system-filepath` or `system-fileio` packages to operate on + `turtle`'s `FilePath`s + * If that happens, you should first check if the `Turtle` module + exports a utility of the same name. If so, then switch to that + * If there is no equivalent substitute from the `Turtle` module then + you will have to change your code to use the closest equivalent + utility from the `filepath` or `directory` package + * If you were previously using any of the `system-filepath` or + `system-fileio` utilities re-exported from the `Turtle` module then + those utilities will not break as they have been replaced with + versions compatible with the `FilePath` type from `base` + * The second thing most likely to break is any code that relies on + typeclasses since because if you defined any instances for the + `FilePath` type exported by `turtle` then those instances will now + overlap with any instances defined for the `String` type + * The conversion utilities (e.g. `toText`, `encodeString`) will still + work, so code that used those conversion utilities should be less + affected by this change + * The behavior of the `collapse` utility is subtly different + * `collapse` no longer interprets `..` in paths + * This new behavior is more correct in the presence of symlinks, so the + change is (hopefully) an improvement to downstream code + * The new API strives to match the old behavior as closely as possible + * �� so this should (hopefully) not break too much code in practice + * With the exception of the `collapse` function the new API should be + bug-for-bug compatible with the old API + * Most of the surprising behavior inherited from the old API is around + how `.` and `..` are handled in paths + * `parent ".." == "."` is an example of such surprising behavior + * At some point in the future we may fix bugs in these utilities inherited + from `system-filepath` / `system-fileio`, but no decision either way has + been made, yet + * Some old utilities are marked `DEPRECATED` if their behavior exactly matches + the behavior of an existing utility from the `filepath` or `directory` + package + * These may be eventually removed at some point in the future or they + remain in a deprecated state indefinitely. No decision either way has + been made + * The `Turtle` module also re-exports any utility suggested by a + `DEPRECATED` pragma as a convenience + * Other utilities are not deprecated if the old behavior significantly departs + from any existing utility from the `filepath` or `directory` package + * For example, the behavior of the `filename` utility differs from the + behavior of `System.FilePath.takeFileName` for filenames that begin with a + `.`, so we have to preserve the old behavior to avoid breaking downstream + code + * At some point in the future utilities like these may be deprecated in + favor of their closest analogs in the `filepath` / `directory` packages or + they may be supported indefinitely. No decision either way has been made + * If you want to try to author code that is compatible with both the + pre-1.6 and post-1.6 API: + * If you add any instances to the `FilePath` type, import it qualified + directly from the `system-filepath` package and use it only for instances + * Otherwise, don't import anything else from the `system-filepath` / + `system-fileio` packages if you can help it. Instead, restrict yourself + entirely to the utilities and `FilePath` type exported by the `Turtle` + module + * Use the conversion utilities (e.g. `encodeStrings`, even if they are not + necessary post-1.6) + * If that's still not enough, use `CPP` and good luck! + + 1.5.25 + + * Build against latest version of `Win32` package + +------------------------------------------------------------------- Old: ---- turtle-1.5.24.tar.gz New: ---- turtle-1.6.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-turtle.spec ++++++ --- /var/tmp/diff_new_pack.I1XdvP/_old 2022-08-01 21:31:16.901808416 +0200 +++ /var/tmp/diff_new_pack.I1XdvP/_new 2022-08-01 21:31:16.917808461 +0200 @@ -19,7 +19,7 @@ %global pkg_name turtle %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.5.24 +Version: 1.6.1 Release: 0 Summary: Shell programming, Haskell-style License: BSD-3-Clause @@ -33,6 +33,7 @@ BuildRequires: ghc-containers-devel BuildRequires: ghc-directory-devel BuildRequires: ghc-exceptions-devel +BuildRequires: ghc-filepath-devel BuildRequires: ghc-foldl-devel BuildRequires: ghc-hostname-devel BuildRequires: ghc-managed-devel @@ -42,8 +43,6 @@ BuildRequires: ghc-rpm-macros BuildRequires: ghc-stm-devel BuildRequires: ghc-streaming-commons-devel -BuildRequires: ghc-system-fileio-devel -BuildRequires: ghc-system-filepath-devel BuildRequires: ghc-temporary-devel BuildRequires: ghc-text-devel BuildRequires: ghc-time-devel @@ -53,6 +52,8 @@ ExcludeArch: %{ix86} %if %{with tests} BuildRequires: ghc-doctest-devel +BuildRequires: ghc-tasty-devel +BuildRequires: ghc-tasty-hunit-devel %endif %description @@ -75,7 +76,7 @@ * Formatting: Type-safe 'printf'-style text formatting -* Modern: Supports 'text' and 'system-filepath' +* Modern: Supports 'text' Read "Turtle.Tutorial" for a detailed tutorial or "Turtle.Prelude" for a quick-start guide ++++++ turtle-1.5.24.tar.gz -> turtle-1.6.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/CHANGELOG.md new/turtle-1.6.1/CHANGELOG.md --- old/turtle-1.5.24/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/turtle-1.6.1/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,83 @@ +1.6.1. + +* BUG FIX: Fix `turtle` to build on Windows +* BUG FIX: `stripPrefix` and `commonPrefix` now correctly handle files with + extensions + * For example, before this fix `stripPrefix "./" "./foo.bar"` would + return `Just "foo/.bar"` + +1.6.0 + +* BREAKING CHANGE: Switch to the `FilePath` type from `base` instead of + `system-filepath` + * This is a breaking change for a couple of reasons: + * The `FilePath` type has changed, so the API is not backwards-compatible + * The thing most likely to break is if you directly imported utilities + from the `system-filepath` or `system-fileio` packages to operate on + `turtle`'s `FilePath`s + * If that happens, you should first check if the `Turtle` module + exports a utility of the same name. If so, then switch to that + * If there is no equivalent substitute from the `Turtle` module then + you will have to change your code to use the closest equivalent + utility from the `filepath` or `directory` package + * If you were previously using any of the `system-filepath` or + `system-fileio` utilities re-exported from the `Turtle` module then + those utilities will not break as they have been replaced with + versions compatible with the `FilePath` type from `base` + * The second thing most likely to break is any code that relies on + typeclasses since because if you defined any instances for the + `FilePath` type exported by `turtle` then those instances will now + overlap with any instances defined for the `String` type + * The conversion utilities (e.g. `toText`, `encodeString`) will still + work, so code that used those conversion utilities should be less + affected by this change + * The behavior of the `collapse` utility is subtly different + * `collapse` no longer interprets `..` in paths + * This new behavior is more correct in the presence of symlinks, so the + change is (hopefully) an improvement to downstream code + * The new API strives to match the old behavior as closely as possible + * �� so this should (hopefully) not break too much code in practice + * With the exception of the `collapse` function the new API should be + bug-for-bug compatible with the old API + * Most of the surprising behavior inherited from the old API is around + how `.` and `..` are handled in paths + * `parent ".." == "."` is an example of such surprising behavior + * At some point in the future we may fix bugs in these utilities inherited + from `system-filepath` / `system-fileio`, but no decision either way has + been made, yet + * Some old utilities are marked `DEPRECATED` if their behavior exactly matches + the behavior of an existing utility from the `filepath` or `directory` + package + * These may be eventually removed at some point in the future or they + remain in a deprecated state indefinitely. No decision either way has + been made + * The `Turtle` module also re-exports any utility suggested by a + `DEPRECATED` pragma as a convenience + * Other utilities are not deprecated if the old behavior significantly departs + from any existing utility from the `filepath` or `directory` package + * For example, the behavior of the `filename` utility differs from the + behavior of `System.FilePath.takeFileName` for filenames that begin with a + `.`, so we have to preserve the old behavior to avoid breaking downstream + code + * At some point in the future utilities like these may be deprecated in + favor of their closest analogs in the `filepath` / `directory` packages or + they may be supported indefinitely. No decision either way has been made + * If you want to try to author code that is compatible with both the + pre-1.6 and post-1.6 API: + * If you add any instances to the `FilePath` type, import it qualified + directly from the `system-filepath` package and use it only for instances + * Otherwise, don't import anything else from the `system-filepath` / + `system-fileio` packages if you can help it. Instead, restrict yourself + entirely to the utilities and `FilePath` type exported by the `Turtle` + module + * Use the conversion utilities (e.g. `encodeStrings`, even if they are not + necessary post-1.6) + * If that's still not enough, use `CPP` and good luck! + +1.5.25 + +* Build against latest version of `Win32` package + 1.5.24 * Expose `Format` constructor diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/src/Turtle/Bytes.hs new/turtle-1.6.1/src/Turtle/Bytes.hs --- old/turtle-1.5.24/src/Turtle/Bytes.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/turtle-1.6.1/src/Turtle/Bytes.hs 2001-09-09 03:46:40.000000000 +0200 @@ -53,8 +53,6 @@ import Data.Streaming.Zlib (Inflate, Popper, PopperRes(..), WindowBits(..)) import Data.Text (Text) import Data.Text.Encoding (Decoding(..)) -import Filesystem.Path (FilePath) -import Prelude hiding (FilePath) import System.Exit (ExitCode(..)) import System.IO (Handle) import Turtle.Internal (ignoreSIGPIPE) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/src/Turtle/Format.hs new/turtle-1.6.1/src/Turtle/Format.hs --- old/turtle-1.5.24/src/Turtle/Format.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/turtle-1.6.1/src/Turtle/Format.hs 2001-09-09 03:46:40.000000000 +0200 @@ -74,9 +74,8 @@ import Data.Text (Text, pack) import Data.Time (UTCTime) import Data.Word -import Filesystem.Path.CurrentOS (FilePath, toText) import Numeric (showEFloat, showFFloat, showGFloat, showHex, showOct) -import Prelude hiding ((.), id, FilePath) +import Prelude hiding ((.), id) import qualified System.IO as IO import Turtle.Line (Line) @@ -215,9 +214,9 @@ l :: Format r (Line -> r) l = makeFormat Turtle.Line.lineToText --- | `Format` a `Filesystem.Path.CurrentOS.FilePath` into `Text` +-- | `Format` a `FilePath` into `Text` fp :: Format r (FilePath -> r) -fp = makeFormat (\fpath -> either id id (toText fpath)) +fp = makeFormat pack -- | `Format` a `UTCTime` into `Text` utc :: Format r (UTCTime -> r) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/src/Turtle/Internal.hs new/turtle-1.6.1/src/Turtle/Internal.hs --- old/turtle-1.5.24/src/Turtle/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/turtle-1.6.1/src/Turtle/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,10 +1,16 @@ -module Turtle.Internal - ( ignoreSIGPIPE - ) where +module Turtle.Internal where +import Control.Applicative ((<|>)) import Control.Exception (handle, throwIO) +import Data.Text (Text) import Foreign.C.Error (Errno(..), ePIPE) import GHC.IO.Exception (IOErrorType(..), IOException(..)) +import System.FilePath ((</>)) + +import qualified Data.List as List +import qualified Data.Text as Text +import qualified Data.Text.IO as Text.IO +import qualified System.FilePath as FilePath ignoreSIGPIPE :: IO () -> IO () ignoreSIGPIPE = handle (\e -> case e of @@ -14,3 +20,230 @@ | Errno ioe == ePIPE -> return () _ -> throwIO e ) + +{-| Convert a `FilePath` to human-readable `Text` + + Note that even though the type says `Either` this utility actually always + succeeds and returns a `Right` value. The only reason for the `Either` is + compatibility with the old type from the @system-filepath@ package. +-} +toText :: FilePath -> Either Text Text +toText = Right . Text.pack +{-# DEPRECATED toText "Use Data.Text.pack instead" #-} + +-- | Convert `Text` to a `FilePath` +fromText :: Text -> FilePath +fromText = Text.unpack +{-# DEPRECATED fromText "Use Data.Text.unpack instead" #-} + +-- | Convert a `String` to a `FilePath` +decodeString :: String -> FilePath +decodeString = id +{-# DEPRECATED decodeString "Use id instead" #-} + +-- | Convert a `FilePath` to a `String` +encodeString :: FilePath -> String +encodeString = id +{-# DEPRECATED encodeString "Use id instead" #-} + +-- | Find the greatest common prefix between a list of `FilePath`s +commonPrefix :: [FilePath] -> FilePath +commonPrefix [ ] = mempty +commonPrefix (path : paths) = foldr longestPathPrefix path paths + where + longestPathPrefix left right + | leftComponents == rightComponents = + FilePath.joinPath leftComponents + ++ mconcat (longestPrefix leftExtensions rightExtensions) + | otherwise = + FilePath.joinPath (longestPrefix leftComponents rightComponents) + where + (leftComponents, leftExtensions) = splitExt (splitDirectories left) + + (rightComponents, rightExtensions) = splitExt (splitDirectories right) + +longestPrefix :: Eq a => [a] -> [a] -> [a] +longestPrefix (l : ls) (r : rs) + | l == r = l : longestPrefix ls rs +longestPrefix _ _ = [ ] + +-- | Remove a prefix from a path +stripPrefix :: FilePath -> FilePath -> Maybe FilePath +stripPrefix prefix path = do + componentSuffix <- List.stripPrefix prefixComponents pathComponents + + if null componentSuffix + then do + prefixSuffix <- List.stripPrefix prefixExtensions pathExtensions + + return (mconcat prefixSuffix) + else do + return (FilePath.joinPath componentSuffix ++ mconcat pathExtensions) + where + (prefixComponents, prefixExtensions) = splitExt (splitDirectories prefix) + + (pathComponents, pathExtensions) = splitExt (splitDirectories path) + +-- Internal helper function for `stripPrefix` and `commonPrefix` +splitExt :: [FilePath] -> ([FilePath], [String]) +splitExt [ component ] = ([ base ], map ("." ++) exts) + where + (base, exts) = splitExtensions component +splitExt [ ] = + ([ ], [ ]) +splitExt (component : components) = (component : base, exts) + where + (base, exts) = splitExt components + +-- | Normalise a path +collapse :: FilePath -> FilePath +collapse = FilePath.normalise +{-# DEPRECATED collapse "Use System.FilePath.normalise instead" #-} + +-- | Read in a file as `Text` +readTextFile :: FilePath -> IO Text +readTextFile = Text.IO.readFile +{-# DEPRECATED readTextFile "Use Data.Text.IO.readFile instead" #-} + +-- | Write out a file as `Text` +writeTextFile :: FilePath -> Text -> IO () +writeTextFile = Text.IO.writeFile +{-# DEPRECATED writeTextFile "Use Data.Text.IO.writeFile instead" #-} + +-- | Retrieves the `FilePath`'s root +root :: FilePath -> FilePath +root = fst . FilePath.splitDrive + +-- | Retrieves the `FilePath`'s parent directory +parent :: FilePath -> FilePath +parent path = prefix </> suffix + where + (drive, rest) = FilePath.splitDrive path + + components = loop (splitDirectories rest) + + prefix = + case components of + "./" : _ -> drive + "../" : _ -> drive + _ | null drive -> "./" + | otherwise -> drive + + suffix = FilePath.joinPath components + + loop [ _ ] = [ ] + loop [ ] = [ ] + loop (c : cs) = c : loop cs + +-- | Retrieves the `FilePath`'s directory +directory :: FilePath -> FilePath +directory path + | prefix == "" && suffix == ".." = + "../" + | otherwise = + trailingSlash (FilePath.takeDirectory prefix) ++ suffix + where + (prefix, suffix) = trailingParent path + where + trailingParent ".." = ("" , "..") + trailingParent [ a, b ] = ([ a, b ], "" ) + trailingParent [ a ] = ([ a ] , "" ) + trailingParent [ ] = ([ ] , "" ) + trailingParent (c : cs) = (c : p, s) + where + ~(p, s) = trailingParent cs + + trailingSlash "" = "/" + trailingSlash "/" = "/" + trailingSlash (c : cs) = c : trailingSlash cs + +-- | Retrieves the `FilePath`'s filename component +filename :: FilePath -> FilePath +filename path + | result == "." || result == ".." = "" + | otherwise = result + where + result = FilePath.takeFileName path + +-- | Retrieve a `FilePath`'s directory name +dirname :: FilePath -> FilePath +dirname path = loop (splitDirectories path) + where + loop [ x, y ] = + case deslash y <|> deslash x of + Just name -> name + Nothing -> "" + loop [ x ] = + case deslash x of + Just name -> name + Nothing -> "" + loop [ ] = + "" + loop (_ : xs) = + loop xs + + deslash "" = Nothing + deslash "/" = Just "" + deslash (c : cs) = fmap (c :) (deslash cs) + +-- | Retrieve a `FilePath`'s basename component +basename :: FilePath -> String +basename path = + case name of + '.' : _ -> name + _ -> + case splitExtensions name of + (base, _) -> base + where + name = filename path + +-- | Test whether a path is absolute +absolute :: FilePath -> Bool +absolute = FilePath.isAbsolute +{-# DEPRECATED absolute "Use System.FilePath.isAbsolute instead" #-} + +-- | Test whether a path is relative +relative :: FilePath -> Bool +relative = FilePath.isRelative +{-# DEPRECATED relative "Use System.FilePath.isRelative instead" #-} + +-- | Split a `FilePath` into its components +splitDirectories :: FilePath -> [FilePath] +splitDirectories path = loop (FilePath.splitPath path) + where + loop [ ] = [ ] + loop [ ".." ] = [ "../" ] + loop [ "." ] = [ "./" ] + loop (c : cs) = c : loop cs + +-- | Get a `FilePath`'s last extension, or `Nothing` if it has no extension +extension :: FilePath -> Maybe String +extension path = + case suffix of + '.' : ext -> Just ext + _ -> Nothing + where + suffix = FilePath.takeExtension path + +-- | Split a `FilePath` on its extension +splitExtension :: FilePath -> (String, Maybe String) +splitExtension path = + case suffix of + '.' : ext -> (prefix, Just ext) + _ -> (prefix, Nothing) + where + (prefix, suffix) = FilePath.splitExtension path + +-- | Split a `FilePath` on its extensions +splitExtensions :: FilePath -> (String, [String]) +splitExtensions path0 = (prefix0, reverse exts0) + where + (prefix0, exts0) = loop path0 + + loop path = case splitExtension path of + (prefix, Just ext) -> + (base, ext : exts) + where + (base, exts) = loop prefix + (base, Nothing) -> + (base, []) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/src/Turtle/Options.hs new/turtle-1.6.1/src/Turtle/Options.hs --- old/turtle-1.5.24/src/Turtle/Options.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/turtle-1.6.1/src/Turtle/Options.hs 2001-09-09 03:46:40.000000000 +0200 @@ -83,9 +83,7 @@ import Data.Optional import Control.Applicative import Control.Monad.IO.Class -import Filesystem.Path.CurrentOS (FilePath, fromText) import Options.Applicative (Parser) -import Prelude hiding (FilePath) import Text.PrettyPrint.ANSI.Leijen (Doc, displayS, renderCompact) import Turtle.Line (Line) @@ -237,7 +235,7 @@ -- | Parse a `FilePath` value as a flag-based option optPath :: ArgName -> ShortName -> Optional HelpMessage -> Parser FilePath -optPath argName short msg = fmap fromText (optText argName short msg) +optPath argName short msg = fmap Text.unpack (optText argName short msg) {- | Build a positional argument parser for any type by providing a `Text`-parsing function @@ -277,7 +275,7 @@ -- | Parse a `FilePath` as a positional argument argPath :: ArgName -> Optional HelpMessage -> Parser FilePath -argPath argName msg = fmap fromText (argText argName msg) +argPath argName msg = fmap Text.unpack (argText argName msg) argParseToReadM :: (Text -> Maybe a) -> Opts.ReadM a argParseToReadM f = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/src/Turtle/Prelude.hs new/turtle-1.6.1/src/Turtle/Prelude.hs --- old/turtle-1.5.24/src/Turtle/Prelude.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/turtle-1.6.1/src/Turtle/Prelude.hs 2001-09-09 03:46:40.000000000 +0200 @@ -111,8 +111,8 @@ echo , err , readline - , Filesystem.readTextFile - , Filesystem.writeTextFile + , Internal.readTextFile + , Internal.writeTextFile , arguments #if __GLASGOW_HASKELL__ >= 710 , export @@ -326,9 +326,6 @@ import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Typeable (Typeable) -import qualified Filesystem -import Filesystem.Path.CurrentOS (FilePath, (</>)) -import qualified Filesystem.Path.CurrentOS as Filesystem import GHC.IO.Exception (IOErrorType(UnsupportedOperation)) import Network.HostName (getHostName) import System.Clock (Clock(..), TimeSpec(..), getTime) @@ -342,8 +339,9 @@ lookupEnv, #endif getEnvironment ) -import qualified System.Directory import qualified System.Directory as Directory +import System.FilePath ((</>)) +import qualified System.FilePath as FilePath import System.Exit (ExitCode(..), exitWith) import System.IO (Handle, hClose) import qualified System.IO as IO @@ -362,12 +360,12 @@ touchFile ) import System.Posix.Files (createSymbolicLink) #endif -import Prelude hiding (FilePath, lines) +import Prelude hiding (lines) import Turtle.Pattern (Pattern, anyChar, chars, match, selfless, sepBy) import Turtle.Shell import Turtle.Format (Format, format, makeFormat, d, w, (%), fp) -import Turtle.Internal (ignoreSIGPIPE) +import qualified Turtle.Internal as Internal import Turtle.Line {-| Run a command using @execvp@, retrieving the exit code @@ -567,7 +565,7 @@ mvar <- newMVar False let close handle = do modifyMVar_ mvar (\finalized -> do - unless finalized (ignoreSIGPIPE (hClose handle)) + unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) let close' (Just hIn, ph) = do close hIn @@ -578,7 +576,7 @@ let handle (Just hIn, ph) = do let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore = - restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn + restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn mask (\restore -> withAsync (feedIn restore) (\a -> restore (Process.waitForProcess ph) `finally` halt a) ) @@ -616,13 +614,13 @@ mvar <- newMVar False let close handle = do modifyMVar_ mvar (\finalized -> do - unless finalized (ignoreSIGPIPE (hClose handle)) + unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph) (\(hIn, hOut, ph) -> do let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore = - restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn + restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn concurrently (mask (\restore -> @@ -659,13 +657,13 @@ mvar <- newMVar False let close handle = do modifyMVar_ mvar (\finalized -> do - unless finalized (ignoreSIGPIPE (hClose handle)) + unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) bracket open (\(hIn, _, _, ph) -> close hIn >> Process.terminateProcess ph) (\(hIn, hOut, hErr, ph) -> do let feedIn :: (forall a. IO a -> IO a) -> IO () feedIn restore = - restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn + restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn runConcurrently $ (,,) <$> Concurrently (mask (\restore -> @@ -743,12 +741,12 @@ mvar <- liftIO (newMVar False) let close handle = do modifyMVar_ mvar (\finalized -> do - unless finalized (ignoreSIGPIPE (hClose handle)) + unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) (hIn, hOut, ph) <- using (managed (bracket open (\(hIn, _, ph) -> close hIn >> Process.terminateProcess ph))) let feedIn :: (forall a. IO a -> IO a) -> IO () - feedIn restore = restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn + feedIn restore = restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn a <- using (managed (\k -> @@ -784,12 +782,12 @@ mvar <- liftIO (newMVar False) let close handle = do modifyMVar_ mvar (\finalized -> do - unless finalized (ignoreSIGPIPE (hClose handle)) + unless finalized (Internal.ignoreSIGPIPE (hClose handle)) return True ) (hIn, hOut, hErr, ph) <- using (managed (bracket open (\(hIn, _, _, ph) -> close hIn >> Process.terminateProcess ph))) let feedIn :: (forall a. IO a -> IO a) -> IO () - feedIn restore = restore (ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn + feedIn restore = restore (Internal.ignoreSIGPIPE (outhandle hIn s)) `finally` close hIn queue <- liftIO TQueue.newTQueueIO let forwardOut :: (forall a. IO a -> IO a) -> IO () @@ -930,7 +928,7 @@ threads since this modifies the global state of the process -} cd :: MonadIO io => FilePath -> io () -cd path = liftIO (Filesystem.setWorkingDirectory path) +cd path = liftIO (Directory.setCurrentDirectory path) {-| Change the current directory. Once the current 'Shell' is done, it returns back to the original directory. @@ -949,23 +947,19 @@ -- | Get the current directory pwd :: MonadIO io => io FilePath -pwd = liftIO Filesystem.getWorkingDirectory +pwd = liftIO Directory.getCurrentDirectory -- | Get the home directory home :: MonadIO io => io FilePath -home = liftIO Filesystem.getHomeDirectory +home = liftIO Directory.getHomeDirectory -- | Get the path pointed to by a symlink readlink :: MonadIO io => FilePath -> io FilePath -readlink = - fmap Filesystem.decodeString - . liftIO - . System.Directory.getSymbolicLinkTarget - . Filesystem.encodeString +readlink path = liftIO (Directory.getSymbolicLinkTarget path) -- | Canonicalize a path realpath :: MonadIO io => FilePath -> io FilePath -realpath path = liftIO (Filesystem.canonicalizePath path) +realpath path = liftIO (Directory.canonicalizePath path) #ifdef mingw32_HOST_OS fILE_ATTRIBUTE_REPARSE_POINT :: Win32.FileAttributeOrFlag @@ -980,7 +974,7 @@ -} ls :: FilePath -> Shell FilePath ls path = Shell (\(FoldShell step begin done) -> do - let path' = Filesystem.encodeString path + let path' = path canRead <- fmap Directory.readable (Directory.getPermissions (deslash path')) @@ -988,13 +982,12 @@ reparse <- fmap reparsePoint (Win32.getFileAttributes path') if (canRead && not reparse) then bracket - (Win32.findFirstFile (Filesystem.encodeString (path </> "*"))) + (Win32.findFirstFile (path </> "*")) (\(h, _) -> Win32.findClose h) (\(h, fdat) -> do let loop x = do - file' <- Win32.getFindDataFileName fdat - let file = Filesystem.decodeString file' - x' <- if (file' /= "." && file' /= "..") + file <- Win32.getFindDataFileName fdat + x' <- if (file /= "." && file /= "..") then step x (path </> file) else return x more <- Win32.findNextFile h fdat @@ -1005,12 +998,11 @@ if canRead then bracket (openDirStream path') closeDirStream (\dirp -> do let loop x = do - file' <- readDirStream dirp - case file' of + file <- readDirStream dirp + case file of "" -> done x _ -> do - let file = Filesystem.decodeString file' - x' <- if (file' /= "." && file' /= "..") + x' <- if (file /= "." && file /= "..") then step x (path </> file) else return x loop $! x' @@ -1086,11 +1078,11 @@ but the operation will not be atomic -} mv :: MonadIO io => FilePath -> FilePath -> io () -mv oldPath newPath = liftIO $ catchIOError (Filesystem.rename oldPath newPath) +mv oldPath newPath = liftIO $ catchIOError (Directory.renameFile oldPath newPath) (\ioe -> if ioeGetErrorType ioe == UnsupportedOperation -- certainly EXDEV then do - Filesystem.copyFile oldPath newPath - Filesystem.removeFile oldPath + Directory.copyFile oldPath newPath + Directory.removeFile oldPath else ioError ioe) {-| Create a directory @@ -1098,18 +1090,18 @@ Fails if the directory is present -} mkdir :: MonadIO io => FilePath -> io () -mkdir path = liftIO (Filesystem.createDirectory False path) +mkdir path = liftIO (Directory.createDirectory path) {-| Create a directory tree (equivalent to @mkdir -p@) Does not fail if the directory is present -} mktree :: MonadIO io => FilePath -> io () -mktree path = liftIO (Filesystem.createTree path) +mktree path = liftIO (Directory.createDirectoryIfMissing True path) -- | Copy a file cp :: MonadIO io => FilePath -> FilePath -> io () -cp oldPath newPath = liftIO (Filesystem.copyFile oldPath newPath) +cp oldPath newPath = liftIO (Directory.copyFile oldPath newPath) #if !defined(mingw32_HOST_OS) -- | Create a symlink from one @FilePath@ to another @@ -1138,7 +1130,7 @@ -- a directory and fails to strip it as a prefix from `/tmp/foo`. Adding -- `(</> "")` to the end of the path makes clear that the path is a -- directory - Just suffix <- return (Filesystem.stripPrefix (oldTree </> "") oldPath) + Just suffix <- return (Internal.stripPrefix (oldTree <> [ FilePath.pathSeparator ]) oldPath) let newPath = newTree </> suffix @@ -1148,14 +1140,14 @@ if PosixCompat.isSymbolicLink fileStatus then do - oldTarget <- liftIO (PosixCompat.readSymbolicLink (Filesystem.encodeString oldPath)) + oldTarget <- liftIO (PosixCompat.readSymbolicLink oldPath) - mktree (Filesystem.directory newPath) + mktree (FilePath.takeDirectory newPath) - liftIO (PosixCompat.createSymbolicLink oldTarget (Filesystem.encodeString newPath)) + liftIO (PosixCompat.createSymbolicLink oldTarget newPath) else if isFile then do - mktree (Filesystem.directory newPath) + mktree (FilePath.takeDirectory newPath) cp oldPath newPath else do @@ -1165,21 +1157,21 @@ cptreeL :: MonadIO io => FilePath -> FilePath -> io () cptreeL oldTree newTree = sh (do oldPath <- lstree oldTree - Just suffix <- return (Filesystem.stripPrefix (oldTree </> "") oldPath) + Just suffix <- return (Internal.stripPrefix (oldTree ++ "/") oldPath) let newPath = newTree </> suffix isFile <- testfile oldPath if isFile - then mktree (Filesystem.directory newPath) >> cp oldPath newPath + then mktree (FilePath.takeDirectory newPath) >> cp oldPath newPath else mktree newPath ) -- | Remove a file rm :: MonadIO io => FilePath -> io () -rm path = liftIO (Filesystem.removeFile path) +rm path = liftIO (Directory.removeFile path) -- | Remove a directory rmdir :: MonadIO io => FilePath -> io () -rmdir path = liftIO (Filesystem.removeDirectory path) +rmdir path = liftIO (Directory.removeDirectory path) {-| Remove a directory tree (equivalent to @rm -r@) @@ -1203,11 +1195,11 @@ -- | Check if a file exists testfile :: MonadIO io => FilePath -> io Bool -testfile path = liftIO (Filesystem.isFile path) +testfile path = liftIO (Directory.doesFileExist path) -- | Check if a directory exists testdir :: MonadIO io => FilePath -> io Bool -testdir path = liftIO (Filesystem.isDirectory path) +testdir path = liftIO (Directory.doesDirectoryExist path) -- | Check if a path exists testpath :: MonadIO io => FilePath -> io Bool @@ -1228,7 +1220,7 @@ #ifdef mingw32_HOST_OS then do handle <- Win32.createFile - (Filesystem.encodeString file) + file Win32.gENERIC_WRITE Win32.fILE_SHARE_NONE Nothing @@ -1237,15 +1229,15 @@ Nothing (creationTime, _, _) <- Win32.getFileTime handle systemTime <- Win32.getSystemTimeAsFileTime - Win32.setFileTime handle creationTime systemTime systemTime + Win32.setFileTime handle (Just creationTime) (Just systemTime) (Just systemTime) #else - then touchFile (Filesystem.encodeString file) + then touchFile file #endif else output file empty ) -{-| This type is the same as @"System.Directory".`System.Directory.Permissions`@ - type except combining the `System.Directory.executable` and - `System.Directory.searchable` fields into a single `executable` field for +{-| This type is the same as @"System.Directory".`Directory.Permissions`@ + type except combining the `Directory.executable` and + `Directory.searchable` fields into a single `executable` field for consistency with the Unix @chmod@. This simplification is still entirely consistent with the behavior of "System.Directory", which treats the two fields as interchangeable. @@ -1257,26 +1249,26 @@ } deriving (Eq, Read, Ord, Show) {-| Under the hood, "System.Directory" does not distinguish between - `System.Directory.executable` and `System.Directory.searchable`. They both + `Directory.executable` and `Directory.searchable`. They both translate to the same `System.Posix.ownerExecuteMode` permission. That - means that we can always safely just set the `System.Directory.executable` - field and safely leave the `System.Directory.searchable` field as `False` + means that we can always safely just set the `Directory.executable` + field and safely leave the `Directory.searchable` field as `False` because the two fields are combined with (`||`) to determine whether to set the executable bit. -} -toSystemDirectoryPermissions :: Permissions -> System.Directory.Permissions +toSystemDirectoryPermissions :: Permissions -> Directory.Permissions toSystemDirectoryPermissions p = - ( System.Directory.setOwnerReadable (_readable p) - . System.Directory.setOwnerWritable (_writable p) - . System.Directory.setOwnerExecutable (_executable p) - ) System.Directory.emptyPermissions + ( Directory.setOwnerReadable (_readable p) + . Directory.setOwnerWritable (_writable p) + . Directory.setOwnerExecutable (_executable p) + ) Directory.emptyPermissions -fromSystemDirectoryPermissions :: System.Directory.Permissions -> Permissions +fromSystemDirectoryPermissions :: Directory.Permissions -> Permissions fromSystemDirectoryPermissions p = Permissions - { _readable = System.Directory.readable p - , _writable = System.Directory.writable p + { _readable = Directory.readable p + , _writable = Directory.writable p , _executable = - System.Directory.executable p || System.Directory.searchable p + Directory.executable p || Directory.searchable p } {-| Update a file or directory's user permissions @@ -1311,7 +1303,7 @@ -> io Permissions -- ^ Updated permissions chmod modifyPermissions path = liftIO (do - let path' = deslash (Filesystem.encodeString path) + let path' = deslash path permissions <- Directory.getPermissions path' let permissions' = fromSystemDirectoryPermissions permissions let permissions'' = modifyPermissions permissions' @@ -1323,21 +1315,21 @@ -- | Get a file or directory's user permissions getmod :: MonadIO io => FilePath -> io Permissions getmod path = liftIO (do - let path' = deslash (Filesystem.encodeString path) + let path' = deslash path permissions <- Directory.getPermissions path' return (fromSystemDirectoryPermissions permissions)) -- | Set a file or directory's user permissions setmod :: MonadIO io => Permissions -> FilePath -> io () setmod permissions path = liftIO (do - let path' = deslash (Filesystem.encodeString path) + let path' = deslash path Directory.setPermissions path' (toSystemDirectoryPermissions permissions) ) -- | Copy a file or directory's permissions (analogous to @chmod --reference@) copymod :: MonadIO io => FilePath -> FilePath -> io () copymod sourcePath targetPath = liftIO (do - let sourcePath' = deslash (Filesystem.encodeString sourcePath) - targetPath' = deslash (Filesystem.encodeString targetPath) + let sourcePath' = deslash sourcePath + targetPath' = deslash targetPath Directory.copyPermissions sourcePath' targetPath' ) -- | @+r@ @@ -1425,7 +1417,7 @@ whichAll :: FilePath -> Shell FilePath whichAll cmd = do Just paths <- need "PATH" - path <- select (Filesystem.splitSearchPathString . Text.unpack $ paths) + path <- select (fmap Text.unpack (Text.splitOn ":" paths)) let path' = path </> cmd True <- testfile path' @@ -1498,10 +1490,8 @@ -- ^ Directory name template -> managed FilePath mktempdir parent prefix = using (do - let parent' = Filesystem.encodeString parent let prefix' = unpack prefix - dir' <- managed (withTempDirectory parent' prefix') - return (Filesystem.decodeString dir')) + managed (withTempDirectory parent prefix')) {-| Create a temporary file underneath the given directory @@ -1520,11 +1510,10 @@ -- ^ File name template -> managed (FilePath, Handle) mktemp parent prefix = using (do - let parent' = Filesystem.encodeString parent let prefix' = unpack prefix (file', handle) <- managed (\k -> - withTempFile parent' prefix' (\file' handle -> k (file', handle)) ) - return (Filesystem.decodeString file', handle) ) + withTempFile parent prefix' (\file' handle -> k (file', handle)) ) + return (file', handle) ) {-| Create a temporary file underneath the given directory @@ -1538,12 +1527,11 @@ -- ^ File name template -> managed FilePath mktempfile parent prefix = using (do - let parent' = Filesystem.encodeString parent let prefix' = unpack prefix (file', handle) <- managed (\k -> - withTempFile parent' prefix' (\file' handle -> k (file', handle)) ) + withTempFile parent prefix' (\file' handle -> k (file', handle)) ) liftIO (hClose handle) - return (Filesystem.decodeString file') ) + return file' ) -- | Fork a thread, acquiring an `Async` value fork :: MonadManaged managed => IO a -> managed (Async a) @@ -1614,15 +1602,15 @@ -- | Acquire a `Managed` read-only `Handle` from a `FilePath` readonly :: MonadManaged managed => FilePath -> managed Handle -readonly file = using (managed (Filesystem.withTextFile file IO.ReadMode)) +readonly file = using (managed (IO.withFile file IO.ReadMode)) -- | Acquire a `Managed` write-only `Handle` from a `FilePath` writeonly :: MonadManaged managed => FilePath -> managed Handle -writeonly file = using (managed (Filesystem.withTextFile file IO.WriteMode)) +writeonly file = using (managed (IO.withFile file IO.WriteMode)) -- | Acquire a `Managed` append-only `Handle` from a `FilePath` appendonly :: MonadManaged managed => FilePath -> managed Handle -appendonly file = using (managed (Filesystem.withTextFile file IO.AppendMode)) +appendonly file = using (managed (IO.withFile file IO.AppendMode)) -- | Combine the output of multiple `Shell`s, in order cat :: [Shell a] -> Shell a @@ -1689,11 +1677,7 @@ -- | Make a `Shell Text -> Shell Text` function work on `FilePath`s instead. -- | Ignores any paths which cannot be decoded as valid `Text`. onFiles :: (Shell Text -> Shell Text) -> Shell FilePath -> Shell FilePath -onFiles f = fmap Filesystem.fromText . f . getRights . fmap Filesystem.toText - where - getRights :: forall a. Shell (Either a Text) -> Shell Text - getRights s = s >>= either (const empty) return - +onFiles f = fmap Text.unpack . f . fmap Text.pack -- | Like `sed`, but operates in place on a `FilePath` (analogous to @sed -i@) inplace :: MonadIO io => Pattern Text -> FilePath -> io () @@ -1733,8 +1717,11 @@ find :: Pattern a -> FilePath -> Shell FilePath find pattern' dir = do path <- lsif isNotSymlink dir - Right txt <- return (Filesystem.toText path) - _:_ <- return (match pattern' txt) + + let txt = Text.pack path + + _:_ <- return (match pattern' txt) + return path where isNotSymlink :: FilePath -> IO Bool @@ -1746,8 +1733,11 @@ findtree :: Pattern a -> Shell FilePath -> Shell FilePath findtree pat files = do path <- files - Right txt <- return (Filesystem.toText path) + + let txt = Text.pack path + _:_ <- return (match pat txt) + return path {- | Check if a file was last modified after a given @@ -1944,7 +1934,7 @@ -- | Get the time a file was last modified datefile :: MonadIO io => FilePath -> io UTCTime -datefile path = liftIO (Filesystem.getModified path) +datefile path = liftIO (Directory.getModificationTime path) -- | Get the size of a file or a directory du :: MonadIO io => FilePath -> io Size @@ -1956,9 +1946,9 @@ let sizes = do child <- lstree path True <- testfile child - liftIO (Filesystem.getSize child) + liftIO (Directory.getFileSize child) fold sizes Control.Foldl.sum - else Filesystem.getSize path + else Directory.getFileSize path return (Size size) ) {-| An abstract file size @@ -2174,7 +2164,7 @@ -- | Get the status of a file stat :: MonadIO io => FilePath -> io PosixCompat.FileStatus -stat = liftIO . PosixCompat.getFileStatus . Filesystem.encodeString +stat = liftIO . PosixCompat.getFileStatus -- | Size of the file in bytes. Does not follow symlinks fileSize :: PosixCompat.FileStatus -> Size @@ -2194,7 +2184,7 @@ -- | Get the status of a file, but don't follow symbolic links lstat :: MonadIO io => FilePath -> io PosixCompat.FileStatus -lstat = liftIO . PosixCompat.getSymbolicLinkStatus . Filesystem.encodeString +lstat = liftIO . PosixCompat.getSymbolicLinkStatus data WithHeader a = Header a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/src/Turtle.hs new/turtle-1.6.1/src/Turtle.hs --- old/turtle-1.5.24/src/Turtle.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/turtle-1.6.1/src/Turtle.hs 2001-09-09 03:46:40.000000000 +0200 @@ -47,8 +47,6 @@ -- -- "Control.Monad.Managed.Safe" provides `Managed` resources -- --- "Filesystem.Path.CurrentOS" provides `FilePath`-manipulation utilities --- -- Additionally, you might also want to import the following modules qualified: -- -- * "Options.Applicative" from @optparse-applicative@ for command-line option @@ -61,8 +59,6 @@ -- * "Data.Text" (for `Text`-manipulation utilities) -- -- * "Data.Text.IO" (for reading and writing `Text`) --- --- * "Filesystem.Path.CurrentOS" (for the remaining `FilePath` utilities) module Turtle ( -- * Modules @@ -77,7 +73,8 @@ , module Control.Monad.IO.Class , module Data.Monoid , module Control.Monad.Managed - , module Filesystem.Path.CurrentOS + , module System.FilePath + , module Turtle.Internal , Fold(..) , FoldM(..) , Text @@ -120,9 +117,23 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.Monoid (Monoid(..), (<>)) import Data.String (IsString(..)) -import Filesystem.Path.CurrentOS +import Control.Monad.Managed (Managed, managed, runManaged, with) +import Control.Foldl (Fold(..), FoldM(..)) +import Data.Text (Text) +import Data.Time (NominalDiffTime, UTCTime) +import System.FilePath ( FilePath - , root + , dropExtension + , hasExtension + , isAbsolute + , isRelative + , (</>) + , (<.>) + ) +import System.IO (Handle) +import System.Exit (ExitCode(..)) +import Turtle.Internal + ( root , directory , parent , filename @@ -130,27 +141,18 @@ , basename , absolute , relative - , (</>) , commonPrefix , stripPrefix , collapse , splitDirectories , extension - , hasExtension - , (<.>) - , dropExtension , splitExtension + , splitExtensions , toText , fromText , encodeString , decodeString ) -import Control.Monad.Managed (Managed, managed, runManaged, with) -import Control.Foldl (Fold(..), FoldM(..)) -import Data.Text (Text) -import Data.Time (NominalDiffTime, UTCTime) -import System.IO (Handle) -import System.Exit (ExitCode(..)) import Prelude hiding (FilePath) #if __GLASGOW_HASKELL__ >= 710 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/test/cptree.hs new/turtle-1.6.1/test/cptree.hs --- old/turtle-1.5.24/test/cptree.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/turtle-1.6.1/test/cptree.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} import Turtle -import Filesystem.Path.CurrentOS () import System.IO.Temp (withSystemTempDirectory) import qualified Control.Monad.Fail as Fail import Control.Monad (unless) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/test/system-filepath.hs new/turtle-1.6.1/test/system-filepath.hs --- old/turtle-1.5.24/test/system-filepath.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/turtle-1.6.1/test/system-filepath.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,226 @@ +{-# Language CPP #-} +{-# Options_GHC -Wno-deprecations #-} + +module Main (main) where + +import Test.Tasty +import Test.Tasty.HUnit +import Turtle + +main :: IO () +main = defaultMain $ testGroup "system-filepath tests" + [ test_Root + , test_Directory + , test_Parent + , test_CommonPrefix + , test_StripPrefix + , test_Collapse + , test_Filename + , test_Dirname + , test_Basename + , test_Absolute + , test_Relative + , test_SplitDirectories + , test_SplitExtension + ] + +test_Root :: TestTree +test_Root = testCase "root" $ do + "" @=? root "" +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + "c:\\" @=? root "c:\\" + "c:\\" @=? root "c:\\foo" +#else + "/" @=? root "/" + "/" @=? root "/foo" +#endif + "" @=? root "foo" + +test_Directory :: TestTree +test_Directory = testCase "directory" $ do + "./" @=? directory "" + "/" @=? directory "/" + "/foo/" @=? directory "/foo/bar" + "/foo/bar/" @=? directory "/foo/bar/" + "./" @=? directory "." + "../" @=? directory ".." + "../" @=? directory "../foo" + "../foo/" @=? directory "../foo/" + "./" @=? directory "foo" + "foo/" @=? directory "foo/bar" + +test_Parent :: TestTree +test_Parent = testCase "parent" $ do + -- The behavior in the presence of `.` / `..` is messed up, but that's how + -- the old system-filepath package worked, so we're preserving that for + -- backwards compatibility (for now) + "./" @=? parent "" + "./" @=? parent "." + "./" @=? parent ".." + "/" @=? parent "/.." + "/" @=? parent "/." + "./" @=? parent "./." + "./" @=? parent "./.." + "../" @=? parent "../.." + "../" @=? parent "../." + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + "c:\\" @=? parent "c:\\" +#else + "/" @=? parent "/" +#endif + "./" @=? parent "foo" + "./" @=? parent "./foo" + "./foo/" @=? parent "foo/bar" + "./foo/" @=? parent "foo/bar/" + "./foo/" @=? parent "./foo/bar" + "/" @=? parent "/foo" + "/foo/" @=? parent "/foo/bar" + +test_Filename :: TestTree +test_Filename = testCase "filename" $ do + "" @=? filename "" + "" @=? filename "." + "" @=? filename ".." + "" @=? filename "/" + "" @=? filename "/foo/" + "bar" @=? filename "/foo/bar" + "bar.txt" @=? filename "/foo/bar.txt" + +test_Dirname :: TestTree +test_Dirname = testCase "dirname" $ do + "" @=? dirname "" + "" @=? dirname "/" + "" @=? dirname "foo" + ".." @=? dirname ".." + "foo" @=? dirname "foo/bar" + "bar" @=? dirname "foo/bar/" + "bar" @=? dirname "foo/bar/baz.txt" + + -- the directory name will be re-parsed to a file name. + let dirnameExts q = snd (splitExtensions (dirname q)) + ["d"] @=? dirnameExts "foo.d/bar" + +test_Basename :: TestTree +test_Basename = testCase "basename" $ do + "" @=? basename ".." + "" @=? basename "/" + "" @=? basename "." + ".txt" @=? basename ".txt" + "foo" @=? basename "foo.txt" + "bar" @=? basename "foo/bar.txt" + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + "bar" @=? basename "c:\\foo\\bar" + "bar" @=? basename "c:\\foo\\bar.txt" +#else + "bar" @=? basename "/foo/bar" + "bar" @=? basename "/foo/bar.txt" +#endif + +test_Absolute :: TestTree +test_Absolute = testCase "absolute" $ do + let myAssert q = assertBool ("absolute " ++ show q) $ absolute q + let myAssert' q = assertBool ("not $ absolute " ++ show q) $ not $ absolute q + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + myAssert "c:\\" + myAssert "c:\\foo\\bar" + myAssert' "" + myAssert' "foo\\bar" + myAssert' "\\foo\\bar" +#else + myAssert "/" + myAssert "/foo/bar" + myAssert' "" + myAssert' "foo/bar" +#endif + + +test_Relative :: TestTree +test_Relative = testCase "relative" $ do + let myAssert q = assertBool ("relative " ++ show q) $ relative q + let myAssert' q = assertBool ("not $ relative " ++ show q) $ not $ relative q + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + myAssert' "c:\\" + myAssert' "c:\\foo\\bar" + myAssert "" + myAssert "foo\\bar" +#else + myAssert' "/" + myAssert' "/foo/bar" + myAssert "" + myAssert "foo/bar" +#endif + +test_CommonPrefix :: TestTree +test_CommonPrefix = testCase "commonPrefix" $ do + "" @=? commonPrefix [] + "./" @=? commonPrefix [".", "."] + "" @=? commonPrefix [".", ".."] + "foo/" @=? commonPrefix ["foo/bar", "foo/baz"] + "foo/a.b" @=? commonPrefix ["foo/a.b.c", "foo/a.b.d"] + "" @=? commonPrefix ["foo/", "bar/"] + +test_StripPrefix :: TestTree +test_StripPrefix = testCase "stripPrefix" $ do + Just "" @=? stripPrefix "" "" + Just "/" @=? stripPrefix "" "/" + Just "" @=? stripPrefix "/" "/" + Just "foo" @=? stripPrefix "/" "/foo" + Just "foo" @=? stripPrefix "./" "./foo" + Just "foo.ext" @=? stripPrefix "./" "./foo.ext" + Just "foo/bar" @=? stripPrefix "/" "/foo/bar" + Just "bar" @=? stripPrefix "/foo/" "/foo/bar" + Just "bar/baz" @=? stripPrefix "/foo/" "/foo/bar/baz" + Just ".txt" @=? stripPrefix "/foo/bar" "/foo/bar.txt" + Just ".gz" @=? stripPrefix "/foo/bar.txt" "/foo/bar.txt.gz" + + -- Test ignoring non-matching prefixes + Nothing @=? stripPrefix "/foo" "/foo/bar" + Nothing @=? stripPrefix "/foo/bar/baz" "/foo" + Nothing @=? stripPrefix "/foo/baz/" "/foo/bar/qux" + Nothing @=? stripPrefix "/foo/bar/baz" "/foo/bar/qux" + +test_Collapse :: TestTree +test_Collapse = testCase "collapse" $ do + -- This behavior differs from the old `system-filepath` package, but this + -- behavior is more correct in the presence of symlinks +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) + "foo\\..\\bar" @=? collapse "foo/../bar" + "foo\\bar" @=? collapse "foo/bar" + "foo\\bar" @=? collapse "foo/./bar" +#else + "foo/../bar" @=? collapse "foo/../bar" + "foo/bar" @=? collapse "foo/bar" + "foo/bar" @=? collapse "foo/./bar" +#endif + +test_SplitDirectories :: TestTree +test_SplitDirectories = testCase "splitDirectories" $ do + [] @=? splitDirectories "" + ["./"] @=? splitDirectories "." + ["../"] @=? splitDirectories ".." + ["foo/", "../"] @=? splitDirectories "foo/.." + ["foo/", "./"] @=? splitDirectories "foo/." + ["/"] @=? splitDirectories "/" + ["/", "a"] @=? splitDirectories "/a" + ["/", "ab/", "cd"] @=? splitDirectories "/ab/cd" + ["/", "ab/", "cd/"] @=? splitDirectories "/ab/cd/" + ["ab/", "cd"] @=? splitDirectories "ab/cd" + ["ab/", "cd/"] @=? splitDirectories "ab/cd/" + ["ab/", "cd.txt"] @=? splitDirectories "ab/cd.txt" + ["ab/", "cd/", ".txt"] @=? splitDirectories "ab/cd/.txt" + ["ab/", "./", "cd"] @=? splitDirectories "ab/./cd" + +test_SplitExtension :: TestTree +test_SplitExtension = testCase "splitExtension" $ do + ("", Nothing) @=? splitExtension "" + ("foo", Nothing) @=? splitExtension "foo" + ("foo", Just "") @=? splitExtension "foo." + ("foo", Just "a") @=? splitExtension "foo.a" + ("foo.a/", Nothing) @=? splitExtension "foo.a/" + ("foo.a/bar", Nothing) @=? splitExtension "foo.a/bar" + ("foo.a/bar", Just "b") @=? splitExtension "foo.a/bar.b" + ("foo.a/bar.b", Just "c") @=? splitExtension "foo.a/bar.b.c" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/turtle-1.5.24/turtle.cabal new/turtle-1.6.1/turtle.cabal --- old/turtle-1.5.24/turtle.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/turtle-1.6.1/turtle.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ Name: turtle -Version: 1.5.24 +Version: 1.6.1 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 @@ -29,7 +29,7 @@ . * Formatting: Type-safe @printf@-style text formatting . - * Modern: Supports @text@ and @system-filepath@ + * Modern: Supports @text@ . Read "Turtle.Tutorial" for a detailed tutorial or "Turtle.Prelude" for a quick-start guide @@ -42,7 +42,7 @@ Tested-With: GHC == 9.2.1 - GHC == 9.0.1 + GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 GHC == 8.6.5 @@ -69,12 +69,11 @@ containers >= 0.5.0.0 && < 0.7 , directory >= 1.3.1.0 && < 1.4 , exceptions >= 0.4 && < 0.11, + filepath >= 1.4.1.2 && < 1.5 , foldl >= 1.1 && < 1.5 , hostname < 1.1 , managed >= 1.0.3 && < 1.1 , process >= 1.0.1.1 && < 1.7 , - system-filepath >= 0.3.1 && < 0.5 , - system-fileio >= 0.2.1 && < 0.4 , stm < 2.6 , streaming-commons < 0.3 , temporary < 1.4 , @@ -83,9 +82,9 @@ transformers >= 0.2.0.0 && < 0.7 , optparse-applicative >= 0.16 && < 0.18, optional-args >= 1.0 && < 2.0 , - unix-compat >= 0.4 && < 0.6 + unix-compat >= 0.4 && < 0.7 if os(windows) - Build-Depends: Win32 >= 2.2.0.1 && < 2.9 + Build-Depends: Win32 >= 2.12 else Build-Depends: unix >= 2.5.1.0 && < 2.8 @@ -143,7 +142,20 @@ Build-Depends: base >= 4 && < 5, temporary, - system-filepath >= 0.4, + filepath >= 0.4, + turtle + +test-suite system-filepath-tests + Type: exitcode-stdio-1.0 + HS-Source-Dirs: test + Main-Is: system-filepath.hs + GHC-Options: -Wall -threaded + Default-Language: Haskell2010 + Build-Depends: + base, + filepath, + tasty >=1.4 && <1.5, + tasty-hunit >=0.10 && <0.11, turtle benchmark bench

1 0

commit ghc-tree-diff for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-tree-diff for openSUSE:Factory checked in at 2022-08-01 21:30:43 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tree-diff (Old) and /work/SRC/openSUSE:Factory/.ghc-tree-diff.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-tree-diff" Mon Aug 1 21:30:43 2022 rev:8 rq:987104 version:0.2.1.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tree-diff/ghc-tree-diff.changes 2022-02-11 23:09:59.679047514 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-tree-diff.new.1533/ghc-tree-diff.changes 2022-08-01 21:31:14.785802346 +0200 @@ -1,0 +2,6 @@ +Mon Jun 20 17:52:40 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update tree-diff to version 0.2.1.1 revision 2. + Upstream has revised the Cabal build instructions on Hackage. + +------------------------------------------------------------------- New: ---- tree-diff.cabal ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tree-diff.spec ++++++ --- /var/tmp/diff_new_pack.bhjZpo/_old 2022-08-01 21:31:15.537804503 +0200 +++ /var/tmp/diff_new_pack.bhjZpo/_new 2022-08-01 21:31:15.541804514 +0200 @@ -25,6 +25,7 @@ License: GPL-2.0-or-later URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-aeson-devel @@ -91,6 +92,7 @@ %prep %autosetup -n %{pkg_name}-%{version} +cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ tree-diff.cabal ++++++ cabal-version: 2.2 name: tree-diff version: 0.2.1.1 x-revision: 2 synopsis: Diffing of (expression) trees. category: Data, Testing description: Common diff algorithm works on list structures: . @ diff :: Eq a => [a] -> [a] -> [Edit a] @ . This package works on trees. . @ treeDiff :: Eq a => Tree a -> Tree a -> Edit (EditTree a) @ . This package also provides a way to diff arbitrary ADTs, using @Generics@-derivable helpers. . This package differs from <http://hackage.haskell.org/package/gdiff gdiff>, in a two ways: @tree-diff@ doesn't have patch function, and the "edit-script" is a tree itself, which is useful for pretty-printing. . @ >>> prettyEditExpr $ ediff (Foo 42 [True, False] "old") (Foo 42 [False, False, True] "new") Foo \ {fooBool = [-True, +False, False, +True], \ fooInt = 42, \ fooString = -"old" +"new"} @ homepage: https://github.com/phadej/tree-diff bug-reports: https://github.com/phadej/tree-diff/issues license: GPL-2.0-or-later license-file: LICENSE author: Oleg Grenrus <oleg.grenrus(a)iki.fi> maintainer: Oleg.Grenrus <oleg.grenrus(a)iki.fi> copyright: (c) 2017-2021 Oleg Grenrus build-type: Simple extra-source-files: ChangeLog.md README.md tested-with: GHC ==7.4.2 || ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1 || ==9.2.1 , GHCJS ==8.4 extra-source-files: fixtures/exfoo.expr fixtures/MyInt1.expr fixtures/MyInt2.expr fixtures/MyInt3.expr fixtures/Positional.expr source-repository head type: git location: https://github.com/phadej/tree-diff.git library exposed-modules: Data.TreeDiff Data.TreeDiff.Class Data.TreeDiff.Expr Data.TreeDiff.Golden Data.TreeDiff.List Data.TreeDiff.OMap Data.TreeDiff.Parser Data.TreeDiff.Pretty Data.TreeDiff.QuickCheck Data.TreeDiff.Tree -- GHC boot libraries build-depends: , base >=4.5 && <4.17 , bytestring ^>=0.9.2.1 || ^>=0.10.0.2 || ^>=0.11.0.0 , containers ^>=0.4.2.1 || ^>=0.5.0.0 || ^>=0.6.0.1 , deepseq ^>=1.3.0.0 || ^>=1.4.0.0 , parsec ^>=3.1.13.0 , pretty ^>=1.1.1.0 , text ^>=1.2.3.0 || ^>=2.0 , time ^>=1.4 || ^>=1.5.0.1 || ^>=1.6.0.1 || ^>=1.8.0.2 || ^>=1.9.3 || ^>=1.10 || ^>=1.11 || ^>=1.12 build-depends: , aeson ^>=1.4.6.0 || ^>=1.5.6.0 || ^>=2.0.0.0 || ^>=2.1.0.0 , ansi-terminal >=0.10 && <0.12 , ansi-wl-pprint ^>=0.6.8.2 , base-compat ^>=0.10.5 || ^>=0.11.0 || ^>=0.12 , bytestring-builder ^>=0.10.8.2.0 , hashable ^>=1.2.7.0 || ^>=1.3.0.0 || ^>=1.4.0.1 , parsers ^>=0.12.10 , primitive ^>=0.7.1.0 , QuickCheck ^>=2.14.2 , scientific ^>=0.3.6.2 , semialign >=1.1 && <1.3 , strict ^>=0.4.0.1 , tagged ^>=0.8.6 , these ^>=1.1.1.1 , unordered-containers ^>=0.2.8.0 , uuid-types ^>=1.0.3 , vector ^>=0.12 || ^>=0.13 if impl(ghc <7.5) build-depends: ghc-prim if !impl(ghc >=8.0) build-depends: semigroups ^>=0.19.1 || ^>=0.20 if !impl(ghc >=7.8) build-depends: generic-deriving >=1.13.1 && <1.15 if !impl(ghc >=7.10) build-depends: , nats ^>=1.1.2 , transformers ^>=0.3.0.0 || ^>=0.4.2.0 || ^>=0.5.2.0 , void ^>=0.7.3 other-extensions: CPP ConstraintKinds DefaultSignatures FlexibleContexts GADTs RankNTypes ScopedTypeVariables TypeOperators hs-source-dirs: src default-language: Haskell2010 test-suite tree-diff-test default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Tests.hs hs-source-dirs: tests src-diff ghc-options: -Wall -threaded other-modules: RefDiffBy -- dependencies from library build-depends: , ansi-terminal , ansi-wl-pprint , base , base-compat , parsec , primitive , QuickCheck , tagged , tree-diff if impl(ghc <7.5) build-depends: ghc-prim -- extra dependencies build-depends: , tasty ^>=1.2 || ^>=1.3.1 || ^>=1.4.2 , tasty-golden ^>=2.3.1.1 , tasty-quickcheck ^>=0.10.1 , trifecta >=2 && <2.2 benchmark tree-diff-bench default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: tree-diff-bench.hs hs-source-dirs: bench ghc-options: -Wall -threaded -- dependencies from library build-depends: , base , deepseq , tree-diff -- extra dependencies build-depends: , criterion ^>=1.5.9.0 , Diff ^>=0.4.0

1 0

commit ghc-transformers-compat for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-transformers-compat for openSUSE:Factory checked in at 2022-08-01 21:30:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-transformers-compat (Old) and /work/SRC/openSUSE:Factory/.ghc-transformers-compat.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-transformers-compat" Mon Aug 1 21:30:42 2022 rev:19 rq:987103 version:0.7.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-transformers-compat/ghc-transformers-compat.changes 2022-02-11 23:11:49.343364694 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-transformers-compat.new.1533/ghc-transformers-compat.changes 2022-08-01 21:31:13.109797538 +0200 @@ -1,0 +2,9 @@ +Sun Jun 26 13:13:51 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update transformers-compat to version 0.7.2. + 0.7.2 [2022.06.26] + ------------------ + * Add `Eq`, `Ord`, `Read`, and `Show` instances for `FunctorClassesDefault` in + `Data.Functor.Classes.Generic`. + +------------------------------------------------------------------- Old: ---- transformers-compat-0.7.1.tar.gz transformers-compat.cabal New: ---- transformers-compat-0.7.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-transformers-compat.spec ++++++ --- /var/tmp/diff_new_pack.7elc8n/_old 2022-08-01 21:31:14.169800578 +0200 +++ /var/tmp/diff_new_pack.7elc8n/_new 2022-08-01 21:31:14.173800590 +0200 @@ -18,13 +18,12 @@ %global pkg_name transformers-compat Name: ghc-%{pkg_name} -Version: 0.7.1 +Version: 0.7.2 Release: 0 Summary: A small compatibility shim for the transformers library License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-transformers-devel @@ -55,7 +54,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ transformers-compat-0.7.1.tar.gz -> transformers-compat-0.7.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/transformers-compat-0.7.1/CHANGELOG.markdown new/transformers-compat-0.7.2/CHANGELOG.markdown --- old/transformers-compat-0.7.1/CHANGELOG.markdown 2001-09-09 03:46:40.000000000 +0200 +++ new/transformers-compat-0.7.2/CHANGELOG.markdown 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,8 @@ +0.7.2 [2022.06.26] +------------------ +* Add `Eq`, `Ord`, `Read`, and `Show` instances for `FunctorClassesDefault` in + `Data.Functor.Classes.Generic`. + 0.7.1 [2021.10.30] ------------------ * Backport new instances from GHC 9.2/`base-4.16` diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/transformers-compat-0.7.1/generics/Data/Functor/Classes/Generic/Internal.hs new/transformers-compat-0.7.2/generics/Data/Functor/Classes/Generic/Internal.hs --- old/transformers-compat-0.7.1/generics/Data/Functor/Classes/Generic/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/transformers-compat-0.7.2/generics/Data/Functor/Classes/Generic/Internal.hs 2001-09-09 03:46:40.000000000 +0200 @@ -17,6 +17,10 @@ {-# LANGUAGE EmptyCase #-} #endif +#if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE QuantifiedConstraints #-} +#endif + {-| Module: Data.Functor.Classes.Generic Copyright: (C) 2015-2016 Edward Kmett, Ryan Scott @@ -77,6 +81,19 @@ , GShow1(..) , GShow1Con(..) , Show1Args(..) + -- * 'Eq' + , eqDefault + , GEq(..) + -- * 'Ord' + , compareDefault + , GOrd(..) + -- * 'Read' + , readsPrecDefault + , GRead(..) + -- * 'Show' + , showsPrecDefault + , showsPrecOptions + , GShow(..) -- * 'FunctorClassesDefault' , FunctorClassesDefault(..) -- * Miscellaneous types @@ -156,6 +173,74 @@ data NonV4 ------------------------------------------------------------------------------- +-- * Eq +------------------------------------------------------------------------------- + +-- | A default @('==')@ implementation for 'Generic1' instances that leverages +-- 'Eq1'. +eqDefault :: (GEq (Rep1 f a), Generic1 f) => f a -> f a -> Bool +eqDefault m n = geq (from1 m) (from1 n) + +-- | Class of generic representation types that can be checked for equality. +class GEq a where + geq :: a -> a -> Bool + +instance Eq c => GEq (K1 i c p) where + geq (K1 c) (K1 d) = c == d + +instance (GEq (f p), GEq (g p)) => GEq ((f :*: g) p) where + geq (a :*: b) (c :*: d) = geq a c && geq b d + +instance (GEq (f p), GEq (g p)) => GEq ((f :+: g) p) where + geq (L1 a) (L1 c) = geq a c + geq (R1 b) (R1 d) = geq b d + geq _ _ = False + +instance GEq (f p) => GEq (M1 i c f p) where + geq (M1 a) (M1 b) = geq a b + +instance GEq (U1 p) where + geq U1 U1 = True + +instance GEq (V1 p) where + geq _ _ = True + +instance Eq p => GEq (Par1 p) where + geq (Par1 a) (Par1 b) = a == b + +instance (Eq1 f, Eq p) => GEq (Rec1 f p) where + geq (Rec1 a) (Rec1 b) = eq1 a b + +#if defined(TRANSFORMERS_FOUR) +instance (Functor f, Eq1 f, GEq (g p)) => GEq ((f :.: g) p) where + geq (Comp1 m) (Comp1 n) = eq1 (fmap Apply m) (fmap Apply n) +#else +instance (Eq1 f, GEq (g p)) => GEq ((f :.: g) p) where + geq (Comp1 m) (Comp1 n) = liftEq geq m n +#endif + +#if MIN_VERSION_base(4,9,0) || defined(GENERIC_DERIVING) +-- Unboxed types +instance GEq (UAddr p) where + geq = eqUAddr + +instance GEq (UChar p) where + geq = eqUChar + +instance GEq (UDouble p) where + geq = eqUDouble + +instance GEq (UFloat p) where + geq = eqUFloat + +instance GEq (UInt p) where + geq = eqUInt + +instance GEq (UWord p) where + geq = eqUWord +#endif + +------------------------------------------------------------------------------- -- * Eq1 ------------------------------------------------------------------------------- @@ -191,8 +276,13 @@ liftEqOptions _ f m n = gliftEq (NonV4Eq1Args f) (from1 m) (from1 n) #endif --- | Class of generic representation types that can be checked for equality. -class GEq1 v t where +-- | Class of generic representation types that can lift equality through unary +-- type constructors. +class +#if __GLASGOW_HASKELL__ >= 806 + (forall a. Eq a => GEq (t a)) => +#endif + GEq1 v t where gliftEq :: Eq1Args v a b -> t a -> t b -> Bool instance Eq c => GEq1 v (K1 i c) where @@ -223,7 +313,7 @@ gliftEq V4Eq1Args (Rec1 a) (Rec1 b) = eq1 a b instance (Functor f, Eq1 f, GEq1 V4 g) => GEq1 V4 (f :.: g) where - gliftEq V4Eq1Args (Comp1 m) (Comp1 n) = eq1 (fmap Apply m) (fmap Apply n) + gliftEq V4Eq1Args (Comp1 m) (Comp1 n) = eq1 (fmap Apply1 m) (fmap Apply1 n) #else instance GEq1 NonV4 Par1 where gliftEq (NonV4Eq1Args f) (Par1 a) (Par1 b) = f a b @@ -239,22 +329,109 @@ #if MIN_VERSION_base(4,9,0) || defined(GENERIC_DERIVING) -- Unboxed types instance GEq1 v UAddr where - gliftEq _ (UAddr a1) (UAddr a2) = isTrue# (eqAddr# a1 a2) + gliftEq _ = eqUAddr instance GEq1 v UChar where - gliftEq _ (UChar c1) (UChar c2) = isTrue# (eqChar# c1 c2) + gliftEq _ = eqUChar instance GEq1 v UDouble where - gliftEq _ (UDouble d1) (UDouble d2) = isTrue# (d1 ==## d2) + gliftEq _ = eqUDouble instance GEq1 v UFloat where - gliftEq _ (UFloat f1) (UFloat f2) = isTrue# (eqFloat# f1 f2) + gliftEq _ = eqUFloat instance GEq1 v UInt where - gliftEq _ (UInt i1) (UInt i2) = isTrue# (i1 ==# i2) + gliftEq _ = eqUInt instance GEq1 v UWord where - gliftEq _ (UWord w1) (UWord w2) = isTrue# (eqWord# w1 w2) + gliftEq _ = eqUWord + +eqUAddr :: UAddr p -> UAddr q -> Bool +eqUAddr (UAddr a1) (UAddr a2) = isTrue# (eqAddr# a1 a2) + +eqUChar :: UChar p -> UChar q -> Bool +eqUChar (UChar c1) (UChar c2) = isTrue# (eqChar# c1 c2) + +eqUDouble :: UDouble p -> UDouble q -> Bool +eqUDouble (UDouble d1) (UDouble d2) = isTrue# (d1 ==## d2) + +eqUFloat :: UFloat p -> UFloat q -> Bool +eqUFloat (UFloat f1) (UFloat f2) = isTrue# (eqFloat# f1 f2) + +eqUInt :: UInt p -> UInt q -> Bool +eqUInt (UInt i1) (UInt i2) = isTrue# (i1 ==# i2) + +eqUWord :: UWord p -> UWord q -> Bool +eqUWord (UWord w1) (UWord w2) = isTrue# (eqWord# w1 w2) +#endif + +------------------------------------------------------------------------------- +-- * Ord +------------------------------------------------------------------------------- + +-- | A default 'compare' implementation for 'Generic1' instances that leverages +-- 'Ord1'. +compareDefault :: (GOrd (Rep1 f a), Generic1 f) => f a -> f a -> Ordering +compareDefault m n = gcompare (from1 m) (from1 n) + +-- | Class of generic representation types that can be totally ordered. +class GEq a => GOrd a where + gcompare :: a -> a -> Ordering + +instance Ord c => GOrd (K1 i c p) where + gcompare (K1 c) (K1 d) = compare c d + +instance (GOrd (f p), GOrd (g p)) => GOrd ((f :*: g) p) where + gcompare (a :*: b) (c :*: d) = gcompare a c `mappend` gcompare b d + +instance (GOrd (f p), GOrd (g p)) => GOrd ((f :+: g) p) where + gcompare (L1 a) (L1 c) = gcompare a c + gcompare L1{} R1{} = LT + gcompare R1{} L1{} = GT + gcompare (R1 b) (R1 d) = gcompare b d + +instance GOrd (f p) => GOrd (M1 i c f p) where + gcompare (M1 a) (M1 b) = gcompare a b + +instance GOrd (U1 p) where + gcompare U1 U1 = EQ + +instance GOrd (V1 p) where + gcompare _ _ = EQ + +instance Ord p => GOrd (Par1 p) where + gcompare (Par1 a) (Par1 b) = compare a b + +instance (Ord1 f, Ord p) => GOrd (Rec1 f p) where + gcompare (Rec1 a) (Rec1 b) = compare1 a b + +#if defined(TRANSFORMERS_FOUR) +instance (Functor f, Ord1 f, GOrd (g p)) => GOrd ((f :.: g) p) where + gcompare (Comp1 m) (Comp1 n) = compare1 (fmap Apply m) (fmap Apply n) +#else +instance (Ord1 f, GOrd (g p)) => GOrd ((f :.: g) p) where + gcompare (Comp1 m) (Comp1 n) = liftCompare gcompare m n +#endif + +#if MIN_VERSION_base(4,9,0) || defined(GENERIC_DERIVING) +-- Unboxed types +instance GOrd (UAddr p) where + gcompare = compareUAddr + +instance GOrd (UChar p) where + gcompare = compareUChar + +instance GOrd (UDouble p) where + gcompare = compareUDouble + +instance GOrd (UFloat p) where + gcompare = compareUFloat + +instance GOrd (UInt p) where + gcompare = compareUInt + +instance GOrd (UWord p) where + gcompare = compareUWord #endif ------------------------------------------------------------------------------- @@ -293,8 +470,13 @@ liftCompareOptions _ f m n = gliftCompare (NonV4Ord1Args f) (from1 m) (from1 n) #endif --- | Class of generic representation types that can be totally ordered. -class GEq1 v t => GOrd1 v t where +-- | Class of generic representation types that can lift a total order through +-- unary type constructors. +class ( GEq1 v t +#if __GLASGOW_HASKELL__ >= 806 + , forall a. Ord a => GOrd (t a) +#endif + ) => GOrd1 v t where gliftCompare :: Ord1Args v a b -> t a -> t b -> Ordering instance Ord c => GOrd1 v (K1 i c) where @@ -328,7 +510,7 @@ instance (Functor f, Ord1 f, GOrd1 V4 g) => GOrd1 V4 (f :.: g) where gliftCompare V4Ord1Args (Comp1 m) (Comp1 n) = - compare1 (fmap Apply m) (fmap Apply n) + compare1 (fmap Apply1 m) (fmap Apply1 n) #else instance GOrd1 NonV4 Par1 where gliftCompare (NonV4Ord1Args f) (Par1 a) (Par1 b) = f a b @@ -344,22 +526,40 @@ #if MIN_VERSION_base(4,9,0) || defined(GENERIC_DERIVING) -- Unboxed types instance GOrd1 v UAddr where - gliftCompare _ (UAddr a1) (UAddr a2) = primCompare (eqAddr# a1 a2) (leAddr# a1 a2) + gliftCompare _ = compareUAddr instance GOrd1 v UChar where - gliftCompare _ (UChar c1) (UChar c2) = primCompare (eqChar# c1 c2) (leChar# c1 c2) + gliftCompare _ = compareUChar instance GOrd1 v UDouble where - gliftCompare _ (UDouble d1) (UDouble d2) = primCompare (d1 ==## d2) (d1 <=## d2) + gliftCompare _ = compareUDouble instance GOrd1 v UFloat where - gliftCompare _ (UFloat f1) (UFloat f2) = primCompare (eqFloat# f1 f2) (leFloat# f1 f2) + gliftCompare _ = compareUFloat instance GOrd1 v UInt where - gliftCompare _ (UInt i1) (UInt i2) = primCompare (i1 ==# i2) (i1 <=# i2) + gliftCompare _ = compareUInt instance GOrd1 v UWord where - gliftCompare _ (UWord w1) (UWord w2) = primCompare (eqWord# w1 w2) (leWord# w1 w2) + gliftCompare _ = compareUWord + +compareUAddr :: UAddr p -> UAddr q -> Ordering +compareUAddr (UAddr a1) (UAddr a2) = primCompare (eqAddr# a1 a2) (leAddr# a1 a2) + +compareUChar :: UChar p -> UChar q -> Ordering +compareUChar (UChar c1) (UChar c2) = primCompare (eqChar# c1 c2) (leChar# c1 c2) + +compareUDouble :: UDouble p -> UDouble q -> Ordering +compareUDouble (UDouble d1) (UDouble d2) = primCompare (d1 ==## d2) (d1 <=## d2) + +compareUFloat :: UFloat p -> UFloat q -> Ordering +compareUFloat (UFloat f1) (UFloat f2) = primCompare (eqFloat# f1 f2) (leFloat# f1 f2) + +compareUInt :: UInt p -> UInt q -> Ordering +compareUInt (UInt i1) (UInt i2) = primCompare (i1 ==# i2) (i1 <=# i2) + +compareUWord :: UWord p -> UWord q -> Ordering +compareUWord (UWord w1) (UWord w2) = primCompare (eqWord# w1 w2) (leWord# w1 w2) # if __GLASGOW_HASKELL__ >= 708 primCompare :: Int# -> Int# -> Ordering @@ -372,6 +572,74 @@ #endif ------------------------------------------------------------------------------- +-- * Read +------------------------------------------------------------------------------- + +-- | A default 'readsPrec' implementation for 'Generic1' instances that leverages +-- 'Read1'. +readsPrecDefault :: (GRead (Rep1 f a), Generic1 f) => Int -> ReadS (f a) +readsPrecDefault p = readPrec_to_S (fmap to1 greadPrec) p + +-- | Class of generic representation types that can be parsed from a 'String'. +class GRead a where + greadPrec :: ReadPrec a + +instance (GRead (f p), IsNullaryDataType f) => GRead (D1 d f p) where + greadPrec = d1ReadPrec greadPrec + +instance GRead (V1 p) where + greadPrec = pfail + +instance (GRead (f p), GRead (g p)) => GRead ((f :+: g) p) where + greadPrec = fmap L1 greadPrec +++ fmap R1 greadPrec + +instance (Constructor c, GReadCon (f p), IsNullaryCon f) => GRead (C1 c f p) where + greadPrec = c1ReadPrec greadPrecCon + +-- | Class of generic representation types that can be parsed from a 'String', +-- and for which the 'ConType' has been determined. +class GReadCon a where + greadPrecCon :: ConType -> ReadPrec a + +instance GReadCon (U1 p) where + greadPrecCon _ = return U1 + +instance Read c => GReadCon (K1 i c p) where + greadPrecCon _ = coerceK1 readPrec + +instance (Selector s, GReadCon (f p)) => GReadCon (S1 s f p) where + greadPrecCon = s1ReadPrec . greadPrecCon + +instance (GReadCon (f p), GReadCon (g p)) => GReadCon ((f :*: g) p) where + greadPrecCon t = productReadPrec t (greadPrecCon t) (greadPrecCon t) + +instance Read p => GReadCon (Par1 p) where + greadPrecCon _ = coercePar1 readPrec + +#if defined(TRANSFORMERS_FOUR) +instance (Read1 f, Read p) => GReadCon (Rec1 f p) where + greadPrecCon _ = coerceRec1 $ readS_to_Prec readsPrec1 + +instance (Functor f, Read1 f, GReadCon (g p)) => GReadCon ((f :.: g) p) where + greadPrecCon _ = + coerceComp1 $ fmap (fmap getApply) $ readS_to_Prec crp1 + where + crp1 :: Int -> ReadS (f (Apply g p)) + crp1 = readsPrec1 +#else +instance (Read1 f, Read p) => GReadCon (Rec1 f p) where + greadPrecCon _ = coerceRec1 $ readS_to_Prec $ + liftReadsPrec (readPrec_to_S readPrec) (readPrec_to_S readListPrec 0) + +instance (Read1 f, GReadCon (g p)) => GReadCon ((f :.: g) p) where + greadPrecCon t = coerceComp1 $ readS_to_Prec $ + liftReadsPrec (readPrec_to_S grpc) + (readPrec_to_S (list grpc) 0) + where + grpc = greadPrecCon t +#endif + +------------------------------------------------------------------------------- -- * Read1 ------------------------------------------------------------------------------- @@ -433,6 +701,9 @@ coerceComp1 :: ReadPrec (f (g a)) -> ReadPrec ((f :.: g) a) coerceComp1 = coerce +coerceK1 :: ReadPrec c -> ReadPrec (K1 i c p) +coerceK1 = coerce + isSymVar :: String -> Bool isSymVar "" = False isSymVar (c:_) = startsVarSym c @@ -457,20 +728,29 @@ identHLexemes s | Just (ss, '#') <- snocView s = [Ident ss, Symbol "#"] | otherwise = [Ident s] --- | Class of generic representation types that can be parsed from a 'String'. -class GRead1 v f where +-- | Class of generic representation types for unary type constructors that can +-- be parsed from a 'String'. +class +#if __GLASGOW_HASKELL__ >= 806 + (forall a. Read a => GRead (f a)) => +#endif + GRead1 v f where gliftReadPrec :: Read1Args v a -> ReadPrec (f a) instance (GRead1 v f, IsNullaryDataType f) => GRead1 v (D1 d f) where - gliftReadPrec = coerceM1 . parensIfNonNullary . gliftReadPrec - where - x :: f p - x = undefined + gliftReadPrec = d1ReadPrec . gliftReadPrec - parensIfNonNullary :: ReadPrec a -> ReadPrec a - parensIfNonNullary = if isNullaryDataType x - then id - else parens +d1ReadPrec :: forall d f p. IsNullaryDataType f + => ReadPrec (f p) -> ReadPrec (D1 d f p) +d1ReadPrec rp = coerceM1 $ parensIfNonNullary rp + where + x :: f p + x = undefined + + parensIfNonNullary :: ReadPrec a -> ReadPrec a + parensIfNonNullary = if isNullaryDataType x + then id + else parens instance GRead1 v V1 where gliftReadPrec _ = pfail @@ -480,41 +760,46 @@ fmap L1 (gliftReadPrec ras) +++ fmap R1 (gliftReadPrec ras) instance (Constructor c, GRead1Con v f, IsNullaryCon f) => GRead1 v (C1 c f) where - gliftReadPrec ras = coerceM1 $ case fixity of - Prefix -> precIfNonNullary $ do - if conIsTuple c - then return () - else let cn = conName c - in if isInfixDataCon cn - then readSurround '(' (expectP (Symbol cn)) ')' - else mapM_ expectP $ identHLexemes cn - readBraces t (gliftReadPrecCon t ras) - Infix _ m -> prec m $ gliftReadPrecCon t ras - where - c :: C1 c f p - c = undefined + gliftReadPrec ras = c1ReadPrec $ \t -> gliftReadPrecCon t ras - x :: f p - x = undefined +c1ReadPrec :: forall c f p. (Constructor c, IsNullaryCon f) + => (ConType -> ReadPrec (f p)) -> ReadPrec (C1 c f p) +c1ReadPrec rpc = + coerceM1 $ case fixity of + Prefix -> precIfNonNullary $ do + if conIsTuple c + then return () + else let cn = conName c + in if isInfixDataCon cn + then readSurround '(' (expectP (Symbol cn)) ')' + else mapM_ expectP $ identHLexemes cn + readBraces t (rpc t) + Infix _ m -> prec m $ rpc t + where + c :: C1 c f p + c = undefined - fixity :: Fixity - fixity = conFixity c + x :: f p + x = undefined - precIfNonNullary :: ReadPrec a -> ReadPrec a - precIfNonNullary = if isNullaryCon x - then id - else prec (if conIsRecord c - then appPrec1 - else appPrec) - - t :: ConType - t = if conIsRecord c - then Rec - else case conIsTuple c of - True -> Tup - False -> case fixity of - Prefix -> Pref - Infix _ _ -> Inf $ conName c + fixity :: Fixity + fixity = conFixity c + + precIfNonNullary :: ReadPrec a -> ReadPrec a + precIfNonNullary = if isNullaryCon x + then id + else prec (if conIsRecord c + then appPrec1 + else appPrec) + + t :: ConType + t = if conIsRecord c + then Rec + else case conIsTuple c of + True -> Tup + False -> case fixity of + Prefix -> Pref + Infix _ _ -> Inf $ conName c readBraces :: ConType -> ReadPrec a -> ReadPrec a readBraces Rec r = readSurround '{' r '}' @@ -529,9 +814,14 @@ expectP (Punc [c2]) return r' --- | Class of generic representation types that can be parsed from a 'String', and --- for which the 'ConType' has been determined. -class GRead1Con v f where +-- | Class of generic representation types for unary type constructors that +-- can be parsed from a 'String', and for which the 'ConType' has been +-- determined. +class +#if __GLASGOW_HASKELL__ >= 806 + (forall a. Read a => GReadCon (f a)) => +#endif + GRead1Con v f where gliftReadPrecCon :: ConType -> Read1Args v a -> ReadPrec (f a) instance GRead1Con v U1 where @@ -539,43 +829,48 @@ instance Read c => GRead1Con v (K1 i c) where gliftReadPrecCon _ _ = coerceK1 readPrec - where - coerceK1 :: ReadPrec c -> ReadPrec (K1 i c p) - coerceK1 = coerce instance (Selector s, GRead1Con v f) => GRead1Con v (S1 s f) where - gliftReadPrecCon t ras - | selectorName == "" = coerceM1 $ step $ gliftReadPrecCon t ras - | otherwise = coerceM1 $ do - mapM_ expectP $ readLblLexemes selectorName - expectP (Punc "=") - reset $ gliftReadPrecCon t ras - where - selectorName :: String - selectorName = selName (undefined :: S1 s f p) + gliftReadPrecCon t = s1ReadPrec . gliftReadPrecCon t + +s1ReadPrec :: forall s f p. Selector s + => ReadPrec (f p) -> ReadPrec (S1 s f p) +s1ReadPrec rp + | selectorName == "" = coerceM1 $ step rp + | otherwise = coerceM1 $ do + mapM_ expectP $ readLblLexemes selectorName + expectP (Punc "=") + reset rp + where + selectorName :: String + selectorName = selName (undefined :: S1 s f p) - readLblLexemes :: String -> [Lexeme] - readLblLexemes lbl | isSymVar lbl - = [Punc "(", Symbol lbl, Punc ")"] - | otherwise - = identHLexemes lbl + readLblLexemes :: String -> [Lexeme] + readLblLexemes lbl | isSymVar lbl + = [Punc "(", Symbol lbl, Punc ")"] + | otherwise + = identHLexemes lbl instance (GRead1Con v f, GRead1Con v g) => GRead1Con v (f :*: g) where - gliftReadPrecCon t ras = do - l <- gliftReadPrecCon t ras - case t of - Rec -> expectP (Punc ",") - Inf o -> infixPrec o - Tup -> expectP (Punc ",") - Pref -> return () - r <- gliftReadPrecCon t ras - return (l :*: r) - where - infixPrec :: String -> ReadPrec () - infixPrec o = if isInfixDataCon o - then expectP (Symbol o) - else mapM_ expectP $ - [Punc "`"] ++ identHLexemes o ++ [Punc "`"] + gliftReadPrecCon t ras = + productReadPrec t (gliftReadPrecCon t ras) (gliftReadPrecCon t ras) + +productReadPrec :: ConType -> ReadPrec (f p) -> ReadPrec (g p) -> ReadPrec ((f :*: g) p) +productReadPrec t rpf rpg = do + l <- rpf + case t of + Rec -> expectP (Punc ",") + Inf o -> infixPrec o + Tup -> expectP (Punc ",") + Pref -> return () + r <- rpg + return (l :*: r) + where + infixPrec :: String -> ReadPrec () + infixPrec o = if isInfixDataCon o + then expectP (Symbol o) + else mapM_ expectP $ + [Punc "`"] ++ identHLexemes o ++ [Punc "`"] #if defined(TRANSFORMERS_FOUR) instance GRead1Con V4 Par1 where @@ -585,10 +880,10 @@ gliftReadPrecCon _ V4Read1Args = coerceRec1 $ readS_to_Prec readsPrec1 instance (Functor f, Read1 f, GRead1Con V4 g) => GRead1Con V4 (f :.: g) where - gliftReadPrecCon _ (V4Read1Args :: Read1Args V4 a) = - coerceComp1 $ fmap (fmap getApply) $ readS_to_Prec crp1 + gliftReadPrecCon _ (V4Read1Args :: Read1Args V4 p) = + coerceComp1 $ fmap (fmap getApply1) $ readS_to_Prec crp1 where - crp1 :: Int -> ReadS (f (Apply g a)) + crp1 :: Int -> ReadS (f (Apply1 g p)) crp1 = readsPrec1 #else instance GRead1Con NonV4 Par1 where @@ -607,6 +902,94 @@ #endif ------------------------------------------------------------------------------- +-- * Show +------------------------------------------------------------------------------- + +-- | A default 'showsPrec' implementation for 'Generic1' instances that leverages +-- 'Show1'. +showsPrecDefault :: (GShow (Rep1 f a), Generic1 f) + => Int -> f a -> ShowS +showsPrecDefault = showsPrecOptions defaultOptions + +-- | Like 'showsPrecDefault', but with configurable 'Options'. +showsPrecOptions :: (GShow (Rep1 f a), Generic1 f) + => Options -> Int -> f a -> ShowS +showsPrecOptions opts p = gshowsPrec opts p . from1 + +-- | Class of generic representation types that can be converted to a 'String'. +class GShow a where + gshowsPrec :: Options -> Int -> a -> ShowS + +instance GShow (f p) => GShow (D1 d f p) where + gshowsPrec opts p (M1 x) = gshowsPrec opts p x + +instance GShow (V1 p) where + gshowsPrec _ = v1ShowsPrec + +instance (GShow (f p), GShow (g p)) => GShow ((f :+: g) p) where + gshowsPrec opts p (L1 x) = gshowsPrec opts p x + gshowsPrec opts p (R1 x) = gshowsPrec opts p x + +instance (Constructor c, GShowCon (f p), IsNullaryCon f) => GShow (C1 c f p) where + gshowsPrec opts = c1ShowsPrec $ gshowsPrecCon opts + +-- | Class of generic representation types that can be converted to a 'String', and +-- for which the 'ConType' has been determined. +class GShowCon a where + gshowsPrecCon :: Options -> ConType -> Int -> a -> ShowS + +instance GShowCon (U1 p) where + gshowsPrecCon _ _ _ U1 = id + +instance Show c => GShowCon (K1 i c p) where + gshowsPrecCon _ _ p (K1 x) = showsPrec p x + +instance (Selector s, GShowCon (f p)) => GShowCon (S1 s f p) where + gshowsPrecCon opts = s1ShowsPrec . gshowsPrecCon opts + +instance (GShowCon (f p), GShowCon (g p)) => GShowCon ((f :*: g) p) where + gshowsPrecCon opts t = + productShowsPrec (gshowsPrecCon opts t) + (gshowsPrecCon opts t) + t + +instance Show p => GShowCon (Par1 p) where + gshowsPrecCon _ _ p (Par1 x) = showsPrec p x + +#if defined(TRANSFORMERS_FOUR) +instance (Show1 f, Show p) => GShowCon (Rec1 f p) where + gshowsPrecCon _ _ p (Rec1 x) = showsPrec1 p x + +instance (Functor f, Show1 f, GShowCon (g p)) => GShowCon ((f :.: g) p) where + gshowsPrecCon _ _ p (Comp1 x) = showsPrec1 p (fmap Apply x) +#else +instance (Show1 f, Show p) => GShowCon (Rec1 f p) where + gshowsPrecCon _ _ p (Rec1 x) = liftShowsPrec showsPrec showList p x + +instance (Show1 f, GShowCon (g p)) => GShowCon ((f :.: g) p) where + gshowsPrecCon opts t p (Comp1 x) = + let glspc = gshowsPrecCon opts t + in liftShowsPrec glspc (showListWith (glspc 0)) p x +#endif + +#if MIN_VERSION_base(4,9,0) || defined(GENERIC_DERIVING) +instance GShowCon (UChar p) where + gshowsPrecCon opts _ = uCharShowsPrec opts + +instance GShowCon (UDouble p) where + gshowsPrecCon opts _ = uDoubleShowsPrec opts + +instance GShowCon (UFloat p) where + gshowsPrecCon opts _ = uFloatShowsPrec opts + +instance GShowCon (UInt p) where + gshowsPrecCon opts _ = uIntShowsPrec opts + +instance GShowCon (UWord p) where + gshowsPrecCon opts _ = uWordShowsPrec opts +#endif + +------------------------------------------------------------------------------- -- * Show1 ------------------------------------------------------------------------------- @@ -642,18 +1025,26 @@ liftShowsPrecOptions opts sp sl p = gliftShowsPrec opts (NonV4Show1Args sp sl) p . from1 #endif --- | Class of generic representation types that can be converted to a 'String'. -class GShow1 v f where +-- | Class of generic representation types for unary type constructors that can +-- be converted to a 'String'. +class +#if __GLASGOW_HASKELL__ >= 806 + (forall a. Show a => GShow (f a)) => +#endif + GShow1 v f where gliftShowsPrec :: Options -> Show1Args v a -> Int -> f a -> ShowS instance GShow1 v f => GShow1 v (D1 d f) where gliftShowsPrec opts sas p (M1 x) = gliftShowsPrec opts sas p x instance GShow1 v V1 where + gliftShowsPrec _ _ = v1ShowsPrec + +v1ShowsPrec :: Int -> V1 p -> ShowS #if __GLASGOW_HASKELL__ >= 708 - gliftShowsPrec _ _ _ x = case x of {} +v1ShowsPrec _ _ x = case x of {} #else - gliftShowsPrec _ _ _ !_ = undefined +v1ShowsPrec _ _ !_ = undefined #endif instance (GShow1 v f, GShow1 v g) => GShow1 v (f :+: g) where @@ -661,31 +1052,35 @@ gliftShowsPrec opts sas p (R1 x) = gliftShowsPrec opts sas p x instance (Constructor c, GShow1Con v f, IsNullaryCon f) => GShow1 v (C1 c f) where - gliftShowsPrec opts sas p c@(M1 x) = case fixity of - Prefix -> showParen ( p > appPrec - && not (isNullaryCon x || conIsTuple c) - ) $ - (if conIsTuple c - then id - else let cn = conName c - in showParen (isInfixDataCon cn) (showString cn)) - . (if isNullaryCon x || conIsTuple c - then id - else showChar ' ') - . showBraces t (gliftShowsPrecCon opts t sas appPrec1 x) - Infix _ m -> showParen (p > m) $ gliftShowsPrecCon opts t sas (m+1) x - where - fixity :: Fixity - fixity = conFixity c + gliftShowsPrec opts sas = c1ShowsPrec $ \t -> gliftShowsPrecCon opts t sas - t :: ConType - t = if conIsRecord c - then Rec - else case conIsTuple c of - True -> Tup - False -> case fixity of - Prefix -> Pref - Infix _ _ -> Inf $ conName c +c1ShowsPrec :: (Constructor c, IsNullaryCon f) + => (ConType -> Int -> f p -> ShowS) -> Int -> C1 c f p -> ShowS +c1ShowsPrec sp p c@(M1 x) = case fixity of + Prefix -> showParen ( p > appPrec + && not (isNullaryCon x || conIsTuple c) + ) $ + (if conIsTuple c + then id + else let cn = conName c + in showParen (isInfixDataCon cn) (showString cn)) + . (if isNullaryCon x || conIsTuple c + then id + else showChar ' ') + . showBraces t (sp t appPrec1 x) + Infix _ m -> showParen (p > m) $ sp t (m+1) x + where + fixity :: Fixity + fixity = conFixity c + + t :: ConType + t = if conIsRecord c + then Rec + else case conIsTuple c of + True -> Tup + False -> case fixity of + Prefix -> Pref + Infix _ _ -> Inf $ conName c showBraces :: ConType -> ShowS -> ShowS showBraces Rec b = showChar '{' . b . showChar '}' @@ -693,9 +1088,13 @@ showBraces Pref b = b showBraces (Inf _) b = b --- | Class of generic representation types that can be converted to a 'String', and --- for which the 'ConType' has been determined. -class GShow1Con v f where +-- | Class of generic representation types for unary type constructors that can +-- be converted to a 'String', and for which the 'ConType' has been determined. +class +#if __GLASGOW_HASKELL__ >= 806 + (forall a. Show a => GShowCon (f a)) => +#endif + GShow1Con v f where gliftShowsPrecCon :: Options -> ConType -> Show1Args v a -> Int -> f a -> ShowS @@ -706,46 +1105,56 @@ gliftShowsPrecCon _ _ _ p (K1 x) = showsPrec p x instance (Selector s, GShow1Con v f) => GShow1Con v (S1 s f) where - gliftShowsPrecCon opts t sas p sel@(M1 x) - | selName sel == "" = gliftShowsPrecCon opts t sas p x - | otherwise = infixRec - . showString " = " - . gliftShowsPrecCon opts t sas 0 x - where - infixRec :: ShowS - infixRec | isSymVar selectorName - = showChar '(' . showString selectorName . showChar ')' - | otherwise - = showString selectorName + gliftShowsPrecCon opts t sas = s1ShowsPrec $ gliftShowsPrecCon opts t sas + +s1ShowsPrec :: Selector s => (Int -> f p -> ShowS) -> Int -> S1 s f p -> ShowS +s1ShowsPrec sp p sel@(M1 x) + | selName sel == "" = sp p x + | otherwise = infixRec + . showString " = " + . sp 0 x + where + infixRec :: ShowS + infixRec | isSymVar selectorName + = showChar '(' . showString selectorName . showChar ')' + | otherwise + = showString selectorName - selectorName :: String - selectorName = selName sel + selectorName :: String + selectorName = selName sel instance (GShow1Con v f, GShow1Con v g) => GShow1Con v (f :*: g) where - gliftShowsPrecCon opts t sas p (a :*: b) = - case t of - Rec -> gliftShowsPrecCon opts t sas 0 a - . showString ", " - . gliftShowsPrecCon opts t sas 0 b - - Inf o -> gliftShowsPrecCon opts t sas p a - . showSpace - . infixOp o - . showSpace - . gliftShowsPrecCon opts t sas p b - - Tup -> gliftShowsPrecCon opts t sas 0 a - . showChar ',' - . gliftShowsPrecCon opts t sas 0 b - - Pref -> gliftShowsPrecCon opts t sas p a - . showSpace - . gliftShowsPrecCon opts t sas p b - where - infixOp :: String -> ShowS - infixOp o = if isInfixDataCon o - then showString o - else showChar '`' . showString o . showChar '`' + gliftShowsPrecCon opts t sas = + productShowsPrec (gliftShowsPrecCon opts t sas) + (gliftShowsPrecCon opts t sas) + t + +productShowsPrec :: (Int -> f p -> ShowS) -> (Int -> g p -> ShowS) + -> ConType -> Int -> (f :*: g) p -> ShowS +productShowsPrec spf spg t p (a :*: b) = + case t of + Rec -> spf 0 a + . showString ", " + . spg 0 b + + Inf o -> spf p a + . showSpace + . infixOp o + . showSpace + . spg p b + + Tup -> spf 0 a + . showChar ',' + . spg 0 b + + Pref -> spf p a + . showSpace + . spg p b + where + infixOp :: String -> ShowS + infixOp o = if isInfixDataCon o + then showString o + else showChar '`' . showString o . showChar '`' #if defined(TRANSFORMERS_FOUR) instance GShow1Con V4 Par1 where @@ -755,7 +1164,7 @@ gliftShowsPrecCon _ _ V4Show1Args p (Rec1 x) = showsPrec1 p x instance (Functor f, Show1 f, GShow1Con V4 g) => GShow1Con V4 (f :.: g) where - gliftShowsPrecCon _ _ V4Show1Args p (Comp1 x) = showsPrec1 p (fmap Apply x) + gliftShowsPrecCon _ _ V4Show1Args p (Comp1 x) = showsPrec1 p (fmap Apply1 x) #else instance GShow1Con NonV4 Par1 where gliftShowsPrecCon _ _ (NonV4Show1Args sp _) p (Par1 x) = sp p x @@ -771,24 +1180,39 @@ #if MIN_VERSION_base(4,9,0) || defined(GENERIC_DERIVING) instance GShow1Con v UChar where - gliftShowsPrecCon opts _ _ p (UChar c) = - showsPrec (hashPrec opts p) (C# c) . oneHash opts + gliftShowsPrecCon opts _ _ = uCharShowsPrec opts instance GShow1Con v UDouble where - gliftShowsPrecCon opts _ _ p (UDouble d) = - showsPrec (hashPrec opts p) (D# d) . twoHash opts + gliftShowsPrecCon opts _ _ = uDoubleShowsPrec opts instance GShow1Con v UFloat where - gliftShowsPrecCon opts _ _ p (UFloat f) = - showsPrec (hashPrec opts p) (F# f) . oneHash opts + gliftShowsPrecCon opts _ _ = uFloatShowsPrec opts instance GShow1Con v UInt where - gliftShowsPrecCon opts _ _ p (UInt i) = - showsPrec (hashPrec opts p) (I# i) . oneHash opts + gliftShowsPrecCon opts _ _ = uIntShowsPrec opts instance GShow1Con v UWord where - gliftShowsPrecCon opts _ _ p (UWord w) = - showsPrec (hashPrec opts p) (W# w) . twoHash opts + gliftShowsPrecCon opts _ _ = uWordShowsPrec opts + +uCharShowsPrec :: Options -> Int -> UChar p -> ShowS +uCharShowsPrec opts p (UChar c) = + showsPrec (hashPrec opts p) (C# c) . oneHash opts + +uDoubleShowsPrec :: Options -> Int -> UDouble p -> ShowS +uDoubleShowsPrec opts p (UDouble d) = + showsPrec (hashPrec opts p) (D# d) . twoHash opts + +uFloatShowsPrec :: Options -> Int -> UFloat p -> ShowS +uFloatShowsPrec opts p (UFloat f) = + showsPrec (hashPrec opts p) (F# f) . oneHash opts + +uIntShowsPrec :: Options -> Int -> UInt p -> ShowS +uIntShowsPrec opts p (UInt i) = + showsPrec (hashPrec opts p) (I# i) . oneHash opts + +uWordShowsPrec :: Options -> Int -> UWord p -> ShowS +uWordShowsPrec opts p (UWord w) = + showsPrec (hashPrec opts p) (W# w) . twoHash opts oneHash, twoHash :: Options -> ShowS hashPrec :: Options -> Int -> Int @@ -826,6 +1250,15 @@ liftShowsPrec sp sl p (FunctorClassesDefault x) = liftShowsPrecDefault sp sl p x #endif +instance (GEq (Rep1 f a), Generic1 f) => Eq (FunctorClassesDefault f a) where + FunctorClassesDefault x == FunctorClassesDefault y = eqDefault x y +instance (GOrd (Rep1 f a), Generic1 f) => Ord (FunctorClassesDefault f a) where + compare (FunctorClassesDefault x) (FunctorClassesDefault y) = compareDefault x y +instance (GRead (Rep1 f a), Generic1 f) => Read (FunctorClassesDefault f a) where + readsPrec p = coerceFCD (readsPrecDefault p) +instance (GShow (Rep1 f a), Generic1 f) => Show (FunctorClassesDefault f a) where + showsPrec p (FunctorClassesDefault x) = showsPrecDefault p x + coerceFCD :: ReadS (f a) -> ReadS (FunctorClassesDefault f a) coerceFCD = coerce @@ -834,24 +1267,33 @@ ------------------------------------------------------------------------------- #if defined(TRANSFORMERS_FOUR) -newtype Apply g a = Apply { getApply :: g a } +newtype Apply g a = Apply { getApply :: g a } +newtype Apply1 g a = Apply1 { getApply1 :: g a } -instance (GEq1 V4 g, Eq a) => Eq (Apply g a) where - Apply x == Apply y = gliftEq V4Eq1Args x y - -instance (GOrd1 V4 g, Ord a) => Ord (Apply g a) where - compare (Apply x) (Apply y) = gliftCompare V4Ord1Args x y +instance GEq (g a) => Eq (Apply g a) where + Apply x == Apply y = geq x y +instance (GEq1 V4 g, Eq a) => Eq (Apply1 g a) where + Apply1 x == Apply1 y = gliftEq V4Eq1Args x y + +instance GOrd (g a) => Ord (Apply g a) where + compare (Apply x) (Apply y) = gcompare x y +instance (GOrd1 V4 g, Ord a) => Ord (Apply1 g a) where + compare (Apply1 x) (Apply1 y) = gliftCompare V4Ord1Args x y -- Passing defaultOptions and Pref below is OK, since it's guaranteed that the -- Options and ConType won't actually have any effect on how (g a) is shown. -- If we augment Options or ConType with more features in the future, this -- decision will need to be revisited. -instance (GRead1Con V4 g, Read a) => Read (Apply g a) where - readPrec = fmap Apply $ gliftReadPrecCon Pref V4Read1Args - -instance (GShow1Con V4 g, Show a) => Show (Apply g a) where - showsPrec d = gliftShowsPrecCon defaultOptions Pref V4Show1Args d . getApply +instance GReadCon (g a) => Read (Apply g a) where + readPrec = fmap Apply $ greadPrecCon Pref +instance (GRead1Con V4 g, Read a) => Read (Apply1 g a) where + readPrec = fmap Apply1 $ gliftReadPrecCon Pref V4Read1Args + +instance GShowCon (g a) => Show (Apply g a) where + showsPrec d = gshowsPrecCon defaultOptions Pref d . getApply +instance (GShow1Con V4 g, Show a) => Show (Apply1 g a) where + showsPrec d = gliftShowsPrecCon defaultOptions Pref V4Show1Args d . getApply1 #endif -- | Whether a constructor is a record ('Rec'), a tuple ('Tup'), is prefix ('Pref'), diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/transformers-compat-0.7.1/transformers-compat.cabal new/transformers-compat-0.7.2/transformers-compat.cabal --- old/transformers-compat-0.7.1/transformers-compat.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/transformers-compat-0.7.2/transformers-compat.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ name: transformers-compat category: Compatibility -version: 0.7.1 +version: 0.7.2 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE @@ -74,7 +74,7 @@ description: Use transformers 0.5 up until (but not including) 0.5.3. This will be selected by cabal picking the appropriate version. flag five-three - default: False + default: True manual: False description: Use transformers 0.5.3. This will be selected by cabal picking the appropriate version.

1 0

commit ghc-topograph for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-topograph for openSUSE:Factory checked in at 2022-08-01 21:30:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-topograph (Old) and /work/SRC/openSUSE:Factory/.ghc-topograph.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-topograph" Mon Aug 1 21:30:42 2022 rev:6 rq:987102 version:1.0.0.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-topograph/ghc-topograph.changes 2022-02-11 23:09:58.995045535 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-topograph.new.1533/ghc-topograph.changes 2022-08-01 21:31:11.869793980 +0200 @@ -1,0 +2,6 @@ +Mon Jun 20 17:45:45 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update topograph to version 1.0.0.1 revision 4. + Upstream has revised the Cabal build instructions on Hackage. + +------------------------------------------------------------------- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-topograph.spec ++++++ --- /var/tmp/diff_new_pack.XHVc6l/_old 2022-08-01 21:31:12.501795793 +0200 +++ /var/tmp/diff_new_pack.XHVc6l/_new 2022-08-01 21:31:12.509795816 +0200 @@ -24,7 +24,7 @@ License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/3.cabal… +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/4.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-base-compat-devel BuildRequires: ghc-base-orphans-devel ++++++ topograph.cabal ++++++ --- /var/tmp/diff_new_pack.XHVc6l/_old 2022-08-01 21:31:12.561795965 +0200 +++ /var/tmp/diff_new_pack.XHVc6l/_new 2022-08-01 21:31:12.565795976 +0200 @@ -1,7 +1,7 @@ cabal-version: 2.2 name: topograph version: 1.0.0.1 -x-revision: 3 +x-revision: 4 synopsis: Directed acyclic graphs. category: Data, Graph description: @@ -52,7 +52,7 @@ , base-compat ^>=0.10.5 || ^>=0.11.0 || ^>=0.12.0 , base-orphans ^>=0.8 , containers ^>=0.5.0.0 || ^>=0.6.0.1 - , vector ^>=0.12 + , vector ^>=0.12 || ^>=0.13 other-extensions: RankNTypes

1 0

commit ghc-tls for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-tls for openSUSE:Factory checked in at 2022-08-01 21:30:41 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tls (Old) and /work/SRC/openSUSE:Factory/.ghc-tls.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-tls" Mon Aug 1 21:30:41 2022 rev:28 rq:987101 version:1.6.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tls/ghc-tls.changes 2022-02-11 23:11:48.587362508 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-tls.new.1533/ghc-tls.changes 2022-08-01 21:31:10.409789791 +0200 @@ -1,0 +2,14 @@ +Mon Jun 6 02:45:15 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update tls to version 1.6.0. + ## Version 1.6.0 + + - Major version up because of disabling SSL3 + - Some fixes against tlsfuzzer + + ## Version 1.5.8 + + - Require mtl-2.2.1 or newer + [#448](https://github.com/haskell-tls/hs-tls/pull/448) + +------------------------------------------------------------------- Old: ---- tls-1.5.7.tar.gz New: ---- tls-1.6.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tls.spec ++++++ --- /var/tmp/diff_new_pack.onjRwR/_old 2022-08-01 21:31:11.013791524 +0200 +++ /var/tmp/diff_new_pack.onjRwR/_new 2022-08-01 21:31:11.017791536 +0200 @@ -19,7 +19,7 @@ %global pkg_name tls %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.5.7 +Version: 1.6.0 Release: 0 Summary: TLS/SSL protocol native implementation (Server and Client) License: BSD-3-Clause @@ -56,8 +56,8 @@ eliminating a common set of security issues through the use of the advanced type system, high level constructions and common Haskell features. -Currently implement the SSL3.0, TLS1.0, TLS1.1, TLS1.2 and TLS 1.3 protocol, -and support RSA and Ephemeral (Elliptic curve and regular) Diffie Hellman key +Currently implement the TLS1.0, TLS1.1, TLS1.2 and TLS 1.3 protocol, and +support RSA and Ephemeral (Elliptic curve and regular) Diffie Hellman key exchanges, and many extensions. Some debug tools linked with tls, are available through the ++++++ tls-1.5.7.tar.gz -> tls-1.6.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/CHANGELOG.md new/tls-1.6.0/CHANGELOG.md --- old/tls-1.5.7/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,13 @@ +## Version 1.6.0 + +- Major version up because of disabling SSL3 +- Some fixes against tlsfuzzer + +## Version 1.5.8 + +- Require mtl-2.2.1 or newer + [#448](https://github.com/haskell-tls/hs-tls/pull/448) + ## Version 1.5.7 - New APIs: getFinished and getPeerFinished diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Core.hs new/tls-1.6.0/Network/TLS/Core.hs --- old/tls-1.5.7/Network/TLS/Core.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Core.hs 2001-09-09 03:46:40.000000000 +0200 @@ -56,6 +56,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as L +import Control.Monad (unless, when) import qualified Control.Exception as E import Control.Monad.State.Strict @@ -175,7 +176,13 @@ terminate (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason Established -> return x NotEstablished -> throwCore $ Error_Protocol ("data at not-established", True, UnexpectedMessage) - process ChangeCipherSpec13 = recvData13 ctx + process ChangeCipherSpec13 = do + established <- ctxEstablished ctx + if established /= Established then + recvData13 ctx + else do + let reason = "CSS after Finished" + terminate (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason process p = let reason = "unexpected message " ++ show p in terminate (Error_Misc reason) AlertLevel_Fatal UnexpectedMessage reason @@ -271,10 +278,8 @@ -> TLSError -> m B.ByteString onError _ Error_EOF = -- Not really an error. return B.empty -onError terminate err@(Error_Protocol (reason,fatal,desc)) = - terminate err (if fatal then AlertLevel_Fatal else AlertLevel_Warning) desc reason -onError terminate err = - terminate err AlertLevel_Fatal InternalError (show err) +onError terminate err = let (lvl,ad) = errorToAlert err + in terminate err lvl ad (errorToAlertMessage err) terminateWithWriteLock :: Context -> ([(AlertLevel, AlertDescription)] -> IO ()) -> TLSError -> AlertLevel -> AlertDescription -> String -> IO a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Credentials.hs new/tls-1.6.0/Network/TLS/Credentials.hs --- old/tls-1.5.7/Network/TLS/Credentials.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Credentials.hs 2001-09-09 03:46:40.000000000 +0200 @@ -32,7 +32,7 @@ type Credential = (CertificateChain, PrivKey) -newtype Credentials = Credentials [Credential] +newtype Credentials = Credentials [Credential] deriving (Show) instance Semigroup Credentials where Credentials l1 <> Credentials l2 = Credentials (l1 ++ l2) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/ErrT.hs new/tls-1.6.0/Network/TLS/ErrT.hs --- old/tls-1.5.7/Network/TLS/ErrT.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/ErrT.hs 2001-09-09 03:46:40.000000000 +0200 @@ -10,20 +10,12 @@ module Network.TLS.ErrT ( runErrT , ErrT - , Error(..) , MonadError(..) ) where -#if MIN_VERSION_mtl(2,2,1) -import Control.Monad.Except -import Control.Monad.Error.Class (Error(..)) +import Control.Monad.Except (MonadError(..)) +import Control.Monad.Trans.Except (ExceptT, runExceptT) + runErrT :: ExceptT e m a -> m (Either e a) runErrT = runExceptT type ErrT = ExceptT -#else -import Control.Monad.Error -runErrT :: ErrorT e m a -> m (Either e a) -runErrT = runErrorT -type ErrT = ErrorT -#endif - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Extension.hs new/tls-1.6.0/Network/TLS/Extension.hs --- old/tls-1.5.7/Network/TLS/Extension.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Extension.hs 2001-09-09 03:46:40.000000000 +0200 @@ -483,7 +483,10 @@ decodeSignatureAlgorithms :: ByteString -> Maybe SignatureAlgorithms decodeSignatureAlgorithms = runGetMaybe $ do len <- getWord16 - SignatureAlgorithms <$> getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh)) + sas <- getList (fromIntegral len) (getSignatureHashAlgorithm >>= \sh -> return (2, sh)) + leftoverLen <- remaining + when (leftoverLen /= 0) $ fail "decodeSignatureAlgorithms: broken length" + return $ SignatureAlgorithms sas ------------------------------------------------------------ @@ -544,7 +547,7 @@ data KeyShareEntry = KeyShareEntry { keyShareEntryGroup :: Group - , keySHareEntryKeyExchange:: ByteString + , keyShareEntryKeyExchange :: ByteString } deriving (Show,Eq) getKeyShareEntry :: Get (Int, Maybe KeyShareEntry) @@ -584,6 +587,7 @@ Just ent -> return $ KeyShareServerHello ent extensionDecode MsgTClientHello = runGetMaybe $ do len <- fromIntegral <$> getWord16 +-- len == 0 allows for HRR grps <- getList len getKeyShareEntry return $ KeyShareClientHello $ catMaybes grps extensionDecode MsgTHelloRetryRequest = runGetMaybe $ do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Handshake/Certificate.hs new/tls-1.6.0/Network/TLS/Handshake/Certificate.hs --- old/tls-1.5.7/Network/TLS/Handshake/Certificate.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Handshake/Certificate.hs 2001-09-09 03:46:40.000000000 +0200 @@ -16,6 +16,7 @@ import Network.TLS.Context.Internal import Network.TLS.Struct import Network.TLS.X509 +import Control.Monad (unless) import Control.Monad.State.Strict import Control.Exception (SomeException) import Data.X509 (ExtKeyUsage(..), ExtKeyUsageFlag, extensionGet) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Handshake/Client.hs new/tls-1.6.0/Network/TLS/Handshake/Client.hs --- old/tls-1.5.7/Network/TLS/Handshake/Client.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Handshake/Client.hs 2001-09-09 03:46:40.000000000 +0200 @@ -648,7 +648,8 @@ -- onServerHello :: Context -> ClientParams -> Session -> [ExtensionID] -> Handshake -> IO (RecvState IO) onServerHello ctx cparams clientSession sentExts (ServerHello rver serverRan serverSession cipher compression exts) = do - when (rver == SSL2) $ throwCore $ Error_Protocol ("ssl2 is not supported", True, ProtocolVersion) + when (rver == SSL2) $ throwCore $ Error_Protocol ("SSL2 is not supported", True, ProtocolVersion) + when (rver == SSL3) $ throwCore $ Error_Protocol ("SSL3 is not supported", True, ProtocolVersion) -- find the compression and cipher methods that the server want to use. cipherAlg <- case find ((==) cipher . cipherID) (supportedCiphers $ ctxSupported ctx) of Nothing -> throwCore $ Error_Protocol ("server choose unknown cipher", True, IllegalParameter) @@ -913,9 +914,11 @@ mks <- usingState_ ctx getTLS13KeyShare case mks of Just (KeyShareServerHello ks) -> return ks - Just _ -> error "calcSharedKey: invalid KeyShare value" + Just _ -> throwCore $ Error_Protocol ("invalid key_share value", True, IllegalParameter) Nothing -> throwCore $ Error_Protocol ("key exchange not implemented, expected key_share extension", True, HandshakeFailure) let grp = keyShareEntryGroup serverKeyShare + unless (checkKeyShareKeyLength serverKeyShare) $ + throwCore $ Error_Protocol ("broken key_share", True, IllegalParameter) unless (groupSent == Just grp) $ throwCore $ Error_Protocol ("received incompatible group for (EC)DHE", True, IllegalParameter) usingHState ctx $ setNegotiatedGroup grp diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Handshake/Common.hs new/tls-1.6.0/Network/TLS/Handshake/Common.hs --- old/tls-1.5.7/Network/TLS/Handshake/Common.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Handshake/Common.hs 2001-09-09 03:46:40.000000000 +0200 @@ -63,19 +63,23 @@ handle ignoreIOErr $ do tls13 <- tls13orLater ctx if tls13 then - sendPacket13 ctx $ Alert13 $ errorToAlert tlserror + sendPacket13 ctx $ Alert13 [errorToAlert tlserror] else - sendPacket ctx $ Alert $ errorToAlert tlserror + sendPacket ctx $ Alert [errorToAlert tlserror] handshakeFailed tlserror where ignoreIOErr :: IOException -> IO () ignoreIOErr _ = return () -errorToAlert :: TLSError -> [(AlertLevel, AlertDescription)] -errorToAlert (Error_Protocol (_, _, ad)) = [(AlertLevel_Fatal, ad)] -errorToAlert (Error_Packet_unexpected _ _) = [(AlertLevel_Fatal, UnexpectedMessage)] -errorToAlert (Error_Packet_Parsing _) = [(AlertLevel_Fatal, DecodeError)] -errorToAlert _ = [(AlertLevel_Fatal, InternalError)] +errorToAlert :: TLSError -> (AlertLevel, AlertDescription) +errorToAlert (Error_Protocol (_, b, ad)) = let lvl = if b then AlertLevel_Fatal else AlertLevel_Warning + in (lvl, ad) +errorToAlert (Error_Packet_unexpected _ _) = (AlertLevel_Fatal, UnexpectedMessage) +errorToAlert (Error_Packet_Parsing msg) + | "invalid version" `isInfixOf` msg = (AlertLevel_Fatal, ProtocolVersion) + | "request_update" `isInfixOf` msg = (AlertLevel_Fatal, IllegalParameter) + | otherwise = (AlertLevel_Fatal, DecodeError) +errorToAlert _ = (AlertLevel_Fatal, InternalError) -- | Return the message that a TLS endpoint can add to its local log for the -- specified library error. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Handshake/Common13.hs new/tls-1.6.0/Network/TLS/Handshake/Common13.hs --- old/tls-1.5.7/Network/TLS/Handshake/Common13.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Handshake/Common13.hs 2001-09-09 03:46:40.000000000 +0200 @@ -42,6 +42,7 @@ , calculateApplicationSecret , calculateResumptionSecret , derivePSK + , checkKeyShareKeyLength ) where import qualified Data.ByteArray as BA @@ -87,6 +88,7 @@ checkFinished :: MonadIO m => Context -> Hash -> ByteString -> ByteString -> ByteString -> m () checkFinished ctx usedHash baseKey hashValue verifyData = do let verifyData' = makeVerifyData usedHash baseKey hashValue + when (B.length verifyData /= B.length verifyData') $ throwCore $ Error_Protocol ("broken Finished", True, DecodeError) unless (verifyData' == verifyData) $ decryptError "cannot verify finished" liftIO $ writeIORef (ctxPeerFinished ctx) (Just verifyData) @@ -505,3 +507,23 @@ where usedHash = cHash choice hashSize = hashDigestSize usedHash + +---------------------------------------------------------------- + +checkKeyShareKeyLength :: KeyShareEntry -> Bool +checkKeyShareKeyLength ks = keyShareKeyLength grp == B.length key + where + grp = keyShareEntryGroup ks + key = keyShareEntryKeyExchange ks + +keyShareKeyLength :: Group -> Int +keyShareKeyLength P256 = 65 -- 32 * 2 + 1 +keyShareKeyLength P384 = 97 -- 48 * 2 + 1 +keyShareKeyLength P521 = 133 -- 66 * 2 + 1 +keyShareKeyLength X25519 = 32 +keyShareKeyLength X448 = 56 +keyShareKeyLength FFDHE2048 = 256 +keyShareKeyLength FFDHE3072 = 384 +keyShareKeyLength FFDHE4096 = 512 +keyShareKeyLength FFDHE6144 = 768 +keyShareKeyLength FFDHE8192 = 1024 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Handshake/Server.hs new/tls-1.6.0/Network/TLS/Handshake/Server.hs --- old/tls-1.5.7/Network/TLS/Handshake/Server.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Handshake/Server.hs 2001-09-09 03:46:40.000000000 +0200 @@ -107,7 +107,7 @@ -- rejecting SSL2. RFC 6176 when (legacyVersion == SSL2) $ throwCore $ Error_Protocol ("SSL 2.0 is not supported", True, ProtocolVersion) -- rejecting SSL3. RFC 7568 - -- when (legacyVersion == SSL3) $ throwCore $ Error_Protocol ("SSL 3.0 is not supported", True, ProtocolVersion) + when (legacyVersion == SSL3) $ throwCore $ Error_Protocol ("SSL 3.0 is not supported", True, ProtocolVersion) -- Fallback SCSV: RFC7507 -- TLS_FALLBACK_SCSV: {0x56, 0x00} @@ -117,7 +117,7 @@ throwCore $ Error_Protocol ("fallback is not allowed", True, InappropriateFallback) -- choosing TLS version let clientVersions = case extensionLookup extensionID_SupportedVersions exts >>= extensionDecode MsgTClientHello of - Just (SupportedVersionsClientHello vers) -> vers + Just (SupportedVersionsClientHello vers) -> vers -- fixme: vers == [] _ -> [] clientVersion = min TLS12 legacyVersion serverVersions @@ -686,21 +686,33 @@ -- status again if 0-RTT successful setEstablished ctx (EarlyDataNotAllowed 3) -- hardcoding -- Deciding key exchange from key shares - keyShares <- case extensionLookup extensionID_KeyShare exts >>= extensionDecode MsgTClientHello of - Just (KeyShareClientHello kses) -> return kses - Just _ -> error "handshakeServerWithTLS13: invalid KeyShare value" - _ -> throwCore $ Error_Protocol ("key exchange not implemented, expected key_share extension", True, HandshakeFailure) - case findKeyShare keyShares serverGroups of + keyShares <- case extensionLookup extensionID_KeyShare exts of + Nothing -> throwCore $ Error_Protocol ("key exchange not implemented, expected key_share extension", True, MissingExtension) + Just kss -> case extensionDecode MsgTClientHello kss of + Just (KeyShareClientHello kses) -> return kses + Just _ -> error "handshakeServerWithTLS13: invalid KeyShare value" + _ -> throwCore $ Error_Protocol ("broken key_share", True, DecodeError) + mshare <- findKeyShare keyShares serverGroups + case mshare of Nothing -> helloRetryRequest sparams ctx chosenVersion usedCipher exts serverGroups clientSession Just keyShare -> doHandshake13 sparams ctx chosenVersion usedCipher exts usedHash keyShare clientSession rtt0 where ciphersFilteredVersion = filter ((`elem` clientCiphers) . cipherID) serverCiphers serverCiphers = filter (cipherAllowedForVersion chosenVersion) (supportedCiphers $ serverSupported sparams) serverGroups = supportedGroups (ctxSupported ctx) - findKeyShare _ [] = Nothing - findKeyShare ks (g:gs) = case find (\ent -> keyShareEntryGroup ent == g) ks of - Just k -> Just k - Nothing -> findKeyShare ks gs + +findKeyShare :: [KeyShareEntry] -> [Group] -> IO (Maybe KeyShareEntry) +findKeyShare ks ggs = go ggs + where + go [] = return Nothing + go (g:gs) = case filter (grpEq g) ks of + [] -> go gs + [k] -> do + unless (checkKeyShareKeyLength k) $ + throwCore $ Error_Protocol ("broken key_share", True, IllegalParameter) + return $ Just k + _ -> throwCore $ Error_Protocol ("duplicated key_share", True, IllegalParameter) + grpEq g ent = g == keyShareEntryGroup ent doHandshake13 :: ServerParams -> Context -> Version -> Cipher -> [ExtensionRaw] @@ -876,9 +888,11 @@ return [ExtensionRaw extensionID_PreSharedKey selectedIdentity] decideCredentialInfo allCreds = do - cHashSigs <- case extensionLookup extensionID_SignatureAlgorithms exts >>= extensionDecode MsgTClientHello of + cHashSigs <- case extensionLookup extensionID_SignatureAlgorithms exts of Nothing -> throwCore $ Error_Protocol ("no signature_algorithms extension", True, MissingExtension) - Just (SignatureAlgorithms sas) -> return sas + Just sa -> case extensionDecode MsgTClientHello sa of + Nothing -> throwCore $ Error_Protocol ("broken signature_algorithms extension", True, DecodeError) + Just (SignatureAlgorithms sas) -> return sas -- When deciding signature algorithm and certificate, we try to keep -- certificates supported by the client, but fallback to all credentials -- if this produces no suitable result (see RFC 5246 section 7.4.2 and @@ -1070,7 +1084,7 @@ v:_ -> Just v where svs = sortOn Down serverVersions - cvs = sortOn Down clientVersions + cvs = sortOn Down $ filter (> SSL3) clientVersions applicationProtocol :: Context -> [ExtensionRaw] -> ServerParams -> IO [ExtensionRaw] applicationProtocol ctx exts sparams = do @@ -1095,7 +1109,7 @@ where loop [] = Nothing loop (hs:hss) = case credentialsFindForSigning13' hs creds of - Nothing -> credentialsFindForSigning13 hss creds + Nothing -> loop hss Just cred -> Just (cred, hs) -- See credentialsFindForSigning. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Handshake/State.hs new/tls-1.6.0/Network/TLS/Handshake/State.hs --- old/tls-1.5.7/Network/TLS/Handshake/State.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Handshake/State.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,7 +2,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} -- | -- Module : Network.TLS.Handshake.State -- License : BSD-style @@ -190,9 +189,7 @@ instance MonadState HandshakeState HandshakeM where put x = HandshakeM (put x) get = HandshakeM get -#if MIN_VERSION_mtl(2,1,0) state f = HandshakeM (state f) -#endif -- create a new empty handshake state newEmptyHandshake :: Version -> ClientRandom -> HandshakeState diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Packet.hs new/tls-1.6.0/Network/TLS/Packet.hs --- old/tls-1.5.7/Network/TLS/Packet.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Packet.hs 2001-09-09 03:46:40.000000000 +0200 @@ -229,7 +229,10 @@ r <- remaining exts <- if hasHelloExtensions ver && r > 0 then fromIntegral <$> getWord16 >>= getExtensions - else return [] + else do + rest <- remaining + _ <- getBytes rest + return [] return $ ClientHello ver random session ciphers compressions exts Nothing decodeServerHello :: Get Handshake diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/QUIC.hs new/tls-1.6.0/Network/TLS/QUIC.hs --- old/tls-1.5.7/Network/TLS/QUIC.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/QUIC.hs 2001-09-09 03:46:40.000000000 +0200 @@ -237,7 +237,7 @@ -- | Return the alert that a TLS endpoint would send to the peer for the -- specified library error. errorToAlertDescription :: TLSError -> AlertDescription -errorToAlertDescription = snd . head . errorToAlert +errorToAlertDescription = snd . errorToAlert -- | Encode an alert to the assigned value. fromAlertDescription :: AlertDescription -> Word8 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Record/Disengage.hs new/tls-1.6.0/Network/TLS/Record/Disengage.hs --- old/tls-1.5.7/Network/TLS/Record/Disengage.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Record/Disengage.hs 2001-09-09 03:46:40.000000000 +0200 @@ -57,13 +57,15 @@ decryptData mver record e st where noDecryption = onRecordFragment record $ fragmentUncipher return - decryptData13 mver e st - | ct == ProtocolType_AppData = do - inner <- decryptData mver record e st - case unInnerPlaintext inner of - Left message -> throwError $ Error_Protocol (message, True, UnexpectedMessage) - Right (ct', d) -> return $ Record ct' ver (fragmentCompressed d) - | otherwise = noDecryption + decryptData13 mver e st = case ct of + ProtocolType_AppData -> do + inner <- decryptData mver record e st + case unInnerPlaintext inner of + Left message -> throwError $ Error_Protocol (message, True, UnexpectedMessage) + Right (ct', d) -> return $ Record ct' ver (fragmentCompressed d) + ProtocolType_ChangeCipherSpec -> noDecryption + ProtocolType_Alert -> noDecryption + _ -> throwError $ Error_Protocol ("illegal plain text", True, UnexpectedMessage) unInnerPlaintext :: ByteString -> Either String (ProtocolType, ByteString) unInnerPlaintext inner = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Record/State.hs new/tls-1.6.0/Network/TLS/Record/State.hs --- old/tls-1.5.7/Network/TLS/Record/State.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Record/State.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,4 @@ {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE CPP #-} -- | -- Module : Network.TLS.Record.State -- License : BSD-style @@ -112,9 +111,7 @@ instance MonadState RecordState RecordM where put x = RecordM $ \_ _ -> Right ((), x) get = RecordM $ \_ st -> Right (st, st) -#if MIN_VERSION_mtl(2,1,0) state f = RecordM $ \_ st -> Right (f st) -#endif instance MonadError TLSError RecordM where throwError e = RecordM $ \_ _ -> Left e diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/State.hs new/tls-1.6.0/Network/TLS/State.hs --- old/tls-1.5.7/Network/TLS/State.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/State.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -108,9 +107,7 @@ instance MonadState TLSState TLSSt where put x = TLSSt (lift $ put x) get = TLSSt (lift get) -#if MIN_VERSION_mtl(2,1,0) state f = TLSSt (lift $ state f) -#endif runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState) runTLSState f st = runState (runErrT (runTLSSt f)) st diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Network/TLS/Struct.hs new/tls-1.6.0/Network/TLS/Struct.hs --- old/tls-1.5.7/Network/TLS/Struct.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Network/TLS/Struct.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,7 +9,6 @@ -- -- the Struct module contains all definitions and values of the TLS protocol -- -{-# LANGUAGE CPP #-} module Network.TLS.Struct ( Version(..) , ConnectionEnd(..) @@ -67,10 +66,6 @@ import Network.TLS.Crypto import Network.TLS.Util.Serialization import Network.TLS.Imports -#if MIN_VERSION_mtl(2,2,1) -#else -import Control.Monad.Error -#endif data ConnectionEnd = ConnectionServer | ConnectionClient data CipherType = CipherStream | CipherBlock | CipherAEAD @@ -173,13 +168,6 @@ | Error_Packet_Parsing String deriving (Eq, Show, Typeable) -#if MIN_VERSION_mtl(2,2,1) -#else -instance Error TLSError where - noMsg = Error_Misc "" - strMsg = Error_Misc -#endif - instance Exception TLSError -- | TLS Exceptions related to bad user usage or diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/Tests/Connection.hs new/tls-1.6.0/Tests/Connection.hs --- old/tls-1.5.7/Tests/Connection.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/Tests/Connection.hs 2001-09-09 03:46:40.000000000 +0200 @@ -67,7 +67,7 @@ arbitraryCiphers = listOf1 $ elements knownCiphers knownVersions :: [Version] -knownVersions = [TLS13,TLS12,TLS11,TLS10,SSL3] +knownVersions = [TLS13,TLS12,TLS11,TLS10] arbitraryVersions :: Gen [Version] arbitraryVersions = sublistOf knownVersions diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/tls-1.5.7/tls.cabal new/tls-1.6.0/tls.cabal --- old/tls-1.5.7/tls.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/tls-1.6.0/tls.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ Name: tls -Version: 1.5.7 +Version: 1.6.0 Description: Native Haskell TLS and SSL protocol implementation for server and client. . @@ -7,7 +7,7 @@ eliminating a common set of security issues through the use of the advanced type system, high level constructions and common Haskell features. . - Currently implement the SSL3.0, TLS1.0, TLS1.1, TLS1.2 and TLS 1.3 protocol, + Currently implement the TLS1.0, TLS1.1, TLS1.2 and TLS 1.3 protocol, and support RSA and Ephemeral (Elliptic curve and regular) Diffie Hellman key exchanges, and many extensions. . @@ -42,7 +42,7 @@ Library Default-Language: Haskell2010 Build-Depends: base >= 4.9 && < 5 - , mtl >= 2 + , mtl >= 2.2.1 , transformers , cereal >= 0.5.3 , bytestring

1 0

commit ghc-threepenny-gui for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-threepenny-gui for openSUSE:Factory checked in at 2022-08-01 21:30:40 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-threepenny-gui (Old) and /work/SRC/openSUSE:Factory/.ghc-threepenny-gui.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-threepenny-gui" Mon Aug 1 21:30:40 2022 rev:7 rq:987100 version:0.9.1.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-threepenny-gui/ghc-threepenny-gui.changes 2022-02-11 23:11:46.187355566 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-threepenny-gui.new.1533/ghc-threepenny-gui.changes 2022-08-01 21:31:08.117783216 +0200 @@ -1,0 +2,6 @@ +Thu Jun 16 15:21:56 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update threepenny-gui to version 0.9.1.0 revision 5. + Upstream has revised the Cabal build instructions on Hackage. + +------------------------------------------------------------------- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-threepenny-gui.spec ++++++ --- /var/tmp/diff_new_pack.zbMRVp/_old 2022-08-01 21:31:09.065785935 +0200 +++ /var/tmp/diff_new_pack.zbMRVp/_new 2022-08-01 21:31:09.069785947 +0200 @@ -24,7 +24,7 @@ License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/4.cabal… +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/5.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-aeson-devel BuildRequires: ghc-async-devel ++++++ threepenny-gui.cabal ++++++ --- /var/tmp/diff_new_pack.zbMRVp/_old 2022-08-01 21:31:09.125786107 +0200 +++ /var/tmp/diff_new_pack.zbMRVp/_new 2022-08-01 21:31:09.129786119 +0200 @@ -1,6 +1,6 @@ Name: threepenny-gui Version: 0.9.1.0 -x-revision: 4 +x-revision: 5 Synopsis: GUI framework that uses the web browser as a display. Description: Threepenny-GUI is a GUI framework that uses the web browser as a display. @@ -111,7 +111,7 @@ cpp-options: -DREBUG ghc-options: -O2 build-depends: base >= 4.8 && < 4.17 - ,aeson (>= 0.7 && < 0.10) || == 0.11.* || (>= 1.0 && < 2.1) + ,aeson (>= 0.7 && < 0.10) || == 0.11.* || (>= 1.0 && < 2.2) ,async >= 2.0 && < 2.3 ,bytestring >= 0.9.2 && < 0.12 ,containers >= 0.4.2 && < 0.7

1 0

commit ghc-th-orphans for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-th-orphans for openSUSE:Factory checked in at 2022-08-01 21:30:39 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-th-orphans (Old) and /work/SRC/openSUSE:Factory/.ghc-th-orphans.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-th-orphans" Mon Aug 1 21:30:39 2022 rev:15 rq:987099 version:0.13.13 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-th-orphans/ghc-th-orphans.changes 2021-12-19 17:34:51.968283096 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-th-orphans.new.1533/ghc-th-orphans.changes 2022-08-01 21:31:06.849779578 +0200 @@ -1,0 +2,8 @@ +Fri May 20 04:12:36 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update th-orphans to version 0.13.13. + ### 0.13.13 [2022.05.19] + * Implement `qGetPackageRoot` (introduced in `template-haskell-2.19.0.0`) + for the `Quasi` instances defined in `th-orphans`. + +------------------------------------------------------------------- Old: ---- th-orphans-0.13.12.tar.gz th-orphans.cabal New: ---- th-orphans-0.13.13.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-th-orphans.spec ++++++ --- /var/tmp/diff_new_pack.CNVtzA/_old 2022-08-01 21:31:07.817782355 +0200 +++ /var/tmp/diff_new_pack.CNVtzA/_new 2022-08-01 21:31:07.825782378 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-th-orphans # -# Copyright (c) 2021 SUSE LLC +# Copyright (c) 2022 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,19 +19,17 @@ %global pkg_name th-orphans %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.13.12 +Version: 0.13.13 Release: 0 Summary: Orphan instances for TH datatypes License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-mtl-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-template-haskell-devel BuildRequires: ghc-th-compat-devel -BuildRequires: ghc-th-expand-syns-devel BuildRequires: ghc-th-lift-devel BuildRequires: ghc-th-lift-instances-devel BuildRequires: ghc-th-reify-many-devel @@ -58,7 +56,6 @@ %prep %autosetup -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ th-orphans-0.13.12.tar.gz -> th-orphans-0.13.13.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-orphans-0.13.12/CHANGELOG.md new/th-orphans-0.13.13/CHANGELOG.md --- old/th-orphans-0.13.12/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/th-orphans-0.13.13/CHANGELOG.md 2022-05-20 06:11:08.000000000 +0200 @@ -1,3 +1,7 @@ +### 0.13.13 [2022.05.19] +* Implement `qGetPackageRoot` (introduced in `template-haskell-2.19.0.0`) + for the `Quasi` instances defined in `th-orphans`. + ### 0.13.12 [2021.08.30] * Implement `qGetDoc` and `qPutDoc` (introduced in `template-haskell-2.18.0.0`) for the `Quasi` instances defined in `th-orphans`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-orphans-0.13.12/src/Language/Haskell/TH/Instances/Internal.hs new/th-orphans-0.13.13/src/Language/Haskell/TH/Instances/Internal.hs --- old/th-orphans-0.13.12/src/Language/Haskell/TH/Instances/Internal.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/th-orphans-0.13.13/src/Language/Haskell/TH/Instances/Internal.hs 2022-05-20 06:09:05.000000000 +0200 @@ -91,6 +91,9 @@ , ('qGetDoc, [| MTL.lift . qGetDoc |]) , ('qPutDoc, [| \a b -> MTL.lift $ qPutDoc a b |]) #endif +#if MIN_VERSION_template_haskell(2,19,0) + , ('qGetPackageRoot, [| MTL.lift qGetPackageRoot |]) +#endif ] mkDec :: Name -> Q Exp -> Q Dec diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-orphans-0.13.12/th-orphans.cabal new/th-orphans-0.13.13/th-orphans.cabal --- old/th-orphans-0.13.12/th-orphans.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/th-orphans-0.13.13/th-orphans.cabal 2022-05-20 06:10:43.000000000 +0200 @@ -1,5 +1,5 @@ name: th-orphans -version: 0.13.12 +version: 0.13.13 cabal-version: >= 1.10 build-type: Simple license: BSD3 @@ -23,7 +23,7 @@ , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.1 - , GHC == 9.2.* + , GHC == 9.2.1 synopsis: Orphan instances for TH datatypes description: Orphan instances for TH datatypes. In particular, instances for Ord and Lift, as well as a few missing Show / Eq. These @@ -33,19 +33,17 @@ library build-depends: base >= 4.3 && < 5, - template-haskell < 2.19, + template-haskell < 2.20, th-compat >= 0.1 && < 0.2, - -- Temporary upper bounds until https://github.com/mgsloan/th-reify-many/issues/9 is resolved - th-expand-syns < 0.4.9, -- https://github.com/mboes/th-lift/issues/14 th-lift >= 0.7.1, th-reify-many >= 0.1 && < 0.2, th-lift-instances, - mtl + mtl >= 2 if !impl(ghc >= 8.0) build-depends: fail == 4.9.*, - semigroups >= 0.18.5 && < 0.20 + semigroups >= 0.18.5 && < 0.21 -- Use TH to derive Generics instances instead of DeriveGeneric, for < 7.10 if impl(ghc < 7.10)

1 0

commit ghc-th-compat for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-th-compat for openSUSE:Factory checked in at 2022-08-01 21:30:38 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-th-compat (Old) and /work/SRC/openSUSE:Factory/.ghc-th-compat.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-th-compat" Mon Aug 1 21:30:38 2022 rev:6 rq:987098 version:0.1.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-th-compat/ghc-th-compat.changes 2021-09-10 23:41:31.534573067 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-th-compat.new.1533/ghc-th-compat.changes 2022-08-01 21:31:05.805776583 +0200 @@ -1,0 +2,6 @@ +Sat May 7 23:50:26 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update th-compat to version 0.1.3 revision 1. + Upstream has revised the Cabal build instructions on Hackage. + +------------------------------------------------------------------- New: ---- th-compat.cabal ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-th-compat.spec ++++++ --- /var/tmp/diff_new_pack.2AK64d/_old 2022-08-01 21:31:06.353778155 +0200 +++ /var/tmp/diff_new_pack.2AK64d/_new 2022-08-01 21:31:06.357778166 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-th-compat # -# Copyright (c) 2021 SUSE LLC +# Copyright (c) 2022 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -25,6 +25,7 @@ License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-template-haskell-devel @@ -55,6 +56,7 @@ %prep %autosetup -n %{pkg_name}-%{version} +cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ th-compat.cabal ++++++ cabal-version: >=1.10 name: th-compat version: 0.1.3 x-revision: 1 synopsis: Backward- (and forward-)compatible Quote and Code types description: This package defines a "Language.Haskell.TH.Syntax.Compat" module, which backports the @Quote@ and @Code@ types to work across a wide range of @template-haskell@ versions. On recent versions of @template-haskell@ (2.17.0.0 or later), this module simply reexports @Quote@ and @Code@ from "Language.Haskell.TH.Syntax". Refer to the Haddocks for "Language.Haskell.TH.Syntax.Compat" for examples of how to use this module. homepage: https://github.com/haskell-compat/th-compat bug-reports: https://github.com/haskell-compat/th-compat/issues license: BSD3 license-file: LICENSE author: Ryan Scott maintainer: Ryan Scott <ryan.gl.scott(a)gmail.com> copyright: (C) 2020 Ryan Scott category: Text build-type: Simple tested-with: GHC == 7.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.4 , GHC == 8.10.7 , GHC == 9.0.1 , GHC == 9.2.* extra-source-files: CHANGELOG.md, README.md source-repository head type: git location: https://github.com/haskell-compat/th-compat library exposed-modules: Language.Haskell.TH.Syntax.Compat build-depends: base >= 4.3 && < 5 , template-haskell >= 2.5 && < 2.19 if !impl(ghc >= 8.0) build-depends: fail == 4.9.* , transformers >= 0.2 && < 0.7 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall if impl(ghc >= 8.6) ghc-options: -Wno-star-is-type test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: Language.Haskell.TH.Syntax.CompatSpec Types build-depends: base >= 4.3 && < 5 , base-compat >= 0.6 && < 0.13 , hspec >= 2 && < 3 , mtl >= 2.1 && < 2.4 , template-haskell >= 2.5 && < 2.19 , th-compat build-tool-depends: hspec-discover:hspec-discover >= 2 hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts

1 0

commit ghc-text-conversions for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-text-conversions for openSUSE:Factory checked in at 2022-08-01 21:30:37 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-text-conversions (Old) and /work/SRC/openSUSE:Factory/.ghc-text-conversions.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-text-conversions" Mon Aug 1 21:30:37 2022 rev:7 rq:987097 version:0.3.1.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-text-conversions/ghc-text-conversions.changes 2020-12-22 11:47:15.557901287 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-text-conversions.new.1533/ghc-text-conversions.changes 2022-08-01 21:31:04.785773656 +0200 @@ -1,0 +2,8 @@ +Mon May 2 22:33:41 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update text-conversions to version 0.3.1.1. + ## 0.3.1.1 (May 2nd, 2022) + + - Eliminated dependency on the `errors` package. + +------------------------------------------------------------------- Old: ---- text-conversions-0.3.1.tar.gz New: ---- text-conversions-0.3.1.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-text-conversions.spec ++++++ --- /var/tmp/diff_new_pack.OYSzQr/_old 2022-08-01 21:31:05.317775183 +0200 +++ /var/tmp/diff_new_pack.OYSzQr/_new 2022-08-01 21:31:05.317775183 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-text-conversions # -# Copyright (c) 2020 SUSE LLC +# Copyright (c) 2022 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name text-conversions %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.3.1 +Version: 0.3.1.1 Release: 0 Summary: Safe conversions between textual types License: ISC @@ -29,7 +29,6 @@ BuildRequires: ghc-base16-bytestring-devel BuildRequires: ghc-base64-bytestring-devel BuildRequires: ghc-bytestring-devel -BuildRequires: ghc-errors-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel ExcludeArch: %{ix86} ++++++ text-conversions-0.3.1.tar.gz -> text-conversions-0.3.1.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-conversions-0.3.1/CHANGELOG.md new/text-conversions-0.3.1.1/CHANGELOG.md --- old/text-conversions-0.3.1/CHANGELOG.md 2020-09-30 05:23:53.000000000 +0200 +++ new/text-conversions-0.3.1.1/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,9 @@ # Changelog +## 0.3.1.1 (May 2nd, 2022) + +- Eliminated dependency on the `errors` package. + ## 0.3.1 (September 29th, 2020) - Added support for `base16-bytestring-1.0`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-conversions-0.3.1/README.md new/text-conversions-0.3.1.1/README.md --- old/text-conversions-0.3.1/README.md 2020-09-21 16:30:10.000000000 +0200 +++ new/text-conversions-0.3.1.1/README.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,4 @@ -# text-conversions [![Build Status](https://travis-ci.org/cjdev/text-conversions.svg?branch=master)](ht… +# text-conversions [![Build Status](https://img.shields.io/github/workflow/status/cjdev/text-conversion… [![Hackage](https://img.shields.io/badge/hackage-0.3.1.1-5e5184)][hackage] This is a small library to ease the pain when converting between the many different string types in Haskell. Unlike some other libraries that attempt to solve the same problem, text-conversions is: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-conversions-0.3.1/package.yaml new/text-conversions-0.3.1.1/package.yaml --- old/text-conversions-0.3.1/package.yaml 2020-09-30 05:19:25.000000000 +0200 +++ new/text-conversions-0.3.1.1/package.yaml 1970-01-01 01:00:00.000000000 +0100 @@ -1,51 +0,0 @@ -name: text-conversions -version: 0.3.1 -category: Data -synopsis: Safe conversions between textual types -description: Safe conversions between textual types -license: ISC -author: Alexis King -maintainer: lexi.lambda(a)gmail.com - -github: cjdev/text-conversions - -extra-source-files: -- README.md -- CHANGELOG.md -- LICENSE -- package.yaml -- stack.yaml - -ghc-options: -Wall -default-extensions: -- FlexibleInstances -- MultiParamTypeClasses -- OverloadedStrings - -library: - source-dirs: src - dependencies: - - base >=4.7 && <5 - - bytestring <1 - - base16-bytestring <2 - - base64-bytestring <2 - - errors <3 - - text <2 - -tests: - text-conversions-test-suite: - source-dirs: test - main: Main.hs - ghc-options: - - -rtsopts - - -threaded - - -with-rtsopts=-N - dependencies: - - base - - text-conversions - - bytestring - - hspec - - text - verbatim: | - build-tool-depends: - hspec-discover:hspec-discover diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-conversions-0.3.1/src/Data/Text/Conversions.hs new/text-conversions-0.3.1.1/src/Data/Text/Conversions.hs --- old/text-conversions-0.3.1/src/Data/Text/Conversions.hs 2020-09-21 16:30:10.000000000 +0200 +++ new/text-conversions-0.3.1.1/src/Data/Text/Conversions.hs 2001-09-09 03:46:40.000000000 +0200 @@ -48,8 +48,6 @@ , Base64(..) ) where -import Control.Error.Util (hush) - import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL @@ -144,6 +142,10 @@ decodeConvertText :: (DecodeText f a, FromText b) => a -> f b decodeConvertText = fmap fromText . decodeText +hush :: Either a b -> Maybe b +hush (Left _) = Nothing +hush (Right x) = Just x + instance ToText T.Text where toText = id instance FromText T.Text where fromText = id instance ToText String where toText = T.pack diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-conversions-0.3.1/stack.yaml new/text-conversions-0.3.1.1/stack.yaml --- old/text-conversions-0.3.1/stack.yaml 2020-09-30 04:00:15.000000000 +0200 +++ new/text-conversions-0.3.1.1/stack.yaml 1970-01-01 01:00:00.000000000 +0100 @@ -1,7 +0,0 @@ -resolver: lts-16.16 - -packages: ['.'] -extra-deps: [] - -flags: {} -extra-package-dbs: [] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/text-conversions-0.3.1/text-conversions.cabal new/text-conversions-0.3.1.1/text-conversions.cabal --- old/text-conversions-0.3.1/text-conversions.cabal 2020-09-30 05:25:00.000000000 +0200 +++ new/text-conversions-0.3.1.1/text-conversions.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,68 +1,64 @@ -cabal-version: 1.12 +cabal-version: 2.4 +name: text-conversions +version: 0.3.1.1 +category: Data +build-type: Simple +synopsis: Safe conversions between textual types +description: Safe conversions between textual types --- This file has been generated from package.yaml by hpack version 0.33.0. --- --- see: https://github.com/sol/hpack --- --- hash: 7c0bf9ebe6887baff27c40e9fdb7bb6569b32eac6b9e701e2ab9355feb75353d - -name: text-conversions -version: 0.3.1 -synopsis: Safe conversions between textual types -description: Safe conversions between textual types -category: Data -homepage: https://github.com/cjdev/text-conversions#readme -bug-reports: https://github.com/cjdev/text-conversions/issues -author: Alexis King -maintainer: lexi.lambda(a)gmail.com -license: ISC -license-file: LICENSE -build-type: Simple +author: Alexis King +maintainer: Alexis King <lexi.lambda(a)gmail.com> +license: ISC +license-file: LICENSE extra-source-files: - README.md - CHANGELOG.md - LICENSE - package.yaml - stack.yaml + README.md + CHANGELOG.md + LICENSE + +homepage: https://github.com/cjdev/text-conversions +bug-reports: https://github.com/cjdev/text-conversions/issues source-repository head type: git location: https://github.com/cjdev/text-conversions -library - exposed-modules: - Data.Text.Conversions - other-modules: - Paths_text_conversions - hs-source-dirs: - src +common common + default-language: Haskell2010 default-extensions: FlexibleInstances MultiParamTypeClasses OverloadedStrings ghc-options: -Wall + if impl(ghc >= 8.0.1) + ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + +library + import: common + + hs-source-dirs: src + exposed-modules: + Data.Text.Conversions + build-depends: - base >=4.7 && <5 + , base >=4.7 && <5 , base16-bytestring <2 , base64-bytestring <2 , bytestring <1 - , errors <3 - , text <2 - default-language: Haskell2010 + , text <3 test-suite text-conversions-test-suite + import: common type: exitcode-stdio-1.0 + + hs-source-dirs: test main-is: Main.hs other-modules: - Data.Text.ConversionsSpec - Paths_text_conversions - hs-source-dirs: - test - default-extensions: FlexibleInstances MultiParamTypeClasses OverloadedStrings - ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N + Data.Text.ConversionsSpec + + ghc-options: -rtsopts -threaded -with-rtsopts=-N + build-depends: - base + , base , bytestring , hspec , text , text-conversions - default-language: Haskell2010 build-tool-depends: - hspec-discover:hspec-discover + hspec-discover:hspec-discover

1 0

commit ghc-tdigest for openSUSE:Factory
by Source-Sync 01 Aug '22

01 Aug '22

Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-tdigest for openSUSE:Factory checked in at 2022-08-01 21:30:37 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-tdigest (Old) and /work/SRC/openSUSE:Factory/.ghc-tdigest.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-tdigest" Mon Aug 1 21:30:37 2022 rev:6 rq:987096 version:0.2.1.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-tdigest/ghc-tdigest.changes 2022-02-11 23:09:58.123043013 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-tdigest.new.1533/ghc-tdigest.changes 2022-08-01 21:31:03.745770673 +0200 @@ -1,0 +2,6 @@ +Sun May 22 19:33:01 UTC 2022 - Peter Simons <psimons(a)suse.com> + +- Update tdigest to version 0.2.1.1 revision 3. + Upstream has revised the Cabal build instructions on Hackage. + +------------------------------------------------------------------- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-tdigest.spec ++++++ --- /var/tmp/diff_new_pack.aRlWmo/_old 2022-08-01 21:31:04.417772601 +0200 +++ /var/tmp/diff_new_pack.aRlWmo/_new 2022-08-01 21:31:04.425772623 +0200 @@ -25,7 +25,7 @@ License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/2.cabal… +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/3.cabal… BuildRequires: ghc-Cabal-devel BuildRequires: ghc-base-compat-devel BuildRequires: ghc-binary-devel ++++++ tdigest.cabal ++++++ --- /var/tmp/diff_new_pack.aRlWmo/_old 2022-08-01 21:31:04.477772773 +0200 +++ /var/tmp/diff_new_pack.aRlWmo/_new 2022-08-01 21:31:04.481772784 +0200 @@ -1,7 +1,7 @@ cabal-version: >=1.10 name: tdigest version: 0.2.1.1 -x-revision: 2 +x-revision: 3 synopsis: On-line accumulation of rank-based statistics description: A new data structure for accurate on-line accumulation of rank-based statistics such as quantiles and trimmed means. @@ -24,9 +24,9 @@ || ==8.4.4 || ==8.6.5 || ==8.8.4 - || ==8.10.4 - || ==9.0.1 - || ==9.2.1 + || ==8.10.7 + || ==9.0.2 + || ==9.2.2 build-type: Simple extra-source-files: @@ -48,7 +48,7 @@ base >=4.7 && <4.19 , binary >=0.7.1.0 && <0.10 , deepseq >=1.3.0.2 && <1.5 - , transformers >=0.3 && <0.6 + , transformers >=0.3 && <0.7 if !impl(ghc >=8.0) build-depends: semigroups >=0.18.4 && <0.21

1 0