Handle GHC 9 changes in a backwards compatible manner.

Taken from upstream:

  https://github.com/ganeti/ganeti/commit/b279fa738fd5b30320584f79f4d2f0e894315aab

diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs
index 818c11f84..9ab93d5e3 100644
--- a/src/Ganeti/THH.hs
+++ b/src/Ganeti/THH.hs
@@ -884,7 +884,7 @@ genLoadOpCode opdefs fn = do
                   ) $ zip mexps opdefs
       defmatch = Match WildP (NormalB fails) []
       cst = NoBindS $ CaseE (VarE opid) $ mpats++[defmatch]
-      body = DoE [st, cst]
+      body = mkDoE [st, cst]
   -- include "OP_ID" to the list of used keys
   bodyAndOpId <- [| $(return body)
                     <* tell (mkUsedKeys . S.singleton . T.pack $ opidKey) |]
@@ -1541,7 +1541,7 @@ loadExcConstructor inname sname fields = do
                 [x] -> BindS (ListP [VarP x])
                 _   -> BindS (TupP (map VarP f_names))
       cval = appCons name $ map VarE f_names
-  return $ DoE [binds read_args, NoBindS (AppE (VarE 'return) cval)]
+  return $ mkDoE [binds read_args, NoBindS (AppE (VarE 'return) cval)]
 
 {-| Generates the loadException function.
 
diff --git a/src/Ganeti/THH/Compat.hs b/src/Ganeti/THH/Compat.hs
index d29e30d18..1f51e49d7 100644
--- a/src/Ganeti/THH/Compat.hs
+++ b/src/Ganeti/THH/Compat.hs
@@ -40,9 +40,11 @@ module Ganeti.THH.Compat
   , extractDataDConstructors
   , myNotStrict
   , nonUnaryTupE
+  , mkDoE
   ) where
 
 import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
 
 -- | Convert Names to DerivClauses
 --
@@ -61,7 +63,11 @@ derivesFromNames names = map ConT names
 --
 -- Handle TH 2.11 and 2.12 changes in a transparent manner using the pre-2.11
 -- API.
+#if MIN_VERSION_template_haskell(2,17,0)
+gntDataD :: Cxt -> Name -> [TyVarBndr ()] -> [Con] -> [Name] -> Dec
+#else
 gntDataD :: Cxt -> Name -> [TyVarBndr] -> [Con] -> [Name] -> Dec
+#endif
 gntDataD x y z a b =
 #if MIN_VERSION_template_haskell(2,12,0)
     DataD x y z Nothing a $ derivesFromNames b
@@ -114,3 +120,12 @@ nonUnaryTupE es = TupE $ map Just es
 #else
 nonUnaryTupE es = TupE $ es
 #endif
+
+-- | DoE is now qualified with an optional ModName
+mkDoE :: [Stmt] -> Exp
+mkDoE s =
+#if MIN_VERSION_template_haskell(2,17,0)
+    DoE Nothing s
+#else
+    DoE s
+#endif
th class='left'>Age</th><th class='left'>Commit message (<a href='/guix/log/gnu/ci.scm?id=5cace974a4c10b4748b526dba5d20e12afbd2835&amp;showmsg=1'>Expand</a>)</th><th class='left'>Author</th></tr>
<tr><td><span title='2019-08-26 13:40:46 +0200'>2019-08-26</span></td><td><a href='/guix/commit/gnu/ci.scm?id=f00ff8db9253b077ea625072d41f573cd1f73f3d'>ci: Try hard to build package replacements.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2019-08-14 21:29:53 +0200'>2019-08-14</span></td><td><a href='/guix/commit/gnu/ci.scm?id=67dac6b8920755cb011047157bb7b4fae4760143'>gnu: mingw: Add x86_64 support.</a><span class='msg-avail'>...</span></td><td>Carl Dong</td></tr>
<tr><td><span title='2019-07-06 16:17:24 +0200'>2019-07-06</span></td><td><a href='/guix/commit/gnu/ci.scm?id=c3ab921eed2a471022e9863a94ea521508782e53'>ci: 'channel-build-system' honors the target system.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2019-03-13 23:12:43 +0100'>2019-03-13</span></td><td><a href='/guix/commit/gnu/ci.scm?id=59e80445882f8b0379e54916f89510c0deda6698'>Remove traces of "GuixSD".</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2019-01-21 10:19:31 +0100'>2019-01-21</span></td><td><a href='/guix/commit/gnu/ci.scm?id=c680a7daa5e143dd37d1d045805e073497c591be'>ci: Skip system tests on armhf-linux.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2019-01-20 01:42:11 +0100'>2019-01-20</span></td><td><a href='/guix/commit/gnu/ci.scm?id=7e6d8d366a61f951936ed83371877ce006f679f6'>ci: Use a valid 'current-guix'.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2019-01-06 21:41:07 +0100'>2019-01-06</span></td><td><a href='/guix/commit/gnu/ci.scm?id=b5f8c2c88543158e8aca76aa98f9009f6b9e743a'>hydra: Compute jobs in an inferior.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2019-01-06 21:41:07 +0100'>2019-01-06</span></td><td><a href='/guix/commit/gnu/ci.scm?id=59fb5c1cdb6fa5d6d1dbeca58e33f4a01a7d98f8'>hydra: Move job definitions to (gnu ci).</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>