chore(users/Profpatsch): clean up haskell libs a little r/6464

Change-Id: Ia9a6c5a754ca8f2912308feb5a26f5276a08d24c
Reviewed-on: https://cl.tvl.fyi/c/depot/+/9011
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI

2 files changed, 0 insertions, 253 deletions

diff --git a/users/Profpatsch/my-prelude/src/Pretty.hs b/users/Profpatsch/my-prelude/src/Pretty.hs
deleted file mode 100644
index 8046c83e459c..000000000000
--- a/users/Profpatsch/my-prelude/src/Pretty.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE LambdaCase #-}
-
-module Pretty
-  ( -- * Pretty printing for error messages
-    Err,
-    printPretty,
-    showPretty,
-    -- constructors hidden
-    prettyErrs,
-    message,
-    messageString,
-    pretty,
-    prettyString,
-    hscolour',
-  )
-where
-
-import Data.List qualified as List
-import Data.Text qualified as Text
-import Language.Haskell.HsColour
-  ( Output (TTYg),
-    hscolour,
-  )
-import Language.Haskell.HsColour.ANSI (TerminalType (..))
-import Language.Haskell.HsColour.Colourise
-  ( defaultColourPrefs,
-  )
-import MyPrelude
-import System.Console.ANSI (setSGRCode)
-import System.Console.ANSI.Types
-  ( Color (Red),
-    ColorIntensity (Dull),
-    ConsoleLayer (Foreground),
-    SGR (Reset, SetColor),
-  )
-import Text.Nicify (nicify)
-
--- | Print any 'Show'able type to stderr, formatted nicely and in color. Very helpful for debugging.
-printPretty :: Show a => a -> IO ()
-printPretty a =
-  a & pretty & (: []) & prettyErrs & stringToText & putStderrLn
-
-showPretty :: Show a => a -> Text
-showPretty a = a & pretty & (: []) & prettyErrs & stringToText
-
--- | Display a list of 'Err's as a colored error message
--- and abort the test.
-prettyErrs :: [Err] -> String
-prettyErrs errs = res
-  where
-    res = List.intercalate "\n" $ map one errs
-    one = \case
-      ErrMsg s -> color Red s
-      ErrPrettyString s -> prettyShowString s
-    -- Pretty print a String that was produced by 'show'
-    prettyShowString :: String -> String
-    prettyShowString = hscolour' . nicify
-
--- | Small DSL for pretty-printing errors
-data Err
-  = -- | Message to display in the error
-    ErrMsg String
-  | -- | Pretty print a String that was produced by 'show'
-    ErrPrettyString String
-
--- | Plain message to display, as 'Text'
-message :: Text -> Err
-message = ErrMsg . Text.unpack
-
--- | Plain message to display, as 'String'
-messageString :: String -> Err
-messageString = ErrMsg
-
--- | Any 'Show'able to pretty print
-pretty :: Show a => a -> Err
-pretty x = ErrPrettyString $ show x
-
--- | Pretty print a String that was produced by 'show'
-prettyString :: String -> Err
-prettyString s = ErrPrettyString s
-
--- Prettifying Helpers, mostly stolen from
--- https://hackage.haskell.org/package/hspec-expectations-pretty-diff-0.7.2.5/docs/src/Test.Hspec.Expectations.Pretty.html#prettyColor
-
-hscolour' :: String -> String
-hscolour' =
-  hscolour (TTYg Ansi16Colour) defaultColourPrefs False False "" False
-
-color :: Color -> String -> String
-color c s = setSGRCode [SetColor Foreground Dull c] ++ s ++ setSGRCode [Reset]
diff --git a/users/Profpatsch/my-prelude/src/RunCommand.hs b/users/Profpatsch/my-prelude/src/RunCommand.hs
deleted file mode 100644
index 5c80eb3aacf4..000000000000
--- a/users/Profpatsch/my-prelude/src/RunCommand.hs
+++ /dev/null
@@ -1,162 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-
-module RunCommand where
-
-import Data.ByteString qualified as ByteString
-import Data.ByteString.Lazy qualified as Bytes.Lazy
-import Data.Char qualified as Char
-import Data.List qualified as List
-import Data.Text qualified as Text
-import MyPrelude
-import System.Exit qualified as Exit
-import System.IO (Handle)
-import System.Process.Typed qualified as Process
-import Prelude hiding (log)
-
--- | Given a a command, the executable and arguments,
--- spawn the tool as subprocess and collect its stdout (stderr will go to our stderr).
-
--- Will strip the stdout of trailing newlines.
---
--- If the executable is not a path, it will be resolved via the @PATH@ environment variable.
-runCommand :: MonadIO m => FilePath -> [Text] -> m (Exit.ExitCode, ByteString)
-runCommand executable args = do
-  let bashArgs = prettyArgsForBash ((executable & stringToText) : args)
-  log [fmt|Running: $ {bashArgs}|]
-  Process.proc
-    executable
-    (args <&> textToString)
-    & Process.readProcessStdout
-    <&> second toStrictBytes
-    <&> second stripWhitespaceFromEnd
-
--- | Given a a command, the executable and arguments,
--- spawn the tool as subprocess and run it to conclusion.
---
--- If the executable is not a path, it will be resolved via the @PATH@ environment variable.
-runCommandNoStdout :: MonadIO m => FilePath -> [Text] -> m Exit.ExitCode
-runCommandNoStdout executable args = do
-  let bashArgs = prettyArgsForBash ((executable & stringToText) : args)
-  log [fmt|Running: $ {bashArgs}|]
-  Process.proc
-    executable
-    (args <&> textToString)
-    & Process.runProcess
-
--- TODO: This is reversing the whole string *twice*. Can we strip from end without doing that?
-stripWhitespaceFromEnd :: ByteString -> ByteString
-stripWhitespaceFromEnd = ByteString.reverse . ByteString.dropWhile (\w -> w == charToWordUnsafe '\n') . ByteString.reverse
-
--- | Like `runCommand`, but takes a Bytestring that provides the command with streamed input on stdin.
-runCommandWithStdin :: MonadIO m => FilePath -> [Text] -> Bytes.Lazy.ByteString -> m (Exit.ExitCode, ByteString)
-runCommandWithStdin executable args stdin = do
-  let bashArgs = prettyArgsForBash ((executable & stringToText) : args)
-  log [fmt|Running: $ {bashArgs}|]
-  Process.proc
-    executable
-    (args <&> textToString)
-    & Process.setStdin (Process.byteStringInput stdin)
-    & Process.readProcessStdout
-    <&> second toStrictBytes
-    <&> second stripWhitespaceFromEnd
-
--- | Like `runCommand`, but takes a Bytestring that provides the command with streamed input on stdin.
-runCommandWithStdinNoStdout :: MonadIO m => FilePath -> [Text] -> Bytes.Lazy.ByteString -> m Exit.ExitCode
-runCommandWithStdinNoStdout executable args stdin = do
-  let bashArgs = prettyArgsForBash ((executable & stringToText) : args)
-  log [fmt|Running: $ {bashArgs}|]
-  Process.proc
-    executable
-    (args <&> textToString)
-    & Process.setStdin (Process.byteStringInput stdin)
-    & Process.runProcess
-
--- | Like 'runCommandWithStdin' but exit if the command returns a non-0 status.
-runCommandWithStdinExpect0 :: MonadIO m => FilePath -> [Text] -> Bytes.Lazy.ByteString -> m ByteString
-runCommandWithStdinExpect0 executable args stdin =
-  runCommandWithStdin executable args stdin >>= \case
-    (ex, stdout) -> do
-      checkStatus0 executable ex
-      pure stdout
-
--- | Like 'runCommandWithStdinNoStdout' but exit if the command returns a non-0 status.
-runCommandWithStdinNoStdoutExpect0 :: MonadIO m => FilePath -> [Text] -> Bytes.Lazy.ByteString -> m ()
-runCommandWithStdinNoStdoutExpect0 executable args stdin =
-  runCommandWithStdinNoStdout executable args stdin
-    >>= checkStatus0 executable
-
--- | Like 'runCommandExpect0', but don’t capture stdout,
--- connect stdin and stdout to the command until it returns.
---
--- This is for interactive subcommands.
-runCommandInteractiveExpect0 :: MonadIO m => FilePath -> [Text] -> m ()
-runCommandInteractiveExpect0 executable args = do
-  let bashArgs = prettyArgsForBash ((executable & stringToText) : args)
-  log [fmt|Running interactively: $ {bashArgs}|]
-  ( liftIO $
-      Process.runProcess $
-        Process.proc
-          executable
-          (args <&> textToString)
-    )
-    >>= checkStatus0 executable
-
--- | Given a name of a command, the executable and arguments,
--- spawn the tool as subprocess and pipe its stdout to the given 'Handle'.
---
--- If the executable is not a path, it will be resolved via the @PATH@ environment variable.
-runCommandPipeToHandle :: MonadIO m => FilePath -> [Text] -> Handle -> m Exit.ExitCode
-runCommandPipeToHandle executable args handle = do
-  -- TODO log the output file?
-  let bashArgs = prettyArgsForBash ((executable & stringToText) : args)
-  log [fmt|Running: $ {bashArgs}|]
-  liftIO $
-    Process.runProcess
-      ( Process.proc
-          executable
-          (args <&> textToString)
-          & Process.setStdout (Process.useHandleClose handle)
-      )
-
--- | Check whether a command exited 0 or crash.
-checkStatus0 :: MonadIO m => FilePath -> Exit.ExitCode -> m ()
-checkStatus0 executable = \case
-  Exit.ExitSuccess -> pure ()
-  Exit.ExitFailure status -> do
-    logCritical [fmt|Command `{executable}` did not exit with status 0 (success), but status {status}|]
-
-log :: MonadIO m => Text -> m ()
-log = liftIO . putStderrLn
-
--- | Log the message on the normal logging level & exit the program
-logCritical :: MonadIO m => Text -> m b
-logCritical msg = do
-  liftIO $ putStderrLn msg
-  liftIO $ Exit.exitWith (Exit.ExitFailure 1)
-
--- | Pretty print a command line in a way that can be copied to bash.
-prettyArgsForBash :: [Text] -> Text
-prettyArgsForBash = Text.intercalate " " . map simpleBashEscape
-
--- | Simple escaping for bash words. If they contain anything that’s not ascii chars
--- and a bunch of often-used special characters, put the word in single quotes.
-simpleBashEscape :: Text -> Text
-simpleBashEscape t = do
-  case Text.find (not . isSimple) t of
-    Just _ -> escapeSingleQuote t
-    Nothing -> t
-  where
-    -- any word that is just ascii characters is simple (no spaces or control characters)
-    -- or contains a few often-used characters like - or .
-    isSimple c =
-      Char.isAsciiLower c
-        || Char.isAsciiUpper c
-        || Char.isDigit c
-        -- These are benign, bash will not interpret them as special characters.
-        || List.elem c ['-', '.', ':', '/']
-    -- Put the word in single quotes
-    -- If there is a single quote in the word,
-    -- close the single quoted word, add a single quote, open the word again
-    escapeSingleQuote t' = "'" <> Text.replace "'" "'\\''" t' <> "'"