diff --git a/patches/dbus-1.2.13.patch b/patches/dbus-1.2.13.patch deleted file mode 100644 index 76eefba067748239676d78cacbd257542f5941bd..0000000000000000000000000000000000000000 --- a/patches/dbus-1.2.13.patch +++ /dev/null @@ -1,42 +0,0 @@ -diff --git a/lib/DBus/Generation.hs b/lib/DBus/Generation.hs -index 47167b2..63fee50 100644 ---- a/lib/DBus/Generation.hs -+++ b/lib/DBus/Generation.hs -@@ -1,3 +1,4 @@ -+{-# LANGUAGE CPP #-} - {-# LANGUAGE OverloadedStrings #-} - {-# LANGUAGE TemplateHaskell #-} - module DBus.Generation where -@@ -149,6 +150,12 @@ mapOrHead outputLength fn names cons = - 1 -> fn $ head names - _ -> cons $ map fn names - -+tupEJust :: [Exp] -> Exp -+tupEJust = TupE -+#if MIN_VERSION_template_haskell(2,16,0) -+ . map Just -+#endif -+ - runGetFirst :: [Maybe a] -> Maybe a - runGetFirst options = getFirst $ mconcat $ map First options - -@@ -232,8 +239,8 @@ generateClientMethod GenerationParams - finalOutputNames <- buildOutputNames - let variantListExp = map makeToVariantApp methodArgNames - mapOrHead' = mapOrHead outputLength -- fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames TupE -- finalResultTuple = mapOrHead' VarE finalOutputNames TupE -+ fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames tupEJust -+ finalResultTuple = mapOrHead' VarE finalOutputNames tupEJust - maybeExtractionPattern = mapOrHead' makeJustPattern finalOutputNames TupP - getMethodCallDefDec = [d| - $( varP methodCallDefN ) = -@@ -432,7 +439,7 @@ generateSignal GenerationParams - } - |] - let mapOrHead' = mapOrHead argCount -- fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames TupE -+ fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames tupEJust - maybeExtractionPattern = mapOrHead' makeJustPattern toHandlerOutputNames TupP - applyToName toApply n = AppE toApply $ VarE n - finalApplication = foldl applyToName (VarE handlerArgN) diff --git a/patches/product-profunctors-0.10.0.0.patch b/patches/product-profunctors-0.10.0.0.patch deleted file mode 100644 index 2dfdf7dfe47d36357a650b40d2ce9791c2362c5f..0000000000000000000000000000000000000000 --- a/patches/product-profunctors-0.10.0.0.patch +++ /dev/null @@ -1,64 +0,0 @@ -diff --git a/Data/Profunctor/Product/Internal/TH.hs b/Data/Profunctor/Product/Internal/TH.hs -index 0407ab7..d1c53b7 100644 ---- a/Data/Profunctor/Product/Internal/TH.hs -+++ b/Data/Profunctor/Product/Internal/TH.hs -@@ -315,13 +315,19 @@ xTuple patCon retCon (funN, numTyVars) = FunD funN [clause] - - fromTuple :: Name -> (Name, Int) -> Dec - fromTuple conName = xTuple patCon retCon -- where patCon = TupP -+ where patCon [p] = p -+ patCon ps = TupP ps - retCon = appEAll (ConE conName) - - toTuple :: Name -> (Name, Int) -> Dec - toTuple conName = xTuple patCon retCon - where patCon = ConP conName -- retCon = TupE -+ retCon [e] = e -+ retCon es = TupE -+#if MIN_VERSION_template_haskell(2,16,0) -+ $ map Just -+#endif -+ es - - {- - Note that we can also do the instance definition like this, but it would -diff --git a/Data/Profunctor/Product/Tuples/TH.hs b/Data/Profunctor/Product/Tuples/TH.hs -index c13b5d3..bb308a1 100644 ---- a/Data/Profunctor/Product/Tuples/TH.hs -+++ b/Data/Profunctor/Product/Tuples/TH.hs -@@ -129,7 +129,8 @@ pN n = sequence [sig, fun] - 1 -> mkPT (head as) (head bs) - _ -> foldl appT (tupleT n) (zipWith mkPT as bs) - mkRightTy = varT p `appT` mkTupT as `appT` mkTupT bs -- mkTupT = foldl appT (tupleT n) . map varT -+ mkTupT [v] = varT v -+ mkTupT vs = foldl appT (tupleT n) $ map varT vs - mkPT a b = varT p `appT` varT a `appT` varT b - fun = funD nm [ clause [] (normalB bdy) [] ] - bdy = varE 'convert `appE` unflat `appE` unflat `appE` flat `appE` pT -diff --git a/product-profunctors.cabal b/product-profunctors.cabal -index 3293c20..01c15a6 100644 ---- a/product-profunctors.cabal -+++ b/product-profunctors.cabal -@@ -1,6 +1,7 @@ - name: product-profunctors - copyright: Copyright (c) 2013, Karamaan Group LLC; 2014-2018 Purely Agile Limited - version: 0.10.0.0 -+x-revision: 3 - synopsis: product-profunctors - description: Product profunctors - homepage: https://github.com/tomjaguarpaw/product-profunctors -@@ -24,9 +25,9 @@ source-repository head - library - default-language: Haskell2010 - build-depends: base >= 4.5 && < 5 -- , profunctors >= 5 && < 5.3 -+ , profunctors >= 5 && < 5.6 - , bifunctors >= 5.4 && < 6.0 -- , contravariant >= 0.4 && < 1.5 -+ , contravariant >= 0.4 && < 1.6 - , tagged >= 0.0 && < 1 - , template-haskell - exposed-modules: Data.Profunctor.Product,