Support promoted type applications.

Closes #370.

Up to GHC 8.10,

    foo @ 'Bar

was a valid type application. In GHC 9 it's not, which means brittany
needs to allow

    foo @'Bar

which it now does.

The reason the space was needed was to allow a promoted type variable at
the head of a type-level list. That is,

    '['Foo]

is invalid syntax, because it initially parses as the character `'['`.
So the promoted type variable was always given a separator at the
beginning, and we'd get

    '[ 'Foo]

which was valid. Now we handle this case by specifically examining the
head of a type-level list; if it's promoted we introduce spaces, so

    '[ 'Foo ]
    '[Foo]

I've added tests for this and some related cases. In doing so I noticed
that unnecessary spaces get added in front of commas in these lists; I
believe that's a separate bug, and I've written a comment explaining why
it happens, but I haven't tried to fix it.

I'm not sure when the first alternates in the `FirstLastSingleton`
and `FirstLast` branches would ever be hit, so I'm not entirely sure if
the separators are necessary there. But since `docSeparator` disappears
at the end of a line and merges with adjacent separators, they should be
harmless.
ghc92
Phil Hazelden 2022-11-01 12:17:59 +00:00 committed by Lennart Spitzner
parent e11188eb16
commit 52bde7910f
3 changed files with 100 additions and 6 deletions

View File

@ -0,0 +1,74 @@
#group extensions/datakinds-promoted-types
### The spaces before commas are undesirable
#test 1
test :: Proxy '[ 'True ]
test = Proxy @'[ 'True ]
#test 2
test :: Proxy '[True]
test = Proxy @'[True]
#test 3
test :: Proxy '[ 'True , False ]
test = Proxy @'[ 'True , False ]
#test 4
test :: Proxy '[True , False]
test = Proxy @'[True , False]
#test 5
test :: Proxy '[True , 'False]
test = Proxy @'[True , 'False]
#test 6
test :: Proxy '[ 'True , 'False ]
test = Proxy @'[ 'True , 'False ]
#test 7
test :: Proxy '[ 'Just 'True , False ]
test = Proxy @'[ 'Just 'True , False ]
#test 8
test :: Proxy '[Just True , False]
test = Proxy @'[Just True , False]
#test 9
test :: Proxy '[('True)]
test = Proxy @'[('True)]
#test 10
test :: Proxy ('Just 'True)
test = Proxy @('Just 'True)
#test 11
test :: Proxy ('True)
test = Proxy @('True)
#test with-comment-1
test
:: Proxy '[-- comment
'True ]
test = Proxy @'[-- comment
'True ]
#test with-comment-2
test
:: Proxy '[-- comment
True]
test = Proxy @'[-- comment
True]
#test with-comment-3
test
:: Proxy '[{- comment -} 'True ]
test = Proxy @'[{- comment -} 'True ]
#test with-comment-4
test
:: Proxy '[{- comment -}
'True ]
test = Proxy @'[{- comment -}
'True ]
#test with-comment-5
test
:: Proxy '[{- comment -} True]
test = Proxy @'[{- comment -} True]
#test with-comment-6
test
:: Proxy '[{- comment -}
True]
test = Proxy @'[{- comment -}
True]

View File

@ -503,7 +503,7 @@ v = A { a = 1, b = 2, c = 3 }
test :: Proxy 'Int
#test issue 63 b
test :: Proxy '[ 'True]
test :: Proxy '[ 'True ]
#test issue 63 c
test :: Proxy '[Bool]

View File

@ -158,7 +158,7 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
HsTyVar epAnn promoted name -> docHandleComms epAnn $ do
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
case promoted of
IsPromoted -> docSeq [docSeparator, docTick, docHandleComms name $ docLit t]
IsPromoted -> docSeq [docTick, docHandleComms name $ docLit t]
NotPromoted -> docHandleComms name $ docLit t
HsForAllTy{} -> do
parts <- splitArrowType ltype
@ -429,14 +429,25 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
HsRecTy{} -> -- TODO
briDocByExactInlineOnly "HsRecTy{}" ltype
HsExplicitListTy epAnn _ typs -> docHandleComms epAnn $ do
-- `'['Foo]` isn't valid because it parses as a character. So if the list
-- starts with a promoted type var, we swap to `'[ 'Foo ]`.
let
sepIfHeadPromoted = case typs of
(L _ t) : _ | startsWithTick t -> docSeparator
_ -> docEmpty
-- When rendering on multiple lines, this causes commas to line up with the
-- opening bracket. Unfortunately it also adds unnecessary space when
-- rendering on a single line.
let specialCommaSep = appSep $ docLit $ Text.pack " ,"
typDocs <- typs `forM` (shareDoc . docHandleListElemComms layoutType)
let hasComments = hasAnyCommentsBelow ltype
let specialCommaSep = appSep $ docLit $ Text.pack " ,"
docAlt
[ docSeq
$ [docLit $ Text.pack "'["]
$ [docLit $ Text.pack "'[", sepIfHeadPromoted]
++ List.intersperse specialCommaSep (docForceSingleline <$> typDocs)
++ [docLit $ Text.pack "]"]
++ [sepIfHeadPromoted, docLit $ Text.pack "]"]
, case splitFirstLast typDocs of
FirstLastEmpty -> docSeq
[ docLit $ Text.pack "'[]" -- TODO92 comments AnnOpenS
@ -444,7 +455,9 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
FirstLastSingleton e -> docAlt
[ docSeq
[ docLit $ Text.pack "'["
, sepIfHeadPromoted
, docForceSingleline e -- TODO92 comments AnnOpenS
, sepIfHeadPromoted
, docLit $ Text.pack "]"
]
, docSetBaseY $ docLines
@ -459,7 +472,7 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
FirstLast e1 ems eN -> runFilteredAlternative $ do
addAlternativeCond (not hasComments)
$ docSeq
$ [docLit $ Text.pack "'["]
$ [docLit $ Text.pack "'[", sepIfHeadPromoted]
++ List.intersperse
specialCommaSep
(docForceSingleline
@ -541,3 +554,10 @@ withoutSpecificity :: LHsTyVarBndr GHC.Types.Var.Specificity GhcPs -> LHsTyVarBn
withoutSpecificity = fmap $ \case
UserTyVar a _ c -> UserTyVar a () c
KindedTyVar a _ c d -> KindedTyVar a () c d
-- | Determine if the type starts with a tick mark (single quote) when rendered.
startsWithTick :: HsType GhcPs -> Bool
startsWithTick = \case
HsTyVar _ IsPromoted _ -> True
HsAppTy _ (L _ t) _ -> startsWithTick t
_ -> False