dev: fix some partial head/tails, silence ghc 9.8's new warnings

Note the headErr/tailErr calls will print stack traces if they fail
(small ones: five lines, one of which is the useful location info),
which may or may not be best UX.

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

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

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

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
+  where
-        dupAccountNames = map (map snd) d
+    dupAccountNames = map (map snd) dupes
-        d = dupes' leafandfullnames
+    dupLeafs = case dupes of
-        dupes' = filter ((> 1) . length)
+      [] -> []
+      _  -> 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)
 

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]

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

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

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
+          ds@(d:_) -> Just $ d > last ds
-          _                  -> Nothing
+          []       -> 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,

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 _ _) =
-periodicReportSpan (PeriodicReport colspans _ _) = DateSpan (fmap Exact . spanStart $ head colspans) (fmap Exact . spanEnd $ last 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

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

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.

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.

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)

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
+  maybe
-    [] -> return [f]
+    (return $ NE.singleton f)
-    fs -> mapM (expandPathPreservingPrefix d) fs
+    (mapM (expandPathPreservingPrefix d))
+    $ NE.nonEmpty $ file_ opts
 
 expandPathPreservingPrefix :: FilePath -> PrefixedFilePath -> IO PrefixedFilePath
 expandPathPreservingPrefix d prefixedf = do

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)

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 = maybe "" readTitle $ tailMay s
-          | otherwise = readTitle $ tail s
 
 findDemo :: [Demo] -> String -> Maybe Demo
 findDemo ds s =

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

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

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

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
+  case changedfiles of
-   then do
+    []  -> return (j, False)
-     -- XXX not sure why we use cmdarg's verbosity here, but keep it for now
+    f:_ -> do
-     verbose <- liftIO isLoud
+      -- XXX not sure why we use cmdarg's verbosity here, but keep it for now
-     when (verbose || debugLevel >= 6) . liftIO $ printf "%s has changed, reloading\n" (head changedfiles)
+      verbose <- liftIO isLoud
-     newj <- journalReload opts
+      when (verbose || debugLevel >= 6) . liftIO $ printf "%s has changed, reloading\n" f
-     return (newj, True)
+      newj <- journalReload opts
-   else
+      return (newj, True)
-     return (j, False)
 
 -- | 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

stack.yaml

@@ -20,10 +20,8 @@ nix:
   pure: false
   packages: [perl gmp ncurses zlib]
 
-ghc-options:
+# ghc-options:
-  # XXX silence 9.8's new partial warnings for now
+#   "$locals": -Wno-x-partial
-  "$locals": -Wno-x-partial
-
 #   "$locals": -fplugin Debug.Breakpoint
 
 # # for precise profiling, per https://www.tweag.io/posts/2020-01-30-haskell-profiling.html:

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'