diff --git a/data/11-extensions/datakinds.blt b/data/11-extensions/datakinds.blt new file mode 100644 index 0000000..8ed5076 --- /dev/null +++ b/data/11-extensions/datakinds.blt @@ -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] diff --git a/data/15-regressions.blt b/data/15-regressions.blt index 51ec51f..d593331 100644 --- a/data/15-regressions.blt +++ b/data/15-regressions.blt @@ -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] diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs index a3024c0..832694e 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs @@ -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