Swap Log's Text for UnlinedText

src/Shrun.hs

@@ -9,7 +9,6 @@ where
 
 import DBus.Notify (UrgencyLevel (Critical, Normal))
 import Data.HashSet qualified as Set
-import Data.Text qualified as T
 import Effects.Concurrent.Async qualified as Async
 import Effects.Concurrent.Thread as X (microsleep, sleep)
 import Effects.Time (TimeSpec, withTiming)
@@ -177,7 +176,8 @@ runCommand cmd = do
         -- see NOTE: [Text Line Concatentation] for how we combine the
         -- multiple texts back into a single err.
         CommandFailure t (MkStderr errs) ->
-          (Critical, ": " <> ShrunText.toText errs, LevelError, t)
+          let errMsg = ShrunText.concat errs
+           in (Critical, ": " <> errMsg, LevelError, t)
         CommandSuccess t -> (Normal, "", LevelSuccess, t)
       timeMsg = TimerFormat.formatRelativeTime timerFormat timeElapsed <> msg'
 
@@ -225,7 +225,7 @@ printFinalResult totalTime result = withRegion Linear $ \r -> do
           mconcat
             [ "Encountered an exception. This is likely not an error in any ",
               "of the commands run but rather an error in Shrun itself: ",
-              displayExceptiont ex
+              ShrunText.fromTextReplace $ displayExceptiont ex
             ]
         fatalLog =
           MkLog
@@ -351,7 +351,10 @@ keepRunning region timer mto = do
           allCmdsSet = Set.fromList $ toList allCmds
           incompleteCmds = Set.difference allCmdsSet completedCommandsSet
           toTxtList acc cmd = LogFmt.displayCmd cmd keyHide : acc
-          unfinishedCmds = T.intercalate ", " $ foldl' toTxtList [] incompleteCmds
+
+          unfinishedCmds =
+            ShrunText.intercalate ", "
+              $ foldl' toTxtList [] incompleteCmds
 
       Logging.putRegionLog region
         $ MkLog

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

@@ -26,6 +26,7 @@ import Data.Time.Relative
   )
 import Data.Time.Relative qualified as RT
 import Shrun.Configuration.Default (Default (def))
+import Shrun.Data.Text (UnlinedText (UnsafeUnlinedText))
 import Shrun.Prelude
 
 -- | Determines how to format the timer.
@@ -56,15 +57,22 @@ parseTimerFormat getTxt =
 timerFormatStr :: (IsString a) => a
 timerFormatStr = "(digital_compact | digital_full | prose_compact | prose_full)"
 
+-- NOTE: Time formatting does not include newlines, so using UnsafeUnlinedText
+-- is safe. We use the constructor rather than unsafeUnlinedText.
+
 -- | Formats a relative time.
-formatRelativeTime :: TimerFormat -> RelativeTime -> Text
+formatRelativeTime :: TimerFormat -> RelativeTime -> UnlinedText
 formatRelativeTime fmt =
-  T.pack . RT.formatRelativeTime (toRelativeTimeFormat fmt)
+  UnsafeUnlinedText
+    . T.pack
+    . RT.formatRelativeTime (toRelativeTimeFormat fmt)
 
 -- | Formats a relative time seconds.
-formatSeconds :: TimerFormat -> Natural -> Text
+formatSeconds :: TimerFormat -> Natural -> UnlinedText
 formatSeconds fmt =
-  T.pack . RT.formatSeconds (toRelativeTimeFormat fmt)
+  UnsafeUnlinedText
+    . T.pack
+    . RT.formatSeconds (toRelativeTimeFormat fmt)
 
 toRelativeTimeFormat :: TimerFormat -> Format
 toRelativeTimeFormat DigitalCompact = MkFormat FormatStyleDigital FormatVerbosityCompact

src/Shrun/Data/Text.hs

@@ -2,11 +2,23 @@
 
 module Shrun.Data.Text
   ( UnlinedText (..),
+
+    -- * Creation
     fromText,
+    fromTextReplace,
+    unsafeUnlinedText,
+
+    -- * Elimination
     toText,
+
+    -- * Functions
+    concat,
+    intercalate,
+    reallyUnsafeLiftUnlined,
   )
 where
 
