40ec6b0 · ormolu · git.iko.soy

git.iko.soy/ormolu

Fix a typo and GHC warnings

commit40ec6b0098ef15d46191e03f706cdf92081fb74c authorYuriy Syrovetskiy <cblp@cblp.su> dateThu 7 Nov 2019, 17:19 (7 years ago) parent15fd409

11 files changed+60−47

compare with master

unifiedsplit

default.nix+2−1 ormolu.cabal+2 src/Ormolu/Diff.hs+1−1 src/Ormolu/Imports.hs+8−4 src/Ormolu/Printer/Meat/Declaration/Class.hs+6−7 src/Ormolu/Printer/Meat/Declaration/Instance.hs+11−10 src/Ormolu/Printer/Meat/Declaration/Type.hs+4−3 src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+6−5 src/Ormolu/Printer/Meat/Declaration/Value.hs+13−13 src/Ormolu/Printer/Operators.hs+6−2 src/Ormolu/Printer/SpanStream.hs+1−1

default.nix+2−1

@@ -14,7 +14,8 @@ let

1414 overrides = ormoluOverlay;

1515 };

1616 ormoluOverlay = self: super: {

17− "ormolu" = super.callCabal2nix "ormolu" source { };

17+ "ormolu" = pkgs.haskell.lib.enableCabalFlag

18+ (super.callCabal2nix "ormolu" source { }) "dev";

1819 # Nixpkgs provides ghc-lib-parser-8.8.0.20190424, but we want

1920 # ghc-lib-parser-8.8.1. We disable Haddock generation because it's way

2021 # too slow.

ormolu.cabal+2

@@ -117,6 +117,8 @@ library

117117 -Wincomplete-uni-patterns

118118 -Wnoncanonical-monad-instances

119119 -Wnoncanonical-monadfail-instances

120+ -- https://github.com/haskell/haddock/issues/1116

121+ -Wno-missing-home-modules

120122 else

121123 ghc-options: -O2 -Wall

122124 default-language: Haskell2010

src/Ormolu/Diff.hs+1−1

@@ -57,7 +57,7 @@ matchIgnoringSrcSpans = genericQuery

5757 where

5858 genericQuery :: GenericQ (GenericQ Diff)

5959 genericQuery x y

60− -- NOTE 'ByteString' implement 'Data' instance manually and does not

60+ -- NOTE 'ByteString' implements 'Data' instance manually and does not

6161 -- implement 'toConstr', so we have to deal with it in a special way.

6262 | Just x' <- cast x,

6363 Just y' <- cast y =

src/Ormolu/Imports.hs+8−4

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

11{-# LANGUAGE LambdaCase #-}

22{-# LANGUAGE RankNTypes #-}

3+{-# LANGUAGE RecordWildCards #-}

45-- | Manipulations on import lists.

56module Ormolu.Imports

@@ -22,10 +23,13 @@ sortImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]

2223sortImports = sortBy compareIdecl . fmap (fmap sortImportLists)

2324 where

2425 sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs

25− sortImportLists decl =

26− decl

27− { ideclHiding = second (fmap sortLies) <$> ideclHiding decl

28− }

26+ sortImportLists = \case

27+ ImportDecl {..} ->

28+ ImportDecl

29+ { ideclHiding = second (fmap sortLies) <$> ideclHiding,

30+ ..

31+ }

32+ XImportDecl {} -> notImplemented "XImportDecl"

2933

3034-- | Compare two @'LImportDecl' 'GhcPs'@ things.

3135compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering

src/Ormolu/Printer/Meat/Declaration/Class.hs+6−7

@@ -12,8 +12,7 @@ import Class

1212import Control.Arrow

1313import Control.Monad

1414import Data.Foldable

15−import Data.List (sortBy)

16−import Data.Ord (comparing)

15+import Data.List (sortOn)

1716import GHC

1817import Ormolu.Printer.Combinators

1918import Ormolu.Printer.Meat.Common

@@ -34,9 +33,8 @@ p_classDecl ::

3433 [LTyFamDefltEqn GhcPs] ->

3534 [LDocDecl] ->

3635 R ()

37−p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs cdocs = do

38− let HsQTvs {..} = tvars

39− variableSpans = getLoc <$> hsq_explicit

36+p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = do

37+ let variableSpans = getLoc <$> hsq_explicit

4038 signatureSpans = getLoc name : variableSpans

4139 dependencySpans = getLoc <$> fdeps

4240 combinedSpans = getLoc ctx : (signatureSpans ++ dependencySpans)

@@ -45,7 +43,7 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs cdocs = do

4543 breakpoint

4644 inci $ do

4745 p_classContext ctx

48− switchLayout signatureSpans $ do

46+ switchLayout signatureSpans $

4947 p_infixDefHelper

5048 (isInfix fixity)

5149 inci

@@ -65,7 +63,7 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs cdocs = do

6563 )

6664 <$> catdefs

6765 allDecls =

68− snd <$> sortBy (comparing fst) (sigs <> vals <> tyFams <> tyFamDefs <> docs)

66+ snd <$> sortOn fst (sigs <> vals <> tyFams <> tyFamDefs <> docs)

6967 unless (null allDecls) $ do

7068 space

7169 txt "where"

@@ -74,6 +72,7 @@ p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs cdocs = do

7472 -- declarations.

7573 when (hasSeparatedDecls allDecls) breakpoint'

7674 inci (p_hsDecls Associated allDecls)

75+p_classDecl _ _ XLHsQTyVars {} _ _ _ _ _ _ _ = notImplemented "XLHsQTyVars"

7776

7877p_classContext :: LHsContext GhcPs -> R ()

7978p_classContext ctx = unless (null (unLoc ctx)) $ do

src/Ormolu/Printer/Meat/Declaration/Instance.hs+11−10

@@ -15,8 +15,7 @@ import BasicTypes

1515import Control.Arrow

1616import Control.Monad

1717import Data.Foldable

18−import Data.List (sortBy)

19−import Data.Ord (comparing)

18+import Data.List (sortOn)

2019import GHC

2120import Ormolu.Printer.Combinators

2221import Ormolu.Printer.Meat.Common

@@ -39,7 +38,7 @@ p_standaloneDerivDecl DerivDecl {..} = do

3938 txt "deriving"

4039 space

4140 case deriv_strategy of

42− Nothing -> do

41+ Nothing ->

4342 instTypes False

4443 Just (L _ a) -> case a of

4544 StockStrategy -> do

@@ -82,8 +81,7 @@ p_clsInstDecl = \case

8281 )

8382 <$> cid_datafam_insts

8483 allDecls =

85− snd

86− <$> sortBy (comparing fst) (sigs <> vals <> tyFamInsts <> dataFamInsts)

84+ snd <$> sortOn fst (sigs <> vals <> tyFamInsts <> dataFamInsts)

8785 located hsib_body $ \x -> do

8886 breakpoint

8987 inci $ do

@@ -92,8 +90,9 @@ p_clsInstDecl = \case

9290 unless (null allDecls) $ do

9391 breakpoint

9492 txt "where"

95− unless (null allDecls) $ do

96− inci $ do

93+ unless (null allDecls)

94+ $ inci

95+ $ do

9796 -- Ensure whitespace is added after where clause.

9897 breakpoint

9998 -- Add newline before first declaration if the body contains separate

@@ -114,10 +113,12 @@ p_tyFamInstDecl style = \case

114113

115114p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()

116115p_dataFamInstDecl style = \case

117− DataFamInstDecl {..} -> do

118− let HsIB {..} = dfid_eqn

119− FamEqn {..} = hsib_body

116+ DataFamInstDecl {dfid_eqn = HsIB {hsib_body = FamEqn {..}}} ->

120117 p_dataDecl style feqn_tycon (map typeArgToType feqn_pats) feqn_fixity feqn_rhs

118+ DataFamInstDecl {dfid_eqn = HsIB {hsib_body = XFamEqn {}}} ->

119+ notImplemented "XFamEqn"

120+ DataFamInstDecl {dfid_eqn = XHsImplicitBndrs {}} ->

121+ notImplemented "XHsImplicitBndrs"

121122

122123match_overlap_mode :: Maybe (Located OverlapMode) -> R () -> R ()

123124match_overlap_mode overlap_mode layoutStrategy =

src/Ormolu/Printer/Meat/Declaration/Type.hs+4−3

@@ -11,6 +11,7 @@ import GHC

1111import Ormolu.Printer.Combinators

1212import Ormolu.Printer.Meat.Common

1313import Ormolu.Printer.Meat.Type

14+import Ormolu.Utils (notImplemented)

1415import RdrName (RdrName (..))

1516import SrcLoc (Located)

1617

@@ -24,11 +25,10 @@ p_synDecl ::

2425 -- | RHS of type declaration

2526 LHsType GhcPs ->

2627 R ()

27−p_synDecl name fixity tvars t = do

28+p_synDecl name fixity HsQTvs {..} t = do

2829 txt "type"

2930 space

30− let HsQTvs {..} = tvars

31− switchLayout (getLoc name : map getLoc hsq_explicit) $ do

31+ switchLayout (getLoc name : map getLoc hsq_explicit) $

3232 p_infixDefHelper

3333 (case fixity of Infix -> True; _ -> False)

3434 inci

@@ -38,3 +38,4 @@ p_synDecl name fixity tvars t = do

3838 txt "="

3939 breakpoint

4040 inci (located t p_hsType)

41+p_synDecl _ _ XLHsQTyVars {} _ = notImplemented "XLHsQTyVars"

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

@@ -20,7 +20,7 @@ import Ormolu.Utils

2020import SrcLoc (GenLocated (..), Located)

2121

2222p_famDecl :: FamilyStyle -> FamilyDecl GhcPs -> R ()

23−p_famDecl style FamilyDecl {..} = do

23+p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do

2424 mmeqs <- case fdInfo of

2525 DataFamily -> Nothing <$ txt "data"

2626 OpenTypeFamily -> Nothing <$ txt "type"

@@ -28,10 +28,9 @@ p_famDecl style FamilyDecl {..} = do

2828 txt $ case style of

2929 Associated -> mempty

3030 Free -> " family"

31− let HsQTvs {..} = fdTyVars

3231 breakpoint

3332 inci $ do

34− switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $ do

33+ switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $

3534 p_infixDefHelper

3635 (isInfix fdFixity)

3736 inci

@@ -56,6 +55,8 @@ p_famDecl style FamilyDecl {..} = do

5655 Just eqs -> do

5756 newline

5857 sep newline (located' (inci . p_tyFamInstEqn)) eqs

58+p_famDecl _ FamilyDecl {fdTyVars = XLHsQTyVars {}} =

59+ notImplemented "XLHsQTyVars"

5960p_famDecl _ (XFamilyDecl NoExt) = notImplemented "XFamilyDecl"

6061

6162p_familyResultSigL ::

@@ -87,8 +88,7 @@ p_injectivityAnn (InjectivityAnn a bs) = do

8788 sep space p_rdrName bs

8889

8990p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

90−p_tyFamInstEqn HsIB {..} = do

91− let FamEqn {..} = hsib_body

91+p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do

9292 case feqn_bndrs of

9393 Nothing -> return ()

9494 Just bndrs -> do

@@ -106,6 +106,7 @@ p_tyFamInstEqn HsIB {..} = do

106106 txt "="

107107 breakpoint

108108 inci (located feqn_rhs p_hsType)

109+p_tyFamInstEqn HsIB {hsib_body = XFamEqn {}} = notImplemented "HsIB XFamEqn"

109110p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"

110111

111112----------------------------------------------------------------------------

src/Ormolu/Printer/Meat/Declaration/Value.hs+13−13

@@ -167,7 +167,7 @@ p_match' ::

167167 -- | Equations

168168 GRHSs GhcPs (Located body) ->

169169 R ()

170−p_match' placer render style isInfix strictness m_pats m_grhss = do

170+p_match' placer render style isInfix strictness m_pats GRHSs {..} = do

171171 -- NOTE Normally, since patterns may be placed in a multi-line layout, it

172172 -- is necessary to bump indentation for the pattern group so it's more

173173 -- indented than function name. This in turn means that indentation for

@@ -224,9 +224,8 @@ p_match' placer render style isInfix strictness m_pats m_grhss = do

224224 Case -> True

225225 LambdaCase -> True

226226 _ -> False

227− let GRHSs {..} = m_grhss

228− hasGuards = withGuards grhssGRHSs

229− unless (length grhssGRHSs > 1) $ do

227+ let hasGuards = withGuards grhssGRHSs

228+ unless (length grhssGRHSs > 1) $

230229 case style of

231230 Function _ | hasGuards -> return ()

232231 Function _ -> space >> txt "="

@@ -266,6 +265,7 @@ p_match' placer render style isInfix strictness m_pats m_grhss = do

266265 switchLayout [patGrhssSpan] $

267266 placeHanging placement p_body

268267 inci p_where

268+p_match' _ _ _ _ _ _ XGRHSs {} = notImplemented "XGRHSs"

269269

270270p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()

271271p_grhs = p_grhs' exprPlacement p_hsExpr

@@ -395,7 +395,7 @@ p_stmt' placer render = \case

395395 -- such that it never occurs in 'p_stmt''. Consequently, handling it

396396 -- here would be redundant.

397397 notImplemented "ParStmt"

398− TransStmt {..} -> do

398+ TransStmt {..} ->

399399 -- NOTE 'TransStmt' only needs to account for render printing itself,

400400 -- since pretty printing of relevant statements (e.g., in 'trS_stmts')

401401 -- is handled through 'gatherStmt'.

@@ -484,7 +484,7 @@ p_hsLocalBinds = \case

484484p_hsRecField ::

485485 HsRecField' RdrName (LHsExpr GhcPs) ->

486486 R ()

487−p_hsRecField = \HsRecField {..} -> do

487+p_hsRecField HsRecField {..} = do

488488 p_rdrName hsRecFieldLbl

489489 unless hsRecPun $ do

490490 space

@@ -691,16 +691,16 @@ p_hsExpr' s = \case

691691 (comma >> breakpoint)

692692 (sitcc . located' (p_hsRecField . updName))

693693 rupd_flds

694− ExprWithTySig NoExt x affix -> sitcc $ do

694+ ExprWithTySig NoExt x HsWC {hswc_body = HsIB {..}} -> sitcc $ do

695695 located x p_hsExpr

696696 space

697697 txt "::"

698698 breakpoint

699− inci $ do

700− let HsWC {..} = affix

701− HsIB {..} = hswc_body

702− located hsib_body p_hsType

703− ArithSeq NoExt _ x -> do

699+ inci $ located hsib_body p_hsType

700+ ExprWithTySig NoExt _ HsWC {hswc_body = XHsImplicitBndrs {}} ->

701+ notImplemented "XHsImplicitBndrs"

702+ ExprWithTySig NoExt _ XHsWildCardBndrs {} -> notImplemented "XHsWildCardBndrs"

703+ ArithSeq NoExt _ x ->

704704 case x of

705705 From from -> brackets s . sitcc $ do

706706 located from p_hsExpr

@@ -911,7 +911,7 @@ p_pat = \case

911911 BangPat NoExt pat -> do

912912 txt "!"

913913 p_pat pat

914− ListPat NoExt pats -> do

914+ ListPat NoExt pats ->

915915 brackets S . sitcc $ sep (comma >> breakpoint) p_pat pats

916916 TuplePat NoExt pats boxing -> do

917917 let f =

src/Ormolu/Printer/Operators.hs+6−2

@@ -13,7 +13,7 @@ where

1313import BasicTypes (Fixity (..), SourceText (NoSourceText), compareFixity, defaultFixity)

1414import Data.Function (on)

1515import Data.List

16−import Data.Maybe (fromMaybe)

16+import Data.Maybe (fromMaybe, mapMaybe)

1717import GHC

1818import OccName (mkVarOcc)

1919import RdrName (mkRdrUnqual)

@@ -144,7 +144,11 @@ buildFixityMap getOpName opTree =

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

145145 avgScores =

146146 sortOn snd

147− . map (\xs@((n, _) : _) -> (n, avg $ map snd xs))

147+ . mapMaybe

148+ ( \case

149+ [] -> Nothing

150+ xs@((n, _) : _) -> Just (n, avg $ map snd xs)

151+ )

148152 . groupBy ((==) `on` fst)

149153 . sort

150154 avg :: [Double] -> Double

src/Ormolu/Printer/SpanStream.hs+1−1

@@ -36,7 +36,7 @@ mkSpanStream a =

3636 $ everything mappend (const mempty `ext2Q` queryLocated) a

3737 where

3838 queryLocated ::

39− (Data e0, Data e1) =>

39+ (Data e0) =>

4040 GenLocated e0 e1 ->

4141 DList RealSrcSpan

4242 queryLocated (L mspn _) =