diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
index 5fd54ba7f9e6646a1d0bb488eac6cd25540f2624..1e58344d71f7b06a4437b1b3d2770c905ca051e2 100644
--- a/Cabal/Cabal.cabal
+++ b/Cabal/Cabal.cabal
@@ -118,6 +118,7 @@ library
     Distribution.Simple.PackageDescription
     Distribution.Simple.PackageIndex
     Distribution.Simple.PreProcess
+    Distribution.Simple.PreProcess.Types
     Distribution.Simple.PreProcess.Unlit
     Distribution.Simple.Program
     Distribution.Simple.Program.Ar
diff --git a/Cabal/src/Distribution/Simple/BuildPaths.hs b/Cabal/src/Distribution/Simple/BuildPaths.hs
index 386a6e7fc822cd30405ece11d760c92b489628aa..b4adc37d3e71dec50cedca6eb3eac8e33acaa4f5 100644
--- a/Cabal/src/Distribution/Simple/BuildPaths.hs
+++ b/Cabal/src/Distribution/Simple/BuildPaths.hs
@@ -58,6 +58,7 @@ import Distribution.PackageDescription
 import Distribution.Pretty
 import Distribution.Simple.Errors
 import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.PreProcess.Types (builtinHaskellSuffixes)
 import Distribution.Simple.Setup.Common (defaultDistPref)
 import Distribution.Simple.Setup.Haddock (HaddockTarget (..))
 import Distribution.Simple.Utils
@@ -189,7 +190,7 @@ getSourceFiles
   -> IO [(ModuleName.ModuleName, FilePath)]
 getSourceFiles verbosity dirs modules = flip traverse modules $ \m ->
   fmap ((,) m) $
-    findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m)
+    findFileWithExtension builtinHaskellSuffixes dirs (ModuleName.toFilePath m)
       >>= maybe (notFound m) (return . normalise)
   where
     notFound module_ =
diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs
index 14130b349de9245be0a63656d91a22959d3a579d..2c5af36a04badfd117a0017c5a7016bd66352b6a 100644
--- a/Cabal/src/Distribution/Simple/Errors.hs
+++ b/Cabal/src/Distribution/Simple/Errors.hs
@@ -26,6 +26,7 @@ import Distribution.Pretty
   , prettyShow
   )
 import Distribution.Simple.InstallDirs
+import Distribution.Simple.PreProcess.Types (Suffix)
 import Distribution.System (OS)
 import Distribution.Types.BenchmarkType
 import Distribution.Types.LibraryName
@@ -53,7 +54,7 @@ data CabalException
   | UnsupportedTestSuite String
   | UnsupportedBenchMark String
   | NoIncludeFileFound String
-  | NoModuleFound ModuleName [String]
+  | NoModuleFound ModuleName [Suffix]
   | RegMultipleInstancePkg
   | SuppressingChecksOnFile
   | NoSupportDirStylePackageDb
@@ -153,7 +154,7 @@ data CabalException
   | RawSystemStdout String
   | FindFileCwd FilePath
   | FindFileEx FilePath
-  | FindModuleFileEx ModuleName [String] [FilePath]
+  | FindModuleFileEx ModuleName [Suffix] [FilePath]
   | MultipleFilesWithExtension String
   | NoDesc
   | MultiDesc [String]
@@ -325,7 +326,7 @@ exceptionMessage e = case e of
     "Could not find module: "
       ++ prettyShow m
       ++ " with any suffix: "
-      ++ show suffixes
+      ++ show (map prettyShow suffixes)
       ++ ".\n"
       ++ "If the module "
       ++ "is autogenerated it should be added to 'autogen-modules'."
@@ -730,7 +731,7 @@ exceptionMessage e = case e of
     "Could not find module: "
       ++ prettyShow mod_name
       ++ " with any suffix: "
-      ++ show extensions
+      ++ show (map prettyShow extensions)
       ++ " in the search path: "
       ++ show searchPath
   MultipleFilesWithExtension buildInfoExt -> "Multiple files with extension " ++ buildInfoExt
diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs
index 449dc695a6936fc7e6746ab426b0c38ef0c55511..d22c7f61849ed6687159a225e4f1087cf6e4fce2 100644
--- a/Cabal/src/Distribution/Simple/GHC.hs
+++ b/Cabal/src/Distribution/Simple/GHC.hs
@@ -104,6 +104,7 @@ import qualified Distribution.Simple.GHC.Internal as Internal
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import qualified Distribution.Simple.PackageIndex as PackageIndex
+import Distribution.Simple.PreProcess.Types
 import Distribution.Simple.Program
 import Distribution.Simple.Program.Builtin (runghcProgram)
 import Distribution.Simple.Program.GHC
@@ -826,9 +827,9 @@ installLib
   -> IO ()
 installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do
   -- copy .hi files over:
-  whenVanilla $ copyModuleFiles "hi"
-  whenProf $ copyModuleFiles "p_hi"
-  whenShared $ copyModuleFiles "dyn_hi"
+  whenVanilla $ copyModuleFiles $ Suffix "hi"
+  whenProf $ copyModuleFiles $ Suffix "p_hi"
+  whenShared $ copyModuleFiles $ Suffix "dyn_hi"
 
   -- copy extra compilation artifacts that ghc plugins may produce
   copyDirectoryIfExists extraCompilationArtifacts
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
index ab80a1522685f880e35b3e6f7a9ef85ba95c5ace..f25c60c887d40f9f61f1ec7d9e62c8deb97f4a90 100644
--- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
+++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs
@@ -29,6 +29,7 @@ import Distribution.Simple.GHC.ImplInfo
 import qualified Distribution.Simple.GHC.Internal as Internal
 import Distribution.Simple.LocalBuildInfo
 import qualified Distribution.Simple.PackageIndex as PackageIndex
+import Distribution.Simple.PreProcess.Types
 import Distribution.Simple.Program
 import qualified Distribution.Simple.Program.Ar as Ar
 import Distribution.Simple.Program.GHC
