diff --git a/patches/attoparsec-0.14.1.patch b/patches/attoparsec-0.14.1.patch
new file mode 100644
index 0000000000000000000000000000000000000000..bd864ca8e5cf9eb5a467cc72309a420f10c220a6
--- /dev/null
+++ b/patches/attoparsec-0.14.1.patch
@@ -0,0 +1,57 @@
+diff --git a/Data/Attoparsec/ByteString/FastSet.hs b/Data/Attoparsec/ByteString/FastSet.hs
+index 5e08fc0..0a1ccdb 100644
+--- a/Data/Attoparsec/ByteString/FastSet.hs
++++ b/Data/Attoparsec/ByteString/FastSet.hs
+@@ -1,3 +1,4 @@
++{-# LANGUAGE CPP #-}
+ {-# LANGUAGE BangPatterns, MagicHash #-}
+ 
+ -----------------------------------------------------------------------------
+@@ -34,13 +35,19 @@ module Data.Attoparsec.ByteString.FastSet
+ 
+ import Data.Bits ((.&.), (.|.))
+ import Foreign.Storable (peekByteOff, pokeByteOff)
+-import GHC.Exts (Int(I#), iShiftRA#, narrow8Word#, shiftL#)
++import GHC.Exts (Int(I#), Word#, iShiftRA#, shiftL#)
+ import GHC.Word (Word8(W8#))
+ import qualified Data.ByteString as B
+ import qualified Data.ByteString.Char8 as B8
+ import qualified Data.ByteString.Internal as I
+ import qualified Data.ByteString.Unsafe as U
+ 
++#if MIN_VERSION_base(4,16,0)
++import GHC.Exts (Word8#, word8ToWord#, wordToWord8#)
++#else
++import GHC.Exts (narrow8Word#)
++#endif
++
+ data FastSet = Sorted { fromSet :: !B.ByteString }
+              | Table  { fromSet :: !B.ByteString }
+     deriving (Eq, Ord)
+@@ -68,7 +75,7 @@ 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# (narrow8WordCompat# (word8ToWordCompat# x# `shiftL#` i#))
+ 
+ index :: Int -> I
+ index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7))
+@@ -113,3 +120,17 @@ charClass = set . B8.pack . go
+     where go (a:'-':b:xs) = [a..b] ++ go xs
+           go (x:xs) = x : go xs
+           go _ = ""
++
++#if MIN_VERSION_base(4,16,0)
++word8ToWordCompat# :: Word8# -> Word#
++word8ToWordCompat# = word8ToWord#
++
++narrow8WordCompat# :: Word# -> Word8#
++narrow8WordCompat# = wordToWord8#
++#else
++word8ToWordCompat# :: Word# -> Word#
++word8ToWordCompat# x = x
++
++narrow8WordCompat# :: Word# -> Word#
++narrow8WordCompat# = narrow8Word#
++#endif