+import Data.String (IsString (fromString))
 import Data.Text qualified as T
 import Shrun.Prelude
 
@@ -17,12 +29,19 @@ import Shrun.Prelude
 -- separately.
 --
 -- In exceptional cases (e.g. command names), we may choose to combine the
--- list back into a single text, according to some logic. This is also handled
--- here via the pattern synonym.
+-- list back into a single text, according to some logic.
+--
+-- The constructor 'UnsafeUnlinedText' should only be used when we __know__
+-- the text has no newlines and performance means a branch is undesirable
+-- (e.g. streaming). If there is no performance impact, consider
+-- 'unsafeUnlinedText' instead.
 newtype UnlinedText = UnsafeUnlinedText {unUnlinedText :: Text}
   deriving stock (Eq, Show)
   deriving (Monoid, Semigroup) via Text
 
+instance IsString UnlinedText where
+  fromString = fromTextReplace . pack
+
 instance
   ( k ~ A_Getter,
     a ~ Text,
@@ -33,10 +52,23 @@ instance
   labelOptic = to (\(UnsafeUnlinedText ts) -> ts)
   {-# INLINE labelOptic #-}
 
+-- | Creates a list of 'UnlinedText'.
 fromText :: Text -> List UnlinedText
 fromText = fmap UnsafeUnlinedText . T.lines
 
--- NOTE: [Text Line Concatentation]
+-- | Creates a single 'UnlinedText' by replacing newlines with
+-- whitespace.
+fromTextReplace :: Text -> UnlinedText
+fromTextReplace = UnsafeUnlinedText . T.replace "\n" " "
+
+-- | Unsafe creation that throws error when the text contains newline(s).
+unsafeUnlinedText :: (HasCallStack) => Text -> UnlinedText
+unsafeUnlinedText txt =
+  if '\n' `T.elem` txt
+    then error $ "Unwanted newline in text: " <> unpack txt
+    else UnsafeUnlinedText txt
+
+-- NOTE: [Text Line Concatenation]
 --
 -- Normally, we log multiple newlines separately. However in at least one
 -- case, we want a single log: final error message. Why? Because we want
@@ -51,3 +83,19 @@ fromText = fmap UnsafeUnlinedText . T.lines
 --    in the final output.
 toText :: List UnlinedText -> Text
 toText = T.intercalate " " . fmap (view #unUnlinedText)
+
+-- | Concats via 'toText'.
+concat :: List UnlinedText -> UnlinedText
+concat = UnsafeUnlinedText . toText
+
+intercalate :: UnlinedText -> List UnlinedText -> UnlinedText
+intercalate (UnsafeUnlinedText d) =
+  UnsafeUnlinedText
+    . T.intercalate d
+    . fmap (view #unUnlinedText)
+
+-- | Lifts a 'Text' function to 'UnlinedText'. Very unsafe in that we do not
+-- check for errors i.e. if the parameter function introduces any newlines,
+-- then this will silently succeed. This exists for performance.
+reallyUnsafeLiftUnlined :: (Text -> Text) -> UnlinedText -> UnlinedText
+reallyUnsafeLiftUnlined f (UnsafeUnlinedText t) = UnsafeUnlinedText (f t)

src/Shrun/IO.hs

@@ -389,7 +389,7 @@ writeLogHelper logFn cmd lastReadRef handleResult messages = do
     logFn
       $ MkLog
         { cmd = Just cmd,
-          msg = msg ^. #unUnlinedText,
+          msg,
           lvl = LevelCommand,
           mode = LogModeSet
         }

src/Shrun/Logging/Formatting.hs

@@ -38,6 +38,8 @@ import Shrun.Configuration.Data.Truncation
     Truncation (MkTruncation),
   )
 import Shrun.Data.Command (CommandP (MkCommandP), CommandP1)
+import Shrun.Data.Text (UnlinedText)
+import Shrun.Data.Text qualified as ShrunText
 import Shrun.Logging.Types
   ( Log,
     LogLevel
@@ -150,7 +152,7 @@ coreFormatting ::
   Log ->
   Text
 coreFormatting mLineTrunc mCommandNameTrunc stripControl keyHide log =
-  concatWithLineTrunc mLineTrunc prefix msgStripped
+  concatWithLineTrunc mLineTrunc prefix (msgStripped ^. #unUnlinedText)
   where
     -- prefix is something like "[Success] " or "[Command][some cmd] ".
     -- Notice this does not include ANSI codes or a timestamp.
@@ -164,7 +166,7 @@ coreFormatting mLineTrunc mCommandNameTrunc stripControl keyHide log =
                 cmd
          in mconcat
               [ brackets False logPrefix,
-                cmd'
+                cmd' ^. #unUnlinedText
               ]
 
     msgStripped = stripChars (log ^. #msg) stripControl
@@ -174,13 +176,13 @@ formatCommand ::
   KeyHideSwitch ->
   Maybe (Truncation TruncCommandName) ->
   CommandP1 ->
-  Text
-formatCommand keyHide commandNameTrunc com = brackets True (truncateNameFn cmdName)
+  UnlinedText
+formatCommand keyHide commandNameTrunc com =
+  ShrunText.reallyUnsafeLiftUnlined (brackets True . truncateNameFn) cmdName
   where
     -- Get cmd name to display. Always strip control sequences. Futhermore,
     -- strip leading/trailing whitespace.
-    cmdName =
-      formatCommandText $ displayCmd com keyHide
+    cmdName = displayCmd com keyHide
 
     -- truncate cmd/name if necessary
     truncateNameFn =
@@ -190,11 +192,11 @@ formatCommand keyHide commandNameTrunc com = brackets True (truncateNameFn cmdNa
 
 -- | Replace newlines with whitespace before stripping, so any strings
 -- separated by newlines do not get smashed together.
-formatCommandText :: Text -> Text
+formatCommandText :: Text -> UnlinedText
 formatCommandText =
-  T.strip
+  ShrunText.reallyUnsafeLiftUnlined T.strip
     . Utils.stripControlAll
-    . T.replace "\n" " "
+    . ShrunText.fromTextReplace
 
 -- | Combines a prefix @p@ and msg @m@ with possible line truncation. If no
 -- truncation is given then concatWithLineTrunc is equivalent to @p <> m@.
@@ -240,20 +242,20 @@ concatWithLineTrunc (Just (MkTruncation lineTrunc, mPrefixLen)) prefix msg =
 --
 -- >>> displayCmd (MkCommandP (Just "long") "some long command") KeyHideOff
 -- "long"
-displayCmd :: CommandP1 -> KeyHideSwitch -> Text
-displayCmd (MkCommandP (Just key) _) KeyHideOff = key
-displayCmd (MkCommandP _ cmd) _ = cmd
+displayCmd :: CommandP1 -> KeyHideSwitch -> UnlinedText
+displayCmd (MkCommandP (Just key) _) KeyHideOff = formatCommandText key
+displayCmd (MkCommandP _ cmd) _ = formatCommandText cmd
 
 -- | Applies the given 'StripControl' to the 'Text'.
 --
 -- * 'StripControlAll': Strips whitespace + all control chars.
 -- * 'StripControlSmart': Strips whitespace + 'ansi control' chars.
 -- * 'StripControlNone': Strips whitespace.
-stripChars :: Text -> StripControl t -> Text
+stripChars :: UnlinedText -> StripControl t -> UnlinedText
 stripChars txt = \case
   StripControlAll -> Utils.stripControlAll txt
   -- whitespace
-  StripControlNone -> T.strip txt
+  StripControlNone -> ShrunText.reallyUnsafeLiftUnlined T.strip txt
   StripControlSmart -> Utils.stripControlSmart txt
 {-# INLINE stripChars #-}
 

src/Shrun/Logging/Types.hs

@@ -17,6 +17,7 @@ module Shrun.Logging.Types
 where
 
 import Shrun.Data.Command (CommandP1)
+import Shrun.Data.Text (UnlinedText)
 import Shrun.Logging.Types.Internal
   ( ConsoleLog,
     FileLog,
@@ -46,19 +47,13 @@ data LogRegion r
   | -- | Log without region.
     LogNoRegion ConsoleLog
 
--- NOTE: [Log UnlinedText]
---
--- It would be nice if msg was UnlinedText, so then formatting
--- could share the proof that lines have been stripped. Unfortunately this is
--- non-trivial. See NOTE: [StripControl Newlines].
-
 -- | Captures the relevant information concerning a specific log
 -- (i.e. command, text, level, and mode).
 data Log = MkLog
   { -- | Optional command that produced this log.
     cmd :: Maybe CommandP1,
     -- | The 'Text' for a given log.
-    msg :: Text,
+    msg :: UnlinedText,
     -- | The 'LogLevel' for a given log.
     lvl :: LogLevel,
     -- | The 'LogMode' for a given log.
@@ -84,8 +79,8 @@ instance
 
 instance
   ( k ~ A_Lens,
-    a ~ Text,
-    b ~ Text
+    a ~ UnlinedText,
+    b ~ UnlinedText
   ) =>
   LabelOptic "msg" k Log Log a b
   where

src/Shrun/Notify.hs

@@ -5,7 +5,6 @@ module Shrun.Notify
 where
 
 import DBus.Notify (UrgencyLevel)
-import Data.Text qualified as T
 import Shrun.Configuration.Env.Types
   ( HasAnyError,
     HasCommonLogging,
@@ -14,6 +13,8 @@ import Shrun.Configuration.Env.Types
     HasNotifyConfig (getNotifyConfig),
     setAnyErrorTrue,
   )
+import Shrun.Data.Text (UnlinedText)
+import Shrun.Data.Text qualified as ShrunText
 import Shrun.Logging qualified as Logging
 import Shrun.Logging.MonadRegionLogger (MonadRegionLogger (Region, withRegion))
 import Shrun.Logging.Types
@@ -43,9 +44,9 @@ sendNotif ::
     MonadTime m
   ) =>
   -- | Notif summary
-  Text ->
+  UnlinedText ->
   -- | Notif body
-  Text ->
+  UnlinedText ->
   -- | Notif urgency
   UrgencyLevel ->
   m ()
@@ -64,7 +65,9 @@ sendNotif summary body urgency = do
       Logging.putRegionLog r
         $ MkLog
           { cmd = Nothing,
-            msg = "Could not send notification: " <> T.pack (displayException ex),
+            msg =
+              "Could not send notification: "
+                <> ShrunText.fromTextReplace (pack (displayException ex)),
             lvl = LevelError,
             mode = LogModeFinish
           }

src/Shrun/Notify/MonadAppleScript.hs

@@ -46,10 +46,10 @@ shrunToAppleScript shrunNote = txt
     txt =
       mconcat
         [ "osascript -e 'display notification ",
-          withDoubleQuotes (shrunNote ^. #body),
+          withDoubleQuotes (shrunNote ^. #body % #unUnlinedText),
           " with title \"Shrun\" ",
           " subtitle ",
-          withDoubleQuotes (shrunNote ^. #summary),
+          withDoubleQuotes (shrunNote ^. #summary % #unUnlinedText),
           "'"
         ]
 

src/Shrun/Notify/MonadDBus.hs

@@ -54,8 +54,8 @@ shrunToDBus :: ShrunNote -> Note
 shrunToDBus shrunNote =
   DBusN.Note
     { appName = "Shrun",
-      summary = unpack $ shrunNote ^. #summary,
-      body = Just . DBusN.Text . T.unpack $ shrunNote ^. #body,
+      summary = unpack $ shrunNote ^. #summary % #unUnlinedText,
+      body = Just . DBusN.Text . T.unpack $ shrunNote ^. #body % #unUnlinedText,
       appImage = Nothing,
       hints = [Urgency (shrunNote ^. #urgency)],
       expiry,