Add INLINEABLE annotations

It turns out, these _appear_ to make a (modest) difference. In general,
the INLINEABLE benchmarks use slightly less memory (file logging is
the most significant, at 10% less allocated), and the benchmarks are
_generally_ faster (though some are slightly slower).

Might as well add these in. Our (extremely blunt) strategy is to
add INLINEABLE to any function involving polymorphic monad m, to
prevent polymorphic binds from blocking optimizations.

benchmarks/baseline_9.8.2.csv

@@ -1,7 +1,7 @@
 Name,Mean (ps),2*Stdev (ps),Allocated,Copied,Peak Memory
-All.Basic Logging.10_000,32054981100,2719280254,197767499,1491201,15728640
-All.Basic Logging.100_000,284949455400,3088076064,1921481603,12566747,22020096
-All.Command Logging.10_000,8675987087,358680480,7701613,170721,22020096
-All.Command Logging.100_000,818098265200,26302296974,427536247,2438572,22020096
-All.File Logging.10_000,28730622578,1775853462,20914526,638780,22020096
-All.File Logging.100_000,5507945763000,212603894328,2001917452,23482169,22020096
+All.Basic Logging.10_000,13994919850,788201886,164620558,1226940,14680064
+All.Basic Logging.100_000,134352162600,3092666264,1642240890,10696009,23068672
+All.Command Logging.10_000,10629656550,664104250,25934036,1142611,23068672
+All.Command Logging.100_000,141102413675,9240202760,290511672,12695602,23068672
+All.File Logging.10_000,67230350850,4015181822,114474577,6010048,23068672
+All.File Logging.100_000,1063772303400,41051284184,1801811732,93045236,23068672

src/Shrun.hs

@@ -132,6 +132,7 @@ shrun = displayRegions $ do
         hFlush h
       where
         MkFileLogOpened h fileQueue = fileLogging ^. #file
+    {-# INLINEABLE runWithFileLogging #-}
 
     runCommands :: (HasCallStack) => m ()
     runCommands = do
@@ -141,6 +142,8 @@ shrun = displayRegions $ do
 
       (totalTime, result) <- withTiming $ tryAny actionsWithTimer
       printFinalResult totalTime result
+    {-# INLINEABLE runCommands #-}
+{-# INLINEABLE shrun #-}
 
 runCommand ::
   forall m env.
@@ -200,6 +203,7 @@ runCommand cmd = do
     Just NotifyAll -> Notify.sendNotif (formattedCmd <> " Finished") timeMsg urgency
     Just NotifyCommand -> Notify.sendNotif (formattedCmd <> " Finished") timeMsg urgency
     _ -> pure ()
+{-# INLINEABLE runCommand #-}
 
 printFinalResult ::
   forall m env e b.
@@ -264,6 +268,7 @@ printFinalResult totalTime result = withRegion Linear $ \r -> do
     _ -> pure ()
 
   Logging.putRegionLog r finalLog
+{-# INLINEABLE printFinalResult #-}
 
 counter ::
   ( HasAnyError env,
@@ -293,6 +298,7 @@ counter = do
       sleep 1
       elapsed <- atomicModifyIORef' timer $ \t -> (t + 1, t + 1)
       logCounter r elapsed
+{-# INLINEABLE counter #-}
 
 logCounter ::
   forall m env.
@@ -317,6 +323,7 @@ logCounter region elapsed = do
             mode = LogModeSet
           }
   Logging.regionLogToConsoleQueue region lg
+{-# INLINEABLE logCounter #-}
 
 keepRunning ::
   forall m env.
@@ -365,6 +372,7 @@ keepRunning region timer mto = do
           }
       pure False
     else pure True
+{-# INLINEABLE keepRunning #-}
 
 timedOut :: Natural -> Maybe Timeout -> Bool
 timedOut _ Nothing = False
@@ -382,6 +390,7 @@ pollQueueToConsole ::
 pollQueueToConsole queue = do
   -- NOTE: Same masking behavior as pollQueueToFile.
   forever $ atomicReadWrite queue printConsoleLog
+{-# INLINEABLE pollQueueToConsole #-}
 
 printConsoleLog ::
   ( HasCallStack,
@@ -391,6 +400,7 @@ printConsoleLog ::
   m ()
 printConsoleLog (LogNoRegion consoleLog) = logGlobal (consoleLog ^. #unConsoleLog)
 printConsoleLog (LogRegion m r consoleLog) = logRegion m r (consoleLog ^. #unConsoleLog)
+{-# INLINEABLE printConsoleLog #-}
 
 pollQueueToFile ::
   ( HasCallStack,
@@ -409,9 +419,11 @@ pollQueueToFile fileLogging = do
     atomicReadWrite queue (logFile h)
   where
     MkFileLogOpened h queue = fileLogging ^. #file
+{-# INLINEABLE pollQueueToFile #-}
 
 logFile :: (HasCallStack, MonadHandleWriter m) => Handle -> FileLog -> m ()
 logFile h = (\t -> hPutUtf8 h t *> hFlush h) . view #unFileLog
+{-# INLINEABLE logFile #-}
 
 -- | Reads from a queue and applies the function, if we receive a value.
 -- Atomic in the sense that if a read is successful, then we will apply the
@@ -428,3 +440,4 @@ atomicReadWrite ::
   m ()
 atomicReadWrite queue logAction =
   mask $ \restore -> restore (readTBQueueA queue) >>= void . logAction
+{-# INLINEABLE atomicReadWrite #-}

src/Shrun/Configuration.hs

@@ -73,3 +73,4 @@ mergeConfig args mToml = do
           }
   where
     cmdsText = args ^. #commands
+{-# INLINEABLE mergeConfig #-}

src/Shrun/Configuration/Data/CommandLogging.hs

@@ -77,6 +77,7 @@ parseBufferLength getNat = do
   case convertIntegral n of
     Left err -> fail err
     Right x -> pure $ MkBufferLength x
+{-# INLINEABLE parseBufferLength #-}
 
 newtype BufferTimeout = MkBufferTimeout Timeout
   deriving stock (Eq, Show)
@@ -102,6 +103,7 @@ parseBufferTimeout ::
   f BufferTimeout
 parseBufferTimeout getNat getTxt =
   MkBufferTimeout <$> Timeout.parseTimeout getNat getTxt
+{-# INLINEABLE parseBufferTimeout #-}
 
 -- | Switch for logging read errors
 data ReportReadErrorsSwitch

src/Shrun/Configuration/Data/CommandLogging/PollInterval.hs

@@ -28,6 +28,7 @@ instance DecodeTOML PollInterval where
 
 parsePollInterval :: (Functor m) => m Natural -> m PollInterval
 parsePollInterval getNat = MkPollInterval <$> getNat
+{-# INLINEABLE parsePollInterval #-}
 
 instance Default PollInterval where
   def = MkPollInterval 10_000

src/Shrun/Configuration/Data/CommandLogging/ReadSize.hs

@@ -119,3 +119,4 @@ parseReadSize getTxt = do
   case U.parseByteText byteTxt of
     Right b -> pure $ MkReadSize b
     Left err -> fail $ "Could not parse --command-log-read-size size: " <> unpack err
+{-# INLINEABLE parseReadSize #-}

src/Shrun/Configuration/Data/CommandLogging/ReadStrategy.hs

@@ -42,6 +42,7 @@ parseReadStrategy getTxt =
             "'. Expected one of ",
             readStrategyStr
           ]
+{-# INLINEABLE parseReadStrategy #-}
 
 -- | Available 'ReadStrategy' strings.
 readStrategyStr :: (IsString a) => a

src/Shrun/Configuration/Data/ConsoleLogging.hs

@@ -297,6 +297,7 @@ mergeConsoleLogging args mToml = do
     argsCommandLogging = args ^. #commandLogging $> True
 
     toml = fromMaybe def mToml
+{-# INLINEABLE mergeConsoleLogging #-}
 
 instance DecodeTOML ConsoleLoggingToml where
   tomlDecoder =

src/Shrun/Configuration/Data/ConsoleLogging/TimerFormat.hs

@@ -52,6 +52,7 @@ parseTimerFormat getTxt =
     "prose_compact" -> pure ProseCompact
     "prose_full" -> pure ProseFull
     bad -> fail $ "Unrecognized timer-format: " <> unpack bad
+{-# INLINEABLE parseTimerFormat #-}
 
 -- | Available 'TimerFormat' strings.
 timerFormatStr :: (IsString a) => a

src/Shrun/Configuration/Data/Core.hs

@@ -364,6 +364,7 @@ mergeCoreConfig args mToml = do
       }
   where
     toml = fromMaybe def mToml
+{-# INLINEABLE mergeCoreConfig #-}
 
 -- | Given a merged CoreConfig, constructs a ConfigEnv and calls the
 -- continuation.
@@ -402,6 +403,7 @@ withCoreEnv cmds merged onCoreConfigEnv = do
               notify
             }
      in onCoreConfigEnv coreConfigEnv
+{-# INLINEABLE withCoreEnv #-}
 
 instance
   ( Default (ConfigPhaseMaybeF p Text),

src/Shrun/Configuration/Data/Core/Timeout.hs

@@ -40,10 +40,12 @@ instance DecodeTOML Timeout where
 parseTimeout :: (Alternative f, MonadFail f) => f Natural -> f Text -> f Timeout
 parseTimeout getNat getTxt =
   (MkTimeout <$> getNat) <|> (getTxt >>= parseTimeoutStr)
+{-# INLINEABLE parseTimeout #-}
 
 parseTimeoutStr :: (MonadFail f) => Text -> f Timeout
 parseTimeoutStr txt = case RT.fromString str of
   Right n -> pure $ MkTimeout $ RT.toSeconds n
   Left err -> fail $ "Error reading time string: " <> err
   where
     str = unpack txt
+{-# INLINEABLE parseTimeoutStr #-}

src/Shrun/Configuration/Data/FileLogging.hs

@@ -543,6 +543,7 @@ mergeFileLogging args mToml = for mPath $ \path -> do
       (Without, Nothing) -> Nothing
       (With p, _) -> Just p
       (_, Just toml) -> Just $ toml ^. #file % #path
+{-# INLINEABLE mergeFileLogging #-}
 
 instance DecodeTOML FileLoggingToml where
   tomlDecoder =
@@ -594,6 +595,7 @@ withFileLoggingEnv mFileLogging onFileLoggingEnv = do
             }
 
   withMLogging mFileLogging (onFileLoggingEnv . mkEnv)
+{-# INLINEABLE withFileLoggingEnv #-}
 
 withMLogging ::
   forall m a.
@@ -640,6 +642,7 @@ withMLogging (Just fileLogging) onLogging = do
     $ removeFileIfExists fp
 
   pure result
+{-# INLINEABLE withMLogging #-}
 
 handleLogFileSize ::
   ( HasCallStack,
@@ -684,6 +687,7 @@ handleLogFileSize fileSizeMode fp = do
 
     toDouble :: Integer -> Double
     toDouble = fromInteger
+{-# INLINEABLE handleLogFileSize #-}
 
 ensureFileExists ::
   ( HasCallStack,
@@ -695,9 +699,11 @@ ensureFileExists ::
 ensureFileExists fp = do
   exists <- doesFileExist fp
   unless exists $ writeFileUtf8 fp ""
+{-# INLINEABLE ensureFileExists #-}
 
 getShrunXdgState :: (HasCallStack, MonadPathReader m) => m OsPath
 getShrunXdgState = getXdgState [osp|shrun|]
+{-# INLINEABLE getShrunXdgState #-}
 
 defaultToml :: FilePathDefault -> FileLoggingToml
 defaultToml path =

src/Shrun/Configuration/Data/FileLogging/FileMode.hs

@@ -22,6 +22,7 @@ parseFileMode getTxt =
     "append" -> pure FileModeAppend
     "write" -> pure FileModeWrite
     bad -> fail $ "Unrecognized file-mode: " <> unpack bad
+{-# INLINEABLE parseFileMode #-}
 
 instance Default FileMode where
   def = FileModeWrite

src/Shrun/Configuration/Data/FileLogging/FilePathDefault.hs

@@ -24,3 +24,4 @@ parseFilePathDefault getTxt =
     "default" -> pure FPDefault
     "" -> fail "Empty path given for --file-log"
     other -> FPManual <$> FsUtils.encodeFpToOsFail (T.unpack other)
+{-# INLINEABLE parseFilePathDefault #-}

src/Shrun/Configuration/Data/FileLogging/FileSizeMode.hs

@@ -49,6 +49,7 @@ parseFileSizeMode getTxt = do
       case U.parseByteText byteTxt of
         Right b -> pure $ cons b
         Left err -> fail $ "Could not parse --file-log-size-mode size: " <> unpack err
+{-# INLINEABLE parseFileSizeMode #-}
 
 instance Default FileSizeMode where
   def = FileSizeModeWarn $ convert (Proxy @B) defBytes

src/Shrun/Configuration/Data/Notify.hs

@@ -208,6 +208,8 @@ toEnv notifyMerged = case systemMerged of
 
 #endif
 
+{-# INLINEABLE toEnv #-}
+
 mkNotify :: NotifyMerged -> NotifySystemEnv -> NotifyEnv
 mkNotify notifyToml systemP2 =
   MkNotifyP

src/Shrun/Configuration/Data/Truncation.hs

@@ -56,6 +56,7 @@ parseTruncation getNat = do
   case convertIntegral n of
     Left err -> fail err
     Right x -> pure $ MkTruncation x
+{-# INLINEABLE parseTruncation #-}
 
 -- | Determines command log line truncation behavior. We need a separate
 -- type from 'Truncation' to add a third option, to detect the terminal size
@@ -77,12 +78,14 @@ parseLineTruncation getNat getTxt =
   Undetected
     <$> parseTruncation getNat
     <|> parseDetected getTxt
+{-# INLINEABLE parseLineTruncation #-}
 
 parseDetected :: (MonadFail m) => m Text -> m LineTruncation
 parseDetected getTxt =
   getTxt >>= \case
     "detect" -> pure Detected
     other -> fail $ "Wanted other, received: " <> unpack other
+{-# INLINEABLE parseDetected #-}
 
 decodeCommandNameTrunc :: Decoder (Maybe (Truncation TruncCommandName))
 decodeCommandNameTrunc = getFieldOptWith tomlDecoder "command-name-trunc"
@@ -101,3 +104,4 @@ configToLineTrunc Disabled = pure Nothing
 configToLineTrunc Without = pure Nothing
 configToLineTrunc (With Detected) = Just . MkTruncation <$> getTerminalWidth
 configToLineTrunc (With (Undetected x)) = pure $ Just x
+{-# INLINEABLE configToLineTrunc #-}