@@ -238,7 +239,7 @@ linkLibrary buildTargetDir cleanedExtraLibDirs pkg_descr verbosity runGhcProg li
         , catMaybes
             <$> sequenceA
               [ findFileWithExtension
-                [buildWayPrefix way ++ objExtension]
+                [Suffix $ buildWayPrefix way ++ objExtension]
                 [buildTargetDir]
                 (ModuleName.toFilePath x ++ "_stub")
               | ghcVersion < mkVersion [7, 2] -- ghc-7.2+ does not make _stub.o files
diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs
index 98daaabf9813cfdd6b17e57e65e9a0c3f709bf43..4e14bc04d5d04875a4838be50678fd6de52f41cc 100644
--- a/Cabal/src/Distribution/Simple/GHCJS.hs
+++ b/Cabal/src/Distribution/Simple/GHCJS.hs
@@ -68,6 +68,7 @@ import qualified Distribution.Simple.Hpc as Hpc
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import qualified Distribution.Simple.PackageIndex as PackageIndex
+import Distribution.Simple.PreProcess.Types
 import Distribution.Simple.Program
 import Distribution.Simple.Program.GHC
 import qualified Distribution.Simple.Program.HcPkg as HcPkg
@@ -1861,9 +1862,9 @@ installLib
   -> ComponentLocalBuildInfo
   -> IO ()
 installLib verbosity lbi targetDir dynlibTargetDir _builtDir _pkg lib clbi = do
-  whenVanilla $ copyModuleFiles "js_hi"
-  whenProf $ copyModuleFiles "js_p_hi"
-  whenShared $ copyModuleFiles "js_dyn_hi"
+  whenVanilla $ copyModuleFiles $ Suffix "js_hi"
+  whenProf $ copyModuleFiles $ Suffix "js_p_hi"
+  whenShared $ copyModuleFiles $ Suffix "js_dyn_hi"
 
   -- whenVanilla $ installOrdinary builtDir targetDir $ toJSLibName vanillaLibName
   -- whenProf    $ installOrdinary builtDir targetDir $ toJSLibName profileLibName
diff --git a/Cabal/src/Distribution/Simple/PreProcess.hs b/Cabal/src/Distribution/Simple/PreProcess.hs
index 886ba7e7fd6ab6e1b673879e0afb50fc2d6359f4..91c8074ca3e977e298060217fb79b651b654811a 100644
--- a/Cabal/src/Distribution/Simple/PreProcess.hs
+++ b/Cabal/src/Distribution/Simple/PreProcess.hs
@@ -11,21 +11,23 @@
 -- Maintainer  :  cabal-devel@haskell.org
 -- Portability :  portable
 --
--- This defines a 'PreProcessor' abstraction which represents a pre-processor
--- that can transform one kind of file into another. There is also a
--- 'PPSuffixHandler' which is a combination of a file extension and a function
--- for configuring a 'PreProcessor'. It defines a bunch of known built-in
--- preprocessors like @cpp@, @cpphs@, @c2hs@, @hsc2hs@, @happy@, @alex@ etc and
--- lists them in 'knownSuffixHandlers'. On top of this it provides a function
--- for actually preprocessing some sources given a bunch of known suffix
--- handlers. This module is not as good as it could be, it could really do with
--- a rewrite to address some of the problems we have with pre-processors.
+-- This module defines 'PPSuffixHandler', which is a combination of a file
+-- extension and a function for configuring a 'PreProcessor'. It also defines
+-- a bunch of known built-in preprocessors like @cpp@, @cpphs@, @c2hs@,
+-- @hsc2hs@, @happy@, @alex@ etc and lists them in 'knownSuffixHandlers'.
+-- On top of this it provides a function for actually preprocessing some sources
+-- given a bunch of known suffix handlers.
+-- This module is not as good as it could be, it could really do with a rewrite
+-- to address some of the problems we have with pre-processors.
 module Distribution.Simple.PreProcess
   ( preprocessComponent
   , preprocessExtras
   , knownSuffixHandlers
   , ppSuffixes
   , PPSuffixHandler
+  , Suffix (..)
+  , builtinHaskellSuffixes
+  , builtinHaskellBootSuffixes
   , PreProcessor (..)
   , mkSimplePreProcessor
   , runSimplePreProcessor
@@ -58,6 +60,7 @@ import Distribution.Simple.Compiler
 import Distribution.Simple.Errors
 import Distribution.Simple.LocalBuildInfo
 import qualified Distribution.Simple.PackageIndex as PackageIndex
+import Distribution.Simple.PreProcess.Types
 import Distribution.Simple.PreProcess.Unlit
 import Distribution.Simple.Program
 import Distribution.Simple.Program.ResponseFile
@@ -81,69 +84,6 @@ import System.FilePath
   )
 import System.Info (arch, os)
 
--- | The interface to a preprocessor, which may be implemented using an
---  external program, but need not be.  The arguments are the name of
---  the input file, the name of the output file and a verbosity level.
---  Here is a simple example that merely prepends a comment to the given
---  source file:
---
---  > ppTestHandler :: PreProcessor
---  > ppTestHandler =
---  >   PreProcessor {
---  >     platformIndependent = True,
---  >     runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
---  >       do info verbosity (inFile++" has been preprocessed to "++outFile)
---  >          stuff <- readFile inFile
---  >          writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff)
---  >          return ExitSuccess
---
---  We split the input and output file names into a base directory and the
---  rest of the file name. The input base dir is the path in the list of search
---  dirs that this file was found in. The output base dir is the build dir where
---  all the generated source files are put.
---
---  The reason for splitting it up this way is that some pre-processors don't
---  simply generate one output .hs file from one input file but have
---  dependencies on other generated files (notably c2hs, where building one
---  .hs file may require reading other .chi files, and then compiling the .hs
---  file may require reading a generated .h file). In these cases the generated
---  files need to embed relative path names to each other (eg the generated .hs
---  file mentions the .h file in the FFI imports). This path must be relative to
---  the base directory where the generated files are located, it cannot be
---  relative to the top level of the build tree because the compilers do not
---  look for .h files relative to there, ie we do not use \"-I .\", instead we
---  use \"-I dist\/build\" (or whatever dist dir has been set by the user)
---
---  Most pre-processors do not care of course, so mkSimplePreProcessor and
---  runSimplePreProcessor functions handle the simple case.
-data PreProcessor = PreProcessor
-  { -- Is the output of the pre-processor platform independent? eg happy output
-    -- is portable haskell but c2hs's output is platform dependent.
-    -- This matters since only platform independent generated code can be
-    -- included into a source tarball.
-    platformIndependent :: Bool
-  , -- TODO: deal with pre-processors that have implementation dependent output
-    --       eg alex and happy have --ghc flags. However we can't really include
-    --       ghc-specific code into supposedly portable source tarballs.
-
-    ppOrdering
-      :: Verbosity
-      -> [FilePath] -- Source directories
-      -> [ModuleName] -- Module names
-      -> IO [ModuleName] -- Sorted modules
-
-  -- ^ This function can reorder /all/ modules, not just those that the
-  -- require the preprocessor in question. As such, this function should be
-  -- well-behaved and not reorder modules it doesn't have dominion over!
-  --
-  -- @since 3.8.1.0
-  , runPreProcessor
-      :: (FilePath, FilePath) -- Location of the source file relative to a base dir
-      -> (FilePath, FilePath) -- Output file name, relative to an output base dir
-      -> Verbosity -- verbosity
-      -> IO () -- Should exit if the preprocessor fails
-  }
-
 -- | Just present the modules in the order given; this is the default and it is
 -- appropriate for preprocessors which do not have any sort of dependencies
 -- between modules.
@@ -184,10 +124,10 @@ runSimplePreProcessor
 runSimplePreProcessor pp inFile outFile verbosity =
   runPreProcessor pp (".", inFile) (".", outFile) verbosity
 
--- | A preprocessor for turning non-Haskell files with the given extension
---  into plain Haskell source files.
+-- | A preprocessor for turning non-Haskell files with the given 'Suffix'
+-- (i.e. file extension) into plain Haskell source files.
 type PPSuffixHandler =
-  (String, BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor)
+  (Suffix, BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor)
 
 -- | Apply preprocessors to the sources from 'hsSourceDirs' for a given
 -- component (lib, exe, or test suite).
@@ -274,8 +214,7 @@ preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers =
   where
     orderingFromHandlers v d hndlrs mods =
       foldM (\acc (_, pp) -> ppOrdering pp v d acc) mods hndlrs
-    builtinHaskellSuffixes = ["hs", "lhs", "hsig", "lhsig"]
-    builtinCSuffixes = cSourceExtensions
+    builtinCSuffixes = map Suffix cSourceExtensions
     builtinSuffixes = builtinHaskellSuffixes ++ builtinCSuffixes
     localHandlers bi = [(ext, h bi lbi clbi) | (ext, h) <- handlers]
     pre dirs dir lhndlrs fp =
@@ -344,9 +283,9 @@ preprocessFile
   -- ^ module file name
   -> Verbosity
   -- ^ verbosity
-  -> [String]
+  -> [Suffix]
   -- ^ builtin suffixes
-  -> [(String, PreProcessor)]
+  -> [(Suffix, PreProcessor)]
   -- ^ possible preprocessors
   -> Bool
   -- ^ fail on missing file
@@ -381,7 +320,7 @@ preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes ha
           pp =
             fromMaybe
               (error "Distribution.Simple.PreProcess: Just expected")
-              (lookup (safeTail ext) handlers)
+              (lookup (Suffix $ safeTail ext) handlers)
       -- Preprocessing files for 'sdist' is different from preprocessing
       -- for 'build'.  When preprocessing for sdist we preprocess to
       -- avoid that the user has to have the preprocessors available.
@@ -901,19 +840,19 @@ standardPP lbi prog args =
     }
 
 -- | Convenience function; get the suffixes of these preprocessors.
