Merge pull request #7 from ncfavier/fix-skolem-trick

Fix the Skolem trick with GHC ≥ 9.4
obsidiansystems · Dec 6, 2023 · 6c42332 · 6c42332
2 parents c6b916a + 6614029
commit 6c42332
Show file tree

Hide file tree

Showing 3 changed files with 6 additions and 19 deletions.
diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml
@@ -6,7 +6,7 @@ jobs:
   build:
     strategy:
       matrix:
-        ghc: ['8.4.4', '8.6.5', '8.8.4', '8.10.7', '9.0.2', '9.6.1']
+        ghc: ['8.4.4', '8.6.5', '8.8.4', '8.10.7', '9.0.2', '9.2.5', '9.4.5', '9.6.1']
         os: ['ubuntu-latest', 'macos-latest']
     runs-on: ${{ matrix.os }}
 

diff --git a/dependent-sum-template.cabal b/dependent-sum-template.cabal
@@ -19,6 +19,8 @@ tested-with:            GHC == 8.4.4,
                         GHC == 8.8.4,
                         GHC == 8.10.7,
                         GHC == 9.0.2,
+                        GHC == 9.2.5,
+                        GHC == 9.4.5,
                         GHC == 9.6.1
 
 extra-source-files:     ChangeLog.md

diff --git a/src/Data/GADT/TH/Internal.hs b/src/Data/GADT/TH/Internal.hs
@@ -6,14 +6,12 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE DataKinds #-}
 
 -- | Shared functions for dependent-sum-template
 module Data.GADT.TH.Internal where
 
 import Control.Monad
 import Control.Monad.Writer
-import qualified Data.Kind
 import Data.List (foldl', drop)
 import Data.Maybe
 import Data.Map (Map)
@@ -36,8 +34,8 @@ classHeadToParams t = (h, reverse reversedParams)
         in (h, x : reversedParams)
       _ -> (headOfType t, [])
 
--- Do not export this type family, it must remain empty. It's used as a way to trick GHC into not unifying certain type variables.
-type family Skolem :: k -> k
+-- Do not export this data family, it must remain empty. It's used as a way to trick GHC into not unifying certain type variables.
+data family Skolem :: k -> k
 
 skolemize :: Set Name -> Type -> Type
 skolemize rigids t = case t of
@@ -52,21 +50,8 @@ skolemize rigids t = case t of
   ParensT t -> ParensT (skolemize rigids t)
   _ -> t
 
-reifyInstancesBroken :: Q Bool
-reifyInstancesBroken = do
-  a <- newName "a"
-  ins <- reifyInstancesWithRigids' (Set.singleton a) ''Show [VarT a]
-  pure $ not $ null ins
-
-reifyInstancesWithRigids' :: Set Name -> Name -> [Type] -> Q [InstanceDec]
-reifyInstancesWithRigids' rigids cls tys = reifyInstances cls (map (skolemize rigids) tys)
-
 reifyInstancesWithRigids :: Set Name -> Name -> [Type] -> Q [InstanceDec]
-reifyInstancesWithRigids rigids cls tys = do
-  isBroken <- reifyInstancesBroken
-  if isBroken
-    then fail "Unsupported GHC version: 'reifyInstances' in this version of GHC returns instances when we expect an empty list. See https://gitlab.haskell.org/ghc/ghc/-/issues/23743"
-    else reifyInstancesWithRigids' rigids cls tys
+reifyInstancesWithRigids rigids cls tys = reifyInstances cls (map (skolemize rigids) tys)
 
 -- | Determine the type variables which occur freely in a type.
 freeTypeVariables :: Type -> Set Name