cln: hlint: Clean up Functor related hlint warnings, and NOINLINE warning.
This commit is contained in:
		
							parent
							
								
									21e62ffcbd
								
							
						
					
					
						commit
						8bf7c95697
					
				| @ -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"} | ||||
| 
 | ||||
| 
 | ||||
|  | ||||
							
								
								
									
										4
									
								
								Shake.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								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 | ||||
|  | ||||
| @ -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) | ||||
|  | ||||
| @ -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" | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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) | ||||
|  | ||||
| @ -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. | ||||
|  | ||||
| @ -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] | ||||
|  | ||||
| @ -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] | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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; }" | ||||
|  | ||||
| @ -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) | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user