-ppSuffixes :: [PPSuffixHandler] -> [String]
+ppSuffixes :: [PPSuffixHandler] -> [Suffix]
 ppSuffixes = map fst
 
 -- | Standard preprocessors: GreenCard, c2hs, hsc2hs, happy, alex and cpphs.
 knownSuffixHandlers :: [PPSuffixHandler]
 knownSuffixHandlers =
-  [ ("gc", ppGreenCard)
-  , ("chs", ppC2hs)
-  , ("hsc", ppHsc2hs)
-  , ("x", ppAlex)
-  , ("y", ppHappy)
-  , ("ly", ppHappy)
-  , ("cpphs", ppCpp)
+  [ (Suffix "gc", ppGreenCard)
+  , (Suffix "chs", ppC2hs)
+  , (Suffix "hsc", ppHsc2hs)
+  , (Suffix "x", ppAlex)
+  , (Suffix "y", ppHappy)
+  , (Suffix "ly", ppHappy)
+  , (Suffix "cpphs", ppCpp)
   ]
 
 -- | Standard preprocessors with possible extra C sources: c2hs, hsc2hs.
diff --git a/Cabal/src/Distribution/Simple/PreProcess/Types.hs b/Cabal/src/Distribution/Simple/PreProcess/Types.hs
new file mode 100644
index 0000000000000000000000000000000000000000..02a5bdbc531c558884538515d901de0d03ee5b1c
--- /dev/null
+++ b/Cabal/src/Distribution/Simple/PreProcess/Types.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes #-}
+
+-----------------------------------------------------------------------------
+
+-- |
+-- Module      :  Distribution.Simple.PreProcess.Types
+-- Copyright   :  (c) 2003-2005, Isaac Jones, Malcolm Wallace
+-- License     :  BSD3
+--
+-- Maintainer  :  cabal-devel@haskell.org
+-- Portability :  portable
+--
+-- This defines a 'PreProcessor' abstraction which represents a pre-processor
+-- that can transform one kind of file into another.
+module Distribution.Simple.PreProcess.Types
+  ( Suffix (..)
+  , PreProcessor (..)
+  , builtinHaskellSuffixes
+  , builtinHaskellBootSuffixes
+  )
+where
+
+import Distribution.Compat.Prelude
+import Prelude ()
+
+import Distribution.ModuleName (ModuleName)
+import Distribution.Pretty
+import Distribution.Verbosity
+import qualified Text.PrettyPrint as Disp
+
+-- | The interface to a preprocessor, which may be implemented using an
+--  external program, but need not be.  The arguments are the name of
+--  the input file, the name of the output file and a verbosity level.
+--  Here is a simple example that merely prepends a comment to the given
+--  source file:
+--
+--  > ppTestHandler :: PreProcessor
+--  > ppTestHandler =
+--  >   PreProcessor {
+--  >     platformIndependent = True,
+--  >     runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->
+--  >       do info verbosity (inFile++" has been preprocessed to "++outFile)
+--  >          stuff <- readFile inFile
+--  >          writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff)
+--  >          return ExitSuccess
+--
+--  We split the input and output file names into a base directory and the
+--  rest of the file name. The input base dir is the path in the list of search
+--  dirs that this file was found in. The output base dir is the build dir where
+--  all the generated source files are put.
+--
+--  The reason for splitting it up this way is that some pre-processors don't
+--  simply generate one output .hs file from one input file but have
+--  dependencies on other generated files (notably c2hs, where building one
+--  .hs file may require reading other .chi files, and then compiling the .hs
+--  file may require reading a generated .h file). In these cases the generated
+--  files need to embed relative path names to each other (eg the generated .hs
+--  file mentions the .h file in the FFI imports). This path must be relative to
+--  the base directory where the generated files are located, it cannot be
+--  relative to the top level of the build tree because the compilers do not
+--  look for .h files relative to there, ie we do not use \"-I .\", instead we
+--  use \"-I dist\/build\" (or whatever dist dir has been set by the user)
+--
+--  Most pre-processors do not care of course, so mkSimplePreProcessor and
+--  runSimplePreProcessor functions handle the simple case.
+data PreProcessor = PreProcessor
+  { -- Is the output of the pre-processor platform independent? eg happy output
+    -- is portable haskell but c2hs's output is platform dependent.
+    -- This matters since only platform independent generated code can be
+    -- included into a source tarball.
+    platformIndependent :: Bool
+  , -- TODO: deal with pre-processors that have implementation dependent output
+    --       eg alex and happy have --ghc flags. However we can't really include
+    --       ghc-specific code into supposedly portable source tarballs.
+
+    ppOrdering
+      :: Verbosity
+      -> [FilePath] -- Source directories
+      -> [ModuleName] -- Module names
+      -> IO [ModuleName] -- Sorted modules
+
+  -- ^ This function can reorder /all/ modules, not just those that the
+  -- require the preprocessor in question. As such, this function should be
+  -- well-behaved and not reorder modules it doesn't have dominion over!
+  --
+  -- @since 3.8.1.0
+  , runPreProcessor
+      :: (FilePath, FilePath) -- Location of the source file relative to a base dir
+      -> (FilePath, FilePath) -- Output file name, relative to an output base dir
+      -> Verbosity -- verbosity
+      -> IO () -- Should exit if the preprocessor fails
+  }
+
+-- | A suffix (or file extension).
+--
+-- Mostly used to decide which preprocessor to use, e.g. files with suffix @"y"@
+-- are usually processed by the @"happy"@ build tool.
+newtype Suffix = Suffix String
+  deriving (Eq, Ord, Show, Generic, IsString)
+
+instance Pretty Suffix where
+  pretty (Suffix s) = Disp.text s
+
+instance Binary Suffix
+instance Structured Suffix
+
+builtinHaskellSuffixes :: [Suffix]
+builtinHaskellSuffixes = map Suffix ["hs", "lhs", "hsig", "lhsig"]
+
+builtinHaskellBootSuffixes :: [Suffix]
+builtinHaskellBootSuffixes = map Suffix ["hs-boot", "lhs-boot"]
diff --git a/Cabal/src/Distribution/Simple/SrcDist.hs b/Cabal/src/Distribution/Simple/SrcDist.hs
index 6c4890ee3dc54fca4fbcb19840d279b2d54cf3f6..90250290fc1a204c4b1b4332265d5888e832724d 100644
--- a/Cabal/src/Distribution/Simple/SrcDist.hs
+++ b/Cabal/src/Distribution/Simple/SrcDist.hs
@@ -522,7 +522,7 @@ allSourcesBuildInfo verbosity rip cwd bi pps modules = do
   bootFiles <-
     sequenceA
       [ let file = ModuleName.toFilePath module_
-            fileExts = ["hs-boot", "lhs-boot"]
+            fileExts = builtinHaskellBootSuffixes
          in findFileCwdWithExtension cwd fileExts (map getSymbolicPath (hsSourceDirs bi)) file
       | module_ <- modules ++ otherModules bi
       ]
@@ -540,7 +540,7 @@ allSourcesBuildInfo verbosity rip cwd bi pps modules = do
     nonEmpty' x _ [] = x
     nonEmpty' _ f xs = f xs
 
-    suffixes = ppSuffixes pps ++ ["hs", "lhs", "hsig", "lhsig"]
+    suffixes = ppSuffixes pps ++ builtinHaskellSuffixes
 
     notFound :: ModuleName -> IO [FilePath]
     notFound m =
diff --git a/Cabal/src/Distribution/Simple/Utils.hs b/Cabal/src/Distribution/Simple/Utils.hs
index 64b22c5abee3f067af28b82e259b2cca9c07125e..1da133ca4c4e13e519afa802cc4c14885ccc0f51 100644
--- a/Cabal/src/Distribution/Simple/Utils.hs
+++ b/Cabal/src/Distribution/Simple/Utils.hs
@@ -201,6 +201,7 @@ import Distribution.Compat.Prelude
 import Distribution.Compat.Stack
 import Distribution.ModuleName as ModuleName
 import Distribution.Simple.Errors
+import Distribution.Simple.PreProcess.Types
 import Distribution.System
 import Distribution.Types.PackageId
 import Distribution.Utils.Generic
@@ -1222,7 +1223,7 @@ findFileEx verbosity searchPath fileName =
 -- file extensions. The file base name should be given and it will be tried
 -- with each of the extensions in each element of the search path.
 findFileWithExtension
-  :: [String]
+  :: [Suffix]
   -> [FilePath]
   -> FilePath
   -> IO (Maybe FilePath)
@@ -1231,13 +1232,13 @@ findFileWithExtension extensions searchPath baseName =
     id
     [ path </> baseName <.> ext
     | path <- ordNub searchPath
-    , ext <- ordNub extensions
+    , Suffix ext <- ordNub extensions
     ]
 
 -- | @since 3.4.0.0
 findFileCwdWithExtension
   :: FilePath
-  -> [String]
+  -> [Suffix]
   -> [FilePath]
   -> FilePath
   -> IO (Maybe FilePath)
@@ -1246,14 +1247,14 @@ findFileCwdWithExtension cwd extensions searchPath baseName =
     (cwd </>)
     [ path </> baseName <.> ext
     | path <- ordNub searchPath
-    , ext <- ordNub extensions
+    , Suffix ext <- ordNub extensions
     ]
 
 -- | @since 3.4.0.0
 findAllFilesCwdWithExtension
   :: FilePath
   -- ^ cwd
-  -> [String]
+  -> [Suffix]
   -- ^ extensions
   -> [FilePath]
   -- ^ relative search locations
@@ -1265,11 +1266,11 @@ findAllFilesCwdWithExtension cwd extensions searchPath basename =
     (cwd </>)
     [ path </> basename <.> ext
     | path <- ordNub searchPath
-    , ext <- ordNub extensions
+    , Suffix ext <- ordNub extensions
     ]
 
 findAllFilesWithExtension
-  :: [String]
+  :: [Suffix]
   -> [FilePath]
   -> FilePath
   -> IO [FilePath]
@@ -1278,13 +1279,13 @@ findAllFilesWithExtension extensions searchPath basename =
     id
     [ path </> basename <.> ext
     | path <- ordNub searchPath
-    , ext <- ordNub extensions
+    , Suffix ext <- ordNub extensions
     ]
 
 -- | Like 'findFileWithExtension' but returns which element of the search path
 -- the file was found in, and the file path relative to that base directory.
 findFileWithExtension'
-  :: [String]
+  :: [Suffix]
   -> [FilePath]
   -> FilePath
   -> IO (Maybe (FilePath, FilePath))
@@ -1293,7 +1294,7 @@ findFileWithExtension' extensions searchPath baseName =
     (uncurry (</>))
     [ (path, baseName <.> ext)
     | path <- ordNub searchPath
-    , ext <- ordNub extensions
+    , Suffix ext <- ordNub extensions
     ]
 
 findFirstFile :: (a -> FilePath) -> [a] -> IO (Maybe a)
@@ -1316,7 +1317,7 @@ findModuleFilesEx
   :: Verbosity
   -> [FilePath]
   -- ^ build prefix (location of objects)
-  -> [String]
+  -> [Suffix]
   -- ^ search suffixes
   -> [ModuleName]
   -- ^ modules
@@ -1332,7 +1333,7 @@ findModuleFileEx
   :: Verbosity
   -> [FilePath]
   -- ^ build prefix (location of objects)
-  -> [String]
+  -> [Suffix]
   -- ^ search suffixes
   -> ModuleName
   -- ^ module
diff --git a/cabal-install/src/Distribution/Client/RebuildMonad.hs b/cabal-install/src/Distribution/Client/RebuildMonad.hs
index 83535994ac017b066f247c7f3a6fc7419efcd9a8..33303ea3243689383c5dc3d910d466c4229471db 100644
--- a/cabal-install/src/Distribution/Client/RebuildMonad.hs
+++ b/cabal-install/src/Distribution/Client/RebuildMonad.hs
@@ -63,6 +63,7 @@ import Prelude ()
 import Distribution.Client.FileMonitor
 import Distribution.Client.Glob hiding (matchFileGlob)
 import qualified Distribution.Client.Glob as Glob (matchFileGlob)
+import Distribution.Simple.PreProcess.Types (Suffix (..))
 
 import Distribution.Simple.Utils (debug)
 
@@ -296,7 +297,7 @@ needIfExists f = do
 
 -- | Like 'findFileWithExtension', but in the 'Rebuild' monad.
 findFileWithExtensionMonitored
-  :: [String]
+  :: [Suffix]
   -> [FilePath]
   -> FilePath
   -> Rebuild (Maybe FilePath)
@@ -305,7 +306,7 @@ findFileWithExtensionMonitored extensions searchPath baseName =
     id
     [ path </> baseName <.> ext
     | path <- nub searchPath
-    , ext <- nub extensions
+    , Suffix ext <- nub extensions
     ]
 
 -- | Like 'findFirstFile', but in the 'Rebuild' monad.
diff --git a/cabal-install/src/Distribution/Client/SourceFiles.hs b/cabal-install/src/Distribution/Client/SourceFiles.hs
index ddff8dad99f4461de9fafd817e7c27c02b0b9267..f8fdcdcc9f9795ae1cf732a5a3322e71f45acc64 100644
--- a/cabal-install/src/Distribution/Client/SourceFiles.hs
+++ b/cabal-install/src/Distribution/Client/SourceFiles.hs
@@ -167,8 +167,8 @@ needBuildInfo :: PackageDescription -> BuildInfo -> [ModuleName] -> Rebuild ()
 needBuildInfo pkg_descr bi modules = do
   -- NB: These are separate because there may be both A.hs and
   -- A.hs-boot; need to track both.
-  findNeededModules ["hs", "lhs", "hsig", "lhsig"]
-  findNeededModules ["hs-boot", "lhs-boot"]
+  findNeededModules builtinHaskellSuffixes
+  findNeededModules builtinHaskellBootSuffixes
   root <- askRoot
   expandedExtraSrcFiles <- liftIO $ fmap concat . for (extraSrcFiles pkg_descr) $ \fpath -> matchDirFileGlobWithDie normal (\_ _ -> return []) (specVersion pkg_descr) root fpath
   traverse_ needIfExists $
@@ -184,12 +184,12 @@ needBuildInfo pkg_descr bi modules = do
     findFileMonitored ("." : includeDirs bi) f
       >>= maybe (return ()) need
   where
-    findNeededModules :: [String] -> Rebuild ()
+    findNeededModules :: [Suffix] -> Rebuild ()
     findNeededModules exts =
       traverse_
         (findNeededModule exts)
         (modules ++ otherModules bi)
-    findNeededModule :: [String] -> ModuleName -> Rebuild ()
+    findNeededModule :: [Suffix] -> ModuleName -> Rebuild ()
     findNeededModule exts m =
       findFileWithExtensionMonitored
         (ppSuffixes knownSuffixHandlers ++ exts)
diff --git a/cabal-testsuite/PackageTests/AutogenModulesToggling/Setup.hs b/cabal-testsuite/PackageTests/AutogenModulesToggling/Setup.hs
index 2eab853cdfba1ae25da472b7dc96fbdc001e1066..76fec15e076d315e31d6e3921519702cf441b18d 100644
--- a/cabal-testsuite/PackageTests/AutogenModulesToggling/Setup.hs
+++ b/cabal-testsuite/PackageTests/AutogenModulesToggling/Setup.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 
 module Main (main) where
 
diff --git a/cabal-testsuite/PackageTests/CustomPreProcess/Setup.hs b/cabal-testsuite/PackageTests/CustomPreProcess/Setup.hs
index 93ff6a015e921f2ba266baff72a19dce1fdef3e2..2b7d59d62970797c97508ac385e3b206ae4dddd5 100644
--- a/cabal-testsuite/PackageTests/CustomPreProcess/Setup.hs
+++ b/cabal-testsuite/PackageTests/CustomPreProcess/Setup.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -Wall #-}
 
 -- The logic here is tricky.