mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-07 21:15:19 +03:00
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