Skip to content

GitLab

  • Menu
Projects Groups Snippets
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,870
    • Issues 4,870
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 453
    • Merge requests 453
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • 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 Compiler
  • GHCGHC
  • Issues
  • #19013
Closed
Open
Created 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
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking