Hello community,
here is the log from the commit of package ghc-one-liner for openSUSE:Factory
checked in at 2017-05-10 20:48:24
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-one-liner (Old)
and /work/SRC/openSUSE:Factory/.ghc-one-liner.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-one-liner"
Wed May 10 20:48:24 2017 rev:2 rq:489361 version:0.8.1
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-one-liner/ghc-one-liner.changes
2017-04-12 18:08:07.466608785 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-one-liner.new/ghc-one-liner.changes
2017-05-10 20:48:25.660541018 +0200
@@ -1,0 +2,5 @@
+Tue Mar 14 09:25:35 UTC 2017 - psim...@suse.com
+
+- Update to version 0.8.1 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
one-liner-0.8.tar.gz
New:
----
one-liner-0.8.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-one-liner.spec ++++++
--- /var/tmp/diff_new_pack.xWe4OL/_old 2017-05-10 20:48:26.384438872 +0200
+++ /var/tmp/diff_new_pack.xWe4OL/_new 2017-05-10 20:48:26.392437743 +0200
@@ -18,7 +18,7 @@
%global pkg_name one-liner
Name: ghc-%{pkg_name}
-Version: 0.8
+Version: 0.8.1
Release: 0
Summary: Constraint-based generics
License: BSD-3-Clause
++++++ one-liner-0.8.tar.gz -> one-liner-0.8.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/one-liner-0.8/examples/freevars1.hs
new/one-liner-0.8.1/examples/freevars1.hs
--- old/one-liner-0.8/examples/freevars1.hs 2017-02-11 18:11:43.000000000
+0100
+++ new/one-liner-0.8.1/examples/freevars1.hs 2017-03-14 08:52:54.000000000
+0100
@@ -1,6 +1,6 @@
-- Another go at this problem:
--
https://github.com/sjoerdvisscher/blog/blob/master/2012/2012-03-03%20how%20to%20work%20generically%20with%20mutually%20recursive%20datatypes.md
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, FlexibleContexts,
DeriveGeneric, ScopedTypeVariables, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, DeriveGeneric,
ScopedTypeVariables, MultiParamTypeClasses #-}
import GHC.Generics
import Generics.OneLiner
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/one-liner-0.8/one-liner.cabal
new/one-liner-0.8.1/one-liner.cabal
--- old/one-liner-0.8/one-liner.cabal 2017-02-11 18:11:43.000000000 +0100
+++ new/one-liner-0.8.1/one-liner.cabal 2017-03-14 08:52:54.000000000 +0100
@@ -1,5 +1,5 @@
Name: one-liner
-Version: 0.8
+Version: 0.8.1
Synopsis: Constraint-based generics
Description: Write short and concise generic instances of type
classes.
one-liner is particularly useful for writing default
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/one-liner-0.8/src/Generics/OneLiner/Internal.hs
new/one-liner-0.8.1/src/Generics/OneLiner/Internal.hs
--- old/one-liner-0.8/src/Generics/OneLiner/Internal.hs 2017-02-11
18:11:43.000000000 +0100
+++ new/one-liner-0.8.1/src/Generics/OneLiner/Internal.hs 2017-03-14
08:52:54.000000000 +0100
@@ -22,6 +22,7 @@
, FlexibleInstances
, ScopedTypeVariables
, UndecidableInstances
+ , MultiParamTypeClasses
#-}
module Generics.OneLiner.Internal where
@@ -34,6 +35,7 @@
import Data.Bifunctor.Product
import Data.Bifunctor.Tannen
import Data.Functor.Contravariant.Divisible
+import Data.Functor.Compose
import Data.Profunctor
import Data.Tagged
@@ -186,9 +188,12 @@
unit = Costar $ const U1
mult (Costar f) (Costar g) = Costar $ \lr -> f (fst1 <$> lr) :*: g (snd1 <$>
lr)
-instance (Functor f, Applicative g) => GenericRecordProfunctor (Biff (->) f g)
where
- unit = Biff $ const $ pure U1
- mult (Biff f) (Biff g) = Biff $ \lr -> (:*:) <$> f (fst1 <$> lr) <*> g (snd1
<$> lr)
+instance (Functor f, Applicative g, GenericRecordProfunctor p) =>
GenericRecordProfunctor (Biff p f g) where
+ unit = Biff $ dimap (const U1) pure unit
+ mult (Biff f) (Biff g) = Biff $ dimap
+ (liftA2 (:*:) (Compose . fmap fst1) (Compose . fmap snd1))
+ (\(Compose l :*: Compose r) -> liftA2 (:*:) l r)
+ (mult (dimap getCompose Compose f) (dimap getCompose Compose g))
instance Applicative f => GenericRecordProfunctor (Joker f) where
unit = Joker $ pure U1
@@ -310,3 +315,38 @@
-- if you don't actually need a class constraint.
class AnyType a
instance AnyType a
+
+-- | The result type of a curried function.
+--
+-- If @r@ is not a function type (i.e., does not unify with `_ -> _`):
+--
+-- @
+-- `Result` (a -> r) ~ r
+-- `Result` (a -> b -> r) ~ r
+-- `Result` (a -> b -> c -> r) ~ r
+-- @
+type family Result t where
+ Result (a -> b) = Result b
+ Result r = r
+
+-- | Automatically apply a lifted function to a polymorphic argument as
+-- many times as possible.
+--
+-- A constraint `FunConstraint t c` is equivalent to the conjunction of
+-- constraints `c s` for every argument type of `t`.
+--
+-- If @r@ is not a function type:
+--
+-- @
+-- c a :- FunConstraints (a -> r) c
+-- (c a, c b) :- FunConstraints (a -> b -> r) c
+-- (c a, c b, c d) :- FunConstraints (a -> b -> d -> r) c
+-- @
+class FunConstraints t c where
+ autoApply :: Applicative f => for c -> (forall s. c s => f s) -> f t -> f
(Result t)
+
+instance {-# OVERLAPPING #-} (c a, FunConstraints b c) => FunConstraints (a ->
b) c where
+ autoApply for run f = autoApply for run (f <*> run)
+
+instance Result r ~ r => FunConstraints r c where
+ autoApply _for _run r = r
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/one-liner-0.8/src/Generics/OneLiner.hs
new/one-liner-0.8.1/src/Generics/OneLiner.hs
--- old/one-liner-0.8/src/Generics/OneLiner.hs 2017-02-11 18:11:43.000000000
+0100
+++ new/one-liner-0.8.1/src/Generics/OneLiner.hs 2017-03-14
08:52:54.000000000 +0100
@@ -10,6 +10,8 @@
-- All functions without postfix are for instances of `Generic`, and functions
-- with postfix `1` are for instances of `Generic1` (with kind @* -> *@) which
-- get an extra argument to specify how to deal with the parameter.
+-- The function `create_` does not require any such instance, but must be given
+-- a constructor explicitly.
-----------------------------------------------------------------------------
{-# LANGUAGE
RankNTypes
@@ -22,6 +24,7 @@
-- * Producing values
create, createA, ctorIndex,
create1, createA1, ctorIndex1,
+ createA_,
-- * Traversing values
gmap, gfoldMap, gtraverse,
gmap1, gfoldMap1, gtraverse1,
@@ -32,7 +35,8 @@
consume, consume1,
-- * Functions for records
-- | These functions only work for single constructor data types.
- nullaryOp, unaryOp, binaryOp, algebra, dialgebra, gcotraverse1,
+ nullaryOp, unaryOp, binaryOp, createA', algebra, dialgebra,
+ createA1', gcotraverse1,
-- * Generic programming with profunctors
-- | All the above functions have been implemented using these functions,
-- using different `profunctor`s.
@@ -71,10 +75,11 @@
-- | Create a value (one for each constructor), given how to construct the
components, under an applicative effect.
--
--- Here's how to implement `get` from the `binary` package:
+-- Here's how to implement `get` from the `binary` package, first encoding the
+-- constructor in a byte:
--
-- @
--- get = getWord8 `>>=` \\ix -> `createA` (`For` :: `For` Binary) [get] `!!`
`fromEnum` ix
+-- get = getWord8 `>>=` \\ix -> `getCompose` (`createA` (`For` :: `For`
Binary) (`Compose` [get])) `!!` `fromEnum` ix
-- @
--
-- `createA` is `generic` specialized to `Joker`.
@@ -99,6 +104,19 @@
=> for c -> (forall b s. c s => f b -> f (s b)) -> f a -> f (t a)
createA1 for f = dimap Joker runJoker $ generic1 for $ dimap runJoker Joker f
+-- | Create a value, given a constructor (or a function) and
+-- how to construct its components, under an applicative effect.
+--
+-- For example, this is the implementation of `Test.QuickCheck.arbitrary` for a
+-- type with a single constructor (e.g., quadruples @(,,,)@).
+--
+-- @
+-- arbitrary = `createA_` (`For` :: `For` Arbitrary) arbitrary (,,,)
+-- @
+createA_ :: (FunConstraints t c, Applicative f)
+ => for c -> (forall s. c s => f s) -> t -> f (Result t)
+createA_ for run = autoApply for run . pure
+
-- | `consume1` is `generic1` specialized to `Clown`.
consume1 :: (ADT1 t, Constraints1 t c, Decidable f)
=> for c -> (forall b s. c s => f b -> f (s b)) -> f a -> f (t a)
@@ -251,6 +269,20 @@
=> for c -> (forall s. c s => s -> s -> s) -> t -> t -> t
binaryOp for f = algebra for (\(Pair a b) -> f a b) .: Pair
+-- | Create a value of a record type (with exactly one constructor), given
+-- how to construct the components, under an applicative effect.
+--
+-- Here's how to implement `get` from the `binary` package:
+--
+-- @
+-- get = `createA'` (`For` :: `For` Binary) get
+-- @
+--
+-- `createA'` is `record` specialized to `Joker`.
+createA' :: (ADTRecord t, Constraints t c, Applicative f)
+ => for c -> (forall s. c s => f s) -> f t
+createA' for f = runJoker $ record for $ Joker f
+
data Pair a = Pair a a
instance Functor Pair where
fmap f (Pair a b) = Pair (f a) (f b)
@@ -271,6 +303,11 @@
=> for c -> (forall s. c s => f s -> g s) -> f t -> g t
dialgebra for f = runBiff $ record for $ Biff f
+-- | `createA1'` is `record1` specialized to `Joker`.
+createA1' :: (ADTRecord1 t, Constraints1 t c, Applicative f)
+ => for c -> (forall b s. c s => f b -> f (s b)) -> f a -> f (t a)
+createA1' for f = dimap Joker runJoker $ record1 for $ dimap runJoker Joker f
+
-- |
--
-- @
