cln: hlint: Clean up Functor related hlint warnings, and NOINLINE warning.

This commit is contained in:
Stephen Morgan 2021-08-16 14:49:40 +10:00 committed by Simon Michael
parent 21e62ffcbd
commit 8bf7c95697
20 changed files with 31 additions and 47 deletions

View File

@ -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"}

View File

@ -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

View File

@ -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)

View File

@ -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"

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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.

View File

@ -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]

View File

@ -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]

View File

@ -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

View File

@ -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; }"

View File

@ -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)

View File

@ -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

View File

@ -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