Implement extension support - OverloadedRecordDot
parent
72c9e4c3ab
commit
d9373ec80e
|
@ -0,0 +1,24 @@
|
||||||
|
#group extensions/overloadedrecorddot
|
||||||
|
|
||||||
|
#test getfield
|
||||||
|
{-# LANGUAGE OverloadedRecordDot #-}
|
||||||
|
recorddot1 = a.b.c
|
||||||
|
|
||||||
|
#test getfield
|
||||||
|
{-# LANGUAGE OverloadedRecordDot #-}
|
||||||
|
recorddot2 =
|
||||||
|
{-before-}a.b.c{-after-}
|
||||||
|
|
||||||
|
#test projection
|
||||||
|
{-# LANGUAGE OverloadedRecordDot #-}
|
||||||
|
recorddot3 =
|
||||||
|
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
|
||||||
|
& (.bbbbbbbbbbbbbbbbbbbbbbbbbbb)
|
||||||
|
& (.ccccccccccccccccccccccccccccccccccccc)
|
||||||
|
& (.ddddddddddddddddddddddddddddddddddddddddddddddddddd)
|
||||||
|
|
||||||
|
#test projection too long
|
||||||
|
{-# LANGUAGE OverloadedRecordDot #-}
|
||||||
|
recorddot4 =
|
||||||
|
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
|
||||||
|
& (.bbbbbbbbbbbbbbbbbbbbbbbbbbb.ccccccccccccccccccccccccccccccccccccc.ddddddddddddddddddddddddddddddddddddddddddddddddddd)
|
|
@ -980,6 +980,37 @@ layoutExpr lexpr@(L _ expr) = do
|
||||||
, docForceSingleline eNDoc
|
, docForceSingleline eNDoc
|
||||||
, docLit $ Text.pack "]"
|
, docLit $ Text.pack "]"
|
||||||
]
|
]
|
||||||
|
HsGetField _epAnn _exp1 _field -> do
|
||||||
|
let
|
||||||
|
labelLayouter label = case label of
|
||||||
|
L flAnn (HsFieldLabel _ (L _ n)) ->
|
||||||
|
docHandleComms flAnn $ docLitS $ FastString.unpackFS n
|
||||||
|
L _ann (XHsFieldLabel _) -> error "XHsFieldLabel"
|
||||||
|
gather
|
||||||
|
:: [ToBriDocM BriDocNumbered]
|
||||||
|
-> LHsExpr GhcPs
|
||||||
|
-> (LHsExpr GhcPs, [ToBriDocM BriDocNumbered])
|
||||||
|
gather list = \case
|
||||||
|
L _ (HsGetField epAnn l r) -> gather
|
||||||
|
(docHandleComms epAnn $ labelLayouter r : list) l
|
||||||
|
x -> (x, list)
|
||||||
|
let (headE, paramEs) = gather
|
||||||
|
[]
|
||||||
|
lexpr
|
||||||
|
expDoc <- shareDoc $ layoutExpr headE
|
||||||
|
-- this only has single-line layout, afaik
|
||||||
|
docForceSingleline $ docSeq $ intersperse (docLitS ".") (expDoc: paramEs)
|
||||||
|
HsProjection epAnn (f1 :| fR) -> do
|
||||||
|
let
|
||||||
|
labelLayouter label = case label of
|
||||||
|
L flAnn (HsFieldLabel _ (L _ n)) ->
|
||||||
|
docHandleComms flAnn $ docLitS $ FastString.unpackFS n
|
||||||
|
L _ann (XHsFieldLabel _) -> error "XHsFieldLabel"
|
||||||
|
docForceSingleline $ docHandleComms epAnn $ docSeq
|
||||||
|
( [ docLitS "(" ]
|
||||||
|
++ [ doc | f <- f1:fR, doc <- [docLitS ".", labelLayouter f] ]
|
||||||
|
++ [ docLitS ")" ]
|
||||||
|
)
|
||||||
ArithSeq{} -> briDocByExactInlineOnly "ArithSeq" lexpr
|
ArithSeq{} -> briDocByExactInlineOnly "ArithSeq" lexpr
|
||||||
HsBracket{} -> do
|
HsBracket{} -> do
|
||||||
-- TODO
|
-- TODO
|
||||||
|
@ -1023,12 +1054,6 @@ layoutExpr lexpr@(L _ expr) = do
|
||||||
HsPragE{} -> do
|
HsPragE{} -> do
|
||||||
-- TODO
|
-- TODO
|
||||||
briDocByExactInlineOnly "HsPragE{}" lexpr
|
briDocByExactInlineOnly "HsPragE{}" lexpr
|
||||||
HsGetField{} -> do
|
|
||||||
-- TODO
|
|
||||||
briDocByExactInlineOnly "HsGetField{}" lexpr
|
|
||||||
HsProjection{} -> do
|
|
||||||
-- TODO
|
|
||||||
briDocByExactInlineOnly "HsGetField{}" lexpr
|
|
||||||
|
|
||||||
recordExpression
|
recordExpression
|
||||||
:: Bool
|
:: Bool
|
||||||
|
|
Loading…
Reference in New Issue