diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index 75bf04bf1..f7d0f1ea2 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -311,7 +311,7 @@ elideAccountName width s elideparts :: Int -> [Text] -> [Text] -> [Text] elideparts w done ss | realLength (accountNameFromComponents $ done++ss) <= w = done++ss - | length ss > 1 = elideparts w (done++[textTakeWidth 2 $ head ss]) (tail ss) + | length ss > 1 = elideparts w (done++[textTakeWidth 2 $ headErr ss]) (tailErr ss) -- PARTIAL headErr, tailErr will succeed because length > 1 | otherwise = done++ss -- | Keep only the first n components of an account name, where n diff --git a/hledger-lib/Hledger/Data/Balancing.hs b/hledger-lib/Hledger/Data/Balancing.hs index 3bb7223f8..031a6e888 100644 --- a/hledger-lib/Hledger/Data/Balancing.hs +++ b/hledger-lib/Hledger/Data/Balancing.hs @@ -46,6 +46,7 @@ import qualified Data.Set as S import qualified Data.Text as T import Data.Time.Calendar (fromGregorian) import qualified Data.Map as M +import Safe (headErr) import Text.Printf (printf) import Hledger.Utils @@ -834,7 +835,7 @@ tests_Balancing = [posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = missingmixedamt}])) @?= Right (mixedAmount $ usd (-1)) ,testCase "conversion price is inferred" $ - (pamount . head . tpostings <$> + (pamount . headErr . tpostings <$> -- PARTIAL headErr succeeds because non-null postings list balanceTransaction defbalancingopts (Transaction 0 @@ -1026,7 +1027,7 @@ tests_Balancing = transaction (fromGregorian 2019 01 01) [ vpost' "a" missingamt (balassert (num 1)) ] ]} assertRight ej - case ej of Right j -> (jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1] + case ej of Right j -> (jtxns j & headErr & tpostings & headErr & pamount & amountsRaw) @?= [num 1] -- PARTIAL headErrs succeed because non-null txns & postings lists given Left _ -> error' "balance-assignment test: shouldn't happen" ,testCase "same-day-1" $ do diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index 05943ed1e..a7e90bc6f 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -105,7 +105,7 @@ import Data.Time.Calendar import Data.Time.Calendar.OrdinalDate (fromMondayStartWeek, mondayStartWeek) import Data.Time.Clock (UTCTime, diffUTCTime) import Data.Time.LocalTime (getZonedTime, localDay, zonedTimeToLocalTime) -import Safe (headMay, lastMay, maximumMay, minimumMay) +import Safe (headErr, headMay, lastMay, maximumMay, minimumMay) import Text.Megaparsec import Text.Megaparsec.Char (char, char', digitChar, string, string') import Text.Megaparsec.Char.Lexer (decimal, signed) @@ -900,7 +900,7 @@ weekday = do show wday <> " in " <> show (weekdays ++ weekdayabbrevs) weekdaysp :: TextParser m [Int] -weekdaysp = fmap head . group . sort <$> sepBy1 weekday (string' ",") +weekdaysp = fmap headErr . group . sort <$> sepBy1 weekday (string' ",") -- PARTIAL headErr will succeed because of sepBy1 -- | Parse a period expression, specifying a date span and optionally -- a reporting interval. Requires a reference "today" date for diff --git a/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs b/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs index c343acc81..b6f5e53bf 100755 --- a/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs +++ b/hledger-lib/Hledger/Data/JournalChecks/Uniqueleafnames.hs @@ -9,6 +9,7 @@ import Data.Function (on) import Data.List (groupBy, sortBy) import Data.Text (Text) import qualified Data.Text as T +import Safe (headErr) import Text.Printf (printf) import Hledger.Data.AccountName (accountLeafName) @@ -55,10 +56,14 @@ journalCheckUniqueleafnames j = do finddupes :: (Ord leaf, Eq full) => [(leaf, full)] -> [(leaf, [full])] finddupes leafandfullnames = zip dupLeafs dupAccountNames - where dupLeafs = map (fst . head) d - dupAccountNames = map (map snd) d - d = dupes' leafandfullnames - dupes' = filter ((> 1) . length) + where + dupAccountNames = map (map snd) dupes + dupLeafs = case dupes of + [] -> [] + _ -> map (fst . headErr) dupes -- PARTIAL headErr succeeds because of pattern + dupes = fnddupes leafandfullnames + where + fnddupes = filter ((> 1) . length) . groupBy ((==) `on` fst) . sortBy (compare `on` fst) diff --git a/hledger-lib/Hledger/Data/Ledger.hs b/hledger-lib/Hledger/Data/Ledger.hs index 6c0908156..a2682e1b8 100644 --- a/hledger-lib/Hledger/Data/Ledger.hs +++ b/hledger-lib/Hledger/Data/Ledger.hs @@ -80,7 +80,7 @@ ledgerRootAccount = headDef nullacct . laccounts -- | List a ledger's top-level accounts (the ones below the root), in tree order. ledgerTopAccounts :: Ledger -> [Account] -ledgerTopAccounts = asubs . head . laccounts +ledgerTopAccounts = asubs . headDef nullacct . laccounts -- | List a ledger's bottom-level (subaccount-less) accounts, in tree order. ledgerLeafAccounts :: Ledger -> [Account] diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 471df58ca..ac2bd2d7f 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -19,6 +19,7 @@ import qualified Data.Map as M import Data.Maybe (catMaybes) import qualified Data.Text as T import Data.Time.Calendar (Day) +import Safe (headDef) import Hledger.Data.Types import Hledger.Data.Amount import Hledger.Data.Dates @@ -127,7 +128,7 @@ tmPostingRuleToFunction verbosetags styles query querytxt tmpr = Just n -> \p -> -- Multiply the old posting's amount by the posting rule's multiplier. let - pramount = dbg6 "pramount" . head . amountsRaw $ pamount pr + pramount = dbg6 "pramount" . headDef nullamt . amountsRaw $ pamount pr matchedamount = dbg6 "matchedamount" . filterMixedAmount (symq `matchesAmount`) $ pamount p -- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928). -- Approach 1: convert to a unit price and increase the display precision slightly diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 0c86e6523..dce038f09 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -82,7 +82,7 @@ import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorian ) -import Safe (readDef, readMay, maximumByMay, maximumMay, minimumMay) +import Safe (headErr, readDef, readMay, maximumByMay, maximumMay, minimumMay) import Text.Megaparsec (between, noneOf, sepBy, try, (), notFollowedBy) import Text.Megaparsec.Char (char, string, string') @@ -494,14 +494,14 @@ simplifyQuery q0 = where simplify (And []) = Any simplify (And [q]) = simplify q - simplify (And qs) | same qs = simplify $ head qs + simplify (And qs) | same qs = simplify $ headErr qs -- PARTIAL headErr succeeds because pattern ensures non-null qs | None `elem` qs = None | all queryIsDate qs = Date $ spansIntersect $ mapMaybe queryTermDateSpan qs | otherwise = And $ map simplify dateqs ++ map simplify otherqs where (dateqs, otherqs) = partition queryIsDate $ filter (/=Any) qs simplify (Or []) = Any simplify (Or [q]) = simplifyQuery q - simplify (Or qs) | same qs = simplify $ head qs + simplify (Or qs) | same qs = simplify $ headErr qs -- PARTIAL headErr succeeds because pattern ensures non-null qs | Any `elem` qs = Any -- all queryIsDate qs = Date $ spansUnion $ mapMaybe queryTermDateSpan qs ? | otherwise = Or $ map simplify $ filter (/=None) qs diff --git a/hledger-lib/Hledger/Read/RulesReader.hs b/hledger-lib/Hledger/Read/RulesReader.hs index 4d0fa6098..1f4babc92 100644 --- a/hledger-lib/Hledger/Read/RulesReader.hs +++ b/hledger-lib/Hledger/Read/RulesReader.hs @@ -948,8 +948,8 @@ readJournalFromCsv merulesfile csvfile csvtext sep = do newestfirst = dbg6 "newest-first" $ isJust $ getDirective "newest-first" rules mdatalooksnewestfirst = dbg6 "mdatalooksnewestfirst" $ case nub $ map tdate txns of - ds | length ds > 1 -> Just $ head ds > last ds - _ -> Nothing + ds@(d:_) -> Just $ d > last ds + [] -> Nothing txns2 = dbg7 "txns2" $ (if newestfirst || mdatalooksnewestfirst == Just True then reverse else id) txns1 -- 3. Disordered dates: in case the CSV records were ordered by chaos, diff --git a/hledger-lib/Hledger/Reports/ReportTypes.hs b/hledger-lib/Hledger/Reports/ReportTypes.hs index 99c55ba84..e3007dd8f 100644 --- a/hledger-lib/Hledger/Reports/ReportTypes.hs +++ b/hledger-lib/Hledger/Reports/ReportTypes.hs @@ -143,8 +143,10 @@ zipWithPadded _ [] bs = bs -- | Figure out the overall date span of a PeriodicReport periodicReportSpan :: PeriodicReport a b -> DateSpan -periodicReportSpan (PeriodicReport [] _ _) = DateSpan Nothing Nothing -periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (fmap Exact . spanStart $ head colspans) (fmap Exact . spanEnd $ last colspans) +periodicReportSpan (PeriodicReport colspans _ _) = + case colspans of + [] -> DateSpan Nothing Nothing + s:_ -> DateSpan (Exact <$> spanStart s) (Exact <$> spanEnd (last colspans)) -- | Map a function over the row names. prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c diff --git a/hledger-lib/Hledger/Utils/Parse.hs b/hledger-lib/Hledger/Utils/Parse.hs index f05bcc320..946840354 100644 --- a/hledger-lib/Hledger/Utils/Parse.hs +++ b/hledger-lib/Hledger/Utils/Parse.hs @@ -51,6 +51,7 @@ where import Control.Monad (when) import qualified Data.Text as T +import Safe (tailErr) import Text.Megaparsec import Text.Printf import Control.Monad.State.Strict (StateT, evalStateT) @@ -163,7 +164,7 @@ showParseError e = "parse error at " ++ show e showDateParseError :: (Show t, Show (Token t), Show e) => ParseErrorBundle t e -> String -showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tail $ lines $ show e) +showDateParseError e = printf "date parse error (%s)" (intercalate ", " $ tailErr $ lines $ show e) -- PARTIAL tailError won't be null because showing a parse error isNewline :: Char -> Bool isNewline '\n' = True diff --git a/hledger-lib/Hledger/Utils/String.hs b/hledger-lib/Hledger/Utils/String.hs index 65e378c61..601382e68 100644 --- a/hledger-lib/Hledger/Utils/String.hs +++ b/hledger-lib/Hledger/Utils/String.hs @@ -41,6 +41,7 @@ module Hledger.Utils.String ( import Data.Char (isSpace, toLower, toUpper) import Data.List (intercalate, dropWhileEnd) import qualified Data.Text as T +import Safe (headErr, tailErr) import Text.Megaparsec ((<|>), between, many, noneOf, sepBy) import Text.Megaparsec.Char (char) import Text.Printf (printf) @@ -203,12 +204,12 @@ unwords' = unwords . map quoteIfNeeded -- | Strip one matching pair of single or double quotes on the ends of a string. stripquotes :: String -> String -stripquotes s = if isSingleQuoted s || isDoubleQuoted s then init $ tail s else s +stripquotes s = if isSingleQuoted s || isDoubleQuoted s then init $ tailErr s else s -- PARTIAL tailErr won't fail because isDoubleQuoted -isSingleQuoted s@(_:_:_) = head s == '\'' && last s == '\'' +isSingleQuoted s@(_:_:_) = headErr s == '\'' && last s == '\'' -- PARTIAL headErr, last will succeed because of pattern isSingleQuoted _ = False -isDoubleQuoted s@(_:_:_) = head s == '"' && last s == '"' +isDoubleQuoted s@(_:_:_) = headErr s == '"' && last s == '"' -- PARTIAL headErr, last will succeed because of pattern isDoubleQuoted _ = False -- Functions below treat wide (eg CJK) characters as double-width. diff --git a/hledger-ui/Hledger/UI/Theme.hs b/hledger-ui/Hledger/UI/Theme.hs index 06883bd6c..fefd74dee 100644 --- a/hledger-ui/Hledger/UI/Theme.hs +++ b/hledger-ui/Hledger/UI/Theme.hs @@ -21,9 +21,10 @@ import qualified Data.Map as M import Data.Maybe import Graphics.Vty import Brick +import Safe (headErr) defaultTheme :: AttrMap -defaultTheme = fromMaybe (snd $ head themesList) $ getTheme "white" +defaultTheme = fromMaybe (snd $ headErr themesList) $ getTheme "white" -- PARTIAL headErr succeeds because themesList is non-null -- the theme named here should exist; -- otherwise it will take the first one from the list, -- which must be non-empty. diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index b77a938ae..b94aa8b6f 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -89,6 +89,7 @@ where import Control.Monad (when) import Data.List +import qualified Data.List.NonEmpty as NE import Safe import qualified System.Console.CmdArgs.Explicit as C import System.Environment @@ -261,7 +262,7 @@ main = do _ | cmd `elem` ["demo","help","test"] -> cmdaction opts journallesserror -- these commands should create the journal if missing _ | cmd `elem` ["add","import"] -> do - ensureJournalFileExists . head =<< journalFilePathFromOpts opts + ensureJournalFileExists . NE.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/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index d733794d3..9058fdbda 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -80,6 +80,7 @@ import Data.Char import Data.Default import Data.Either (fromRight, isRight) import Data.List.Extra (groupSortOn, intercalate, isInfixOf, nubSort) +import qualified Data.List.NonEmpty as NE (NonEmpty, fromList, head, nonEmpty, singleton) import Data.List.Split (splitOn) import Data.Maybe --import Data.String.Here @@ -534,7 +535,7 @@ rawOptsToCliOpts rawopts = do (`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] + let availablewidth = NE.head $ NE.fromList $ catMaybes [mcolumns, mtermwidth, Just defaultWidth] -- PARTIAL: fromList won't fail because non-null list return defcliopts { rawopts_ = rawopts ,command_ = stringopt "command" rawopts @@ -612,13 +613,14 @@ getHledgerCliOpts mode' = do -- Actually, returns one or more file paths. There will be more -- than one if multiple -f options were provided. -- File paths can have a READER: prefix naming a reader/data format. -journalFilePathFromOpts :: CliOpts -> IO [String] +journalFilePathFromOpts :: CliOpts -> IO (NE.NonEmpty String) journalFilePathFromOpts opts = do f <- defaultJournalPath d <- getCurrentDirectory - case file_ opts of - [] -> return [f] - fs -> mapM (expandPathPreservingPrefix d) fs + maybe + (return $ NE.singleton f) + (mapM (expandPathPreservingPrefix d)) + $ NE.nonEmpty $ file_ opts expandPathPreservingPrefix :: FilePath -> PrefixedFilePath -> IO PrefixedFilePath expandPathPreservingPrefix d prefixedf = do diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index c0d963d46..f9e3a3b12 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -57,6 +57,7 @@ import Data.List.Extra (nubSort) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar +import Safe (headErr) import String.ANSI import System.Environment (withArgs) import System.Console.CmdArgs.Explicit as C @@ -396,19 +397,19 @@ tests_Commands = testGroup "Commands" [ ,testCase "preserves \"virtual\" posting type" $ do j <- readJournal' "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" -- PARTIAL: - let p = head $ tpostings $ head $ jtxns j + let p = headErr $ tpostings $ headErr $ jtxns j -- PARTIAL headErrs succeed because txns & postings provided paccount p @?= "test:from" ptype p @?= VirtualPosting ] ,testCase "alias directive" $ do j <- readJournal' "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" -- PARTIAL: - let p = head $ tpostings $ head $ jtxns j + let p = headErr $ tpostings $ headErr $ jtxns j -- PARTIAL headErrs succeed because txns & postings provided paccount p @?= "equity:draw:personal:food" ,testCase "Y default year directive" $ do j <- readJournal' defaultyear_journal_txt -- PARTIAL: - tdate (head $ jtxns j) @?= fromGregorian 2009 1 1 + tdate (headErr $ jtxns j) @?= fromGregorian 2009 1 1 -- PARTIAL headErr succeeds because defaultyear_journal_txt has a txn ,testCase "ledgerAccountNames" $ (ledgerAccountNames ledger7) diff --git a/hledger/Hledger/Cli/Commands/Demo.hs b/hledger/Hledger/Cli/Commands/Demo.hs index 7ee9333cb..4ab935713 100644 --- a/hledger/Hledger/Cli/Commands/Demo.hs +++ b/hledger/Hledger/Cli/Commands/Demo.hs @@ -51,6 +51,7 @@ import Control.Applicative ((<|>)) import Data.ByteString as B (ByteString) import Data.Maybe import qualified Data.ByteString.Char8 as B +import Safe (tailMay) import System.IO.Temp (withSystemTempFile) import System.IO (hClose) import System.Console.CmdArgs.Explicit (flagReq) @@ -128,8 +129,7 @@ readDemo content = Demo title content where readTitle s | "\"title\":" `isPrefixOf` s = takeWhile (/='"') $ drop 1 $ lstrip $ drop 8 s - | null s = "" - | otherwise = readTitle $ tail s + | otherwise = maybe "" readTitle $ tailMay s findDemo :: [Demo] -> String -> Maybe Demo findDemo ds s = diff --git a/hledger/Hledger/Cli/Commands/Diff.hs b/hledger/Hledger/Cli/Commands/Diff.hs index 3d3212377..597ed8a54 100644 --- a/hledger/Hledger/Cli/Commands/Diff.hs +++ b/hledger/Hledger/Cli/Commands/Diff.hs @@ -20,6 +20,7 @@ import Data.Time (diffDays) import Data.Either (partitionEithers) import qualified Data.Text.IO as T import Lens.Micro (set) +import Safe (headDef) import System.Exit (exitFailure) import Hledger @@ -47,7 +48,7 @@ pptxn :: PostingWithPath -> Transaction pptxn = fromJust . ptransaction . ppposting ppamountqty :: PostingWithPath -> Quantity -ppamountqty = aquantity . head . amounts . pamount . ppposting +ppamountqty = aquantity . headDef nullamt . amounts . pamount . ppposting allPostingsWithPath :: Journal -> [PostingWithPath] allPostingsWithPath j = do diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index fc71fe155..0ec91c5a4 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -27,6 +27,7 @@ import Numeric.RootFinding import Data.Decimal import qualified Data.Text as T import qualified Data.Text.Lazy.IO as TL +import Safe (headDef, tailDef) import System.Console.CmdArgs.Explicit as CmdArgs import Text.Tabular.AsciiWide as Tab @@ -218,14 +219,14 @@ timeWeightedReturn styles showCashFlow prettyTables investmentsQuery trans mixed aggregateByDate datedAmounts = -- Aggregate all entries for a single day, assuming that intraday interest is negligible sort - $ map (\date_cash -> let (dates, cash) = unzip date_cash in (head dates, maSum cash)) + $ map (\datecashes -> let (dates, cash) = unzip datecashes in (headDef (error' "Roi.hs: datecashes was null, please report a bug") dates, maSum cash)) $ groupBy ((==) `on` fst) $ sortOn fst $ map (second maNegate) $ datedAmounts let units = - tail $ + tailDef (error' "Roi.hs units was null, please report a bug") $ scanl (\(_, _, unitCost, unitBalance) (date, amt) -> let valueOnDate = unMix $ mixedAmountValue end date $ total trans (And [investmentsQuery, Date (DateSpan Nothing (Just $ Exact date))]) diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 1ea2a1147..0f0f6be39 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -22,6 +22,7 @@ import Data.Time.Calendar (Day, addDays) import System.Console.CmdArgs.Explicit as C import Hledger.Read.CsvUtils (CSV, printCSV, printTSV) import Lucid as L hiding (value_) +import Safe (tailDef) import Text.Tabular.AsciiWide as Tab hiding (render) import Hledger @@ -261,7 +262,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor -- | Add a subreport title row and drop the heading row. subreportAsCsv ropts1 (subreporttitle, multibalreport, _) = padRow subreporttitle : - tail (multiBalanceReportAsCsv ropts1 multibalreport) + tailDef [] (multiBalanceReportAsCsv ropts1 multibalreport) padRow s = take numcols $ s : repeat "" where numcols diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 2cd69d1eb..b204d8f97 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -31,6 +31,7 @@ where import Control.Monad.Except (ExceptT) import Control.Monad.IO.Class (liftIO) import Data.List +import qualified Data.List.NonEmpty as NE (toList) import Data.Maybe import qualified Data.Text as T import qualified Data.Text.IO as T @@ -72,7 +73,7 @@ withJournalDo opts cmd = do -- it's stdin, or it doesn't exist and we are adding. We read it strictly -- to let the add command work. journalpaths <- journalFilePathFromOpts opts - j <- runExceptT $ journalTransform opts <$> readJournalFiles (inputopts_ opts) journalpaths + j <- runExceptT $ journalTransform opts <$> readJournalFiles (inputopts_ opts) (NE.toList journalpaths) either error' cmd j -- PARTIAL: -- | Apply some extra post-parse transformations to the journal, if enabled by options. @@ -145,15 +146,14 @@ journalReloadIfChanged opts _d j = do let maybeChangedFilename f = do newer <- journalFileIsNewer j f return $ if newer then Just f else Nothing changedfiles <- liftIO $ catMaybes <$> mapM maybeChangedFilename (journalFilePaths j) - if not $ null changedfiles - then do - -- XXX not sure why we use cmdarg's verbosity here, but keep it for now - verbose <- liftIO isLoud - when (verbose || debugLevel >= 6) . liftIO $ printf "%s has changed, reloading\n" (head changedfiles) - newj <- journalReload opts - return (newj, True) - else - return (j, False) + case changedfiles of + [] -> return (j, False) + f:_ -> do + -- XXX not sure why we use cmdarg's verbosity here, but keep it for now + verbose <- liftIO isLoud + when (verbose || debugLevel >= 6) . liftIO $ printf "%s has changed, reloading\n" f + newj <- journalReload opts + return (newj, True) -- | Re-read the journal file(s) specified by options, applying any -- transformations specified by options. Or return an error string. @@ -161,7 +161,7 @@ journalReloadIfChanged opts _d j = do journalReload :: CliOpts -> ExceptT String IO Journal journalReload opts = do journalpaths <- liftIO $ dbg6 "reloading files" <$> journalFilePathFromOpts opts - journalTransform opts <$> readJournalFiles (inputopts_ opts) journalpaths + journalTransform opts <$> readJournalFiles (inputopts_ opts) (NE.toList journalpaths) -- | Has the specified file changed since the journal was last read ? -- Typically this is one of the journal's journalFilePaths. These are diff --git a/stack.yaml b/stack.yaml index 84e3d6aab..73ea8e9ff 100644 --- a/stack.yaml +++ b/stack.yaml @@ -20,10 +20,8 @@ nix: pure: false packages: [perl gmp ncurses zlib] -ghc-options: - # XXX silence 9.8's new partial warnings for now - "$locals": -Wno-x-partial - +# ghc-options: +# "$locals": -Wno-x-partial # "$locals": -fplugin Debug.Breakpoint # # for precise profiling, per https://www.tweag.io/posts/2020-01-30-haskell-profiling.html: diff --git a/tools/generatejournal.hs b/tools/generatejournal.hs index 7fd6e59a7..f3dffab8f 100755 --- a/tools/generatejournal.hs +++ b/tools/generatejournal.hs @@ -19,6 +19,7 @@ import Data.List import Data.Time.Calendar import Data.Time.LocalTime import Numeric +import Safe (tailErr) import System.Environment import Text.Printf -- import Hledger.Utils.Debug @@ -35,7 +36,7 @@ main = do let comms = cycle ['A'..'Z'] let rates = [0.70, 0.71 .. 1.3] mapM_ (\(n,d,(a,b),c,p) -> putStr $ showtxn n d a b c p) $ take numtxns $ zip5 [1..] dates accts comms (drop 1 comms) - mapM_ (\(d,rate) -> putStr $ showmarketprice d rate) $ take numtxns $ zip dates (cycle $ rates ++ init (tail (reverse rates))) + mapM_ (\(d,rate) -> putStr $ showmarketprice d rate) $ take numtxns $ zip dates (cycle $ rates ++ init (tailErr (reverse rates))) -- PARTIAL tailErr succeeds because non-null rates list showtxn :: Int -> Day -> String -> String -> Char -> Char -> String showtxn txnno date acct1 acct2 comm pricecomm = @@ -79,7 +80,7 @@ sequences :: Show a => Int -> [a] -> [[a]] sequences n l = go l where go [] = [] - go l' = s : go (tail l') + go l' = s : go (tailErr l') -- PARTIAL tailErr succeeds because of pattern where s' = take n l' s | length s' == n = s'