From f6f537ce3c61eb2e33adb4993b5bffb07fcf60b9 Mon Sep 17 00:00:00 2001 From: Ryan Scott <ryan.gl.scott@gmail.com> Date: Thu, 29 Sep 2022 08:00:55 -0400 Subject: [PATCH] Remove unneeded Hackage patches This includes `proto3-wire`, which now compiles on HEAD by virtue of `word-compat-0.0.6` exporting compatibility shims for `Word64`/`W64#`. --- patches/EdisonAPI-1.3.1.patch | 56 -- patches/EdisonCore-1.3.2.1.patch | 1050 --------------------- patches/cborg-0.2.7.0.patch | 182 ---- patches/fgl-5.7.0.3.patch | 48 - patches/free-algebras-0.1.0.1.patch | 28 - patches/primitive-unaligned-0.1.1.1.patch | 90 -- patches/proto3-wire-1.4.0.patch | 55 -- patches/unix-time-0.4.7.patch | 196 ---- patches/yesod-1.6.2.patch | 14 - 9 files changed, 1719 deletions(-) delete mode 100644 patches/EdisonAPI-1.3.1.patch delete mode 100644 patches/EdisonCore-1.3.2.1.patch delete mode 100644 patches/cborg-0.2.7.0.patch delete mode 100644 patches/fgl-5.7.0.3.patch delete mode 100644 patches/free-algebras-0.1.0.1.patch delete mode 100644 patches/primitive-unaligned-0.1.1.1.patch delete mode 100644 patches/proto3-wire-1.4.0.patch delete mode 100644 patches/unix-time-0.4.7.patch delete mode 100644 patches/yesod-1.6.2.patch diff --git a/patches/EdisonAPI-1.3.1.patch b/patches/EdisonAPI-1.3.1.patch deleted file mode 100644 index 51eb1f59..00000000 --- a/patches/EdisonAPI-1.3.1.patch +++ /dev/null @@ -1,56 +0,0 @@ -diff --git a/src/Data/Edison/Seq/ListSeq.hs b/src/Data/Edison/Seq/ListSeq.hs -index 1ad677f..f782022 100644 ---- a/src/Data/Edison/Seq/ListSeq.hs -+++ b/src/Data/Edison/Seq/ListSeq.hs -@@ -131,25 +131,25 @@ lcons = (:) - rcons x s = s ++ [x] - append = (++) - --lview [] = fail "ListSeq.lview: empty sequence" -+lview [] = error "ListSeq.lview: empty sequence" - lview (x:xs) = return (x, xs) - --lheadM [] = fail "ListSeq.lheadM: empty sequence" -+lheadM [] = error "ListSeq.lheadM: empty sequence" - lheadM (x:xs) = return x - - lhead [] = error "ListSeq.lhead: empty sequence" - lhead (x:xs) = x - --ltailM [] = fail "ListSeq.ltailM: empty sequence" -+ltailM [] = error "ListSeq.ltailM: empty sequence" - ltailM (x:xs) = return xs - - ltail [] = error "ListSeq.ltail: empty sequence" - ltail (x:xs) = xs - --rview [] = fail "ListSeq.rview: empty sequence" -+rview [] = error "ListSeq.rview: empty sequence" - rview xs = return (rhead xs, rtail xs) - --rheadM [] = fail "ListSeq.rheadM: empty sequence" -+rheadM [] = error "ListSeq.rheadM: empty sequence" - rheadM (x:xs) = rh x xs - where rh y [] = return y - rh y (x:xs) = rh x xs -@@ -159,7 +159,7 @@ rhead (x:xs) = rh x xs - where rh y [] = y - rh y (x:xs) = rh x xs - --rtailM [] = fail "ListSeq.rtailM: empty sequence" -+rtailM [] = error "ListSeq.rtailM: empty sequence" - rtailM (x:xs) = return (rt x xs) - where rt y [] = [] - rt y (x:xs) = y : rt x xs -@@ -255,9 +255,9 @@ inBounds i xs - lookup i xs = ID.runIdentity (lookupM i xs) - - lookupM i xs -- | i < 0 = fail "ListSeq.lookup: not found" -+ | i < 0 = error "ListSeq.lookup: not found" - | otherwise = case drop i xs of -- [] -> fail "ListSeq.lookup: not found" -+ [] -> error "ListSeq.lookup: not found" - (x:_) -> return x - - lookupWithDefault d i xs diff --git a/patches/EdisonCore-1.3.2.1.patch b/patches/EdisonCore-1.3.2.1.patch deleted file mode 100644 index 308a1fe1..00000000 --- a/patches/EdisonCore-1.3.2.1.patch +++ /dev/null @@ -1,1050 +0,0 @@ -diff --git a/src/Data/Edison/Assoc/AssocList.hs b/src/Data/Edison/Assoc/AssocList.hs -index c577492..10e7797 100644 ---- a/src/Data/Edison/Assoc/AssocList.hs -+++ b/src/Data/Edison/Assoc/AssocList.hs -@@ -311,7 +311,7 @@ count key (I k _ m) | key == k = 1 - - lookup key m = runIdentity (lookupM key m) - --lookupM _ E = fail "AssocList.lookup: lookup failed" -+lookupM _ E = error "AssocList.lookup: lookup failed" - lookupM key (I k x m) | key == k = return x - | otherwise = lookupM key m - -@@ -321,7 +321,7 @@ lookupAll key (I k x m) | key == k = S.singleton x - - lookupAndDelete key m = runIdentity (lookupAndDeleteM key m) - --lookupAndDeleteM _ E = fail "AssocList.lookupAndDeleteM: lookup failed" -+lookupAndDeleteM _ E = error "AssocList.lookupAndDeleteM: lookup failed" - lookupAndDeleteM key (I k x m) - | key == k = return (x,delete k m) - | otherwise = lookupAndDeleteM key m >>= -@@ -424,7 +424,7 @@ findMax k0 a0 (I k a m) - | k > k0 = findMax k a (delete k m) - | otherwise = findMax k0 a0 (delete k m) - --minView E = fail (moduleName++".minView: empty map") -+minView E = error (moduleName++".minView: empty map") - minView n@(I k a m) = let (k',x) = findMin k a m in return (x,delete k' n) - - minElem E = error (moduleName++".minElem: empty map") -@@ -435,7 +435,7 @@ deleteMin n@(I k a m) = let (k',_) = findMin k a m in delete k' n - - unsafeInsertMin = insert - --maxView E = fail (moduleName++".maxView: empty map") -+maxView E = error (moduleName++".maxView: empty map") - maxView n@(I k a m) = let (k',x) = findMax k a m in return (x,delete k' n) - - maxElem E = error (moduleName++".maxElem: empty map") -@@ -482,13 +482,13 @@ partitionLT_GE k = spanFM (<k) . mergeSortFM - partitionLE_GT k = spanFM (<=k) . mergeSortFM - partitionLT_GT k = (\(x,y) -> (x,delete k y)) . spanFM (<k) . mergeSortFM - --minViewWithKey E = fail $ moduleName++".minViewWithKey: empty map" -+minViewWithKey E = error $ moduleName++".minViewWithKey: empty map" - minViewWithKey n@(I k a m) = let (k',x) = findMin k a m in return ((k',x),delete k' n) - - minElemWithKey E = error $ moduleName++".minElemWithKey: empty map" - minElemWithKey (I k a m) = findMin k a m - --maxViewWithKey E = fail $ moduleName++".maxViewWithKey: empty map" -+maxViewWithKey E = error $ moduleName++".maxViewWithKey: empty map" - maxViewWithKey n@(I k a m) = let (k',x) = findMax k a m in return ((k',x),delete k' n) - - maxElemWithKey E = error $ moduleName++".maxElemWithKey: empty map" -diff --git a/src/Data/Edison/Assoc/Defaults.hs b/src/Data/Edison/Assoc/Defaults.hs -index a9ef520..a682f64 100644 ---- a/src/Data/Edison/Assoc/Defaults.hs -+++ b/src/Data/Edison/Assoc/Defaults.hs -@@ -193,7 +193,7 @@ lookupAndDeleteDefault k m = - lookupAndDeleteMDefault :: (Monad rm, AssocX m k) => k -> m a -> rm (a, m a) - lookupAndDeleteMDefault k m = - case lookupM k m of -- Nothing -> fail (instanceName m ++ ".lookupAndDelete: lookup failed") -+ Nothing -> error (instanceName m ++ ".lookupAndDelete: lookup failed") - Just x -> return (x, delete k m) - - lookupAndDeleteAllDefault :: (S.Sequence seq, AssocX m k) => k -> m a -> (seq a,m a) -diff --git a/src/Data/Edison/Assoc/PatriciaLoMap.hs b/src/Data/Edison/Assoc/PatriciaLoMap.hs -index 3073f83..3ca5a65 100644 ---- a/src/Data/Edison/Assoc/PatriciaLoMap.hs -+++ b/src/Data/Edison/Assoc/PatriciaLoMap.hs -@@ -213,10 +213,10 @@ lookup :: Int -> FM a -> a - lookup k m = runIdentity (lookupM k m) - - lookupM :: (Monad rm) => Int -> FM a -> rm a --lookupM _ E = fail "PatriciaLoMap.lookup: lookup failed" -+lookupM _ E = error "PatriciaLoMap.lookup: lookup failed" - lookupM k (L j x) - | j == k = return x -- | otherwise = fail "PatriciaLoMap.lookup: lookup failed" -+ | otherwise = error "PatriciaLoMap.lookup: lookup failed" - lookupM k (B _ m t0 t1) = if zeroBit k m then lookupM k t0 else lookupM k t1 - - doLookupAndDelete :: z -> (a -> FM a -> z) -> Int -> FM a -> z -@@ -235,7 +235,7 @@ lookupAndDelete = doLookupAndDelete - - lookupAndDeleteM :: Monad m => Int -> FM a -> m (a, FM a) - lookupAndDeleteM = doLookupAndDelete -- (fail "PatriciaLoMap.lookupAndDelete: lookup failed") -+ (error "PatriciaLoMap.lookupAndDelete: lookup failed") - (\x m -> return (x,m)) - - lookupAndDeleteAll :: S.Sequence seq => Int -> FM a -> (seq a,FM a) -@@ -586,25 +586,25 @@ ordListFM_rev (B _ _ t0 t1) = merge (ordListFM_rev t0) (ordListFM_rev t1) - minView :: Monad m => FM a -> m (a, FM a) - minView fm = - case ordListFM fm of -- [] -> fail $ moduleName++".minView: empty map" -+ [] -> error $ moduleName++".minView: empty map" - ((k,x):_) -> return (x,delete k fm) - - minViewWithKey :: Monad m => FM a -> m ((Int, a), FM a) - minViewWithKey fm = - case ordListFM fm of -- [] -> fail $ moduleName++".minViewWithKey: empty map" -+ [] -> error $ moduleName++".minViewWithKey: empty map" - ((k,x):_) -> return ((k,x),delete k fm) - - maxView :: Monad m => FM a -> m (a, FM a) - maxView fm = - case ordListFM_rev fm of -- [] -> fail $ moduleName++".maxView: empty map" -+ [] -> error $ moduleName++".maxView: empty map" - ((k,x):_) -> return (x,delete k fm) - - maxViewWithKey :: Monad m => FM a -> m ((Int, a), FM a) - maxViewWithKey fm = - case ordListFM_rev fm of -- [] -> fail $ moduleName++".maxViewWithKey: empty map" -+ [] -> error $ moduleName++".maxViewWithKey: empty map" - ((k,x):_) -> return ((k,x),delete k fm) - - minElem :: FM a -> a -diff --git a/src/Data/Edison/Assoc/StandardMap.hs b/src/Data/Edison/Assoc/StandardMap.hs -index 5ca48c5..2446473 100644 ---- a/src/Data/Edison/Assoc/StandardMap.hs -+++ b/src/Data/Edison/Assoc/StandardMap.hs -@@ -199,7 +199,7 @@ size = DM.size - member = DM.member - count = countUsingMember - lookup k m = maybe (error (moduleName ++ ".lookup: failed")) id (DM.lookup k m) --lookupM k m = maybe (fail (moduleName ++ ".lookupM: failed")) return (DM.lookup k m) -+lookupM k m = maybe (error (moduleName ++ ".lookupM: failed")) return (DM.lookup k m) - lookupAll = lookupAllUsingLookupM - lookupWithDefault = DM.findWithDefault - lookupAndDelete = lookupAndDeleteDefault -@@ -223,14 +223,14 @@ partition = DM.partition - elements = elementsUsingFold - - minView m = if DM.null m -- then fail (moduleName ++ ".minView: failed") -+ then error (moduleName ++ ".minView: failed") - else let ((_,x),m') = DM.deleteFindMin m - in return (x,m') - minElem = snd . DM.findMin - deleteMin = DM.deleteMin - unsafeInsertMin = DM.insert - maxView m = if DM.null m -- then fail (moduleName ++ ".maxView: failed") -+ then error (moduleName ++ ".maxView: failed") - else let ((_,x),m') = DM.deleteFindMax m - in return (x,m') - maxElem = snd . DM.findMax -@@ -283,11 +283,11 @@ filterWithKey = DM.filterWithKey - partitionWithKey = DM.partitionWithKey - - minViewWithKey m = if DM.null m -- then fail (moduleName ++ ".minViewWithKey: failed") -+ then error (moduleName ++ ".minViewWithKey: failed") - else return (DM.deleteFindMin m) - minElemWithKey = DM.findMin - maxViewWithKey m = if DM.null m -- then fail (moduleName ++ ".maxViewWithKey: failed") -+ then error (moduleName ++ ".maxViewWithKey: failed") - else return (DM.deleteFindMax m) - maxElemWithKey = DM.findMax - foldrWithKey = DM.foldrWithKey -diff --git a/src/Data/Edison/Assoc/TernaryTrie.hs b/src/Data/Edison/Assoc/TernaryTrie.hs -index 8b2dd57..8e85bbc 100644 ---- a/src/Data/Edison/Assoc/TernaryTrie.hs -+++ b/src/Data/Edison/Assoc/TernaryTrie.hs -@@ -530,12 +530,12 @@ count = countUsingMember - lookup m k = runIdentity (lookupM m k) - - lookupM [] (FM Nothing _) -- = fail "TernaryTrie.lookup: lookup failed" -+ = error "TernaryTrie.lookup: lookup failed" - lookupM [] (FM (Just v) _) - = return v - lookupM xs (FM _ fmb) - = case lookupFMB xs fmb of -- Nothing -> fail "TernaryTrie.lookup: lookup failed" -+ Nothing -> error "TernaryTrie.lookup: lookup failed" - Just v -> return v - - lookupAll = lookupAllUsingLookupM -@@ -547,7 +547,7 @@ lookupAndDelete = - - lookupAndDeleteM = - lookupAndDelFromFM -- (fail "TernaryTrie.lookupAndDeleteM: lookup failed") -+ (error "TernaryTrie.lookupAndDeleteM: lookup failed") - (\w m -> return (w,m)) - - lookupAndDeleteAll k m = -@@ -855,7 +855,7 @@ intersectionWithKey f - -- OrdAssocX - - minViewFMB :: Monad m => FMB k a -> (FMB k a -> FM k a) -> m (a, FM k a) --minViewFMB E _ = fail $ moduleName++".minView: empty map" -+minViewFMB E _ = error $ moduleName++".minView: empty map" - minViewFMB (I i k (Just v) E m r) f = return (v, f (I i k Nothing E m r)) - minViewFMB (I _ _ Nothing E (FMB' E) _) _ = error $ moduleName++".minView: bug!" - minViewFMB (I _ k Nothing E (FMB' m) r) f = minViewFMB m (\m' -> f (mkVBalancedFMB k Nothing E (FMB' m') r)) -@@ -866,7 +866,7 @@ minView (FM (Just v) fmb) = return (v, FM Nothing fmb) - minView (FM Nothing fmb) = minViewFMB fmb (FM Nothing) - - minViewWithKeyFMB :: Monad m => FMB k a -> ([k] -> [k]) -> (FMB k a -> FM k a) -> m (([k],a),FM k a) --minViewWithKeyFMB E _ _ = fail $ moduleName++".minView: empty map" -+minViewWithKeyFMB E _ _ = error $ moduleName++".minView: empty map" - minViewWithKeyFMB (I i k (Just v) E m r) kf f = return ((kf [k],v),f (I i k Nothing E m r)) - minViewWithKeyFMB (I _ _ Nothing E (FMB' E) _) _ _ = error $ moduleName++".minViewWithKey: bug!" - minViewWithKeyFMB (I _ k Nothing E (FMB' m) r) kf f = minViewWithKeyFMB m (kf . (k:)) -@@ -915,7 +915,7 @@ maxViewFMB (I _ k mv l m r) f = maxViewFMB r (\r' -> f (mkVBalanced - maxViewFMB E _ = error $ moduleName++".maxView: bug!" - - maxView :: Monad m => FM k a -> m (a, FM k a) --maxView (FM Nothing E) = fail $ moduleName++".maxView: empty map" -+maxView (FM Nothing E) = error $ moduleName++".maxView: empty map" - maxView (FM (Just v) E) = return (v,FM Nothing E) - maxView (FM mv fmb) = maxViewFMB fmb (FM mv) - -@@ -931,7 +931,7 @@ maxViewWithKeyFMB E _ _ = error $ moduleName++".maxV - - - maxViewWithKey :: Monad m => FM k a -> m (([k],a), FM k a) --maxViewWithKey (FM Nothing E) = fail $ moduleName++".maxViewWithKey: empty map" -+maxViewWithKey (FM Nothing E) = error $ moduleName++".maxViewWithKey: empty map" - maxViewWithKey (FM (Just v) E) = return (([],v),FM Nothing E) - maxViewWithKey (FM mv fmb) = maxViewWithKeyFMB fmb id (FM mv) - -diff --git a/src/Data/Edison/Coll/Defaults.hs b/src/Data/Edison/Coll/Defaults.hs -index 213ed36..5b9288f 100644 ---- a/src/Data/Edison/Coll/Defaults.hs -+++ b/src/Data/Edison/Coll/Defaults.hs -@@ -89,7 +89,7 @@ intersectWitnessUsingToOrdList as bs = witness (toOrdList as) (toOrdList bs) - EQ -> return (x, y) - GT -> witness a ys - -- XXX -- witness _ _ = fail $ instanceName as ++ ".intersect: failed" -+ witness _ _ = error $ instanceName as ++ ".intersect: failed" - - lookupUsingLookupM :: Coll c a => a -> c -> a - lookupUsingLookupM x ys = runIdentity (lookupM x ys) -@@ -104,7 +104,7 @@ lookupMUsingLookupAll :: (Coll c a, Monad m) => a -> c -> m a - lookupMUsingLookupAll x ys = - case lookupAll x ys of - (y:_) -> return y -- [] -> fail $ instanceName ys ++ ".lookupM: lookup failed" -+ [] -> error $ instanceName ys ++ ".lookupM: lookup failed" - - lookupWithDefaultUsingLookupAll :: Coll c a => a -> a -> c -> a - lookupWithDefaultUsingLookupAll dflt x ys = -diff --git a/src/Data/Edison/Coll/EnumSet.hs b/src/Data/Edison/Coll/EnumSet.hs -index c93ab07..a2f00ea 100644 ---- a/src/Data/Edison/Coll/EnumSet.hs -+++ b/src/Data/Edison/Coll/EnumSet.hs -@@ -254,7 +254,7 @@ lookup = lookupUsingLookupAll - lookupM :: (Eq a, Enum a, Monad m) => a -> Set a -> m a - lookupM x s - | member x s = return x -- | otherwise = fail (moduleName++".lookupM: lookup failed") -+ | otherwise = error (moduleName++".lookupM: lookup failed") - - lookupAll :: (Eq a, Enum a, S.Sequence s) => a -> Set a -> s a - lookupAll = lookupAllUsingLookupM -@@ -342,12 +342,12 @@ deleteMax (Set w) - - minView :: (Enum a, Monad m) => Set a -> m (a, Set a) - minView (Set w) -- | w == 0 = fail (moduleName++".minView: empty set") -+ | w == 0 = error (moduleName++".minView: empty set") - | otherwise = let i = lsb w in return (toEnum i,Set $ clearBit w i) - - maxView :: (Enum a, Monad m) => Set a -> m (a, Set a) - maxView (Set w) -- | w == 0 = fail (moduleName++".maxView: empty set") -+ | w == 0 = error (moduleName++".maxView: empty set") - | otherwise = let i = msb w in return (toEnum i, Set $ clearBit w i) - - unsafeInsertMin :: (Ord a, Enum a) => a -> Set a -> Set a -diff --git a/src/Data/Edison/Coll/LazyPairingHeap.hs b/src/Data/Edison/Coll/LazyPairingHeap.hs -index e41ce2e..be0db61 100644 ---- a/src/Data/Edison/Coll/LazyPairingHeap.hs -+++ b/src/Data/Edison/Coll/LazyPairingHeap.hs -@@ -360,7 +360,7 @@ lookupAll y h = look h S.empty - GT -> rest - - minView :: (Ord a, Monad m) => Heap a -> m (a, Heap a) --minView E = fail "LazyPairingHeap.minView: empty heap" -+minView E = error "LazyPairingHeap.minView: empty heap" - minView (H1 x xs) = return (x,xs) - minView (H2 x h xs) = return (x,union h xs) - -@@ -370,7 +370,7 @@ minElem (H1 x _) = x - minElem (H2 x _ _) = x - - maxView :: (Ord a, Monad m) => Heap a -> m (a, Heap a) --maxView E = fail "LazyPairingHeap.maxView: empty heap" -+maxView E = error "LazyPairingHeap.maxView: empty heap" - maxView xs = return (y,xs') - where (xs', y) = maxView' xs - -diff --git a/src/Data/Edison/Coll/LeftistHeap.hs b/src/Data/Edison/Coll/LeftistHeap.hs -index 751394b..3508173 100644 ---- a/src/Data/Edison/Coll/LeftistHeap.hs -+++ b/src/Data/Edison/Coll/LeftistHeap.hs -@@ -174,13 +174,13 @@ toSeq h = tol h S.empty - tol (L _ x a b) rest = S.lcons x (tol b (tol a rest)) - - lookupM :: (Ord a, Monad m) => a -> Heap a -> m a --lookupM _ E = fail "LeftistHeap.lookupM: XXX" -+lookupM _ E = error "LeftistHeap.lookupM: XXX" - lookupM x (L _ y a b) = - case compare x y of -- LT -> fail "LeftistHeap.lookupM: XXX" -+ LT -> error "LeftistHeap.lookupM: XXX" - EQ -> return y - GT -> case lookupM x b `mplus` lookupM x a of -- Nothing -> fail "LeftistHeap.lookupM: XXX" -+ Nothing -> error "LeftistHeap.lookupM: XXX" - Just q -> return q - - lookupAll :: (Ord a,S.Sequence seq) => a -> Heap a -> seq a -@@ -300,7 +300,7 @@ partitionLT_GT y h = (h', C.unionList hs) - in (node x a' b', hs'') - - minView :: (Ord a, Monad m) => Heap a -> m (a, Heap a) --minView E = fail "LeftistHeap.minView: empty collection" -+minView E = error "LeftistHeap.minView: empty collection" - minView (L _ x a b) = return (x, union a b) - - minElem :: Ord a => Heap a -> a -@@ -308,7 +308,7 @@ minElem E = error "LeftistHeap.minElem: empty collection" - minElem (L _ x _ _) = x - - maxView :: (Ord a, Monad m) => Heap a -> m (a, Heap a) --maxView E = fail "LeftistHeap.maxView: empty collection" -+maxView E = error "LeftistHeap.maxView: empty collection" - maxView (L _ x E _) = return (x, E) - maxView (L _ x a E) = return (y, L 1 x a' E) - where Just (y,a') = maxView a -diff --git a/src/Data/Edison/Coll/MinHeap.hs b/src/Data/Edison/Coll/MinHeap.hs -index ba38960..5781792 100644 ---- a/src/Data/Edison/Coll/MinHeap.hs -+++ b/src/Data/Edison/Coll/MinHeap.hs -@@ -201,7 +201,7 @@ lookup _ _ = error "MinHeap.lookup: empty heap" - lookupM x (M y ys) - | x > y = C.lookupM x ys - | x == y = return y --lookupM _ _ = fail "lookupM.lookup: XXX" -+lookupM _ _ = error "lookupM.lookup: XXX" - - lookupAll x (M y ys) - | x > y = C.lookupAll x ys -@@ -286,13 +286,13 @@ partitionLT_GT x (M y ys) - partitionLT_GT _ h = (E, h) - - --minView E = fail "MinHeap.minView: empty heap" -+minView E = error "MinHeap.minView: empty heap" - minView (M x xs) = return (x, fromPrim xs) - - minElem E = error "MinHeap.minElem: empty heap" - minElem (M x _) = x - --maxView E = fail "MinHeap.maxView: empty heap" -+maxView E = error "MinHeap.maxView: empty heap" - maxView (M x xs) = case C.maxView xs of - Nothing -> return (x, E) - Just (y,ys) -> return (y, M x ys) -diff --git a/src/Data/Edison/Coll/SkewHeap.hs b/src/Data/Edison/Coll/SkewHeap.hs -index 1a05ebe..4fb5982 100644 ---- a/src/Data/Edison/Coll/SkewHeap.hs -+++ b/src/Data/Edison/Coll/SkewHeap.hs -@@ -143,13 +143,13 @@ toSeq h = tol h S.empty - tol (T x a b) rest = S.lcons x (tol b (tol a rest)) - - lookupM :: (Ord a, Monad m) => a -> Heap a -> m a --lookupM _ E = fail "SkewHeap.lookupM: XXX" -+lookupM _ E = error "SkewHeap.lookupM: XXX" - lookupM x (T y a b) = - case compare x y of -- LT -> fail "SkewHeap.lookupM: XXX" -+ LT -> error "SkewHeap.lookupM: XXX" - EQ -> return y - GT -> case lookupM x b `mplus` lookupM x a of -- Nothing -> fail "SkewHeap.lookupM: XXX" -+ Nothing -> error "SkewHeap.lookupM: XXX" - Just x -> return x - - lookupAll :: (Ord a,S.Sequence seq) => a -> Heap a -> seq a -@@ -268,7 +268,7 @@ partitionLT_GT y h = (h', C.unionList hs) - in (T x a' b', hs'') - - minView :: (Ord a, Monad m) => Heap a -> m (a, Heap a) --minView E = fail "SkewHeap.minView: empty heap" -+minView E = error "SkewHeap.minView: empty heap" - minView (T x a b) = return (x, union a b) - - minElem :: Ord a => Heap a -> a -@@ -276,7 +276,7 @@ minElem E = error "SkewHeap.minElem: empty collection" - minElem (T x _ _) = x - - maxView :: (Ord a, Monad m) => Heap a -> m (a, Heap a) --maxView E = fail "SkewHeap.maxView: empty heap" -+maxView E = error "SkewHeap.maxView: empty heap" - maxView (T x E E) = return (x, E) - maxView (T x a E) = return (y, T x a' E) - where Just (y, a') = maxView a -diff --git a/src/Data/Edison/Coll/SplayHeap.hs b/src/Data/Edison/Coll/SplayHeap.hs -index 4e3b061..9ae1783 100644 ---- a/src/Data/Edison/Coll/SplayHeap.hs -+++ b/src/Data/Edison/Coll/SplayHeap.hs -@@ -182,7 +182,7 @@ lookup x (T a y b) - | x > y = lookup x b - | otherwise = y - --lookupM _ E = fail "SplayHeap.lookup: empty heap" -+lookupM _ E = error "SplayHeap.lookup: empty heap" - lookupM x (T a y b) - | x < y = lookupM x a - | x > y = lookupM x b -@@ -354,7 +354,7 @@ partitionLT_GT k t@(T a x b) = - else (T a x (filterLT k ba), filterGT k bb) - else (filterLT k a, filterGT k b) - --minView E = fail "SplayHeap.minView: empty heap" -+minView E = error "SplayHeap.minView: empty heap" - minView (T a x b) = return (y, ys) - where (y,ys) = minv a x b - minv E x b = (x,b) -@@ -368,7 +368,7 @@ minElem (T a x _) = minel a x - minel (T a x _) _ = minel a x - - --maxView E = fail "SplayHeap.maxView: empty heap" -+maxView E = error "SplayHeap.maxView: empty heap" - maxView (T a x b) = return (y,ys) - where (ys,y) = maxv a x b - maxv a x E = (a,x) -diff --git a/src/Data/Edison/Coll/StandardSet.hs b/src/Data/Edison/Coll/StandardSet.hs -index fcaf715..1467cab 100644 ---- a/src/Data/Edison/Coll/StandardSet.hs -+++ b/src/Data/Edison/Coll/StandardSet.hs -@@ -179,12 +179,12 @@ partitionLE_GT x = DS.partition (<=x) - partitionLT_GT = DS.split - - minView set = if DS.null set -- then fail (moduleName ++ ".minView: failed") -+ then error (moduleName ++ ".minView: failed") - else return (DS.deleteFindMin set) - minElem = DS.findMin - - maxView set = if DS.null set -- then fail (moduleName ++ ".maxView: failed") -+ then error (moduleName ++ ".maxView: failed") - else return (DS.deleteFindMax set) - maxElem = DS.findMax - -diff --git a/src/Data/Edison/Coll/UnbalancedSet.hs b/src/Data/Edison/Coll/UnbalancedSet.hs -index 03cb856..59bd721 100644 ---- a/src/Data/Edison/Coll/UnbalancedSet.hs -+++ b/src/Data/Edison/Coll/UnbalancedSet.hs -@@ -179,7 +179,7 @@ member x (T a y b) = - EQ -> True - GT -> member x b - --lookupM _ E = fail "UnbalancedSet.lookupM: XXX" -+lookupM _ E = error "UnbalancedSet.lookupM: XXX" - lookupM x (T a y b) = - case compare x y of - LT -> lookupM x a -@@ -276,7 +276,7 @@ partitionLT_GT y (T a x b) = - GT -> (a0,T a1 x b) - where (a0,a1) = partitionLT_GT y a - --minView E = fail "UnbalancedSet.minView: empty collection" -+minView E = error "UnbalancedSet.minView: empty collection" - minView (T E x b) = return (x, b) - minView (T a x b) = return (y, T a' x b) - where Just (y,a') = minView a -@@ -285,7 +285,7 @@ minElem E = error "UnbalancedSet.minElem: empty collection" - minElem (T E x _) = x - minElem (T a _ _) = minElem a - --maxView E = fail "UnbalancedSet.maxView: empty collection" -+maxView E = error "UnbalancedSet.maxView: empty collection" - maxView (T a x E) = return (x, a) - maxView (T a x b) = return (y, T a x b') - where Just (y, b') = maxView b -diff --git a/src/Data/Edison/Concrete/FingerTree.hs b/src/Data/Edison/Concrete/FingerTree.hs -index 47f766c..3293ce3 100644 ---- a/src/Data/Edison/Concrete/FingerTree.hs -+++ b/src/Data/Edison/Concrete/FingerTree.hs -@@ -335,7 +335,7 @@ null _ = False - - -- | /O(1)/. Analyse the left end of a sequence. - lview :: (Measured v a, Monad m) => FingerTree v a -> m (a,FingerTree v a) --lview Empty = fail "FingerTree.lview: empty tree" -+lview Empty = error "FingerTree.lview: empty tree" - lview (Single x) = return (x, Empty) - lview (Deep _ (One x) m sf) = return . (,) x $ - case lview m of -@@ -358,7 +358,7 @@ ltailDigit _ = error "FingerTree.ltailDigit: bug!" - - -- | /O(1)/. Analyse the right end of a sequence. - rview :: (Measured v a, Monad m) => FingerTree v a -> m (a, FingerTree v a) --rview Empty = fail "FingerTree.rview: empty tree" -+rview Empty = error "FingerTree.rview: empty tree" - rview (Single x) = return (x, Empty) - rview (Deep _ pr m (One x)) = return . (,) x $ - case rview m of -diff --git a/src/Data/Edison/Seq/BankersQueue.hs b/src/Data/Edison/Seq/BankersQueue.hs -index 6dac746..f7f01ab 100644 ---- a/src/Data/Edison/Seq/BankersQueue.hs -+++ b/src/Data/Edison/Seq/BankersQueue.hs -@@ -161,25 +161,25 @@ rcons y (Q i xs ys j) = makeQ i xs (y:ys) (j+1) - append (Q i1 xs1 ys1 j1) (Q i2 xs2 ys2 j2) = - Q (i1 + j1 + i2) (xs1 ++ L.reverseOnto ys1 xs2) ys2 j2 - --lview (Q _ [] _ _) = fail "BankersQueue.lview: empty sequence" -+lview (Q _ [] _ _) = error "BankersQueue.lview: empty sequence" - lview (Q i (x:xs) ys j) = return (x, makeQ (i-1) xs ys j) - - lhead (Q _ [] _ _) = error "BankersQueue.lhead: empty sequence" - lhead (Q _ (x:_) _ _) = x - --lheadM (Q _ [] _ _) = fail "BankersQueue.lheadM: empty sequence" -+lheadM (Q _ [] _ _) = error "BankersQueue.lheadM: empty sequence" - lheadM (Q _ (x:_) _ _) = return x - - ltail (Q i (_:xs) ys j) = makeQ (i-1) xs ys j - ltail _ = error "BankersQueue.ltail: empty sequence" - - ltailM (Q i (_:xs) ys j) = return (makeQ (i-1) xs ys j) --ltailM _ = fail "BankersQueue.ltail: empty sequence" -+ltailM _ = error "BankersQueue.ltail: empty sequence" - - rview (Q i xs (y:ys) j) = return (y, Q i xs ys (j-1)) - rview (Q i xs [] _) = - case L.rview xs of -- Nothing -> fail "BankersQueue.rview: empty sequence" -+ Nothing -> error "BankersQueue.rview: empty sequence" - Just (x,xs') -> return (x, Q (i-1) xs' [] 0) - - rhead (Q _ _ (y:_) _) = y -@@ -187,7 +187,7 @@ rhead (Q _ [] [] _) = error "BankersQueue.rhead: empty sequence" - rhead (Q _ xs [] _) = L.rhead xs - - rheadM (Q _ _ (y:_) _) = return y --rheadM (Q _ [] [] _) = fail "BankersQueue.rheadM: empty sequence" -+rheadM (Q _ [] [] _) = error "BankersQueue.rheadM: empty sequence" - rheadM (Q _ xs [] _) = return (L.rhead xs) - - rtail (Q i xs (_:ys) j) = Q i xs ys (j-1) -@@ -195,7 +195,7 @@ rtail (Q _ [] [] _) = error "BankersQueue.rtail: empty sequence" - rtail (Q i xs [] _) = Q (i-1) (L.rtail xs) [] 0 - - rtailM (Q i xs (_:ys) j) = return (Q i xs ys (j-1)) --rtailM (Q _ [] [] _) = fail "BankersQueue.rtailM: empty sequence" -+rtailM (Q _ [] [] _) = error "BankersQueue.rtailM: empty sequence" - rtailM (Q i xs [] _) = return (Q (i-1) (L.rtail xs) [] 0) - - null (Q i _ _ _) = (i == 0) -diff --git a/src/Data/Edison/Seq/BinaryRandList.hs b/src/Data/Edison/Seq/BinaryRandList.hs -index b01b9b8..2442fe8 100644 ---- a/src/Data/Edison/Seq/BinaryRandList.hs -+++ b/src/Data/Edison/Seq/BinaryRandList.hs -@@ -181,7 +181,7 @@ copy n x - | n == 0 = E - | otherwise = Even (cp (half n) (x,x)) - --lview E = fail "BinaryRandList.lview: empty sequence" -+lview E = error "BinaryRandList.lview: empty sequence" - lview (Even ps) = case lview ps of - Just ((x,y), ps') -> return (x, Odd y ps') - Nothing -> error "BinaryRandList.lview: bug!" -@@ -191,7 +191,7 @@ lhead E = error "BinaryRandList.lhead: empty sequence" - lhead (Even ps) = fst (lhead ps) - lhead (Odd x _) = x - --lheadM E = fail "BinaryRandList.lheadM: empty sequence" -+lheadM E = error "BinaryRandList.lheadM: empty sequence" - lheadM (Even ps) = return (fst (lhead ps)) - lheadM (Odd x _) = return (x) - -@@ -201,7 +201,7 @@ ltail (Even ps) = case lview ps of - Nothing -> error "BinaryRandList.ltail: bug!" - ltail (Odd _ ps) = mkEven ps - --ltailM E = fail "BinaryRandList.ltailM: empty sequence" -+ltailM E = error "BinaryRandList.ltailM: empty sequence" - ltailM (Even ps) = case lview ps of - Just ((_,y), ps') -> return (Odd y ps') - Nothing -> error "BinaryRandList.ltailM: bug!" -@@ -212,7 +212,7 @@ rhead (Even ps) = snd (rhead ps) - rhead (Odd x E) = x - rhead (Odd _ ps) = snd (rhead ps) - --rheadM E = fail "BinaryRandList.rheadM: empty sequence" -+rheadM E = error "BinaryRandList.rheadM: empty sequence" - rheadM (Even ps) = return (snd (rhead ps)) - rheadM (Odd x E) = return x - rheadM (Odd _ ps) = return (snd (rhead ps)) -@@ -270,10 +270,10 @@ inBounds i xs = (i >= 0) && inb xs i - lookup i xs = runIdentity (lookupM i xs) - - lookupM i xs -- | i < 0 = fail "BinaryRandList.lookup: bad subscript" -+ | i < 0 = error "BinaryRandList.lookup: bad subscript" - | otherwise = lookFun nothing xs i return - where -- nothing = fail "BinaryRandList.lookup: not found" -+ nothing = error "BinaryRandList.lookup: not found" - - lookupWithDefault d i xs - | i < 0 = d -diff --git a/src/Data/Edison/Seq/BraunSeq.hs b/src/Data/Edison/Seq/BraunSeq.hs -index 7f6f33b..7d5cc4d 100644 ---- a/src/Data/Edison/Seq/BraunSeq.hs -+++ b/src/Data/Edison/Seq/BraunSeq.hs -@@ -193,7 +193,7 @@ append xs ys = app (size xs) xs ys - app _ _ _ = error "BraunSeq.append: bug!" - -- how does it compare to converting to/from lists? - --lview E = fail "BraunSeq.lview: empty sequence" -+lview E = error "BraunSeq.lview: empty sequence" - lview (B x a b) = return (x, combine a b) - - -- not exported -@@ -204,13 +204,13 @@ combine (B x a b) c = B x c (combine a b) - lhead E = error "BraunSeq.lhead: empty sequence" - lhead (B x _ _) = x - --lheadM E = fail "BraunSeq.lheadM: empty sequence" -+lheadM E = error "BraunSeq.lheadM: empty sequence" - lheadM (B x _ _) = return x - - ltail E = error "BraunSeq.ltail: empty sequence" - ltail (B _ a b) = combine a b - --ltailM E = fail "BraunSeq.ltailM: empty sequence" -+ltailM E = error "BraunSeq.ltailM: empty sequence" - ltailM (B _ a b) = return (combine a b) - - -- not exported -@@ -222,20 +222,20 @@ delAt i (B x a b) - | otherwise = B x a (delAt (half i - 1) b) - delAt _ _ = error "BraunSeq.delAt: bug. Impossible case!" - --rview E = fail "BraunSeq.rview: empty sequence" -+rview E = error "BraunSeq.rview: empty sequence" - rview xs = return (lookup m xs, delAt m xs) - where m = size xs - 1 - - rhead E = error "BraunSeq.rhead: empty sequence" - rhead xs = lookup (size xs - 1) xs - --rheadM E = fail "BraunSeq.rheadM: empty sequence" -+rheadM E = error "BraunSeq.rheadM: empty sequence" - rheadM xs = return (lookup (size xs - 1) xs) - - rtail E = error "BraunSeq.rtail: empty sequence" - rtail xs = delAt (size xs - 1) xs - --rtailM E = fail "BraunSeq.rtailM: empty sequence" -+rtailM E = error "BraunSeq.rtailM: empty sequence" - rtailM xs = return (delAt (size xs - 1) xs) - - null E = True -@@ -347,14 +347,14 @@ inBounds i xs = (i >= 0) && inb xs i - lookup i xs = runIdentity (lookupM i xs) - - lookupM i xs -- | i < 0 = fail "BraunSeq.lookupM: bad subscript" -+ | i < 0 = error "BraunSeq.lookupM: bad subscript" - | otherwise = look xs i - where look E _ = nothing - look (B x a b) i - | odd i = look a (half i) - | i == 0 = return x - | otherwise = look b (half i - 1) -- nothing = fail "BraunSeq.lookupM: not found" -+ nothing = error "BraunSeq.lookupM: not found" - - lookupWithDefault d i xs = if i < 0 then d - else look xs i -diff --git a/src/Data/Edison/Seq/Defaults.hs b/src/Data/Edison/Seq/Defaults.hs -index ed593dc..197f5b8 100644 ---- a/src/Data/Edison/Seq/Defaults.hs -+++ b/src/Data/Edison/Seq/Defaults.hs -@@ -35,7 +35,7 @@ appendUsingFoldr s t | null t = s - - rviewDefault :: (Monad m, Sequence s) => s a -> m (a, s a) - rviewDefault xs -- | null xs = fail $ instanceName xs ++ ".rview: empty sequence" -+ | null xs = error $ instanceName xs ++ ".rview: empty sequence" - | otherwise = return (rhead xs, rtail xs) - - -@@ -52,7 +52,7 @@ rtailUsingLview xs = - rtailMUsingLview :: (Monad m,Sequence s) => s a -> m (s a) - rtailMUsingLview xs = - case lview xs of -- Nothing -> fail $ instanceName xs ++ ".rtailM: empty sequence" -+ Nothing -> error $ instanceName xs ++ ".rtailM: empty sequence" - Just (x, xs) -> return (rt x xs) - where rt x xs = - case lview xs of -@@ -223,7 +223,7 @@ lookupWithDefaultUsingDrop d i s - lookupMUsingDrop :: (Monad m, Sequence s) => Int -> s a -> m a - lookupMUsingDrop i s - -- XXX better error message! -- | i < 0 || null s' = fail $ instanceName s -+ | i < 0 || null s' = error $ instanceName s - ++ ".lookupMUsingDrop: empty sequence" - | otherwise = return (lhead s') - where s' = drop i s -diff --git a/src/Data/Edison/Seq/FingerSeq.hs b/src/Data/Edison/Seq/FingerSeq.hs -index c74c70b..8ecb4ee 100644 ---- a/src/Data/Edison/Seq/FingerSeq.hs -+++ b/src/Data/Edison/Seq/FingerSeq.hs -@@ -46,7 +46,7 @@ import Data.Semigroup as SG - import Test.QuickCheck - - #ifdef __GLASGOW_HASKELL__ --import GHC.Base (unsafeCoerce#) -+import GHC.Exts (unsafeCoerce#) - #endif - - -@@ -243,7 +243,7 @@ lookupM i (Seq xs) - case FT.splitTree (> (SizeM i)) (SizeM 0) xs of - FT.Split _ (Elem x) _ -> return x - -- | otherwise = fail "FingerSeq.lookupM: index out of bounds" -+ | otherwise = error "FingerSeq.lookupM: index out of bounds" - - lookupWithDefault d i (Seq xs) - | inBounds i (Seq xs) = -diff --git a/src/Data/Edison/Seq/JoinList.hs b/src/Data/Edison/Seq/JoinList.hs -index 6922023..76d390f 100644 ---- a/src/Data/Edison/Seq/JoinList.hs -+++ b/src/Data/Edison/Seq/JoinList.hs -@@ -162,7 +162,7 @@ append xs ys = A xs ys - - -- path reversal on lview/ltail - --lview E = fail "JoinList.lview: empty sequence" -+lview E = error "JoinList.lview: empty sequence" - lview (L x) = return (x, E) - lview (A xs ys) = lvw xs ys - where lvw E _ = error "JoinList.lvw: bug" -@@ -173,7 +173,7 @@ lhead E = error "JoinList.lhead: empty sequence" - lhead (L x) = x - lhead (A xs _) = lhead xs - --lheadM E = fail "JoinList.lheadM: empty sequence" -+lheadM E = error "JoinList.lheadM: empty sequence" - lheadM (L x) = return x - lheadM (A xs _) = lheadM xs - -@@ -184,7 +184,7 @@ ltail (A xs ys) = ltl xs ys - ltl (L _) zs = zs - ltl (A xs ys) zs = ltl xs (A ys zs) - --ltailM E = fail "JoinList.ltailM: empty sequence" -+ltailM E = error "JoinList.ltailM: empty sequence" - ltailM (L _) = return E - ltailM (A xs ys) = return (ltl xs ys) - where ltl E _ = error "JoinList.ltl: bug" -@@ -196,7 +196,7 @@ ltailM (A xs ys) = return (ltl xs ys) - -- that left accesses are more common, so we would prefer to keep the left - -- spine short. - --rview E = fail "JoinLis.rview: empty sequence" -+rview E = error "JoinLis.rview: empty sequence" - rview (L x) = return (x, E) - rview (A xs ys) = rvw xs ys - where rvw xs (A ys (A zs s)) = rvw (A xs (A ys zs)) s -@@ -208,7 +208,7 @@ rhead E = error "JoinList.rhead: empty sequence" - rhead (L x) = x - rhead (A _ ys) = rhead ys - --rheadM E = fail "JoinList.rheadM: empty sequence" -+rheadM E = error "JoinList.rheadM: empty sequence" - rheadM (L x) = return x - rheadM (A _ ys) = rheadM ys - -@@ -220,7 +220,7 @@ rtail (A xs ys) = rtl xs ys - rtl xs (L _) = xs - rtl _ _ = error "JoinList.rtl: bug" - --rtailM E = fail "JoinList.rtailM: empty sequence" -+rtailM E = error "JoinList.rtailM: empty sequence" - rtailM (L _) = return E - rtailM (A xs ys) = return (rtl xs ys) - where rtl xs (A ys (A zs s)) = A (A xs ys) (rtl zs s) -diff --git a/src/Data/Edison/Seq/MyersStack.hs b/src/Data/Edison/Seq/MyersStack.hs -index 30eb197..3fc5e7f 100644 ---- a/src/Data/Edison/Seq/MyersStack.hs -+++ b/src/Data/Edison/Seq/MyersStack.hs -@@ -151,22 +151,22 @@ lcons x xs@(C i _ _ (C j _ _ xs')) - | i == j = C (1 + i + j) x xs xs' - lcons x xs = C 1 x xs xs - --lview E = fail "MyersStack.lview: empty sequence" -+lview E = error "MyersStack.lview: empty sequence" - lview (C _ x xs _) = return (x, xs) - - lhead E = error "MyersStack.lhead: empty sequence" - lhead (C _ x _ _) = x - --lheadM E = fail "MyersStack.lheadM: empty sequence" -+lheadM E = error "MyersStack.lheadM: empty sequence" - lheadM (C _ x _ _) = return x - - ltail E = error "MyersStack.ltail: empty sequence" - ltail (C _ _ xs _) = xs - --ltailM E = fail "MyersStack.ltailM: empty sequence" -+ltailM E = error "MyersStack.ltailM: empty sequence" - ltailM (C _ _ xs _) = return xs - --rview E = fail "MyersStack.rview: empty sequence" -+rview E = error "MyersStack.rview: empty sequence" - rview xs = return (rhead xs, rtail xs) - - rhead E = error "MyersStack.rhead: empty sequence" -@@ -175,7 +175,7 @@ rhead (C _ x xs xs') = rh x xs xs' - rh _ (C _ y ys ys') E = rh y ys ys' - rh x E E = x - --rheadM E = fail "MyersStack.rheadM: empty sequence" -+rheadM E = error "MyersStack.rheadM: empty sequence" - rheadM (C _ x xs xs') = return (rh x xs xs') - where rh _ _ (C _ y ys ys') = rh y ys ys' - rh _ (C _ y ys ys') E = rh y ys ys' -@@ -186,7 +186,7 @@ rtail (C _ x xs _) = rt x xs - where rt _ E = E - rt y (C _ x xs _) = lcons y (rt x xs) - --rtailM E = fail "MyersStack.rtailM: empty sequence" -+rtailM E = error "MyersStack.rtailM: empty sequence" - rtailM (C _ x xs _) = return (rt x xs) - where rt _ E = E - rt y (C _ x xs _) = lcons y (rt x xs) -@@ -249,13 +249,13 @@ inBounds i xs = inb xs i - lookup i xs = runIdentity (lookupM i xs) - - lookupM i xs = look xs i -- where look E _ = fail "MyersStack.lookup: bad subscript" -+ where look E _ = error "MyersStack.lookup: bad subscript" - look (C j x xs xs') i - | i >= j = look xs' (i - j) - | i > 0 = look xs (i - 1) - | i == 0 = return x - | otherwise = nothing -- nothing = fail "MyersStack.lookup: not found" -+ nothing = error "MyersStack.lookup: not found" - - lookupWithDefault d i xs = look xs i - where look E _ = d -diff --git a/src/Data/Edison/Seq/RandList.hs b/src/Data/Edison/Seq/RandList.hs -index 8fe97bd..b4e8091 100644 ---- a/src/Data/Edison/Seq/RandList.hs -+++ b/src/Data/Edison/Seq/RandList.hs -@@ -166,7 +166,7 @@ copy n x = if n <= 0 then E else buildTrees (1::Int) (L x) - child (T _ _ t) = t - child _ = error "RandList.copy: bug!" - --lview E = fail "RandList.lview: empty sequence" -+lview E = error "RandList.lview: empty sequence" - lview (C _ (L x) xs) = return (x, xs) - lview (C i (T x s t) xs) = return (x, C j s (C j t xs)) - where j = half i -@@ -175,7 +175,7 @@ lhead E = error "RandList.lhead: empty sequence" - lhead (C _ (L x) _) = x - lhead (C _ (T x _ _) _) = x - --lheadM E = fail "RandList.lheadM: empty sequence" -+lheadM E = error "RandList.lheadM: empty sequence" - lheadM (C _ (L x) _) = return x - lheadM (C _ (T x _ _) _) = return x - -@@ -184,7 +184,7 @@ ltail (C _ (L _) xs) = xs - ltail (C i (T _ s t) xs) = C j s (C j t xs) - where j = half i - --ltailM E = fail "RandList.ltailM: empty sequence" -+ltailM E = error "RandList.ltailM: empty sequence" - ltailM (C _ (L _) xs) = return xs - ltailM (C i (T _ s t) xs) = return (C j s (C j t xs)) - where j = half i -@@ -195,7 +195,7 @@ rhead (C _ t E) = treeLast t - treeLast (T _ _ t) = treeLast t - rhead (C _ _ xs) = rhead xs - --rheadM E = fail "RandList.rhead: empty sequence" -+rheadM E = error "RandList.rhead: empty sequence" - rheadM (C _ t E) = return(treeLast t) - where treeLast (L x) = x - treeLast (T _ _ t) = treeLast t -@@ -272,7 +272,7 @@ inBounds i xs = inb xs i - lookup i xs = runIdentity (lookupM i xs) - - lookupM i xs = look xs i -- where look E _ = fail "RandList.lookup bad subscript" -+ where look E _ = error "RandList.lookup bad subscript" - look (C j t xs) i - | i < j = lookTree j t i - | otherwise = look xs (i - j) -@@ -285,7 +285,7 @@ lookupM i xs = look xs i - | i /= 0 = lookTree k s (i - 1) - | otherwise = return x - where k = half j -- nothing = fail "RandList.lookup: not found" -+ nothing = error "RandList.lookup: not found" - - lookupWithDefault d i xs = look xs i - where look E _ = d -diff --git a/src/Data/Edison/Seq/RevSeq.hs b/src/Data/Edison/Seq/RevSeq.hs -index 3652c7b..de26103 100644 ---- a/src/Data/Edison/Seq/RevSeq.hs -+++ b/src/Data/Edison/Seq/RevSeq.hs -@@ -167,7 +167,7 @@ rcons x (N m xs) = N (m+1) (S.lcons x xs) - append (N m xs) (N n ys) = N (m+n+1) (S.append ys xs) - - lview (N m xs) = case S.rview xs of -- Nothing -> fail "RevSeq.lview: empty sequence" -+ Nothing -> error "RevSeq.lview: empty sequence" - Just (x,xs) -> return (x, N (m-1) xs) - - lhead (N _ xs) = S.rhead xs -@@ -177,11 +177,11 @@ lheadM (N _ xs) = S.rheadM xs - ltail (N (-1) _) = error "RevSeq.ltail: empty sequence" - ltail (N m xs) = N (m-1) (S.rtail xs) - --ltailM (N (-1) _) = fail "RevSeq.ltailM: empty sequence" -+ltailM (N (-1) _) = error "RevSeq.ltailM: empty sequence" - ltailM (N m xs) = return (N (m-1) (S.rtail xs)) - - rview (N m xs) = case S.lview xs of -- Nothing -> fail "RevSeq.rview: empty sequence" -+ Nothing -> error "RevSeq.rview: empty sequence" - Just (x,xs) -> return (x, N (m-1) xs) - - rhead (N _ xs) = S.lhead xs -@@ -191,7 +191,7 @@ rheadM (N _ xs) = S.lheadM xs - rtail (N (-1) _) = error "RevSeq.rtail: empty sequence" - rtail (N m xs) = N (m-1) (S.ltail xs) - --rtailM (N (-1) _) = fail "RevSeq.rtailM: empty sequence" -+rtailM (N (-1) _) = error "RevSeq.rtailM: empty sequence" - rtailM (N m xs) = return (N (m-1) (S.ltail xs)) - - null (N m _) = m == -1 -diff --git a/src/Data/Edison/Seq/SimpleQueue.hs b/src/Data/Edison/Seq/SimpleQueue.hs -index 64592b6..65a51a3 100644 ---- a/src/Data/Edison/Seq/SimpleQueue.hs -+++ b/src/Data/Edison/Seq/SimpleQueue.hs -@@ -159,14 +159,14 @@ rcons y (Q xs ys) = Q xs (y:ys) - append (Q xs1 ys1) (Q xs2 ys2) = - Q (xs1 ++ L.reverseOnto ys1 xs2) ys2 - --lview (Q [] _) = fail "SimpleQueue.lview: empty sequence" -+lview (Q [] _) = error "SimpleQueue.lview: empty sequence" - lview (Q [x] ys) = return (x, Q (L.reverse ys) []) - lview (Q (x:xs) ys) = return (x, Q xs ys) - - lhead (Q [] _) = error "SimpleQueue.lhead: empty sequence" - lhead (Q (x:_) _) = x - --lheadM (Q [] _) = fail "SimpleQueue.lheadM: empty sequence" -+lheadM (Q [] _) = error "SimpleQueue.lheadM: empty sequence" - lheadM (Q (x:_) _) = return x - - ltail (Q [_] ys) = Q (L.reverse ys) [] -@@ -175,12 +175,12 @@ ltail (Q [] _) = error "SimpleQueue.ltail: empty sequence" - - ltailM (Q [_] ys) = return (Q (L.reverse ys) []) - ltailM (Q (_:xs) ys) = return (Q xs ys) --ltailM (Q [] _) = fail "SimpleQueue.ltailM: empty sequence" -+ltailM (Q [] _) = error "SimpleQueue.ltailM: empty sequence" - - rview (Q xs (y:ys)) = return (y, Q xs ys) - rview (Q xs []) = - case L.rview xs of -- Nothing -> fail "SimpleQueue.rview: empty sequence" -+ Nothing -> error "SimpleQueue.rview: empty sequence" - Just (x,xs') -> return (x, Q xs' []) - - rhead (Q _ (y:_)) = y -@@ -188,7 +188,7 @@ rhead (Q [] []) = error "SimpleQueue.rhead: empty sequence" - rhead (Q xs []) = L.rhead xs - - rheadM (Q _ (y:_)) = return y --rheadM (Q [] []) = fail "SimpleQueue.rheadM: empty sequence" -+rheadM (Q [] []) = error "SimpleQueue.rheadM: empty sequence" - rheadM (Q xs []) = return (L.rhead xs) - - rtail (Q xs (_:ys)) = Q xs ys -@@ -196,7 +196,7 @@ rtail (Q [] []) = error "SimpleQueue.rtail: empty sequence" - rtail (Q xs []) = Q (L.rtail xs) [] - - rtailM (Q xs (_:ys)) = return (Q xs ys) --rtailM (Q [] []) = fail "SimpleQueue.rtailM: empty sequence" -+rtailM (Q [] []) = error "SimpleQueue.rtailM: empty sequence" - rtailM (Q xs []) = return (Q (L.rtail xs) []) - - null (Q [] _) = True -diff --git a/src/Data/Edison/Seq/SizedSeq.hs b/src/Data/Edison/Seq/SizedSeq.hs -index a50b800..5358abc 100644 ---- a/src/Data/Edison/Seq/SizedSeq.hs -+++ b/src/Data/Edison/Seq/SizedSeq.hs -@@ -156,7 +156,7 @@ rcons x (N n xs) = N (n+1) (S.rcons x xs) - append (N m xs) (N n ys) = N (m+n) (S.append xs ys) - - lview (N n xs) = case S.lview xs of -- Nothing -> fail "SizedSeq.lview: empty sequence" -+ Nothing -> error "SizedSeq.lview: empty sequence" - Just (x,xs) -> return (x, N (n-1) xs) - - lhead (N _ xs) = S.lhead xs -@@ -166,11 +166,11 @@ lheadM (N _ xs) = S.lheadM xs - ltail (N 0 _) = error "SizedSeq.ltail: empty sequence" - ltail (N n xs) = N (n-1) (S.ltail xs) - --ltailM (N 0 _) = fail "SizedSeq.ltailM: empty sequence" -+ltailM (N 0 _) = error "SizedSeq.ltailM: empty sequence" - ltailM (N n xs) = return (N (n-1) (S.ltail xs)) - - rview (N n xs) = case S.rview xs of -- Nothing -> fail "SizedSeq.rview: empty sequence" -+ Nothing -> error "SizedSeq.rview: empty sequence" - Just (x,xs) -> return (x, N (n-1) xs) - - rhead (N _ xs) = S.rhead xs -@@ -180,7 +180,7 @@ rheadM (N _ xs) = S.rheadM xs - rtail (N 0 _) = error "SizedSeq.rtail: empty sequence" - rtail (N n xs) = N (n-1) (S.rtail xs) - --rtailM (N 0 _) = fail "SizedSeq.rtailM: empty sequence" -+rtailM (N 0 _) = error "SizedSeq.rtailM: empty sequence" - rtailM (N n xs) = return (N (n-1) (S.rtail xs)) - - null (N n _) = n == 0 diff --git a/patches/cborg-0.2.7.0.patch b/patches/cborg-0.2.7.0.patch deleted file mode 100644 index 7a8b30be..00000000 --- a/patches/cborg-0.2.7.0.patch +++ /dev/null @@ -1,182 +0,0 @@ -diff --git a/src/Codec/CBOR/Decoding.hs b/src/Codec/CBOR/Decoding.hs -index 2d18e51..ff9ee02 100644 ---- a/src/Codec/CBOR/Decoding.hs -+++ b/src/Codec/CBOR/Decoding.hs -@@ -188,7 +188,7 @@ data DecodeAction s a - - | PeekTokenType (TokenType -> ST s (DecodeAction s a)) - | PeekAvailable (Int# -> ST s (DecodeAction s a)) --#if defined(ARCH_32bit) -+#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) - | PeekByteOffset (Int64# -> ST s (DecodeAction s a)) - #else - | PeekByteOffset (Int# -> ST s (DecodeAction s a)) -@@ -327,12 +327,12 @@ toInt32 n = I32# (intToInt32# n) - toWord8 n = W8# (wordToWord8# n) - toWord16 n = W16# (wordToWord16# n) - toWord32 n = W32# (wordToWord32# n) --#if WORD_SIZE_IN_BITS == 64 --toInt64 n = I64# n --toWord64 n = W64# n --#else -+#if __GLASGOW_HASKELL__ >= 903 || WORD_SIZE_IN_BITS == 32 - toInt64 n = I64# (intToInt64# n) - toWord64 n = W64# (wordToWord64# n) -+#else -+toInt64 n = I64# n -+toWord64 n = W64# n - #endif - #else - toInt8 n = I8# n -@@ -748,7 +748,7 @@ decodeTag64 :: Decoder s Word64 - {-# INLINE decodeTag64 #-} - decodeTag64 = - #if defined(ARCH_64bit) -- Decoder (\k -> return (ConsumeTag (\w# -> k (W64# w#)))) -+ Decoder (\k -> return (ConsumeTag (\w# -> k (toWord64 w#)))) - #else - Decoder (\k -> return (ConsumeTag64 (\w64# -> k (W64# w64#)))) - #endif -@@ -769,7 +769,7 @@ decodeTag64Canonical :: Decoder s Word64 - {-# INLINE decodeTag64Canonical #-} - decodeTag64Canonical = - #if defined(ARCH_64bit) -- Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (W64# w#)))) -+ Decoder (\k -> return (ConsumeTagCanonical (\w# -> k (toWord64 w#)))) - #else - Decoder (\k -> return (ConsumeTag64Canonical (\w64# -> k (W64# w64#)))) - #endif -diff --git a/src/Codec/CBOR/FlatTerm.hs b/src/Codec/CBOR/FlatTerm.hs -index 9d8b20a..b7c0b4d 100644 ---- a/src/Codec/CBOR/FlatTerm.hs -+++ b/src/Codec/CBOR/FlatTerm.hs -@@ -50,10 +50,13 @@ import qualified Codec.CBOR.ByteArray as BA - import qualified Codec.CBOR.ByteArray.Sliced as BAS - - import Data.Int --#if defined(ARCH_32bit) -+#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH32_bit) - import GHC.Int (Int64(I64#)) -+import GHC.Exts (Int64#) -+#endif -+#if defined(ARCH32_bit) - import GHC.Word (Word64(W64#)) --import GHC.Exts (Word64#, Int64#) -+import GHC.Exts (Word64#) - #endif - #if MIN_VERSION_ghc_prim(0,8,0) - import GHC.Exts (word8ToWord#) -@@ -170,12 +173,12 @@ decodePreEncoded bs0 = - -- always starts by requesting initial input. Only decoders that - -- fail or return a value without looking at their input can give - -- a different initial result. -- Read.Partial k <- Read.deserialiseIncremental decodeTermToken -+ ~(Read.Partial k) <- Read.deserialiseIncremental decodeTermToken - k (Just bs) - collectOutput next - - collectOutput :: Read.IDecode s TermToken -> ST.Lazy.ST s FlatTerm -- collectOutput (Read.Fail _ _ err) = fail $ "toFlatTerm: encodePreEncoded " -+ collectOutput (Read.Fail _ _ err) = error $ "toFlatTerm: encodePreEncoded " - ++ "used with invalid CBOR: " - ++ show err - collectOutput (Read.Partial k) = ST.Lazy.strictToLazyST (k Nothing) -@@ -456,7 +459,7 @@ fromFlatTerm decoder ft = - -- We don't have real bytes so we have to give these two operations - -- different interpretations: remaining tokens and just 0 for offsets. - go ts (PeekAvailable k) = k (unI# (length ts)) >>= go ts --#if defined(ARCH_32bit) -+#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) - go ts (PeekByteOffset k)= k (unI64# 0) >>= go ts - #else - go ts (PeekByteOffset k)= k 0# >>= go ts -@@ -732,7 +735,9 @@ unD# (D# f#) = f# - #if defined(ARCH_32bit) - unW64# :: Word64 -> Word64# - unW64# (W64# w#) = w# -+#endif - -+#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) - unI64# :: Int64 -> Int64# - unI64# (I64# i#) = i# - #endif -diff --git a/src/Codec/CBOR/Magic.hs b/src/Codec/CBOR/Magic.hs -index 0160881..e37e711 100644 ---- a/src/Codec/CBOR/Magic.hs -+++ b/src/Codec/CBOR/Magic.hs -@@ -109,7 +109,12 @@ import Data.ByteString (ByteString) - import qualified Data.ByteString as BS - import qualified Data.ByteString.Internal as BS - import qualified Data.ByteString.Unsafe as BS --import Data.Primitive.ByteArray as Prim hiding (copyByteArrayToPtr) -+import Data.Primitive.ByteArray as Prim hiding -+ ( copyByteArrayToPtr -+#if MIN_VERSION_primitive(0,7,4) -+ , copyPtrToMutableByteArray -+#endif -+ ) - - import Foreign.ForeignPtr (withForeignPtr) - import Foreign.C (CUShort) -@@ -166,7 +171,9 @@ grabWord32 (Ptr ip#) = W32# (wordToWord32# (byteSwap32# (word32ToWord# (indexWor - grabWord16 (Ptr ip#) = W16# (narrow16Word# (byteSwap16# (indexWord16OffAddr# ip# 0#))) - grabWord32 (Ptr ip#) = W32# (narrow32Word# (byteSwap32# (indexWord32OffAddr# ip# 0#))) - #endif --#if defined(ARCH_64bit) -+#if __GLASGOW_HASKELL__ >= 903 -+grabWord64 (Ptr ip#) = W64# (byteSwap64# (indexWord64OffAddr# ip# 0#)) -+#elif defined(ARCH_64bit) - grabWord64 (Ptr ip#) = W64# (byteSwap# (indexWord64OffAddr# ip# 0#)) - #else - grabWord64 (Ptr ip#) = W64# (byteSwap64# (word64ToWord# (indexWord64OffAddr# ip# 0#))) -@@ -438,13 +445,10 @@ int64ToWord64 = fromIntegral - word8ToWord (W8# w#) = W# (word8ToWord# w#) - word16ToWord (W16# w#) = W# (word16ToWord# w#) - word32ToWord (W32# w#) = W# (word32ToWord# w#) --#if defined(ARCH_64bit) --word64ToWord (W64# w#) = W# w# -+#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) -+word64ToWord (W64# w64#) = W# (word64ToWord# w64#) - #else --word64ToWord (W64# w64#) = -- case isTrue# (w64# `leWord64#` wordToWord64# 0xffffffff##) of -- True -> Just (W# (word64ToWord# w64#)) -- False -> Nothing -+word64ToWord (W64# w#) = W# w# - #endif - #else - word8ToWord (W8# w#) = W# w# -@@ -490,15 +494,15 @@ word32ToInt (W32# w#) = - #endif - #endif - --#if defined(ARCH_64bit) -+#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) - word64ToInt (W64# w#) = -- case isTrue# (w# `ltWord#` 0x8000000000000000##) of -- True -> Just (I# (word2Int# w#)) -+ case isTrue# (w# `ltWord64#` wordToWord64# 0x80000000##) of -+ True -> Just (I# (int64ToInt# (word64ToInt64# w#))) - False -> Nothing - #else - word64ToInt (W64# w#) = -- case isTrue# (w# `ltWord64#` wordToWord64# 0x80000000##) of -- True -> Just (I# (int64ToInt# (word64ToInt64# w#))) -+ case isTrue# (w# `ltWord#` 0x8000000000000000##) of -+ True -> Just (I# (word2Int# w#)) - False -> Nothing - #endif - -diff --git a/src/Codec/CBOR/Read.hs b/src/Codec/CBOR/Read.hs -index 0dbb0b6..4d63bba 100644 ---- a/src/Codec/CBOR/Read.hs -+++ b/src/Codec/CBOR/Read.hs -@@ -247,7 +247,7 @@ data SlowPath s a - | SlowConsumeTokenByteArray {-# UNPACK #-} !ByteString (BA.ByteArray -> ST s (DecodeAction s a)) {-# UNPACK #-} !Int - | SlowConsumeTokenString {-# UNPACK #-} !ByteString (T.Text -> ST s (DecodeAction s a)) {-# UNPACK #-} !Int - | SlowConsumeTokenUtf8ByteArray {-# UNPACK #-} !ByteString (BA.ByteArray -> ST s (DecodeAction s a)) {-# UNPACK #-} !Int --#if defined(ARCH_32bit) -+#if __GLASGOW_HASKELL__ >= 903 || defined(ARCH_32bit) - | SlowPeekByteOffset {-# UNPACK #-} !ByteString (Int64# -> ST s (DecodeAction s a)) - #else - | SlowPeekByteOffset {-# UNPACK #-} !ByteString (Int# -> ST s (DecodeAction s a)) diff --git a/patches/fgl-5.7.0.3.patch b/patches/fgl-5.7.0.3.patch deleted file mode 100644 index fccf4a76..00000000 --- a/patches/fgl-5.7.0.3.patch +++ /dev/null @@ -1,48 +0,0 @@ -diff --git a/Data/Graph/Inductive/Monad.hs b/Data/Graph/Inductive/Monad.hs -index d63752b..489fae4 100644 ---- a/Data/Graph/Inductive/Monad.hs -+++ b/Data/Graph/Inductive/Monad.hs -@@ -19,10 +19,6 @@ module Data.Graph.Inductive.Monad( - - - import Data.Graph.Inductive.Graph --#if MIN_VERSION_base(4,12,0) --import Control.Monad.Fail --import Prelude hiding (fail) --#endif - - {-# ANN module "HLint: ignore Redundant lambda" #-} - -@@ -44,11 +40,7 @@ import Prelude hiding (fail) - -- Monadic Graph - -- - class --#if MIN_VERSION_base(4,12,0) -- (MonadFail m) --#else - (Monad m) --#endif - => GraphM m gr where - {-# MINIMAL emptyM, isEmptyM, matchM, mkGraphM, labNodesM #-} - -@@ -65,8 +57,9 @@ class - matchAnyM :: m (gr a b) -> m (GDecomp gr a b) - matchAnyM g = do vs <- labNodesM g - case vs of -- [] -> fail "Match Exception, Empty Graph" -- (v,_):_ -> do (Just c,g') <- matchM v g -+ [] -> error "Match Exception, Empty Graph" -+ (v,_):_ -> do cg' <- matchM v g -+ let (Just c,g') = cg' - return (c,g') - - noNodesM :: m (gr a b) -> m Int -@@ -75,7 +68,7 @@ class - nodeRangeM :: m (gr a b) -> m (Node,Node) - nodeRangeM g = do isE <- isEmptyM g - if isE -- then fail "nodeRangeM of empty graph" -+ then error "nodeRangeM of empty graph" - else do vs <- nodesM g - return (minimum vs,maximum vs) - diff --git a/patches/free-algebras-0.1.0.1.patch b/patches/free-algebras-0.1.0.1.patch deleted file mode 100644 index e27f47f1..00000000 --- a/patches/free-algebras-0.1.0.1.patch +++ /dev/null @@ -1,28 +0,0 @@ -diff --git a/src/Data/Semigroup/Abelian.hs b/src/Data/Semigroup/Abelian.hs -index 6567faf..c38b161 100644 ---- a/src/Data/Semigroup/Abelian.hs -+++ b/src/Data/Semigroup/Abelian.hs -@@ -26,7 +26,9 @@ import Data.Semigroup - , Dual - , Max - , Min -+#if __GLASGOW_HASKELL__ < 900 - , Option -+#endif - , Product - , Sum - ) -@@ -111,10 +113,10 @@ instance FreeAlgebra FreeAbelianSemigroup where - foldMapFree f (FreeAbelianSemigroup as) - = foldMapFree f (toNonEmpty_ as) - where -- replicate_ :: a -> Natural -> [a] -+ replicate_ :: a -> Natural -> [a] - replicate_ _ n | n <= 0 = error "foldMapFree @FreeAbelianSemigroup: impossible" -- replicate_ a 1 = [a] -- replicate_ a n = a : replicate_ a (n - 1) -+ replicate_ a 1 = [a] -+ replicate_ a n = a : replicate_ a (n - 1) - - toNonEmpty_ :: Map a Natural -> NonEmpty a - toNonEmpty_ = NE.fromList . concatMap (uncurry replicate_) . Map.toList diff --git a/patches/primitive-unaligned-0.1.1.1.patch b/patches/primitive-unaligned-0.1.1.1.patch deleted file mode 100644 index 150d4056..00000000 --- a/patches/primitive-unaligned-0.1.1.1.patch +++ /dev/null @@ -1,90 +0,0 @@ -diff --git a/src-64/Data/Primitive/Unaligned/Mach.hs b/src-64/Data/Primitive/Unaligned/Mach.hs -index f365f40..2eead89 100644 ---- a/src-64/Data/Primitive/Unaligned/Mach.hs -+++ b/src-64/Data/Primitive/Unaligned/Mach.hs -@@ -1,3 +1,4 @@ -+{-# language CPP #-} - {-# language MagicHash #-} - {-# language UnboxedTuples #-} - -@@ -17,11 +18,23 @@ import qualified GHC.Exts as E - - indexUnalignedWord64Array# :: ByteArray# -> Int# -> Word64 - indexUnalignedWord64Array# a i = -- W64# (E.indexWord8ArrayAsWord# a i) -+ W64# ( -+#if __GLASGOW_HASKELL__ >= 903 -+ E.indexWord8ArrayAsWord64# -+#else -+ E.indexWord8ArrayAsWord# -+#endif -+ a i) - - indexUnalignedInt64Array# :: ByteArray# -> Int# -> Int64 - indexUnalignedInt64Array# a i = -- I64# (E.indexWord8ArrayAsInt# a i) -+ I64# ( -+#if __GLASGOW_HASKELL__ >= 903 -+ E.indexWord8ArrayAsInt64# -+#else -+ E.indexWord8ArrayAsInt# -+#endif -+ a i) - - readUnalignedWord64Array# :: - MutableByteArray# s -@@ -29,7 +42,13 @@ readUnalignedWord64Array# :: - -> State# s - -> (# State# s, Word64 #) - readUnalignedWord64Array# a i s0 = -- case E.readWord8ArrayAsWord# a i s0 of -+ case -+#if __GLASGOW_HASKELL__ >= 903 -+ E.readWord8ArrayAsWord64# -+#else -+ E.readWord8ArrayAsWord# -+#endif -+ a i s0 of - (# s1, r #) -> (# s1, W64# r #) - - readUnalignedInt64Array# :: -@@ -38,7 +57,13 @@ readUnalignedInt64Array# :: - -> State# s - -> (# State# s, Int64 #) - readUnalignedInt64Array# a i s0 = -- case E.readWord8ArrayAsInt# a i s0 of -+ case -+#if __GLASGOW_HASKELL__ >= 903 -+ E.readWord8ArrayAsInt64# -+#else -+ E.readWord8ArrayAsInt# -+#endif -+ a i s0 of - (# s1, r #) -> (# s1, I64# r #) - - writeUnalignedWord64Array# :: -@@ -48,7 +73,12 @@ writeUnalignedWord64Array# :: - -> State# s - -> State# s - writeUnalignedWord64Array# a i (W64# w) = -- E.writeWord8ArrayAsWord# a i w -+#if __GLASGOW_HASKELL__ >= 903 -+ E.writeWord8ArrayAsWord64# -+#else -+ E.writeWord8ArrayAsWord# -+#endif -+ a i w - - writeUnalignedInt64Array# :: - MutableByteArray# s -@@ -57,4 +87,9 @@ writeUnalignedInt64Array# :: - -> State# s - -> State# s - writeUnalignedInt64Array# a i (I64# w) = -- E.writeWord8ArrayAsInt# a i w -+#if __GLASGOW_HASKELL__ >= 903 -+ E.writeWord8ArrayAsInt64# -+#else -+ E.writeWord8ArrayAsInt# -+#endif -+ a i w diff --git a/patches/proto3-wire-1.4.0.patch b/patches/proto3-wire-1.4.0.patch deleted file mode 100644 index 763c09d7..00000000 --- a/patches/proto3-wire-1.4.0.patch +++ /dev/null @@ -1,55 +0,0 @@ -diff --git a/src/Proto3/Wire/Reverse/Prim.hs b/src/Proto3/Wire/Reverse/Prim.hs -index 33dacec..fada4a2 100644 ---- a/src/Proto3/Wire/Reverse/Prim.hs -+++ b/src/Proto3/Wire/Reverse/Prim.hs -@@ -108,11 +108,14 @@ import Data.Int ( Int8, Int16, Int32, Int64 ) - import Data.Kind ( Type ) - import qualified Data.Vector.Generic - import Foreign ( Storable(..) ) --import GHC.Exts ( Addr#, Int#, Proxy#, -+import GHC.Exts ( Addr#, Int#, Proxy#, Word#, - RealWorld, State#, (+#), - and#, inline, or#, - plusAddr#, plusWord#, proxy#, - uncheckedShiftRL# ) -+#if __GLASGOW_HASKELL__ >= 903 -+import GHC.Exts ( wordToWord64# ) -+#endif - import GHC.IO ( IO(..) ) - import GHC.Int ( Int(..) ) - import GHC.Ptr ( Ptr(..) ) -@@ -137,8 +140,8 @@ import GHC.Exts (Word#) - - -- "ghc-prim" v0.6.1 defines `GHC.Prim.Ext.WORD64`, but we do not wish - -- to require that version of "ghc-prim". Therefore we define it locally. --#if WORD_SIZE_IN_BITS < 64 --import GHC.IntWord64 (Word64#) -+#if __GLASGOW_HASKELL__ >= 903 || WORD_SIZE_IN_BITS < 64 -+import GHC.Exts (Word64#) - type WORD64 = Word64# - #else - import GHC.Exts (Word#) -@@ -688,7 +691,10 @@ charUtf8 = \ch -> case fromIntegral (ord ch) of W# x -> wordUtf8 x - - -- | The bounded primitive implementing - -- `Proto3.Wire.Reverse.wordBase128LEVar`. --#if WORD_SIZE_IN_BITS < 64 -+#if __GLASGOW_HASKELL__ >= 903 -+wordBase128LEVar :: Word -> BoundedPrim 10 -+wordBase128LEVar (W# w) = word64Base128LEVar (W64# (wordToWord64# w)) -+#elif WORD_SIZE_IN_BITS < 64 - wordBase128LEVar :: Word -> BoundedPrim 5 - wordBase128LEVar (W# w) = word32Base128LEVar (W32# w) - #else -@@ -699,7 +705,10 @@ wordBase128LEVar (W# w) = word64Base128LEVar (W64# w) - - -- | Like 'wordBase128LEVar' but inlined, possibly bloating your code. On - -- the other hand, inlining an application to a constant may shrink your code. --#if WORD_SIZE_IN_BITS < 64 -+#if __GLASGOW_HASKELL__ >= 903 -+wordBase128LEVar_inline :: Word -> BoundedPrim 10 -+wordBase128LEVar_inline (W# w) = word64Base128LEVar_inline (W64# (wordToWord64# w)) -+#elif WORD_SIZE_IN_BITS < 64 - wordBase128LEVar_inline :: Word -> BoundedPrim 5 - wordBase128LEVar_inline (W# w) = word32Base128LEVar_inline (W32# w) - #else diff --git a/patches/unix-time-0.4.7.patch b/patches/unix-time-0.4.7.patch deleted file mode 100644 index f34e3db6..00000000 --- a/patches/unix-time-0.4.7.patch +++ /dev/null @@ -1,196 +0,0 @@ -diff --git a/cbits/config.h.in b/cbits/config.h.in -index 7ec66c5..08883a9 100644 ---- a/cbits/config.h.in -+++ b/cbits/config.h.in -@@ -1,5 +1,9 @@ - /* cbits/config.h.in. Generated from configure.ac by autoheader. */ - -+/* Define to 1 if you have the declaration of `_mkgmtime', and to 0 if you -+ don't. */ -+#undef HAVE_DECL__MKGMTIME -+ - /* Define to 1 if you have the <inttypes.h> header file. */ - #undef HAVE_INTTYPES_H - -@@ -60,9 +64,6 @@ - /* Define to 1 if you have the `_isupper_l' function. */ - #undef HAVE__ISUPPER_L - --/* Define to 1 if you have the `_mkgmtime' function. */ --#undef HAVE__MKGMTIME -- - /* "Is Linux" */ - #undef IS_LINUX - -diff --git a/cbits/win_patch.h b/cbits/win_patch.h -index 1b5b022..b746b53 100644 ---- a/cbits/win_patch.h -+++ b/cbits/win_patch.h -@@ -116,7 +116,11 @@ long long strtoll_l(const char *nptr, char **endptr, int base, _locale_t locale) - #define isleap_sum(a, b) isleap((a) % 400 + (b) % 400) - #endif /* !defined isleap_sum */ - --#if !HAVE__ISBLANK_L -+#if HAVE__ISBLANK_L -+#define isblank_l _isblank_l -+// Needed to avoid -Wimplicit-function-declaration warnings -+int _isblank_l(int c, _locale_t loc); -+#else - int isblank_l( int c, _locale_t _loc); - #endif - -@@ -126,7 +130,7 @@ struct tm *gmtime_r(const time_t *_time_t, struct tm *_tm); - - struct tm *localtime_r(const time_t *_time_t, struct tm *_tm); - --#if HAVE__MKGMTIME -+#if HAVE_DECL__MKGMTIME - #define timegm _mkgmtime - #define HAVE_TIMEGM 1 - #endif -diff --git a/configure b/configure -index 24d5fef..6bf04d8 100644 ---- a/configure -+++ b/configure -@@ -651,6 +651,7 @@ infodir - docdir - oldincludedir - includedir -+runstatedir - localstatedir - sharedstatedir - sysconfdir -@@ -721,6 +722,7 @@ datadir='${datarootdir}' - sysconfdir='${prefix}/etc' - sharedstatedir='${prefix}/com' - localstatedir='${prefix}/var' -+runstatedir='${localstatedir}/run' - includedir='${prefix}/include' - oldincludedir='/usr/include' - docdir='${datarootdir}/doc/${PACKAGE}' -@@ -973,6 +975,15 @@ do - | -silent | --silent | --silen | --sile | --sil) - silent=yes ;; - -+ -runstatedir | --runstatedir | --runstatedi | --runstated \ -+ | --runstate | --runstat | --runsta | --runst | --runs \ -+ | --run | --ru | --r) -+ ac_prev=runstatedir ;; -+ -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ -+ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ -+ | --run=* | --ru=* | --r=*) -+ runstatedir=$ac_optarg ;; -+ - -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) - ac_prev=sbindir ;; - -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ -@@ -1110,7 +1121,7 @@ fi - for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ - datadir sysconfdir sharedstatedir localstatedir includedir \ - oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ -- libdir localedir mandir -+ libdir localedir mandir runstatedir - do - eval ac_val=\$$ac_var - # Remove trailing slashes. -@@ -1263,6 +1274,7 @@ Fine tuning of the installation directories: - --sysconfdir=DIR read-only single-machine data [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] - --localstatedir=DIR modifiable single-machine data [PREFIX/var] -+ --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] - --libdir=DIR object code libraries [EPREFIX/lib] - --includedir=DIR C header files [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc [/usr/include] -@@ -1723,6 +1735,52 @@ $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - - } # ac_fn_c_check_func -+ -+# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES -+# --------------------------------------------- -+# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR -+# accordingly. -+ac_fn_c_check_decl () -+{ -+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack -+ as_decl_name=`echo $2|sed 's/ *(.*//'` -+ as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` -+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 -+$as_echo_n "checking whether $as_decl_name is declared... " >&6; } -+if eval \${$3+:} false; then : -+ $as_echo_n "(cached) " >&6 -+else -+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext -+/* end confdefs.h. */ -+$4 -+int -+main () -+{ -+#ifndef $as_decl_name -+#ifdef __cplusplus -+ (void) $as_decl_use; -+#else -+ (void) $as_decl_name; -+#endif -+#endif -+ -+ ; -+ return 0; -+} -+_ACEOF -+if ac_fn_c_try_compile "$LINENO"; then : -+ eval "$3=yes" -+else -+ eval "$3=no" -+fi -+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -+fi -+eval ac_res=\$$3 -+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -+$as_echo "$ac_res" >&6; } -+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno -+ -+} # ac_fn_c_check_decl - cat >config.log <<_ACEOF - This file contains any messages produced by compilers while - running configure, to aid debugging if configure makes a mistake. -@@ -3304,16 +3362,17 @@ _ACEOF - fi - done - --for ac_func in _mkgmtime --do : -- ac_fn_c_check_func "$LINENO" "_mkgmtime" "ac_cv_func__mkgmtime" --if test "x$ac_cv_func__mkgmtime" = xyes; then : -- cat >>confdefs.h <<_ACEOF --#define HAVE__MKGMTIME 1 --_ACEOF -- -+ac_fn_c_check_decl "$LINENO" "_mkgmtime" "ac_cv_have_decl__mkgmtime" "#include <time.h> -+" -+if test "x$ac_cv_have_decl__mkgmtime" = xyes; then : -+ ac_have_decl=1 -+else -+ ac_have_decl=0 - fi --done -+ -+cat >>confdefs.h <<_ACEOF -+#define HAVE_DECL__MKGMTIME $ac_have_decl -+_ACEOF - - for ac_func in _get_current_locale - do : -diff --git a/configure.ac b/configure.ac -index 0732702..4e78553 100644 ---- a/configure.ac -+++ b/configure.ac -@@ -8,7 +8,7 @@ AC_CHECK_HEADERS(xlocale.h) - - AC_CHECK_FUNCS(strptime_l) - AC_CHECK_FUNCS(timegm) --AC_CHECK_FUNCS(_mkgmtime) -+AC_CHECK_DECLS([_mkgmtime], [], [], [[#include <time.h>]]) - AC_CHECK_FUNCS(_get_current_locale) - AC_CHECK_FUNCS(_create_locale) - AC_CHECK_FUNCS(strtol_l) diff --git a/patches/yesod-1.6.2.patch b/patches/yesod-1.6.2.patch deleted file mode 100644 index 0b98ce30..00000000 --- a/patches/yesod-1.6.2.patch +++ /dev/null @@ -1,14 +0,0 @@ -diff --git a/Yesod/Default/Util.hs b/Yesod/Default/Util.hs -index 2051413..19c2f9f 100644 ---- a/Yesod/Default/Util.hs -+++ b/Yesod/Default/Util.hs -@@ -23,6 +23,9 @@ import Control.Monad (when, unless) - import Conduit - import System.Directory (doesFileExist, createDirectoryIfMissing) - import Language.Haskell.TH.Syntax -+#if __GLASGOW_HASKELL__ >= 903 -+ hiding (makeRelativeToProject) -+#endif - import Text.Lucius (luciusFile, luciusFileReload) - import Text.Julius (juliusFile, juliusFileReload) - import Text.Cassius (cassiusFile, cassiusFileReload) -- GitLab