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.
ChickenProp/promoted-type-applications
Phil Hazelden 2022-11-01 12:17:59 +00:00
parent 0aa04af4eb
commit b613ebaac2
2 changed files with 75 additions and 6 deletions

View File

@ -1 +1,50 @@
test :: Proxy '[ 'True] -- The spaces before commas are undesirable
test :: Proxy '[ 'True ]
test :: Proxy '[True]
test :: Proxy '[ 'True , False ]
test :: Proxy '[True , False]
test :: Proxy '[True , 'False]
test :: Proxy '[ 'True , 'False ]
test :: Proxy '[ 'Just 'True , False ]
test :: Proxy '[Just True , False]
test :: Proxy '[('True)]
test :: Proxy ('Just 'True)
test :: Proxy ('True)
test = Proxy @'[ 'True ]
test = Proxy @'[True]
test = Proxy @'[ 'True , False ]
test = Proxy @'[True , False]
test = Proxy @'[True , 'False]
test = Proxy @'[ 'True , 'False ]
test = Proxy @'[ 'Just 'True , False ]
test = Proxy @'[Just True , False]
test = Proxy @'[('True)]
test = Proxy @('Just 'True)
test = Proxy @('True)
test
:: Proxy '[-- comment
'True ]
test
:: Proxy '[-- comment
True]
test
:: Proxy '[{- comment -}
'True ]
test
:: Proxy '[{- comment -}
True]
test =
Proxy @'[-- comment
'True ]
test =
Proxy @'[-- comment
True]
test =
Proxy @'[{- comment -}
'True ]
test =
Proxy @'[{- comment -}
True]

View File

@ -24,7 +24,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
HsTyVar _ promoted name -> do HsTyVar _ promoted name -> do
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
case promoted of case promoted of
IsPromoted -> docSeq [docSeparator, docTick, docWrapNode name $ docLit t] IsPromoted -> docSeq [docTick, docWrapNode name $ docLit t]
NotPromoted -> docWrapNode name $ docLit t NotPromoted -> docWrapNode name $ docLit t
HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
let bndrs = getBinders hsf let bndrs = getBinders hsf
@ -522,14 +522,25 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
HsRecTy{} -> -- TODO HsRecTy{} -> -- TODO
briDocByExactInlineOnly "HsRecTy{}" ltype briDocByExactInlineOnly "HsRecTy{}" ltype
HsExplicitListTy _ _ typs -> do HsExplicitListTy _ _ typs -> 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 <- docSharedWrapper layoutType `mapM` typs typDocs <- docSharedWrapper layoutType `mapM` typs
hasComments <- hasAnyCommentsBelow ltype 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 "'[" [ docLit $ Text.pack "'["
@ -538,7 +549,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
FirstLastSingleton e -> docAlt FirstLastSingleton e -> docAlt
[ docSeq [ docSeq
[ docLit $ Text.pack "'[" [ docLit $ Text.pack "'["
, sepIfHeadPromoted
, docNodeAnnKW ltype (Just AnnOpenS) $ docForceSingleline e , docNodeAnnKW ltype (Just AnnOpenS) $ docForceSingleline e
, sepIfHeadPromoted
, docLit $ Text.pack "]" , docLit $ Text.pack "]"
] ]
, docSetBaseY $ docLines , docSetBaseY $ docLines
@ -553,7 +566,7 @@ layoutType ltype@(L _ typ) = docWrapNode 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
@ -633,3 +646,10 @@ 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
XTyVarBndr a -> XTyVarBndr a XTyVarBndr a -> XTyVarBndr a
-- | Determine if the type starts with a tick mark (single quote) when rendered.
startsWithTick :: HsType pass -> Bool
startsWithTick = \case
HsTyVar _ IsPromoted _ -> True
HsAppTy _ (L _ t) _ -> startsWithTick t
_ -> False