e91ced8 · ormolu · git.iko.soy

src/Ormolu.hs+1−3

compare with master

unifiedsplit

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

1{-# LANGUAGE BangPatterns #-}

2−{-# LANGUAGE RecordWildCards #-}

3

2

4-- | A formatter for Haskell source code.

3-- | A formatter for Haskell source code.

5module Ormolu

4module Ormolu

@@ -29,7 +28,6 @@ import Ormolu.Parser.Result

29import Ormolu.Printer

28import Ormolu.Printer

30import Ormolu.Utils (showOutputable)

29import Ormolu.Utils (showOutputable)

31import qualified SrcLoc as GHC

30import qualified SrcLoc as GHC

32−import System.IO (hGetContents, stdin)

33

31

34-- | Format a 'String', return formatted version as 'Text'.

32-- | Format a 'String', return formatted version as 'Text'.

35--

33--

@@ -115,7 +113,7 @@ ormoluStdin ::

115 -- | Resulting rendition

113 -- | Resulting rendition

116 m Text

114 m Text

117ormoluStdin cfg =

115ormoluStdin cfg =

118− liftIO (hGetContents stdin) >>= ormolu cfg "<stdin>"

116+ liftIO getContents >>= ormolu cfg "<stdin>"

119

117

120----------------------------------------------------------------------------

118----------------------------------------------------------------------------

121-- Helpers

119-- Helpers

src/Ormolu/Config.hs−4

@@ -1,7 +1,3 @@

1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE RecordWildCards #-}

4−

5-- | Configuration options used by the tool.

1-- | Configuration options used by the tool.

6module Ormolu.Config

2module Ormolu.Config

7 ( Config (..),

3 ( Config (..),

src/Ormolu/Diff.hs+1−3

@@ -1,6 +1,4 @@

1−{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE RankNTypes #-}

1{-# LANGUAGE RankNTypes #-}

3−{-# LANGUAGE RecordWildCards #-}

4

2

5-- | Diffing GHC ASTs modulo span positions.

3-- | Diffing GHC ASTs modulo span positions.

6module Ormolu.Diff

4module Ormolu.Diff

@@ -107,7 +105,7 @@ matchIgnoringSrcSpans = genericQuery

107 appendSpan :: SrcSpan -> Diff -> Diff

105 appendSpan :: SrcSpan -> Diff -> Diff

108 appendSpan s (Different ss) | fresh && helpful = Different (s : ss)

106 appendSpan s (Different ss) | fresh && helpful = Different (s : ss)

109 where

107 where

110− fresh = not $ any (flip isSubspanOf s) ss

108+ fresh = not $ any (`isSubspanOf` s) ss

111 helpful = isGoodSrcSpan s

109 helpful = isGoodSrcSpan s

112 appendSpan _ d = d

110 appendSpan _ d = d

113

111

src/Ormolu/Exception.hs+12−10

@@ -49,10 +49,12 @@ instance Exception OrmoluException where

49 unlines $

50 [ "AST of input and AST of formatted code differ."

51 ]

52+ ++ fmap

53+ withIndent

52− ++ ( fmap withIndent $ case fmap (\s -> "at " ++ showOutputable s) ss of

54+ ( case fmap (\s -> "at " ++ showOutputable s) ss of

53− [] -> ["in " ++ path]

55+ [] -> ["in " ++ path]

54− xs -> xs

56+ xs -> xs

55− )

57+ )

56 ++ ["Please, consider reporting the bug."]

58 ++ ["Please, consider reporting the bug."]

57 OrmoluNonIdempotentOutput loc left right ->

59 OrmoluNonIdempotentOutput loc left right ->

58 showParsingErr

60 showParsingErr

@@ -80,12 +82,12 @@ withPrettyOrmoluExceptions m = m `catch` h

80 exitWith . ExitFailure $

82 exitWith . ExitFailure $

81 case e of

83 case e of

82 -- Error code 1 is for `error` or `notImplemented`

84 -- Error code 1 is for `error` or `notImplemented`

83− OrmoluCppEnabled _ -> 2

85+ OrmoluCppEnabled {} -> 2

84− OrmoluParsingFailed _ _ -> 3

86+ OrmoluParsingFailed {} -> 3

85− OrmoluOutputParsingFailed _ _ -> 4

87+ OrmoluOutputParsingFailed {} -> 4

86− OrmoluASTDiffers _ _ -> 5

88+ OrmoluASTDiffers {} -> 5

87− OrmoluNonIdempotentOutput _ _ _ -> 6

89+ OrmoluNonIdempotentOutput {} -> 6

88− OrmoluUnrecognizedOpts _ -> 7

90+ OrmoluUnrecognizedOpts {} -> 7

89

91

90----------------------------------------------------------------------------

92----------------------------------------------------------------------------

91-- Helpers

93-- Helpers

src/Ormolu/Parser.hs−1

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

1{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE RecordWildCards #-}

3−{-# LANGUAGE StandaloneDeriving #-}

4{-# OPTIONS_GHC -fno-warn-orphans #-}

3{-# OPTIONS_GHC -fno-warn-orphans #-}

5

4

6-- | Parser for Haskell source code.

5-- | Parser for Haskell source code.

src/Ormolu/Parser/CommentStream.hs−2

@@ -1,8 +1,6 @@

1−{-# LANGUAGE BangPatterns #-}

2{-# LANGUAGE DeriveDataTypeable #-}

1{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4{-# LANGUAGE LambdaCase #-}

3{-# LANGUAGE LambdaCase #-}

5−{-# LANGUAGE TupleSections #-}

6

4

7-- | Functions for working with comment stream.

5-- | Functions for working with comment stream.

8module Ormolu.Parser.CommentStream

6module Ormolu.Parser.CommentStream

src/Ormolu/Parser/Pragma.hs+1−1

@@ -54,7 +54,7 @@ parseExtensions :: String -> Maybe [String]

54parseExtensions str = tokenize str >>= go

55 where

56 go = \case

57− (L.ITconid ext : []) -> return [unpackFS ext]

57+ [L.ITconid ext] -> return [unpackFS ext]

58 (L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> go xs

59 _ -> Nothing

60

src/Ormolu/Printer.hs−2

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

1−{-# LANGUAGE LambdaCase #-}

2−{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE RecordWildCards #-}

1{-# LANGUAGE RecordWildCards #-}

4

2

5-- | Pretty-printer for Haskell AST.

3-- | Pretty-printer for Haskell AST.

src/Ormolu/Printer/Combinators.hs−1

@@ -2,7 +2,6 @@

2{-# LANGUAGE GADTs #-}

3{-# LANGUAGE LambdaCase #-}

4{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE RecordWildCards #-}

6

5

7-- | Printing combinators. The definitions here are presented in such an

6-- | Printing combinators. The definitions here are presented in such an

8-- order so you can just go through the Haddocks and by the end of the file

7-- order so you can just go through the Haddocks and by the end of the file

src/Ormolu/Printer/Comments.hs+4−6

@@ -1,4 +1,3 @@

1−{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

1{-# LANGUAGE OverloadedStrings #-}

3

2

4-- | Helpers for formatting of comments. This is low-level code, use

3-- | Helpers for formatting of comments. This is low-level code, use

@@ -244,11 +243,10 @@ commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =

244 Nothing -> True

243 Nothing -> True

245 Just espn ->

244 Just espn ->

246 let startColumn = srcLocCol . realSrcSpanStart

245 let startColumn = srcLocCol . realSrcSpanStart

247− in if startColumn espn > startColumn ref

246+ in startColumn espn > startColumn ref

248− then True

249− else

250− abs (startColumn espn - startColumn l)

247+ || ( abs (startColumn espn - startColumn l)

251− >= abs (startColumn ref - startColumn l)

248+ >= abs (startColumn ref - startColumn l)

249+ )

252 continuation =

250 continuation =

253 case mlastSpn of

251 case mlastSpn of

254 Nothing -> False

252 Nothing -> False

src/Ormolu/Printer/Internal.hs−1

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

1{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2−{-# LANGUAGE LambdaCase #-}

3{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE RankNTypes #-}

3{-# LANGUAGE RankNTypes #-}

5

4

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

@@ -257,6 +257,6 @@ patBindNames (SigPat _ p _) = patBindNames p

257patBindNames (NPat NoExt _ _ _) = []

258patBindNames (NPlusKPat NoExt (L _ n) _ _ _ _) = [n]

259patBindNames (ConPatIn _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)

260−patBindNames (ConPatOut _ _ _ _ _ _ _) = notImplemented "ConPatOut" -- created by renamer

260+patBindNames ConPatOut {} = notImplemented "ConPatOut" -- created by renamer

261patBindNames (CoPat NoExt _ p _) = patBindNames p

262patBindNames (XPat p) = patBindNames (unLoc p)

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

@@ -9,8 +9,7 @@ module Ormolu.Printer.Meat.Declaration.Data

9where

10

11import Control.Monad

12−import Data.Maybe (isJust)

12+import Data.Maybe (isJust, maybeToList)

13−import Data.Maybe (maybeToList)

14import GHC

13import GHC

15import Ormolu.Printer.Combinators

14import Ormolu.Printer.Combinators

16import Ormolu.Printer.Meat.Common

15import Ormolu.Printer.Meat.Common

@@ -73,7 +72,7 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do

73 (newline >> txt "|" >> space)

72 (newline >> txt "|" >> space)

74 sep s (sitcc . located' p_conDecl) dd_cons

73 sep s (sitcc . located' p_conDecl) dd_cons

75 unless (null $ unLoc dd_derivs) breakpoint

74 unless (null $ unLoc dd_derivs) breakpoint

76− inci . located dd_derivs $ \xs -> do

75+ inci . located dd_derivs $ \xs ->

77 sep newline (located' p_hsDerivingClause) xs

76 sep newline (located' p_hsDerivingClause) xs

78p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"

77p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"

79

78

src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs−1

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

1{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE TypeFamilies #-}

3{-# LANGUAGE TypeFamilies #-}

5

4

6-- | Rendering of Role annotation declarations.

5-- | Rendering of Role annotation declarations.

src/Ormolu/Printer/Meat/Declaration/Rule.hs−1

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

1{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE RecordWildCards #-}

4

3

5module Ormolu.Printer.Meat.Declaration.Rule

4module Ormolu.Printer.Meat.Declaration.Rule

6 ( p_ruleDecls,

5 ( p_ruleDecls,

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+1−2

@@ -37,8 +37,7 @@ p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do

37 (p_rdrName fdLName)

38 (located' p_hsTyVarBndr <$> hsq_explicit)

39 let rsig = p_familyResultSigL fdResultSig

40− unless (isNothing rsig && isNothing fdInjectivityAnn) $

40+ unless (isNothing rsig && isNothing fdInjectivityAnn) space

41− space

42 inci $ do

41 inci $ do

43 sequence_ rsig

42 sequence_ rsig

44 when (isJust rsig && isJust fdInjectivityAnn) breakpoint

43 when (isJust rsig && isJust fdInjectivityAnn) breakpoint

src/Ormolu/Printer/Meat/Declaration/Value.hs+5−6

@@ -32,8 +32,7 @@ import Ormolu.Printer.Meat.Declaration.Signature

32import Ormolu.Printer.Meat.Type

33import Ormolu.Printer.Operators

34import Ormolu.Utils

35−import RdrName (RdrName (..))

35+import RdrName (RdrName (..), rdrNameOcc)

36−import RdrName (rdrNameOcc)

37import SrcLoc (combineSrcSpans, isOneLineSpan)

36import SrcLoc (combineSrcSpans, isOneLineSpan)

38

37

39-- | Style of a group of equations.

38-- | Style of a group of equations.

@@ -456,7 +455,7 @@ p_hsLocalBinds = \case

456 -- Assigns 'False' to the last element, 'True' to the rest.

455 -- Assigns 'False' to the last element, 'True' to the rest.

457 markInit :: [a] -> [(Bool, a)]

456 markInit :: [a] -> [(Bool, a)]

458 markInit [] = []

457 markInit [] = []

459− markInit (x : []) = [(False, x)]

458+ markInit [x] = [(False, x)]

460 markInit (x : xs) = (True, x) : markInit xs

459 markInit (x : xs) = (True, x) : markInit xs

461 -- NOTE When in a single-line layout, there is a chance that the inner

460 -- NOTE When in a single-line layout, there is a chance that the inner

462 -- elements will also contain semicolons and they will confuse the

461 -- elements will also contain semicolons and they will confuse the

@@ -838,7 +837,7 @@ p_case ::

838 -- | Expression

837 -- | Expression

839 LHsExpr GhcPs ->

838 LHsExpr GhcPs ->

840 -- | Match group

839 -- | Match group

841− (MatchGroup GhcPs (Located body)) ->

840+ MatchGroup GhcPs (Located body) ->

842 R ()

841 R ()

843p_case placer render e mgroup = do

842p_case placer render e mgroup = do

844 txt "case"

843 txt "case"

@@ -1164,7 +1163,7 @@ blockPlacement ::

1164 (body -> Placement) ->

1163 (body -> Placement) ->

1165 [LGRHS GhcPs (Located body)] ->

1164 [LGRHS GhcPs (Located body)] ->

1166 Placement

1165 Placement

1167−blockPlacement placer [(L _ (GRHS NoExt _ (L _ x)))] = placer x

1166+blockPlacement placer [L _ (GRHS NoExt _ (L _ x))] = placer x

1168blockPlacement _ _ = Normal

1167blockPlacement _ _ = Normal

1169

1168

1170-- | Check if given command has a hanging form.

1169-- | Check if given command has a hanging form.

@@ -1257,7 +1256,7 @@ p_exprOpTree isDollarSpecial s (OpBranch x op y) = do

1257 Hanging -> useBraces

1256 Hanging -> useBraces

1258 Normal -> dontUseBraces

1257 Normal -> dontUseBraces

1259 gotDollar = case getOpName (unLoc op) of

1258 gotDollar = case getOpName (unLoc op) of

1260− Just rname -> mkVarOcc "$" == (rdrNameOcc rname)

1259+ Just rname -> mkVarOcc "$" == rdrNameOcc rname

1261 _ -> False

1260 _ -> False

1262 lhs =

1261 lhs =

1263 switchLayout [opTreeLoc x] $

1262 switchLayout [opTreeLoc x] $

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

@@ -28,14 +28,16 @@ p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"

28p_moduleWarning :: WarningTxt -> R ()

29p_moduleWarning wtxt = do

30 let (pragmaText, lits) = warningText wtxt

31− switchLayout (getLoc <$> lits) $ do

31+ switchLayout (getLoc <$> lits)

32+ $ inci

32− inci $ pragma pragmaText (inci $ p_lits lits)

33+ $ pragma pragmaText (inci $ p_lits lits)

33

34

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

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

35p_topLevelWarning fnames wtxt = do

36p_topLevelWarning fnames wtxt = do

36 let (pragmaText, lits) = warningText wtxt

37 let (pragmaText, lits) = warningText wtxt

37− switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $ do

38+ switchLayout (fmap getLoc fnames ++ fmap getLoc lits)

38− pragma pragmaText . inci $ do

39+ $ pragma pragmaText . inci

40+ $ do

39 sitcc $ sep (comma >> breakpoint) p_rdrName fnames

41 sitcc $ sep (comma >> breakpoint) p_rdrName fnames

40 breakpoint

42 breakpoint

41 p_lits lits

43 p_lits lits

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

@@ -56,7 +56,7 @@ p_hsmodImport ImportDecl {..} = do

56 when hiding (txt "hiding")

57 case ideclHiding of

58 Nothing -> return ()

59− Just (_, (L _ xs)) -> do

59+ Just (_, L _ xs) -> do

60 breakpoint

61 parens N . sitcc $ do

62 layout <- getLayout

src/Ormolu/Printer/Meat/Module.hs−1

@@ -1,4 +1,3 @@

1−{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE OverloadedStrings #-}

1{-# LANGUAGE OverloadedStrings #-}

3{-# LANGUAGE RecordWildCards #-}

2{-# LANGUAGE RecordWildCards #-}

4

3

src/Ormolu/Printer/Meat/Type.hs+10−9

@@ -84,9 +84,10 @@ p_hsType' multilineArgs = \case

84 HsSumTy NoExt xs ->

85 parensHash N . sitcc $

86 sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs

87− HsOpTy NoExt x op y -> sitcc $ do

87+ HsOpTy NoExt x op y ->

88+ sitcc $

88− let opTree = OpBranch (tyOpTree x) op (tyOpTree y)

89+ let opTree = OpBranch (tyOpTree x) op (tyOpTree y)

89− in p_tyOpTree (reassociateOpTree Just opTree)

90+ in p_tyOpTree (reassociateOpTree Just opTree)

90 HsParTy NoExt t ->

91 HsParTy NoExt t ->

91 parens N (located t p_hsType)

92 parens N (located t p_hsType)

92 HsIParamTy NoExt n t -> sitcc $ do

93 HsIParamTy NoExt n t -> sitcc $ do

@@ -126,14 +127,14 @@ p_hsType' multilineArgs = \case

126 -- If both this list itself and the first element is promoted,

127 -- If both this list itself and the first element is promoted,

127 -- we need to put a space in between or it fails to parse.

128 -- we need to put a space in between or it fails to parse.

128 case (p, xs) of

129 case (p, xs) of

129− (IsPromoted, ((L _ t) : _)) | isPromoted t -> space

130+ (IsPromoted, L _ t : _) | isPromoted t -> space

130 _ -> return ()

131 _ -> return ()

131 sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

132 sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs

132 HsExplicitTupleTy NoExt xs -> do

133 HsExplicitTupleTy NoExt xs -> do

133 txt "'"

134 txt "'"

134 parens N $ do

135 parens N $ do

135 case xs of

136 case xs of

136− ((L _ t) : _) | isPromoted t -> space

137+ L _ t : _ | isPromoted t -> space

137 _ -> return ()

138 _ -> return ()

138 sep (comma >> breakpoint) (located' p_hsType) xs

139 sep (comma >> breakpoint) (located' p_hsType) xs

139 HsTyLit NoExt t ->

140 HsTyLit NoExt t ->

@@ -145,8 +146,8 @@ p_hsType' multilineArgs = \case

145 where

146 where

146 isPromoted = \case

147 isPromoted = \case

147 HsTyVar _ IsPromoted _ -> True

148 HsTyVar _ IsPromoted _ -> True

148− HsExplicitListTy _ _ _ -> True

149+ HsExplicitListTy {} -> True

149− HsExplicitTupleTy _ _ -> True

150+ HsExplicitTupleTy {} -> True

150 _ -> False

151 _ -> False

151 interArgBreak =

152 interArgBreak =

152 if multilineArgs

153 if multilineArgs

@@ -158,7 +159,7 @@ p_hsType' multilineArgs = \case

158-- attached to it.

159-- attached to it.

159hasDocStrings :: HsType GhcPs -> Bool

160hasDocStrings :: HsType GhcPs -> Bool

160hasDocStrings = \case

161hasDocStrings = \case

161− HsDocTy _ _ _ -> True

162+ HsDocTy {} -> True

162 HsFunTy _ (L _ x) (L _ y) -> hasDocStrings x || hasDocStrings y

163 HsFunTy _ (L _ x) (L _ y) -> hasDocStrings x || hasDocStrings y

163 _ -> False

164 _ -> False

164

165

@@ -220,7 +221,7 @@ tyOpTree n = OpNode n

220p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R ()

221p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R ()

221p_tyOpTree (OpNode n) = located n p_hsType

222p_tyOpTree (OpNode n) = located n p_hsType

222p_tyOpTree (OpBranch l op r) = do

223p_tyOpTree (OpBranch l op r) = do

223− switchLayout [opTreeLoc l] $ do

224+ switchLayout [opTreeLoc l] $

224 p_tyOpTree l

225 p_tyOpTree l

225 breakpoint

226 breakpoint

226 inci . switchLayout [opTreeLoc r] $ do

227 inci . switchLayout [opTreeLoc r] $ do

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

@@ -129,17 +129,17 @@ buildFixityMap getOpName opTree =

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

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

131 opName <- getOpName (unLoc o)

132− let s =

132+ let s

133− if le < ob

133+ | le < ob =

134− then-- if the operator is in the beginning of a line, assign

134+ -- if the operator is in the beginning of a line, assign

135 -- a score relative to its column within range [0, 1).

136− fromIntegral oc / fromIntegral (maxCol + 1)

136+ fromIntegral oc / fromIntegral (maxCol + 1)

137+ | oe < rb =

137− else-- if the operator is in the end of the line, assign the

138+ -- if the operator is in the end of the line, assign the

138 -- score 1.

139 -- score 1.

139−

140+ 1

140− if oe < rb

141+ | otherwise =

141− then 1

142− else 2 -- otherwise, assign a high score.

142+ 2 -- otherwise, assign a high score.

143 return $ (opName, s) : score r

144 avgScores :: [(RdrName, Double)] -> [(RdrName, Double)]

145 avgScores =

tests/Ormolu/Parser/PragmaSpec.hs+1−1

@@ -4,7 +4,7 @@ import Ormolu.Parser.Pragma

4import Test.Hspec

5

6spec :: Spec

7−spec = do

7+spec =

8 describe "parsePragma" $ do

9 stdTest "{-# LANGUAGE Foo #-}" (Just (PragmaLanguage ["Foo"]))

10 stdTest "{-# language Foo #-}" (Just (PragmaLanguage ["Foo"]))