diff --git a/patches/Spock-core-0.14.0.0.patch b/patches/Spock-core-0.14.0.0.patch
new file mode 100644
index 0000000000000000000000000000000000000000..85b0bb1e10f3e14ca11dd600d653d2ebd67065cc
--- /dev/null
+++ b/patches/Spock-core-0.14.0.0.patch
@@ -0,0 +1,22 @@
+diff --git a/src/Web/Spock/Core.hs b/src/Web/Spock/Core.hs
+index 88d31cc..31345c3 100644
+--- a/src/Web/Spock/Core.hs
++++ b/src/Web/Spock/Core.hs
+@@ -77,7 +77,7 @@ instance RouteM SpockCtxT where
+     addMiddleware = SpockCtxT . AR.middleware
+     wireAny m action =
+         SpockCtxT $
+-        do hookLift <- lift $ asks unLiftHooked
++        do hookLift <- lift $ asks (\e -> unLiftHooked e)
+            case m of
+              MethodAny ->
+                  do forM_ allStdMethods $ \mReg ->
+@@ -103,7 +103,7 @@ withPrehookImpl hook (SpockCtxT hookBody) =
+ wireRouteImpl :: forall xs ctx m ps. (HasRep xs, Monad m) => SpockMethod -> Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> SpockCtxT ctx m ()
+ wireRouteImpl m path action =
+     SpockCtxT $
+-    do hookLift <- lift $ asks unLiftHooked
++    do hookLift <- lift $ asks (\e -> unLiftHooked e)
+        let actionPacker :: HVectElim xs (ActionCtxT ctx m ()) -> HVect xs -> ActionCtxT () m ()
+            actionPacker act captures = hookLift (uncurry act captures)
+        case m of
diff --git a/patches/bytestring-strict-builder-0.4.5.3.patch b/patches/bytestring-strict-builder-0.4.5.3.patch
new file mode 100644
index 0000000000000000000000000000000000000000..bf2ee5be312cf560e84238184eab153a24c53a0f
--- /dev/null
+++ b/patches/bytestring-strict-builder-0.4.5.3.patch
@@ -0,0 +1,71 @@
+diff --git a/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
+index 69ba0ff..277996c 100644
+--- a/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
++++ b/library/ByteString/StrictBuilder/Population/UncheckedShifting.hs
+@@ -62,8 +62,8 @@ shiftr_w w s = fromIntegral $ (`shiftr_w64` s) $ fromIntegral w
+ #endif
+ 
+ #if !defined(__HADDOCK__)
+-shiftr_w16 (W16# w) (I# i) = W16# (w `uncheckedShiftRL#`   i)
+-shiftr_w32 (W32# w) (I# i) = W32# (w `uncheckedShiftRL#`   i)
++shiftr_w16 (W16# w) (I# i) = W16# (narrowWord16Compat# (extendWord16Compat# w `uncheckedShiftRL#`   i))
++shiftr_w32 (W32# w) (I# i) = W32# (narrowWord32Compat# (extendWord32Compat# w `uncheckedShiftRL#`   i))
+ 
+ #if WORD_SIZE_IN_BITS < 64
+ shiftr_w64 (W64# w) (I# i) = W64# (w `uncheckedShiftRL64#` i)
+@@ -94,3 +94,31 @@ caseWordSize_32_64 f32 f64 =
+     32 -> f32
+     64 -> f64
+     s  -> error $ "caseWordSize_32_64: unsupported Word bit-size " ++ show s
++
++
++#if MIN_VERSION_base(4,16,0)
++extendWord16Compat# :: Word16# -> Word#
++extendWord16Compat# = extendWord16#
++
++narrowWord16Compat# :: Word# -> Word16#
++narrowWord16Compat# = narrowWord16#
++
++extendWord32Compat# :: Word32# -> Word#
++extendWord32Compat# = extendWord32#
++
++narrowWord32Compat# :: Word# -> Word32#
++narrowWord32Compat# = narrowWord32#
++#else
++extendWord1Compat# :: Word# -> Word#
++extendWord16Compat# x = x
++
++narrowWord16Compat# :: Word# -> Word#
++narrowWord16Compat# x = x
++
++extendWord32Compat# :: Word32# -> Word#
++extendWord32Compat# x = x
++
++narrowWord32Compat# :: Word# -> Word32#
++narrowWord32Compat# x = x
++#endif
++
+diff --git a/library/ByteString/StrictBuilder/UTF8.hs b/library/ByteString/StrictBuilder/UTF8.hs
+index c1bb7f4..7e6d964 100644
+--- a/library/ByteString/StrictBuilder/UTF8.hs
++++ b/library/ByteString/StrictBuilder/UTF8.hs
+@@ -19,8 +19,8 @@ type UTF8Char =
+ 
+ {-# INLINE char #-}
+ char :: Char -> UTF8Char
+-char =
+-  unicodeCodePoint . ord
++char x =
++  unicodeCodePoint (ord x)
+ 
+ {-# INLINE unicodeCodePoint #-}
+ unicodeCodePoint :: Int -> UTF8Char
+@@ -28,7 +28,7 @@ unicodeCodePoint x f1 f2 f3 f4 =
+   if x <= 0x7F
+     then
+       f1 (fromIntegral x)
+-    else 
++    else
+       if x <= 0x07FF
+         then
+           f2
diff --git a/patches/charset-0.3.7.1.patch b/patches/charset-0.3.7.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..f999a0386e22393217a919205bf2d2322d86af05
--- /dev/null
+++ b/patches/charset-0.3.7.1.patch
@@ -0,0 +1,37 @@
+diff --git a/src/Data/CharSet/ByteSet.hs b/src/Data/CharSet/ByteSet.hs
+index 78e9e7f..19d9065 100644
+--- a/src/Data/CharSet/ByteSet.hs
++++ b/src/Data/CharSet/ByteSet.hs
+@@ -30,7 +30,7 @@ module Data.CharSet.ByteSet
+ 
+ import Data.Bits ((.&.), (.|.))
+ import Foreign.Storable (peekByteOff, pokeByteOff)
+-import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#)
++import GHC.Base
+ import GHC.Word (Word8(W8#))
+ import qualified Data.ByteString as B
+ import qualified Data.ByteString.Internal as I
+@@ -44,7 +44,22 @@ shiftR :: Int -> Int -> Int
+ shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)
+ 
+ shiftL :: Word8 -> Int -> Word8
+-shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))
++shiftL (W8# x#) (I# i#) = W8# (narrowWord8Compat# (narrow8Word# (extendWord8Compat# x# `shiftL#` i#)))
++
++#if MIN_VERSION_base(4,16,0)
++extendWord8Compat# :: Word8# -> Word#
++extendWord8Compat# = extendWord8#
++
++narrowWord8Compat# :: Word# -> Word8#
++narrowWord8Compat# = narrowWord8#
++
++#else
++extendWord8Compat# :: Word8# -> Word#
++extendWord8Compat# x = x
++
++narrowWord8Compat# :: Word# -> Word8#
++narrowWord8Compat# x = x
++#endif
+ 
+ index :: Int -> I
+ index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7))
diff --git a/patches/data-serializer-0.3.4.1.patch b/patches/data-serializer-0.3.4.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..321ba1daf51356cf2f38e9681b56f650ca9e2da1
--- /dev/null
+++ b/patches/data-serializer-0.3.4.1.patch
@@ -0,0 +1,50 @@
+diff --git a/src/Data/Deserializer.hs b/src/Data/Deserializer.hs
+index 5975e37..eb9c78d 100644
+--- a/src/Data/Deserializer.hs
++++ b/src/Data/Deserializer.hs
+@@ -637,16 +637,16 @@ instance Deserializer μ ⇒ Deserializer (BigEndianDeserializer μ) where
+ -- | Force the default byte order.
+ deserializeIn ∷ Deserializer μ
+               ⇒ Endian → (∀ μ' . (Deserializer μ') ⇒ μ' α) → μ α
+-deserializeIn LittleEndian = deserializeL
+-deserializeIn BigEndian    = deserializeB
++deserializeIn LittleEndian f = deserializeL f
++deserializeIn BigEndian    f = deserializeB f
+ {-# INLINE deserializeIn #-}
+ 
+ -- | Force the default byte order to be the host byte order.
+ deserializeH ∷ Deserializer μ ⇒ (∀ μ' . (Deserializer μ') ⇒ μ' α) → μ α
+ #ifdef WORDS_BIGENDIAN
+-deserializeH = deserializeB
++deserializeH f = deserializeB f
+ #else
+-deserializeH = deserializeL
++deserializeH f = deserializeL f
+ #endif
+ 
+ -- | Deserialization result.
+diff --git a/src/Data/Serializer.hs b/src/Data/Serializer.hs
+index 1b87a3f..dd82799 100644
+--- a/src/Data/Serializer.hs
++++ b/src/Data/Serializer.hs
+@@ -576,16 +576,16 @@ instance Serializer s ⇒ Serializer (BigEndianSerializer s) where
+ 
+ -- | Force the default byte order.
+ serializeIn ∷ Serializer s ⇒ Endian → (∀ s' . (Serializer s') ⇒ s') → s
+-serializeIn LittleEndian = serializeL
+-serializeIn BigEndian    = serializeB
++serializeIn LittleEndian f = serializeL f
++serializeIn BigEndian    f = serializeB f
+ {-# INLINE serializeIn #-}
+ 
+ -- | Force the default byte order to be the host byte order.
+ serializeH ∷ Serializer s ⇒ (∀ s' . (Serializer s') ⇒ s') → s
+ #ifdef WORDS_BIGENDIAN
+-serializeH = serializeB
++serializeH f = serializeB f
+ #else
+-serializeH = serializeL
++serializeH f = serializeL f
+ #endif
+ {-# INLINE serializeH #-}
+ 
diff --git a/patches/hedgehog-1.0.4.patch b/patches/hedgehog-1.0.4.patch
new file mode 100644
index 0000000000000000000000000000000000000000..f42097886e682f6ce963ec2b5104ebf28a505062
--- /dev/null
+++ b/patches/hedgehog-1.0.4.patch
@@ -0,0 +1,63 @@
+diff --git a/src/Hedgehog/Internal/TH.hs b/src/Hedgehog/Internal/TH.hs
+index 39b3bc1..2d8e701 100644
+--- a/src/Hedgehog/Internal/TH.hs
++++ b/src/Hedgehog/Internal/TH.hs
+@@ -15,7 +15,7 @@ import           Hedgehog.Internal.Discovery
+ import           Hedgehog.Internal.Property
+ 
+ import           Language.Haskell.TH (Exp(..), Q, TExp, location, runIO)
+-import           Language.Haskell.TH.Syntax (Loc(..), mkName, unTypeQ, unsafeTExpCoerce)
++import           Language.Haskell.TH.Syntax (Loc(..), mkName, unTypeQ, unsafeTExpCoerce, Code, liftCode, examineCode, unsafeCodeCoerce, unTypeCode)
+ 
+ type TExpQ a =
+   Q (TExp a)
+@@ -24,11 +24,11 @@ type TExpQ a =
+ --
+ --   Functions starting with `prop_` are assumed to be properties.
+ --
+-discover :: TExpQ Group
++discover :: Code Q Group
+ discover = discoverPrefix "prop_"
+ 
+-discoverPrefix :: String -> TExpQ Group
+-discoverPrefix prefix = do
++discoverPrefix :: String -> Code Q Group
++discoverPrefix prefix = liftCode $ do
+   file <- getCurrentFile
+   properties <- Map.toList <$> runIO (readProperties prefix file)
+ 
+@@ -44,24 +44,24 @@ discoverPrefix prefix = do
+       fmap (mkNamedProperty . fst) $
+       List.sortBy startLine properties
+ 
+-  [|| Group $$(moduleName) $$(listTE names) ||]
++  examineCode [|| Group $$(moduleName) $$(listTE names) ||]
+ 
+-mkNamedProperty :: PropertyName -> TExpQ (PropertyName, Property)
++mkNamedProperty :: PropertyName -> Code Q (PropertyName, Property)
+ mkNamedProperty name = do
+   [|| (name, $$(unsafeProperty name)) ||]
+ 
+-unsafeProperty :: PropertyName -> TExpQ Property
++unsafeProperty :: PropertyName -> Code Q Property
+ unsafeProperty =
+-  unsafeTExpCoerce . pure . VarE . mkName . unPropertyName
++  unsafeCodeCoerce . pure . VarE . mkName . unPropertyName
+ 
+-listTE :: [TExpQ a] -> TExpQ [a]
+-listTE xs = do
+-  unsafeTExpCoerce . pure . ListE =<< traverse unTypeQ xs
++listTE :: [Code Q a] -> Code Q [a]
++listTE xs = liftCode $ do
++  unsafeTExpCoerce . pure . ListE =<< traverse unTypeCode xs
+ 
+-moduleName :: TExpQ GroupName
+-moduleName = do
++moduleName :: Code Q GroupName
++moduleName = liftCode $ do
+   loc <- GroupName . loc_module <$> location
+-  [|| loc ||]
++  examineCode [|| loc ||]
+ 
+ getCurrentFile :: Q FilePath
+ getCurrentFile =
diff --git a/patches/monad-validate-1.2.0.0.patch b/patches/monad-validate-1.2.0.0.patch
new file mode 100644
index 0000000000000000000000000000000000000000..0685a81955e053d9f2be0521beb3fd8509bc4be3
--- /dev/null
+++ b/patches/monad-validate-1.2.0.0.patch
@@ -0,0 +1,13 @@
+diff --git a/src/Control/Monad/Validate/Internal.hs b/src/Control/Monad/Validate/Internal.hs
+index cfb1d6b..96aee8e 100644
+--- a/src/Control/Monad/Validate/Internal.hs
++++ b/src/Control/Monad/Validate/Internal.hs
+@@ -296,7 +296,7 @@ instance (Monad m) => Applicative (ValidateT e m) where
+   {-# INLINABLE (<*>) #-}
+ 
+ instance (Monad m) => Monad (ValidateT e m) where
+-  ValidateT x >>= f = ValidateT (x >>= (getValidateT . f))
++  ValidateT x >>= f = ValidateT (x >>= (\a -> getValidateT (f a)))
+   {-# INLINE (>>=) #-}
+ 
+ instance MonadTrans (ValidateT e) where
diff --git a/patches/primitive-extras-0.8.patch b/patches/primitive-extras-0.8.patch
new file mode 100644
index 0000000000000000000000000000000000000000..30d5ee4eaa87b83c35e19dabaf7d3dc7f002d71d
--- /dev/null
+++ b/patches/primitive-extras-0.8.patch
@@ -0,0 +1,84 @@
+diff --git a/library/PrimitiveExtras/Bitmap.hs b/library/PrimitiveExtras/Bitmap.hs
+index d9a1fe0..ccbab8b 100644
+--- a/library/PrimitiveExtras/Bitmap.hs
++++ b/library/PrimitiveExtras/Bitmap.hs
+@@ -2,7 +2,7 @@ module PrimitiveExtras.Bitmap
+ (
+   Bitmap,
+   empty,
+-  singleton,
++  PrimitiveExtras.Bitmap.singleton,
+   insert,
+   invert,
+   indexList,
+diff --git a/library/PrimitiveExtras/SparseSmallArray.hs b/library/PrimitiveExtras/SparseSmallArray.hs
+index fec94db..ff6ef42 100644
+--- a/library/PrimitiveExtras/SparseSmallArray.hs
++++ b/library/PrimitiveExtras/SparseSmallArray.hs
+@@ -2,7 +2,7 @@ module PrimitiveExtras.SparseSmallArray
+ (
+   SparseSmallArray,
+   empty,
+-  singleton,
++  PrimitiveExtras.SparseSmallArray.singleton,
+   maybeList,
+   pair,
+   insert,
+@@ -50,7 +50,7 @@ empty = SparseSmallArray Bitmap.empty Prelude.empty
+ -- An array with a single element at the specified index.
+ {-# INLINE singleton #-}
+ singleton :: Int -> e -> SparseSmallArray e
+-singleton i e = 
++singleton i e =
+   let b = Bitmap.singleton i
+       a = runST $ newSmallArray 1 e >>= unsafeFreezeSmallArray
+       in SparseSmallArray b a
+@@ -58,9 +58,9 @@ singleton i e =
+ {-# INLINE pair #-}
+ pair :: Int -> e -> Int -> e -> SparseSmallArray e
+ pair i1 e1 i2 e2 =
+-  {-# SCC "pair" #-} 
++  {-# SCC "pair" #-}
+   SparseSmallArray bitmap array
+-  where 
++  where
+     bitmap = Bitmap.pair i1 i2
+     array = SmallArray.orderedPair i1 e1 i2 e2
+ 
+@@ -76,15 +76,15 @@ It's your obligation to ensure that the index is empty before the operation.
+ {-# INLINE insert #-}
+ insert :: Int -> e -> SparseSmallArray e -> SparseSmallArray e
+ insert i e (SparseSmallArray b a) =
+-  {-# SCC "insert" #-} 
++  {-# SCC "insert" #-}
+   let
+     sparseIndex = Bitmap.populatedIndex i b
+     in SparseSmallArray (Bitmap.insert i b) (SmallArray.insert sparseIndex e a)
+-    
++
+ {-# INLINE replace #-}
+ replace :: Int -> e -> SparseSmallArray e -> SparseSmallArray e
+ replace i e (SparseSmallArray b a) =
+-  {-# SCC "replace" #-} 
++  {-# SCC "replace" #-}
+   let
+     sparseIndex = Bitmap.populatedIndex i b
+     in SparseSmallArray b (SmallArray.set sparseIndex e a)
+@@ -109,7 +109,7 @@ unset i (SparseSmallArray b a) =
+ {-# INLINE lookup #-}
+ lookup :: Int -> SparseSmallArray e -> Maybe e
+ lookup i (SparseSmallArray b a) =
+-  {-# SCC "lookup" #-} 
++  {-# SCC "lookup" #-}
+   if Bitmap.isPopulated i b
+     then Just (indexSmallArray a (Bitmap.populatedIndex i b))
+     else Nothing
+@@ -148,7 +148,7 @@ onElementAtFocus index (Focus concealA revealA) = Focus concealSsa revealSsa whe
+       Focus.Remove -> Focus.Leave
+   revealSsa (SparseSmallArray indices array) =
+     fmap (fmap aChangeToSsaChange) $
+-    if Bitmap.isPopulated index indices 
++    if Bitmap.isPopulated index indices
+       then do
+         a <- indexSmallArrayM array (Bitmap.populatedIndex index indices)
+         revealA a
diff --git a/patches/some-1.0.1.patch b/patches/some-1.0.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..7e74db8bc05d42443e992b9d8e2142ad2e727741
--- /dev/null
+++ b/patches/some-1.0.1.patch
@@ -0,0 +1,13 @@
+diff --git a/src/Data/GADT/Internal.hs b/src/Data/GADT/Internal.hs
+index ce347a0..1acb270 100644
+--- a/src/Data/GADT/Internal.hs
++++ b/src/Data/GADT/Internal.hs
+@@ -82,7 +82,7 @@ instance (GShow a, GShow b) => GShow (Product a b) where
+ type GReadS t = String -> [(Some t, String)]
+ 
+ getGReadResult :: Some tag -> (forall a. tag a -> b) -> b
+-getGReadResult = withSome
++getGReadResult s f = withSome s f
+ 
+ mkGReadResult :: tag a -> Some tag
+ mkGReadResult = mkSome
diff --git a/patches/text-builder-0.6.6.1.patch b/patches/text-builder-0.6.6.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..03c19e300da81536ea46eff4c95df970a46f0223
--- /dev/null
+++ b/patches/text-builder-0.6.6.1.patch
@@ -0,0 +1,15 @@
+diff --git a/library/Text/Builder/UTF16.hs b/library/Text/Builder/UTF16.hs
+index 2478b87..1687b9e 100644
+--- a/library/Text/Builder/UTF16.hs
++++ b/library/Text/Builder/UTF16.hs
+@@ -12,8 +12,8 @@ type UTF16View =
+ 
+ {-# INLINE char #-}
+ char :: Char -> UTF16View
+-char =
+-  unicodeCodePoint . ord
++char x =
++  unicodeCodePoint (ord x)
+ 
+ {-# INLINE unicodeCodePoint #-}
+ unicodeCodePoint :: Int -> UTF16View
diff --git a/patches/wai-extra-3.1.4.1.patch b/patches/wai-extra-3.1.4.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
diff --git a/patches/wreq-0.5.3.2.patch b/patches/wreq-0.5.3.2.patch
new file mode 100644
index 0000000000000000000000000000000000000000..a4937ca4e10b9dd9de61c2515a6d34e26b2f38a0
--- /dev/null
+++ b/patches/wreq-0.5.3.2.patch
@@ -0,0 +1,13 @@
+diff --git a/Network/Wreq/Lens.hs b/Network/Wreq/Lens.hs
+index 5b61a85..7114fd8 100644
+--- a/Network/Wreq/Lens.hs
++++ b/Network/Wreq/Lens.hs
+@@ -466,7 +466,7 @@ partGetBody = TH.partGetBody
+ -- >>> r ^. responseHeader "Allow" . atto verbs . to sort
+ -- ["GET","HEAD","OPTIONS"]
+ atto :: Parser a -> Fold ByteString a
+-atto = folding . parseOnly
++atto x = folding (parseOnly x)
+ 
+ -- | The same as 'atto', but ensures that the parser consumes the
+ -- entire input.