Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-logict for openSUSE:Factory checked in at 2022-08-01 21:30:05 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-logict (Old) and /work/SRC/openSUSE:Factory/.ghc-logict.new.1533 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-logict" Mon Aug 1 21:30:05 2022 rev:13 rq:987057 version:0.8.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-logict/ghc-logict.changes 2021-01-20 18:26:31.831466785 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-logict.new.1533/ghc-logict.changes 2022-08-01 21:30:17.897639138 +0200 @@ -1,0 +2,9 @@ +Sun May 8 20:46:55 UTC 2022 - Peter Simons <[email protected]> + +- Update logict to version 0.8.0.0. + Upstream has edited the change log file since the last release in + a non-trivial way, i.e. they did more than just add a new entry + at the top. You can review the file at: + http://hackage.haskell.org/package/logict-0.8.0.0/src/changelog.md + +------------------------------------------------------------------- Old: ---- logict-0.7.1.0.tar.gz New: ---- logict-0.8.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-logict.spec ++++++ --- /var/tmp/diff_new_pack.ll4X9h/_old 2022-08-01 21:30:18.453640733 +0200 +++ /var/tmp/diff_new_pack.ll4X9h/_new 2022-08-01 21:30:18.457640744 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-logict # -# 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,7 +19,7 @@ %global pkg_name logict %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.7.1.0 +Version: 0.8.0.0 Release: 0 Summary: A backtracking logic-programming monad License: BSD-3-Clause ++++++ logict-0.7.1.0.tar.gz -> logict-0.8.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/logict-0.7.1.0/Control/Monad/Logic/Class.hs new/logict-0.8.0.0/Control/Monad/Logic/Class.hs --- old/logict-0.7.1.0/Control/Monad/Logic/Class.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/logict-0.8.0.0/Control/Monad/Logic/Class.hs 2001-09-09 03:46:40.000000000 +0200 @@ -291,8 +291,8 @@ -- > pure d -- > -- > prime v = once (ifte (divisors v) - -- > (const (pure True)) - -- > (pure False)) + -- > (const (pure False)) + -- > (pure True)) -- -- >>> observeAll (prime 20) -- [False] @@ -310,16 +310,14 @@ interleave m1 m2 = msplit m1 >>= maybe m2 (\(a, m1') -> pure a <|> interleave m2 m1') - m >>- f = do (a, m') <- maybe empty pure =<< msplit m - interleave (f a) (m' >>- f) + m >>- f = msplit m >>= maybe empty + (\(a, m') -> interleave (f a) (m' >>- f)) ifte t th el = msplit t >>= maybe el (\(a,m) -> th a <|> (m >>= th)) - once m = do (a, _) <- maybe empty pure =<< msplit m - pure a - - lnot m = ifte (once m) (const empty) (pure ()) + once m = msplit m >>= maybe empty (\(a, _) -> pure a) + lnot m = msplit m >>= maybe (pure ()) (const empty) ------------------------------------------------------------------------------- -- | The inverse of 'msplit'. Satisfies the following law: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/logict-0.7.1.0/Control/Monad/Logic.hs new/logict-0.8.0.0/Control/Monad/Logic.hs --- old/logict-0.7.1.0/Control/Monad/Logic.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/logict-0.8.0.0/Control/Monad/Logic.hs 2001-09-09 03:46:40.000000000 +0200 @@ -19,6 +19,9 @@ ------------------------------------------------------------------------- {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} @@ -43,8 +46,10 @@ observeT, observeManyT, observeAllT, - module Control.Monad, - module Trans + fromLogicT, + fromLogicTWith, + hoistLogicT, + embedLogicT ) where import Control.Applicative @@ -54,7 +59,9 @@ import Control.Monad.Identity (Identity(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans (MonadTrans(..)) -import qualified Control.Monad.Trans as Trans +#if MIN_VERSION_base(4,8,0) +import Control.Monad.Zip (MonadZip (..)) +#endif import Control.Monad.Reader.Class (MonadReader(..)) import Control.Monad.State.Class (MonadState(..)) @@ -76,6 +83,11 @@ ------------------------------------------------------------------------- -- | A monad transformer for performing backtracking computations -- layered over another monad @m@. +-- +-- When @m@ is 'Identity', 'LogicT' @m@ becomes isomorphic to a list +-- (see 'Logic'). Thus 'LogicT' @m@ for non-trivial @m@ can be imagined +-- as a list, pattern matching on which causes monadic effects. +-- newtype LogicT m a = LogicT { unLogicT :: forall r. (a -> m r -> m r) -> m r -> m r } @@ -154,9 +166,87 @@ runLogicT :: LogicT m a -> (a -> m r -> m r) -> m r -> m r runLogicT (LogicT r) = r +-- | Convert from 'LogicT' to an arbitrary logic-like monad transformer, +-- such as <https://hackage.haskell.org/package/list-t list-t> +-- or <https://hackage.haskell.org/package/logict-sequence logict-sequence> +-- +-- For example, to show a representation of the structure of a `LogicT` +-- computation, @l@, over a data-like `Monad` (such as @[]@, +-- @Data.Sequence.Seq@, etc.), you could write +-- +-- @ +-- import ListT (ListT) +-- +-- 'show' $ fromLogicT @ListT l +-- @ +#if MIN_VERSION_base(4,8,0) +fromLogicT :: (Alternative (t m), MonadTrans t, Monad m, Monad (t m)) + => LogicT m a -> t m a +#else +fromLogicT :: (Alternative (t m), MonadTrans t, Applicative m, Monad m, Monad (t m)) + => LogicT m a -> t m a +#endif +fromLogicT = fromLogicTWith lift + +-- | Convert from @'LogicT' m@ to an arbitrary logic-like monad, +-- such as @[]@. +-- +-- Examples: +-- +-- @ +-- 'fromLogicT' = fromLogicTWith d +-- 'hoistLogicT' f = fromLogicTWith ('lift' . f) +-- 'embedLogicT' f = 'fromLogicTWith' f +-- @ +-- +-- The first argument should be a +-- <https://hackage.haskell.org/package/mmorph/docs/Control-Monad-Morph.html monad morphism>. +-- to produce sensible results. +fromLogicTWith :: (Applicative m, Monad n, Alternative n) + => (forall x. m x -> n x) -> LogicT m a -> n a +fromLogicTWith p (LogicT f) = join . p $ + f (\a v -> pure (pure a <|> join (p v))) (pure empty) + +-- | Convert a 'LogicT' computation from one underlying monad to another. +-- For example, +-- +-- @ +-- hoistLogicT lift :: LogicT m a -> LogicT (StateT m) a +-- @ +-- +-- The first argument should be a +-- <https://hackage.haskell.org/package/mmorph/docs/Control-Monad-Morph.html monad morphism>. +-- to produce sensible results. +hoistLogicT :: (Applicative m, Monad n) => (forall x. m x -> n x) -> LogicT m a -> LogicT n a +hoistLogicT f = fromLogicTWith (lift . f) + +-- | Convert a 'LogicT' computation from one underlying monad to another. +-- +-- The first argument should be a +-- <https://hackage.haskell.org/package/mmorph/docs/Control-Monad-Morph.html monad morphism>. +-- to produce sensible results. +embedLogicT :: Applicative m => (forall a. m a -> LogicT n a) -> LogicT m b -> LogicT n b +embedLogicT f = fromLogicTWith f + ------------------------------------------------------------------------- -- | The basic 'Logic' monad, for performing backtracking computations -- returning values (e.g. 'Logic' @a@ will return values of type @a@). +-- +-- __Technical perspective.__ +-- 'Logic' is a +-- <http://okmij.org/ftp/tagless-final/course/Boehm-Berarducci.html Boehm-Berarducci encoding> +-- of lists. Speaking plainly, its type is identical (up to 'Identity' wrappers) +-- to 'foldr' applied to a given list. And this list itself can be reconstructed +-- by supplying @(:)@ and @[]@. +-- +-- > import Data.Functor.Identity +-- > +-- > fromList :: [a] -> Logic a +-- > fromList xs = LogicT $ \cons nil -> foldr cons nil xs +-- > +-- > toList :: Logic a -> [a] +-- > toList (LogicT fld) = runIdentity $ fld (\x (Identity xs) -> Identity (x : xs)) (Identity []) +-- type Logic = LogicT Identity ------------------------------------------------------------------------- @@ -176,15 +266,20 @@ -- >>> observe empty -- *** Exception: No answer. -- +-- Since 'Logic' is isomorphic to a list, 'observe' is analogous to 'head'. +-- observe :: Logic a -> a observe lt = runIdentity $ unLogicT lt (const . pure) (error "No answer.") ------------------------------------------------------------------------- -- | Extracts all results from a 'Logic' computation. -- --- >>> observe (pure 5 <|> empty <|> empty <|> pure 3 <|> empty) +-- >>> observeAll (pure 5 <|> empty <|> empty <|> pure 3 <|> empty) -- [5,3] -- +-- 'observeAll' reveals a half of the isomorphism between 'Logic' +-- and lists. See description of 'runLogic' for the other half. +-- observeAll :: Logic a -> [a] observeAll = runIdentity . observeAllT @@ -195,6 +290,8 @@ -- >>> observeMany 5 nats -- [0,1,2,3,4] -- +-- Since 'Logic' is isomorphic to a list, 'observeMany' is analogous to 'take'. +-- observeMany :: Int -> Logic a -> [a] observeMany i = take i . observeAll -- Implementing 'observeMany' using 'observeManyT' is quite costly, @@ -210,6 +307,10 @@ -- >>> runLogic (pure 5 <|> pure 3 <|> empty) (+) 0 -- 8 -- +-- When invoked with @(:)@ and @[]@ as arguments, reveals +-- a half of the isomorphism between 'Logic' and lists. +-- See description of 'observeAll' for the other half. +-- runLogic :: Logic a -> (a -> r -> r) -> r -> r runLogic l s f = runIdentity $ unLogicT l si fi where @@ -249,7 +350,11 @@ instance Monoid (LogicT m a) where mempty = empty +#if MIN_VERSION_base(4,9,0) + mappend = (<>) +#else mappend = (<|>) +#endif mconcat = F.asum instance MonadTrans LogicT where @@ -282,10 +387,86 @@ #endif -instance T.Traversable (LogicT Identity) where +-- A much simpler logic monad representation used to define the Traversable and +-- MonadZip instances. This is essentially the same as ListT from the list-t +-- package, but it uses a slightly more efficient representation: MLView m a is +-- more compact than Maybe (a, ML m a), and the additional laziness in the +-- latter appears to be incidental/historical. +newtype ML m a = ML (m (MLView m a)) + deriving (Functor, F.Foldable, T.Traversable) + +data MLView m a = EmptyML | ConsML a (ML m a) + deriving (Functor, F.Foldable) + +instance T.Traversable m => T.Traversable (MLView m) where + traverse _ EmptyML = pure EmptyML + traverse f (ConsML x (ML m)) + = liftA2 (\y ym -> ConsML y (ML ym)) (f x) (T.traverse (T.traverse f) m) + {- The derived instance would write the second case as + - + - traverse f (ConsML x xs) = liftA2 ConsML (f x) (traverse @(ML m) f xs) + - + - Inlining the inner traverse gives + - + - traverse f (ConsML x (ML m)) = liftA2 ConsML (f x) (ML <$> traverse (traverse f) m) + - + - revealing fmap under liftA2. We fuse those into a single application of liftA2, + - in case fmap isn't free. + -} + +toML :: Applicative m => LogicT m a -> ML m a +toML (LogicT q) = ML $ q (\a m -> pure $ ConsML a (ML m)) (pure EmptyML) + +fromML :: Monad m => ML m a -> LogicT m a +fromML (ML m) = lift m >>= \r -> case r of + EmptyML -> empty + ConsML a xs -> pure a <|> fromML xs + +#if MIN_VERSION_base(4,8,0) +instance {-# OVERLAPPING #-} T.Traversable (LogicT Identity) where traverse g l = runLogic l (\a ft -> cons <$> g a <*> ft) (pure empty) where cons a l' = pure a <|> l' +instance {-# OVERLAPPABLE #-} (Monad m, T.Traversable m) => T.Traversable (LogicT m) where + traverse f = fmap fromML . T.traverse f . toML +#else +instance (Monad m, Applicative m, T.Traversable m) => T.Traversable (LogicT m) where + traverse f = fmap fromML . T.traverse f . toML +#endif + +#if MIN_VERSION_base(4,8,0) +zipWithML :: MonadZip m => (a -> b -> c) -> ML m a -> ML m b -> ML m c +zipWithML f = go + where + go (ML m1) (ML m2) = + ML $ mzipWith zv m1 m2 + zv (a `ConsML` as) (b `ConsML` bs) = f a b `ConsML` go as bs + zv _ _ = EmptyML + +unzipML :: MonadZip m => ML m (a, b) -> (ML m a, ML m b) +unzipML (ML m) + | (l, r) <- munzip (fmap go m) + = (ML l, ML r) + where + go EmptyML = (EmptyML, EmptyML) + go ((a, b) `ConsML` listab) + = (a `ConsML` la, b `ConsML` lb) + where + -- If the underlying munzip is careful not to leak memory, then we + -- don't want to defeat it. We need to be sure that la and lb are + -- realized as selector thunks. Hopefully the CPSish conversion + -- doesn't muck anything up at another level. + {-# NOINLINE remains #-} + {-# NOINLINE la #-} + {-# NOINLINE lb #-} + remains = unzipML listab + (la, lb) = remains + +instance MonadZip m => MonadZip (LogicT m) where + mzipWith f xs ys = fromML $ zipWithML f (toML xs) (toML ys) + munzip xys = case unzipML (toML xys) of + (xs, ys) -> (fromML xs, fromML ys) +#endif -- Needs undecidable instances instance MonadReader r m => MonadReader r (LogicT m) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/logict-0.7.1.0/changelog.md new/logict-0.8.0.0/changelog.md --- old/logict-0.7.1.0/changelog.md 2001-09-09 03:46:40.000000000 +0200 +++ new/logict-0.8.0.0/changelog.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,7 +1,20 @@ +# 0.8.0.0 + +* Breaking change: + do not re-export `Control.Monad` and `Control.Monad.Trans` from `Control.Monad.Logic`. +* Generalize `instance Traversable (LogicT Identity)` + to `instance (Traversable m, Monad m) => Traversable (LogicT m)`. +* Add conversion functions `fromLogicT` and `fromLogicTWith` to facilitate + interoperation with [`list-t`](https://hackage.haskell.org/package/list-t) + and [`logict-sequence`](https://hackage.haskell.org/package/logict-sequence) packages. +* Add `hoistLogicT` and `embedLogicT` to convert `LogicT` computations + from one underlying monad to another. + # 0.7.1.0 * Improve documentation. -* Relax superclasses of `MonadLogic` to `Monad` and `Alternative` instead of `MonadPlus`. +* Breaking change: + relax superclasses of `MonadLogic` to `Monad` and `Alternative` instead of `MonadPlus`. # 0.7.0.3 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/logict-0.7.1.0/logict.cabal new/logict-0.8.0.0/logict.cabal --- old/logict-0.7.1.0/logict.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/logict-0.8.0.0/logict.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ name: logict -version: 0.7.1.0 +version: 0.8.0.0 license: BSD3 license-file: LICENSE copyright: @@ -22,7 +22,7 @@ changelog.md README.md cabal-version: >=1.10 -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.3 +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.2 GHC ==9.2.2 source-repository head type: git @@ -33,10 +33,14 @@ Control.Monad.Logic Control.Monad.Logic.Class default-language: Haskell2010 + ghc-options: -O2 -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat + build-depends: base >=4.3 && <5, - mtl >=2.0 && <2.3 + mtl >=2.0 && <2.4 if impl(ghc <8.0) build-depends: @@ -55,7 +59,11 @@ type: exitcode-stdio-1.0 main-is: Test.hs default-language: Haskell2010 + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat -Wno-incomplete-uni-patterns + build-depends: base, async >=2.0, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/logict-0.7.1.0/test/Test.hs new/logict-0.8.0.0/test/Test.hs --- old/logict-0.7.1.0/test/Test.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/logict-0.8.0.0/test/Test.hs 2001-09-09 03:46:40.000000000 +0200 @@ -10,6 +10,7 @@ import Control.Concurrent ( threadDelay ) import Control.Concurrent.Async ( race ) import Control.Exception +import Control.Monad import Control.Monad.Identity import Control.Monad.Logic import Control.Monad.Reader
