[Pkg-haskell-commits] darcs: haskell-lens: Redo the non-TH patches from scratch

Joachim Breitner mail at joachim-breitner.de
Tue May 13 21:36:51 UTC 2014


Tue May 13 15:29:02 UTC 2014  Joachim Breitner <mail at joachim-breitner.de>
  * Redo the non-TH patches from scratch

    M! ./changelog -1 +1
    M! ./patches/add-without-th-flag.patch -78 +57
    R! ./patches/disable-reflection.patch
    M! ./patches/guard-ANNotations.patch -43 +85
    M! ./patches/no-transformers-compat.diff -3 +5
    M! ./patches/series -1 +1

Tue May 13 15:29:02 UTC 2014  Joachim Breitner <mail at joachim-breitner.de>
  * Redo the non-TH patches from scratch
diff -rN -u old-haskell-lens/changelog new-haskell-lens/changelog
--- old-haskell-lens/changelog	2014-05-13 21:36:51.367543699 +0000
+++ new-haskell-lens/changelog	2014-05-13 21:36:51.375543706 +0000
@@ -1,8 +1,8 @@
 haskell-lens (4.1.2-2) unstable; urgency=medium
 
+  [ Raúl Benencia ]
   * Fix bogus patch
   * Disable Reflection on architectures without TH
-  * Backport testsuite failure fix
 
  -- Raúl Benencia <rul at kalgan.cc>  Tue, 13 May 2014 10:48:44 -0300
 
diff -rN -u old-haskell-lens/patches/add-without-th-flag.patch new-haskell-lens/patches/add-without-th-flag.patch
--- old-haskell-lens/patches/add-without-th-flag.patch	2014-05-13 21:36:51.367543699 +0000
+++ new-haskell-lens/patches/add-without-th-flag.patch	2014-05-13 21:36:51.375543706 +0000
@@ -1,11 +1,8 @@
-From 42c73dc2026eb8aeeb1cf60ca4102357f3718a06 Mon Sep 17 00:00:00 2001
-From: Joey Hess <joey at kitenet.net>
-Date: Tue, 15 Oct 2013 09:56:50 -0400
-Last-Update: 2014-04-14
-Subject: [PATCH 2/3] add without-th flag
---- a/lens.cabal
-+++ b/lens.cabal
-@@ -180,6 +180,11 @@
+Index: haskell-lens-4.1.2/lens.cabal
+===================================================================
+--- haskell-lens-4.1.2.orig/lens.cabal
++++ haskell-lens-4.1.2/lens.cabal
+@@ -121,6 +121,12 @@ flag benchmark-uniplate
    default: False
    manual: True
  
@@ -14,29 +11,19 @@
 +  default: False
 +  manual: True
 +
- library
-   build-depends:
-     aeson                     >= 0.7      && < 0.8,
-@@ -200,7 +205,6 @@
-     parallel                  >= 3.1.0.1  && < 3.3,
-     primitive                 >= 0.4.0.1  && < 0.6,
-     profunctors               >= 4        && < 5,
--    reflection                >= 1.1.6    && < 2,
-     scientific                >= 0.2      && < 0.3,
-     semigroupoids             >= 4        && < 5,
-     semigroups                >= 0.8.4    && < 1,
-@@ -246,10 +250,8 @@
-     Control.Lens.Internal.Level
-     Control.Lens.Internal.Magma
-     Control.Lens.Internal.Prism
--    Control.Lens.Internal.Reflection
++
+ -- Generate inline pragmas when using template-haskell. This defaults to enabled, but you can
+ --
+ -- > cabal install lens -f-inlining
+@@ -248,7 +254,6 @@ library
+     Control.Lens.Internal.Reflection
      Control.Lens.Internal.Review
      Control.Lens.Internal.Setter
 -    Control.Lens.Internal.TH
      Control.Lens.Internal.Zoom
      Control.Lens.Iso
      Control.Lens.Lens
-@@ -261,7 +263,6 @@
+@@ -260,7 +265,6 @@ library
      Control.Lens.Reified
      Control.Lens.Review
      Control.Lens.Setter
