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 664
    • Merge requests 664
  • 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
  • #18622

Should unary tuple generated by `tupleT 1` ignored?

Summary

Since GHC 8.10.1, tupleT 1 appT conT ''SomeType generates Unit SomeType instead of just SomeType.
Due to this behavior, my package isn't compiled as expected.

Steps to reproduce

Here is the minimum code to reproduce:

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}

import Language.Haskell.TH.Lib

data ExampleData = ExampleData deriving Show

class ExampleClass a where
  exampleMethod :: a -> String

$(
  [d|
    instance ExampleClass $(tupleT 1 `appT` conT ''ExampleData)  where
      exampleMethod _ = "ExampleData"
    |]
  )

main :: IO ()
main = print $ exampleMethod ExampleData

Expected behavior

Should be successfully compiled. But actually GHC reports an error like below:

example-unary-tuple-th.hs:20:16: error:
    • No instance for (ExampleClass ExampleData)
        arising from a use of ‘exampleMethod’
    • In the second argument of ‘($)’, namely
        ‘exampleMethod ExampleData’
      In the expression: print $ exampleMethod ExampleData
      In an equation for ‘main’: main = print $ exampleMethod ExampleData
   |
20 | main = print $ exampleMethod ExampleData
   |                ^^^^^^^^^^^^^^^^^^^^^^^^^

Additional details

Compiling with -ddump-splices, I found GHC interprets $(tupleT 1 appT conT ''ExampleData) as Unit ExampleData instead of ExampleData:

example-unary-tuple-th.hs:(13,3)-(16,6): Splicing declarations
    [d| instance ExampleClass $(tupleT 1
                                  `appT` conT ''ExampleData) where
          exampleMethod _ = "ExampleData" |]
    pending(rn) [<splice_aEd, tupleT 1 `appT` conT ''ExampleData>]
  ======>
    instance ExampleClass Unit ExampleData where
      exampleMethod _ = "ExampleData"

I assume this is the cause.

Perhaps related issue: #17511 (closed)

When this causes a problem

In my package, typesafe-precure, many instances of type classes are generated by TH, from separately defined data structures. There are both tuples of types and single types among the generated instances, so if Unit SomeType is generated, I have to add an exceptional treatment for single types when creating TypeQ (e.g. https://github.com/igrep/typesafe-precure/blob/3844b4cb866cda9d0df4e2f7b986d066b66a1f83/src/ACME/PreCure/Types/TH.hs#L225 ). So I'm sure this can be actually avoided by such an exceptional treatment (I will add that in typesafe-precure later). If you think Unit SomeType and SomeType are separately treated, feel free to close (But I'm sure submitting this issue would help some people with the same problem).

Environment

I confirmed the error with these environments:

  • GHC 8.10.1 on Windows 10 ver. 1909
  • GHC 8.10.2 on Linux debian 4.19.0-10-amd64 #1 SMP Debian 4.19.132-1 (2020-07-24) x86_64 GNU/Linux
Edited Aug 30, 2020 by Yuji Yamamoto
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking