mirror of
https://github.com/tweag/ormolu.git
synced 2024-10-06 01:47:10 +03:00
Fix HLint warnings
This commit is contained in:
parent
40ec6b0098
commit
e91ced82c4
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
-- | A formatter for Haskell source code.
|
||||
module Ormolu
|
||||
@ -29,7 +28,6 @@ import Ormolu.Parser.Result
|
||||
import Ormolu.Printer
|
||||
import Ormolu.Utils (showOutputable)
|
||||
import qualified SrcLoc as GHC
|
||||
import System.IO (hGetContents, stdin)
|
||||
|
||||
-- | Format a 'String', return formatted version as 'Text'.
|
||||
--
|
||||
@ -115,7 +113,7 @@ ormoluStdin ::
|
||||
-- | Resulting rendition
|
||||
m Text
|
||||
ormoluStdin cfg =
|
||||
liftIO (hGetContents stdin) >>= ormolu cfg "<stdin>"
|
||||
liftIO getContents >>= ormolu cfg "<stdin>"
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Helpers
|
||||
|
@ -1,7 +1,3 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
-- | Configuration options used by the tool.
|
||||
module Ormolu.Config
|
||||
( Config (..),
|
||||
|
@ -1,6 +1,4 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
-- | Diffing GHC ASTs modulo span positions.
|
||||
module Ormolu.Diff
|
||||
@ -107,7 +105,7 @@ matchIgnoringSrcSpans = genericQuery
|
||||
appendSpan :: SrcSpan -> Diff -> Diff
|
||||
appendSpan s (Different ss) | fresh && helpful = Different (s : ss)
|
||||
where
|
||||
fresh = not $ any (flip isSubspanOf s) ss
|
||||
fresh = not $ any (`isSubspanOf` s) ss
|
||||
helpful = isGoodSrcSpan s
|
||||
appendSpan _ d = d
|
||||
|
||||
|
@ -49,7 +49,9 @@ instance Exception OrmoluException where
|
||||
unlines $
|
||||
[ "AST of input and AST of formatted code differ."
|
||||
]
|
||||
++ ( fmap withIndent $ case fmap (\s -> "at " ++ showOutputable s) ss of
|
||||
++ fmap
|
||||
withIndent
|
||||
( case fmap (\s -> "at " ++ showOutputable s) ss of
|
||||
[] -> ["in " ++ path]
|
||||
xs -> xs
|
||||
)
|
||||
@ -80,12 +82,12 @@ withPrettyOrmoluExceptions m = m `catch` h
|
||||
exitWith . ExitFailure $
|
||||
case e of
|
||||
-- Error code 1 is for `error` or `notImplemented`
|
||||
OrmoluCppEnabled _ -> 2
|
||||
OrmoluParsingFailed _ _ -> 3
|
||||
OrmoluOutputParsingFailed _ _ -> 4
|
||||
OrmoluASTDiffers _ _ -> 5
|
||||
OrmoluNonIdempotentOutput _ _ _ -> 6
|
||||
OrmoluUnrecognizedOpts _ -> 7
|
||||
OrmoluCppEnabled {} -> 2
|
||||
OrmoluParsingFailed {} -> 3
|
||||
OrmoluOutputParsingFailed {} -> 4
|
||||
OrmoluASTDiffers {} -> 5
|
||||
OrmoluNonIdempotentOutput {} -> 6
|
||||
OrmoluUnrecognizedOpts {} -> 7
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Helpers
|
||||
|
@ -1,6 +1,5 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
-- | Parser for Haskell source code.
|
||||
|
@ -1,8 +1,6 @@
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
-- | Functions for working with comment stream.
|
||||
module Ormolu.Parser.CommentStream
|
||||
|
@ -54,7 +54,7 @@ parseExtensions :: String -> Maybe [String]
|
||||
parseExtensions str = tokenize str >>= go
|
||||
where
|
||||
go = \case
|
||||
(L.ITconid ext : []) -> return [unpackFS ext]
|
||||
[L.ITconid ext] -> return [unpackFS ext]
|
||||
(L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> go xs
|
||||
_ -> Nothing
|
||||
|
||||
|
@ -1,5 +1,3 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
-- | Pretty-printer for Haskell AST.
|
||||
|
@ -2,7 +2,6 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
-- | Printing combinators. The definitions here are presented in such an
|
||||
-- order so you can just go through the Haddocks and by the end of the file
|
||||
|
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | Helpers for formatting of comments. This is low-level code, use
|
||||
@ -244,11 +243,10 @@ commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =
|
||||
Nothing -> True
|
||||
Just espn ->
|
||||
let startColumn = srcLocCol . realSrcSpanStart
|
||||
in if startColumn espn > startColumn ref
|
||||
then True
|
||||
else
|
||||
abs (startColumn espn - startColumn l)
|
||||
in startColumn espn > startColumn ref
|
||||
|| ( abs (startColumn espn - startColumn l)
|
||||
>= abs (startColumn ref - startColumn l)
|
||||
)
|
||||
continuation =
|
||||
case mlastSpn of
|
||||
Nothing -> False
|
||||
|
@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
|
@ -257,6 +257,6 @@ patBindNames (SigPat _ p _) = patBindNames p
|
||||
patBindNames (NPat NoExt _ _ _) = []
|
||||
patBindNames (NPlusKPat NoExt (L _ n) _ _ _ _) = [n]
|
||||
patBindNames (ConPatIn _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)
|
||||
patBindNames (ConPatOut _ _ _ _ _ _ _) = notImplemented "ConPatOut" -- created by renamer
|
||||
patBindNames ConPatOut {} = notImplemented "ConPatOut" -- created by renamer
|
||||
patBindNames (CoPat NoExt _ p _) = patBindNames p
|
||||
patBindNames (XPat p) = patBindNames (unLoc p)
|
||||
|
@ -9,8 +9,7 @@ module Ormolu.Printer.Meat.Declaration.Data
|
||||
where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Maybe (maybeToList)
|
||||
import Data.Maybe (isJust, maybeToList)
|
||||
import GHC
|
||||
import Ormolu.Printer.Combinators
|
||||
import Ormolu.Printer.Meat.Common
|
||||
@ -73,7 +72,7 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do
|
||||
(newline >> txt "|" >> space)
|
||||
sep s (sitcc . located' p_conDecl) dd_cons
|
||||
unless (null $ unLoc dd_derivs) breakpoint
|
||||
inci . located dd_derivs $ \xs -> do
|
||||
inci . located dd_derivs $ \xs ->
|
||||
sep newline (located' p_hsDerivingClause) xs
|
||||
p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"
|
||||
|
||||
|
@ -1,6 +1,5 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
-- | Rendering of Role annotation declarations.
|
||||
|
@ -1,6 +1,5 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Ormolu.Printer.Meat.Declaration.Rule
|
||||
( p_ruleDecls,
|
||||
|
@ -37,8 +37,7 @@ p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do
|
||||
(p_rdrName fdLName)
|
||||
(located' p_hsTyVarBndr <$> hsq_explicit)
|
||||
let rsig = p_familyResultSigL fdResultSig
|
||||
unless (isNothing rsig && isNothing fdInjectivityAnn) $
|
||||
space
|
||||
unless (isNothing rsig && isNothing fdInjectivityAnn) space
|
||||
inci $ do
|
||||
sequence_ rsig
|
||||
when (isJust rsig && isJust fdInjectivityAnn) breakpoint
|
||||
|
@ -32,8 +32,7 @@ import Ormolu.Printer.Meat.Declaration.Signature
|
||||
import Ormolu.Printer.Meat.Type
|
||||
import Ormolu.Printer.Operators
|
||||
import Ormolu.Utils
|
||||
import RdrName (RdrName (..))
|
||||
import RdrName (rdrNameOcc)
|
||||
import RdrName (RdrName (..), rdrNameOcc)
|
||||
import SrcLoc (combineSrcSpans, isOneLineSpan)
|
||||
|
||||
-- | Style of a group of equations.
|
||||
@ -456,7 +455,7 @@ p_hsLocalBinds = \case
|
||||
-- Assigns 'False' to the last element, 'True' to the rest.
|
||||
markInit :: [a] -> [(Bool, a)]
|
||||
markInit [] = []
|
||||
markInit (x : []) = [(False, x)]
|
||||
markInit [x] = [(False, x)]
|
||||
markInit (x : xs) = (True, x) : markInit xs
|
||||
-- NOTE When in a single-line layout, there is a chance that the inner
|
||||
-- elements will also contain semicolons and they will confuse the
|
||||
@ -838,7 +837,7 @@ p_case ::
|
||||
-- | Expression
|
||||
LHsExpr GhcPs ->
|
||||
-- | Match group
|
||||
(MatchGroup GhcPs (Located body)) ->
|
||||
MatchGroup GhcPs (Located body) ->
|
||||
R ()
|
||||
p_case placer render e mgroup = do
|
||||
txt "case"
|
||||
@ -1164,7 +1163,7 @@ blockPlacement ::
|
||||
(body -> Placement) ->
|
||||
[LGRHS GhcPs (Located body)] ->
|
||||
Placement
|
||||
blockPlacement placer [(L _ (GRHS NoExt _ (L _ x)))] = placer x
|
||||
blockPlacement placer [L _ (GRHS NoExt _ (L _ x))] = placer x
|
||||
blockPlacement _ _ = Normal
|
||||
|
||||
-- | Check if given command has a hanging form.
|
||||
@ -1257,7 +1256,7 @@ p_exprOpTree isDollarSpecial s (OpBranch x op y) = do
|
||||
Hanging -> useBraces
|
||||
Normal -> dontUseBraces
|
||||
gotDollar = case getOpName (unLoc op) of
|
||||
Just rname -> mkVarOcc "$" == (rdrNameOcc rname)
|
||||
Just rname -> mkVarOcc "$" == rdrNameOcc rname
|
||||
_ -> False
|
||||
lhs =
|
||||
switchLayout [opTreeLoc x] $
|
||||
|
@ -28,14 +28,16 @@ p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"
|
||||
p_moduleWarning :: WarningTxt -> R ()
|
||||
p_moduleWarning wtxt = do
|
||||
let (pragmaText, lits) = warningText wtxt
|
||||
switchLayout (getLoc <$> lits) $ do
|
||||
inci $ pragma pragmaText (inci $ p_lits lits)
|
||||
switchLayout (getLoc <$> lits)
|
||||
$ inci
|
||||
$ pragma pragmaText (inci $ p_lits lits)
|
||||
|
||||
p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
|
||||
p_topLevelWarning fnames wtxt = do
|
||||
let (pragmaText, lits) = warningText wtxt
|
||||
switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $ do
|
||||
pragma pragmaText . inci $ do
|
||||
switchLayout (fmap getLoc fnames ++ fmap getLoc lits)
|
||||
$ pragma pragmaText . inci
|
||||
$ do
|
||||
sitcc $ sep (comma >> breakpoint) p_rdrName fnames
|
||||
breakpoint
|
||||
p_lits lits
|
||||
|
@ -56,7 +56,7 @@ p_hsmodImport ImportDecl {..} = do
|
||||
when hiding (txt "hiding")
|
||||
case ideclHiding of
|
||||
Nothing -> return ()
|
||||
Just (_, (L _ xs)) -> do
|
||||
Just (_, L _ xs) -> do
|
||||
breakpoint
|
||||
parens N . sitcc $ do
|
||||
layout <- getLayout
|
||||
|
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
|
@ -84,7 +84,8 @@ p_hsType' multilineArgs = \case
|
||||
HsSumTy NoExt xs ->
|
||||
parensHash N . sitcc $
|
||||
sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs
|
||||
HsOpTy NoExt x op y -> sitcc $ do
|
||||
HsOpTy NoExt x op y ->
|
||||
sitcc $
|
||||
let opTree = OpBranch (tyOpTree x) op (tyOpTree y)
|
||||
in p_tyOpTree (reassociateOpTree Just opTree)
|
||||
HsParTy NoExt t ->
|
||||
@ -126,14 +127,14 @@ p_hsType' multilineArgs = \case
|
||||
-- If both this list itself and the first element is promoted,
|
||||
-- we need to put a space in between or it fails to parse.
|
||||
case (p, xs) of
|
||||
(IsPromoted, ((L _ t) : _)) | isPromoted t -> space
|
||||
(IsPromoted, L _ t : _) | isPromoted t -> space
|
||||
_ -> return ()
|
||||
sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
|
||||
HsExplicitTupleTy NoExt xs -> do
|
||||
txt "'"
|
||||
parens N $ do
|
||||
case xs of
|
||||
((L _ t) : _) | isPromoted t -> space
|
||||
L _ t : _ | isPromoted t -> space
|
||||
_ -> return ()
|
||||
sep (comma >> breakpoint) (located' p_hsType) xs
|
||||
HsTyLit NoExt t ->
|
||||
@ -145,8 +146,8 @@ p_hsType' multilineArgs = \case
|
||||
where
|
||||
isPromoted = \case
|
||||
HsTyVar _ IsPromoted _ -> True
|
||||
HsExplicitListTy _ _ _ -> True
|
||||
HsExplicitTupleTy _ _ -> True
|
||||
HsExplicitListTy {} -> True
|
||||
HsExplicitTupleTy {} -> True
|
||||
_ -> False
|
||||
interArgBreak =
|
||||
if multilineArgs
|
||||
@ -158,7 +159,7 @@ p_hsType' multilineArgs = \case
|
||||
-- attached to it.
|
||||
hasDocStrings :: HsType GhcPs -> Bool
|
||||
hasDocStrings = \case
|
||||
HsDocTy _ _ _ -> True
|
||||
HsDocTy {} -> True
|
||||
HsFunTy _ (L _ x) (L _ y) -> hasDocStrings x || hasDocStrings y
|
||||
_ -> False
|
||||
|
||||
@ -220,7 +221,7 @@ tyOpTree n = OpNode n
|
||||
p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R ()
|
||||
p_tyOpTree (OpNode n) = located n p_hsType
|
||||
p_tyOpTree (OpBranch l op r) = do
|
||||
switchLayout [opTreeLoc l] $ do
|
||||
switchLayout [opTreeLoc l] $
|
||||
p_tyOpTree l
|
||||
breakpoint
|
||||
inci . switchLayout [opTreeLoc r] $ do
|
||||
|
@ -129,17 +129,17 @@ buildFixityMap getOpName opTree =
|
||||
rb <- srcSpanStartLine <$> unSrcSpan (opTreeLoc r) -- right begin
|
||||
oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column
|
||||
opName <- getOpName (unLoc o)
|
||||
let s =
|
||||
if le < ob
|
||||
then-- if the operator is in the beginning of a line, assign
|
||||
let s
|
||||
| le < ob =
|
||||
-- if the operator is in the beginning of a line, assign
|
||||
-- a score relative to its column within range [0, 1).
|
||||
fromIntegral oc / fromIntegral (maxCol + 1)
|
||||
else-- if the operator is in the end of the line, assign the
|
||||
| oe < rb =
|
||||
-- if the operator is in the end of the line, assign the
|
||||
-- score 1.
|
||||
|
||||
if oe < rb
|
||||
then 1
|
||||
else 2 -- otherwise, assign a high score.
|
||||
1
|
||||
| otherwise =
|
||||
2 -- otherwise, assign a high score.
|
||||
return $ (opName, s) : score r
|
||||
avgScores :: [(RdrName, Double)] -> [(RdrName, Double)]
|
||||
avgScores =
|
||||
|
@ -4,7 +4,7 @@ import Ormolu.Parser.Pragma
|
||||
import Test.Hspec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
spec =
|
||||
describe "parsePragma" $ do
|
||||
stdTest "{-# LANGUAGE Foo #-}" (Just (PragmaLanguage ["Foo"]))
|
||||
stdTest "{-# language Foo #-}" (Just (PragmaLanguage ["Foo"]))
|
||||
|
Loading…
Reference in New Issue
Block a user