From 8bf7c956971d1e20f18d0c388d3f3616d679f189 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Mon, 16 Aug 2021 14:49:40 +1000 Subject: [PATCH] cln: hlint: Clean up Functor related hlint warnings, and NOINLINE warning. --- .hlint.yaml | 8 -------- Shake.hs | 4 +--- bin/hledger-check-fancyassertions.hs | 2 +- hledger-lib/Hledger/Data/Dates.hs | 4 ++-- hledger-lib/Hledger/Read/CsvReader.hs | 7 +++---- hledger-lib/Hledger/Reports/BudgetReport.hs | 8 ++++---- hledger-lib/Hledger/Reports/ReportOptions.hs | 2 +- hledger-lib/Hledger/Utils.hs | 4 ++-- hledger-lib/Hledger/Utils/Debug.hs | 2 +- hledger-lib/Hledger/Utils/Parse.hs | 3 ++- hledger-lib/Text/Tabular/AsciiWide.hs | 8 ++++---- hledger-lib/other/ledger-parse/Ledger/Parser/Text.hs | 2 +- hledger-web/Hledger/Web/Main.hs | 2 +- hledger-web/Hledger/Web/WebOptions.hs | 3 +-- hledger/Hledger/Cli/CliOptions.hs | 2 +- hledger/Hledger/Cli/Commands/Balance.hs | 4 ++-- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 2 +- hledger/Hledger/Cli/Main.hs | 2 +- tools/dayssincetag.hs | 4 +--- tools/generatetimeclock.hs | 5 +---- 20 files changed, 31 insertions(+), 47 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index 3746cb1c3..713653cc5 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -9,24 +9,16 @@ # Warnings currently triggered by your code - ignore: {name: "Move brackets to avoid $"} - ignore: {name: "Redundant $"} -- ignore: {name: "Use <$>"} - ignore: {name: "Redundant bracket"} - ignore: {name: "Avoid reverse"} - ignore: {name: "Eta reduce"} -- ignore: {name: "Use =<<"} -- ignore: {name: "Use fmap"} -- ignore: {name: "Use <&>"} - ignore: {name: "Use sortOn"} - ignore: {name: "Use camelCase"} - ignore: {name: "Use list comprehension"} -- ignore: {name: "Redundant <$>"} - ignore: {name: "Use fewer imports"} - ignore: {name: "Use tuple-section"} - ignore: {name: "Use section"} - ignore: {name: "Avoid lambda using `infix`"} -- ignore: {name: "Functor law"} -- ignore: {name: "Missing NOINLINE pragma"} -- ignore: {name: "Use void"} - ignore: {name: "Use lambda-case"} diff --git a/Shake.hs b/Shake.hs index 1009b7ed1..a074de79c 100755 --- a/Shake.hs +++ b/Shake.hs @@ -795,9 +795,7 @@ maybeWriteFile f new = do -- | Get the current local date. getCurrentDay :: IO Day -getCurrentDay = do - t <- getZonedTime - return $ localDay (zonedTimeToLocalTime t) +getCurrentDay = localDay . zonedTimeToLocalTime <$> getZonedTime -- | Replace each occurrence of a regular expression by this string. replaceRe :: RE -> String -> String -> String diff --git a/bin/hledger-check-fancyassertions.hs b/bin/hledger-check-fancyassertions.hs index 57c6a8a6c..fb021a13a 100755 --- a/bin/hledger-check-fancyassertions.hs +++ b/bin/hledger-check-fancyassertions.hs @@ -450,7 +450,7 @@ predicatep = wrap predparensp <|> wrap predcomparep <|> wrap prednotp where wrap p = do a <- P.try p spaces - P.try (wrap $ do c <- lift connectp; spaces; a2 <- p; pure $ Connect a c a2) <|> pure a + P.try (wrap $ do c <- lift connectp; spaces; Connect a c <$> p) <|> pure a data Value = Account H.AccountName | AccountNested H.AccountName | Amount H.Amount deriving (Eq, Ord, Show) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index b4126b475..a480d7f15 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -163,7 +163,7 @@ spanYears (DateSpan ma mb) = mapMaybe (fmap (first3 . toGregorian)) [ma,mb] -- | Get overall span enclosing multiple sequentially ordered spans. spansSpan :: [DateSpan] -> DateSpan -spansSpan spans = DateSpan (maybe Nothing spanStart $ headMay spans) (maybe Nothing spanEnd $ lastMay spans) +spansSpan spans = DateSpan (spanStart =<< headMay spans) (spanEnd =<< lastMay spans) -- | Split a DateSpan into consecutive whole spans of the specified interval -- which fully encompass the original span (and a little more when necessary). @@ -747,7 +747,7 @@ smartdate = choice' -- XXX maybe obscures date errors ? see ledgerdate [ yyyymmdd, ymd , (\(m,d) -> SmartFromReference (Just m) d) <$> md - , (SmartFromReference Nothing <$> decimal) >>= failIfInvalidDate + , failIfInvalidDate . SmartFromReference Nothing =<< decimal , SmartMonth <$> (month <|> mon) , SmartRelative This Day <$ string' "today" , SmartRelative Last Day <$ string' "yesterday" diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index c0e763443..868a589c0 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -41,7 +41,7 @@ import Prelude () import "base-compat-batteries" Prelude.Compat hiding (fail) import Control.Applicative (liftA2) import Control.Exception (IOException, handle, throw) -import Control.Monad (liftM, unless, when) +import Control.Monad (unless, when) import Control.Monad.Except (ExceptT, throwError) import qualified Control.Monad.Fail as Fail import Control.Monad.IO.Class (MonadIO, liftIO) @@ -437,8 +437,7 @@ rulesp = do ,(conditionaltablep >>= modify' . addConditionalBlocks . reverse) "conditional table" ] eof - r <- get - return $ mkrules r + mkrules <$> get blankorcommentlinep :: CsvRulesParser () blankorcommentlinep = lift (dbgparse 8 "trying blankorcommentlinep") >> choiceInState [blanklinep, commentlinep] @@ -789,7 +788,7 @@ parseSeparator = specials . T.toLower parseCsv :: Char -> FilePath -> Text -> IO (Either String CSV) parseCsv separator filePath csvdata = case filePath of - "-" -> liftM (parseCassava separator "(stdin)") T.getContents + "-" -> parseCassava separator "(stdin)" <$> T.getContents _ -> return $ parseCassava separator filePath csvdata parseCassava :: Char -> FilePath -> Text -> Either String CSV diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 6812288fa..ccc59e2a2 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -344,11 +344,11 @@ budgetReportAsTable budgetAndPerc b = uncurry zip ( showmixed b - , fmap (fmap (wbFromText . T.pack . show . roundTo 0)) $ percbudget actual' b + , fmap (wbFromText . T.pack . show . roundTo 0) <$> percbudget actual' b ) full - | Just b <- mbudget = fmap Just $ budgetAndPerc b + | Just b <- mbudget = Just <$> budgetAndPerc b | otherwise = repeat Nothing paddisplaycell :: (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder @@ -433,8 +433,8 @@ budgetReportAsCsv | otherwise = joinNames . zipWith (:) cs -- add symbols and names . transpose -- each row becomes a list of Text quantities - . fmap (fmap wbToText . showMixedAmountLinesB oneLine{displayOrder=Just cs, displayMinWidth=Nothing}) - . fmap (fromMaybe nullmixedamt) + . fmap (fmap wbToText . showMixedAmountLinesB oneLine{displayOrder=Just cs, displayMinWidth=Nothing} + .fromMaybe nullmixedamt) $ all where cs = S.toList . foldl' S.union mempty . fmap maCommodities $ catMaybes all diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 7a39e61f1..c5a4b0d2d 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -703,7 +703,7 @@ instance Reportable Identity e where report a (Identity i) = Identity $ fromRight a i instance Reportable Maybe e where - report _ = join . fmap eitherToMaybe + report _ = (eitherToMaybe =<<) instance (e ~ a) => Reportable (Either a) e where report _ = join diff --git a/hledger-lib/Hledger/Utils.hs b/hledger-lib/Hledger/Utils.hs index b4d41840b..d4fca830b 100644 --- a/hledger-lib/Hledger/Utils.hs +++ b/hledger-lib/Hledger/Utils.hs @@ -36,7 +36,7 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c ) where -import Control.Monad (liftM, when) +import Control.Monad (when) import Data.FileEmbed (makeRelativeToProject, embedStringFile) import Data.List (foldl', foldl1') -- import Data.String.Here (hereFile) @@ -156,7 +156,7 @@ applyN n f | n < 1 = id -- Can raise an error. expandPath :: FilePath -> FilePath -> IO FilePath -- general type sig for use in reader parsers expandPath _ "-" = return "-" -expandPath curdir p = (if isRelative p then (curdir ) else id) `liftM` expandHomePath p +expandPath curdir p = (if isRelative p then (curdir ) else id) <$> expandHomePath p -- PARTIAL: -- | Expand user home path indicated by tilde prefix diff --git a/hledger-lib/Hledger/Utils/Debug.hs b/hledger-lib/Hledger/Utils/Debug.hs index c4f771afd..47f2b3cf1 100644 --- a/hledger-lib/Hledger/Utils/Debug.hs +++ b/hledger-lib/Hledger/Utils/Debug.hs @@ -151,7 +151,7 @@ traceWith f a = trace (f a) a -- command-line processing. When running with :main in GHCI, you must -- touch and reload this module to see the effect of a new --debug option. -- {-# OPTIONS_GHC -fno-cse #-} --- {-# NOINLINE debugLevel #-} +{-# NOINLINE debugLevel #-} -- Avoid using dbg* in this function (infinite loop). debugLevel :: Int debugLevel = case dropWhile (/="--debug") args of diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs index 5785765c0..00d59450f 100644 --- a/hledger-lib/Hledger/Utils/Parse.hs +++ b/hledger-lib/Hledger/Utils/Parse.hs @@ -37,6 +37,7 @@ where import Control.Monad.Except (ExceptT) import Control.Monad.State.Strict (StateT, evalStateT) import Data.Char +import Data.Functor (void) import Data.Functor.Identity (Identity(..)) import Data.List import Data.Text (Text) @@ -154,4 +155,4 @@ skipNonNewlineSpaces' = True <$ skipNonNewlineSpaces1 <|> pure False eolof :: TextParser m () -eolof = (newline >> return ()) <|> eof +eolof = void newline <|> eof diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs index 13fc0c2e5..0a268076a 100644 --- a/hledger-lib/Text/Tabular/AsciiWide.hs +++ b/hledger-lib/Text/Tabular/AsciiWide.hs @@ -108,17 +108,17 @@ renderTableByRowsB topts@TableOpts{prettyTable=pretty, tableBorders=borders} fc unlinesB . addBorders $ renderColumns topts sizes ch2 : bar VM DoubleLine -- +======================================+ - : renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders) + : renderRs (renderR <$> zipHeader [] cellContents rowHeaders) where renderR :: ([Cell], Cell) -> Builder renderR (cs,h) = renderColumns topts sizes $ Group DoubleLine [ Header h - , fmap fst $ zipHeader emptyCell cs colHeaders + , fst <$> zipHeader emptyCell cs colHeaders ] rows = unzip . fmap f $ zip (headerContents rh) cells - rowHeaders = fmap fst $ zipHeader emptyCell (fst rows) rh - colHeaders = fmap fst $ zipHeader emptyCell (fc $ headerContents ch) ch + rowHeaders = fst <$> zipHeader emptyCell (fst rows) rh + colHeaders = fst <$> zipHeader emptyCell (fc $ headerContents ch) ch cellContents = snd rows -- ch2 and cell2 include the row and column labels diff --git a/hledger-lib/other/ledger-parse/Ledger/Parser/Text.hs b/hledger-lib/other/ledger-parse/Ledger/Parser/Text.hs index 251385ff7..f06fb64ea 100644 --- a/hledger-lib/other/ledger-parse/Ledger/Parser/Text.hs +++ b/hledger-lib/other/ledger-parse/Ledger/Parser/Text.hs @@ -30,7 +30,7 @@ import Text.Trifecta.Delta infixl 4 <$!> (<$!>) :: TokenParsing m => (a -> b) -> m a -> m b -f <$!> ma = ($!) <$> pure f <*> ma +f <$!> ma = (f $!) <$> ma newtype RawJournal = RawJournal [RawEntity] deriving (Show, Eq) diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index f5b089ca6..6831d229d 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -60,7 +60,7 @@ hledgerWebMain = do -- "binary-filename" `inRawOpts` rawopts_ -> putStrLn (binaryfilename progname) | "test" `inRawOpts` rawopts_ -> do -- remove --test and --, leaving other args for hspec - filter (not . (`elem` ["--test","--"])) <$> getArgs >>= flip withArgs hledgerWebTest + (`withArgs` hledgerWebTest) . filter (`notElem` ["--test","--"]) =<< getArgs | otherwise -> withJournalDo copts (web wopts) -- | The hledger web command. diff --git a/hledger-web/Hledger/Web/WebOptions.hs b/hledger-web/Hledger/Web/WebOptions.hs index 43678ca87..5800b75a3 100644 --- a/hledger-web/Hledger/Web/WebOptions.hs +++ b/hledger-web/Hledger/Web/WebOptions.hs @@ -7,7 +7,6 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BC import Data.ByteString.UTF8 (fromString) import Data.CaseInsensitive (CI, mk) -import Control.Monad (join) import Data.Default (Default(def)) import Data.Maybe (fromMaybe) import qualified Data.Text as T @@ -156,7 +155,7 @@ rawOptsToWebOpts rawopts = b = maybe (defbaseurl h p) stripTrailingSlash $ maybestringopt "base-url" rawopts - caps' = join $ T.splitOn "," . T.pack <$> listofstringopt "capabilities" rawopts + caps' = T.splitOn "," . T.pack =<< listofstringopt "capabilities" rawopts caps = case traverse capabilityFromText caps' of Left e -> error' ("Unknown capability: " ++ T.unpack e) -- PARTIAL: Right [] -> [CapView, CapAdd] diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index dad23f3de..5c17a7cb7 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -467,7 +467,7 @@ rawOptsToCliOpts rawopts = do #ifdef mingw32_HOST_OS return Nothing #else - setupTermFromEnv >>= return . flip getCapability termColumns + (`getCapability` termColumns) <$> setupTermFromEnv -- XXX Throws a SetupTermError if the terminfo database could not be read, should catch #endif let availablewidth = head $ catMaybes [mcolumns, mtermwidth, Just defaultWidth] diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index fab672acc..676d97a07 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -452,7 +452,7 @@ balanceReportAsText' opts ((items, total)) = damts = showMixedAmountLinesB dopts amt lines = fmap render items totalline = render ("", "", 0, total) - sizes = fmap (fromMaybe 0 . maximumMay . map cellWidth) $ + sizes = fromMaybe 0 . maximumMay . map cellWidth <$> transpose ([totalline | not (no_total_ opts)] ++ lines) overline = Cell TopLeft . pure . wbFromText . flip T.replicate "-" . fromMaybe 0 $ headMay sizes @@ -524,7 +524,7 @@ multiBalanceReportAsCsv' opts@ReportOpts{..} ) : concatMap (fullRowAsTexts (accountNameDrop drop_ . prrFullName)) items where - fullRowAsTexts render row = fmap ((:) (render row)) $ multiBalanceRowAsCsvText opts row + fullRowAsTexts render row = (render row :) <$> multiBalanceRowAsCsvText opts row totalrows | no_total_ = mempty | otherwise = fullRowAsTexts (const "total") tr diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 4d5a28b22..de59d575a 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -302,7 +302,7 @@ compoundBalanceReportAsHtml ropts cbr = ++ [blankrow] totalrows | no_total_ ropts || length subreports == 1 = [] - | otherwise = multiBalanceReportHtmlFootRow ropts <$> (fmap ("Net:" :) $ multiBalanceRowAsCsvText ropts netrow) + | otherwise = multiBalanceReportHtmlFootRow ropts <$> (("Net:" :) <$> multiBalanceRowAsCsvText ropts netrow) in do style_ (T.unlines ["" ,"td { padding:0 0.5em; }" diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 1a94e1539..9bcfcc0de 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -179,7 +179,7 @@ main = do _ | cmd `elem` ["test","help"] -> cmdaction opts journallesserror -- these commands should create the journal if missing _ | cmd `elem` ["add","import"] -> do - (ensureJournalFileExists =<< (head <$> journalFilePathFromOpts opts)) + ensureJournalFileExists . head =<< journalFilePathFromOpts opts withJournalDo opts (cmdaction opts) -- other commands read the journal and should fail if it's missing _ -> withJournalDo opts (cmdaction opts) diff --git a/tools/dayssincetag.hs b/tools/dayssincetag.hs index 543396816..a97e4f384 100755 --- a/tools/dayssincetag.hs +++ b/tools/dayssincetag.hs @@ -18,6 +18,4 @@ main = do putStrLn $ show (diffDays today date) ++ " days since tag "++tag++":\n" putStr s -getCurrentDay = do - t <- getZonedTime - return $ localDay (zonedTimeToLocalTime t) +getCurrentDay = localDay . zonedTimeToLocalTime <$> getZonedTime diff --git a/tools/generatetimeclock.hs b/tools/generatetimeclock.hs index eab0d38d0..e198f0dd7 100644 --- a/tools/generatetimeclock.hs +++ b/tools/generatetimeclock.hs @@ -24,7 +24,4 @@ main = do showentry d = printf "i %s 09:00:00 dummy\no %s 17:00:00\n" (show d) (show d) -getCurrentDay = do - t <- getZonedTime - return $ localDay (zonedTimeToLocalTime t) - +getCurrentDay = localDay . zonedTimeToLocalTime <$> getZonedTime