Improve promoted type applications in GHC < 9.
This is https://github.com/lspitzner/brittany/pull/376 backported so we can use it on GHC 8.10.7. Backporting the tests would have been a hassle so I didn't bother.remotes/ChickenProp/promoted-type-applications-backport
parent
434f9f8e49
commit
7b9437229b
|
@ -50,8 +50,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
|
||||||
#else /* ghc-8.6 */
|
#else /* ghc-8.6 */
|
||||||
Promoted -> docSeq
|
Promoted -> docSeq
|
||||||
#endif
|
#endif
|
||||||
[ docSeparator
|
[ docTick
|
||||||
, docTick
|
|
||||||
, docWrapNode name $ docLit t
|
, docWrapNode name $ docLit t
|
||||||
]
|
]
|
||||||
NotPromoted -> docWrapNode name $ docLit t
|
NotPromoted -> docWrapNode name $ docLit t
|
||||||
|
@ -562,14 +561,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 "'["
|
||||||
|
@ -578,7 +588,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
|
||||||
|
@ -593,7 +605,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 specialCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW ltype (Just AnnOpenS) eN]))
|
++ List.intersperse specialCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW ltype (Just AnnOpenS) eN]))
|
||||||
++ [docLit $ Text.pack " ]"]
|
++ [docLit $ Text.pack " ]"]
|
||||||
addAlternative $
|
addAlternative $
|
||||||
|
@ -663,3 +675,10 @@ processTyVarBndrsSingleline bndrDocs = bndrDocs >>= \case
|
||||||
, docForceSingleline $ doc
|
, docForceSingleline $ doc
|
||||||
, docLit $ Text.pack ")"
|
, docLit $ Text.pack ")"
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- | 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
|
||||||
|
|
Loading…
Reference in New Issue