Implement new --command-log-read-strategy option

.github/workflows/ci.yaml

@@ -43,7 +43,7 @@ jobs:
       - name: Integration Tests
         run: cabal test ${{ matrix.ghc.proj-file }} integration
       - name: Functional Tests
-        run: cabal test ${{ matrix.ghc.proj-file }} functional
+        run: cabal test ${{ matrix.ghc.proj-file }} functional --test-options '--read-strategy all'
       - name: Benchmarks
         if: ${{ matrix.os == 'ubuntu-latest' }}
         id: bench

docker/alpine_amd64/Dockerfile

@@ -40,7 +40,7 @@ echo 'PATH=$PATH:$HOME/.ghcup/bin' >> $HOME/.bashrc
 . $HOME/.bashrc
 
 echo "*** Installing ghc ***"
-ghcup install ghc 9.6.4 --set
+ghcup install ghc 9.8.2 --set
 
 echo "*** Installing cabal ***"
 ghcup install cabal 3.10.3.0 --set

shrun.cabal

@@ -69,6 +69,7 @@ library
     Shrun.Configuration.Data.CommandLogging
     Shrun.Configuration.Data.CommandLogging.PollInterval
     Shrun.Configuration.Data.CommandLogging.ReadSize
+    Shrun.Configuration.Data.CommandLogging.ReadStrategy
     Shrun.Configuration.Data.CommonLogging
     Shrun.Configuration.Data.CommonLogging.KeyHideSwitch
     Shrun.Configuration.Data.ConfigPhase
@@ -251,15 +252,18 @@ test-suite functional
     Functional.Miscellaneous
     Functional.Notify
     Functional.Prelude
+    Functional.ReadStrategyTest
     Functional.TestArgs
 
   build-depends:
     , base
     , effects-fs
     , env-guard
     , fdo-notify
+    , optparse-applicative
     , shrun
     , shrun-verifier
+    , tagged                ^>=0.8.6
     , tasty
     , tasty-hunit
     , text

shrun.log

@@ -0,0 +1,4 @@
+[2024-06-01 08:57:15][Command][cabal test f...] Starting...
+[2024-06-01 08:57:16][Command][cabal test f...] Build profile: -w ghc-9.8.2 -O2
+[2024-06-01 08:57:16][Command][cabal test f...] In order, the following will be built (use -v for more details):
+[2024-06-01 08:57:16][Command][cabal test f...]  - shrun-0.9 (test:functional) (file /home/tommy/Dev/tommy/github/shrun/dist-newstyle/build/x86_64-linux/ghc-9.8.2/shrun-0.9/opt/cache/build changed)

src/Shrun/Configuration/Args/Parsing/CommandLogging.hs

@@ -14,13 +14,16 @@ import Shrun.Configuration.Data.CommandLogging
       ( MkCommandLoggingP,
         pollInterval,
         readSize,
+        readStrategy,
         reportReadErrors
       ),
   )
 import Shrun.Configuration.Data.CommandLogging.PollInterval (PollInterval)
 import Shrun.Configuration.Data.CommandLogging.PollInterval qualified as PollInterval
 import Shrun.Configuration.Data.CommandLogging.ReadSize (ReadSize)
 import Shrun.Configuration.Data.CommandLogging.ReadSize qualified as ReadSize
+import Shrun.Configuration.Data.CommandLogging.ReadStrategy (ReadStrategy)
+import Shrun.Configuration.Data.CommandLogging.ReadStrategy qualified as ReadStrategy
 import Shrun.Configuration.Data.WithDisabled (WithDisabled)
 import Shrun.Configuration.Default (Default (def))
 import Shrun.Prelude
@@ -29,12 +32,14 @@ commandLoggingParser :: Parser CommandLoggingArgs
 commandLoggingParser = do
   pollInterval <- pollIntervalParser
   readSize <- readSizeParser
+  readStrategy <- readStrategyParser
   reportReadErrors <- reportReadErrorsParser
 
   pure
     $ MkCommandLoggingP
       { pollInterval,
         readSize,
+        readStrategy,
         reportReadErrors
       }
 
@@ -94,6 +99,26 @@ readSizeParser = Utils.withDisabledParser mainParser "command-log-read-size"
           "broken across lines. The default is '16 kb'."
         ]
 
+readStrategyParser :: Parser (WithDisabled ReadStrategy)
+readStrategyParser = Utils.withDisabledParser mainParser "command-log-read-strategy"
+  where
+    mainParser =
+      OA.optional
+        $ OA.option (ReadStrategy.parseReadStrategy OA.str)
+        $ mconcat
+          [ OA.long "command-log-read-strategy",
+            Utils.mkHelp helpTxt,
+            OA.metavar ReadStrategy.readStrategyStr
+          ]
+    helpTxt =
+      mconcat
+        [ "Determines how we read command logs. The default, block, is ",
+          "simpler, but can cut split logs in some circumstances. The ",
+          "block-buffer-line strategy attempts to only log entire lines at ",
+          "a time, for the purposes of nicer output. The latter is ",
+          "experimental and subject to change."
+        ]
+
 reportReadErrorsParser :: Parser (WithDisabled ())
 reportReadErrorsParser =
   Utils.withDisabledParserOpts

src/Shrun/Configuration/Data/CommandLogging.hs

@@ -20,6 +20,7 @@ where
 
 import Shrun.Configuration.Data.CommandLogging.PollInterval (PollInterval)
 import Shrun.Configuration.Data.CommandLogging.ReadSize (ReadSize)
+import Shrun.Configuration.Data.CommandLogging.ReadStrategy (ReadStrategy)
 import Shrun.Configuration.Data.ConfigPhase
   ( ConfigPhase
       ( ConfigPhaseArgs,
@@ -71,6 +72,8 @@ data CommandLoggingP p = MkCommandLoggingP
     -- | Determines the max log size we read from commands in one go.
     -- Note this is not on commandLogging or fileLogging since it affects both.
     readSize :: ConfigPhaseF p ReadSize,
+    -- | Reading strategy.
+    readStrategy :: ConfigPhaseF p ReadStrategy,
     -- | Determines if we should log read errors.
     reportReadErrors :: SwitchF p ReportReadErrorsSwitch
   }
@@ -85,13 +88,15 @@ instance
          ( MkCommandLoggingP
              _pollInterval
              _readSize
+             _readStrategy
              _reportReadErrors
            ) ->
           fmap
             ( \pollInterval' ->
                 MkCommandLoggingP
                   pollInterval'
                   _readSize
+                  _readStrategy
                   _reportReadErrors
             )
             (f _pollInterval)
@@ -107,18 +112,44 @@ instance
          ( MkCommandLoggingP
              _pollInterval
              _readSize
+             _readStrategy
              _reportReadErrors
            ) ->
           fmap
             ( \readSize' ->
                 MkCommandLoggingP
                   _pollInterval
                   readSize'
+                  _readStrategy
                   _reportReadErrors
             )
             (f _readSize)
   {-# INLINE labelOptic #-}
 
+instance
+  (k ~ A_Lens, a ~ ConfigPhaseF p ReadStrategy, b ~ ConfigPhaseF p ReadStrategy) =>
+  LabelOptic "readStrategy" k (CommandLoggingP p) (CommandLoggingP p) a b
+  where
+  labelOptic =
+    lensVL
+      $ \f
+         ( MkCommandLoggingP
+             _pollInterval
+             _readSize
+             _readStrategy
+             _reportReadErrors
+           ) ->
+          fmap
+            ( \readStrategy' ->
+                MkCommandLoggingP
+                  _pollInterval
+                  _readSize
+                  readStrategy'
+                  _reportReadErrors
+            )
+            (f _readStrategy)
+  {-# INLINE labelOptic #-}
+
 instance
   (k ~ A_Lens, a ~ SwitchF p ReportReadErrorsSwitch, b ~ SwitchF p ReportReadErrorsSwitch) =>
   LabelOptic "reportReadErrors" k (CommandLoggingP p) (CommandLoggingP p) a b
@@ -129,12 +160,14 @@ instance
          ( MkCommandLoggingP
              _pollInterval
              _readSize
+             _readStrategy
              _reportReadErrors
            ) ->
           fmap
             ( MkCommandLoggingP
                 _pollInterval
                 _readSize
+                _readStrategy
             )
             (f _reportReadErrors)
   {-# INLINE labelOptic #-}
@@ -161,6 +194,7 @@ deriving stock instance Show (CommandLoggingP ConfigPhaseMerged)
 
 instance
   ( Default (ConfigPhaseF p PollInterval),
+    Default (ConfigPhaseF p ReadStrategy),
     Default (ConfigPhaseF p ReadSize),
     Default (SwitchF p ReportReadErrorsSwitch)
   ) =>
@@ -169,6 +203,7 @@ instance
   def =
     MkCommandLoggingP
       { pollInterval = def,
+        readStrategy = def,
         readSize = def,
         reportReadErrors = def
       }
@@ -182,6 +217,8 @@ mergeCommandLogging args mToml =
   MkCommandLoggingP
     { pollInterval =
         (args ^. #pollInterval) <>?. (toml ^. #pollInterval),
+      readStrategy =
+        (args ^. #readStrategy) <>?. (toml ^. #readStrategy),
       readSize =
         (args ^. #readSize) <>?. (toml ^. #readSize),
       reportReadErrors =
@@ -203,6 +240,7 @@ instance DecodeTOML CommandLoggingToml where
     MkCommandLoggingP
       <$> decodePollInterval
       <*> decodeReadSize
+      <*> decodeReadStrategy
       <*> decodeReportReadErrors
 
 decodePollInterval :: Decoder (Maybe PollInterval)
@@ -211,6 +249,9 @@ decodePollInterval = getFieldOptWith tomlDecoder "poll-interval"
 decodeReadSize :: Decoder (Maybe ReadSize)
 decodeReadSize = getFieldOptWith tomlDecoder "read-size"
 
+decodeReadStrategy :: Decoder (Maybe ReadStrategy)
+decodeReadStrategy = getFieldOptWith tomlDecoder "read-strategy"
+
 decodeReportReadErrors :: Decoder (Maybe Bool)
 decodeReportReadErrors = getFieldOptWith tomlDecoder "report-read-errors"
 
@@ -219,6 +260,7 @@ toEnv :: CommandLoggingMerged -> CommandLoggingEnv
 toEnv merged =
   MkCommandLoggingP
     { pollInterval = merged ^. #pollInterval,
+      readStrategy = merged ^. #readStrategy,
       readSize = merged ^. #readSize,
       reportReadErrors = merged ^. #reportReadErrors
     }
@@ -227,6 +269,7 @@ defaultToml :: CommandLoggingToml
 defaultToml =
   MkCommandLoggingP
     { pollInterval = Nothing,
+      readStrategy = Nothing,
       readSize = Nothing,
       reportReadErrors = Nothing
     }
@@ -235,6 +278,7 @@ defaultMerged :: CommandLoggingMerged
 defaultMerged =
   MkCommandLoggingP
     { pollInterval = def,
+      readStrategy = def,
       readSize = def,
       reportReadErrors = def
     }

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

@@ -0,0 +1,48 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Shrun.Configuration.Data.CommandLogging.ReadStrategy
+  ( ReadStrategy (..),
+    parseReadStrategy,
+    readStrategyStr,
+  )
+where
+
+import Data.String (IsString)
+import Shrun.Configuration.Default (Default (def))
+import Shrun.Prelude
+
+-- | Different read strategies for simplicity vs. potential prettier
+-- formatting.
+data ReadStrategy
+  = -- | Default strategy. Reads N bytes at a time.
+    ReadBlock
+  | -- | Reads N bytes at a time but attempts to distinguish "complete" (newline
+    -- terminated) vs. "partial" (anything else) reads. We do this to make
+    -- the file log output prettier.
+    ReadBlockBufferLine
+  deriving stock (Eq, Show)
+
+instance Default ReadStrategy where
+  def = ReadBlock
+
+instance DecodeTOML ReadStrategy where
+  tomlDecoder = parseReadStrategy tomlDecoder
+
+-- | Parses 'ReadStrategy'.
+parseReadStrategy :: (MonadFail m) => m Text -> m ReadStrategy
+parseReadStrategy getTxt =
+  getTxt >>= \case
+    "block" -> pure ReadBlock
+    "block-buffer-line" -> pure ReadBlockBufferLine
+    other ->
+      fail
+        $ mconcat
+          [ "Unrecognized read strategy: '",
+            unpack other,
+            "'. Expected one of ",
+            readStrategyStr
+          ]
+
+-- | Available 'ReadStrategy' strings.
+readStrategyStr :: (IsString a) => a
+readStrategyStr = "(block |block-buffer-line)"

src/Shrun/Configuration/Env.hs

@@ -95,7 +95,6 @@ withEnv onEnv = getMergedConfig >>= flip fromMergedConfig onEnv
 -- | Creates a 'MergedConfig' from CLI args and TOML config.
 getMergedConfig ::
   ( HasCallStack,
-    MonadDBus m,
     MonadFileReader m,
     MonadOptparse m,
     MonadPathReader m,

src/Shrun/Data/Text.hs

@@ -12,6 +12,7 @@ module Shrun.Data.Text
     toText,
 
     -- * Functions
+    length,
     concat,
     intercalate,
     reallyUnsafeMap,
@@ -20,7 +21,7 @@ where
 
 import Data.String (IsString (fromString))
 import Data.Text qualified as T
-import Shrun.Prelude
+import Shrun.Prelude hiding (length)
 
 -- | Text after it has had all lines separated into different texts. We
 -- introduce a newtype for clarity. The idea is that when we read arbitrary
@@ -99,3 +100,6 @@ intercalate (UnsafeUnlinedText d) =
 -- then this will silently succeed. This exists for performance.
 reallyUnsafeMap :: (Text -> Text) -> UnlinedText -> UnlinedText
 reallyUnsafeMap f (UnsafeUnlinedText t) = UnsafeUnlinedText (f t)
+
+length :: UnlinedText -> Int
+length (UnsafeUnlinedText t) = T.length t