Skip to content
GitLab
Projects Groups Topics Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Register
  • Sign in
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributor statistics
    • Graph
    • Compare revisions
    • Locked files
  • Issues 5.6k
    • Issues 5.6k
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 662
    • Merge requests 662
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Artifacts
    • Schedules
    • Test cases
  • Deployments
    • Deployments
    • Releases
  • Packages and registries
    • Packages and registries
    • Model experiments
  • Analytics
    • Analytics
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell CompilerGlasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #14860

QuantifiedConstraints: Can't quantify constraint involving type family

This program fails to typecheck using the wip/T2893 branch, to my surprise:

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Bug where

import Data.Proxy

type family   Apply (f :: * -> *) a
type instance Apply Proxy a = Proxy a

data ExTyFam f where
  MkExTyFam :: Apply f a -> ExTyFam f

instance (forall a. Show (Apply f a)) => Show (ExTyFam f) where
  show (MkExTyFam x) = show x
  showsPrec = undefined -- Not defining these leads to the oddities observed in
  showList = undefined  -- https://ghc.haskell.org/trac/ghc/ticket/5927#comment:32

test :: ExTyFam Proxy -> String
test = show

This fails with:

$ ghc-cq/inplace/bin/ghc-stage2 --interactive Bug.hs
GHCi, version 8.5.20180128: http://www.haskell.org/ghc/  :? for help
Loaded GHCi configuration from /home/rgscott/.ghci
[1 of 1] Compiling Bug              ( Bug.hs, interpreted )

Bug.hs:17:24: error:
    • Could not deduce (Show (Apply f a)) arising from a use of ‘show’
      from the context: forall a. Show (Apply f a)
        bound by the instance declaration at Bug.hs:16:10-57
    • In the expression: show x
      In an equation for ‘show’: show (MkExTyFam x) = show x
      In the instance declaration for ‘Show (ExTyFam f)’
   |
17 |   show (MkExTyFam x) = show x
   |                        ^^^^^^

I would have expected the (forall a. Show (Apply f a)) quantified constraint to kick in, but it didn't.

Trac metadata
Trac field Value
Version 8.5
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler (Type checker)
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking