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

4 files changed, 2 insertions, 267 deletions

diff --git a/users/Profpatsch/my-prelude/default.nix b/users/Profpatsch/my-prelude/default.nix
index c046c213bd..1c75379d70 100644
--- a/users/Profpatsch/my-prelude/default.nix
+++ b/users/Profpatsch/my-prelude/default.nix
@@ -8,8 +8,6 @@ pkgs.haskellPackages.mkDerivation {
     ./my-prelude.cabal
     ./src/Aeson.hs
     ./src/MyPrelude.hs
-    ./src/Pretty.hs
-    ./src/RunCommand.hs
     ./src/Test.hs
     ./src/Tool.hs
     ./src/ValidationParseT.hs
@@ -24,25 +22,20 @@ pkgs.haskellPackages.mkDerivation {
     pkgs.haskellPackages.pa-label
     pkgs.haskellPackages.pa-error-tree
     pkgs.haskellPackages.pa-json
+    pkgs.haskellPackages.pa-pretty
     pkgs.haskellPackages.aeson-better-errors
-    pkgs.haskellPackages.ansi-terminal
     pkgs.haskellPackages.error
-    pkgs.haskellPackages.hscolour
     pkgs.haskellPackages.hspec
     pkgs.haskellPackages.hspec-expectations-pretty-diff
     pkgs.haskellPackages.monad-logger
-    pkgs.haskellPackages.nicify-lib
     pkgs.haskellPackages.postgresql-simple
     pkgs.haskellPackages.profunctors
     pkgs.haskellPackages.PyF
     pkgs.haskellPackages.semigroupoids
     pkgs.haskellPackages.these
-    pkgs.haskellPackages.typed-process
     pkgs.haskellPackages.unliftio
     pkgs.haskellPackages.validation-selective
     pkgs.haskellPackages.vector
-
-
   ];
 
   license = lib.licenses.mit;
diff --git a/users/Profpatsch/my-prelude/my-prelude.cabal b/users/Profpatsch/my-prelude/my-prelude.cabal
index 3a4a06d165..4c732bcaf8 100644
--- a/users/Profpatsch/my-prelude/my-prelude.cabal
+++ b/users/Profpatsch/my-prelude/my-prelude.cabal
@@ -56,9 +56,7 @@ library
     hs-source-dirs: src
     exposed-modules:
       MyPrelude
-      Pretty
       Aeson
-      RunCommand
       Test
       Postgres.Decoder
       Postgres.MonadPostgres
@@ -76,20 +74,18 @@ library
      , pa-label
      , pa-error-tree
      , pa-json
+     , pa-pretty
      , aeson
      , aeson-better-errors
-     , ansi-terminal
      , bytestring
      , containers
      , error
      , exceptions
      , filepath
-     , hscolour
      , hspec
      , hspec-expectations-pretty-diff
      , monad-logger
      , mtl
-     , nicify-lib
      , postgresql-simple
      , profunctors
      , PyF
@@ -97,7 +93,6 @@ library
      , selective
      , text
      , these
-     , typed-process
      , unix
      , unliftio
      , validation-selective
diff --git a/users/Profpatsch/my-prelude/src/Pretty.hs b/users/Profpatsch/my-prelude/src/Pretty.hs
deleted file mode 100644
index 8046c83e45..0000000000
--- 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 5c80eb3aac..0000000000
--- 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' <> "'"