Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Template Haskell 2.17 compatibility
Handle the following changes in a backwards compatible manner:
 - TyVarBndr is now annotated with a flag.
 - The data constructors DoE and MDoE got a new Maybe ModName argument
   to describe the qualifier of do blocks.
  • Loading branch information
apoikos committed Dec 8, 2022
1 parent a052bb9 commit b279fa7
Show file tree
Hide file tree
Showing 2 changed files with 17 additions and 2 deletions.
4 changes: 2 additions & 2 deletions src/Ganeti/THH.hs
Expand Up @@ -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) |]
Expand Down Expand Up @@ -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.
Expand Down
15 changes: 15 additions & 0 deletions src/Ganeti/THH/Compat.hs
Expand Up @@ -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
--
Expand All @@ -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
Expand Down Expand Up @@ -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

0 comments on commit b279fa7

Please sign in to comment.