2efc5d3 · ormolu · git.iko.soy

git.iko.soy/ormolu

Format linked lists with colon as line terminator

This adds support for a formatting style described here: <https://wiki.haskell.org/List_notation>

commit2efc5d37f9946d67f218f12cc326599ad5dd4b98 authorMark Karpov <markkarpov92@gmail.com> dateThu 4 Jun 2020, 18:42 (6 years ago) parent6dfd6f0

24 files changed+199−131

compare with master

unifiedsplit

CHANGELOG.md+3

@@ -13,6 +13,9 @@

1313* Fixed a bug related to trailing space in multiline comments in certain

1414 cases. [Issue 603](https://github.com/tweag/ormolu/issues/602).

1515

16+* Added support for formatting linked lists with `(:)` as line terminator.

17+ [Issue 478](https://github.com/tweag/ormolu/issues/478).

18+

1619## Ormolu 0.1.0.0

1720

1821* Fixed rendering of type signatures concerning several identifiers. [Issue

data/examples/declaration/value/function/infix/dollar-chains-out.hs+3−3

@@ -13,9 +13,9 @@ foo =

1313 throwIO (OrmoluCppEnabled path)

1414

1515foo =

16− bar

17− $ baz

18− $ quux

16+ bar $

17+ baz $

18+ quux

1919

2020x =

2121 case l of { A -> B } $

data/examples/declaration/value/function/infix/hanging-out.hs+4−3

@@ -17,6 +17,7 @@ update =

1717 `catch` \case

1818 a -> a

1919

20−foo = bar

21− ++ case foo of

22− a -> a

20+foo =

21+ bar

22+ ++ case foo of

23+ a -> a

data/examples/declaration/value/function/infix/lenses-out.hs+8−7

@@ -1,11 +1,12 @@

11lenses =

2− Just $ M.fromList $

3− "type" .= ("user.connection" :: Text)

4− # "connection" .= uc

5− # "user" .= case name of

6− Just n -> Just $ object ["name" .= n]

7− Nothing -> Nothing

8− # []

2+ Just $

3+ M.fromList $

4+ "type" .= ("user.connection" :: Text)

5+ # "connection" .= uc

6+ # "user" .= case name of

7+ Just n -> Just $ object ["name" .= n]

8+ Nothing -> Nothing

9+ # []

910

1011foo =

1112 a

data/examples/declaration/value/function/list-notation-0-out.hsnew file+5

@@ -0,0 +1,5 @@

1+foo =

2+ testCase "Foo" testFoo :

3+ testCase "Bar" testBar :

4+ testCase "Baz" testBaz :

5+ []

data/examples/declaration/value/function/list-notation-0.hsnew file+5

@@ -0,0 +1,5 @@

1+foo =

2+ testCase "Foo" testFoo :

3+ testCase "Bar" testBar :

4+ testCase "Baz" testBaz :

5+ []

data/examples/declaration/value/function/list-notation-1-out.hsnew file+8

@@ -0,0 +1,8 @@

1+instance A.ToJSON UpdateTable where

2+ toJSON a =

3+ A.object $

4+ "TableName" .= updateTableName a :

5+ "ProvisionedThroughput" .= updateProvisionedThroughput a :

6+ case updateGlobalSecondaryIndexUpdates a of

7+ [] -> []

8+ l -> ["GlobalSecondaryIndexUpdates" .= l]

data/examples/declaration/value/function/list-notation-1.hsnew file+7

@@ -0,0 +1,7 @@

1+instance A.ToJSON UpdateTable where

2+ toJSON a = A.object

3+ $ "TableName" .= updateTableName a

4+ : "ProvisionedThroughput" .= updateProvisionedThroughput a

5+ : case updateGlobalSecondaryIndexUpdates a of

6+ [] -> []

7+ l -> [ "GlobalSecondaryIndexUpdates" .= l ]

data/examples/declaration/value/function/list-notation-2-out.hsnew file+6

@@ -0,0 +1,6 @@

1+-- A list of the element and all its parents up to the root node.

2+getPath tree t =

3+ t :

4+ case Map.lookup (getId t) tree of

5+ Nothing -> []

6+ Just parent -> getPath tree parent

data/examples/declaration/value/function/list-notation-2.hsnew file+5

@@ -0,0 +1,5 @@

1+-- A list of the element and all its parents up to the root node.

2+getPath tree t = t :

3+ case Map.lookup (getId t) tree of

4+ Nothing -> []

5+ Just parent -> getPath tree parent

data/examples/declaration/value/function/list-notation-3-out.hsnew file+12

@@ -0,0 +1,12 @@

1+foo =

2+ reportSDoc "tc.cc" 30 $

3+ sep $ do

4+ (prettyTCM q <+> " before compilation") : do

5+ map (prettyTCM . map unArg . clPats) cls

7+foo =

8+ reportSDoc "tc.cc" 30 $

9+ sep $ do

10+ (prettyTCM q <+> " before compilation") :

11+ do

12+ map (prettyTCM . map unArg . clPats) cls

data/examples/declaration/value/function/list-notation-3.hsnew file+10

@@ -0,0 +1,10 @@

1+foo =

2+ reportSDoc "tc.cc" 30 $ sep $ do

3+ (prettyTCM q <+> " before compilation") : do

4+ map (prettyTCM . map unArg . clPats) cls

6+foo =

7+ reportSDoc "tc.cc" 30 $ sep $ do

8+ (prettyTCM q <+> " before compilation") :

9+ do

10+ map (prettyTCM . map unArg . clPats) cls

expected-failures/Agda.txt+1−1

@@ -5,7 +5,7 @@ Formatting is not idempotent:

55Please, consider reporting the bug.

77Formatting is not idempotent:

8− src/full/Agda/Syntax/Translation/InternalToAbstract.hs<rendered>:745:4

8+ src/full/Agda/Syntax/Translation/InternalToAbstract.hs<rendered>:750:4

99 before: " nes\n\n "

1010 after: " nes\n\n -- Andreas"

1111Please, consider reporting the bug.

expected-failures/intero.txt+1−1

@@ -1,5 +1,5 @@

11Formatting is not idempotent:

2− src/InteractiveUI.hs<rendered>:3688:33

2+ src/InteractiveUI.hs<rendered>:3708:33

33 before: "text \"Try\" <+> doWha"

44 after: "text \"Try\"\n "

55Please, consider reporting the bug.

expected-failures/leksah.txt+1−1

@@ -1,5 +1,5 @@

11Formatting is not idempotent:

2− src/IDE/Pane/Modules.hs<rendered>:1188:7

2+ src/IDE/Pane/Modules.hs<rendered>:1187:7

33 before: "cr\n -- show"

44 after: "cr\n in -- show"

55Please, consider reporting the bug.

src/Ormolu/Printer/Meat/Common.hs+1−1

@@ -131,7 +131,7 @@ p_infixDefHelper isInfix indentArgs name args =

131131 parens' $ do

132132 p0

133133 breakpoint

134− inci $ sitcc $ do

134+ inci . sitcc $ do

135135 name

136136 space

137137 p1

src/Ormolu/Printer/Meat/Declaration.hs+11−9

@@ -54,12 +54,13 @@ p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

5454p_hsDeclsRespectGrouping = p_hsDecls' Respect

5555

5656p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()

57−p_hsDecls' grouping style decls = sepSemi id $

58− -- Return a list of rendered declarations, adding a newline to separate

59− -- groups.

60− case groupDecls decls of

61− [] -> []

62− (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)

57+p_hsDecls' grouping style decls =

58+ sepSemi id $

59+ -- Return a list of rendered declarations, adding a newline to separate

60+ -- groups.

61+ case groupDecls decls of

62+ [] -> []

63+ (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)

6364 where

6465 renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style)

6566 renderGroupWithPrev prev curr =

@@ -288,9 +289,10 @@ patSigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc

288289patSigRdrNames _ = Nothing

289290

290291warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]

291−warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $ flip concatMap ws $ \case

292− L _ (Warning NoExtField ns _) -> map unLoc ns

293− L _ (XWarnDecl x) -> noExtCon x

292+warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $

293+ flip concatMap ws $ \case

294+ L _ (Warning NoExtField ns _) -> map unLoc ns

295+ L _ (XWarnDecl x) -> noExtCon x

294296warnSigRdrNames _ = Nothing

295297

296298patBindNames :: Pat GhcPs -> [RdrName]

src/Ormolu/Printer/Meat/Declaration/Data.hs+20−22

@@ -60,28 +60,26 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

6060 txt "where"

6161 breakpoint

6262 sepSemi (located' (p_conDecl False)) dd_cons

63− else switchLayout (getLoc name : (getLoc <$> dd_cons))

64− $ inci

65− $ do

66− let singleConstRec = isSingleConstRec dd_cons

67− if singleConstRec

68− then space

69− else

70− if hasHaddocks dd_cons

71− then newline

72− else breakpoint

73− equals

74− space

75− layout <- getLayout

76− let s =

77− if layout == MultiLine || hasHaddocks dd_cons

78− then newline >> txt "|" >> space

79− else space >> txt "|" >> space

80− sitcc' =

81− if singleConstRec

82− then id

83− else sitcc

84− sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons

63+ else switchLayout (getLoc name : (getLoc <$> dd_cons)) . inci $ do

64+ let singleConstRec = isSingleConstRec dd_cons

65+ if singleConstRec

66+ then space

67+ else

68+ if hasHaddocks dd_cons

69+ then newline

70+ else breakpoint

71+ equals

72+ space

73+ layout <- getLayout

74+ let s =

75+ if layout == MultiLine || hasHaddocks dd_cons

76+ then newline >> txt "|" >> space

77+ else space >> txt "|" >> space

78+ sitcc' =

79+ if singleConstRec

80+ then id

81+ else sitcc

82+ sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons

8583 unless (null $ unLoc dd_derivs) breakpoint

8684 inci . located dd_derivs $ \xs ->

8785 sep newline (located' p_hsDerivingClause) xs

src/Ormolu/Printer/Meat/Declaration/Instance.hs+4−6

@@ -88,12 +88,10 @@ p_clsInstDecl = \case

8888 unless (null allDecls) $ do

8989 breakpoint

9090 txt "where"

91− unless (null allDecls)

92− $ inci

93− $ do

94− -- Ensure whitespace is added after where clause.

95− breakpoint

96− dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

91+ unless (null allDecls) . inci $ do

92+ -- Ensure whitespace is added after where clause.

93+ breakpoint

94+ dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls

9795 XHsImplicitBndrs x -> noExtCon x

9896 XClsInstDecl x -> noExtCon x

9997

src/Ormolu/Printer/Meat/Declaration/Value.hs+62−53

@@ -1,4 +1,5 @@

11{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE MultiWayIf #-}

23{-# LANGUAGE OverloadedStrings #-}

34{-# LANGUAGE RecordWildCards #-}

45{-# LANGUAGE TypeApplications #-}

@@ -26,7 +27,7 @@ import qualified Data.List.NonEmpty as NE

2627import Data.Text (Text)

2728import qualified Data.Text as Text

2829import GHC

29−import OccName (mkVarOcc)

30+import OccName (occNameString)

3031import Ormolu.Printer.Combinators

3132import Ormolu.Printer.Internal

3233import Ormolu.Printer.Meat.Common

@@ -60,7 +61,7 @@ data Placement

6061 -- should use it and avoid bumping one level

6162 -- of indentation

6263 Hanging

63− deriving (Eq)

64+ deriving (Eq, Show)

6465

6566p_valDecl :: HsBindLR GhcPs GhcPs -> R ()

6667p_valDecl = \case

@@ -180,9 +181,10 @@ p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

180181 SrcStrict -> txt "!"

181182 SrcLazy -> txt "~"

182183 indentBody <- case NE.nonEmpty m_pats of

183− Nothing -> False <$ case style of

184− Function name -> p_rdrName name

185− _ -> return ()

184+ Nothing ->

185+ False <$ case style of

186+ Function name -> p_rdrName name

187+ _ -> return ()

186188 Just ne_pats -> do

187189 let combinedSpans =

188190 combineSrcSpans' $

@@ -592,9 +594,10 @@ p_hsExpr' s = \case

592594 L _ (HsAppType NoExtField _ _) -> True

593595 L _ (HsMultiIf NoExtField _) -> True

594596 L spn _ -> isOneLineSpan spn

595− ub <- getLayout <&> \case

596− SingleLine -> useBraces

597− MultiLine -> id

597+ ub <-

598+ getLayout <&> \case

599+ SingleLine -> useBraces

600+ MultiLine -> id

598601 ub $ do

599602 located func (p_hsExpr' s)

600603 breakpoint

@@ -617,7 +620,7 @@ p_hsExpr' s = \case

617620 located (hswc_body a) p_hsType

618621 OpApp NoExtField x op y -> do

619622 let opTree = OpBranch (exprOpTree x) op (exprOpTree y)

620− p_exprOpTree True s (reassociateOpTree getOpName opTree)

623+ p_exprOpTree s (reassociateOpTree getOpName opTree)

621624 NegApp NoExtField e _ -> do

622625 txt "-"

623626 space

@@ -671,7 +674,7 @@ p_hsExpr' s = \case

671674 sepSemi

672675 (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))

673676 (unLoc es)

674− compBody = brackets N $ located es $ \xs -> do

677+ compBody = brackets N . located es $ \xs -> do

675678 let p_parBody =

676679 sep

677680 (breakpoint >> txt "|" >> space)

@@ -1222,11 +1225,10 @@ exprPlacement = \case

12221225 HsCase NoExtField _ _ -> Hanging

12231226 HsDo NoExtField DoExpr _ -> Hanging

12241227 HsDo NoExtField MDoExpr _ -> Hanging

1225− -- If the rightmost expression in an operator chain is hanging, make the

1226− -- whole block hanging; so that we can use the common @f = foo $ do@

1227− -- style.

1228− OpApp NoExtField _ _ y -> exprPlacement (unLoc y)

1229− -- Same thing for function applications (usually with -XBlockArguments)

1228+ OpApp NoExtField _ op y ->

1229+ case (fmap getOpNameStr . getOpName . unLoc) op of

1230+ Just "$" -> exprPlacement (unLoc y)

1231+ _ -> Normal

12301232 HsApp NoExtField _ y -> exprPlacement (unLoc y)

12311233 HsProc NoExtField p _ ->

12321234 -- Indentation breaks if pattern is longer than one line and left

@@ -1252,15 +1254,16 @@ getOpName = \case

12521254 HsVar NoExtField (L _ a) -> Just a

12531255 _ -> Nothing

12541256

1257+getOpNameStr :: RdrName -> String

1258+getOpNameStr = occNameString . rdrNameOcc

1259+

12551260p_exprOpTree ::

1256− -- | Can use special handling of dollar?

1257− Bool ->

12581261 -- | Bracket style to use

12591262 BracketStyle ->

12601263 OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->

12611264 R ()

1262−p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)

1263−p_exprOpTree isDollarSpecial s (OpBranch x op y) = do

1265+p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)

1266+p_exprOpTree s (OpBranch x op y) = do

12641267 -- If the beginning of the first argument and the second argument are on

12651268 -- the same line, and the second argument has a hanging form, use hanging

12661269 -- placement.

@@ -1282,44 +1285,54 @@ p_exprOpTree isDollarSpecial s (OpBranch x op y) = do

12821285 MultiLine -> case placement of

12831286 Hanging -> useBraces

12841287 Normal -> dontUseBraces

1285− gotDollar = case getOpName (unLoc op) of

1286− Just rname -> mkVarOcc "$" == rdrNameOcc rname

1287− _ -> False

1288+ opNameStr = (fmap getOpNameStr . getOpName . unLoc) op

1289+ gotDollar = opNameStr == Just "$"

1290+ gotColon = opNameStr == Just ":"

1291+ gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)

12881292 lhs =

12891293 switchLayout [opTreeLoc x] $

1290− p_exprOpTree (not gotDollar) s x

1291− let p_op = located op (opWrapper . p_hsExpr)

1292− p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)

1294+ p_exprOpTree s x

1295+ p_op = located op (opWrapper . p_hsExpr)

1296+ p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)

12931297 isSection = case (opTreeLoc x, getLoc op) of

12941298 (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->

12951299 srcSpanEndCol treeSpan /= srcSpanStartCol opSpan

12961300 _ -> False

1301+ isDoBlock = \case

1302+ OpNode (L _ HsDo {}) -> True

1303+ _ -> False

12971304 useRecordDot' <- useRecordDot

1298− let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)

1299− if useRecordDot' && isRecordDot'

1300− then do

1301− lhs

1302− when isSection space

1303− p_op

1304− p_y

1305− else

1306− if isDollarSpecial

1307− && gotDollar

1308− && placement

1309− == Normal

1310− && isOneLineSpan (opTreeLoc x)

1311− then do

1312− useBraces lhs

1313− space

1314− p_op

1315− breakpoint

1316− inci p_y

1317− else do

1318− ub lhs

1319− placeHanging placement $ do

1320− p_op

1305+ if

1306+ | gotColon -> do

1307+ lhs

1308+ space

1309+ p_op

1310+ case placement of

1311+ Hanging -> do

13211312 space

13221313 p_y

1314+ Normal -> do

1315+ breakpoint

1316+ inciIf (isDoBlock y) p_y

1317+ | gotDollar

1318+ && isOneLineSpan (opTreeLoc x)

1319+ && placement == Normal -> do

1320+ useBraces lhs

1321+ space

1322+ p_op

1323+ breakpoint

1324+ inci p_y

1325+ | useRecordDot' && gotRecordDot -> do

1326+ lhs

1327+ when isSection space

1328+ p_op

1329+ p_y

1330+ | otherwise -> do

1331+ ub lhs

1332+ placeHanging placement $ do

1333+ p_op

1334+ space

1335+ p_y

13231336

13241337-- | Return 'True' if given expression is a record-dot operator expression.

13251338isRecordDot ::

@@ -1330,14 +1343,10 @@ isRecordDot ::

13301343 Bool

13311344isRecordDot op (RealSrcSpan ySpan) = case op of

13321345 HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->

1333− isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

1346+ (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)

13341347 _ -> False

13351348isRecordDot _ _ = False

13361349

1337−-- | Check whether a given 'RdrName' is the dot operator.

1338−isDot :: RdrName -> Bool

1339−isDot name = rdrNameOcc name == mkVarOcc "."

1340−

13411350-- | Get annotations for the enclosing element.

13421351getEnclosingAnns :: R [AnnKeywordId]

13431352getEnclosingAnns = do

src/Ormolu/Printer/Meat/Declaration/Warning.hs+2−3

@@ -32,9 +32,8 @@ p_moduleWarning wtxt = do

3232p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()

3333p_topLevelWarning fnames wtxt = do

3434 let (pragmaText, lits) = warningText wtxt

35− switchLayout (fmap getLoc fnames ++ fmap getLoc lits)

36− $ pragma pragmaText . inci

37− $ do

35+ switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $

36+ pragma pragmaText . inci $ do

3837 sep commaDel p_rdrName fnames

3938 breakpoint

4039 p_lits lits

src/Ormolu/Printer/Meat/ImportExport.hs+2−3

@@ -93,9 +93,8 @@ p_lie encLayout relativePos = \case

9393 inci $ do

9494 let names :: [R ()]

9595 names = located' p_ieWrappedName <$> xs

96− parens N

97− $ sep commaDel sitcc

98− $ case w of

96+ parens N . sep commaDel sitcc $

97+ case w of

9998 NoIEWildcard -> names

10099 IEWildcard n ->

101100 let (before, after) = splitAt n names

src/Ormolu/Printer/Meat/Type.hs+2−2

@@ -67,7 +67,7 @@ p_hsType' multilineArgs docStyle = \case

6767 L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs)

6868 _ -> (f', knownArgs)

6969 (func, args) = gatherArgs f [x]

70− switchLayout (getLoc f : fmap getLoc args) $ sitcc $ do

70+ switchLayout (getLoc f : fmap getLoc args) . sitcc $ do

7171 located func p_hsType

7272 breakpoint

7373 inci $

@@ -270,6 +270,6 @@ tyVarToType = \case

270270 -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as

271271 -- long as 'tyVarToType' does not get applied to right-hand sides of

272272 -- declarations.

273− HsParTy NoExtField $ noLoc $

273+ HsParTy NoExtField . noLoc $

274274 HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind

275275 XTyVarBndr x -> noExtCon x

src/Ormolu/Printer/Operators.hs+16−16

@@ -16,7 +16,7 @@ import Data.Map.Strict (Map)

1616import qualified Data.Map.Strict as M

1717import Data.Maybe (fromMaybe, mapMaybe)

1818import GHC

19−import OccName (mkVarOcc)

19+import OccName (occNameString)

2020import Ormolu.Utils (unSrcSpan)

2121

2222-- | Intermediate representation of operator trees. It has two type

@@ -57,7 +57,7 @@ reassociateOpTree getOpName opTree =

5757reassociateOpTreeWith ::

5858 forall ty op.

5959 -- | Fixity map for operators

60− Map RdrName Fixity ->

60+ Map String Fixity ->

6161 -- | How to get the name of an operator

6262 (op -> Maybe RdrName) ->

6363 -- | Original 'OpTree'

@@ -68,8 +68,8 @@ reassociateOpTreeWith fixityMap getOpName = go

6868 where

6969 fixityOf :: op -> Fixity

7070 fixityOf op = fromMaybe defaultFixity $ do

71− opName <- getOpName op

72− M.lookup opName fixityMap

71+ s <- occNameString . rdrNameOcc <$> getOpName op

72+ M.lookup s fixityMap

7373 -- Here, left branch is already associated and the root alongside with

7474 -- the right branch is right-associated. This function picks up one item

7575 -- from the right and inserts it correctly to the left.

@@ -112,26 +112,26 @@ buildFixityMap ::

112112 -- | Operator tree

113113 OpTree (Located ty) (Located op) ->

114114 -- | Fixity map

115− Map RdrName Fixity

115+ Map String Fixity

116116buildFixityMap getOpName opTree =

117117 addOverrides

118118 . M.fromList

119119 . concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)

120− . zip [1 ..]

120+ . zip [2 ..]

121121 . L.groupBy ((==) `on` snd)

122122 . selectScores

123123 $ score opTree

124124 where

125− addOverrides :: Map RdrName Fixity -> Map RdrName Fixity

125+ addOverrides :: Map String Fixity -> Map String Fixity

126126 addOverrides m =

127− let mk k v = (mkRdrUnqual (mkVarOcc k), fixity v InfixL)

128− in M.fromList

129− [ mk "$" 0,

130− mk "." 9

131− ]

132− `M.union` m

127+ M.fromList

128+ [ ("$", fixity 0 InfixR),

129+ (":", fixity 1 InfixR),

130+ (".", fixity 100 InfixL)

131+ ]

132+ `M.union` m

133133 fixity = Fixity NoSourceText

134− score :: OpTree (Located ty) (Located op) -> [(RdrName, Score)]

134+ score :: OpTree (Located ty) (Located op) -> [(String, Score)]

135135 score (OpNode _) = []

136136 score (OpBranch l o r) = fromMaybe (score r) $ do

137137 -- If we fail to get any of these, 'defaultFixity' will be used by

@@ -141,13 +141,13 @@ buildFixityMap getOpName opTree =

141141 oe <- srcSpanEndLine <$> unSrcSpan (getLoc o) -- operator end

142142 rb <- srcSpanStartLine <$> unSrcSpan (opTreeLoc r) -- right begin

143143 oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column

144− opName <- getOpName (unLoc o)

144+ opName <- occNameString . rdrNameOcc <$> getOpName (unLoc o)

145145 let s

146146 | le < ob = AtBeginning oc

147147 | oe < rb = AtEnd

148148 | otherwise = InBetween

149149 return $ (opName, s) : score r

150− selectScores :: [(RdrName, Score)] -> [(RdrName, Score)]

150+ selectScores :: [(String, Score)] -> [(String, Score)]

151151 selectScores =

152152 L.sortOn snd

153153 . mapMaybe