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]
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue