hie-bios 0.7.2 → 0.7.3
raw patch · 6 files changed
+137/−148 lines, 6 filesdep +optparse-applicativedep ~bytestringdep ~timePVP ok
version bump matches the API change (PVP)
Dependencies added: optparse-applicative
Dependency ranges changed: bytestring, time
API changes (from Hackage documentation)
Files
- ChangeLog.md +9/−0
- exe/Main.hs +59/−85
- hie-bios.cabal +4/−3
- src/HIE/Bios/Cradle.hs +63/−58
- src/HIE/Bios/Ghc/Check.hs +1/−1
- wrappers/cabal.hs +1/−1
ChangeLog.md view
@@ -1,5 +1,14 @@ # ChangeLog hie-bios +## 2021-01-29 - 0.7.3++* Set builddir for cabal [#264](https://github.com/mpickering/hie-bios/pull/264)+ * Essentially, change the build directory for cabal to the [`XDG_CACHE_HOME`](https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html)+ directory (e.g. `~/.cache/hie-bios/...`). This way, user+ invocations of cabal will no longer trigger a `configure` step, improving+ the overall developer experience.+* Optparse-applicative CLI [#276](https://github.com/mpickering/hie-bios/pull/276)+ ## 2020-12-16 - 0.7.2 * Faster Bios protocol [#271](https://github.com/mpickering/hie-bios/pull/271)
exe/Main.hs view
@@ -1,18 +1,14 @@-{-# LANGUAGE DeriveDataTypeable, LambdaCase #-}+{-# LANGUAGE LambdaCase #-} module Main where import Config (cProjectVersion) -import Control.Exception (Exception, Handler(..), ErrorCall(..))-import qualified Control.Exception as E import Control.Monad ( forM )-import Data.Typeable (Typeable) import Data.Version (showVersion)+import Options.Applicative import System.Directory (getCurrentDirectory)-import System.Environment (getArgs)-import System.Exit (exitFailure)-import System.IO (hPutStr, hPutStrLn, stdout, stderr, hSetEncoding, utf8)+import System.IO (stdout, hSetEncoding, utf8) import System.FilePath( (</>) ) import HIE.Bios@@ -25,99 +21,77 @@ progVersion :: String progVersion = "hie-bios version " ++ showVersion version ++ " compiled by GHC " ++ cProjectVersion ++ "\n" -ghcOptHelp :: String-ghcOptHelp = " [-g GHC_opt1 -g GHC_opt2 ...] "+data Command+ = Check { checkTargetFiles :: [FilePath] }+ | Flags { flagTargetFiles :: [FilePath] }+ | Debug { debugComponents :: FilePath }+ | ConfigInfo { configFiles :: [FilePath] }+ | CradleInfo { cradleFiles :: [FilePath] }+ | Root+ | Version -usage :: String-usage = progVersion- ++ "Usage:\n"- ++ "\t hie-bios check" ++ ghcOptHelp ++ "<HaskellFiles...>\n"- ++ "\t hie-bios expand <HaskellFiles...>\n"- ++ "\t hie-bios flags <HaskellFiles...>\n"- ++ "\t hie-bios debug [<ComponentDir>]\n"- ++ "\t hie-bios config <HaskellFiles...>\n"- ++ "\t hie-bios cradle <HaskellFiles...>\n"- ++ "\t hie-bios root\n"- ++ "\t hie-bios version\n" -----------------------------------------------------------------+filepathParser :: Parser [FilePath]+filepathParser = some (argument str ( metavar "TARGET_FILES...")) -data HhpcError = SafeList- | TooManyArguments String- | NotEnoughArguments String- | NoSuchCommand String- | CmdArg [String]- | FileNotExist String deriving (Show, Typeable)+progInfo :: ParserInfo Command+progInfo = info (progParser <**> helper)+ ( fullDesc+ <> progDesc "hie-bios is the way to specify how haskell-language-server and ghcide set up a GHC API session.\+ \Delivers the full set of flags to pass to GHC in order to build the project."+ <> header progVersion+ <> footer "You can report issues/contribute at https://github.com/mpickering/hie-bios") -instance Exception HhpcError+progParser :: Parser Command+progParser = subparser+ (command "check" (info (Check <$> filepathParser) (progDesc "Try to load modules into the GHC API."))+ <> command "flags" (info (Flags <$> filepathParser) (progDesc "Print out the options that hie-bios thinks you will need to load a file."))+ <> command "debug" (info (Debug <$> argument str ( metavar "TARGET_FILES...")) (progDesc "Print out the options that hie-bios thinks you will need to load a file."))+ <> command "config" (info (ConfigInfo <$> filepathParser) (progDesc "Print out the cradle config."))+ <> command "cradle" (info (CradleInfo <$> filepathParser) (progDesc "."))+ <> command "root" (info (pure Root) (progDesc "Display the path towards the selected hie.yaml."))+ <> command "version" (info (pure Version) (progDesc "Print version and exit."))+ ) + ---------------------------------------------------------------- main :: IO ()-main = flip E.catches handlers $ do+main = do hSetEncoding stdout utf8- args <- getArgs cwd <- getCurrentDirectory cradle <- -- find cradle does a takeDirectory on the argument, so make it into a file findCradle (cwd </> "File.hs") >>= \case Just yaml -> loadCradle yaml Nothing -> loadImplicitCradle (cwd </> "File.hs")- let cmdArg0 = args !. 0- remainingArgs = tail args- res <- case cmdArg0 of- "check" -> checkSyntax cradle remainingArgs- "debug"- | null remainingArgs -> debugInfo (cradleRootDir cradle) cradle- | (fp:_) <- remainingArgs -> debugInfo fp cradle- "root" -> rootInfo cradle- "version" -> return progVersion- "config" -> configInfo remainingArgs- "cradle" -> cradleInfo remainingArgs- "flags"- | null remainingArgs -> E.throw $ NotEnoughArguments cmdArg0- | otherwise -> do- res <- forM remainingArgs $ \fp -> do- res <- getCompilerOptions fp cradle- case res of- CradleFail (CradleError _deps _ex err) ->- return $ "Failed to show flags for \""- ++ fp- ++ "\": " ++ show err- CradleSuccess opts ->- return $ unlines ["Options: " ++ show (componentOptions opts)- ,"ComponentDir: " ++ (componentRoot opts)- ,"Dependencies: " ++ show (componentDependencies opts) ]- CradleNone -> return "No flags: this component should not be loaded"- return (unlines res) - "help" -> return usage- "--help" -> return usage- "-h" -> return usage+ cmd <- execParser progInfo - cmd -> E.throw (NoSuchCommand cmd)+ res <- case cmd of+ Check targetFiles -> checkSyntax cradle targetFiles+ Debug files -> case files of+ [] -> debugInfo (cradleRootDir cradle) cradle+ fp -> debugInfo fp cradle+ Flags files -> case files of+ -- TODO force optparse to acquire one+ [] -> error "too few arguments"+ _ -> do+ res <- forM files $ \fp -> do+ res <- getCompilerOptions fp cradle+ case res of+ CradleFail (CradleError _deps _ex err) ->+ return $ "Failed to show flags for \""+ ++ fp+ ++ "\": " ++ show err+ CradleSuccess opts ->+ return $ unlines ["Options: " ++ show (componentOptions opts)+ ,"ComponentDir: " ++ componentRoot opts+ ,"Dependencies: " ++ show (componentDependencies opts) ]+ CradleNone -> return $ "No flags/None Cradle: component " ++ fp ++ " should not be loaded"+ return (unlines res)+ ConfigInfo files -> configInfo files+ CradleInfo files -> cradleInfo files+ Root -> rootInfo cradle+ Version -> return progVersion putStr res- where- handlers = [Handler (handleThenExit handler1), Handler (handleThenExit handler2)]- handleThenExit handler e = handler e >> exitFailure- handler1 :: ErrorCall -> IO ()- handler1 = print -- for debug- handler2 :: HhpcError -> IO ()- handler2 SafeList = hPutStr stderr usage- handler2 (TooManyArguments cmd) =- hPutStrLn stderr $ "\"" ++ cmd ++ "\": Too many arguments"- handler2 (NotEnoughArguments cmd) = do- hPutStrLn stderr $ "\"" ++ cmd ++ "\": Not enough arguments"- hPutStrLn stderr ""- hPutStr stderr usage- handler2 (NoSuchCommand cmd) = do- hPutStrLn stderr $ "\"" ++ cmd ++ "\" not supported"- hPutStrLn stderr ""- hPutStr stderr usage- handler2 (CmdArg errs) =- mapM_ (hPutStr stderr) errs- handler2 (FileNotExist file) =- hPutStrLn stderr $ "\"" ++ file ++ "\" not found"- xs !. idx- | length xs <= idx = E.throw SafeList- | otherwise = xs !! idx
hie-bios.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: hie-bios-Version: 0.7.2+Version: 0.7.3 Author: Matthew Pickering <matthewtpickering@gmail.com> Maintainer: Matthew Pickering <matthewtpickering@gmail.com> License: BSD-3-Clause@@ -148,13 +148,13 @@ base >= 4.8 && < 5, aeson >= 1.4.5 && < 2, base16-bytestring >= 0.1.1 && < 1.1,- bytestring >= 0.10.8 && < 0.11,+ bytestring >= 0.10.8 && < 0.12, deepseq >= 1.4.3 && < 1.5, containers >= 0.5.10 && < 0.7, cryptohash-sha1 >= 0.11.100 && < 0.12, directory >= 1.3.0 && < 1.4, filepath >= 1.4.1 && < 1.5,- time >= 1.8.0 && < 1.10,+ time >= 1.8.0 && < 1.12, extra >= 1.6.14 && < 1.8, process >= 1.6.1 && < 1.7, ghc >= 8.4.1 && < 8.11,@@ -182,6 +182,7 @@ , filepath , ghc , hie-bios+ , optparse-applicative test-suite parser-tests type: exitcode-stdio-1.0
src/HIE/Bios/Cradle.hs view
@@ -26,6 +26,7 @@ import Control.Exception (handleJust) import qualified Data.Yaml as Yaml import Data.Void+import Data.Char (isSpace) import System.Process import System.Exit import HIE.Bios.Types hiding (ActionName(..))@@ -407,15 +408,14 @@ { actionName = Types.Cabal , runCradle = cabalAction wdir mc , runGhcCmd = \args -> do+ buildDir <- cabalBuildDir wdir -- Workaround for a cabal-install bug on 3.0.0.0: -- ./dist-newstyle/tmp/environment.-24811: createDirectory: does not exist (No such file or directory)- -- (It's ok to pass 'dist-newstyle' here, as it can only be changed- -- with the --builddir flag and not cabal.project, which we aren't- -- using in our call to v2-exec)- createDirectoryIfMissing True (wdir </> "dist-newstyle" </> "tmp")+ createDirectoryIfMissing True (buildDir </> "tmp") -- Need to pass -v0 otherwise we get "resolving dependencies..."+ wrapper_fp <- withCabalWrapperTool ("ghc", []) wdir readProcessWithCwd- wdir "cabal" (["v2-exec", "ghc", "-v0", "--"] ++ args) ""+ wdir "cabal" (["--builddir="<>buildDir,"v2-exec","--with-compiler", wrapper_fp, "ghc", "-v0", "--"] ++ args) "" } } @@ -464,40 +464,45 @@ -- | Generate a fake GHC that can be passed to cabal -- when run with --interactive, it will print out its -- command-line arguments and exit-withCabalWrapperTool :: GhcProc -> FilePath -> (FilePath -> IO a) -> IO a-withCabalWrapperTool (mbGhc, ghcArgs) wdir k = do- if isWindows- then do- cacheDir <- getCacheDir ""- let srcHash = show (fingerprintString cabalWrapperHs)- let wrapper_name = "wrapper-" ++ srcHash- let wrapper_fp = cacheDir </> wrapper_name <.> "exe"- exists <- doesFileExist wrapper_fp- unless exists $ withSystemTempDirectory "hie-bios" $ \ tmpDir -> do+withCabalWrapperTool :: GhcProc -> FilePath -> IO FilePath+withCabalWrapperTool (mbGhc, ghcArgs) wdir = do+ cacheDir <- getCacheDir ""+ let wrapperContents = if isWindows then cabalWrapperHs else cabalWrapper+ suffix fp = if isWindows then fp <.> "exe" else fp+ let srcHash = show (fingerprintString wrapperContents)+ let wrapper_name = "wrapper-" ++ srcHash+ let wrapper_fp = suffix $ cacheDir </> wrapper_name+ exists <- doesFileExist wrapper_fp+ unless exists $+ if isWindows+ then do+ withSystemTempDirectory "hie-bios" $ \ tmpDir -> do createDirectoryIfMissing True cacheDir let wrapper_hs = cacheDir </> wrapper_name <.> "hs"- writeFile wrapper_hs cabalWrapperHs+ writeFile wrapper_hs wrapperContents let ghc = (proc mbGhc $ ghcArgs ++ ["-rtsopts=ignore", "-outputdir", tmpDir, "-o", wrapper_fp, wrapper_hs]) { cwd = Just wdir } readCreateProcess ghc "" >>= putStr- setMode wrapper_fp- k wrapper_fp- else withSystemTempFile "bios-wrapper"- (\loc h -> do- hPutStr h cabalWrapper- hClose h- setMode loc- k loc)-+ else withFile wrapper_fp WriteMode $ \h -> hPutStr h wrapperContents+ setMode wrapper_fp+ pure wrapper_fp where setMode wrapper_fp = setFileMode wrapper_fp accessModes +-- | Given the root directory, get the build dir we are using for cabal+-- In the `hie-bios` cache directory+cabalBuildDir :: FilePath -> IO FilePath+cabalBuildDir work_dir = do+ abs_work_dir <- makeAbsolute work_dir+ let dirHash = show (fingerprintString abs_work_dir)+ getCacheDir ("dist-"<>filter (not . isSpace) (takeBaseName abs_work_dir)<>"-"<>dirHash) cabalAction :: FilePath -> Maybe String -> LoggingFunction -> FilePath -> IO (CradleLoadResult ComponentOptions) cabalAction work_dir mc l fp = do- withCabalWrapperTool ("ghc", []) work_dir $ \wrapper_fp -> do- let cab_args = ["v2-repl", "--with-compiler", wrapper_fp, fromMaybe (fixTargetPath fp) mc]+ wrapper_fp <- withCabalWrapperTool ("ghc", []) work_dir+ buildDir <- cabalBuildDir work_dir+ let cab_args = ["--builddir="<>buildDir,"v2-repl", "--with-compiler", wrapper_fp, fromMaybe (fixTargetPath fp) mc] (ex, output, stde, [(_,mb_args)]) <- readProcessWithOutputs [hie_bios_output] l work_dir (proc "cabal" cab_args) let args = fromMaybe [] mb_args@@ -622,38 +627,38 @@ stackAction work_dir mc syaml l _fp = do let ghcProcArgs = ("stack", stackYamlProcessArgs syaml <> ["exec", "ghc", "--"]) -- Same wrapper works as with cabal- withCabalWrapperTool ghcProcArgs work_dir $ \wrapper_fp -> do- (ex1, _stdo, stde, [(_, mb_args)]) <-- readProcessWithOutputs [hie_bios_output] l work_dir $- stackProcess syaml- $ ["repl", "--no-nix-pure", "--with-ghc", wrapper_fp]- <> [ comp | Just comp <- [mc] ]- (ex2, pkg_args, stdr, _) <-- readProcessWithOutputs [hie_bios_output] l work_dir $- stackProcess syaml ["path", "--ghc-package-path"]- let split_pkgs = concatMap splitSearchPath pkg_args- pkg_ghc_args = concatMap (\p -> ["-package-db", p] ) split_pkgs- args = fromMaybe [] mb_args- case processCabalWrapperArgs args of- Nothing -> do- -- Best effort. Assume the working directory is the- -- the root of the component, so we are right in trivial cases at least.- deps <- stackCradleDependencies work_dir work_dir syaml- pure $ CradleFail- (CradleError deps ex1 $- [ "Failed to parse result of calling stack" ]- ++ stde- ++ args- )+ wrapper_fp <- withCabalWrapperTool ghcProcArgs work_dir+ (ex1, _stdo, stde, [(_, mb_args)]) <-+ readProcessWithOutputs [hie_bios_output] l work_dir $+ stackProcess syaml+ $ ["repl", "--no-nix-pure", "--with-ghc", wrapper_fp]+ <> [ comp | Just comp <- [mc] ]+ (ex2, pkg_args, stdr, _) <-+ readProcessWithOutputs [hie_bios_output] l work_dir $+ stackProcess syaml ["path", "--ghc-package-path"]+ let split_pkgs = concatMap splitSearchPath pkg_args+ pkg_ghc_args = concatMap (\p -> ["-package-db", p] ) split_pkgs+ args = fromMaybe [] mb_args+ case processCabalWrapperArgs args of+ Nothing -> do+ -- Best effort. Assume the working directory is the+ -- the root of the component, so we are right in trivial cases at least.+ deps <- stackCradleDependencies work_dir work_dir syaml+ pure $ CradleFail+ (CradleError deps ex1 $+ [ "Failed to parse result of calling stack" ]+ ++ stde+ ++ args+ ) - Just (componentDir, ghc_args) -> do- deps <- stackCradleDependencies work_dir componentDir syaml- pure $ makeCradleResult- ( combineExitCodes [ex1, ex2]- , stde ++ stdr, componentDir- , ghc_args ++ pkg_ghc_args- )- deps+ Just (componentDir, ghc_args) -> do+ deps <- stackCradleDependencies work_dir componentDir syaml+ pure $ makeCradleResult+ ( combineExitCodes [ex1, ex2]+ , stde ++ stdr, componentDir+ , ghc_args ++ pkg_ghc_args+ )+ deps stackProcess :: StackYaml -> [String] -> CreateProcess stackProcess syaml args = proc "stack" $ stackYamlProcessArgs syaml <> args
src/HIE/Bios/Ghc/Check.hs view
@@ -41,7 +41,7 @@ where handleRes (CradleSuccess x) f = f x handleRes (CradleFail ce) _f = liftIO $ throwIO ce - handleRes CradleNone _f = return "No cradle"+ handleRes CradleNone _f = return "None cradle" ----------------------------------------------------------------
wrappers/cabal.hs view
@@ -9,9 +9,9 @@ main :: IO () main = do args <- getArgs- output_file <- getEnv "HIE_BIOS_OUTPUT" case args of "--interactive":_ -> do+ output_file <- getEnv "HIE_BIOS_OUTPUT" h <- openFile output_file AppendMode getCurrentDirectory >>= hPutStrLn h mapM_ (hPutStrLn h) args