TH-reified data family instances lack arguments since 8.8
Summary
Before GHC 8.8, data family instances' arguments were available from reify
. In GHC 8.8, they are not.
Steps to reproduce
Create two files:
ReportErr1.hs
module ReportErr1 where
import Language.Haskell.TH.Syntax
reportOnDataFamily :: Name -> Q a
reportOnDataFamily familyName = do
fam <- reify familyName
case fam of
FamilyI _ xs -> fail $ "Here is my report: " <> show xs
_ -> fail ":("
ReportErr2.hs
{-# LANGUAGE TypeFamilies #-}
import ReportErr1
data family Foo :: * -> *
data instance Foo Bool
$(reportOnDataFamily ''Foo)
Build:
$ ghc -dynamic ReportErr1
$ ghc ReportErr2
Expected behavior
The instance's argument Bool
should be available. It was before 8.8:
8.4.4 Here is my report: [DataInstD [] Main.Foo [ConT GHC.Types.Bool] Nothing [] []]
8.6.4 Here is my report: [DataInstD [] Main.Foo [ConT GHC.Types.Bool] Nothing [] []]
8.6.5 Here is my report: [DataInstD [] Main.Foo [ConT GHC.Types.Bool] Nothing [] []]
8.8.1 Here is my report: [DataInstD [] Nothing (ConT Main.Foo) Nothing [] []]
8.9.20190601 Here is my report: [DataInstD [] Nothing (ConT Main.Foo) Nothing [] []]
In describing this change, the 8.8 release notes say that the data family instances' arguments should be available in the Type field. The Type field is to contain "the data family name applied to its arguments", but here it contains only the data family name.
Environment
- GHC version used: 8.8.1
Optional:
- Operating System: NixOS
- System Architecture: x86_64