Fix roundtripping of (~) constraint/type
parent
41750dc8a8
commit
77d6d5b553
|
@ -684,3 +684,9 @@ d = \(~x) -> x
|
||||||
#test type signature with forall and constraint
|
#test type signature with forall and constraint
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
func :: forall b . Show b => b -> String
|
func :: forall b . Show b => b -> String
|
||||||
|
|
||||||
|
#test issue 267
|
||||||
|
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
f :: ((~) a b) => a -> b
|
||||||
|
f = id
|
||||||
|
|
|
@ -206,13 +206,14 @@ rdrNameToText (Exact name) = Text.pack $ getOccString name
|
||||||
lrdrNameToText :: GenLocated l RdrName -> Text
|
lrdrNameToText :: GenLocated l RdrName -> Text
|
||||||
lrdrNameToText (L _ n) = rdrNameToText n
|
lrdrNameToText (L _ n) = rdrNameToText n
|
||||||
|
|
||||||
lrdrNameToTextAnn
|
lrdrNameToTextAnnGen
|
||||||
:: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
|
:: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
|
||||||
=> Located RdrName
|
=> (Text -> Text)
|
||||||
|
-> Located RdrName
|
||||||
-> m Text
|
-> m Text
|
||||||
lrdrNameToTextAnn ast@(L _ n) = do
|
lrdrNameToTextAnnGen f ast@(L _ n) = do
|
||||||
anns <- mAsk
|
anns <- mAsk
|
||||||
let t = rdrNameToText n
|
let t = f $ rdrNameToText n
|
||||||
let hasUni x (ExactPrint.Types.G y, _) = x == y
|
let hasUni x (ExactPrint.Types.G y, _) = x == y
|
||||||
hasUni _ _ = False
|
hasUni _ _ = False
|
||||||
-- TODO: in general: we should _always_ process all annotaiton stuff here.
|
-- TODO: in general: we should _always_ process all annotaiton stuff here.
|
||||||
|
@ -228,15 +229,21 @@ lrdrNameToTextAnn ast@(L _ n) = do
|
||||||
_ | any (hasUni AnnOpenP) aks -> Text.pack "(" <> t <> Text.pack ")"
|
_ | any (hasUni AnnOpenP) aks -> Text.pack "(" <> t <> Text.pack ")"
|
||||||
_ | otherwise -> t
|
_ | otherwise -> t
|
||||||
|
|
||||||
|
lrdrNameToTextAnn
|
||||||
|
:: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
|
||||||
|
=> Located RdrName
|
||||||
|
-> m Text
|
||||||
|
lrdrNameToTextAnn = lrdrNameToTextAnnGen id
|
||||||
|
|
||||||
lrdrNameToTextAnnTypeEqualityIsSpecial
|
lrdrNameToTextAnnTypeEqualityIsSpecial
|
||||||
:: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
|
:: (MonadMultiReader Config m, MonadMultiReader (Map AnnKey Annotation) m)
|
||||||
=> Located RdrName
|
=> Located RdrName
|
||||||
-> m Text
|
-> m Text
|
||||||
lrdrNameToTextAnnTypeEqualityIsSpecial ast = do
|
lrdrNameToTextAnnTypeEqualityIsSpecial ast = do
|
||||||
x <- lrdrNameToTextAnn ast
|
let f x = if x == Text.pack "Data.Type.Equality~"
|
||||||
return $ if x == Text.pack "Data.Type.Equality~"
|
then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh
|
||||||
then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh
|
else x
|
||||||
else x
|
lrdrNameToTextAnnGen f ast
|
||||||
|
|
||||||
-- | Same as lrdrNameToTextAnnTypeEqualityIsSpecial, but also inspects
|
-- | Same as lrdrNameToTextAnnTypeEqualityIsSpecial, but also inspects
|
||||||
-- the annotations for a (parent) node for a tick to be added to the
|
-- the annotations for a (parent) node for a tick to be added to the
|
||||||
|
|
|
@ -40,7 +40,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
|
||||||
#else /* ghc-8.2 ghc-8.4 */
|
#else /* ghc-8.2 ghc-8.4 */
|
||||||
HsTyVar promoted name -> do
|
HsTyVar promoted name -> do
|
||||||
#endif
|
#endif
|
||||||
t <- lrdrNameToTextAnn name
|
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
|
||||||
case promoted of
|
case promoted of
|
||||||
#if MIN_VERSION_ghc(8,8,0)
|
#if MIN_VERSION_ghc(8,8,0)
|
||||||
IsPromoted -> docSeq
|
IsPromoted -> docSeq
|
||||||
|
@ -54,7 +54,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
|
||||||
NotPromoted -> docWrapNode name $ docLit t
|
NotPromoted -> docWrapNode name $ docLit t
|
||||||
#else /* ghc-8.0 */
|
#else /* ghc-8.0 */
|
||||||
HsTyVar name -> do
|
HsTyVar name -> do
|
||||||
t <- lrdrNameToTextAnn name
|
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
|
||||||
docWrapNode name $ docLit t
|
docWrapNode name $ docLit t
|
||||||
#endif
|
#endif
|
||||||
#if MIN_VERSION_ghc(8,6,0)
|
#if MIN_VERSION_ghc(8,6,0)
|
||||||
|
|
Loading…
Reference in New Issue