hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Implement/Improve record pun handling (Pat/Expr)

pull/1/head
Lennart Spitzner 2016-08-06 14:59:10 +02:00
parent b4f749ea0c
commit 0314569276
2 changed files with 48 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
src/Language/Haskell/Brittany/Layouters/Expr.hs
View File

@ -462,8 +462,10 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
docLit $ t <> Text.pack "{}" docLit $ t <> Text.pack "{}"
RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do
let t = lrdrNameToText lname let t = lrdrNameToText lname
((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr _)) -> do ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do
fExpDoc <- docSharedWrapper layoutExpr fExpr fExpDoc <- if pun
then return Nothing
else Just <$> docSharedWrapper layoutExpr fExpr
return $ (fieldl, lrdrNameToText lnameF, fExpDoc) return $ (fieldl, lrdrNameToText lnameF, fExpDoc)
docAlt docAlt
[ docSetParSpacing [ docSetParSpacing
@ -474,16 +476,22 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
line1 = docCols ColRecUpdate line1 = docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "{" [ appSep $ docLit $ Text.pack "{"
, appSep $ docLit $ fd1n , appSep $ docLit $ fd1n
, docSeq [ appSep $ docLit $ Text.pack "=" , case fd1e of
, docWrapNode fd1l $ docAddBaseY BrIndentRegular $ fd1e Just x -> docSeq
[ appSep $ docLit $ Text.pack "="
, docWrapNode fd1l $ docAddBaseY BrIndentRegular $ x
] ]
Nothing -> docEmpty
] ]
lineR = fdr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate lineR = fdr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "," [ appSep $ docLit $ Text.pack ","
, appSep $ docLit $ fText , appSep $ docLit $ fText
, docSeq [ appSep $ docLit $ Text.pack "=" , case fDoc of
, docWrapNode lfield $ docAddBaseY BrIndentRegular fDoc Just x -> docSeq
[ appSep $ docLit $ Text.pack "="
, docWrapNode lfield $ docAddBaseY BrIndentRegular x
] ]
Nothing -> docEmpty
] ]
lineN = docLit $ Text.pack "}" lineN = docLit $ Text.pack "}"
in [line1] ++ lineR ++ [lineN]) in [line1] ++ lineR ++ [lineN])
@ -497,8 +505,10 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
RecordUpd rExpr fields@(_:_) _ _ _ _ -> do RecordUpd rExpr fields@(_:_) _ _ _ _ -> do
rExprDoc <- docSharedWrapper layoutExpr rExpr rExprDoc <- docSharedWrapper layoutExpr rExpr
rFs@((rF1f, rF1n, rF1e):rFr) <- fields rFs@((rF1f, rF1n, rF1e):rFr) <- fields
`forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr _)) -> do `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do
rFExpDoc <- docSharedWrapper layoutExpr rFExpr rFExpDoc <- if pun
then return Nothing
else Just <$> docSharedWrapper layoutExpr rFExpr
return $ case ambName of return $ case ambName of
Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
@ -509,11 +519,14 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
[ appSep rExprDoc [ appSep rExprDoc
, appSep $ docLit $ Text.pack "{" , appSep $ docLit $ Text.pack "{"
, appSep $ docSeq $ List.intersperse docCommaSep , appSep $ docSeq $ List.intersperse docCommaSep
$ rFs <&> \(lfield, fieldStr, fieldDoc) -> $ rFs <&> \case
(lfield, fieldStr, Just fieldDoc) ->
docSeq [ appSep $ docWrapNode lfield $ docLit fieldStr docSeq [ appSep $ docWrapNode lfield $ docLit fieldStr
, appSep $ docLit $ Text.pack "=" , appSep $ docLit $ Text.pack "="
, docForceSingleline fieldDoc , docForceSingleline fieldDoc
] ]
(lfield, fieldStr, Nothing) ->
docWrapNode lfield $ docLit fieldStr
, docLit $ Text.pack "}" , docLit $ Text.pack "}"
] ]
-- wild-indentation block -- wild-indentation block
@ -523,16 +536,20 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
line1 = docCols ColRecUpdate line1 = docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "{" [ appSep $ docLit $ Text.pack "{"
, appSep $ docLit $ rF1n , appSep $ docLit $ rF1n
, docSeq [ appSep $ docLit $ Text.pack "=" , case rF1e of
, docForceSingleline $ rF1e Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docForceSingleline $ x
] ]
Nothing -> docEmpty
] ]
lineR = rFr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate lineR = rFr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "," [ appSep $ docLit $ Text.pack ","
, appSep $ docWrapNode lfield $ docLit $ fText , appSep $ docWrapNode lfield $ docLit $ fText
, docSeq [ appSep $ docLit $ Text.pack "=" , case fDoc of
, docForceSingleline fDoc Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docForceSingleline x
] ]
Nothing -> docEmpty
] ]
lineN = docLit $ Text.pack "}" lineN = docLit $ Text.pack "}"
in [line1] ++ lineR ++ [lineN] in [line1] ++ lineR ++ [lineN]
@ -546,16 +563,20 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
line1 = docCols ColRecUpdate line1 = docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "{" [ appSep $ docLit $ Text.pack "{"
, appSep $ docWrapNode rF1f $ docLit $ rF1n , appSep $ docWrapNode rF1f $ docLit $ rF1n
, docSeq [ appSep $ docLit $ Text.pack "=" , case rF1e of
, docAddBaseY BrIndentRegular $ rF1e Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docAddBaseY BrIndentRegular $ x
] ]
Nothing -> docEmpty
] ]
lineR = rFr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate lineR = rFr <&> \(lfield, fText, fDoc) -> docCols ColRecUpdate
[ appSep $ docLit $ Text.pack "," [ appSep $ docLit $ Text.pack ","
, appSep $ docWrapNode lfield $ docLit $ fText , appSep $ docWrapNode lfield $ docLit $ fText
, docSeq [ appSep $ docLit $ Text.pack "=" , case fDoc of
, docAddBaseY BrIndentRegular fDoc Just x -> docSeq [ appSep $ docLit $ Text.pack "="
, docAddBaseY BrIndentRegular x
] ]
Nothing -> docEmpty
] ]
lineN = docLit $ Text.pack "}" lineN = docLit $ Text.pack "}"
in [line1] ++ lineR ++ [lineN]) in [line1] ++ lineR ++ [lineN])

9
src/Language/Haskell/Brittany/Layouters/Pattern.hs
View File

@ -53,11 +53,10 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
docLit $ t <> Text.pack "{}" docLit $ t <> Text.pack "{}"
ConPatIn lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do ConPatIn lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do
let t = lrdrNameToText lname let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat _)) -> do fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do
-- special casing for some record special thingy.. fExpDoc <- if pun
fExpDoc <- case fPat of then return Nothing
(L _ (VarPat (L _ (Unqual x)))) | occNameString x == "pun-right-hand-side" -> return Nothing else Just <$> docSharedWrapper layoutPat fPat
_ -> Just <$> docSharedWrapper layoutPat fPat
return $ (lrdrNameToText lnameF, fExpDoc) return $ (lrdrNameToText lnameF, fExpDoc)
docSeq docSeq
[ appSep $ docLit t [ appSep $ docLit t