hie-bios 0.19.0 → 0.20.0
raw patch · 26 files changed
+1152/−602 lines, 26 filesdep +containersdep ~aesondep ~ghcdep ~timePVP ok
version bump matches the API change (PVP)
Dependencies added: containers
Dependency ranges changed: aeson, ghc, time
API changes (from Hackage documentation)
- HIE.Bios.Config.YAML: instance Data.Aeson.Types.FromJSON.FromJSON component => Data.Aeson.Types.FromJSON.FromJSON (HIE.Bios.Config.YAML.OneOrManyComponents component)
- HIE.Bios.Types: LoadWithContext :: [FilePath] -> LoadStyle
- HIE.Bios.Types: LogComputedCradleLoadStyle :: !Text -> !LoadStyle -> Log
- HIE.Bios.Types: LogLoadWithContextUnsupported :: !Text -> !Maybe Text -> Log
- HIE.Bios.Types: LogRequestedCradleLoadStyle :: !Text -> !LoadStyle -> Log
- HIE.Bios.Types: data LoadStyle
- HIE.Bios.Types: instance GHC.Classes.Eq HIE.Bios.Types.LoadStyle
- HIE.Bios.Types: instance GHC.Classes.Ord HIE.Bios.Types.LoadStyle
- HIE.Bios.Types: instance GHC.Show.Show HIE.Bios.Types.LoadStyle
+ HIE.Bios.Config: cabalComponentsToLoad :: CabalType -> Maybe [String]
+ HIE.Bios.Config: stackComponentsToLoad :: StackType -> Maybe [String]
+ HIE.Bios.Config.YAML: [cabalComponentsToLoad] :: CabalConfig -> Maybe [String]
+ HIE.Bios.Config.YAML: [stackComponentsToLoad] :: StackConfig -> Maybe [String]
+ HIE.Bios.Config.YAML: instance Data.Aeson.Types.FromJSON.FromJSON a => Data.Aeson.Types.FromJSON.FromJSON (HIE.Bios.Config.YAML.OneOrManyComponents a)
+ HIE.Bios.Cradle.Cabal: instance GHC.Classes.Eq HIE.Bios.Cradle.Cabal.LoadUnits
+ HIE.Bios.Cradle.Resolved: instance GHC.Base.Functor HIE.Bios.Cradle.Resolved.ConcreteCradle
+ HIE.Bios.Cradle.Resolved: instance GHC.Base.Functor HIE.Bios.Cradle.Resolved.ResolvedCradle
+ HIE.Bios.Environment: extractUnits :: [String] -> ([String], [String])
+ HIE.Bios.Ghc.Gap: InsideRTS :: InRTS
+ HIE.Bios.Ghc.Gap: OutsideRTS :: InRTS
+ HIE.Bios.Ghc.Gap: data InRTS
+ HIE.Bios.Ghc.Gap: initMulti :: NonEmpty String -> (DynFlags -> [(String, Maybe Phase)] -> [String] -> [String] -> IO ()) -> Ghc [(String, Maybe UnitId, Maybe Phase)]
+ HIE.Bios.Ghc.Gap: removeRTS :: [String] -> [String]
+ HIE.Bios.Ghc.Gap: typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule
+ HIE.Bios.Types: LoadFileWithContext :: LoadMode
+ HIE.Bios.Types: LoadUnitsFromCradle :: LoadMode
+ HIE.Bios.Types: LoadUnitsInferred :: LoadMode
+ HIE.Bios.Types: LogComputedCradleLoadMode :: !Text -> !TargetWithContext -> !LoadMode -> Log
+ HIE.Bios.Types: LogLoadModeUnsupported :: !Text -> LoadMode -> !Maybe Text -> Log
+ HIE.Bios.Types: LogRequestedCradleLoadMode :: !Text -> !TargetWithContext -> !LoadMode -> Log
+ HIE.Bios.Types: TargetWithContext :: !FilePath -> ![FilePath] -> TargetWithContext
+ HIE.Bios.Types: [targetContext] :: TargetWithContext -> ![FilePath]
+ HIE.Bios.Types: [targetFilePath] :: TargetWithContext -> !FilePath
+ HIE.Bios.Types: data LoadMode
+ HIE.Bios.Types: data TargetWithContext
+ HIE.Bios.Types: instance GHC.Classes.Eq HIE.Bios.Types.LoadMode
+ HIE.Bios.Types: instance GHC.Classes.Ord HIE.Bios.Types.LoadMode
+ HIE.Bios.Types: instance GHC.Enum.Bounded HIE.Bios.Types.LoadMode
+ HIE.Bios.Types: instance GHC.Enum.Enum HIE.Bios.Types.LoadMode
+ HIE.Bios.Types: instance GHC.Show.Show HIE.Bios.Types.LoadMode
+ HIE.Bios.Types: instance GHC.Show.Show HIE.Bios.Types.TargetWithContext
+ HIE.Bios.Types: instance Prettyprinter.Internal.Pretty HIE.Bios.Types.LoadMode
+ HIE.Bios.Types: instance Prettyprinter.Internal.Pretty HIE.Bios.Types.TargetWithContext
+ HIE.Bios.Types: singleTarget :: FilePath -> TargetWithContext
+ HIE.Bios.Types: targetAndContext :: TargetWithContext -> [FilePath]
+ HIE.Bios.Types: type Component = String
- HIE.Bios: getCompilerOptions :: FilePath -> LoadStyle -> Cradle a -> IO (CradleLoadResult ComponentOptions)
+ HIE.Bios: getCompilerOptions :: TargetWithContext -> LoadMode -> Cradle a -> IO (CradleLoadResult ComponentOptions)
- HIE.Bios.Config: pattern CabalType :: Maybe String -> Maybe FilePath -> CabalType
+ HIE.Bios.Config: pattern CabalType :: Maybe String -> Maybe FilePath -> Maybe [String] -> CabalType
- HIE.Bios.Config: pattern StackType :: Maybe String -> Maybe FilePath -> StackType
+ HIE.Bios.Config: pattern StackType :: Maybe String -> Maybe FilePath -> Maybe [String] -> StackType
- HIE.Bios.Config.YAML: CabalConfig :: Maybe FilePath -> OneOrManyComponents CabalComponent -> CabalConfig
+ HIE.Bios.Config.YAML: CabalConfig :: Maybe FilePath -> Maybe [String] -> OneOrManyComponents CabalComponent -> CabalConfig
- HIE.Bios.Config.YAML: StackConfig :: Maybe FilePath -> OneOrManyComponents StackComponent -> StackConfig
+ HIE.Bios.Config.YAML: StackConfig :: Maybe FilePath -> Maybe [String] -> OneOrManyComponents StackComponent -> StackConfig
- HIE.Bios.Cradle.Cabal: cabalAction :: ResolvedCradles a -> FilePath -> Maybe String -> LogAction IO (WithSeverity Log) -> CradleProjectConfig -> FilePath -> LoadStyle -> CradleLoadResultT IO ComponentOptions
+ HIE.Bios.Cradle.Cabal: cabalAction :: ResolvedCradles a -> FilePath -> Maybe String -> LogAction IO (WithSeverity Log) -> CradleProjectConfig -> TargetWithContext -> LoadMode -> CradleLoadResultT IO ComponentOptions
- HIE.Bios.Flags: getCompilerOptions :: FilePath -> LoadStyle -> Cradle a -> IO (CradleLoadResult ComponentOptions)
+ HIE.Bios.Flags: getCompilerOptions :: TargetWithContext -> LoadMode -> Cradle a -> IO (CradleLoadResult ComponentOptions)
- HIE.Bios.Internal.Debug: debugInfo :: Show a => FilePath -> LoadStyle -> Cradle a -> IO String
+ HIE.Bios.Internal.Debug: debugInfo :: Show a => TargetWithContext -> LoadMode -> Cradle a -> IO String
- HIE.Bios.Types: CradleAction :: ActionName a -> (FilePath -> LoadStyle -> IO (CradleLoadResult ComponentOptions)) -> ([String] -> IO (CradleLoadResult String)) -> CradleAction a
+ HIE.Bios.Types: CradleAction :: ActionName a -> (TargetWithContext -> LoadMode -> IO (CradleLoadResult ComponentOptions)) -> ([String] -> IO (CradleLoadResult String)) -> CradleAction a
- HIE.Bios.Types: LoadFile :: LoadStyle
+ HIE.Bios.Types: LoadFile :: LoadMode
- HIE.Bios.Types: [runCradle] :: CradleAction a -> FilePath -> LoadStyle -> IO (CradleLoadResult ComponentOptions)
+ HIE.Bios.Types: [runCradle] :: CradleAction a -> TargetWithContext -> LoadMode -> IO (CradleLoadResult ComponentOptions)
Files
- ChangeLog.md +9/−0
- README.md +39/−0
- exe/Main.hs +21/−15
- hie-bios.cabal +250/−241
- src/HIE/Bios/Config.hs +36/−21
- src/HIE/Bios/Config/YAML.hs +20/−13
- src/HIE/Bios/Cradle.hs +96/−56
- src/HIE/Bios/Cradle/Cabal.hs +72/−11
- src/HIE/Bios/Cradle/Resolved.hs +3/−3
- src/HIE/Bios/Cradle/Utils.hs +2/−31
- src/HIE/Bios/Environment.hs +78/−16
- src/HIE/Bios/Flags.hs +5/−7
- src/HIE/Bios/Ghc/Api.hs +1/−1
- src/HIE/Bios/Ghc/Gap.hs +141/−1
- src/HIE/Bios/Ghc/Load.hs +1/−1
- src/HIE/Bios/Internal/Debug.hs +5/−4
- src/HIE/Bios/Types.hs +45/−16
- tests/BiosTests.hs +189/−78
- tests/ParserTests.hs +46/−29
- tests/Utils.hs +66/−57
- tests/configs/cabal-with-load.yaml +3/−0
- tests/configs/multi-cabal-with-load.yaml +9/−0
- tests/configs/multi-stack-with-load.yaml +9/−0
- tests/configs/single-components.yaml +2/−0
- tests/configs/stack-with-load.yaml +3/−0
- tests/projects/multi-cabal/multi-cabal.cabal +1/−1
ChangeLog.md view
@@ -1,5 +1,14 @@ # ChangeLog hie-bios +## 2026-06-30 - 0.20.0++* Hide LoadMode in TestM ([#516](https://github.com/haskell/hie-bios/pull/516))+* "componentsToLoad" field ([#515](https://github.com/haskell/hie-bios/pull/515))+* Fail hard if component(s) field have wrong type ([#513](https://github.com/haskell/hie-bios/pull/513))+* Allow to build with GHC 10.1 ([#510](https://github.com/haskell/hie-bios/pull/510))+* New Load Modes for upfront loading of cradle/project ([#508](https://github.com/haskell/hie-bios/pull/508))+ * Implement full project loading+ ## 2026-04-15 - 0.19.0 * Pass --builddir to avoid clobbering dist-newstyle ([#503](https://github.com/haskell/hie-bios/pull/503))
README.md view
@@ -552,6 +552,33 @@ , { path: "./tests", component: "parser-tests" } ] } } ``` +## Selecting which components to load++For `cabal` and `stack` cradles, `hie-bios` supports asking for flags to load+the components in the cradle at once. This is much faster than loading+components on-demand at the cost of more memory usage if a component isn't+actually needed. Support is conditional on underlying tool versions, and+`hie-bios` will fall back to legacy loading otherwise.++The optional field `componentsToLoad` specifies which components should be loaded together, it defaults to all the explicitly listed components.++```yaml+cradle:+ cabal:+ componentsToLoad: ["lib:foo"]+ components:+ - {"path": "./src", "component": "lib:foo"}+ - {"path": "./app", "component": "exe:foo"}+```++The elements of `componentsToLoad` do not need to be also listed as individual components, though doing so might improve dependency tracking.++```yaml+cradle:+ stack:+ componentsToLoad: ["foo:lib","foo:exe"]+```+ ## Cradle Dependencies Sometimes it is necessary to reload a component, for example when a package@@ -609,9 +636,21 @@ ```yaml cradle: cabal:+ cabalProject: "optional path to project description"+ componentsToLoad: ["cabal target1","cabal target2"]+ -- one or none of the following component: "optional component name"+ components:+ - path: "path to package dir"+ component: "cabal target" stack:+ stackYaml: "optional path to stack yaml file"+ componentsToLoad: ["stack target1","stack target2"]+ -- one or none of the following component: "optional component name"+ components:+ - path: "path to package dir"+ component: "stack target" bios: program: "program to run" dependency-program: "optional program to run"
exe/Main.hs view
@@ -16,7 +16,7 @@ import HIE.Bios.Ghc.Check import HIE.Bios.Ghc.Gap as Gap import HIE.Bios.Internal.Debug-import HIE.Bios.Types (LoadStyle(..))+import HIE.Bios.Types (LoadMode(..), TargetWithContext (..), singleTarget) import Paths_hie_bios import Data.Void (Void) import Data.Function@@ -26,9 +26,11 @@ progVersion :: String progVersion = "hie-bios version " ++ showVersion version ++ " compiled by GHC " ++ Gap.ghcVersion ++ "\n" -data UseLoadStyle+data UseLoadMode = UseSingleFile | UseMultiFile+ | UseUnitsInferred+ | UseUnitsFromCradle data Cli = Cli { logLevel :: Maybe L.Severity@@ -38,7 +40,7 @@ data Command = Check { checkTargetFiles :: [FilePath] } | Flags { flagTargetFiles :: [FilePath] }- | Debug { debugUseMultiLoadStyle :: UseLoadStyle, debugComponents :: [FilePath] }+ | Debug { debugUseMultiLoadMode :: UseLoadMode, debugComponents :: [FilePath] } | ConfigInfo { configFiles :: [FilePath] } | CradleInfo { cradleFiles :: [FilePath] } | Root@@ -69,16 +71,18 @@ progParser = hsubparser (command "check" (info (Check <$> some filepathParser) (progDesc "Try to load modules into the GHC API.")) <> command "flags" (info (Flags <$> some filepathParser) (progDesc "Print out the options that hie-bios thinks you will need to load a file."))- <> command "debug" (info (Debug <$> loadStyleParser <*> many filepathParser) (progDesc "Print out the options that hie-bios thinks you will need to load a file."))+ <> command "debug" (info (Debug <$> loadModeParser <*> many filepathParser) (progDesc "Print out the options that hie-bios thinks you will need to load a file.")) <> command "config" (info (ConfigInfo <$> some filepathParser) (progDesc "Print out the cradle config location.")) <> command "cradle" (info (CradleInfo <$> some filepathParser) (progDesc "Print out only the cradle type.")) <> command "root" (info (pure Root) (progDesc "Display the path towards the selected hie.yaml.")) <> command "version" (info (pure Version) (progDesc "Print version and exit.")) ) -loadStyleParser :: Parser UseLoadStyle-loadStyleParser =+loadModeParser :: Parser UseLoadMode+loadModeParser = flag UseSingleFile UseMultiFile (long "multi" <> help "Load all targets in bulk if supported")+ <|> flag UseSingleFile UseUnitsInferred (long "inferred-units" <> help "Load all units in bulk if supported")+ <|> flag UseSingleFile UseUnitsFromCradle (long "cradle-units" <> help "Load all units from cradle components in bulk if supported") ---------------------------------------------------------------- @@ -112,7 +116,7 @@ [] -> error "too few arguments" _ -> do res <- forM files $ \fp -> do- res <- getCompilerOptions fp LoadFile cradle+ res <- getCompilerOptions (TargetWithContext fp []) LoadFile cradle case res of CradleFail (CradleError _deps _ex err _fps) -> return $ "Failed to show flags for \""@@ -130,15 +134,17 @@ Version -> return progVersion putStr res -debugFiles :: [FilePath] -> UseLoadStyle -> Cradle Void -> IO String-debugFiles fps useLoadStyle cradle = case useLoadStyle of+debugFiles :: [FilePath] -> UseLoadMode -> Cradle Void -> IO String+debugFiles fps useLoadMode cradle = case useLoadMode of UseSingleFile -> debugSingle- UseMultiFile -> debugBulk+ UseMultiFile -> debugBulk LoadFileWithContext+ UseUnitsInferred -> debugBulk LoadUnitsInferred+ UseUnitsFromCradle -> debugBulk LoadUnitsFromCradle where debugSingle = case fps of- [] -> debugInfo (cradleRootDir cradle) LoadFile cradle- _ -> concat <$> traverse (\fp -> debugInfo fp LoadFile cradle) fps+ [] -> debugInfo (singleTarget $ cradleRootDir cradle) LoadFile cradle+ _ -> concat <$> traverse (\fp -> debugInfo (singleTarget fp) LoadFile cradle) fps - debugBulk = case fps of- [] -> debugInfo (cradleRootDir cradle) (LoadWithContext []) cradle- fp:otherFps -> debugInfo fp (LoadWithContext otherFps) cradle+ debugBulk mode = case fps of+ [] -> debugInfo (TargetWithContext (cradleRootDir cradle) []) mode cradle+ fp:otherFps -> debugInfo (TargetWithContext fp otherFps) mode cradle
hie-bios.cabal view
@@ -1,266 +1,275 @@-Cabal-Version: 2.2-Name: hie-bios-Version: 0.19.0-Author: Matthew Pickering <matthewtpickering@gmail.com>, Hannes Siebenhandl <fendor.haskell@gmail.com>-Maintainer: Hannes Siebenhandl <fendor.haskell@gmail.com>-License: BSD-3-Clause-License-File: LICENSE-Homepage: https://github.com/haskell/hie-bios-Synopsis: Set up a GHC API session-Description: Set up a GHC API session and obtain flags required to compile a source file--Category: Development-Build-Type: Simple--- No glob syntax until GHC 8.6 because of stack-extra-doc-files: ChangeLog.md-Extra-Source-Files: README.md- wrappers/cabal- wrappers/cabal-with-repl- wrappers/cabal.hs- wrappers/cabal-with-repl.hs- tests/configs/*.yaml- tests/projects/cabal-with-ghc/cabal-with-ghc.cabal- tests/projects/cabal-with-ghc/cabal.project- tests/projects/cabal-with-ghc/hie.yaml- tests/projects/cabal-with-ghc/src/MyLib.hs- tests/projects/cabal-with-ghc-and-project/cabal-with-ghc.cabal- tests/projects/cabal-with-ghc-and-project/cabal.project.extra- tests/projects/cabal-with-ghc-and-project/hie.yaml- tests/projects/cabal-with-ghc-and-project/src/MyLib.hs- tests/projects/cabal-with-project/cabal-with-project.cabal- tests/projects/cabal-with-project/cabal.project.extra- tests/projects/cabal-with-project/hie.yaml- tests/projects/cabal-with-project/src/MyLib.hs- tests/projects/symlink-test/a/A.hs- tests/projects/symlink-test/hie.yaml- tests/projects/deps-bios-new/A.hs- tests/projects/deps-bios-new/B.hs- tests/projects/deps-bios-new/hie-bios.sh- tests/projects/deps-bios-new/hie.yaml- tests/projects/multi-direct/A.hs- tests/projects/multi-direct/B.hs- tests/projects/multi-direct/hie.yaml- tests/projects/multi-cabal/app/Main.hs- tests/projects/multi-cabal/cabal.project- tests/projects/multi-cabal/hie.yaml- tests/projects/multi-cabal/multi-cabal.cabal- tests/projects/multi-cabal/src/Lib.hs- tests/projects/multi-cabal-with-project/appA/appA.cabal- tests/projects/multi-cabal-with-project/appA/src/Lib.hs- tests/projects/multi-cabal-with-project/appB/appB.cabal- tests/projects/multi-cabal-with-project/appB/src/Lib.hs- tests/projects/multi-cabal-with-project/cabal.project.extra- tests/projects/multi-cabal-with-project/hie.yaml- tests/projects/monorepo-cabal/cabal.project- tests/projects/monorepo-cabal/hie.yaml- tests/projects/monorepo-cabal/A/Main.hs- tests/projects/monorepo-cabal/A/A.cabal- tests/projects/monorepo-cabal/B/MyLib.hs- tests/projects/monorepo-cabal/B/B.cabal- tests/projects/multi-stack/app/Main.hs- tests/projects/multi-stack/cabal.project- tests/projects/multi-stack/hie.yaml- tests/projects/multi-stack/multi-stack.cabal- tests/projects/multi-stack/src/Lib.hs- tests/projects/failing-bios/A.hs- tests/projects/failing-bios/B.hs- tests/projects/failing-bios/hie.yaml- tests/projects/failing-bios-ghc/A.hs- tests/projects/failing-bios-ghc/B.hs- tests/projects/failing-bios-ghc/hie.yaml- tests/projects/failing-cabal/failing-cabal.cabal- tests/projects/failing-cabal/hie.yaml- tests/projects/failing-cabal/MyLib.hs- tests/projects/failing-stack/failing-stack.cabal- tests/projects/failing-stack/hie.yaml- tests/projects/failing-stack/src/Lib.hs- tests/projects/nested-cabal/nested-cabal.cabal- tests/projects/nested-cabal/cabal.project- tests/projects/nested-cabal/hie.yaml- tests/projects/nested-cabal/MyLib.hs- tests/projects/nested-cabal/sub-comp/sub-comp.cabal- tests/projects/nested-cabal/sub-comp/Lib.hs- tests/projects/nested-stack/nested-stack.cabal- tests/projects/nested-stack/hie.yaml- tests/projects/nested-stack/MyLib.hs- tests/projects/nested-stack/sub-comp/sub-comp.cabal- tests/projects/nested-stack/sub-comp/Lib.hs- tests/projects/simple-bios/A.hs- tests/projects/simple-bios/B.hs- tests/projects/simple-bios/hie-bios.sh- tests/projects/simple-bios/hie-bios-deps.sh- tests/projects/simple-bios/hie.yaml- tests/projects/simple-bios-ghc/A.hs- tests/projects/simple-bios-ghc/B.hs- tests/projects/simple-bios-ghc/hie-bios.sh- tests/projects/simple-bios-ghc/hie.yaml- tests/projects/simple-bios-shell/A.hs- tests/projects/simple-bios-shell/B.hs- tests/projects/simple-bios-shell/hie.yaml- tests/projects/simple-cabal/A.hs- tests/projects/simple-cabal/B.hs- tests/projects/simple-cabal/cabal.project- tests/projects/simple-cabal/hie.yaml- tests/projects/simple-cabal/simple-cabal.cabal- tests/projects/simple-direct/A.hs- tests/projects/simple-direct/B.hs- tests/projects/simple-direct/hie.yaml- tests/projects/simple-stack/A.hs- tests/projects/simple-stack/B.hs- tests/projects/simple-stack/cabal.project- tests/projects/simple-stack/hie.yaml- tests/projects/simple-stack/simple-stack.cabal- "tests/projects/space stack/A.hs"- "tests/projects/space stack/B.hs"- "tests/projects/space stack/hie.yaml"- "tests/projects/space stack/stackproj.cabal"- tests/projects/implicit-cabal/cabal.project- tests/projects/implicit-cabal/implicit-cabal.cabal- tests/projects/implicit-cabal/Main.hs- tests/projects/implicit-cabal-no-project/implicit-cabal-no-project.cabal- tests/projects/implicit-cabal-no-project/Main.hs- tests/projects/implicit-cabal-deep-project/README- tests/projects/implicit-cabal-deep-project/implicit-cabal-deep-project.cabal- tests/projects/implicit-cabal-deep-project/Main.hs- tests/projects/implicit-cabal-deep-project/cabal.project- tests/projects/implicit-cabal-deep-project/foo/foo.cabal- tests/projects/implicit-cabal-deep-project/foo/Main.hs- tests/projects/implicit-stack/implicit-stack.cabal- tests/projects/implicit-stack/Main.hs- tests/projects/implicit-stack-multi/implicit-stack-multi.cabal- tests/projects/implicit-stack-multi/Main.hs- tests/projects/implicit-stack-multi/other-package/other-package.cabal- tests/projects/implicit-stack-multi/other-package/Main.hs- tests/projects/multi-stack-with-yaml/appA/appA.cabal- tests/projects/multi-stack-with-yaml/appA/src/Lib.hs- tests/projects/multi-stack-with-yaml/appB/appB.cabal- tests/projects/multi-stack-with-yaml/appB/src/Lib.hs- tests/projects/multi-stack-with-yaml/hie.yaml- tests/projects/stack-with-yaml/app/Main.hs- tests/projects/stack-with-yaml/hie.yaml- tests/projects/stack-with-yaml/stack-with-yaml.cabal- tests/projects/stack-with-yaml/src/Lib.hs- tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/app/Main.hs- tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/multi-repl-cabal-fail.cabal- tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Fail.hs- tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Lib.hs- tests/projects/failing-multi-repl-cabal-project/NotInPath.hs+cabal-version: 2.2+name: hie-bios+version: 0.20.0+author: Matthew Pickering <matthewtpickering@gmail.com>, Hannes Siebenhandl <fendor.haskell@gmail.com>+maintainer: Hannes Siebenhandl <fendor.haskell@gmail.com>+license: BSD-3-Clause+license-file: LICENSE+homepage: https://github.com/haskell/hie-bios+synopsis: Set up a GHC API session+description: Set up a GHC API session and obtain flags required to compile a source file+category: Development+build-type: Simple+extra-doc-files: ChangeLog.md+extra-source-files:+ README.md+ tests/configs/*.yaml+ tests/projects/cabal-with-ghc-and-project/cabal-with-ghc.cabal+ tests/projects/cabal-with-ghc-and-project/cabal.project.extra+ tests/projects/cabal-with-ghc-and-project/hie.yaml+ tests/projects/cabal-with-ghc-and-project/src/MyLib.hs+ tests/projects/cabal-with-ghc/cabal-with-ghc.cabal+ tests/projects/cabal-with-ghc/cabal.project+ tests/projects/cabal-with-ghc/hie.yaml+ tests/projects/cabal-with-ghc/src/MyLib.hs+ tests/projects/cabal-with-project/cabal-with-project.cabal+ tests/projects/cabal-with-project/cabal.project.extra+ tests/projects/cabal-with-project/hie.yaml+ tests/projects/cabal-with-project/src/MyLib.hs+ tests/projects/deps-bios-new/A.hs+ tests/projects/deps-bios-new/B.hs+ tests/projects/deps-bios-new/hie-bios.sh+ tests/projects/deps-bios-new/hie.yaml+ tests/projects/failing-bios-ghc/A.hs+ tests/projects/failing-bios-ghc/B.hs+ tests/projects/failing-bios-ghc/hie.yaml+ tests/projects/failing-bios/A.hs+ tests/projects/failing-bios/B.hs+ tests/projects/failing-bios/hie.yaml+ tests/projects/failing-cabal/failing-cabal.cabal+ tests/projects/failing-cabal/hie.yaml+ tests/projects/failing-cabal/MyLib.hs+ tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/app/Main.hs+ tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/multi-repl-cabal-fail.cabal+ tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Fail.hs+ tests/projects/failing-multi-repl-cabal-project/multi-repl-cabal-fail/src/Lib.hs+ tests/projects/failing-multi-repl-cabal-project/NotInPath.hs+ tests/projects/failing-stack/failing-stack.cabal+ tests/projects/failing-stack/hie.yaml+ tests/projects/failing-stack/src/Lib.hs+ tests/projects/implicit-cabal-deep-project/cabal.project+ tests/projects/implicit-cabal-deep-project/foo/foo.cabal+ tests/projects/implicit-cabal-deep-project/foo/Main.hs+ tests/projects/implicit-cabal-deep-project/implicit-cabal-deep-project.cabal+ tests/projects/implicit-cabal-deep-project/Main.hs+ tests/projects/implicit-cabal-deep-project/README+ tests/projects/implicit-cabal-no-project/implicit-cabal-no-project.cabal+ tests/projects/implicit-cabal-no-project/Main.hs+ tests/projects/implicit-cabal/cabal.project+ tests/projects/implicit-cabal/implicit-cabal.cabal+ tests/projects/implicit-cabal/Main.hs+ tests/projects/implicit-stack-multi/implicit-stack-multi.cabal+ tests/projects/implicit-stack-multi/Main.hs+ tests/projects/implicit-stack-multi/other-package/Main.hs+ tests/projects/implicit-stack-multi/other-package/other-package.cabal+ tests/projects/implicit-stack/implicit-stack.cabal+ tests/projects/implicit-stack/Main.hs+ tests/projects/monorepo-cabal/A/A.cabal+ tests/projects/monorepo-cabal/A/Main.hs+ tests/projects/monorepo-cabal/B/B.cabal+ tests/projects/monorepo-cabal/B/MyLib.hs+ tests/projects/monorepo-cabal/cabal.project+ tests/projects/monorepo-cabal/hie.yaml+ tests/projects/multi-cabal-with-project/appA/appA.cabal+ tests/projects/multi-cabal-with-project/appA/src/Lib.hs+ tests/projects/multi-cabal-with-project/appB/appB.cabal+ tests/projects/multi-cabal-with-project/appB/src/Lib.hs+ tests/projects/multi-cabal-with-project/cabal.project.extra+ tests/projects/multi-cabal-with-project/hie.yaml+ tests/projects/multi-cabal/app/Main.hs+ tests/projects/multi-cabal/cabal.project+ tests/projects/multi-cabal/hie.yaml+ tests/projects/multi-cabal/multi-cabal.cabal+ tests/projects/multi-cabal/src/Lib.hs+ tests/projects/multi-direct/A.hs+ tests/projects/multi-direct/B.hs+ tests/projects/multi-direct/hie.yaml+ tests/projects/multi-stack-with-yaml/appA/appA.cabal+ tests/projects/multi-stack-with-yaml/appA/src/Lib.hs+ tests/projects/multi-stack-with-yaml/appB/appB.cabal+ tests/projects/multi-stack-with-yaml/appB/src/Lib.hs+ tests/projects/multi-stack-with-yaml/hie.yaml+ tests/projects/multi-stack/app/Main.hs+ tests/projects/multi-stack/cabal.project+ tests/projects/multi-stack/hie.yaml+ tests/projects/multi-stack/multi-stack.cabal+ tests/projects/multi-stack/src/Lib.hs+ tests/projects/nested-cabal/cabal.project+ tests/projects/nested-cabal/hie.yaml+ tests/projects/nested-cabal/MyLib.hs+ tests/projects/nested-cabal/nested-cabal.cabal+ tests/projects/nested-cabal/sub-comp/Lib.hs+ tests/projects/nested-cabal/sub-comp/sub-comp.cabal+ tests/projects/nested-stack/hie.yaml+ tests/projects/nested-stack/MyLib.hs+ tests/projects/nested-stack/nested-stack.cabal+ tests/projects/nested-stack/sub-comp/Lib.hs+ tests/projects/nested-stack/sub-comp/sub-comp.cabal+ tests/projects/simple-bios-ghc/A.hs+ tests/projects/simple-bios-ghc/B.hs+ tests/projects/simple-bios-ghc/hie-bios.sh+ tests/projects/simple-bios-ghc/hie.yaml+ tests/projects/simple-bios-shell/A.hs+ tests/projects/simple-bios-shell/B.hs+ tests/projects/simple-bios-shell/hie.yaml+ tests/projects/simple-bios/A.hs+ tests/projects/simple-bios/B.hs+ tests/projects/simple-bios/hie-bios-deps.sh+ tests/projects/simple-bios/hie-bios.sh+ tests/projects/simple-bios/hie.yaml+ tests/projects/simple-cabal/A.hs+ tests/projects/simple-cabal/B.hs+ tests/projects/simple-cabal/cabal.project+ tests/projects/simple-cabal/hie.yaml+ tests/projects/simple-cabal/simple-cabal.cabal+ tests/projects/simple-direct/A.hs+ tests/projects/simple-direct/B.hs+ tests/projects/simple-direct/hie.yaml+ tests/projects/simple-stack/A.hs+ tests/projects/simple-stack/B.hs+ tests/projects/simple-stack/cabal.project+ tests/projects/simple-stack/hie.yaml+ tests/projects/simple-stack/simple-stack.cabal+ "tests/projects/space stack/A.hs"+ "tests/projects/space stack/B.hs"+ "tests/projects/space stack/hie.yaml"+ "tests/projects/space stack/stackproj.cabal"+ tests/projects/stack-with-yaml/app/Main.hs+ tests/projects/stack-with-yaml/hie.yaml+ tests/projects/stack-with-yaml/src/Lib.hs+ tests/projects/stack-with-yaml/stack-with-yaml.cabal+ tests/projects/symlink-test/a/A.hs+ tests/projects/symlink-test/hie.yaml+ wrappers/cabal+ wrappers/cabal-with-repl+ wrappers/cabal-with-repl.hs+ wrappers/cabal.hs -tested-with: GHC ==9.6.7 || ==9.8.4 || ==9.10.1 || ==9.12.2 || ==9.14.1+tested-with: ghc ==9.6.7 || ==9.8.4 || ==9.10.1 || ==9.12.2 || ==9.14.1 -Library- Default-Language: Haskell2010- GHC-Options: -Wall- HS-Source-Dirs: src- Exposed-Modules: HIE.Bios- HIE.Bios.Config- HIE.Bios.Config.YAML- HIE.Bios.Cradle- HIE.Bios.Cradle.Cabal- HIE.Bios.Cradle.ProgramVersions- HIE.Bios.Cradle.ProjectConfig- HIE.Bios.Cradle.Resolved- HIE.Bios.Cradle.Utils- HIE.Bios.Environment- HIE.Bios.Internal.Debug- HIE.Bios.Flags- HIE.Bios.Process- HIE.Bios.Types- HIE.Bios.Ghc.Api- HIE.Bios.Ghc.Check- HIE.Bios.Ghc.Doc- HIE.Bios.Ghc.Gap- HIE.Bios.Ghc.Load- HIE.Bios.Ghc.Logger- HIE.Bios.Wrappers- Other-Modules: Paths_hie_bios- autogen-modules: Paths_hie_bios- Build-Depends:- base >= 4.16 && < 5,- aeson >= 1.4.4 && < 2.3,- base16-bytestring >= 0.1.1 && < 1.1,- bytestring >= 0.10.8 && < 0.13,- co-log-core ^>= 0.3.0,- deepseq >= 1.4.3 && < 1.6,- exceptions ^>= 0.10,- cryptohash-sha1 >= 0.11.100 && < 0.12,- directory >= 1.3.0 && < 1.4,- filepath >= 1.4.1 && < 1.6,- time >= 1.8.0 && < 1.16,- extra >= 1.6.14 && < 1.9,- prettyprinter ^>= 1.6 || ^>= 1.7.0,- ghc >= 9.2.1 && < 9.15,- transformers >= 0.5.2 && < 0.7,- temporary >= 1.2 && < 1.4,- template-haskell >= 2.18 && <2.25,- text >= 1.2.3 && < 2.2,- unix-compat >= 0.5.1 && < 0.8,- unordered-containers >= 0.2.9 && < 0.3,- yaml >= 0.10.0 && < 0.12,- file-embed >= 0.0.11 && < 1,- conduit >= 1.3 && < 2,- conduit-extra >= 1.3 && < 2+library+ default-language: Haskell2010+ ghc-options: -Wall+ hs-source-dirs: src+ exposed-modules:+ HIE.Bios+ HIE.Bios.Config+ HIE.Bios.Config.YAML+ HIE.Bios.Cradle+ HIE.Bios.Cradle.Cabal+ HIE.Bios.Cradle.ProgramVersions+ HIE.Bios.Cradle.ProjectConfig+ HIE.Bios.Cradle.Resolved+ HIE.Bios.Cradle.Utils+ HIE.Bios.Environment+ HIE.Bios.Flags+ HIE.Bios.Ghc.Api+ HIE.Bios.Ghc.Check+ HIE.Bios.Ghc.Doc+ HIE.Bios.Ghc.Gap+ HIE.Bios.Ghc.Load+ HIE.Bios.Ghc.Logger+ HIE.Bios.Internal.Debug+ HIE.Bios.Process+ HIE.Bios.Types+ HIE.Bios.Wrappers + other-modules: Paths_hie_bios+ autogen-modules: Paths_hie_bios+ build-depends:+ aeson >=1.4.4 && <2.4,+ base >=4.16 && <5,+ base16-bytestring >=0.1.1 && <1.1,+ bytestring >=0.10.8 && <0.13,+ co-log-core ^>=0.3.0,+ conduit >=1.3 && <2,+ conduit-extra >=1.3 && <2,+ containers >=0.6.2 && <0.9,+ cryptohash-sha1 >=0.11.100 && <0.12,+ deepseq >=1.4.3 && <1.6,+ directory >=1.3.0 && <1.4,+ exceptions ^>=0.10,+ extra >=1.6.14 && <1.9,+ file-embed >=0.0.11 && <1,+ filepath >=1.4.1 && <1.6,+ ghc >=9.2.1 && <10.2,+ prettyprinter ^>=1.6 || ^>=1.7.0,+ template-haskell >=2.18 && <2.25,+ temporary >=1.2 && <1.4,+ text >=1.2.3 && <2.2,+ time >=1.8.0 && <1.17,+ transformers >=0.5.2 && <0.7,+ unix-compat >=0.5.1 && <0.8,+ unordered-containers >=0.2.9 && <0.3,+ yaml >=0.10.0 && <0.12, -Executable hie-bios- Default-Language: Haskell2010- Main-Is: Main.hs- Other-Modules: Paths_hie_bios- autogen-modules: Paths_hie_bios- GHC-Options: -Wall- HS-Source-Dirs: exe- Build-Depends: base >= 4.16 && < 5- , co-log-core- , directory- , filepath- , hie-bios- , optparse-applicative >= 0.17.1 && < 0.20- , prettyprinter+executable hie-bios+ default-language: Haskell2010+ main-is: Main.hs+ other-modules: Paths_hie_bios+ autogen-modules: Paths_hie_bios+ ghc-options: -Wall+ hs-source-dirs: exe+ build-depends:+ base >=4.16 && <5,+ co-log-core,+ directory,+ filepath,+ hie-bios,+ optparse-applicative >=0.17.1 && <0.20,+ prettyprinter, test-suite parser-tests type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends:- base,- aeson,- filepath,- hie-bios,- tasty,- tasty-hunit,- yaml+ aeson,+ base,+ filepath,+ hie-bios,+ tasty,+ tasty-hunit,+ yaml, hs-source-dirs: tests/- ghc-options: -threaded -Wall+ ghc-options:+ -threaded+ -Wall+ main-is: ParserTests.hs test-suite bios-tests type: exitcode-stdio-1.0 default-language: Haskell2010 build-depends:- base,- co-log-core,- extra,- transformers,- tasty,- tasty-hunit,- tasty-expected-failure,- hie-bios,- filepath,- directory,- prettyprinter,- temporary,- text,- ghc+ base,+ co-log-core,+ directory,+ extra,+ filepath,+ ghc,+ hie-bios,+ prettyprinter,+ tasty,+ tasty-expected-failure,+ tasty-hunit,+ temporary,+ text,+ transformers, hs-source-dirs: tests/ main-is: BiosTests.hs other-modules: Utils+ ghc-options:+ -threaded+ -Wall - ghc-options: -threaded -Wall -- There seems to be a race condition on windows if !os(windows)- ghc-options: -rtsopts "-with-rtsopts=-N"+ ghc-options:+ -rtsopts+ -with-rtsopts=-N -Source-Repository head- Type: git- Location: https://github.com/haskell/hie-bios.git+source-repository head+ type: git+ location: https://github.com/haskell/hie-bios.git
src/HIE/Bios/Config.hs view
@@ -11,10 +11,12 @@ pattern CabalType, cabalComponent, cabalProjectFile,+ cabalComponentsToLoad, StackType, pattern StackType, stackComponent, stackYaml,+ stackComponentsToLoad, CradleTree(..), Callable(..) ) where@@ -67,34 +69,42 @@ -- 'cabal.project'. We allow to override that name to have an HLS specific -- project configuration file. data CabalType- = CabalType_ { _cabalComponent :: !(Last String), _cabalProjectFile :: !(Last FilePath) }+ = CabalType_+ { _cabalComponent :: !(Last String)+ , _cabalProjectFile :: !(Last FilePath)+ , _cabalComponentsToLoad :: !(Maybe [String])+ } deriving (Eq) instance Semigroup CabalType where- CabalType_ cr cpr <> CabalType_ cl cpl = CabalType_ (cr <> cl) (cpr <> cpl)+ CabalType_ cr cpr csr <> CabalType_ cl cpl csl = CabalType_ (cr <> cl) (cpr <> cpl) (csr <> csl) instance Monoid CabalType where- mempty = CabalType_ mempty mempty+ mempty = CabalType_ mempty mempty mempty -pattern CabalType :: Maybe String -> Maybe FilePath -> CabalType-pattern CabalType { cabalComponent, cabalProjectFile } = CabalType_ (Last cabalComponent) (Last cabalProjectFile)+pattern CabalType :: Maybe String -> Maybe FilePath -> Maybe [String] -> CabalType+pattern CabalType { cabalComponent, cabalProjectFile, cabalComponentsToLoad } = CabalType_ (Last cabalComponent) (Last cabalProjectFile) cabalComponentsToLoad {-# COMPLETE CabalType #-} instance Show CabalType where show = show . Cabal data StackType- = StackType_ { _stackComponent :: !(Last String) , _stackYaml :: !(Last String) }+ = StackType_+ { _stackComponent :: !(Last String)+ , _stackYaml :: !(Last String)+ , _stackComponentsToLoad :: !(Maybe [String])+ } deriving (Eq) instance Semigroup StackType where- StackType_ cr yr <> StackType_ cl yl = StackType_ (cr <> cl) (yr <> yl)+ StackType_ cr yr zr <> StackType_ cl yl zl = StackType_ (cr <> cl) (yr <> yl) (zr <> zl) instance Monoid StackType where- mempty = StackType_ mempty mempty+ mempty = StackType_ mempty mempty mempty -pattern StackType :: Maybe String -> Maybe FilePath -> StackType-pattern StackType { stackComponent, stackYaml } = StackType_ (Last stackComponent) (Last stackYaml)+pattern StackType :: Maybe String -> Maybe FilePath -> Maybe [String] -> StackType+pattern StackType { stackComponent, stackYaml, stackComponentsToLoad } = StackType_ (Last stackComponent) (Last stackYaml) stackComponentsToLoad {-# COMPLETE StackType #-} instance Show StackType where@@ -126,7 +136,11 @@ deriving (Eq, Functor) instance Show (CradleTree a) where- show (Cabal comp) = "Cabal {component = " ++ show (cabalComponent comp) ++ "}"+ show (Cabal comp) = concat $+ [ "Cabal { component = ", show (cabalComponent comp)+ , ", projectFile = ", show (cabalProjectFile comp)+ , "}"+ ] show (CabalMulti d a) = "CabalMulti {defaultCabal = " ++ show d ++ ", subCabalComponents = " ++ show a ++ "}" show (Stack comp) = "Stack {component = " ++ show (stackComponent comp) ++ ", stackYaml = " ++ show (stackYaml comp) ++ "}" show (StackMulti d a) = "StackMulti {defaultStack = " ++ show d ++ ", subStackComponents = " ++ show a ++ "}"@@ -159,20 +173,21 @@ toCradleTree :: YAML.CradleComponent a -> CradleTree a toCradleTree (YAML.Multi cpts) = Multi $ (\(YAML.MultiSubComponent fp' cfg) -> (fp', cradle $ fromYAMLConfig cfg)) <$> cpts-toCradleTree (YAML.Stack (YAML.StackConfig yaml cpts)) =+toCradleTree (YAML.Stack (YAML.StackConfig yaml csToLoad cpts)) = case cpts of- YAML.NoComponent -> Stack $ StackType Nothing yaml- (YAML.SingleComponent c) -> Stack $ StackType (Just c) yaml- (YAML.ManyComponents cs) -> StackMulti (StackType Nothing yaml)+ YAML.NoComponent -> Stack $ StackType Nothing yaml csToLoad+ (YAML.SingleComponent c) -> Stack $ StackType (Just c) yaml csToLoad+ (YAML.ManyComponents cs) -> StackMulti (StackType Nothing yaml csToLoad) ((\(YAML.StackComponent fp' c cYAML) ->- (fp', StackType (Just c) cYAML)) <$> cs)-toCradleTree (YAML.Cabal (YAML.CabalConfig prjFile cpts)) =+ (fp', StackType (Just c) cYAML+ Nothing)) <$> cs)+toCradleTree (YAML.Cabal (YAML.CabalConfig prjFile csToLoad cpts)) = case cpts of- YAML.NoComponent -> Cabal $ CabalType Nothing prjFile- (YAML.SingleComponent c) -> Cabal $ CabalType (Just c) prjFile- (YAML.ManyComponents cs) -> CabalMulti (CabalType Nothing prjFile)+ YAML.NoComponent -> Cabal $ CabalType Nothing prjFile csToLoad+ (YAML.SingleComponent c) -> Cabal $ CabalType (Just c) prjFile csToLoad+ (YAML.ManyComponents cs) -> CabalMulti (CabalType Nothing prjFile csToLoad) ((\(YAML.CabalComponent fp' c cPrjFile) ->- (fp', CabalType (Just c) cPrjFile)) <$> cs)+ (fp', CabalType (Just c) cPrjFile Nothing)) <$> cs) toCradleTree (YAML.Direct cfg) = Direct (YAML.arguments cfg) toCradleTree (YAML.Bios cfg) = Bios (toCallable $ YAML.callable cfg) (toCallable <$> YAML.depsCallable cfg)
src/HIE/Bios/Config/YAML.hs view
@@ -24,8 +24,9 @@ import Control.Applicative ((<|>)) import Data.Aeson #if MIN_VERSION_aeson(2,0,0)-import Data.Aeson.KeyMap (keys)+import Data.Aeson.KeyMap (keys,lookup) #else+import Data.HashMap.Strict (lookup) import qualified Data.HashMap.Strict as Map import qualified Data.Text as T #endif@@ -33,6 +34,7 @@ import qualified Data.Char as C (toLower) import Data.List ((\\)) import GHC.Generics (Generic)+import Prelude hiding (lookup) #if !MIN_VERSION_aeson(2,0,0) -- | Backwards compatible type-def for Key@@ -103,16 +105,18 @@ data CabalConfig = CabalConfig { cabalProject :: Maybe FilePath+ , cabalComponentsToLoad :: Maybe [String] , cabalComponents :: OneOrManyComponents CabalComponent } instance FromJSON CabalConfig where- parseJSON v@(Array _) = CabalConfig Nothing . ManyComponents <$> parseJSON v- parseJSON v@(Object obj) = (checkObjectKeys ["cabalProject", "component", "components"] obj)+ parseJSON v@(Array _) = CabalConfig Nothing Nothing . ManyComponents <$> parseJSON v+ parseJSON v@(Object obj) = (checkObjectKeys ["cabalProject", "component", "components", "componentsToLoad"] obj) *> (CabalConfig <$> obj .:? "cabalProject"+ <*> obj .:? "componentsToLoad" <*> parseJSON v)- parseJSON Null = pure $ CabalConfig Nothing NoComponent+ parseJSON Null = pure $ CabalConfig Nothing Nothing NoComponent parseJSON v = typeMismatch "CabalConfig" v data CabalComponent@@ -133,6 +137,7 @@ data StackConfig = StackConfig { stackYaml :: Maybe FilePath+ , stackComponentsToLoad :: Maybe [String] , stackComponents :: OneOrManyComponents StackComponent } @@ -143,13 +148,14 @@ } instance FromJSON StackConfig where- parseJSON v@(Array _) = StackConfig Nothing . ManyComponents <$> parseJSON v- parseJSON v@(Object obj) = (checkObjectKeys ["component", "components", "stackYaml"] obj)+ parseJSON v@(Array _) = StackConfig Nothing Nothing . ManyComponents <$> parseJSON v+ parseJSON v@(Object obj) = (checkObjectKeys ["component", "components", "stackYaml", "componentsToLoad"] obj) *> (StackConfig <$> obj .:? "stackYaml"+ <*> obj .:? "componentsToLoad" <*> parseJSON v )- parseJSON Null = pure $ StackConfig Nothing NoComponent+ parseJSON Null = pure $ StackConfig Nothing Nothing NoComponent parseJSON v = typeMismatch "StackConfig" v instance FromJSON StackComponent where@@ -166,12 +172,13 @@ | ManyComponents [component] | NoComponent -instance FromJSON component => FromJSON (OneOrManyComponents component) where- parseJSON =- let parseComponents o = (parseSingleComponent o <|> parseSubComponents o <|> pure NoComponent)- parseSingleComponent o = SingleComponent <$> o .: "component"- parseSubComponents o = ManyComponents <$> o .: "components"- in withObject "Components" parseComponents+instance FromJSON a => FromJSON (OneOrManyComponents a) where+ parseJSON (Object obj)+ | Just v <- lookup "component" obj = SingleComponent <$> parseJSON v+ | Just v <- lookup "components" obj = ManyComponents <$> parseJSON v+ | otherwise = pure NoComponent+ parseJSON Null = pure NoComponent+ parseJSON v = typeMismatch "OneOrManyComponents" v data DirectConfig = DirectConfig { arguments :: [String] }
src/HIE/Bios/Cradle.hs view
@@ -58,6 +58,7 @@ import HIE.Bios.Cradle.Cabal as Cabal import HIE.Bios.Cradle.Resolved import HIE.Bios.Cradle.ProgramVersions+import Data.List.Extra (nubOrd) ---------------------------------------------------------------- @@ -94,11 +95,13 @@ loadCradleWithOpts :: (Yaml.FromJSON b, Show a) => LogAction IO (WithSeverity Log) -> (b -> CradleAction a) -> FilePath -> IO (Cradle a) loadCradleWithOpts l buildCustomCradle wfile = do cradleConfig <- readCradleConfig wfile+ l <& WithSeverity (LogAny $ T.pack $ "Cradle Config: " ++ show cradleConfig) Debug getCradle l buildCustomCradle (cradleConfig, takeDirectory wfile) getCradle :: Show a => LogAction IO (WithSeverity Log) -> (b -> CradleAction a) -> (CradleConfig b, FilePath) -> IO (Cradle a) getCradle l buildCustomCradle (cc, wdir) = do rcs <- canonicalizeResolvedCradles wdir cs+ liftIO $ l <& WithSeverity (LogAny . T.pack $ "Resolved Cradles " ++ show ((fmap . fmap) (const ()) rcs)) Debug resolvedCradlesToCradle l buildCustomCradle wdir rcs where cs = resolveCradleTree wdir cc@@ -126,10 +129,11 @@ versions <- makeVersions logger root run_ghc_cmd let rcs = ResolvedCradles root cs versions cradleActions = [ (c, resolveCradleAction logger buildCustomCradle rcs root c) | c <- cs ]- err_msg fp+ err_msg (TargetWithContext fp fps) = ["Multi Cradle: No prefixes matched" , "pwd: " ++ root , "filepath: " ++ fp+ , "context: " ++ intercalate ", " fps , "prefixes:" ] ++ [show (prefix pf, actionName cc) | (pf, cc) <- cradleActions] pure $ Cradle@@ -137,12 +141,12 @@ , cradleLogger = logger , cradleOptsProg = CradleAction { actionName = multiActionName- , runCradle = \fp prev -> do- absfp <- makeAbsolute fp+ , runCradle = \fpc prev -> do+ absfp <- makeAbsolute (targetFilePath fpc) case selectCradle (prefix . fst) absfp cradleActions of Just (rc, act) -> do- addActionDeps (cradleDeps rc) <$> runCradle act fp prev- Nothing -> return $ CradleFail $ CradleError [] ExitSuccess (err_msg fp) [fp]+ addActionDeps (cradleDeps rc) <$> runCradle act fpc prev+ Nothing -> return $ CradleFail $ CradleError [] ExitSuccess (err_msg fpc) (targetFilePath fpc: targetContext fpc) , runGhcCmd = run_ghc_cmd } }@@ -184,20 +188,20 @@ resolveCradleAction :: Show a => LogAction IO (WithSeverity Log) -> (b -> CradleAction a) -> ResolvedCradles b -> FilePath -> ResolvedCradle b -> CradleAction a-resolveCradleAction l buildCustomCradle cs root cradle = addLoadStyleLogToCradleAction $+resolveCradleAction l buildCustomCradle cs root cradle = addLoadModeLogToCradleAction $ case concreteCradle cradle of ConcreteCabal t -> cabalCradle l cs root (cabalComponent t) (projectConfigFromMaybe root (cabalProjectFile t))- ConcreteStack t -> stackCradle l root (stackComponent t) (projectConfigFromMaybe root (stackYaml t))+ ConcreteStack t -> stackCradle l cs root (stackComponent t) (projectConfigFromMaybe root (stackYaml t)) ConcreteBios bios deps mbGhc -> biosCradle l cs root bios deps mbGhc ConcreteDirect xs -> directCradle l root xs ConcreteNone -> noneCradle ConcreteOther a -> buildCustomCradle a where -- Add a log message to each loading operation.- addLoadStyleLogToCradleAction crdlAct = crdlAct- { runCradle = \fp ls -> do- l <& LogRequestedCradleLoadStyle (T.pack $ show $ actionName crdlAct) ls `WithSeverity` Debug- runCradle crdlAct fp ls+ addLoadModeLogToCradleAction crdlAct = crdlAct+ { runCradle = \fpc ls -> do+ l <& LogRequestedCradleLoadMode (T.pack $ show $ actionName crdlAct) fpc ls `WithSeverity` Debug+ runCradle crdlAct fpc ls } resolveCradleTree :: FilePath -> CradleConfig a -> [ResolvedCradle a]@@ -229,9 +233,9 @@ where maybeItsBios = (\wdir -> (Bios (Program $ wdir </> ".hie-bios") Nothing Nothing, wdir)) <$> biosWorkDir fp - maybeItsStack = stackExecutable >> (Stack $ StackType Nothing Nothing,) <$> stackWorkDir fp+ maybeItsStack = stackExecutable >> (Stack $ StackType Nothing Nothing Nothing,) <$> stackWorkDir fp - maybeItsCabal = (Cabal $ CabalType Nothing Nothing,) <$> cabalWorkDir fp+ maybeItsCabal = (Cabal $ CabalType Nothing Nothing Nothing,) <$> cabalWorkDir fp -- maybeItsObelisk = (Obelisk,) <$> obeliskWorkDir fp @@ -357,7 +361,7 @@ = CradleAction { actionName = Types.Direct , runCradle = \_ loadStyle -> do- logCradleHasNoSupportForLoadWithContext l loadStyle "direct"+ logCradleHasNoSupportForLoadFileWithContext l loadStyle "direct" return (CradleSuccess (ComponentOptions (args ++ argDynamic) wdir [])) , runGhcCmd = runGhcCmdOnPath l wdir }@@ -379,11 +383,20 @@ biosWorkDir :: FilePath -> MaybeT IO FilePath biosWorkDir = Process.findFileUpwards ".hie-bios" -biosDepsAction :: LogAction IO (WithSeverity Log) -> FilePath -> Maybe Callable -> FilePath -> LoadStyle -> IO [FilePath]-biosDepsAction l wdir (Just biosDepsCall) fp loadStyle = do- let fps = case loadStyle of- LoadFile -> [fp]- LoadWithContext old_fps -> fp : old_fps+-- | shared between @biosDepsAction@ and @biosAction@.+biosFilePaths :: TargetWithContext -> LoadMode -> [FilePath]+biosFilePaths fpc = \case+ LoadFile -> [targetFilePath fpc]+ LoadFileWithContext -> targetAndContext fpc+ -- Exhaustive matching to trigger type errors for datatype changes.+ LoadUnitsInferred -> targetAndContext fpc+ LoadUnitsFromCradle -> targetAndContext fpc++biosDepsAction :: LogAction IO (WithSeverity Log) -> FilePath -> Maybe Callable -> TargetWithContext -> LoadMode -> IO [FilePath]+biosDepsAction l wdir (Just biosDepsCall) fpc loadStyle = do++ let fps = biosFilePaths fpc loadStyle+ (ex, sout, serr, [(_, args)]) <- runContT (withCallableToProcess biosDepsCall fps) $ \biosDeps' -> Process.readProcessWithOutputs [hie_bios_output] l wdir biosDeps'@@ -398,37 +411,43 @@ -> Callable -> Maybe Callable -> LogAction IO (WithSeverity Log)- -> FilePath- -> LoadStyle+ -> TargetWithContext+ -> LoadMode -> IO (CradleLoadResult ComponentOptions)-biosAction rc wdir bios bios_deps l fp loadStyle = do+biosAction rc wdir bios bios_deps l fpc loadStyle = do+ let fp = targetFilePath fpc ghc_version <- liftIO $ runCachedIO $ ghcVersion $ cradleProgramVersions rc- determinedLoadStyle <- case ghc_version of- Just ghc- -- Multi-component supported from ghc 9.4- -- We trust the assertion for a bios program, as we have no way of- -- checking its version- | LoadWithContext _ <- loadStyle ->- if ghc >= makeVersion [9,4]- then pure loadStyle- else do- liftIO $ l <& WithSeverity- (LogLoadWithContextUnsupported "bios"- $ Just "ghc version is too old. We require `ghc >= 9.4`"- )- Warning- pure LoadFile- _ -> pure LoadFile- let fps = case determinedLoadStyle of- LoadFile -> [fp]- LoadWithContext old_fps -> fp : old_fps+ let warnUnsupportedLoadMode msg =+ liftIO $ l <& WithSeverity+ (LogLoadModeUnsupported "bios" loadStyle (Just msg))+ Warning+ determinedLoadMode <- case ghc_version of+ Just ghc+ | ghc >= makeVersion [9,4] -> do+ -- Multi-component supported from ghc 9.4+ -- We trust the assertion for a bios program, as we have no way of+ -- checking its version+ pure $ case loadStyle of+ LoadFile -> LoadFile+ LoadFileWithContext -> LoadFileWithContext+ LoadUnitsFromCradle -> LoadFileWithContext+ LoadUnitsInferred -> LoadFileWithContext+ | loadStyle /= LoadFile -> do+ warnUnsupportedLoadMode "ghc version is too old. We require `ghc >= 9.4`"+ pure LoadFile+ _ -> do+ warnUnsupportedLoadMode "Unable to determine ghc version. We require `ghc >= 9.4`"+ pure LoadFile++ let fps = biosFilePaths fpc determinedLoadMode+ (ex, _stdo, std, [(_, res),(_, mb_deps)]) <- runContT (withCallableToProcess bios fps) $ \bios' -> Process.readProcessWithOutputs [hie_bios_output, hie_bios_deps] l wdir bios' deps <- case mb_deps of Just x -> return x- Nothing -> biosDepsAction l wdir bios_deps fp loadStyle+ Nothing -> biosDepsAction l wdir bios_deps fpc determinedLoadMode -- Output from the program should be written to the output file and -- delimited by newlines. -- Execute the bios action and add dependencies of the cradle.@@ -478,7 +497,7 @@ cabalCradle l cs wdir mc projectFile = CradleAction { actionName = Types.Cabal- , runCradle = \fp -> runCradleResultT . cabalAction cs wdir mc l projectFile fp+ , runCradle = \fpc -> runCradleResultT . cabalAction cs wdir mc l projectFile fpc , runGhcCmd = runCabalGhcCmd cs wdir l projectFile } @@ -499,11 +518,11 @@ -- | Stack Cradle -- Works for by invoking `stack repl` with a wrapper script-stackCradle :: LogAction IO (WithSeverity Log) -> FilePath -> Maybe String -> CradleProjectConfig -> CradleAction a-stackCradle l wdir mc syaml =+stackCradle :: LogAction IO (WithSeverity Log) -> ResolvedCradles b -> FilePath -> Maybe String -> CradleProjectConfig -> CradleAction a+stackCradle l cs wdir mc syaml = CradleAction { actionName = Types.Stack- , runCradle = stackAction wdir mc syaml l+ , runCradle = stackAction wdir mc syaml l cs , runGhcCmd = \args -> runCradleResultT $ do -- Setup stack silently, since stack might print stuff to stdout in some cases (e.g. on Win) -- Issue 242 from HLS: https://github.com/haskell/haskell-language-server/issues/242@@ -535,19 +554,40 @@ -> Maybe String -> CradleProjectConfig -> LogAction IO (WithSeverity Log)- -> FilePath- -> LoadStyle+ -> ResolvedCradles a+ -> TargetWithContext+ -> LoadMode -> IO (CradleLoadResult ComponentOptions)-stackAction workDir mc syaml l fp loadStyle = do- logCradleHasNoSupportForLoadWithContext l loadStyle "stack"+stackAction workDir mc syaml l cs fpc loadStyle = do+ let fp = targetFilePath fpc+ logCradleHasNoSupportForLoadFileWithContext l loadStyle "stack" let ghcProc args = proc "stack" (stackYamlProcessArgs syaml <> ["exec", "ghc", "--"] <> args) -- Same wrapper works as with cabal wrapper_fp <- withGhcWrapperTool l ghcProc workDir+ let+ fallback = [ comp | Just comp <- [mc] ]+ componentsToLoad = nubOrd <$> mconcat+ [ comps+ | ResolvedCradle{concreteCradle = ConcreteStack+ (StackType {stackComponentsToLoad = comps})} <- resolvedCradles cs ]+ allComponents = [ comp+ | ResolvedCradle{concreteCradle = ConcreteStack+ (StackType {stackComponent = Just comp})} <- resolvedCradles cs ]+ -- for stack we do not include --test --bench to avoid triggering stack repl limitations.+ inferred = []+ components = case loadStyle of+ LoadUnitsFromCradle+ | Just comps <- componentsToLoad -> comps+ | null allComponents -> inferred+ | otherwise -> allComponents+ LoadUnitsInferred -> inferred+ LoadFile -> fallback+ LoadFileWithContext -> fallback (ex1, _stdo, stde, [(_, maybeArgs)]) <- Process.readProcessWithOutputs [hie_bios_output] l workDir $ stackProcess syaml $ ["repl", "--no-nix-pure", "--with-ghc", wrapper_fp]- <> [ comp | Just comp <- [mc] ]+ <> components (ex2, pkg_args, stdr, _) <- Process.readProcessWithOutputs [hie_bios_output] l workDir@@ -682,12 +722,12 @@ runGhcCmdOnPath l wdir args = Process.readProcessWithCwd l wdir "ghc" args "" -- | Log that the cradle has no supported for loading with context, if and only if--- 'LoadWithContext' was requested.-logCradleHasNoSupportForLoadWithContext :: Applicative m => LogAction m (WithSeverity Log) -> LoadStyle -> T.Text -> m ()-logCradleHasNoSupportForLoadWithContext l (LoadWithContext _) crdlName =+-- 'LoadFileWithContext' was requested.+logCradleHasNoSupportForLoadFileWithContext :: Applicative m => LogAction m (WithSeverity Log) -> LoadMode -> T.Text -> m ()+logCradleHasNoSupportForLoadFileWithContext l LoadFileWithContext crdlName = l <& WithSeverity- (LogLoadWithContextUnsupported crdlName+ (LogLoadModeUnsupported crdlName LoadFileWithContext $ Just $ crdlName <> " doesn't support loading multiple components at once" ) Info-logCradleHasNoSupportForLoadWithContext _ _ _ = pure ()+logCradleHasNoSupportForLoadFileWithContext _ _ _ = pure ()
src/HIE/Bios/Cradle/Cabal.hs view
@@ -137,26 +137,28 @@ Maybe String -> LogAction IO (WithSeverity Log) -> CradleProjectConfig ->- FilePath ->- LoadStyle ->+ TargetWithContext ->+ LoadMode -> CradleLoadResultT IO ComponentOptions cabalAction cradles workDir mc l projectFile fp loadStyle = do let progVersions = cradleProgramVersions cradles multiCompSupport <- isCabalMultipleCompSupported progVersions -- determine which load style is supported by this cabal cradle.- determinedLoadStyle <- case loadStyle of- LoadWithContext _ | not multiCompSupport -> do+ determinedLoadMode <- case loadStyle of+ LoadFile -> pure LoadFile+ -- all other modes need multi component support.+ _ | not multiCompSupport -> do liftIO $ l <& WithSeverity- ( LogLoadWithContextUnsupported "cabal" $+ ( LogLoadModeUnsupported "cabal" loadStyle $ Just "cabal or ghc version is too old. We require `cabal >= 3.11` and `ghc >= 9.4`" ) Warning pure LoadFile _ -> pure loadStyle - (cabalArgs, loadingFiles, extraDeps) <- processCabalLoadStyle l cradles projectFile workDir mc fp determinedLoadStyle+ (cabalArgs, loadingFiles, extraDeps) <- processCabalLoadMode l cradles projectFile workDir mc fp determinedLoadMode cabalFeatures <- determineCabalLoadFeature progVersions let@@ -255,22 +257,29 @@ cabalProc <- cabalExecGhc l vs projectFile wdir args Process.readProcessWithCwd' l cabalProc "" -processCabalLoadStyle :: MonadIO m => LogAction IO (WithSeverity Log) -> ResolvedCradles a -> CradleProjectConfig -> [Char] -> Maybe FilePath -> [Char] -> LoadStyle -> m ([FilePath], [FilePath], [FilePath])-processCabalLoadStyle l cradles projectFile workDir mc fp loadStyle = do- let fpModule = fromMaybe (fixTargetPath fp) mc+data LoadUnits = Inferred | FromCradle+ deriving Eq++processCabalLoadMode :: MonadIO m => LogAction IO (WithSeverity Log) -> ResolvedCradles a -> CradleProjectConfig -> [Char] -> Maybe FilePath -> TargetWithContext -> LoadMode -> m ([FilePath], [FilePath], [FilePath])+processCabalLoadMode l cradles projectFile workDir mc fpc loadStyle = do (cabalArgs, loadingFiles, extraDeps) <- case loadStyle of LoadFile -> pure ([fpModule], [fp], [])- LoadWithContext fps -> do+ LoadFileWithContext -> do+ let fps = targetContext fpc (modPairs, mergedDeps) <- moduleFilesFromSameProject fps let allModPairs = nubOrd $ (fpModule, fp) : modPairs allModules = nubOrd $ fmap fst allModPairs allFiles = nubOrd $ fmap snd allModPairs pure (["--enable-multi-repl"] ++ allModules, allFiles, mergedDeps)+ LoadUnitsInferred -> loadUnits Inferred+ LoadUnitsFromCradle -> loadUnits FromCradle - liftIO $ l <& LogComputedCradleLoadStyle "cabal" loadStyle `WithSeverity` Info+ liftIO $ l <& LogComputedCradleLoadMode "cabal" fpc loadStyle `WithSeverity` Info liftIO $ l <& LogCabalLoad fp mc (prefix <$> resolvedCradles cradles) loadingFiles `WithSeverity` Debug pure (cabalArgs, loadingFiles, extraDeps) where+ fpModule = fromMaybe (fixTargetPath fp) mc+ fp = targetFilePath fpc -- Need to make relative on Windows, due to a Cabal bug with how it -- parses file targets with a C: drive in it. So we decide to make -- the paths relative to the working directory.@@ -295,6 +304,58 @@ let modPairs = [ (fromMaybe (fixTargetPath file) old_mc, file) | (file, _, _, old_mc) <- selected ] pure (modPairs, mergedDeps)++ cabalComponentsFromSameProject :: MonadIO m => Maybe [String] -> m ([String],[FilePath])+ cabalComponentsFromSameProject mToLoad = do++ let selected =+ [ (comp, prefix rc, depsYaml)+ | rc@(ResolvedCradle {concreteCradle = ConcreteCabal ct, cradleDeps = depsYaml}) <- (resolvedCradles cradles)+ , Just comp <- [cabalComponent ct]+ , maybe True (comp `elem`) mToLoad+ , (projectConfigFromMaybe (cradleRoot cradles) (cabalProjectFile ct)) == projectFile+ ]+ let compDirs = nubOrd $ [dir | (_,dir,_) <- selected]+ dynDeps <- concatMapM (liftIO . cabalCradleDependenciesEnclosing projectFile (cradleRoot cradles)) compDirs+ let mergedDeps = nubOrd $ dynDeps ++ concat [ depsYaml | (_, _, depsYaml) <- selected ]+ pure ([comp | (comp,_,_) <- selected], mergedDeps)++ loadUnits whichUnits0 = do+ let+ componentsToLoad = do+ guard (whichUnits0 == FromCradle)+ nubOrd <$> mconcat+ [ cs+ | ResolvedCradle{concreteCradle = ConcreteCabal+ (CabalType {cabalComponentsToLoad = cs})} <- resolvedCradles cradles ]++ -- compDeps includes the .cabal files of the specified components (if the prefixes are there and accurate)+ -- These are used as dependencies for both Inferred and FromCradle modes.+ -- They might not be accurate for `Inferred`, but we have no easy way to query the cabal project for the complete set.+ (cradleComponents,compDeps) <- cabalComponentsFromSameProject componentsToLoad+ let+ whichUnits+ | Just units <- componentsToLoad+ = (whichUnits0, units)+ -- Note we default to Inferred only if componentsToLoad is not declared.+ | null cradleComponents = (Inferred , [])+ | otherwise = (whichUnits0, cradleComponents)++ let fps = targetContext fpc+ (modPairs, mergedDeps0) <- moduleFilesFromSameProject fps+ let allModPairs = nubOrd $ (fpModule, fp) : modPairs+ allModules = nubOrd $ fmap fst allModPairs+ allFiles = nubOrd $ fmap snd allModPairs+ let mergedDeps = mergedDeps0 ++ compDeps+ let compArgs = case whichUnits of+ (Inferred,_) -> enableFlags ++ ["all"]+ where+ enableFlags = case projectFile of+ NoExplicitConfig+ -> ["--enable-tests","--enable-benchmarks"]+ _ -> []+ (FromCradle,units) -> units+ pure (["--enable-multi-repl"] ++ compArgs ++ allModules, allFiles, mergedDeps) cabalLoadFilesWithRepl :: LogAction IO (WithSeverity Log) -> CradleProjectConfig -> FilePath -> [String] -> CradleLoadResultT IO CreateProcess cabalLoadFilesWithRepl l projectFile workDir args = do
src/HIE/Bios/Cradle/Resolved.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveFunctor #-} module HIE.Bios.Cradle.Resolved ( ResolvedCradles(..) , ResolvedCradle(..)@@ -21,7 +22,7 @@ { prefix :: FilePath -- ^ the prefix to match files , cradleDeps :: [FilePath] -- ^ accumulated dependencies , concreteCradle :: ConcreteCradle a- } deriving Show+ } deriving (Show, Functor) -- | The actual type of action we will be using to process a file data ConcreteCradle a@@ -31,5 +32,4 @@ | ConcreteDirect [String] | ConcreteNone | ConcreteOther a- deriving Show-+ deriving (Show, Functor)
src/HIE/Bios/Cradle/Utils.hs view
@@ -18,6 +18,7 @@ import Data.List import System.Process.Extra import GHC.ResponseFile (expandResponse)+import HIE.Bios.Ghc.Gap (removeRTS) -- ---------------------------------------------------------------------------- -- Process error details@@ -53,6 +54,7 @@ -- | Given a list of cradles, try to find the most likely cradle that -- this 'FilePath' belongs to.+-- TODO: this finds the first cradle that matches, while hie-bios README says most-specific cradle would match, unless the inputs are assumed sorted by specificity? selectCradle :: (a -> FilePath) -> FilePath -> [a] -> Maybe a selectCradle _ _ [] = Nothing selectCradle k cur_fp (c: css) =@@ -68,36 +70,6 @@ removeInteractive :: [String] -> [String] removeInteractive = filter (/= "--interactive") --- | Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list.-data InRTS = OutsideRTS | InsideRTS---- | Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list.------ >>> removeRTS ["option1", "+RTS -H32m -RTS", "option2"]--- ["option1", "option2"]------ >>> removeRTS ["option1", "+RTS", "-H32m", "-RTS", "option2"]--- ["option1", "option2"]------ >>> removeRTS ["option1", "+RTS -H32m"]--- ["option1"]------ >>> removeRTS ["option1", "+RTS -H32m", "-RTS", "option2"]--- ["option1", "option2"]------ >>> removeRTS ["option1", "+RTS -H32m", "-H32m -RTS", "option2"]--- ["option1", "option2"]-removeRTS :: [String] -> [String]-removeRTS = go OutsideRTS- where- go :: InRTS -> [String] -> [String]- go _ [] = []- go OutsideRTS (y:ys)- | "+RTS" `isPrefixOf` y = go (if "-RTS" `isSuffixOf` y then OutsideRTS else InsideRTS) ys- | otherwise = y : go OutsideRTS ys- go InsideRTS (y:ys) = go (if "-RTS" `isSuffixOf` y then OutsideRTS else InsideRTS) ys-- removeVerbosityOpts :: [String] -> [String] removeVerbosityOpts = filter ((&&) <$> (/= "-v0") <*> (/= "-w")) @@ -105,4 +77,3 @@ expandGhcOptionResponseFile args = do expanded_args <- expandResponse args pure $ removeInteractive expanded_args-
src/HIE/Bios/Environment.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards, CPP #-}-module HIE.Bios.Environment (initSession, initSession', getRuntimeGhcLibDir, getRuntimeGhcVersion, makeDynFlagsAbsolute, makeTargetsAbsolute, getCacheDir, addCmdOpts) where+{-# LANGUAGE TupleSections #-}+module HIE.Bios.Environment (initSession, initSession', getRuntimeGhcLibDir, getRuntimeGhcVersion, makeDynFlagsAbsolute, makeTargetsAbsolute, getCacheDir, addCmdOpts, extractUnits) where import GHC (GhcMonad) import qualified GHC as G@@ -22,7 +23,13 @@ import HIE.Bios.Types import qualified HIE.Bios.Ghc.Gap as Gap import qualified System.OsPath as OsPath-+import qualified GHC.Plugins as G+import qualified Data.List.NonEmpty as NE+import qualified GHC.Driver.Monad as G+import Data.IORef (newIORef, readIORef)+import qualified GHC.Unit.Env as G+import GHC.Driver.Env (HscEnv(hsc_unit_env))+import Data.Maybe (fromMaybe) -- | Start a GHC session and set some sensible options for tooling to use. -- Creates a folder in the cache directory to cache interface files to make@@ -37,7 +44,6 @@ -> ComponentOptions -> m [G.Target] initSession' workAroundThreadUnsafety ComponentOptions {..} = do- df <- G.getSessionDynFlags -- Create a unique folder per set of different GHC options, assuming that each different set of -- GHC options will create incompatible interface files. let@@ -45,22 +51,69 @@ hash_args = (if workAroundThreadUnsafety then (componentRoot :) else id) componentOptions opts_hash = B.unpack $ encode $ H.finalize $ H.updates H.init $ map B.pack hash_args - cache_dir <- liftIO $ getCacheDir opts_hash- -- Add the user specified options to a fresh GHC session.- (df', targets) <- addCmdOpts componentOptions df- let df'' = makeDynFlagsAbsolute componentRoot df'- void $ G.setSessionDynFlags- (disableOptimisation -- Compile with -O0 as we are not going to produce object files.- $ setIgnoreInterfacePragmas -- Ignore any non-essential information in interface files such as unfoldings changing.- $ writeInterfaceFiles (Just cache_dir) -- Write interface files to the cache- $ setVerbosity 0 -- Set verbosity to zero just in case the user specified `-vx` in the options.- $ Gap.setWayDynamicIfHostIsDynamic -- Add dynamic way if GHC is built with dynamic linking- $ setLinkerOptions df'' -- Set `-fno-code` to avoid generating object files, unless we have to.- )+ cache_dir <- liftIO $ makeAbsolute =<< getCacheDir opts_hash - let targets' = makeTargetsAbsolute componentRoot targets+ -- Plan:+ -- - Extract `-unit @resp_file` options if present+ -- - Add the user specified options to a fresh GHC session+ -- - Make all dflags absolute+ -- - Set flags for interactive session+ -- - Reconstruct targets and make them absolute++ let (units,rest) = extractUnits componentOptions++ let liftGhc m = do+ env <- G.getSession+ s <- liftIO (newIORef env)+ x <- liftIO $ G.reflectGhc m (G.Session s)+ G.setSession =<< liftIO (readIORef s)+ pure x+ let+ setFlags df'' =+ void $ G.setSessionDynFlags+ (disableOptimisation -- Compile with -O0 as we are not going to produce object files.+ $ setIgnoreInterfacePragmas -- Ignore any non-essential information in interface files such as unfoldings changing.+ $ writeInterfaceFiles (Just cache_dir) -- Write interface files to the cache+ $ setVerbosity 0 -- Set verbosity to zero just in case the user specified `-vx` in the options.+ $ Gap.setWayDynamicIfHostIsDynamic -- Add dynamic way if GHC is built with dynamic linking+ $ setLinkerOptions df'' -- Set `-fno-code` to avoid generating object files, unless we have to.+ )++ targets <- case NE.nonEmpty units of+ Nothing -> do+ (df',targets) <- addCmdOpts componentOptions =<< G.getSessionDynFlags+ setFlags $ makeDynFlagsAbsolute componentRoot df'+ pure targets+ Just ne_units -> do+ logger <- Gap.getLogger <$> G.getSession+ df <- G.getSessionDynFlags+ -- leftovers won't have targets when units are present.+ (df', _leftovers, _warns) <- Gap.parseDynamicFlags logger df (map G.noLoc rest)+ setFlags $ makeDynFlagsAbsolute componentRoot df'++ hs_srcs <- liftGhc $ Gap.initMulti ne_units (\ _ _ _ _ -> return ())++ G.modifySession $ G.hscUpdateHUG $ fmap (\ ue -> ue {G.homeUnitEnv_dflags = makeDynFlagsAbsolute componentRoot (G.homeUnitEnv_dflags ue)})++ -- This should be an enforced invariant.+ G.modifySession $ \ hsc_env -> G.hscSetActiveUnitId (G.ue_current_unit $ G.hsc_unit_env hsc_env) hsc_env++ mapM (\(src, uid, phase) -> G.guessTarget src uid phase) hs_srcs++ let mkTgtAbs env tgt = tgt {G.targetId = makeTargetIdAbsolute wdir (G.targetId tgt)}+ where+ wdir = fromMaybe componentRoot $+ G.workingDirectory+ . G.homeUnitEnv_dflags . G.ue_findHomeUnitEnv uid+ $ hsc_unit_env env+ uid = G.targetUnitId tgt++ env <- G.getSession+ let targets' = map (mkTgtAbs env) targets+ -- Unset the default log action to avoid output going to stdout. Gap.unsetLogAction+ return targets' ----------------------------------------------------------------@@ -145,7 +198,15 @@ setHiDir :: FilePath -> G.DynFlags -> G.DynFlags setHiDir f d = d { G.hiDir = Just f} +extractUnits :: [String] -> ([String], [String])+extractUnits = go [] []+ where+ -- TODO: we should likely use the 'processCmdLineP' instead+ go units rest ("-unit" : x : xs) = go (x : units) rest xs+ go units rest (x : xs) = go units (x : rest) xs+ go units rest [] = (reverse units, reverse rest) + -- | Interpret and set the specific command line options. -- A lot of this code is just copied from ghc/Main.hs -- It would be good to move this code into a library module so we can just use it@@ -174,6 +235,7 @@ { G.importPaths = map makeAbs (G.importPaths df) , G.packageDBFlags = map (Gap.overPkgDbRef makeAbsOs) (G.packageDBFlags df)+ , G.workingDirectory = (root </>) <$> G.workingDirectory df } where makeAbs =
src/HIE/Bios/Flags.hs view
@@ -6,11 +6,9 @@ -- | Initialize the 'DynFlags' relating to the compilation of a single -- file or GHC session according to the provided 'Cradle'.-getCompilerOptions- :: FilePath -- ^ The file we are loading it because of- -> LoadStyle -- ^ previous files we might want to include in the build- -> Cradle a- -> IO (CradleLoadResult ComponentOptions)-getCompilerOptions fp loadStyle cradle = do++-- | Note: @getCompilerOptions (TargetWithContext path cxt) LoadFile@ will warn if `cxt` is non-empty.+getCompilerOptions :: TargetWithContext -> LoadMode -> Cradle a -> IO (CradleLoadResult ComponentOptions)+getCompilerOptions target loadMode cradle = do (cradleLogger cradle) <& LogProcessOutput "invoking build tool to determine build flags (this may take some time depending on the cache)" `WithSeverity` Info- runCradle (cradleOptsProg cradle) fp loadStyle+ runCradle (cradleOptsProg cradle) target loadMode
src/HIE/Bios/Ghc/Api.hs view
@@ -40,7 +40,7 @@ -> Cradle a -- ^ The cradle we want to load -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions)) -- ^ Whether we actually loaded the cradle or not. initializeFlagsWithCradleWithMessage msg fp cradle =- fmap (initSessionWithMessage msg) <$> liftIO (getCompilerOptions fp LoadFile cradle)+ fmap (initSessionWithMessage msg) <$> liftIO (getCompilerOptions (TargetWithContext fp []) LoadFile cradle) -- | Actually perform the initialisation of the session. Initialising the session corresponds to -- parsing the command line flags, setting the targets for the session and then attempting to load
src/HIE/Bios/Ghc/Gap.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleInstances, CPP, PatternSynonyms #-}+{-# LANGUAGE NondecreasingIndentation #-}+{-# LANGUAGE TupleSections #-} -- | All the CPP for GHC version compability should live in this module. module HIE.Bios.Ghc.Gap ( ghcVersion@@ -11,6 +13,8 @@ , G.modifySession , G.reflectGhc , G.Session(..)+ -- * Compat shims+ , typecheckModule -- * Hsc Monad , getHscEnv -- * Driver compat@@ -55,12 +59,15 @@ , load' , homeUnitId_ , getDynFlags+ , initMulti+ , InRTS(..)+ , removeRTS ) where import Control.Monad.IO.Class import qualified Control.Monad.Catch as E -import GHC+import GHC hiding (typecheckModule,parseTargetFiles) import qualified GHC as G ----------------------------------------------------------------@@ -96,6 +103,21 @@ #if __GLASGOW_HASKELL__ < 907 import GHC.Driver.CmdLine as CmdLine #endif+#if __GLASGOW_HASKELL__ >= 914+import qualified GHC.Driver.Session.Units as G+#else+import GHC.Unit.Home.ModInfo (emptyHomePackageTable)+import GHC.Unit.Env+import Control.Monad+import GHC.ResponseFile (expandResponse)+import Data.List (partition)+import GHC.Driver.Phases (isHaskellishTarget)+import qualified GHC.Unit.State as State+import System.FilePath (isRelative, (</>))+import qualified Data.Map as Map+#endif+import qualified Data.List.NonEmpty as NE+import Data.List (isPrefixOf, isSuffixOf) ghcVersion :: String ghcVersion = VERSION_ghc@@ -111,6 +133,13 @@ load' _ a b c = G.load' a b c #endif +typecheckModule :: GhcMonad m => ParsedModule -> m TypecheckedModule+#if MIN_VERSION_ghc(10, 1, 0)+typecheckModule = G.typecheckModule G.StartAndStopTcMPlugins+#else+typecheckModule = G.typecheckModule+#endif+ bracket :: E.MonadMask m => m a -> (a -> m c) -> (a -> m b) -> m b bracket = E.bracket@@ -303,3 +332,114 @@ unsafeDecodeUtf :: HasCallStack => OsPath -> FilePath unsafeDecodeUtf = fromMaybe (error "unsafeDecodeUtf") . OsPath.decodeUtf++initMulti :: NE.NonEmpty String -> (DynFlags -> [(String, Maybe Phase)] -> [String] -> [String] -> IO ()) -> Ghc [(String, Maybe UnitId, Maybe Phase)]+#if __GLASGOW_HASKELL__ >= 914+initMulti = G.initMulti+#else++-- taken from ghc-9.6.7, dropping some checks and logging.+initMulti unitArgsFiles _check = do+ hsc_env <- GHC.getSession+ let logger = hsc_logger hsc_env+ initial_dflags <- GHC.getSessionDynFlags++ dynFlagsAndSrcs <- forM unitArgsFiles $ \f -> do+ when (verbosity initial_dflags > 2) (liftIO $ print f)+ args <- liftIO $ expandResponse [f]+ (dflags2, fileish_args, _warns) <- parseDynamicFlagsCmdLine initial_dflags (map (mkGeneralLocated f) (removeRTS args))++ let (dflags3, srcs, _objs) = parseTargetFiles dflags2 (map unLoc fileish_args)+ dflags4 = offsetDynFlags dflags3++ let (hs_srcs, _non_hs_srcs) = partition isHaskellishTarget srcs+ pure (dflags4, hs_srcs)++ let+ unitDflags = NE.map fst dynFlagsAndSrcs+ srcs = NE.map (\(dflags, lsrcs) -> map (uncurry (,Just $ homeUnitId_ dflags,)) lsrcs) dynFlagsAndSrcs+ (hs_srcs, _non_hs_srcs) = unzip (map (partition (\(file, _uid, phase) -> isHaskellishTarget (file, phase))) (NE.toList srcs))++ let (initial_home_graph, mainUnitId) = createUnitEnvFromFlags unitDflags+ home_units = unitEnv_keys initial_home_graph++ home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do+ let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv+ hue_flags = homeUnitEnv_dflags homeUnitEnv+ dflags = homeUnitEnv_dflags homeUnitEnv+ (dbs,unit_state,home_unit,mconstants) <- liftIO $ State.initUnits logger hue_flags cached_unit_dbs home_units++ updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants+ pure $ HomeUnitEnv+ { homeUnitEnv_units = unit_state+ , homeUnitEnv_unit_dbs = Just dbs+ , homeUnitEnv_dflags = updated_dflags+ , homeUnitEnv_hpt = emptyHomePackageTable+ , homeUnitEnv_home_unit = Just home_unit+ }++ let dflags = homeUnitEnv_dflags $ unitEnv_lookup mainUnitId home_unit_graph+ unitEnv <- assertUnitEnvInvariant <$> (liftIO $ initUnitEnv mainUnitId home_unit_graph (ghcNameVersion dflags) (targetPlatform dflags))+ let final_hsc_env = hsc_env { hsc_unit_env = unitEnv }++ GHC.setSession final_hsc_env++ return $ concat hs_srcs++offsetDynFlags :: DynFlags -> DynFlags+offsetDynFlags dflags =+ dflags { hiDir = c hiDir+ , objectDir = c objectDir+ , stubDir = c stubDir+ , hieDir = c hieDir+ , dumpDir = c dumpDir }++ where+ c f = augment_maybe (f dflags)++ augment_maybe Nothing = Nothing+ augment_maybe (Just f) = Just (augment f)+ augment f | isRelative f, Just offset <- workingDirectory dflags = offset </> f+ | otherwise = f+++createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> (HomeUnitGraph, UnitId)+createUnitEnvFromFlags unitDflags =+ let+ newInternalUnitEnv dflags = mkHomeUnitEnv dflags emptyHomePackageTable Nothing+ unitEnvList = NE.map (\dflags -> (homeUnitId_ dflags, newInternalUnitEnv dflags)) unitDflags+ activeUnit = fst $ NE.head unitEnvList+ in+ (unitEnv_new (Map.fromList (NE.toList (unitEnvList))), activeUnit)+++#endif++-- | Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list.+data InRTS = OutsideRTS | InsideRTS++-- | Strip out any ["+RTS", ..., "-RTS"] sequences in the command string list.+--+-- >>> removeRTS ["option1", "+RTS -H32m -RTS", "option2"]+-- ["option1", "option2"]+--+-- >>> removeRTS ["option1", "+RTS", "-H32m", "-RTS", "option2"]+-- ["option1", "option2"]+--+-- >>> removeRTS ["option1", "+RTS -H32m"]+-- ["option1"]+--+-- >>> removeRTS ["option1", "+RTS -H32m", "-RTS", "option2"]+-- ["option1", "option2"]+--+-- >>> removeRTS ["option1", "+RTS -H32m", "-H32m -RTS", "option2"]+-- ["option1", "option2"]+removeRTS :: [String] -> [String]+removeRTS = go OutsideRTS+ where+ go :: InRTS -> [String] -> [String]+ go _ [] = []+ go OutsideRTS (y:ys)+ | "+RTS" `isPrefixOf` y = go (if "-RTS" `isSuffixOf` y then OutsideRTS else InsideRTS) ys+ | otherwise = y : go OutsideRTS ys+ go InsideRTS (y:ys) = go (if "-RTS" `isSuffixOf` y then OutsideRTS else InsideRTS) ys
src/HIE/Bios/Ghc/Load.hs view
@@ -163,7 +163,7 @@ -> Gap.Hsc Gap.FrontendResult astHook logger tc_ref ms = ghcInHsc $ do p <- G.parseModule =<< initializePluginsGhc logger ms- tcm <- G.typecheckModule p+ tcm <- Gap.typecheckModule p let tcg_env = fst (tm_internals_ tcm) liftIO $ modifyIORef tc_ref (tcm :) return $ Gap.FrontendTypecheck tcg_env
src/HIE/Bios/Internal/Debug.hs view
@@ -25,13 +25,14 @@ -- -- Otherwise, shows the error message and exit-code. debugInfo :: Show a- => FilePath- -> LoadStyle+ => TargetWithContext+ -> LoadMode -> Cradle a -> IO String-debugInfo fp loadStyle cradle = unlines <$> do+debugInfo fpc loadStyle cradle = unlines <$> do+ let fp = targetFilePath fpc let logger = cradleLogger cradle- res <- getCompilerOptions fp loadStyle cradle+ res <- getCompilerOptions fpc loadStyle cradle canonFp <- canonicalizePath fp conf <- findConfig canonFp crdl <- findCradle' logger canonFp
src/HIE/Bios/Types.hs view
@@ -102,14 +102,20 @@ | LogProcessOutput String | LogCreateProcessRun CreateProcess | LogProcessRun FilePath [FilePath]- | LogRequestedCradleLoadStyle !T.Text !LoadStyle- | LogComputedCradleLoadStyle !T.Text !LoadStyle- | LogLoadWithContextUnsupported !T.Text !(Maybe T.Text)+ | LogRequestedCradleLoadMode !T.Text !TargetWithContext !LoadMode+ | LogComputedCradleLoadMode !T.Text !TargetWithContext !LoadMode+ | LogLoadModeUnsupported !T.Text LoadMode !(Maybe T.Text) | LogCabalLoad !FilePath !(Maybe String) ![FilePath] ![FilePath] | LogCabalLibraryTooOld [String] | LogCabalPath !T.Text deriving (Show) +instance Pretty LoadMode where+ pretty = viaShow++instance Pretty TargetWithContext where+ pretty (TargetWithContext fp fps) = pretty fp <> list (map pretty fps)+ instance Pretty Log where pretty (LogAny s) = pretty s pretty (LogProcessOutput s) = pretty s@@ -129,21 +135,26 @@ ] where envText = map (indent 2 . pretty) $ prettyProcessEnv cp- pretty (LogRequestedCradleLoadStyle crdlName ls) =+ pretty (LogRequestedCradleLoadMode crdlName fpc ls) = "Requested to load" <+> pretty crdlName <+> "cradle" <+> case ls of- LoadFile -> "using single file mode"- LoadWithContext fps -> "using all files (multi-components):" <> line <> indent 4 (pretty fps)- pretty (LogComputedCradleLoadStyle crdlName ls) =+ LoadFile -> "using single file mode" <+> parens ("target =" <+> pretty fpc)+ LoadFileWithContext -> "using all files (multi-components):" <> line <> indent 4 (pretty fpc)+ LoadUnitsFromCradle -> "using all units specified in cradle" <+> fallback+ LoadUnitsInferred -> "using all units from project" <+> fallback+ where+ fallback = parens $ "fallback info: " <+> pretty fpc+ pretty (LogComputedCradleLoadMode crdlName _fpc ls) = "Load" <+> pretty crdlName <+> "cradle" <+> case ls of LoadFile -> "using single file"- LoadWithContext _ -> "using all files (multi-components)"-- pretty (LogLoadWithContextUnsupported crdlName mReason) =+ LoadFileWithContext -> "using all files (multi-components)"+ LoadUnitsFromCradle -> "using all units specified in cradle"+ LoadUnitsInferred -> "using all units from project"+ pretty (LogLoadModeUnsupported crdlName mode mReason) = pretty crdlName <+> "cradle doesn't support loading using all files (multi-components)" <> case mReason of Nothing -> "." Just reason -> ", because:" <+> pretty reason <> "."- <+> "Falling back loading to single file mode."+ <+> "Falling back" <+> parens ("from" <+> pretty mode ) <+> "loading to single file mode." pretty (LogCabalLoad file prefixes projectFile crs) = "Cabal Loading file" <+> pretty file <> line <> indent 4 "from project: " <+> pretty projectFile@@ -156,8 +167,24 @@ "Could not parse json output of 'cabal path': " <> line <> indent 4 (pretty err) --- | The 'LoadStyle' instructs a cradle on how to load a given file target.-data LoadStyle+type Component = String++-- | @TargetWithContext@ is only directly relevant for @LoadFile@ and @LoadFileWithContext@ modes.+-- Other modes though can fallback on those two, so relevant regardless.+data TargetWithContext = TargetWithContext+ { targetFilePath :: !FilePath+ , targetContext :: ![FilePath]+ }+ deriving (Show)++singleTarget :: FilePath -> TargetWithContext+singleTarget fp = TargetWithContext fp []++targetAndContext :: TargetWithContext -> [FilePath]+targetAndContext (TargetWithContext fp fps) = fp:fps++-- | The 'LoadMode' instructs a cradle on how to load a given file target.+data LoadMode = LoadFile -- ^ Instruct the cradle to load the given file target. --@@ -165,7 +192,7 @@ -- will configure the whole component the file target belongs to, and produce -- component options to load the component, which is the minimal unit of code in cabal repl. -- A 'default' cradle, on the other hand, will only load the given filepath.- | LoadWithContext [FilePath]+ | LoadFileWithContext -- ^ Give a cradle additional context for loading a file target. -- -- The context instructs the cradle to load the file target, while also loading@@ -173,12 +200,14 @@ -- This is useful for cradles that support loading multiple code units at once, -- e.g. cabal cradles can use the 'multi-repl' feature to set up a multiple home unit -- session in GHC.- deriving (Show, Eq, Ord)+ | LoadUnitsInferred+ | LoadUnitsFromCradle+ deriving (Eq,Ord,Enum,Bounded,Show) data CradleAction a = CradleAction { actionName :: ActionName a -- ^ Name of the action.- , runCradle :: FilePath -> LoadStyle -> IO (CradleLoadResult ComponentOptions)+ , runCradle :: TargetWithContext -> LoadMode -> IO (CradleLoadResult ComponentOptions) -- ^ Options to compile the given file with. , runGhcCmd :: [String] -> IO (CradleLoadResult String) -- ^ Executes the @ghc@ binary that is usually used to
tests/BiosTests.hs view
@@ -4,7 +4,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeApplications #-}-module Main where+module Main (main) where import Utils @@ -17,11 +17,12 @@ import HIE.Bios import HIE.Bios.Cradle import HIE.Bios.Cradle.Cabal (cabalBuildDir)-import Control.Monad (forM_)+import HIE.Bios.Types (LoadMode(..))+import Control.Monad (forM_, forM, unless) import Control.Monad.Extra (unlessM) import Control.Monad.IO.Class import Data.Foldable (for_)-import Data.List ( sort, isPrefixOf )+import Data.List ( sort, isPrefixOf, isInfixOf, tails ) import Data.Typeable import System.Exit (ExitCode(ExitSuccess, ExitFailure)) import System.Directory@@ -29,6 +30,8 @@ import System.Info.Extra (isWindows) import System.IO (BufferMode (LineBuffering), hSetBuffering, stderr, stdout) import qualified HIE.Bios.Ghc.Gap as Gap+import HIE.Bios.Cradle.Utils (expandGhcOptionResponseFile)+import HIE.Bios.Environment (extractUnits) argDynamic :: [String]@@ -89,7 +92,7 @@ assertCradle isMultiCradle step "Attempt to load symlinked module A" do- loadComponentOptions "./a/A.hs"+ loadComponentOptions "./a/A.hs" [] assertComponentOptions $ \opts -> componentOptions opts `shouldMatchList` ["a"] <> argDynamic @@ -103,7 +106,7 @@ liftIO $ createDirectoryLink (rooted "a") (rooted "./b") liftIO $ unlessM (doesFileExist $ rooted "b/A.hs") $ assertFailure "Test invariant broken, this file must exist."- loadComponentOptions "./b/A.hs"+ loadComponentOptions "./b/A.hs" [] assertComponentOptions $ \opts -> componentOptions opts `shouldMatchList` ["b"] <> argDynamic @@ -117,7 +120,7 @@ liftIO $ createDirectoryLink (rooted "./a") (rooted "./c") liftIO $ unlessM (doesFileExist $ rooted "c/A.hs") $ assertFailure "Test invariant broken, this file must exist."- loadComponentOptions "./c/A.hs"+ loadComponentOptions "./c/A.hs" [] assertLoadNone ] @@ -126,7 +129,7 @@ [ biosTestCase "failing-bios" $ runTestEnv "./failing-bios" $ do initCradle "B.hs" assertCradle isBiosCradle- loadComponentOptions "B.hs"+ loadComponentOptions "B.hs" [] assertCradleError $ \CradleError {..} -> do cradleErrorExitCode @?= ExitFailure 1 cradleErrorDependencies `shouldMatchList` ["hie.yaml"]@@ -154,7 +157,7 @@ biosCradleDeps fp deps = do initCradle fp assertCradle isBiosCradle- loadComponentOptions fp+ loadComponentOptions fp [] assertComponentOptions $ \opts -> do deps @?= componentDependencies opts @@ -172,13 +175,13 @@ cabalTestCases :: ToolDependency -> [TestTree] cabalTestCases extraGhcDep = [- biosTestCase "failing-cabal" $ runTestEnv "./failing-cabal" $ do- cabalAttemptLoad "MyLib.hs"+ biosTestCaseAll "failing-cabal" $ runTestEnv "./failing-cabal" $ do+ attemptCabalSingleTargetLoad "MyLib.hs" assertCradleError (\CradleError {..} -> do cradleErrorExitCode @?= ExitFailure 1 cradleErrorDependencies `shouldMatchList` ["failing-cabal.cabal", "cabal.project", "cabal.project.local"])- , biosTestCase "failing-cabal-multi-repl-with-shrink-error-files" $ runTestEnv "./failing-multi-repl-cabal-project" $ do- cabalAttemptLoadFiles "multi-repl-cabal-fail/app/Main.hs" ["multi-repl-cabal-fail/src/Lib.hs", "multi-repl-cabal-fail/src/Fail.hs", "NotInPath.hs"]+ , biosTestCaseMulti "failing-cabal-multi-repl-with-shrink-error-files" $ runTestEnv "./failing-multi-repl-cabal-project" $ do+ attemptCabalLoad "multi-repl-cabal-fail/app/Main.hs" ["multi-repl-cabal-fail/src/Lib.hs", "multi-repl-cabal-fail/src/Fail.hs", "NotInPath.hs"] root <- askRoot multiSupported <- isCabalMultipleCompSupported' if multiSupported@@ -190,15 +193,15 @@ (makeRelative root <$> cradleErrorLoadingFiles) `shouldMatchList` ["multi-repl-cabal-fail/app/Main.hs","multi-repl-cabal-fail/src/Fail.hs","multi-repl-cabal-fail/src/Lib.hs"]) else assertLoadSuccess >>= \ComponentOptions {} -> do return ()- , biosTestCase "simple-cabal" $ runTestEnv "./simple-cabal" $ do+ , biosTestCaseAll "simple-cabal" $ runTestEnv "./simple-cabal" $ do testDirectoryM isCabalCradle "B.hs"- , biosTestCase "build-dir" $ runTestEnv "./simple-cabal" $ do+ , biosTestCaseMulti "build-dir" $ runTestEnv "./simple-cabal" $ do initCradle "B.hs" assertCradle isCabalCradle root <- askRoot buildDir <- liftIO $ cabalBuildDir root -- use --multi-repl, as that was the codepath with the bug- loadFileGhcMultiStyle "B.hs" []+ loadFileGhc "B.hs" [] liftIO $ do -- Check we aren't trampling over dist-newstyle distNewstyleExists <- doesDirectoryExist (root </> "dist-newstyle")@@ -206,30 +209,50 @@ -- Check we are using the correct build directory buildDirExists <- doesDirectoryExist buildDir assertBool "build dir does not exist" buildDirExists- , biosTestCase "nested-cabal" $ runTestEnv "./nested-cabal" $ do- cabalAttemptLoad "sub-comp/Lib.hs"+ , biosTestCaseAll "nested-cabal" $ runTestEnv "./nested-cabal" $ do+ attemptCabalSingleTargetLoad "sub-comp/Lib.hs"+ mode <- askLoadMode assertComponentOptions $ \opts -> do- componentDependencies opts `shouldMatchList`- [ "sub-comp" </> "sub-comp.cabal"- , "cabal.project"- , "cabal.project.local"- ]- , biosTestCase "nested-cabal2" $ runTestEnv "./nested-cabal" $ do- cabalAttemptLoad "MyLib.hs"+ let+ expectedDeps+ | mode `elem` [LoadUnitsFromCradle,LoadUnitsInferred]+ = [ "nested-cabal.cabal"+ , "sub-comp" </> "sub-comp.cabal"+ , "cabal.project"+ , "cabal.project.local"+ ]+ | otherwise =+ [ "sub-comp" </> "sub-comp.cabal"+ , "cabal.project"+ , "cabal.project.local"+ ]+ componentDependencies opts `shouldMatchList` expectedDeps+ , biosTestCaseAll "nested-cabal2" $ runTestEnv "./nested-cabal" $ do+ attemptCabalSingleTargetLoad "MyLib.hs"+ mode <- askLoadMode assertComponentOptions $ \opts -> do- componentDependencies opts `shouldMatchList`- [ "nested-cabal.cabal"- , "cabal.project"- , "cabal.project.local"- ]- , biosTestCase "nested-cabal multi-mode includes enclosing deps for extra files" $ runTestEnv "./nested-cabal" $ do+ let+ expectedDeps+ | mode `elem` [LoadUnitsFromCradle,LoadUnitsInferred]+ = [ "nested-cabal.cabal"+ , "sub-comp" </> "sub-comp.cabal"+ , "cabal.project"+ , "cabal.project.local"+ ]+ | otherwise+ = [ "nested-cabal.cabal"+ , "cabal.project"+ , "cabal.project.local"+ ]+ componentDependencies opts `shouldMatchList` expectedDeps+ , biosTestCaseMulti "nested-cabal multi-mode includes enclosing deps for extra files" $ runTestEnv "./nested-cabal" $ do -- Initialize cradle first, since capability checks use the current cradle. initCradle "sub-comp/Lib.hs" assertCradle isCabalCradle multiSupported <- isCabalMultipleCompSupported' if multiSupported then do- loadComponentOptionsMultiStyle "sub-comp/Lib.hs" ["MyLib.hs"]+ loadComponentOptions "sub-comp/Lib.hs" ["MyLib.hs"] assertComponentOptions $ \opts -> do -- Expect both the main component's cabal file and the enclosing cabal for the extra file, -- plus project files.@@ -241,17 +264,17 @@ ] else do -- On older cabal/ghc combos, multi-repl isn't supported; just ensure load succeeds.- loadComponentOptions "sub-comp/Lib.hs"+ loadComponentOptions "sub-comp/Lib.hs" [] _ <- assertLoadSuccess pure ()- , biosTestCase "nested-cabal multi-mode includes enclosing deps when extra file is subcomp" $ runTestEnv "./nested-cabal" $ do+ , biosTestCaseMulti "nested-cabal multi-mode includes enclosing deps when extra file is subcomp" $ runTestEnv "./nested-cabal" $ do -- Initialize cradle at the top level, then treat the sub-component file as an extra file. initCradle "MyLib.hs" assertCradle isCabalCradle multiSupported <- isCabalMultipleCompSupported' if multiSupported then do- loadComponentOptionsMultiStyle "MyLib.hs" ["sub-comp/Lib.hs"]+ loadComponentOptions "MyLib.hs" ["sub-comp/Lib.hs"] assertComponentOptions $ \opts -> do componentDependencies opts `shouldMatchList` [ "nested-cabal.cabal"@@ -260,27 +283,29 @@ , "cabal.project.local" ] else do- loadComponentOptions "MyLib.hs"+ loadComponentOptions "MyLib.hs" [] _ <- assertLoadSuccess pure ()- , biosTestCase "multi-cabal" $ runTestEnv "./multi-cabal" $ do+ , biosTestCaseAll "multi-cabal" $ runTestEnv "./multi-cabal" $ do {- tests if both components can be loaded -} testDirectoryM isCabalCradle "app/Main.hs" testDirectoryM isCabalCradle "src/Lib.hs" , {- issue https://github.com/mpickering/hie-bios/issues/200 -}- biosTestCase "monorepo-cabal" $ runTestEnv "./monorepo-cabal" $ do+ biosTestCaseAll "monorepo-cabal" $ runTestEnv "./monorepo-cabal" $ do testDirectoryM isCabalCradle "A/Main.hs" testDirectoryM isCabalCradle "B/MyLib.hs" , testGroup "Implicit cradle tests" $- [ biosTestCase "implicit-cabal" $ runTestEnv "./implicit-cabal" $ do+ [ biosTestCaseAll "implicit-cabal" $ runTestEnv "./implicit-cabal" $ do testImplicitDirectoryM isCabalCradle "Main.hs"- , biosTestCase "implicit-cabal-no-project" $ runTestEnv "./implicit-cabal-no-project" $ do+ , biosTestCaseAll "implicit-cabal-no-project" $ runTestEnv "./implicit-cabal-no-project" $ do testImplicitDirectoryM isCabalCradle "Main.hs"- , biosTestCase "implicit-cabal-deep-project" $ runTestEnv "./implicit-cabal-deep-project" $ do+ , biosTestCaseAll "implicit-cabal-deep-project" $ runTestEnv "./implicit-cabal-deep-project" $ do testImplicitDirectoryM isCabalCradle "foo/Main.hs"+ , biosTestCase "implicit-cabal-deep-project-with-context" $ runTestModeEnv "./implicit-cabal-deep-project" LoadFileWithContext $ do+ testImplicitDirectoryWithContextM isCabalCradle "foo/Main.hs" ["Main.hs"] ] , testGroupWithDependency extraGhcDep- [ biosTestCase "Appropriate ghc and libdir" $ runTestEnvLocal "./cabal-with-ghc" $ do+ [ biosTestCaseAll "Appropriate ghc and libdir" $ runTestEnv "./cabal-with-ghc" $ do initCradle "src/MyLib.hs" assertCradle isCabalCradle loadRuntimeGhcLibDir@@ -288,32 +313,27 @@ loadRuntimeGhcVersion assertGhcVersionIs extraGhcVersion step "Find Component Options"- loadComponentOptions "src/MyLib.hs"+ loadComponentOptions "src/MyLib.hs" [] _ <- assertLoadSuccess pure () ] , testGroup "Cabal cabalProject"- [ biosTestCase "cabal-with-project, options propagated" $ runTestEnv "cabal-with-project" $ do- opts <- cabalLoadOptions "src/MyLib.hs"- liftIO $ do- "-O2" `elem` componentOptions opts- @? "Options must contain '-O2'"- , biosTestCase "cabal-with-project, load" $ runTestEnv "cabal-with-project" $ do+ [ biosTestCaseAll "cabal-with-project, options propagated" $ runTestEnv "cabal-with-project" $ do+ _opts <- cabalLoadOptions "src/MyLib.hs"+ assertOptionsContain "-O2" Nothing+ , biosTestCaseAll "cabal-with-project, load" $ runTestEnv "cabal-with-project" $ do testDirectoryM isCabalCradle "src/MyLib.hs"- , biosTestCase "multi-cabal-with-project, options propagated" $ runTestEnv "multi-cabal-with-project" $ do- optsAppA <- cabalLoadOptions "appA/src/Lib.hs"- liftIO $ do- "-O2" `elem` componentOptions optsAppA- @? "Options must contain '-O2'"- optsAppB <- cabalLoadOptions "appB/src/Lib.hs"- liftIO $ do- "-O2" `notElem` componentOptions optsAppB- @? "Options must not contain '-O2'"- , biosTestCase "multi-cabal-with-project, load" $ runTestEnv "multi-cabal-with-project" $ do+ , biosTestCaseAll "multi-cabal-with-project, options propagated" $ runTestEnv "multi-cabal-with-project" $ do+ _optsAppA <- cabalLoadOptions "appA/src/Lib.hs"+ assertOptionsContain "-O2" (Just "appA")+ , biosTestCaseAll "multi-cabal-with-project, options not propagated" $ runTestEnv "multi-cabal-with-project" $ do+ _optsAppB <- cabalLoadOptions "appB/src/Lib.hs"+ assertOptionsDoNotContain "-O2" (Just "appB")+ , biosTestCaseAll "multi-cabal-with-project, load" $ runTestEnv "multi-cabal-with-project" $ do testDirectoryM isCabalCradle "appB/src/Lib.hs" testDirectoryM isCabalCradle "appB/src/Lib.hs" , testGroupWithDependency extraGhcDep- [ biosTestCase "Honours extra ghc setting" $ runTestEnv "cabal-with-ghc-and-project" $ do+ [ biosTestCaseAll "Honours extra ghc setting" $ runTestEnv "cabal-with-ghc-and-project" $ do initCradle "src/MyLib.hs" assertCradle isCabalCradle loadRuntimeGhcLibDir@@ -321,17 +341,17 @@ loadRuntimeGhcVersion assertGhcVersionIs extraGhcVersion step "Find Component Options"- loadComponentOptions "src/MyLib.hs"+ loadComponentOptions "src/MyLib.hs" [] _ <- assertLoadSuccess pure () ]- , biosTestCase "force older Cabal version in custom setup" $ runTestEnv "cabal-with-custom-setup" $ do+ , biosTestCaseAll "force older Cabal version in custom setup" $ runTestEnv "cabal-with-custom-setup" $ do -- Specifically tests whether cabal 3.16 works as expected with -- an older lib:Cabal version that doesn't support '--with-repl'. -- This test doesn't hurt for other cases as well, so we enable it for -- all configurations. testDirectoryM isCabalCradle "src/MyLib.hs"- , biosTestCase "force older Cabal version in custom setup with multi mode" $ runTestEnv "cabal-with-custom-setup" $ do+ , biosTestCaseMulti "force older Cabal version in custom setup with multi mode" $ runTestEnv "cabal-with-custom-setup" $ do -- Specifically tests whether cabal 3.16 works as expected with -- an older lib:Cabal version that doesn't support '--with-repl'. -- This test doesn't hurt for other cases as well, so we enable it for@@ -344,29 +364,85 @@ loadRuntimeGhcVersion assertGhcVersion -- suffices to force loading cabal's `--enable-multi-repl` codepath- loadFileGhcMultiStyle target []+ loadFileGhc target []+ , biosTestCase "multi-cabal-with-load" $ runTestModeEnv "multi-cabal-with-load" LoadUnitsFromCradle $ do+ opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"+ liftIO $ do+ unless (any ("appA" `isInfixOf`) opts) $+ assertFailure $ "Missing appA: " ++ unwords opts+ unless (all (not . ("appB" `isInfixOf`)) opts) $+ assertFailure $ "Included appB: " ++ unwords opts+ , biosTestCase "multi-cabal-with-load-inferred" $ runTestModeEnv "multi-cabal-with-load" LoadUnitsInferred $ do+ -- LoadUnitsInferred should be unaffected by componentsToLoad+ opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"+ liftIO $ do+ unless (any ("appA" `isInfixOf`) opts) $+ assertFailure $ "Missing appA: " ++ unwords opts+ unless (any ("appB" `isInfixOf`) opts) $+ assertFailure $ "Missing appB: " ++ unwords opts+ , biosTestCase "cabal-with-load" $ runTestModeEnv "cabal-with-load" LoadUnitsFromCradle $ do+ opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"+ liftIO $ do+ unless (any ("appA" `isInfixOf`) opts) $+ assertFailure $ "Missing appA: " ++ unwords opts+ unless (all (not . ("appB" `isInfixOf`)) opts) $+ assertFailure $ "Included appB: " ++ unwords opts+ , biosTestCase "multi-cabal-with-load-superset" $ runTestModeEnv "multi-cabal-with-load-superset" LoadUnitsFromCradle $ do+ opts <- componentOptions <$> cabalLoadOptions "appA/src/Lib.hs"+ liftIO $ do+ unless (any ("appA" `isInfixOf`) opts) $+ assertFailure $ "Missing appA: " ++ unwords opts+ unless (any ("appB" `isInfixOf`) opts) $+ assertFailure $ "Missing appB: " ++ unwords opts ] ] where- cabalAttemptLoad :: FilePath -> TestM ()- cabalAttemptLoad fp = do- initCradle fp- assertCradle isCabalCradle- loadComponentOptions fp+ attemptCabalSingleTargetLoad fp = attemptCabalLoad fp [] - cabalAttemptLoadFiles :: FilePath -> [FilePath] -> TestM ()- cabalAttemptLoadFiles fp fps = do+ attemptCabalLoad :: FilePath -> [FilePath] -> TestM ()+ attemptCabalLoad fp fps = do initCradle fp assertCradle isCabalCradle- loadComponentOptionsMultiStyle fp fps+ loadComponentOptions fp fps cabalLoadOptions :: FilePath -> TestM ComponentOptions cabalLoadOptions fp = do initCradle fp assertCradle isCabalCradle- loadComponentOptions fp+ loadComponentOptions fp [] assertLoadSuccess +assertOptionsContain :: [Char] -> Maybe String -> TestM ()+assertOptionsContain flag munit = do+ doesContain <- hasOption flag munit+ liftIO $ doesContain @? ("Options must contain '" ++ flag ++ "'")++assertOptionsDoNotContain :: [Char] -> Maybe String -> TestM ()+assertOptionsDoNotContain flag munit = do+ doesContain <- hasOption flag munit+ liftIO $ not doesContain @? ("Options must not contain '" ++ flag ++ "'")++hasOption :: [Char] -> Maybe String -> TestM Bool+hasOption flag munit = elem flag <$> do+ options <- componentOptions <$> assertLoadSuccess+ mode <- askLoadMode+ let+ common | Nothing <- munit = do+ expandGhcOptionResponseFile options+ | Just unit <- munit = do+ let (units, rest) = extractUnits options+ fmap (concat . (rest:)) . forM units $ \ resp_file -> do+ unit_flags <- expandGhcOptionResponseFile [resp_file]+ if and [ unit `isInfixOf` uid | ("-this-unit-id":uid:_) <- tails unit_flags+ ]+ then pure unit_flags+ else pure []+ liftIO $ case mode of+ LoadFile -> return options+ LoadFileWithContext -> expandGhcOptionResponseFile options+ LoadUnitsFromCradle -> common+ LoadUnitsInferred -> common+ stackTestCases :: [TestTree] stackTestCases = [ expectFailBecause "stack repl does not fail on an invalid cabal file" $@@ -380,6 +456,8 @@ , biosTestCase "multi-stack" $ runTestEnv "./multi-stack" $ do {- tests if both components can be loaded -} testDirectoryM isStackCradle "app/Main.hs" testDirectoryM isStackCradle "src/Lib.hs"+ , biosTestCaseMulti "multi-stack-multi-modes" $ runTestEnv "./multi-stack" $ do+ testDirectoryM isStackCradle "app/Main.hs" , biosTestCase "nested-stack" $ runTestEnv "./nested-stack" $ do stackAttemptLoad "sub-comp/Lib.hs" assertComponentOptions $ \opts ->@@ -396,6 +474,22 @@ {- tests if both components can be loaded -} testDirectoryM isStackCradle "appA/src/Lib.hs" testDirectoryM isStackCradle "appB/src/Lib.hs"+ , biosTestCase "multi-stack-with-load" $ runTestModeEnv "multi-stack-with-load" LoadUnitsFromCradle $ do+ testDirectoryM isStackCradle "appA/src/LibA.hs"+ assertComponentOptions $ \ opts0 -> do+ let opts = componentOptions opts0+ unless (any ("appA" `isInfixOf`) opts) $+ assertFailure $ "Missing appA: " ++ unwords opts+ unless (all (not . ("appB" `isInfixOf`)) opts) $+ assertFailure $ "Included appB: " ++ unwords opts+ , biosTestCase "multi-stack-with-load-inferred" $ runTestModeEnv "multi-stack-with-load" LoadUnitsInferred $ do+ testDirectoryM isStackCradle "appA/src/LibA.hs"+ assertComponentOptions $ \ opts0 -> do+ let opts = componentOptions opts0+ unless (any ("appA" `isInfixOf`) opts) $+ assertFailure $ "Missing appA: " ++ unwords opts+ unless (any ("appB" `isInfixOf`) opts) $+ assertFailure $ "Missing appB: " ++ unwords opts , -- Test for special characters in the path for parsing of the ghci-scripts. -- Issue https://github.com/mpickering/hie-bios/issues/162@@ -403,11 +497,11 @@ testDirectoryM isStackCradle "A.hs" testDirectoryM isStackCradle "B.hs" , testGroup "Implicit cradle tests"- [ biosTestCase "implicit-stack" $ runTestEnv "./implicit-stack" $+ [ biosTestCase "implicit-stack" $ runTestModeEnv "./implicit-stack" LoadFile $ do testImplicitDirectoryM isStackCradle "Main.hs"- , biosTestCase "implicit-stack-multi" $ runTestEnv "./implicit-stack-multi" $ do+ , biosTestCase "implicit-stack-multi" $ runTestModeEnv "./implicit-stack-multi" LoadFile $ do testImplicitDirectoryM isStackCradle "Main.hs"- testImplicitDirectoryM isStackCradle "other-package/Main.hs"+ testImplicitDirectoryM isStackCradle "other-package/Main.hs" ] ] where@@ -415,7 +509,7 @@ stackAttemptLoad fp = do initCradle fp assertCradle isStackCradle- loadComponentOptions fp+ loadComponentOptions fp [] directTestCases :: [TestTree] directTestCases =@@ -456,11 +550,27 @@ infix 1 `shouldMatchList` -biosTestCase :: TestName -> (Bool -> Assertion) -> TestTree+biosTestCase :: TestName -> (TestConfig -> Assertion) -> TestTree biosTestCase name assertion = askOption @VerboseLogging (\case- VerboseLogging verbose -> testCase name (assertion verbose)+ VerboseLogging verbose ->+ testCaseSteps name (\ stepF -> testWrapper verbose stepF) )+ where+ testWrapper verbose stepF =+ assertion defConfig{testVerbose=verbose,testStepFunction=stepF} +biosTestCaseMulti :: TestName -> (TestConfig -> Assertion) -> TestTree+biosTestCaseMulti name act = testGroup name $ biosTestsForAllModes [LoadFileWithContext .. ] act++biosTestCaseAll :: TestName -> (TestConfig -> Assertion) -> TestTree+biosTestCaseAll name act = testGroup name $ biosTestsForAllModes [minBound .. ] act++biosTestsForAllModes :: [LoadMode] -> (TestConfig -> Assertion) -> [TestTree]+biosTestsForAllModes modes assertion =+ [ biosTestCase (show mode) (\ conf -> assertion (conf{testLoadModeConfig=mode}))+ | mode <- modes+ ]+ -- ------------------------------------------------------------------ -- Stack related helper functions -- ------------------------------------------------------------------@@ -482,6 +592,7 @@ , ("tests" </> "projects" </> "implicit-stack-multi", "stack.yaml", ["."]) , ("tests" </> "projects" </> "multi-stack-with-yaml", "stack-alt.yaml", ["appA", "appB"]) , ("tests" </> "projects" </> "stack-with-yaml", "stack-alt.yaml", ["."])+ , ("tests" </> "projects" </> "multi-stack-with-load", "stack.yaml", ["appA", "appB"]) ] stackYaml :: String -> [FilePath] -> String
tests/ParserTests.hs view
@@ -26,58 +26,64 @@ main :: IO () main = defaultMain $ testGroup "Parser Tests"- [ assertParser "cabal-1.yaml" (noDeps (Cabal $ CabalType (Just "lib:hie-bios") Nothing))- , assertParser "stack-config.yaml" (noDeps (Stack $ StackType Nothing Nothing))+ [ assertParser "cabal-1.yaml" (noDeps (Cabal $ CabalType (Just "lib:hie-bios") Nothing Nothing))+ , assertParser "stack-config.yaml" (noDeps (Stack $ StackType Nothing Nothing Nothing)) --, assertParser "bazel.yaml" (noDeps Bazel) , assertParser "bios-1.yaml" (noDeps (Bios (Program "program") Nothing Nothing)) , assertParser "bios-2.yaml" (noDeps (Bios (Program "program") (Just (Program "dep-program")) Nothing)) , assertParser "bios-3.yaml" (noDeps (Bios (Command "shellcommand") Nothing Nothing)) , assertParser "bios-4.yaml" (noDeps (Bios (Command "shellcommand") (Just (Command "dep-shellcommand")) Nothing)) , assertParser "bios-5.yaml" (noDeps (Bios (Command "shellcommand") (Just (Program "dep-program")) Nothing))- , assertParser "dependencies.yaml" (Config (CradleConfig ["depFile"] (Cabal $ CabalType (Just "lib:hie-bios") Nothing)))+ , assertParser "dependencies.yaml" (Config (CradleConfig ["depFile"] (Cabal $ CabalType (Just "lib:hie-bios") Nothing Nothing))) , assertParser "direct.yaml" (noDeps (Direct ["list", "of", "arguments"])) , assertParser "none.yaml" (noDeps None) --, assertParser "obelisk.yaml" (noDeps Obelisk)- , assertParser "multi.yaml" (noDeps (Multi [("./src", CradleConfig [] (Cabal $ CabalType (Just "lib:hie-bios") Nothing))- ,("./test", CradleConfig [] (Cabal $ CabalType (Just "test") Nothing))]))+ , assertParser "multi.yaml" (noDeps (Multi [("./src", CradleConfig [] (Cabal $ CabalType (Just "lib:hie-bios") Nothing Nothing))+ ,("./test", CradleConfig [] (Cabal $ CabalType (Just "test") Nothing Nothing))])) - , assertParser "cabal-multi.yaml" (noDeps (CabalMulti (CabalType Nothing Nothing)- [("./src", CabalType (Just "lib:hie-bios") Nothing)- ,("./", CabalType (Just "lib:hie-bios") Nothing)]))+ , assertParser "cabal-multi.yaml" (noDeps (CabalMulti (CabalType Nothing Nothing Nothing)+ [("./src", CabalType (Just "lib:hie-bios") Nothing Nothing)+ ,("./", CabalType (Just "lib:hie-bios") Nothing Nothing)])) - , assertParser "stack-multi.yaml" (noDeps (StackMulti (StackType Nothing Nothing)- [("./src", StackType (Just "lib:hie-bios") Nothing)- ,("./", StackType (Just"lib:hie-bios") Nothing)]))+ , assertParser "stack-multi.yaml" (noDeps (StackMulti (StackType Nothing Nothing Nothing)+ [("./src", StackType (Just "lib:hie-bios") Nothing Nothing)+ ,("./", StackType (Just"lib:hie-bios") Nothing Nothing)])) , assertParser "nested-cabal-multi.yaml" (noDeps (Multi [("./test/testdata", CradleConfig [] None) ,("./", CradleConfig [] (- CabalMulti (CabalType Nothing Nothing)- [("./src", CabalType (Just "lib:hie-bios") Nothing)- ,("./tests", CabalType (Just "parser-tests") Nothing)]))]))+ CabalMulti (CabalType Nothing Nothing Nothing)+ [("./src", CabalType (Just "lib:hie-bios") Nothing Nothing)+ ,("./tests", CabalType (Just "parser-tests") Nothing Nothing)]))])) , assertParser "nested-stack-multi.yaml" (noDeps (Multi [("./test/testdata", CradleConfig [] None) ,("./", CradleConfig [] (- StackMulti (StackType Nothing Nothing)- [("./src", StackType (Just "lib:hie-bios") Nothing)- ,("./tests", StackType (Just "parser-tests") Nothing)]))]))+ StackMulti (StackType Nothing Nothing Nothing)+ [("./src", StackType (Just "lib:hie-bios") Nothing Nothing)+ ,("./tests", StackType (Just "parser-tests") Nothing Nothing)]))])) -- Assertions for cabal.project files , assertParser "cabal-with-project.yaml"- (noDeps (Cabal $ CabalType Nothing (Just "cabal.project.extra")))+ (noDeps (Cabal $ CabalType Nothing (Just "cabal.project.extra") Nothing)) , assertParser "cabal-with-both.yaml"- (noDeps (Cabal $ CabalType (Just "hie-bios:hie") (Just "cabal.project.extra")))+ (noDeps (Cabal $ CabalType (Just "hie-bios:hie") (Just "cabal.project.extra") Nothing)) , assertParser "multi-cabal-with-project.yaml"- (noDeps (CabalMulti (CabalType Nothing (Just "cabal.project.extra"))- [("./src", CabalType (Just "lib:hie-bios") Nothing)- ,("./vendor", CabalType (Just "parser-tests") Nothing)]))+ (noDeps (CabalMulti (CabalType Nothing (Just "cabal.project.extra") Nothing)+ [("./src", CabalType (Just "lib:hie-bios") Nothing Nothing)+ ,("./vendor", CabalType (Just "parser-tests") Nothing Nothing)]))+ , assertParser "multi-cabal-with-load.yaml"+ (noDeps (CabalMulti (CabalType Nothing (Just "cabal.project.extra") (Just ["lib:hie-bios","parser-tests","some-other"]))+ [("./src", CabalType (Just "lib:hie-bios") Nothing Nothing)+ ,("./vendor", CabalType (Just "parser-tests") Nothing Nothing)]))+ , assertParser "cabal-with-load.yaml"+ (noDeps (Cabal (CabalType Nothing Nothing (Just ["lib:hie-bios","parser-tests","some-other"])))) -- Assertions for stack.yaml files , assertParser "stack-with-yaml.yaml"- (noDeps (Stack $ StackType Nothing (Just "stack-8.8.3.yaml")))+ (noDeps (Stack $ StackType Nothing (Just "stack-8.8.3.yaml") Nothing)) , assertParser "stack-with-both.yaml"- (noDeps (Stack $ StackType (Just "hie-bios:hie") (Just "stack-8.8.3.yaml")))+ (noDeps (Stack $ StackType (Just "hie-bios:hie") (Just "stack-8.8.3.yaml") Nothing)) , assertParser "multi-stack-with-yaml.yaml"- (noDeps (StackMulti (StackType Nothing (Just "stack-8.8.3.yaml"))- [("./src", StackType (Just "lib:hie-bios") Nothing)- ,("./vendor", StackType (Just "parser-tests") Nothing)]))+ (noDeps (StackMulti (StackType Nothing (Just "stack-8.8.3.yaml") Nothing)+ [("./src", StackType (Just "lib:hie-bios") Nothing Nothing)+ ,("./vendor", StackType (Just "parser-tests") Nothing Nothing)])) , assertCustomParser "ch-cabal.yaml" (noDeps (Other CabalHelperCabal $ simpleCabalHelperYaml "cabal"))@@ -87,11 +93,18 @@ (noDeps (Multi [ ("./src", CradleConfig [] (Other CabalHelperStack $ simpleCabalHelperYaml "stack")) , ("./input", CradleConfig [] (Other CabalHelperCabal $ simpleCabalHelperYaml "cabal"))- , ("./test", CradleConfig [] (Cabal $ CabalType (Just "test") Nothing))+ , ("./test", CradleConfig [] (Cabal $ CabalType (Just "test") Nothing Nothing)) , (".", CradleConfig [] None) ])) , assertParserFails "keys-not-unique-fails.yaml" invalidYamlException- , assertParser "cabal-empty-config.yaml" (noDeps (Cabal $ CabalType Nothing Nothing))+ , assertParser "cabal-empty-config.yaml" (noDeps (Cabal $ CabalType Nothing Nothing Nothing))+ , assertParserFails "single-components.yaml" aesonException+ , assertParser "multi-stack-with-load.yaml"+ (noDeps (StackMulti (StackType Nothing (Just "stack.extra.yaml") (Just ["lib:hie-bios","parser-tests","some-other"]))+ [("./src", StackType (Just "lib:hie-bios") Nothing Nothing)+ ,("./vendor", StackType (Just "parser-tests") Nothing Nothing)]))+ , assertParser "stack-with-load.yaml"+ (noDeps (Stack (StackType Nothing Nothing (Just ["lib:hie-bios","parser-tests","some-other"])))) ] assertParser :: FilePath -> Config Void -> TestTree@@ -104,6 +117,10 @@ invalidYamlException :: Selector ParseException invalidYamlException (InvalidYaml (Just _)) = True invalidYamlException _ = False++aesonException :: Selector ParseException+aesonException (AesonException _) = True+aesonException _ = False assertParserFails :: Exception e => FilePath -> Selector e -> TestTree assertParserFails fp es = testCase fp $ (readConfig (configDir </> fp) :: IO (Config Void)) `shouldThrow` es
tests/Utils.hs view
@@ -12,6 +12,7 @@ -- * Run Tests runTestEnv,+ runTestModeEnv, runTestEnv', runTestEnvLocal, @@ -28,6 +29,7 @@ askStep, askLogger, askCradle,+ askLoadMode, askLoadResult, askOrLoadLibDir, askLibDir,@@ -43,11 +45,9 @@ initCradle, initImplicitCradle, loadComponentOptions,- loadComponentOptionsMultiStyle, loadRuntimeGhcLibDir, loadRuntimeGhcVersion, loadFileGhc,- loadFileGhcMultiStyle, isCabalMultipleCompSupported', -- * Assertion helpers@@ -67,6 +67,7 @@ -- * High-level test helpers testDirectoryM, testImplicitDirectoryM,+ testImplicitDirectoryWithContextM, findCradleForModuleM, ) where @@ -94,6 +95,8 @@ import Colog.Core import qualified Data.Text as Text import Data.Function ((&))+import qualified Control.Exception as C+import System.Environment (lookupEnv) -- --------------------------------------------------------------------------- -- Test configuration and information@@ -105,8 +108,9 @@ { useTemporaryDirectory :: Bool , testProjectRoots :: FilePath , testVerbose :: Bool+ , testStepFunction :: String -> IO ()+ , testLoadModeConfig :: LoadMode }- deriving (Eq, Show, Ord) data TestEnv ext = TestEnv { testCradleType :: Maybe (Cradle ext)@@ -115,26 +119,39 @@ , testGhcVersionResult :: Maybe (CradleLoadResult String) , testRootDir :: FilePath , testLogger :: L.LogAction IO (L.WithSeverity HIE.Log)+ , testLoadMode :: LoadMode } defConfig :: TestConfig-defConfig = TestConfig True "./tests/projects" False+defConfig =+ TestConfig+ { useTemporaryDirectory = True+ , testProjectRoots = "./tests/projects"+ , testVerbose = False+ , testStepFunction = unLogAction logStringStderr+ , testLoadModeConfig = LoadFile+ } -runTestEnv :: FilePath -> TestM a -> Bool -> IO a-runTestEnv fp act verbose = runTestEnv' defConfig{testVerbose=verbose} fp act+runTestEnv :: FilePath -> TestM a -> TestConfig -> IO a+runTestEnv fp act testConf = runTestEnv' testConf fp act -runTestEnvLocal :: FilePath -> TestM a -> Bool -> IO a-runTestEnvLocal fp act verbose = runTestEnv' defConfig{useTemporaryDirectory = False,testVerbose=verbose} fp act+runTestModeEnv :: FilePath -> LoadMode -> TestM a -> TestConfig -> IO a+runTestModeEnv fp loadMode act testConf = runTestEnv' testConf{testLoadModeConfig=loadMode} fp act +runTestEnvLocal :: FilePath -> TestM a -> TestConfig -> IO a+runTestEnvLocal fp act testConf = runTestEnv' testConf{useTemporaryDirectory = False} fp act+ runTestEnv' :: TestConfig -> FilePath -> TestM a -> IO a runTestEnv' config root act = do -- We need to copy over the directory to somewhere outside the source tree -- when we test, since the cabal.project/stack.yaml/hie.yaml file in the root -- of this repository interferes with the test cradles!- let wrapper =+ let wrapper r cont = if useTemporaryDirectory config- then withTempCopy- else \r cont -> cont r+ then do+ mkeep <- lookupEnv "KEEP_TEMP_DIRS"+ withTempCopy (mkeep == Just "true") r cont+ else cont r mkEnv root' = TestEnv { testCradleType = Nothing@@ -143,13 +160,14 @@ , testGhcVersionResult = Nothing , testRootDir = root' , testLogger = init_logger+ , testLoadMode = testLoadModeConfig config } realRoot <- makeAbsolute $ testProjectRoots config </> root wrapper realRoot $ \root' -> flip evalStateT (mkEnv root') $ do step $ "Run test in: " <> root' act where- init_logger = L.logStringStderr+ init_logger = LogAction (testStepFunction config) & L.cmap printLog & L.filterBySeverity (if testVerbose config then Debug else Error) getSeverity printLog (L.WithSeverity l sev) = "[" ++ show sev ++ "] " ++ show (pretty l)@@ -245,6 +263,9 @@ askLogger :: TestM (L.LogAction IO (L.WithSeverity HIE.Log)) askLogger = gets testLogger +askLoadMode :: TestM LoadMode+askLoadMode = gets testLoadMode+ -- --------------------------------------------------------------------------- -- Test setup helpers -- ---------------------------------------------------------------------------@@ -276,6 +297,7 @@ crd <- case mcfg of Just cfg -> liftIO $ loadCradle logger cfg Nothing -> liftIO $ loadImplicitCradle logger a_fp+ step $ "Cradle: " ++ show crd setCradle crd initImplicitCradle :: FilePath -> TestM ()@@ -286,21 +308,16 @@ crd <- liftIO $ loadImplicitCradle logger a_fp setCradle crd -loadComponentOptions :: FilePath -> TestM ()-loadComponentOptions fp = do- a_fp <- normFile fp- crd <- askCradle- step $ "Initialise flags for: " <> fp- clr <- liftIO $ getCompilerOptions a_fp LoadFile crd- setLoadResult clr--loadComponentOptionsMultiStyle :: FilePath -> [FilePath] -> TestM ()-loadComponentOptionsMultiStyle fp fps = do+loadComponentOptions :: FilePath -> [FilePath] -> TestM ()+loadComponentOptions fp extraFps = do a_fp <- normFile fp- a_fps <- traverse normFile fps+ a_fps <- traverse normFile extraFps crd <- askCradle- step $ "Initialise flags for: " <> fp <> " and " <> show fps- clr <- liftIO $ getCompilerOptions a_fp (LoadWithContext a_fps) crd+ mode <- askLoadMode+ step $ "Initialise flags for " <> fp <> " using " <> show mode+ when (not $ null extraFps) $ do+ step $ "Provided context: " <> show extraFps+ clr <- liftIO $ getCompilerOptions (TargetWithContext a_fp a_fps) mode crd setLoadResult clr loadRuntimeGhcLibDir :: TestM ()@@ -324,32 +341,13 @@ versions <- liftIO $ makeVersions (cradleLogger cr) root ((runGhcCmd . cradleOptsProg) cr) liftIO $ isCabalMultipleCompSupported versions -loadFileGhc :: FilePath -> TestM ()-loadFileGhc fp = do- libdir <- askOrLoadLibDir- a_fp <- normFile fp- stepF <- askStep- step "Cradle load"- loadComponentOptions fp- opts <- assertLoadSuccess- liftIO $- G.runGhc (Just libdir) $ do- let (ini, _) = initSessionWithMessage' True (Just G.batchMsg) opts- sf <- ini- case sf of- -- Test resetting the targets- Succeeded -> do- liftIO $ stepF "Set target files"- setTargetFiles mempty [(a_fp, a_fp)]- Failed -> liftIO $ assertFailure "Module loading failed"--loadFileGhcMultiStyle :: FilePath -> [FilePath] -> TestM ()-loadFileGhcMultiStyle fp extraFps = do+loadFileGhc :: FilePath -> [FilePath] -> TestM ()+loadFileGhc fp extraFps = do libdir <- askOrLoadLibDir a_fp <- normFile fp stepF <- askStep step "Cradle load"- loadComponentOptionsMultiStyle fp extraFps+ loadComponentOptions fp extraFps opts <- assertLoadSuccess liftIO $ G.runGhc (Just libdir) $ do@@ -445,17 +443,20 @@ assertLibDirVersion loadRuntimeGhcVersion assertGhcVersion- loadFileGhc file+ loadFileGhc file [] testImplicitDirectoryM :: (Cradle Void -> Bool) -> FilePath -> TestM ()-testImplicitDirectoryM cradlePred file = do+testImplicitDirectoryM cradlePred file = testImplicitDirectoryWithContextM cradlePred file []++testImplicitDirectoryWithContextM :: (Cradle Void -> Bool) -> FilePath -> [FilePath] -> TestM ()+testImplicitDirectoryWithContextM cradlePred file ctxt = do initImplicitCradle file assertCradle cradlePred loadRuntimeGhcLibDir assertLibDirVersion loadRuntimeGhcVersion assertGhcVersion- loadFileGhc file+ loadFileGhc file ctxt findCradleForModuleM :: FilePath -> Maybe FilePath -> TestM () findCradleForModuleM fp expected' = do@@ -468,13 +469,21 @@ -- Copy Directory system utilities -- --------------------------------------------------------------------------- -withTempCopy :: FilePath -> (FilePath -> IO a) -> IO a-withTempCopy srcDir f =- withSystemTempDirectory "hie-bios-test" $ \newDir -> do- exists <- doesDirectoryExist srcDir- when exists $ do- copyDir srcDir newDir- f newDir+withTempCopy :: Bool -> FilePath -> (FilePath -> IO a) -> IO a+withTempCopy keep srcDir f = getCanonicalTemporaryDirectory >>= \targetDir -> do+ C.bracket+ (liftIO (createTempDirectory targetDir template))+ cleanup $ \newDir -> do+ exists <- doesDirectoryExist srcDir+ when exists $ do+ copyDir srcDir newDir+ f newDir+ where+ template = "hie-bios-test"+ cleanup dir | keep = return ()+ | otherwise = (liftIO . ignoringIOErrors . removeDirectoryRecursive) dir+ ignoringIOErrors ioe = ioe `C.catch` (\e -> const (return ()) (e :: IOError))+ copyDir :: FilePath -> FilePath -> IO () copyDir src dst = do
+ tests/configs/cabal-with-load.yaml view
@@ -0,0 +1,3 @@+cradle:+ cabal:+ componentsToLoad: ["lib:hie-bios","parser-tests","some-other"]
+ tests/configs/multi-cabal-with-load.yaml view
@@ -0,0 +1,9 @@+cradle:+ cabal:+ componentsToLoad: ["lib:hie-bios","parser-tests","some-other"]+ cabalProject: "cabal.project.extra"+ components:+ - path: "./src"+ component: "lib:hie-bios"+ - path: "./vendor"+ component: "parser-tests"
+ tests/configs/multi-stack-with-load.yaml view
@@ -0,0 +1,9 @@+cradle:+ stack:+ componentsToLoad: ["lib:hie-bios","parser-tests","some-other"]+ stackYaml: "stack.extra.yaml"+ components:+ - path: "./src"+ component: "lib:hie-bios"+ - path: "./vendor"+ component: "parser-tests"
+ tests/configs/single-components.yaml view
@@ -0,0 +1,2 @@+cabal:+ components: "exe:t3"
+ tests/configs/stack-with-load.yaml view
@@ -0,0 +1,3 @@+cradle:+ stack:+ componentsToLoad: ["lib:hie-bios","parser-tests","some-other"]
tests/projects/multi-cabal/multi-cabal.cabal view
@@ -1,4 +1,4 @@-cabal-version: >=2.0+cabal-version: 2.0 name: multi-cabal version: 0.1.0.0 build-type: Simple