Skip to content

GitLab

  • Projects
  • Groups
  • Snippets
  • Help
    • Loading...
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
GHC
GHC
  • Project overview
    • Project overview
    • Details
    • Activity
    • Releases
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,334
    • Issues 4,334
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 371
    • Merge Requests 371
  • Requirements
    • Requirements
    • List
  • CI / CD
    • CI / CD
    • Pipelines
    • Jobs
    • Schedules
  • Security & Compliance
    • Security & Compliance
    • Dependency List
    • License Compliance
  • Operations
    • Operations
    • Incidents
    • Environments
  • Analytics
    • Analytics
    • CI / CD
    • Code Review
    • Insights
    • Issue
    • Repository
    • Value Stream
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Members
    • Members
  • Collapse sidebar
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #19013

Closed
Open
Opened Dec 01, 2020 by dminuoso@dminuosoReporter

Type wildcard infers differently than no type signature

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PartialTypeSignatures #-}
module Main where

import Optics

main :: IO ()
main = putStrLn "Hello, Haskell!"

g :: Lens' String Char                                                                                   
g = undefined                                                                                            

f :: _
f o = "foo" & (g%o) .~ 10

Full source code of the test case at: https://gitlab.haskell.org/dminuoso/ghc-wildcard-bug/

The above code fails to type check with:

Without the wildcard type annotation on f it compiles and infers the following type for f:

*Main> :t f
f :: (Is (Join A_Lens l) A_Setter, Is l (Join A_Lens l),
      Is A_Lens (Join A_Lens l), Num b) =>
     Optic l js Char Char a b -> String
*Main> 

Leaving the wildcard in, the type checker bails out.

[nix-shell:~/git/ghc-wildcard-bug]$ cabal build
Build profile: -w ghc-8.8.4 -O1
In order, the following will be built (use -v for more details):
 - ghc-wildcard-bug-0.1.0.0 (exe:ghc-wildcard-bug) (file Main.hs changed)
Preprocessing executable 'ghc-wildcard-bug' for ghc-wildcard-bug-0.1.0.0..
Building executable 'ghc-wildcard-bug' for ghc-wildcard-bug-0.1.0.0..
[1 of 1] Compiling Main             ( Main.hs, /home/dminuoso/git/ghc-wildcard-bug/dist-newstyle/build/x86_64-linux/ghc-8.8.4/ghc-wildcard-bug-0.1.0.0/x/ghc-wildcard-bug/build/ghc-wildcard-bug/ghc-wildcard-bug-tmp/Main.o )

Main.hs:15:15: error:
    • Overlapping instances for Is (Join A_Lens l0) A_Setter
        arising from a use of ‘.~’
      Matching instances:
        instance [overlappable] (TypeError ...) => Is k l
          -- Defined in ‘optics-core-0.3.0.1:Optics.Internal.Optic.Subtyping’
        instance Is k k
          -- Defined in ‘optics-core-0.3.0.1:Optics.Internal.Optic.Subtyping’
        instance Is A_Lens A_Setter
          -- Defined in ‘optics-core-0.3.0.1:Optics.Internal.Optic.Subtyping’
        ...plus four others
        (use -fprint-potential-instances to see them all)
      (The choice depends on the instantiation of ‘l0’
       To pick the first instance above, use IncoherentInstances
       when compiling the other instance declarations)
    • In the second argument of ‘(&)’, namely ‘(g % o) .~ 10’
      In the expression: "foo" & (g % o) .~ 10
      In an equation for ‘f’: f o = "foo" & (g % o) .~ 10
   |
15 | f o = "foo" & (g%o) .~ 10
   |               ^^^^^^^^^^^

Main.hs:15:16: error:
    • Overlapping instances for Is l0 (Join A_Lens l0)
        arising from a use of ‘%’
      Matching instances:
        instance [overlappable] (TypeError ...) => Is k l
          -- Defined in ‘optics-core-0.3.0.1:Optics.Internal.Optic.Subtyping’
        instance Is k k
          -- Defined in ‘optics-core-0.3.0.1:Optics.Internal.Optic.Subtyping’
        instance Is A_Getter A_Fold
          -- Defined in ‘optics-core-0.3.0.1:Optics.Internal.Optic.Subtyping’
        ...plus 35 others
        (use -fprint-potential-instances to see them all)
      (The choice depends on the instantiation of ‘l0’
       To pick the first instance above, use IncoherentInstances
       when compiling the other instance declarations)
    • In the first argument of ‘(.~)’, namely ‘(g % o)’
      In the second argument of ‘(&)’, namely ‘(g % o) .~ 10’
      In the expression: "foo" & (g % o) .~ 10
   |
15 | f o = "foo" & (g%o) .~ 10
   |            

Also tried enabling NoMonomorphismRestriction to no avail.

Edited Dec 06, 2020 by dminuoso
Assignee
Assign to
None
Milestone
None
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#19013