diff options
Diffstat (limited to 'users')
| -rw-r--r-- | users/Profpatsch/cabal.project | 2 | ||||
| -rw-r--r-- | users/Profpatsch/hie.yaml | 8 | ||||
| -rw-r--r-- | users/Profpatsch/jbovlaste-sqlite/default.nix | 2 | ||||
| -rw-r--r-- | users/Profpatsch/jbovlaste-sqlite/jbovlaste-sqlite.cabal | 3 | ||||
| -rw-r--r-- | users/Profpatsch/mailbox-org/MailboxOrg.hs | 85 | ||||
| -rw-r--r-- | users/Profpatsch/mailbox-org/default.nix | 2 | ||||
| -rw-r--r-- | users/Profpatsch/mailbox-org/mailbox-org.cabal | 81 | ||||
| -rw-r--r-- | users/Profpatsch/mailbox-org/src/AesonQQ.hs (renamed from users/Profpatsch/mailbox-org/AesonQQ.hs) | 7 | ||||
| -rw-r--r-- | users/Profpatsch/my-prelude/default.nix | 9 | ||||
| -rw-r--r-- | users/Profpatsch/my-prelude/my-prelude.cabal | 7 | ||||
| -rw-r--r-- | users/Profpatsch/my-prelude/src/Pretty.hs | 91 | ||||
| -rw-r--r-- | users/Profpatsch/my-prelude/src/RunCommand.hs | 162 |
12 files changed, 123 insertions, 336 deletions
diff --git a/users/Profpatsch/cabal.project b/users/Profpatsch/cabal.project index d05768a0088f..ed34b2f2828a 100644 --- a/users/Profpatsch/cabal.project +++ b/users/Profpatsch/cabal.project @@ -4,7 +4,9 @@ packages: ./arglib/arglib-netencode.cabal ./execline/exec-helpers.cabal ./htmx-experiment/htmx-experiment.cabal + ./mailbox-org/mailbox-org.cabal ./cas-serve/cas-serve.cabal ./jbovlaste-sqlite/jbovlaste-sqlite.cabal ./whatcd-resolver/whatcd-resolver.cabal + ./ircmail/ircmail.cabal ./httzip/httzip.cabal diff --git a/users/Profpatsch/hie.yaml b/users/Profpatsch/hie.yaml index e22a383216ec..308fa8fe918c 100644 --- a/users/Profpatsch/hie.yaml +++ b/users/Profpatsch/hie.yaml @@ -10,15 +10,19 @@ cradle: component: "lib:exec-helpers" - path: "./htmx-experiment/src" component: "lib:htmx-experiment" - - path: "./htmx-experiment/src" - component: "lib:htmx-experiment" - path: "./htmx-experiment/Main.hs" component: "htmx-experiment:exe:htmx-experiment" + - path: "./mailbox-org/src" + component: "lib:mailbox-org" + - path: "./mailbox-org/MailboxOrg.hs" + component: "mailbox-org:exe:mailbox-org" - path: "./cas-serve/CasServe.hs" component: "cas-serve:exe:cas-serve" - path: "./jbovlaste-sqlite/JbovlasteSqlite.hs" component: "jbovlaste-sqlite:exe:jbovlaste-sqlite" - path: "./whatcd-resolver/src" component: "lib:whatcd-resolver" + - path: "./ircmail/src" + component: "lib:ircmail" - path: "./httzip/Httzip.hs" component: "httzip:exe:httzip" diff --git a/users/Profpatsch/jbovlaste-sqlite/default.nix b/users/Profpatsch/jbovlaste-sqlite/default.nix index b72143c96d70..f04b4ad0b3c9 100644 --- a/users/Profpatsch/jbovlaste-sqlite/default.nix +++ b/users/Profpatsch/jbovlaste-sqlite/default.nix @@ -20,8 +20,6 @@ let pkgs.haskellPackages.foldl pkgs.haskellPackages.sqlite-simple pkgs.haskellPackages.xml-conduit - depot.users.Profpatsch.arglib.netencode.haskell - depot.users.Profpatsch.netencode.netencode-hs ]; diff --git a/users/Profpatsch/jbovlaste-sqlite/jbovlaste-sqlite.cabal b/users/Profpatsch/jbovlaste-sqlite/jbovlaste-sqlite.cabal index 4c9707feee9e..40da320f08d3 100644 --- a/users/Profpatsch/jbovlaste-sqlite/jbovlaste-sqlite.cabal +++ b/users/Profpatsch/jbovlaste-sqlite/jbovlaste-sqlite.cabal @@ -62,7 +62,6 @@ executable jbovlaste-sqlite pa-label, pa-error-tree, pa-field-parser, - my-prelude, containers, selective, semigroupoids, @@ -71,8 +70,6 @@ executable jbovlaste-sqlite foldl, conduit, bytestring, - arglib-netencode, - netencode, text, sqlite-simple, xml-conduit, diff --git a/users/Profpatsch/mailbox-org/MailboxOrg.hs b/users/Profpatsch/mailbox-org/MailboxOrg.hs index c66db49c13c7..6c5820080c76 100644 --- a/users/Profpatsch/mailbox-org/MailboxOrg.hs +++ b/users/Profpatsch/mailbox-org/MailboxOrg.hs @@ -1,6 +1,5 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GHC2021 #-} {-# LANGUAGE LambdaCase #-} @@ -31,7 +30,6 @@ import Data.List qualified as List import Data.Map.Strict qualified as Map import Data.Text qualified as Text import ExecHelpers -import GHC.Records (HasField (..)) import Label import Netencode qualified import Netencode.Parse qualified as NetParse @@ -117,9 +115,7 @@ listFilterConfig session = do >>= printPretty applyFilterRule :: - ( HasField "folderId" dat Text, - HasField "rulename" dat Text - ) => + (HasField "folderId" dat Text) => dat -> Session -> IO () @@ -209,48 +205,47 @@ applyFilters session = do <&> mapFromListOn (\dat -> getLabel @"rulename" dat.parsed) ) ([] :: [()]) - let goal = Map.fromList [(label @"rulename" "another", 32), (label @"rulename" "xyz", 23)] + let goal = Map.fromList [(label @"rulename" "another", 32 :: Integer), (label @"rulename" "xyz", 23)] let actions = declarativeUpdate goal filters log [fmt|To * create: {actions.toCreate & Map.keys & show}, * update: {actions.toUpdate & Map.keys & show}, * delete: {actions.toDelete & Map.keys & show}|] - where - -- filters - -- & Map.elems - -- & traverse_ - -- ( updateIfDifferent - -- session - -- ( \el -> - -- pure $ - -- el.original.mailfilter - -- & KeyMap.insert "active" (Json.Bool False) - -- ) - -- (pure ()) - -- ) - - mapFromListOn :: Ord k => (a -> k) -> [a] -> Map k a - mapFromListOn on xs = xs <&> (\x -> (on x, x)) & Map.fromList - updateIfDifferent :: - forall label parsed. - ( HasField "id_" parsed Json.Value, - HasField "rulename" parsed Text - ) => - Session -> - (Dat label Json.Object parsed -> IO Json.Object) -> - Json.Parse Error () -> - Dat label Json.Object parsed -> - IO () - updateIfDifferent session switcheroo parser dat = do - new <- switcheroo dat - if new /= getField @label dat.original - then do - log [fmt|Updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value})|] - mailfilter - session - "update" - mempty - parser - new - else do - log [fmt|Skipping updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value}) because nothing changed.|] + +-- where +-- filters +-- & Map.elems +-- & traverse_ +-- ( updateIfDifferent +-- session +-- ( \el -> +-- pure $ +-- el.original.mailfilter +-- & KeyMap.insert "active" (Json.Bool False) +-- ) +-- (pure ()) +-- ) + +-- updateIfDifferent :: +-- forall label parsed. +-- ( HasField "id_" parsed Json.Value, +-- HasField "rulename" parsed Text +-- ) => +-- Session -> +-- (Dat label Json.Object parsed -> IO Json.Object) -> +-- Json.Parse Error () -> +-- Dat label Json.Object parsed -> +-- IO () +-- updateIfDifferent session switcheroo parser dat = do +-- new <- switcheroo dat +-- if new /= getField @label dat.original +-- then do +-- log [fmt|Updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value})|] +-- mailfilter +-- session +-- "update" +-- mempty +-- parser +-- new +-- else do +-- log [fmt|Skipping updating filter "{dat.parsed.rulename}" (id {dat.parsed.id_ & show @Json.Value}) because nothing changed.|] -- | https://oxpedia.org/wiki/index.php?title=HTTP_API_MailFilter mailfilter :: diff --git a/users/Profpatsch/mailbox-org/default.nix b/users/Profpatsch/mailbox-org/default.nix index 2cb4c7af8e6c..73bd28292dcc 100644 --- a/users/Profpatsch/mailbox-org/default.nix +++ b/users/Profpatsch/mailbox-org/default.nix @@ -7,7 +7,7 @@ let src = depot.users.Profpatsch.exactSource ./. [ ./mailbox-org.cabal - ./AesonQQ.hs + ./src/AesonQQ.hs ./MailboxOrg.hs ]; diff --git a/users/Profpatsch/mailbox-org/mailbox-org.cabal b/users/Profpatsch/mailbox-org/mailbox-org.cabal index 8125baef7144..8e5328907a9e 100644 --- a/users/Profpatsch/mailbox-org/mailbox-org.cabal +++ b/users/Profpatsch/mailbox-org/mailbox-org.cabal @@ -4,38 +4,93 @@ version: 0.1.0.0 author: Profpatsch maintainer: mail@profpatsch.de + +common common-options + ghc-options: + -Wall + -Wno-type-defaults + -Wunused-packages + -Wredundant-constraints + -fwarn-missing-deriving-strategies + + -- See https://downloads.haskell.org/ghc/latest/docs/users_guide/exts.html + -- for a description of all these extensions + default-extensions: + -- Infer Applicative instead of Monad where possible + ApplicativeDo + + -- Allow literal strings to be Text + OverloadedStrings + + -- Syntactic sugar improvements + LambdaCase + MultiWayIf + + -- Makes the (deprecated) usage of * instead of Data.Kind.Type an error + NoStarIsType + + -- Convenient and crucial to deal with ambiguous field names, commonly + -- known as RecordDotSyntax + OverloadedRecordDot + + -- does not export record fields as functions, use OverloadedRecordDot to access instead + NoFieldSelectors + + -- Record punning + RecordWildCards + + -- Improved Deriving + DerivingStrategies + DerivingVia + + -- Type-level strings + DataKinds + + -- to enable the `type` keyword in import lists (ormolu uses this automatically) + ExplicitNamespaces + + default-language: GHC2021 + + +library + import: common-options + + hs-source-dirs: src + + exposed-modules: + AesonQQ + + build-depends: + base >=4.15 && <5, + pa-prelude, + aeson, + PyF, + template-haskell + + + executable mailbox-org + import: common-options main-is: MailboxOrg.hs build-depends: base >=4.15 && <5, + mailbox-org, my-prelude, pa-prelude, pa-label, + pa-pretty, pa-error-tree, exec-helpers, netencode, text, - semigroupoids, - nonempty-containers, - data-fix, - selective, directory, - mtl, filepath, arglib-netencode, random, http-conduit, - http-client, aeson, aeson-better-errors, bytestring, - PyF, typed-process, - process, containers, - - default-language: Haskell2010 - - default-extensions: - GHC2021 diff --git a/users/Profpatsch/mailbox-org/AesonQQ.hs b/users/Profpatsch/mailbox-org/src/AesonQQ.hs index f12afdf51584..2ac3d533aeaa 100644 --- a/users/Profpatsch/mailbox-org/AesonQQ.hs +++ b/users/Profpatsch/mailbox-org/src/AesonQQ.hs @@ -3,20 +3,21 @@ module AesonQQ where import Data.Aeson qualified as Json -import Data.Either qualified as Either +import Language.Haskell.TH.Quote (QuasiQuoter) import PossehlAnalyticsPrelude import PyF qualified import PyF.Internal.QQ qualified as PyFConf +aesonQQ :: QuasiQuoter aesonQQ = PyF.mkFormatter "aesonQQ" PyF.defaultConfig { PyFConf.delimiters = Just ('|', '|'), - PyFConf.postProcess = \exp -> do + PyFConf.postProcess = \exp_ -> do -- TODO: this does not throw an error at compilation time if the json does not parse [| - case Json.eitherDecodeStrict' @Json.Value $ textToBytesUtf8 $ stringToText $(exp) of + case Json.eitherDecodeStrict' @Json.Value $ textToBytesUtf8 $ stringToText $(exp_) of Left err -> error err Right a -> a |] diff --git a/users/Profpatsch/my-prelude/default.nix b/users/Profpatsch/my-prelude/default.nix index c046c213bdf3..1c75379d7037 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 3a4a06d165b1..4c732bcaf897 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 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' <> "'" |