From 392e5b7569f692f1cb98980b29aadaee0338c6c9 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Sat, 6 Nov 2021 21:05:10 +0000 Subject: [PATCH] Fix many HLint warnings --- .hlint.yaml | 50 +------ src-literatetests/Main.hs | 4 +- src/Language/Haskell/Brittany/Internal.hs | 18 +-- .../Haskell/Brittany/Internal/Backend.hs | 31 ++-- .../Haskell/Brittany/Internal/BackendUtils.hs | 8 +- .../Brittany/Internal/ExactPrintUtils.hs | 18 +-- .../Brittany/Internal/LayouterBasics.hs | 3 +- .../Brittany/Internal/Layouters/DataDecl.hs | 10 +- .../Brittany/Internal/Layouters/Decl.hs | 8 +- .../Brittany/Internal/Layouters/Expr.hs | 2 +- .../Haskell/Brittany/Internal/Layouters/IE.hs | 8 +- .../Brittany/Internal/Layouters/Type.hs | 2 +- .../Haskell/Brittany/Internal/Prelude.hs | 137 ++++++++---------- .../Brittany/Internal/Transformations/Alt.hs | 12 +- .../Haskell/Brittany/Internal/Types.hs | 7 +- src/Language/Haskell/Brittany/Main.hs | 16 +- 16 files changed, 134 insertions(+), 200 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 026d8f1..191512f 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -5,56 +5,12 @@ # This file contains a template configuration file, which is typically # placed as .hlint.yaml in the root of your project -# Specify additional command line arguments - -- arguments: - [ "--cross" - , "--threads=0" - ] - -- ignore: {name: "Use camelCase"} -- ignore: {name: "Redundant as"} -- ignore: {name: "Redundant do"} -- ignore: {name: "Redundant return"} -- ignore: {name: "Redundant guard", whithin: "lrdrNameToTextAnn"} - - ignore: { name: 'Use :' } -- ignore: { name: Avoid lambda } - ignore: { name: Eta reduce } - ignore: { name: Move brackets to avoid $ } -- ignore: { name: Redundant <$> } - ignore: { name: Redundant $ } -- ignore: { name: Redundant bang pattern } - ignore: { name: Redundant bracket } -- ignore: { name: Redundant flip } -- ignore: { name: Redundant id } -- ignore: { name: Redundant if } -- ignore: { name: Redundant lambda } -- ignore: { name: Replace case with fromMaybe } -- ignore: { name: Use <=< } -- ignore: { name: Use <$> } -- ignore: { name: Use all } -- ignore: { name: Use and } -- ignore: { name: Use any } -- ignore: { name: Use concatMap } -- ignore: { name: Use const } -- ignore: { name: Use elem } -- ignore: { name: Use elemIndex } -- ignore: { name: Use fewer imports } -- ignore: { name: Use first } -- ignore: { name: Use fromLeft } -- ignore: { name: Use getContents } -- ignore: { name: Use if } -- ignore: { name: Use isNothing } -- ignore: { name: Use lambda-case } -- ignore: { name: Use mapM } -- ignore: { name: Use minimumBy } - ignore: { name: Use newtype instead of data } -- ignore: { name: Use record patterns } -- ignore: { name: Use second } -- ignore: { name: Use section } -- ignore: { name: Use sortOn } -- ignore: { name: Use sqrt } -- ignore: { name: Use tuple-section } -- ignore: { name: Use unless } -- ignore: { name: Use when } +- ignore: {name: "Redundant do"} +- ignore: {name: "Redundant return"} +- ignore: {name: "Use camelCase"} diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs index 5949a55..a1dc2af 100644 --- a/src-literatetests/Main.hs +++ b/src-literatetests/Main.hs @@ -94,8 +94,8 @@ main = do fmap groupProcessor $ groupBy grouperG $ filter (not . lineIsSpace) - $ fmap lineMapper - $ Text.lines input + $ lineMapper + <$> Text.lines input where groupProcessor :: [InputLine] -> (Text, [TestCase]) groupProcessor = \case diff --git a/src/Language/Haskell/Brittany/Internal.hs b/src/Language/Haskell/Brittany/Internal.hs index 41ac6b1..71e885b 100644 --- a/src/Language/Haskell/Brittany/Internal.hs +++ b/src/Language/Haskell/Brittany/Internal.hs @@ -60,7 +60,7 @@ import Language.Haskell.Brittany.Internal.Transformations.Par import Language.Haskell.Brittany.Internal.Transformations.Columns import Language.Haskell.Brittany.Internal.Transformations.Indent -import qualified GHC as GHC +import qualified GHC hiding ( parseModule ) import GHC.Parser.Annotation ( AnnKeywordId(..) ) import GHC ( GenLocated(L) @@ -130,7 +130,7 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do , \s -> "{" `isPrefixOf` dropWhile (== ' ') s , Butcher.addCmdPart (Butcher.varPartDesc "yaml-config-document") $ fmap (\lconf -> (mempty { _conf_layout = lconf }, "")) - . either (\_ -> Nothing) Just + . either (const Nothing) Just . Data.Yaml.decodeEither' . Data.ByteString.Char8.pack -- TODO: use some proper utf8 encoder instead? @@ -299,7 +299,7 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do pure $ if hackAroundIncludes then ( ews - , TextL.intercalate (TextL.pack "\n") $ fmap hackF $ TextL.splitOn + , TextL.intercalate (TextL.pack "\n") $ hackF <$> TextL.splitOn (TextL.pack "\n") outRaw ) @@ -311,11 +311,9 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do customErrOrder ErrorUnknownNode{} = 3 customErrOrder ErrorMacroConfig{} = 5 let hasErrors = - case - moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack - of - False -> 0 < maximum (-1 : fmap customErrOrder errsWarns) - True -> not $ null errsWarns + if moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack + then not $ null errsWarns + else 0 < maximum (-1 : fmap customErrOrder errsWarns) if hasErrors then throwE $ errsWarns else pure $ TextL.toStrict outputTextL @@ -402,7 +400,7 @@ parsePrintModuleTests conf filename input = do then return $ pPrintModule moduleConf perItemConf anns parsedModule else lift $ pPrintModuleAndCheck moduleConf perItemConf anns parsedModule - if null $ filter (not . isErrorUnusedComment) errs + if all isErrorUnusedComment errs then pure $ TextL.toStrict $ ltext else let @@ -533,7 +531,7 @@ getDeclBindingNames (L _ decl) = case decl of ppPreamble :: GenLocated SrcSpan HsModule -> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)] -ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _ _)) = do +ppPreamble lmod@(L loc m@HsModule{}) = do filteredAnns <- mAsk <&> \annMap -> Map.findWithDefault Map.empty (ExactPrint.mkAnnKey lmod) annMap -- Since ghc-exactprint adds annotations following (implicit) diff --git a/src/Language/Haskell/Brittany/Internal/Backend.hs b/src/Language/Haskell/Brittany/Internal/Backend.hs index b8241bf..142fe2f 100644 --- a/src/Language/Haskell/Brittany/Internal/Backend.hs +++ b/src/Language/Haskell/Brittany/Internal/Backend.hs @@ -11,10 +11,12 @@ module Language.Haskell.Brittany.Internal.Backend where import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.PreludeUtils import qualified Control.Monad.Trans.State.Strict as StateS +import qualified Data.Either as Either import qualified Data.Foldable as Foldable import qualified Data.IntMap.Lazy as IntMapL import qualified Data.IntMap.Strict as IntMapS import qualified Data.Map as Map +import qualified Data.Maybe as Maybe import qualified Data.Semigroup as Semigroup import qualified Data.Sequence as Seq import qualified Data.Set as Set @@ -171,7 +173,7 @@ layoutBriDocM = \case -- layoutResetSepSpace priors `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> - when (not $ comment == "(" || comment == ")") $ do + when (comment /= "(" && comment /= ")") $ do let commentLines = Text.lines $ Text.pack $ comment case comment of ('#':_) -> layoutMoveToCommentPos y (-999) (length commentLines) @@ -191,7 +193,7 @@ layoutBriDocM = \case let m = _lstate_comments state let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m let mToSpan = case mAnn of - Just anns | keyword == Nothing -> Just anns + Just anns | Maybe.isNothing keyword -> Just anns Just ((ExactPrint.Types.G kw1, _):annR) | keyword == Just kw1 -> Just annR _ -> Nothing @@ -212,7 +214,7 @@ layoutBriDocM = \case Nothing -> pure () Just comments -> do comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> - when (not $ comment == "(" || comment == ")") $ do + when (comment /= "(" && comment /= ")") $ do let commentLines = Text.lines $ Text.pack $ comment -- evil hack for CPP: case comment of @@ -229,7 +231,7 @@ layoutBriDocM = \case state <- mGet let m = _lstate_comments state pure $ Map.lookup annKey m - let mComments = nonEmpty =<< extractAllComments <$> annMay + let mComments = nonEmpty . extractAllComments =<< annMay let semiCount = length [ () | Just ann <- [ annMay ] , (ExactPrint.Types.AnnSemiSep, _) <- ExactPrint.Types.annsDP ann @@ -252,10 +254,10 @@ layoutBriDocM = \case case mComments of Nothing -> do when shouldAddSemicolonNewlines $ do - [1..semiCount] `forM_` \_ -> layoutWriteNewline + [1..semiCount] `forM_` const layoutWriteNewline Just comments -> do comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> - when (not $ comment == "(" || comment == ")") $ do + when (comment /= "(" && comment /= ")") $ do let commentLines = Text.lines $ Text.pack comment case comment of ('#':_) -> layoutMoveToCommentPos y (-999) 1 @@ -351,13 +353,13 @@ briDocIsMultiLine briDoc = rec briDoc BDBaseYPop bd -> rec bd BDIndentLevelPushCur bd -> rec bd BDIndentLevelPop bd -> rec bd - BDPar _ _ _ -> True + BDPar{} -> True BDAlt{} -> error "briDocIsMultiLine BDAlt" BDForceMultiline _ -> True BDForceSingleline bd -> rec bd BDForwardLineMode bd -> rec bd BDExternal _ _ _ t | [_] <- Text.lines t -> False - BDExternal _ _ _ _ -> True + BDExternal{} -> True BDPlain t | [_] <- Text.lines t -> False BDPlain _ -> True BDAnnotationPrior _ bd -> rec bd @@ -453,7 +455,7 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do -- tellDebugMess ("alignColsLines: at " ++ take 100 (show $ briDocToDoc $ head bridocs)) curX <- do state <- mGet - return $ either id (const 0) (_lstate_curYOrAddNewline state) + fromMaybe + return $ Either.fromLeft 0 (_lstate_curYOrAddNewline state) + fromMaybe 0 (_lstate_addSepSpace state) colMax <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack @@ -543,8 +545,8 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do -- personal preference to not break alignment for those, even if -- multiline. Really, this should be configurable.. (TODO) shouldBreakAfter :: BriDoc -> Bool - shouldBreakAfter bd = if alignBreak - then briDocIsMultiLine bd && case bd of + shouldBreakAfter bd = alignBreak && + briDocIsMultiLine bd && case bd of (BDCols ColTyOpPrefix _) -> False (BDCols ColPatternsFuncPrefix _) -> True (BDCols ColPatternsFuncInfix _) -> True @@ -565,7 +567,6 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do (BDCols ColTuples _) -> False (BDCols ColOpPrefix _) -> False _ -> True - else False mergeInfoBriDoc :: Bool @@ -644,9 +645,7 @@ processInfo maxSpace m = \case curX <- do state <- mGet -- tellDebugMess ("processInfo: " ++ show (_lstate_curYOrAddNewline state) ++ " - " ++ show ((_lstate_addSepSpace state))) - let spaceAdd = case _lstate_addSepSpace state of - Nothing -> 0 - Just i -> i + let spaceAdd = fromMaybe 0 $ _lstate_addSepSpace state return $ case _lstate_curYOrAddNewline state of Left i -> case _lstate_commentCol state of Nothing -> spaceAdd + i @@ -655,7 +654,7 @@ processInfo maxSpace m = \case let colMax = min colMaxConf (curX + maxSpace) -- tellDebugMess $ show curX let Just (ratio, maxCols1, _colss) = IntMapS.lookup ind m - let maxCols2 = list <&> \e -> case e of + let maxCols2 = list <&> \case (_, ColInfo i _ _) -> let Just (_, ms, _) = IntMapS.lookup i m in sum ms (l, _) -> l diff --git a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs index 8003fd8..6c34ea9 100644 --- a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs @@ -49,9 +49,7 @@ layoutWriteAppend t = do replicateM_ i $ mTell $ Text.Builder.fromString $ "\n" Left{} -> do return () - let spaces = case _lstate_addSepSpace state of - Just i -> i - Nothing -> 0 + let spaces = fromMaybe 0 $ _lstate_addSepSpace state mTell $ Text.Builder.fromText $ Text.pack (replicate spaces ' ') mTell $ Text.Builder.fromText $ t mModify $ \s -> s @@ -452,7 +450,7 @@ layoutWritePriorComments ast = do case mAnn of Nothing -> return () Just priors -> do - when (not $ null priors) $ layoutSetCommentCol + unless (null priors) $ layoutSetCommentCol priors `forM_` \( ExactPrint.Comment comment _ _ , ExactPrint.DP (x, y) ) -> do @@ -484,7 +482,7 @@ layoutWritePostComments ast = do case mAnn of Nothing -> return () Just posts -> do - when (not $ null posts) $ layoutSetCommentCol + unless (null posts) $ layoutSetCommentCol posts `forM_` \( ExactPrint.Comment comment _ _ , ExactPrint.DP (x, y) ) -> do diff --git a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs index f2c7806..46e1b6a 100644 --- a/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs @@ -27,7 +27,7 @@ import Data.HList.HList import GHC ( GenLocated(L) ) import qualified GHC.Driver.Session as GHC -import qualified GHC as GHC hiding (parseModule) +import qualified GHC hiding (parseModule) import qualified GHC.Types.SrcLoc as GHC import qualified GHC.Driver.CmdLine as GHC @@ -78,11 +78,11 @@ parseModuleWithCpp cpp opts args fp dynCheck = -- harmless. See commit 1b7576dcd1823e1c685a44927b1fcaade1319063. void $ lift $ GHC.setSessionDynFlags dflags1 dflags2 <- lift $ ExactPrint.initDynFlags fp - when (not $ null leftover) + unless (null leftover) $ ExceptT.throwE $ "when parsing ghc flags: leftover flags: " ++ show (leftover <&> \(L _ s) -> s) - when (not $ null warnings) + unless (null warnings) $ ExceptT.throwE $ "when parsing ghc flags: encountered warnings: " ++ show (warnings <&> warnExtractorCompat) @@ -110,11 +110,11 @@ parseModuleFromString args fp dynCheck str = dflags0 <- lift $ ExactPrint.initDynFlagsPure fp str (dflags1, leftover, warnings) <- lift $ GHC.parseDynamicFlagsCmdLine dflags0 (GHC.noLoc <$> args) - when (not $ null leftover) + unless (null leftover) $ ExceptT.throwE $ "when parsing ghc flags: leftover flags: " ++ show (leftover <&> \(L _ s) -> s) - when (not $ null warnings) + unless (null warnings) $ ExceptT.throwE $ "when parsing ghc flags: encountered warnings: " ++ show (warnings <&> warnExtractorCompat) @@ -135,7 +135,7 @@ commentAnnFixTransformGlob ast = do let nodes = SYB.everything (<>) extract ast let annsMap :: Map GHC.RealSrcLoc ExactPrint.AnnKey annsMap = Map.fromListWith - (flip const) + (const id) [ (GHC.realSrcSpanEnd span, annKey) | (GHC.RealSrcSpan span _, annKey) <- Foldable.toList nodes ] @@ -174,8 +174,8 @@ commentAnnFixTransformGlob ast = do in Map.insert annKey2 ann2' anns _ -> return True -- retain comment at current node. - priors' <- flip filterM priors processCom - follows' <- flip filterM follows $ processCom + priors' <- filterM processCom priors + follows' <- filterM processCom follows assocs' <- flip filterM assocs $ \case (ExactPrint.AnnComment com, dp) -> processCom (com, dp) _ -> return True @@ -286,7 +286,7 @@ foldedAnnKeys ast = SYB.everything ( \x -> maybe Set.empty Set.singleton - [ SYB.gmapQi 1 (\t -> ExactPrint.mkAnnKey $ L l t) x + [ SYB.gmapQi 1 (ExactPrint.mkAnnKey . L l) x | locTyCon == SYB.typeRepTyCon (SYB.typeOf x) , l :: SrcSpan <- SYB.gmapQi 0 SYB.cast x -- for some reason, ghc-8.8 has forgotten how to infer the type of l, diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index 1d8f48a..422c7be 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -36,11 +36,10 @@ import Language.Haskell.Brittany.Internal.Utils import Language.Haskell.Brittany.Internal.ExactPrintUtils import GHC.Types.Name.Reader ( RdrName(..) ) -import GHC ( Located, GenLocated(L), moduleNameString ) +import GHC ( Located, GenLocated(L), moduleName, moduleNameString ) import qualified GHC.Types.SrcLoc as GHC import GHC.Types.Name.Occurrence ( occNameString ) import GHC.Types.Name ( getOccString ) -import GHC ( moduleName ) import GHC.Parser.Annotation ( AnnKeywordId(..) ) import Data.Data diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs index 49f615a..acbe186 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs @@ -37,13 +37,13 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of docWrapNode ltycl $ do nameStr <- lrdrNameToTextAnn name consNameStr <- lrdrNameToTextAnn consName - tyVarLine <- fmap return $ createBndrDoc bndrs + tyVarLine <- return <$> createBndrDoc bndrs -- headDoc <- fmap return $ docSeq -- [ appSep $ docLitS "newtype") -- , appSep $ docLit nameStr -- , appSep tyVarLine -- ] - rhsDoc <- fmap return $ createDetailsDoc consNameStr details + rhsDoc <- return <$> createDetailsDoc consNameStr details createDerivingPar mDerivs $ docSeq [ appSep $ docLitS "newtype" , appSep $ docLit nameStr @@ -62,7 +62,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of docWrapNode ltycl $ do lhsContextDoc <- docSharedWrapper createContextDoc lhsContext nameStr <- lrdrNameToTextAnn name - tyVarLine <- fmap return $ createBndrDoc bndrs + tyVarLine <- return <$> createBndrDoc bndrs createDerivingPar mDerivs $ docSeq [ appSep $ docLitS "data" , lhsContextDoc @@ -79,14 +79,14 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of lhsContextDoc <- docSharedWrapper createContextDoc lhsContext nameStr <- lrdrNameToTextAnn name consNameStr <- lrdrNameToTextAnn consName - tyVarLine <- fmap return $ createBndrDoc bndrs + tyVarLine <- return <$> createBndrDoc bndrs forallDocMay <- case createForallDoc qvars of Nothing -> pure Nothing Just x -> Just . pure <$> x rhsContextDocMay <- case mRhsContext of Nothing -> pure Nothing Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt - rhsDoc <- fmap return $ createDetailsDoc consNameStr details + rhsDoc <- return <$> createDetailsDoc consNameStr details consDoc <- fmap pure $ docNonBottomSpacing $ case (forallDocMay, rhsContextDocMay) of diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index a2d4a00..a96ae47 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -162,7 +162,7 @@ layoutBind lbind@(L _ bind) = case bind of patDocs <- colsWrapPat =<< layoutPat pat clauseDocs <- layoutGrhs `mapM` grhss mWhereDocs <- layoutLocalBinds whereBinds - let mWhereArg = mWhereDocs <&> \d -> (mkAnnKey lbind, d) -- TODO: is this the right AnnKey? + let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lbind) -- TODO: is this the right AnnKey? binderDoc <- docLit $ Text.pack "=" hasComments <- hasAnyCommentsBelow lbind fmap Right $ docWrapNode lbind $ layoutPatternBindFinal Nothing @@ -206,7 +206,7 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of let unordered = [ BagBind b | b <- Data.Foldable.toList bindlrs ] ++ [ BagSig s | s <- sigs ] - ordered = sortBy (comparing $ ExactPrint.rs . bindOrSigtoSrcSpan) unordered + ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered docs <- docWrapNode lbinds $ join <$> ordered `forM` \case BagBind b -> either id return <$> layoutBind b BagSig s -> return <$> layoutSig s @@ -271,7 +271,7 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do $ (List.intersperse docSeparator $ docForceSingleline <$> ps) clauseDocs <- docWrapNodeRest lmatch $ layoutGrhs `mapM` grhss mWhereDocs <- layoutLocalBinds whereBinds - let mWhereArg = mWhereDocs <&> \d -> (mkAnnKey lmatch, d) + let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch) let alignmentToken = if null pats then Nothing else funId hasComments <- hasAnyCommentsBelow lmatch layoutPatternBindFinal alignmentToken @@ -331,7 +331,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha -- be shared between alternatives. wherePartMultiLine :: [ToBriDocM BriDocNumbered] <- case mWhereDocs of Nothing -> return $ [] - Just (annKeyWhere, [w]) -> fmap (pure . pure) $ docAlt + Just (annKeyWhere, [w]) -> pure . pure <$> docAlt [ docEnsureIndent BrIndentRegular $ docSeq [ docLit $ Text.pack "where" diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index b26687c..344454c 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -595,7 +595,7 @@ layoutExpr lexpr@(L _ expr) = do expDoc1 <- docSharedWrapper layoutExpr exp1 -- We jump through some ugly hoops here to ensure proper sharing. hasComments <- hasAnyCommentsBelow lexpr - mBindDocs <- fmap (fmap (fmap pure)) $ layoutLocalBinds binds + mBindDocs <- fmap (fmap pure) <$> layoutLocalBinds binds let ifIndentFreeElse :: a -> a -> a ifIndentFreeElse x y = diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs index 06aa0cf..39b7a49 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs @@ -55,7 +55,7 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of (layoutWrapped lie x) (layoutItems (splitFirstLast sortedNs)) where - nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName + nameDoc = docLit <=< lrdrNameToTextAnn . prepareName layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n] layoutItems FirstLastEmpty = docSetBaseY $ docLines [docSeq [docParenLSep, docNodeAnnKW lie (Just AnnOpenP) docEmpty], docParenR] @@ -208,9 +208,9 @@ lieToText = \case -- Need to check, and either put them at the top (for module) or do some -- other clever thing. L _ (IEModuleContents _ n) -> moduleNameToText n - L _ (IEGroup _ _ _ ) -> Text.pack "@IEGroup" - L _ (IEDoc _ _ ) -> Text.pack "@IEDoc" - L _ (IEDocNamed _ _ ) -> Text.pack "@IEDocNamed" + L _ IEGroup{} -> Text.pack "@IEGroup" + L _ IEDoc{} -> Text.pack "@IEDoc" + L _ IEDocNamed{} -> Text.pack "@IEDocNamed" where moduleNameToText :: Located ModuleName -> Text moduleNameToText (L _ name) = Text.pack ("@IEModuleContents" ++ moduleNameString name) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index f5efb7f..ed0dd26 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -645,7 +645,7 @@ getBinders x = case x of XHsForAllTelescope _ -> [] withoutSpecificity :: LHsTyVarBndr flag pass -> LHsTyVarBndr () pass -withoutSpecificity = fmap $ \ x -> case x of +withoutSpecificity = fmap $ \case UserTyVar a _ c -> UserTyVar a () c KindedTyVar a _ c d -> KindedTyVar a () c d XTyVarBndr a -> XTyVarBndr a diff --git a/src/Language/Haskell/Brittany/Internal/Prelude.hs b/src/Language/Haskell/Brittany/Internal/Prelude.hs index d09b788..87a0c0a 100644 --- a/src/Language/Haskell/Brittany/Internal/Prelude.hs +++ b/src/Language/Haskell/Brittany/Internal/Prelude.hs @@ -14,44 +14,22 @@ import GHC.Types.Name.Reader as E ( RdrName ) import Data.Functor.Identity as E ( Identity(..) ) import Control.Concurrent.Chan as E ( Chan ) -import Control.Concurrent.MVar as E ( MVar ) +import Control.Concurrent.MVar as E ( MVar + , newEmptyMVar + , newMVar + , putMVar + , readMVar + , takeMVar + , swapMVar + ) import Data.Int as E ( Int ) -import Data.Word as E ( Word ) +import Data.Word as E ( Word + , Word32 + ) import Prelude as E ( Integer , Float , Double - ) -import Control.Monad.ST as E ( ST ) -import Data.Bool as E ( Bool(..) ) -import Data.Char as E ( Char ) -import Data.Either as E ( Either(..) ) -import Data.IORef as E ( IORef ) -import Data.Maybe as E ( Maybe(..) ) -import Data.Monoid as E ( Endo(..) - , All(..) - , Any(..) - , Sum(..) - , Product(..) - , Alt(..) - ) -import Data.Ord as E ( Ordering(..) - , Down(..) - ) -import Data.Ratio as E ( Ratio - , Rational - ) -import Data.String as E ( String ) -import Data.Void as E ( Void ) -import System.IO as E ( IO ) -import Data.Proxy as E ( Proxy(..) ) -import Data.Sequence as E ( Seq ) - -import Data.Map as E ( Map ) -import Data.Set as E ( Set ) - -import Data.Text as E ( Text ) - -import Prelude as E ( undefined + , undefined , Eq (..) , Ord (..) , Enum (..) @@ -101,8 +79,58 @@ import Prelude as E ( undefined , Foldable , Traversable ) +import Control.Monad.ST as E ( ST ) +import Data.Bool as E ( Bool(..) ) +import Data.Char as E ( Char + , ord + , chr + ) +import Data.Either as E ( Either(..) + , either + ) +import Data.IORef as E ( IORef ) +import Data.Maybe as E ( Maybe(..) + , fromMaybe + , maybe + , listToMaybe + , maybeToList + , catMaybes + ) +import Data.Monoid as E ( Endo(..) + , All(..) + , Any(..) + , Sum(..) + , Product(..) + , Alt(..) + , mconcat + , Monoid (..) + ) +import Data.Ord as E ( Ordering(..) + , Down(..) + , comparing + ) +import Data.Ratio as E ( Ratio + , Rational + , (%) + , numerator + , denominator + ) +import Data.String as E ( String ) +import Data.Void as E ( Void ) +import System.IO as E ( IO + , hFlush + , stdout + ) +import Data.Proxy as E ( Proxy(..) ) +import Data.Sequence as E ( Seq ) + +import Data.Map as E ( Map ) +import Data.Set as E ( Set ) + +import Data.Text as E ( Text ) import Data.Function as E ( fix + , (&) ) import Data.Foldable as E ( foldl' @@ -153,31 +181,6 @@ import Data.List.NonEmpty as E ( NonEmpty(..) import Data.Tuple as E ( swap ) -import Data.Char as E ( ord - , chr - ) - -import Data.Maybe as E ( fromMaybe - , maybe - , listToMaybe - , maybeToList - , catMaybes - ) - -import Data.Word as E ( Word32 - ) - -import Data.Ord as E ( comparing - ) - -import Data.Either as E ( either - ) - -import Data.Ratio as E ( (%) - , numerator - , denominator - ) - import Text.Read as E ( readMaybe ) @@ -222,14 +225,6 @@ import Control.Concurrent as E ( threadDelay , forkOS ) -import Control.Concurrent.MVar as E ( newEmptyMVar - , newMVar - , putMVar - , readMVar - , takeMVar - , swapMVar - ) - import Control.Exception as E ( evaluate , bracket , assert @@ -249,19 +244,11 @@ import Debug.Trace as E ( trace import Foreign.ForeignPtr as E ( ForeignPtr ) -import Data.Monoid as E ( mconcat - , Monoid (..) - ) - import Data.Bifunctor as E ( bimap ) import Data.Functor as E ( ($>) ) -import Data.Function as E ( (&) ) import Data.Semigroup as E ( (<>) , Semigroup(..) ) -import System.IO as E ( hFlush - , stdout - ) import Data.Typeable as E ( Typeable ) diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs index 57461ca..ca79995 100644 --- a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs @@ -206,8 +206,7 @@ transformAlts = (zip spacings alts <&> \(vs, bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs)) ( hasSpace1 lconf acp vs && lineCheck vs, bd)) - id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x) - $ rec + rec $ fromMaybe (-- trace ("choosing last") $ List.last alts) $ Data.List.Extra.firstJust (\(_i::Int, (b,x)) -> @@ -233,8 +232,7 @@ transformAlts = && any lineCheck vs, bd)) let checkedOptions :: [Maybe (Int, BriDocNumbered)] = zip [1..] options <&> (\(i, (b,x)) -> [ (i, x) | b ]) - id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x) - $ rec + rec $ fromMaybe (-- trace ("choosing last") $ List.last alts) $ Data.List.Extra.firstJust (fmap snd) checkedOptions @@ -325,7 +323,7 @@ transformAlts = LineModeValid (VerticalSpacing i VerticalSpacingParNone _) -> do acp <- mGet mSet $ acp { _acp_line = _acp_line acp + i } - LineModeValid (VerticalSpacing _ _ _) -> error "processSpacingSimple par" + LineModeValid VerticalSpacing{} -> error "processSpacingSimple par" _ -> error "ghc exhaustive check is insufficient" hasSpace1 :: LayoutConfig -> AltCurPos -> LineModeValidity VerticalSpacing -> Bool hasSpace1 _ _ LineModeInvalid = False @@ -630,9 +628,9 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc BDFLit t -> return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False] BDFSeq list -> - fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list + fmap sumVs . mapM filterAndLimit <$> rec `mapM` list BDFCols _sig list -> - fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list + fmap sumVs . mapM filterAndLimit <$> rec `mapM` list BDFSeparator -> return $ [VerticalSpacing 1 VerticalSpacingParNone False] BDFAddBaseY indent bd -> do diff --git a/src/Language/Haskell/Brittany/Internal/Types.hs b/src/Language/Haskell/Brittany/Internal/Types.hs index 55c3746..76b7735 100644 --- a/src/Language/Haskell/Brittany/Internal/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Types.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} @@ -19,7 +18,7 @@ import Language.Haskell.Brittany.Internal.Prelude import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS import qualified Data.Data import qualified Data.Strict.Maybe as Strict -import qualified Safe as Safe +import qualified Safe import qualified Language.Haskell.GHC.ExactPrint as ExactPrint import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types @@ -423,7 +422,7 @@ briDocSeqSpine = \case BDIndentLevelPushCur bd -> briDocSeqSpine bd BDIndentLevelPop bd -> briDocSeqSpine bd BDPar _ind line indented -> briDocSeqSpine line `seq` briDocSeqSpine indented - BDAlt alts -> foldl' (\(!()) -> briDocSeqSpine) () alts + BDAlt alts -> foldl' (\() -> briDocSeqSpine) () alts BDForwardLineMode bd -> briDocSeqSpine bd BDExternal{} -> () BDPlain{} -> () @@ -431,7 +430,7 @@ briDocSeqSpine = \case BDAnnotationKW _annKey _kw bd -> briDocSeqSpine bd BDAnnotationRest _annKey bd -> briDocSeqSpine bd BDMoveToKWDP _annKey _kw _b bd -> briDocSeqSpine bd - BDLines lines -> foldl' (\(!()) -> briDocSeqSpine) () lines + BDLines lines -> foldl' (\() -> briDocSeqSpine) () lines BDEnsureIndent _ind bd -> briDocSeqSpine bd BDForceMultiline bd -> briDocSeqSpine bd BDForceSingleline bd -> briDocSeqSpine bd diff --git a/src/Language/Haskell/Brittany/Main.hs b/src/Language/Haskell/Brittany/Main.hs index 7df86d5..87ebe66 100644 --- a/src/Language/Haskell/Brittany/Main.hs +++ b/src/Language/Haskell/Brittany/Main.hs @@ -240,7 +240,7 @@ mainCmdParser helpDesc = do outputPaths if checkMode - then when (any (== Changes) (Data.Either.rights results)) + then when (Changes `elem` (Data.Either.rights results)) $ System.Exit.exitWith (System.Exit.ExitFailure 1) else case results of xs | all Data.Either.isRight xs -> pure () @@ -310,7 +310,7 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM = let hackTransform = if hackAroundIncludes && not exactprintOnly then List.intercalate "\n" . fmap hackF . lines' else id - inputString <- liftIO $ System.IO.hGetContents System.IO.stdin + inputString <- liftIO System.IO.getContents parseRes <- liftIO $ parseModuleFromString ghcOptions "stdin" cppCheckFunc @@ -376,8 +376,8 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM = let out = TextL.toStrict $ if hackAroundIncludes then TextL.intercalate (TextL.pack "\n") - $ fmap hackF - $ TextL.splitOn (TextL.pack "\n") outRaw + $ hackF + <$> TextL.splitOn (TextL.pack "\n") outRaw else outRaw out' <- if moduleConf & _conf_obfuscate & confUnpack then lift $ obfuscate out @@ -389,7 +389,7 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM = customErrOrder ErrorUnusedComment{} = 2 customErrOrder ErrorUnknownNode{} = -2 :: Int customErrOrder ErrorMacroConfig{} = 5 - when (not $ null errsWarns) $ do + unless (null errsWarns) $ do let groupedErrsWarns = Data.List.Extra.groupOn customErrOrder $ List.sortOn customErrOrder @@ -442,9 +442,9 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM = -- adds some override? let hasErrors = - case config & _conf_errorHandling & _econf_Werror & confUnpack of - False -> 0 < maximum (-1 : fmap customErrOrder errsWarns) - True -> not $ null errsWarns + if config & _conf_errorHandling & _econf_Werror & confUnpack + then not $ null errsWarns + else 0 < maximum (-1 : fmap customErrOrder errsWarns) outputOnErrs = config & _conf_errorHandling