Skip to content

WIP: TypeWarning implementation #17027

Rowan Goemans requested to merge (removed):master into master

This is the initial implementation for user defined type warnings #17027. This is the first time working with GHC for me so it doesn't quite work yet and I would like some pointers. Since it seems constraints are canonicalized I thought it would be a good idea to check whether a constraint contains a TypeWarning during this step. Specifically while rewriting. This however has issues with double warnings since the solver runs multiple times. Also it now issues warnings when the function isn't used yet:

f :: (TypeWarning (Text "SomeWarning") (Show a)) => a -> a
f = id

Which results in the following during compilation:

Test.hs:1:1: warning: SomeWarning
  |
1 | {-# LANGUAGE TypeFamilies         #-}
  | ^

Test.hs:22:6: warning:
    • SomeWarning
    • In the type signature:
        f :: (TypeWarning (Text "SomeWarning") (Show a)) => a -> a
   |
22 | f :: (TypeWarning (Text "SomeWarning") (Show a)) => a -> a
   |      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Test.hs:22:6: warning:
    • SomeWarning
    • In the type signature:
        f :: (TypeWarning (Text "SomeWarning") (Show a)) => a -> a
   |
22 | f :: (TypeWarning (Text "SomeWarning") (Show a)) => a -> a
   |      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

Test.hs:22:6: warning:
    • SomeWarning
    • In the type signature:
        f :: (TypeWarning (Text "SomeWarning") (Show a)) => a -> a
   |
22 | f :: (TypeWarning (Text "SomeWarning") (Show a)) => a -> a
   |      ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

When using the TypeWarning in a type family it looks a little better but the warning is not issued on the correct line.

type family ShouldBeInteger x :: Constraint where
    ShouldBeInteger Integer = () :: Constraint
    ShouldBeInteger x = TypeWarning (ShowType x :<>: Text " is not an Integer")
                                     (() :: Constraint)

g :: (ShouldBeInteger a) => a -> a
g = id

main = do
    putStrLn $ show $ g $ (1337 :: Int)

Which results in:

Test.hs:24:1: warning: Int is not an integer
   |
24 | main = do
   | ^^^^^^^^^...

I hope someone can give some pointers on how to best proceed/implement this.

to do:

  • Initial working implementation
  • Bring comments up to date
  • Squash unnecessary commits
  • Add a test cases.
Edited by Rowan Goemans

Merge request reports