From 9755db1d05ba30f95ea2d21d6be70006da1e1371 Mon Sep 17 00:00:00 2001
From: Sergey Vinokurov <serg.foo@gmail.com>
Date: Tue, 18 Sep 2018 09:12:35 +0100
Subject: [PATCH] Unify "(#", "#)" under single name, docParenHashL and
docParenHashR
---
src-literatetests/15-regressions.blt | 3 ++-
.../Brittany/Internal/LayouterBasics.hs | 23 +++++++++++++++-
.../Brittany/Internal/Layouters/Expr.hs | 5 +---
.../Brittany/Internal/Layouters/Pattern.hs | 26 +++++++------------
.../Brittany/Internal/Layouters/Type.hs | 4 +--
5 files changed, 37 insertions(+), 24 deletions(-)
diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt
index 52306c1..e7bf199 100644
--- a/src-literatetests/15-regressions.blt
+++ b/src-literatetests/15-regressions.blt
@@ -653,11 +653,12 @@ jaicyhHumzo btrKpeyiFej mava = do
#test unboxed-tuple and vanilla names
{-# LANGUAGE UnboxedTuples #-}
+spanKey :: (# Int, Int #) -> (# Int, Int #)
spanKey = case foo of
(# bar, baz #) -> (# baz, bar #)
#test unboxed-tuple and hashed name
{-# LANGUAGE MagicHash, UnboxedTuples #-}
-spanKey :: _ -> (# Int#, Int# #)
+spanKey :: (# Int#, Int# #) -> (# Int#, Int# #)
spanKey = case foo of
(# bar#, baz# #) -> (# baz# +# bar#, bar# #)
diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
index d5aac63..c6cd9ae 100644
--- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
+++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
@@ -50,7 +50,12 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, appSep
, docCommaSep
, docParenLSep
+ , docParenL
, docParenR
+ , docParenHashL
+ , docParenHashR
+ , docBracketL
+ , docBracketR
, docTick
, spacifyDocs
, briDocMToPPM
@@ -530,11 +535,27 @@ docCommaSep :: ToBriDocM BriDocNumbered
docCommaSep = appSep $ docLit $ Text.pack ","
docParenLSep :: ToBriDocM BriDocNumbered
-docParenLSep = appSep $ docLit $ Text.pack "("
+docParenLSep = appSep docParenL
+
+docParenL :: ToBriDocM BriDocNumbered
+docParenL = docLit $ Text.pack "("
docParenR :: ToBriDocM BriDocNumbered
docParenR = docLit $ Text.pack ")"
+docParenHashL :: ToBriDocM BriDocNumbered
+docParenHashL = docSeq [docLit $ Text.pack "(#", docSeparator]
+
+docParenHashR :: ToBriDocM BriDocNumbered
+docParenHashR = docSeq [docSeparator, docLit $ Text.pack "#)"]
+
+docBracketL :: ToBriDocM BriDocNumbered
+docBracketL = docLit $ Text.pack "["
+
+docBracketR :: ToBriDocM BriDocNumbered
+docBracketR = docLit $ Text.pack "]"
+
+
docTick :: ToBriDocM BriDocNumbered
docTick = docLit $ Text.pack "'"
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
index 96b739c..a486d3b 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs
@@ -372,10 +372,7 @@ layoutExpr lexpr@(L _ expr) = do
hasComments <- hasAnyCommentsBelow lexpr
let (openLit, closeLit) = case boxity of
Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")")
- Unboxed ->
- ( docSeq [docLit $ Text.pack "(#", docSeparator]
- , docSeq [docSeparator, docLit $ Text.pack "#)"]
- )
+ Unboxed -> (docParenHashL, docParenHashR)
case splitFirstLast argDocs of
FirstLastEmpty -> docSeq
[ openLit
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
index 6c95e0b..6b8e750 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs
@@ -140,8 +140,8 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
-- (nestedpat1, nestedpat2, nestedpat3) -> expr
-- (#nestedpat1, nestedpat2, nestedpat3#) -> expr
case boxity of
- Boxed -> wrapPatListy args "(" ")" False
- Unboxed -> wrapPatListy args "(#" "#)" True
+ Boxed -> wrapPatListy args "()" docParenL docParenR
+ Unboxed -> wrapPatListy args "(##)" docParenHashL docParenHashR
AsPat asName asPat -> do
-- bind@nestedpat -> expr
wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@")
@@ -172,7 +172,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
ListPat elems _ _ ->
-- [] -> expr1
-- [nestedpat1, nestedpat2, nestedpat3] -> expr2
- wrapPatListy elems "[" "]" False
+ wrapPatListy elems "[]" docBracketL docBracketR
BangPat pat1 -> do
-- !nestedpat -> expr
wrapPatPrepend pat1 (docLit $ Text.pack "!")
@@ -212,24 +212,18 @@ wrapPatPrepend pat prepElem = do
wrapPatListy
:: [Located (Pat GhcPs)]
-> String
- -> String
- -> Bool
+ -> ToBriDocM BriDocNumbered
+ -> ToBriDocM BriDocNumbered
-> ToBriDocM (Seq BriDocNumbered)
-wrapPatListy elems start end padSeparators = do
+wrapPatListy elems both start end = do
elemDocs <- Seq.fromList elems `forM` (layoutPat >=> colsWrapPat)
case Seq.viewl elemDocs of
- Seq.EmptyL -> fmap Seq.singleton $ docLit $ Text.pack $ start ++ end
+ Seq.EmptyL -> fmap Seq.singleton $ docLit $ Text.pack both
x1 Seq.:< rest -> do
- sDoc <- docLit $ Text.pack start
- eDoc <- docLit $ Text.pack end
- let sDoc' | padSeparators = docSeq [return sDoc, docSeparator]
- | otherwise = return sDoc
- eDoc' | padSeparators = docSeq [docSeparator, return eDoc]
- | otherwise = return eDoc
- sDoc'' <- sDoc'
- eDoc'' <- eDoc'
+ sDoc <- start
+ eDoc <- end
rest' <- rest `forM` \bd -> docSeq
[ docCommaSep
, return bd
]
- return $ (sDoc'' Seq.<| x1 Seq.<| rest') Seq.|> eDoc''
+ return $ (sDoc Seq.<| x1 Seq.<| rest') Seq.|> eDoc
diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
index 2a8f0dd..d50a10c 100644
--- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
+++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
@@ -407,8 +407,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
unboxedL = do
docs <- docSharedWrapper layoutType `mapM` typs
- let start = docSeq [docLit $ Text.pack "(#", docSeparator]
- end = docSeq [docSeparator, docLit $ Text.pack "#)"]
+ let start = docParenHashL
+ end = docParenHashR
docAlt
[ docSeq $ [start]
++ List.intersperse docCommaSep docs