fix: cli,ui,web: quote spaced file paths properly on Windows

hledger-ui's A key (running hledger-iadd) and E key (running $EDITOR)
now properly handle file paths containing spaces, on Windows machines.
The same fix is applied to running info, man, tldr, or a pager, eg
when displaying help.

Added shellQuoteIfNeeded in Hledger.Utils.String, which uses double-quote
escaping on mingw32 and single quotes elsewhere.

RulesReader's runCommand/runCommandAsFilter are not changed; they run
user-authored commands from CSV rules files, where quoting is the
user's responsibility.

Author: simonmichael

hledger-lib/Hledger/Utils/String.hs

@@ -11,6 +11,7 @@ module Hledger.Utils.String (
  -- quoting
  quoteIfNeeded,
  singleQuoteIfNeeded,
+ shellQuoteIfNeeded,
  quoteForCommandLine,
  -- quotechars,
  -- whitespacechars,
@@ -41,6 +42,7 @@ import Data.Char (isSpace, toLower, toUpper)
 import Data.List (intercalate, dropWhileEnd)
 import Data.Text qualified as T
 import Safe (headErr, tailErr)
+import System.Info (os)
 import Text.Megaparsec ((<|>), between, many, noneOf, sepBy)
 import Text.Megaparsec.Char (char)
 import Text.Printf (printf)
@@ -155,6 +157,18 @@ singleQuoteIfNeeded s | any (`elem` s) (quotechars++whitespacechars) = singleQuo
 singleQuote :: String -> String
 singleQuote s = "'"++s++"'"
 
+-- | Quote a string if needed for use as one argument in a shell command line
+-- on the current platform. Uses double-quote escaping on Windows (cmd.exe does
+-- not recognise single quotes as a quoting character); elsewhere uses single
+-- quotes, which are literal in POSIX shells. Use this whenever interpolating
+-- a path or other string into a command that will be passed to
+-- 'System.Process.runCommand', 'System.Process.callCommand', or
+-- 'System.Process.shell'.
+shellQuoteIfNeeded :: String -> String
+shellQuoteIfNeeded
+  | os == "mingw32" = quoteIfNeeded
+  | otherwise       = singleQuoteIfNeeded
+
 -- | Try to single- and backslash-quote a string as needed to make it usable
 -- as an argument on a (sh/bash) shell command line. At least, well enough 
 -- to handle common currency symbols, like $. Probably broken in many ways.

hledger-ui/Hledger/UI/Editor.hs

@@ -33,7 +33,7 @@ endPosition = Just (-1, Nothing)
 -- and return the exit code; or raise an error.
 -- hledger-iadd is an alternative to the built-in add command.
 runIadd :: FilePath -> IO ExitCode
-runIadd f = runCommand ("hledger-iadd -f " ++ f) >>= waitForProcess
+runIadd f = runCommand ("hledger-iadd -f " ++ shellQuoteIfNeeded f) >>= waitForProcess
 
 -- | Run the user's preferred text editor (or try a default editor),
 -- on the given file, blocking until it exits, and return the exit
@@ -99,7 +99,7 @@ editFileAtPositionCommand :: Maybe TextPosition -> FilePath -> IO String
 editFileAtPositionCommand mpos f = do
   cmd <- getEditCommand
   let editor = lowercase $ takeBaseName $ headDef "" $ words' cmd
-      f' = singleQuoteIfNeeded f
+      f' = shellQuoteIfNeeded f
       mpos' = Just . bimap show (fmap show) =<< mpos
       join sep = intercalate sep . catMaybes
       args = case editor of

hledger/Hledger/Cli/DocFiles.hs

@@ -29,7 +29,7 @@ import System.IO
 import System.IO.Temp
 import System.Process
 
-import Hledger.Utils (first3, second3, third3, embedFileRelative, error')
+import Hledger.Utils (first3, second3, third3, embedFileRelative, error', shellQuoteIfNeeded)
 import Text.Printf (printf)
 import System.Environment (lookupEnv)
 import Hledger.Utils.Debug
@@ -107,7 +107,7 @@ runInfoForTopic tool mtopic =
     BC.hPutStrLn h $ manualInfo tool
     hClose h
     callCommand $ dbg1 "info command" $
-      "info -f " ++ f ++ maybe "" (printf " -n '%s'") mtopic
+      "info -f " ++ shellQuoteIfNeeded f ++ maybe "" (printf " -n '%s'") mtopic
 
 -- less with any vertical whitespace squashed, case-insensitive searching, the $ regex metacharacter accessible as \$.
 less = "less -s -i --use-backslash"
@@ -129,7 +129,7 @@ runPagerForTopic tool mtopic = do
         case mtopic of
           Nothing -> (envpager, "")
           Just t  -> (less, "-p'^(   )?" ++ t ++ if exactmatch then "\\$'" else "")
-    callCommand $ dbg1 "pager command" $ unwords [pager, searcharg, f]
+    callCommand $ dbg1 "pager command" $ unwords [pager, searcharg, shellQuoteIfNeeded f]
 
 -- | Display a man page for this tool, scrolled to the given topic if provided, using "man".
 -- When a topic is provided we force man to use "less", ignoring $MANPAGER and $PAGER.
@@ -145,7 +145,7 @@ runManForTopic tool mtopic =
         case mtopic of
           Nothing -> ""
           Just t  -> "-P \"" ++ less ++ " -p'^(   )?" ++ t ++ (if exactmatch then "\\\\$" else "") ++ "'\""
-    callCommand $ dbg1 "man command" $ unwords ["man", pagerarg, f]
+    callCommand $ dbg1 "man command" $ unwords ["man", pagerarg, shellQuoteIfNeeded f]
 
 -- | Get the named tldr page's source, if we know it.
 tldr :: TldrPage -> Maybe ByteString
@@ -165,7 +165,7 @@ runTldrForPage name =
         -- tlrc - ?
         -- tldr-node-client - undocumented env var suggested in output
         setEnv "TLDR_AUTO_UPDATE_DISABLED" "1"
-        callCommand $ dbg1 "tldr command" $ "tldr --render " <> f
+        callCommand $ dbg1 "tldr command" $ "tldr --render " <> shellQuoteIfNeeded f
       ) `catch` (\(_e::IOException) -> do
         hPutStrLn stderr $ "Warning: could not run tldr --render, using fallback viewer instead.\n"
         BC.putStrLn b