From 04fc04f586ad8b336371499b4487f51c73e03862 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 5 Mar 2022 20:00:32 +0100
Subject: [PATCH] More improvements to completers

---
 app/ghcup/GHCup/OptParse.hs        |  4 ++++
 app/ghcup/GHCup/OptParse/Common.hs | 36 +++++++++++++++++++++++-------
 2 files changed, 32 insertions(+), 8 deletions(-)

diff --git a/app/ghcup/GHCup/OptParse.hs b/app/ghcup/GHCup/OptParse.hs
index 89ae3b5..f4b48cd 100644
--- a/app/ghcup/GHCup/OptParse.hs
+++ b/app/ghcup/GHCup/OptParse.hs
@@ -124,6 +124,7 @@ opts =
             <> metavar "URL"
             <> help "Alternative ghcup download info url"
             <> internal
+            <> completer fileUri
             )
           )
     <*> (fmap . fmap) not (invertableSwitch "verify" 'n' True (help "Disable tarball checksum verification (default: enabled)"))
@@ -134,6 +135,7 @@ opts =
           <> help
                "Keep build directories? (default: errors)"
           <> hidden
+          <> completer (listCompleter ["always", "errors", "never"])
           ))
     <*> optional (option
           (eitherReader downloaderParser)
@@ -148,6 +150,7 @@ opts =
           "Downloader to use (default: curl)"
 #endif
           <> hidden
+          <> completer (listCompleter ["curl", "wget"])
           ))
     <*> invertableSwitch "offline" 'o' False (help "Don't do any network calls, trying cached assets and failing if missing.")
     <*> optional (option
@@ -156,6 +159,7 @@ opts =
           <> metavar "<strict|lax|none>"
           <> help
           "GPG verification (default: none)"
+          <> completer (listCompleter ["strict", "lax", "none"])
           ))
     <*> com
  where
diff --git a/app/ghcup/GHCup/OptParse/Common.hs b/app/ghcup/GHCup/OptParse/Common.hs
index 1d04968..e4f7ca9 100644
--- a/app/ghcup/GHCup/OptParse/Common.hs
+++ b/app/ghcup/GHCup/OptParse/Common.hs
@@ -52,6 +52,7 @@ import           Haskus.Utils.Variant.Excepts
 import           Options.Applicative     hiding ( style )
 import           Prelude                 hiding ( appendFile )
 import           Safe
+import           System.Directory
 import           System.Process                  ( readProcess )
 import           System.FilePath
 import           Text.HTML.TagSoup       hiding ( Tag )
@@ -301,20 +302,34 @@ gpgParser s' | t == T.pack "strict" = Right GPGStrict
 toolCompleter :: Completer
 toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"]
 
-
 fileUri :: Completer
-fileUri = mkCompleter $ \case
-  "" -> pure ["https://", "http://", "file:///"]
+fileUri = mkCompleter fileUri'
+
+fileUri' :: String -> IO [String]
+fileUri' = \case
+  "" -> do
+    pwd <- getCurrentDirectory
+    pure ["https://", "http://", "file:///", "file://" <> pwd <> "/"]
   xs
-   | "file://" `isPrefixOf` xs -> fmap ("file://" <>) <$>
+   | "file:///" `isPrefixOf` xs -> fmap ("file://" <>) <$>
       case stripPrefix "file://" xs of
         Nothing -> pure []
         Just r ->  do
-          let cmd = unwords ["compgen", "-A", "file", "--", requote r]
-          result <- tryIO $ readProcess "bash" ["-c", cmd] ""
-          return . lines . either (const []) id $ result
+          pwd <- getCurrentDirectory
+          dirs  <- compgen "directory" r ["-S", "/"]
+          files <- filter (\f -> (f <> "/") `notElem` dirs) <$> compgen "file" r []
+          pure (dirs <> files <> if r `isPrefixOf` pwd then [pwd <> "/"] else [])
+   | xs `isPrefixOf` "file:///" -> pure ["file:///"]
+   | xs `isPrefixOf` "https://" -> pure ["https://"]
+   | xs `isPrefixOf` "http://"  -> pure ["http://"]
    | otherwise -> pure []
  where
+  compgen :: String -> String -> [String] -> IO [String]
+  compgen action' r opts = do
+    let cmd = unwords $ ["compgen", "-A", action'] <> opts <> ["--", requote r]
+    result <- tryIO $ readProcess "bash" ["-c", cmd] ""
+    return . lines . either (const []) id $ result
+
   -- | Strongly quote the string we pass to compgen.
   --
   -- We need to do this so bash doesn't expand out any ~ or other
@@ -459,8 +474,9 @@ versionCompleter criteria tool = listIOCompleter $ do
 
 toolDlCompleter :: Tool -> Completer
 toolDlCompleter tool = mkCompleter $ \case
-  "" -> pure $ initUrl tool
+  "" -> pure (initUrl tool <> ["https://", "http://", "file:///"])
   word
+    | "file://" `isPrefixOf` word -> fileUri' word
     -- downloads.haskell.org
     | "https://downloads.haskell.org/" `isPrefixOf` word ->
         fmap (completePrefix word) . prefixMatch (FP.takeFileName word) <$> fromHRef word
@@ -501,6 +517,10 @@ toolDlCompleter tool = mkCompleter $ \case
 
     | "h" `isPrefixOf` word -> pure $ initUrl tool
 
+    | word `isPrefixOf` "file:///" -> pure ["file:///"]
+    | word `isPrefixOf` "https://" -> pure ["https://"]
+    | word `isPrefixOf` "http://"  -> pure ["http://"]
+
     | otherwise -> pure []
  where
   initUrl :: Tool -> [String]