on master help sign in
Keep the ($) operator on the same line in certain cases
commit397fc55b67fb94cfa1749049d372c2a7891f4720 authormrkkrp <mark.karpov@tweag.io> dateWed 2 Oct 2019, 17:33 (7 years ago) parent8466d6e
9 files changed+84−33
data/examples/declaration/value/function/infix/applicative.hs−2 data/examples/declaration/value/function/infix/comments-out.hs+3−5 data/examples/declaration/value/function/infix/dollar-chains-out.hs+18 data/examples/declaration/value/function/infix/dollar-chains.hs+18 data/examples/declaration/value/function/infix/lenses-out.hs+2−2 data/examples/declaration/value/function/lambda-multi-line1-out.hs+3−3 data/examples/declaration/value/function/lambda-multi-line2-out.hs+4−4 data/examples/declaration/value/function/let-multi-line-out.hs+3−3 src/Ormolu/Printer/Meat/Declaration/Value.hs+33−14
data/examples/declaration/value/function/infix/applicative.hs−2
@@ -1,6 +1,4 @@
1−
21f =
32 Foo <$> bar
43 <*> baz
54 <*> baz'
6−
data/examples/declaration/value/function/infix/comments-out.hs+3−5
@@ -1,10 +1,8 @@
11main =
2− bar
3− $ baz -- bar
4− -- baz
2+ bar $ -- bar
3+ baz -- baz
54
6−bar
7− $
5+bar $
86 {- foo
97 -}
108 bar
data/examples/declaration/value/function/infix/dollar-chains-out.hsnew file+18
@@ -0,0 +1,18 @@
1+module Main where
2+
3+foo =
4+ fmap escapeLeadingDollar
5+ . dropPaddingSpace
6+ . dropWhileEnd T.null
7+ . fmap (T.stripEnd . T.pack)
8+ . lines
9+ $ unpackHDS docStr
10+
11+foo =
12+ when (GHC.xopt Cpp dynFlags && not cfgTolerateCpp) $
13+ throwIO (OrmoluCppEnabled path)
14+
15+foo =
16+ bar
17+ $ baz
18+ $ quux
data/examples/declaration/value/function/infix/dollar-chains.hsnew file+18
@@ -0,0 +1,18 @@
1+module Main where
2+
3+foo =
4+ fmap escapeLeadingDollar
5+ . dropPaddingSpace
6+ . dropWhileEnd T.null
7+ . fmap (T.stripEnd . T.pack)
8+ . lines
9+ $ unpackHDS docStr
10+
11+foo =
12+ when (GHC.xopt Cpp dynFlags && not cfgTolerateCpp) $
13+ throwIO (OrmoluCppEnabled path)
14+
15+foo =
16+ bar
17+ $ baz
18+ $ quux
data/examples/declaration/value/function/infix/lenses-out.hs+2−2
@@ -1,6 +1,6 @@
11lenses =
2− Just $ M.fromList
3− $ "type" .= ("user.connection" :: Text)
2+ Just $ M.fromList $
3+ "type" .= ("user.connection" :: Text)
44 # "connection" .= uc
55 # "user" .= case name of
66 Just n -> Just $ object ["name" .= n]
data/examples/declaration/value/function/lambda-multi-line1-out.hs+3−3
@@ -9,7 +9,7 @@ bar x = \y ->
99 else 12
1010
1111foo =
12− prop "is inverse to closure"
13− $ \(f :: StaticPtr (Int -> Int))
14− (x :: Int) ->
12+ prop "is inverse to closure" $
13+ \(f :: StaticPtr (Int -> Int))
14+ (x :: Int) ->
1515 (unclosure . closure) f x == deRefStaticPtr f x
data/examples/declaration/value/function/lambda-multi-line2-out.hs+4−4
@@ -3,10 +3,10 @@ tricky0 =
33 canUnify poly_given_ok wt gt || go False wt gt
44
55tricky1 =
6− flip all (zip ws gs)
7− $ \(wt, gt) -> canUnify poly_given_ok wt gt || go False wt gt
6+ flip all (zip ws gs) $
7+ \(wt, gt) -> canUnify poly_given_ok wt gt || go False wt gt
88
99tricky2 =
10− flip all (zip ws gs)
11− $ \(wt, gt) ->
10+ flip all (zip ws gs) $
11+ \(wt, gt) ->
1212 canUnify poly_given_ok wt gt || go False wt gt
data/examples/declaration/value/function/let-multi-line-out.hs+3−3
@@ -23,6 +23,6 @@ implicitParams =
2323 in foo cs
2424
2525sitting =
26− foo
27− $ let x = 20
28− in x
26+ foo $
27+ let x = 20
28+ in x
src/Ormolu/Printer/Meat/Declaration/Value.hs+33−14
@@ -21,17 +21,19 @@ import Data.Data hiding (Infix, Prefix)
2121import Data.List (intersperse, sortOn)
2222import Data.List.NonEmpty (NonEmpty ((:|)))
2323import Data.Text (Text)
24−import qualified Data.Text as Text
2524import GHC
25+import OccName (mkVarOcc)
2626import Ormolu.Printer.Combinators
2727import Ormolu.Printer.Meat.Common
2828import Ormolu.Printer.Meat.Declaration.Signature
2929import Ormolu.Printer.Meat.Type
3030import Ormolu.Printer.Operators
3131import Ormolu.Utils
32+import RdrName (RdrName (..))
3233import RdrName (rdrNameOcc)
3334import SrcLoc (combineSrcSpans, isOneLineSpan)
3435import qualified Data.List.NonEmpty as NE
36+import qualified Data.Text as Text
3537import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
3638
3739-- | Style of a group of equations.
@@ -549,10 +551,7 @@ p_hsExpr' s = \case
549551 located (hswc_body a) p_hsType
550552 OpApp NoExt x op y -> do
551553 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)
552− getOpName = \case
553− HsVar NoExt (L _ a) -> Just a
554− _ -> Nothing
555− p_exprOpTree s (reassociateOpTree getOpName opTree)
554+ p_exprOpTree True s (reassociateOpTree getOpName opTree)
556555 NegApp NoExt e _ -> do
557556 txt "-"
558557 space
@@ -1145,9 +1144,18 @@ exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
11451144exprOpTree (L _ (OpApp NoExt x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)
11461145exprOpTree n = OpNode n
11471146
1148−p_exprOpTree :: BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
1149−p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)
1150−p_exprOpTree s (OpBranch x op y) = do
1147+getOpName :: HsExpr GhcPs -> Maybe RdrName
1148+getOpName = \case
1149+ HsVar NoExt (L _ a) -> Just a
1150+ _ -> Nothing
1151+
1152+p_exprOpTree
1153+ :: Bool -- ^ Can use special handling of dollar?
1154+ -> BracketStyle -- ^ Bracket style to use
1155+ -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
1156+ -> R ()
1157+p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)
1158+p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
11511159 -- NOTE If the beginning of the first argument and the second argument
11521160 -- are on the same line, and the second argument has a hanging form, use
11531161 -- hanging placement.
@@ -1167,13 +1175,24 @@ p_exprOpTree s (OpBranch x op y) = do
11671175 MultiLine -> case placement of
11681176 Hanging -> useBraces
11691177 Normal -> dontUseBraces
1178+ gotDollar = case getOpName (unLoc op) of
1179+ Just rname -> mkVarOcc "$" == (rdrNameOcc rname)
1180+ _ -> False
11701181 switchLayout [opTreeLoc x] $
1171− ub $ p_exprOpTree s x
1172− placeHanging placement $ do
1173− located op (opWrapper . p_hsExpr)
1174− space
1175− switchLayout [opTreeLoc y] $
1176− p_exprOpTree N y
1182+ ub $ p_exprOpTree (not gotDollar) s x
1183+ let p_op = located op (opWrapper . p_hsExpr)
1184+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)
1185+ if isDollarSpecial && gotDollar && placement == Normal && isOneLineSpan (opTreeLoc x)
1186+ then do
1187+ space
1188+ p_op
1189+ breakpoint
1190+ inci p_y
1191+ else
1192+ placeHanging placement $ do
1193+ p_op
1194+ space
1195+ p_y
11771196
11781197-- | Get annotations for the enclosing element.
11791198