@@ -44,43 +31,28 @@
      Control.Lens.Traversal
      Control.Lens.Tuple
      Control.Lens.Type
-@@ -294,19 +295,28 @@
-     Data.Typeable.Lens
-     Data.Vector.Lens
-     Data.Vector.Generic.Lens
--    Generics.Deriving.Lens
--    GHC.Generics.Lens
-     System.Exit.Lens
-     System.FilePath.Lens
--    System.IO.Error.Lens
--    Language.Haskell.TH.Lens
+@@ -301,11 +305,18 @@ library
+     Language.Haskell.TH.Lens
      Numeric.Lens
  
 -  other-modules:
 -    Control.Lens.Internal.TupleIxedTH
--
+ 
    cpp-options: -traditional
  
 +  if flag(without-th)
 +    cpp-options: -DDISABLE_TEMPLATE_HASKELL
-+  else
-+    build-depends:
-+      reflection                >= 1.1.6    && < 2
++  else:
 +    exposed-modules:
-+      Control.Lens.Internal.Reflection
-+      Control.Lens.Internal.TH
 +      Control.Lens.TH
-+      Generics.Deriving.Lens
-+      GHC.Generics.Lens
-+      Language.Haskell.TH.Lens
-+      System.IO.Error.Lens
++      Control.Lens.Internal.TH
 +    other-modules:
 +      Control.Lens.Internal.TupleIxedTH
 +
    if flag(safe)
      cpp-options: -DSAFE=1
  
-@@ -340,6 +350,9 @@
+@@ -339,6 +350,9 @@ test-suite templates
    ghc-options: -Wall -threaded
    hs-source-dirs: tests
  
@@ -90,43 +62,50 @@
    if flag(dump-splices)
      ghc-options: -ddump-splices
  
