Compare commits
4 Commits
084125eed3
...
29000c990c
Author | SHA1 | Date |
---|---|---|
|
29000c990c | |
|
ea550b401a | |
|
a3083729af | |
|
e04b90e4c8 |
|
@ -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]
|
|
@ -277,24 +277,22 @@ layoutBriDocM = \case
|
||||||
comms <- takeBefore loc
|
comms <- takeBefore loc
|
||||||
printComments comms
|
printComments comms
|
||||||
mModify (\s -> s + CommentCounter (length comms))
|
mModify (\s -> s + CommentCounter (length comms))
|
||||||
do
|
mModify $ \s -> s
|
||||||
state <- mGet
|
{ _lstate_markerForDelta = Nothing
|
||||||
mModify $ \s -> s { _lstate_markerForDelta = Nothing }
|
, _lstate_plannedSpace = case _lstate_markerForDelta s of
|
||||||
case _lstate_markerForDelta state of
|
Nothing -> _lstate_plannedSpace s
|
||||||
Just m -> do
|
Just m ->
|
||||||
let p1 = (srcLocLine m, srcLocCol m)
|
let p1 = (srcLocLine m, srcLocCol m)
|
||||||
let p2 = (srcLocLine loc, srcLocCol loc)
|
p2 = (srcLocLine loc, srcLocCol loc)
|
||||||
let newlinePlanned = case _lstate_plannedSpace state of
|
|
||||||
PlannedNone -> False
|
|
||||||
PlannedSameline{} -> False
|
|
||||||
PlannedNewline{} -> True
|
|
||||||
PlannedDelta{} -> True
|
|
||||||
-- traceShow (m, ExactPrint.pos2delta p1 p2) $ pure ()
|
-- traceShow (m, ExactPrint.pos2delta p1 p2) $ pure ()
|
||||||
case ExactPrint.pos2delta p1 p2 of
|
in case ExactPrint.pos2delta p1 p2 of
|
||||||
SameLine{} -> pure ()
|
SameLine{} -> _lstate_plannedSpace s
|
||||||
DifferentLine n _ | newlinePlanned -> layoutWriteNewlines n
|
DifferentLine n _ -> case _lstate_plannedSpace s of
|
||||||
| otherwise -> pure ()
|
PlannedNone -> PlannedNone
|
||||||
_ -> pure ()
|
PlannedSameline i -> PlannedDelta n (_lstate_curY s + i)
|
||||||
|
PlannedNewline{} -> PlannedNewline n
|
||||||
|
PlannedDelta{} -> PlannedNewline n
|
||||||
|
}
|
||||||
layoutBriDocM bd
|
layoutBriDocM bd
|
||||||
BDFlushCommentsPost loc shouldMark bd -> do
|
BDFlushCommentsPost loc shouldMark bd -> do
|
||||||
layoutBriDocM bd
|
layoutBriDocM bd
|
||||||
|
|
|
@ -158,7 +158,7 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
|
||||||
HsTyVar epAnn promoted name -> docHandleComms epAnn $ do
|
HsTyVar epAnn promoted name -> docHandleComms epAnn $ do
|
||||||
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
|
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
|
||||||
case promoted of
|
case promoted of
|
||||||
IsPromoted -> docSeq [docSeparator, docTick, docHandleComms name $ docLit t]
|
IsPromoted -> docSeq [docTick, docHandleComms name $ docLit t]
|
||||||
NotPromoted -> docHandleComms name $ docLit t
|
NotPromoted -> docHandleComms name $ docLit t
|
||||||
HsForAllTy{} -> do
|
HsForAllTy{} -> do
|
||||||
parts <- splitArrowType ltype
|
parts <- splitArrowType ltype
|
||||||
|
@ -429,14 +429,25 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
|
||||||
HsRecTy{} -> -- TODO
|
HsRecTy{} -> -- TODO
|
||||||
briDocByExactInlineOnly "HsRecTy{}" ltype
|
briDocByExactInlineOnly "HsRecTy{}" ltype
|
||||||
HsExplicitListTy epAnn _ typs -> docHandleComms epAnn $ do
|
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)
|
typDocs <- typs `forM` (shareDoc . docHandleListElemComms layoutType)
|
||||||
let hasComments = hasAnyCommentsBelow ltype
|
let 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 "'[]" -- TODO92 comments AnnOpenS
|
[ docLit $ Text.pack "'[]" -- TODO92 comments AnnOpenS
|
||||||
|
@ -444,7 +455,9 @@ layoutType ltype@(L _ typ) = docHandleComms ltype $ case typ of
|
||||||
FirstLastSingleton e -> docAlt
|
FirstLastSingleton e -> docAlt
|
||||||
[ docSeq
|
[ docSeq
|
||||||
[ docLit $ Text.pack "'["
|
[ docLit $ Text.pack "'["
|
||||||
|
, sepIfHeadPromoted
|
||||||
, docForceSingleline e -- TODO92 comments AnnOpenS
|
, docForceSingleline e -- TODO92 comments AnnOpenS
|
||||||
|
, sepIfHeadPromoted
|
||||||
, docLit $ Text.pack "]"
|
, docLit $ Text.pack "]"
|
||||||
]
|
]
|
||||||
, docSetBaseY $ docLines
|
, docSetBaseY $ docLines
|
||||||
|
@ -459,7 +472,7 @@ layoutType ltype@(L _ typ) = docHandleComms 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
|
||||||
|
@ -541,3 +554,10 @@ withoutSpecificity :: LHsTyVarBndr GHC.Types.Var.Specificity GhcPs -> LHsTyVarBn
|
||||||
withoutSpecificity = fmap $ \case
|
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
|
||||||
|
|
||||||
|
-- | 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
|
||||||
|
|
|
@ -16,7 +16,7 @@ import Language.Haskell.Brittany.Internal.Types
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
data PlanneSpace
|
data PlannedSpace
|
||||||
= PlannedNone
|
= PlannedNone
|
||||||
| PlannedSameline Int
|
| PlannedSameline Int
|
||||||
| PlannedNewline Int
|
| PlannedNewline Int
|
||||||
|
@ -45,7 +45,7 @@ data LayoutState = LayoutState
|
||||||
-- on the first indented element have an
|
-- on the first indented element have an
|
||||||
-- annotation offset relative to the last
|
-- annotation offset relative to the last
|
||||||
-- non-indented element, which is confusing.
|
-- non-indented element, which is confusing.
|
||||||
, _lstate_plannedSpace :: PlanneSpace
|
, _lstate_plannedSpace :: PlannedSpace
|
||||||
-- , _lstate_isNewline :: NewLineState
|
-- , _lstate_isNewline :: NewLineState
|
||||||
-- -- captures if the layouter currently is in a new line, i.e. if the
|
-- -- captures if the layouter currently is in a new line, i.e. if the
|
||||||
-- -- current line only contains (indentation) spaces.
|
-- -- current line only contains (indentation) spaces.
|
||||||
|
|
Loading…
Reference in New Issue