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
parent
e11188eb16
commit
52bde7910f
|
@ -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]
|
|
@ -158,7 +158,7 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
|
||||||
HsTyVar epAnn promoted name -> docHandleComms epAnn $ do
|
HsTyVar epAnn promoted name -> docHandleComms epAnn $ do
|
||||||
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
|
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
|
||||||
case promoted of
|
case promoted of
|
||||||
IsPromoted -> docSeq [docSeparator, docTick, docHandleComms name $ docLit t]
|
IsPromoted -> docSeq [docTick, docHandleComms name $ docLit t]
|
||||||
NotPromoted -> docHandleComms name $ docLit t
|
NotPromoted -> docHandleComms name $ docLit t
|
||||||
HsForAllTy{} -> do
|
HsForAllTy{} -> do
|
||||||
parts <- splitArrowType ltype
|
parts <- splitArrowType ltype
|
||||||
|
@ -429,14 +429,25 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
|
||||||
HsRecTy{} -> -- TODO
|
HsRecTy{} -> -- TODO
|
||||||
briDocByExactInlineOnly "HsRecTy{}" ltype
|
briDocByExactInlineOnly "HsRecTy{}" ltype
|
||||||
HsExplicitListTy epAnn _ typs -> docHandleComms epAnn $ do
|
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)
|
typDocs <- typs `forM` (shareDoc . docHandleListElemComms layoutType)
|
||||||
let hasComments = hasAnyCommentsBelow ltype
|
let hasComments = hasAnyCommentsBelow ltype
|
||||||
let specialCommaSep = appSep $ docLit $ Text.pack " ,"
|
|
||||||
docAlt
|
docAlt
|
||||||
[ docSeq
|
[ docSeq
|
||||||
$ [docLit $ Text.pack "'["]
|
$ [docLit $ Text.pack "'[", sepIfHeadPromoted]
|
||||||
++ List.intersperse specialCommaSep (docForceSingleline <$> typDocs)
|
++ List.intersperse specialCommaSep (docForceSingleline <$> typDocs)
|
||||||
++ [docLit $ Text.pack "]"]
|
++ [sepIfHeadPromoted, docLit $ Text.pack "]"]
|
||||||
, case splitFirstLast typDocs of
|
, case splitFirstLast typDocs of
|
||||||
FirstLastEmpty -> docSeq
|
FirstLastEmpty -> docSeq
|
||||||
[ docLit $ Text.pack "'[]" -- TODO92 comments AnnOpenS
|
[ docLit $ Text.pack "'[]" -- TODO92 comments AnnOpenS
|
||||||
|
@ -444,7 +455,9 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
|
||||||
FirstLastSingleton e -> docAlt
|
FirstLastSingleton e -> docAlt
|
||||||
[ docSeq
|
[ docSeq
|
||||||
[ docLit $ Text.pack "'["
|
[ docLit $ Text.pack "'["
|
||||||
|
, sepIfHeadPromoted
|
||||||
, docForceSingleline e -- TODO92 comments AnnOpenS
|
, docForceSingleline e -- TODO92 comments AnnOpenS
|
||||||
|
, sepIfHeadPromoted
|
||||||
, docLit $ Text.pack "]"
|
, docLit $ Text.pack "]"
|
||||||
]
|
]
|
||||||
, docSetBaseY $ docLines
|
, docSetBaseY $ docLines
|
||||||
|
@ -459,7 +472,7 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
|
||||||
FirstLast e1 ems eN -> runFilteredAlternative $ do
|
FirstLast e1 ems eN -> runFilteredAlternative $ do
|
||||||
addAlternativeCond (not hasComments)
|
addAlternativeCond (not hasComments)
|
||||||
$ docSeq
|
$ docSeq
|
||||||
$ [docLit $ Text.pack "'["]
|
$ [docLit $ Text.pack "'[", sepIfHeadPromoted]
|
||||||
++ List.intersperse
|
++ List.intersperse
|
||||||
specialCommaSep
|
specialCommaSep
|
||||||
(docForceSingleline
|
(docForceSingleline
|
||||||
|
@ -541,3 +554,10 @@ withoutSpecificity :: LHsTyVarBndr GHC.Types.Var.Specificity GhcPs -> LHsTyVarBn
|
||||||
withoutSpecificity = fmap $ \case
|
withoutSpecificity = fmap $ \case
|
||||||
UserTyVar a _ c -> UserTyVar a () c
|
UserTyVar a _ c -> UserTyVar a () c
|
||||||
KindedTyVar a _ c d -> KindedTyVar a () c d
|
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
|
||||||
|
|
Loading…
Reference in New Issue