---- a/src/Control/Lens/Internal/Exception.hs
-+++ b/src/Control/Lens/Internal/Exception.hs
-@@ -39,7 +39,9 @@
- import Control.Exception as Exception
- import Control.Lens.Fold
- import Control.Lens.Getter
+Index: haskell-lens-4.1.2/src/Control/Lens/At.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/At.hs
++++ haskell-lens-4.1.2/src/Control/Lens/At.hs
+@@ -2,7 +2,9 @@
+ {-# LANGUAGE GADTs #-}
+ {-# LANGUAGE Rank2Types #-}
+ {-# LANGUAGE TypeFamilies #-}
 +#ifndef DISABLE_TEMPLATE_HASKELL
- import Control.Lens.Internal.Reflection
+ {-# LANGUAGE TemplateHaskell #-}
 +#endif
- import Control.Monad.Catch as Catch
- import Data.Monoid
- import Data.Proxy
-@@ -140,6 +142,7 @@
-   handler_ l = handler l . const
-   {-# INLINE handler_ #-}
- 
+ {-# LANGUAGE FlexibleContexts #-}
+ {-# LANGUAGE DefaultSignatures #-}
+ {-# LANGUAGE FlexibleInstances #-}
+@@ -45,7 +47,9 @@ import Control.Applicative
+ import Control.Lens.Lens
+ import Control.Lens.Setter
+ import Control.Lens.Type
 +#ifndef DISABLE_TEMPLATE_HASKELL
- instance Handleable SomeException IO Exception.Handler where
-   handler = handlerIO
- 
-@@ -151,7 +154,7 @@
+ import Control.Lens.Internal.TupleIxedTH (makeAllTupleIxed)
++#endif
+ import Data.Aeson as Aeson
+ import Data.Array.IArray as Array
+ import Data.Array.Unboxed
+@@ -441,4 +445,6 @@ instance (Eq k, Hashable k) => At (HashS
+     where mv = if HashSet.member k m then Just () else Nothing
+   {-# INLINE at #-}
  
- handlerCatchIO :: forall m a r. (Typeable a, Typeable1 m) => Getting (First a) SomeException a -> (a -> m r) -> Catch.Handler m r
- handlerCatchIO l f = reifyTypeable (preview l) $ \ (_ :: Proxy s) -> Catch.Handler (\(Handling a :: Handling a s m) -> f a)
--
++#ifndef DISABLE_TEMPLATE_HASKELL
+ makeAllTupleIxed
 +#endif
- ------------------------------------------------------------------------------
- -- Helpers
- ------------------------------------------------------------------------------
-@@ -197,8 +200,10 @@
-   showsPrec d _ = showParen (d > 10) $ showString "Handling ..."
-   {-# INLINE showsPrec #-}
+Index: haskell-lens-4.1.2/src/System/IO/Error/Lens.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/System/IO/Error/Lens.hs
++++ haskell-lens-4.1.2/src/System/IO/Error/Lens.hs
+@@ -1,3 +1,4 @@
++{-# LANGUAGE CPP #-}
+ {-# LANGUAGE TemplateHaskell #-}
+ {-# LANGUAGE FlexibleContexts #-}
+ {-# LANGUAGE FlexibleInstances #-}
+@@ -62,4 +63,6 @@ errorType f s = f (ioe_type s) <&> \e ->
+ --
+ -- (These prisms are generated automatically)
  
 +#ifndef DISABLE_TEMPLATE_HASKELL
- instance (Reifies s (SomeException -> Maybe a), Typeable a, Typeable1 m, Typeable s) => Exception (Handling a s m) where
-   toException _ = SomeException HandlingException
-   {-# INLINE toException #-}
-   fromException = fmap Handling . reflect (Proxy :: Proxy s)
-   {-# INLINE fromException #-}
+ makePrisms ''IOErrorType
 +#endif
diff -rN -u old-haskell-lens/patches/disable-reflection.patch new-haskell-lens/patches/disable-reflection.patch
--- old-haskell-lens/patches/disable-reflection.patch	2014-05-13 21:36:51.363543696 +0000
+++ new-haskell-lens/patches/disable-reflection.patch	1970-01-01 00:00:00.000000000 +0000
@@ -1,95 +0,0 @@
-From: Raúl Benencia <rul at kalgan.cc>
-Date: 2014-04-19
-Description: disable Reflection on architectures without TH
---- a/src/Control/Lens/Fold.hs
-+++ b/src/Control/Lens/Fold.hs
-@@ -131,11 +131,13 @@
-   , Traversed
-   , Sequenced
- 
-+#ifndef DISABLE_TEMPLATE_HASKELL
-   -- * Fold with Reified Monoid
-   , foldBy
-   , foldByOf
-   , foldMapBy
-   , foldMapByOf
-+#endif
-   ) where
- 
- import Control.Applicative as Applicative
-@@ -2397,6 +2399,7 @@
- skip _ = ()
- {-# INLINE skip #-}
- 
-+#ifndef DISABLE_TEMPLATE_HASKELL
- ------------------------------------------------------------------------------
- -- Folds with Reified Monoid
- ------------------------------------------------------------------------------
-@@ -2412,3 +2415,4 @@
- 
- foldMapByOf :: (forall s. Getting (M r s) t a) -> (r -> r -> r) -> r -> (a -> r) -> t -> r
- foldMapByOf l f z g = reifyFold f z (foldMapOf l (M #. g))
-+#endif
---- a/src/Control/Lens/Internal/Fold.hs
-+++ b/src/Control/Lens/Internal/Fold.hs
-@@ -25,8 +25,10 @@
-   , Min(..), getMin
-   , Leftmost(..), getLeftmost
-   , Rightmost(..), getRightmost
-+#ifndef DISABLE_TEMPLATE_HASKELL
-   , ReifiedMonoid(..), M(..)
-   , reifyFold
-+#endif
-   ) where
- 
- import Control.Applicative
-@@ -35,7 +37,9 @@
- import Data.Functor.Contravariant
- import Data.Maybe
- import Data.Semigroup hiding (Min, getMin, Max, getMax)
-+#ifndef DISABLE_TEMPLATE_HASKELL
- import Data.Reflection
-+#endif
- 
- #ifndef DISABLE_TEMPLATE_HASKELL
- {-# ANN module "HLint: ignore Avoid lambda" #-}
-@@ -212,6 +216,7 @@
- getRightmost (RLeaf a) = Just a
- getRightmost (RStep x) = getRightmost x
- 
-+#ifndef DISABLE_TEMPLATE_HASKELL
- ------------------------------------------------------------------------------
- -- Folding with Reified Monoid
- ------------------------------------------------------------------------------
-@@ -232,3 +237,4 @@
- 
- reifyFold :: (a -> a -> a) -> a -> (forall s. Reifies s (ReifiedMonoid a) => t -> M a s) -> t -> a
- reifyFold f z m xs = reify (ReifiedMonoid f z) (unM (m xs))
-+#endif
---- a/src/Control/Lens/Indexed.hs
-+++ b/src/Control/Lens/Indexed.hs
-@@ -68,9 +68,11 @@
-   , iforM
-   , imapAccumR
-   , imapAccumL
-+#ifndef DISABLE_TEMPLATE_HASKELL
-   -- * Indexed Folds with Reified Monoid
-   , ifoldMapBy
-   , ifoldMapByOf
-+#endif
-   ) where
- 
- import Control.Applicative
-@@ -703,6 +705,7 @@
- skip _ = ()
- {-# INLINE skip #-}
- 
-+#ifndef DISABLE_TEMPLATE_HASKELL
- -------------------------------------------------------------------------------
- -- Indexed Folds with Reified Monoid
- -------------------------------------------------------------------------------
-@@ -712,3 +715,4 @@
- 
- ifoldMapByOf :: (forall s. IndexedGetting i (M r s) t a) -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r
- ifoldMapByOf l f z g = reifyFold f z (ifoldMapOf l (\i a -> M (g i a)))
-+#endif
diff -rN -u old-haskell-lens/patches/guard-ANNotations.patch new-haskell-lens/patches/guard-ANNotations.patch
--- old-haskell-lens/patches/guard-ANNotations.patch	2014-05-13 21:36:51.363543696 +0000
+++ new-haskell-lens/patches/guard-ANNotations.patch	2014-05-13 21:36:51.371543702 +0000
@@ -3,9 +3,11 @@
 Date: Tue, 15 Oct 2013 10:03:28 -0400
 Last-Update: 2014-04-14
 Subject: [PATCH 3/3] guard ANNotations
---- a/src/Control/Lens.hs
-+++ b/src/Control/Lens.hs
-@@ -95,6 +95,8 @@
+Index: haskell-lens-4.1.2/src/Control/Lens.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens.hs
++++ haskell-lens-4.1.2/src/Control/Lens.hs
+@@ -95,6 +95,8 @@ import Control.Lens.Type
  import Control.Lens.Wrapped
  import Control.Lens.Zoom
  
@@ -14,9 +16,11 @@
  {-# ANN module "HLint: ignore Use import/export shortcut" #-}
  #endif
 +#endif
---- a/src/Control/Lens/Equality.hs
-+++ b/src/Control/Lens/Equality.hs
-@@ -31,10 +31,12 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Equality.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Equality.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Equality.hs
+@@ -31,10 +31,12 @@ module Control.Lens.Equality
  import Control.Lens.Type
  import Data.Functor.Identity
  
@@ -29,16 +33,18 @@
  
  -- $setup
  -- >>> import Control.Lens
-@@ -86,4 +88,4 @@
+@@ -86,4 +88,4 @@ simply = id
  -- type of a used argument and avoid @ScopedTypeVariables@ or other ugliness.
  simple :: Equality' a a
  simple = id
 -{-# INLINE simple #-}
 \ No newline at end of file
 +{-# INLINE simple #-}
---- a/src/Control/Lens/Fold.hs
-+++ b/src/Control/Lens/Fold.hs
-@@ -178,11 +178,13 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Fold.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Fold.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Fold.hs
+@@ -178,11 +178,13 @@ import Data.Traversable
  -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g
  -- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force
  
@@ -52,9 +58,11 @@
  
  infixl 8 ^.., ^?, ^?!, ^@.., ^@?, ^@?!
  
---- a/src/Control/Exception/Lens.hs
-+++ b/src/Control/Exception/Lens.hs
-@@ -119,9 +119,11 @@
+Index: haskell-lens-4.1.2/src/Control/Exception/Lens.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Exception/Lens.hs
++++ haskell-lens-4.1.2/src/Control/Exception/Lens.hs
+@@ -119,9 +119,11 @@ import Prelude
    , Maybe(..), Either(..), String
    )
  
@@ -66,9 +74,11 @@
  
  -- $setup
  -- >>> :set -XNoOverloadedStrings
---- a/src/Control/Lens/Cons.hs
-+++ b/src/Control/Lens/Cons.hs
-@@ -55,7 +55,9 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Cons.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Cons.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Cons.hs
+@@ -55,7 +55,9 @@ import           Data.Vector.Unboxed (Un
  import qualified Data.Vector.Unboxed as Unbox
  import           Data.Word
  
@@ -78,9 +88,11 @@
  
  -- $setup
  -- >>> :set -XNoOverloadedStrings
---- a/src/Control/Lens/Internal/Fold.hs
-+++ b/src/Control/Lens/Internal/Fold.hs
-@@ -37,7 +37,9 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Internal/Fold.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Internal/Fold.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Internal/Fold.hs
+@@ -37,7 +37,9 @@ import Data.Maybe
  import Data.Semigroup hiding (Min, getMin, Max, getMax)
  import Data.Reflection
  
@@ -90,9 +102,11 @@
  
  ------------------------------------------------------------------------------
  -- Folding
---- a/src/Control/Lens/Internal.hs
-+++ b/src/Control/Lens/Internal.hs
-@@ -44,6 +44,8 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Internal.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Internal.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Internal.hs
+@@ -44,6 +44,8 @@ import Control.Lens.Internal.Review
  import Control.Lens.Internal.Setter
  import Control.Lens.Internal.Zoom
  
@@ -101,9 +115,11 @@
  {-# ANN module "HLint: ignore Use import/export shortcut" #-}
  #endif
 +#endif
---- a/src/Control/Lens/Iso.hs
-+++ b/src/Control/Lens/Iso.hs
-@@ -88,9 +88,11 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Iso.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Iso.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Iso.hs
+@@ -88,9 +88,11 @@ import Data.Maybe
  import Data.Profunctor
  import Data.Profunctor.Unsafe
  
@@ -115,9 +131,11 @@
  
  -- $setup
  -- >>> :set -XNoOverloadedStrings
---- a/src/Control/Lens/Lens.hs
-+++ b/src/Control/Lens/Lens.hs
-@@ -136,9 +136,11 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Lens.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Lens.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Lens.hs
+@@ -136,9 +136,11 @@ import Data.Profunctor.Rep
  import Data.Profunctor.Unsafe
  import Data.Void
  
@@ -129,9 +147,11 @@
  
  -- $setup
  -- >>> :set -XNoOverloadedStrings
---- a/src/Control/Lens/Plated.hs
-+++ b/src/Control/Lens/Plated.hs
-@@ -106,9 +106,11 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Plated.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Plated.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Plated.hs
+@@ -106,9 +106,11 @@ import Data.Data.Lens
  import Data.Monoid
  import Data.Tree
  
@@ -143,9 +163,11 @@
  
  -- | A 'Plated' type is one where we know how to extract its immediate self-similar children.
  --
---- a/src/Control/Lens/Prism.hs
-+++ b/src/Control/Lens/Prism.hs
-@@ -59,7 +59,9 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Prism.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Prism.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Prism.hs
+@@ -59,7 +59,9 @@ import Unsafe.Coerce
  import Data.Profunctor.Unsafe
  #endif
  
@@ -155,9 +177,11 @@
  
  -- $setup
  -- >>> :set -XNoOverloadedStrings
---- a/src/Control/Lens/Setter.hs
-+++ b/src/Control/Lens/Setter.hs
-@@ -91,9 +91,11 @@
+Index: haskell-lens-4.1.2/src/Control/Lens/Setter.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Setter.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Setter.hs
+@@ -91,9 +91,11 @@ import Data.Profunctor
  import Data.Profunctor.Rep
  import Data.Profunctor.Unsafe
  
@@ -169,14 +193,16 @@
  
  -- $setup
  -- >>> import Control.Lens
---- a/src/Control/Monad/Primitive/Lens.hs
-+++ b/src/Control/Monad/Primitive/Lens.hs
+Index: haskell-lens-4.1.2/src/Control/Monad/Primitive/Lens.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Monad/Primitive/Lens.hs
++++ haskell-lens-4.1.2/src/Control/Monad/Primitive/Lens.hs
 @@ -1,3 +1,4 @@
 +{-# LANGUAGE CPP #-}
  {-# LANGUAGE MagicHash #-}
  {-# LANGUAGE UnboxedTuples #-}
  {-# LANGUAGE TypeFamilies #-}
-@@ -20,7 +21,9 @@
+@@ -20,7 +21,9 @@ import Control.Lens
  import Control.Monad.Primitive (PrimMonad(..))
  import GHC.Prim (State#)
  
@@ -186,9 +212,11 @@
  
  prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
  prim = iso internal primitive
---- a/src/Data/Data/Lens.hs
-+++ b/src/Data/Data/Lens.hs
-@@ -65,12 +65,14 @@
+Index: haskell-lens-4.1.2/src/Data/Data/Lens.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Data/Data/Lens.hs
++++ haskell-lens-4.1.2/src/Data/Data/Lens.hs
+@@ -65,12 +65,14 @@ import           Data.IORef
  import           Data.Monoid
  import           GHC.Exts (realWorld#)
  
@@ -203,3 +231,17 @@
  
  -- $setup
  -- >>> :set -XNoOverloadedStrings
+Index: haskell-lens-4.1.2/src/Control/Lens/Internal/Reflection.hs
+===================================================================
+--- haskell-lens-4.1.2.orig/src/Control/Lens/Internal/Reflection.hs
++++ haskell-lens-4.1.2/src/Control/Lens/Internal/Reflection.hs
+@@ -64,7 +64,9 @@ import Data.Word
+ import Data.Typeable
+ import Data.Reflection
+ 
++#ifndef DISABLE_TEMPLATE_HASKELL
+ {-# ANN module "HLint: ignore Avoid lambda" #-}
++#endif
+ 
+ class Typeable s => B s where
+   reflectByte :: proxy s -> IntPtr
diff -rN -u old-haskell-lens/patches/no-transformers-compat.diff new-haskell-lens/patches/no-transformers-compat.diff
--- old-haskell-lens/patches/no-transformers-compat.diff	2014-05-13 21:36:51.359543692 +0000
+++ new-haskell-lens/patches/no-transformers-compat.diff	2014-05-13 21:36:51.371543702 +0000
@@ -1,6 +1,8 @@
---- a/lens.cabal
-+++ b/lens.cabal
-@@ -213,7 +213,6 @@
+Index: haskell-lens-4.1.2/lens.cabal
+===================================================================
+--- haskell-lens-4.1.2.orig/lens.cabal
++++ haskell-lens-4.1.2/lens.cabal
+@@ -209,7 +209,6 @@ library
      template-haskell          >= 2.4      && < 2.11,
      text                      >= 0.11     && < 1.2,
      transformers              >= 0.2      && < 0.4,
diff -rN -u old-haskell-lens/patches/series new-haskell-lens/patches/series
--- old-haskell-lens/patches/series	2014-05-13 21:36:51.359543692 +0000
+++ new-haskell-lens/patches/series	2014-05-13 21:36:51.375543706 +0000
@@ -1,7 +1,7 @@
+no-transformers-compat.diff
 add-without-th-flag.patch
 guard-ANNotations.patch
 fix-doctest-path.hs
 fudge-doctest-nonascii.diff
 no-transformers-compat.diff
 disable-reflection.patch
-backport-testsuite-failure-fi[...incomplete...]



More information about the Pkg-haskell-commits mailing list