hie-bios 0.12.1 → 0.13.0

raw patch · 34 files changed

+821/−464 lines, 34 filesdep ~ghcdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−2
• README.md +27/−3
• exe/Main.hs +11/−11
• hie-bios.cabal +19/−5
• src/HIE/Bios/Config.hs +35/−23
• src/HIE/Bios/Config/YAML.hs +17/−10
• src/HIE/Bios/Cradle.hs +397/−324
• src/HIE/Bios/Environment.hs +6/−8
• src/HIE/Bios/Flags.hs +5/−5
• src/HIE/Bios/Ghc/Api.hs +5/−7
• src/HIE/Bios/Ghc/Check.hs +5/−6
• src/HIE/Bios/Ghc/Gap.hs +2/−15
• src/HIE/Bios/Internal/Debug.hs +15/−15
• src/HIE/Bios/Types.hs +88/−7
• tests/BiosTests.hs +42/−3
• tests/ParserTests.hs +23/−13
• tests/Utils.hs +7/−7
• tests/configs/cabal-with-both.yaml +4/−0
• tests/configs/cabal-with-project.yaml +3/−0
• tests/configs/multi-cabal-with-project.yaml +8/−0
• tests/projects/cabal-with-ghc-and-project/cabal-with-ghc.cabal +9/−0
• tests/projects/cabal-with-ghc-and-project/cabal.project.8.10.7 +12/−0
• tests/projects/cabal-with-ghc-and-project/hie.yaml +3/−0
• tests/projects/cabal-with-ghc-and-project/src/MyLib.hs +4/−0
• tests/projects/cabal-with-project/cabal-with-project.cabal +9/−0
• tests/projects/cabal-with-project/cabal.project.8.10.7 +5/−0
• tests/projects/cabal-with-project/hie.yaml +3/−0
• tests/projects/cabal-with-project/src/MyLib.hs +4/−0
• tests/projects/multi-cabal-with-project/appA/appA.cabal +10/−0
• tests/projects/multi-cabal-with-project/appA/src/Lib.hs +1/−0
• tests/projects/multi-cabal-with-project/appB/appB.cabal +12/−0
• tests/projects/multi-cabal-with-project/appB/src/Lib.hs +1/−0
• tests/projects/multi-cabal-with-project/cabal.project.8.10.7 +6/−0
• tests/projects/multi-cabal-with-project/hie.yaml +16/−0

@@ -1,8 +1,13 @@ # ChangeLog hie-bios -## 2023-11-13 - 0.12.1+## 2023-98-22 - 0.13.0 -* 9.8 support [#417](https://github.com/haskell/hie-bios/pull/417)+* Multi Component cabal support [#409](https://github.com/haskell/hie-bios/pull/409)+* Make sure cabal caches can be found [#408](https://github.com/haskell/hie-bios/pull/408)+* Rename project-file to cabalProject in hie.yaml [#407](https://github.com/haskell/hie-bios/pull/407)+* Update README for new project-file key [#403](https://github.com/haskell/hie-bios/pull/403)+* Add more informative log messages for cradle running [#406](https://github.com/haskell/hie-bios/pull/406)+* Add cabal.project support for cabal cradles [#357](https://github.com/haskell/hie-bios/pull/357)  ## 2023-03-13 - 0.12.0 

@@ -298,13 +298,10 @@     * This is convenient if components are overlapping.  Similarly to `multi-stack` configurations, you can also specify multiple components using a `components` subkey.-While this is currently not used for anything, this syntax gives you a place to put defaults, directly under-the `cabal` entry.  ```yaml cradle:   cabal:-    # Reserved for future default options     components:     - path: "./src"       component: "lib:hie-bios"@@ -317,6 +314,33 @@ ```  This way we specified which component needs to be compiled given a certain source file for our whole project.++Some projects have multiple `cabal.project` files for multiple versions of ghc or development options. In this case you+can specify an alternate relative file to use by using the `cabalProject` option. The path is relative to the+`hie.yaml`.++```yaml+cradle:+  cabal:+    cabalProject: "./cabal.project.dev"+```++We can combine the `cabalProject` field with `components`:++```yaml+cradle:+  cabal:+    cabalProject: "./cabal.project.dev"+    components:+    - path: "./src"+      component: "lib:hie-bios"+    - path: "./exe"+      component: "exe:hie-bios"+    - path: "./tests/BiosTests.hs"+      component: "test:hie-bios"+    - path: "./tests/ParserTests.hs"+      component: "test:parser-tests"+```  #### Debugging a `cabal` cradle 

@@ -63,28 +63,28 @@     hSetEncoding stdout utf8     cwd <- getCurrentDirectory     cmd <- execParser progInfo-    cradle <--        -- find cradle does a takeDirectory on the argument, so make it into a file-        findCradle (cwd </> "File.hs") >>= \case-          Just yaml -> loadCradle yaml-          Nothing -> loadImplicitCradle (cwd </> "File.hs")-     let       printLog (L.WithSeverity l sev) = "[" ++ show sev ++ "] " ++ show (pretty l)       logger :: forall a . Pretty a => L.LogAction IO (L.WithSeverity a)       logger = L.cmap printLog L.logStringStderr +    cradle <-+        -- find cradle does a takeDirectory on the argument, so make it into a file+        findCradle (cwd </> "File.hs") >>= \case+          Just yaml -> loadCradle logger yaml+          Nothing -> loadImplicitCradle logger (cwd </> "File.hs")+     res <- case cmd of-      Check targetFiles -> checkSyntax logger logger cradle targetFiles+      Check targetFiles -> checkSyntax logger cradle targetFiles       Debug files -> case files of-        [] -> debugInfo logger (cradleRootDir cradle) cradle-        fp -> debugInfo logger fp cradle+        [] -> debugInfo (cradleRootDir cradle) cradle+        fp -> debugInfo fp cradle       Flags files -> case files of         -- TODO force optparse to acquire one         [] -> error "too few arguments"         _ -> do           res <- forM files $ \fp -> do-                  res <- getCompilerOptions logger fp cradle+                  res <- getCompilerOptions fp [] cradle                   case res of                       CradleFail (CradleError _deps _ex err) ->                         return $ "Failed to show flags for \""@@ -97,7 +97,7 @@                       CradleNone -> return $ "No flags/None Cradle: component " ++ fp ++ " should not be loaded"           return (unlines res)       ConfigInfo files -> configInfo files-      CradleInfo files -> cradleInfo files+      CradleInfo files -> cradleInfo logger files       Root    -> rootInfo cradle       Version -> return progVersion     putStr res

@@ -1,11 +1,11 @@ Cabal-Version:          2.2 Name:                   hie-bios-Version:                0.12.1+Version:                0.13.0 Author:                 Matthew Pickering <matthewtpickering@gmail.com> Maintainer:             Matthew Pickering <matthewtpickering@gmail.com> License:                BSD-3-Clause License-File:           LICENSE-Homepage:               https://github.com/mpickering/hie-bios+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 @@ -21,6 +21,14 @@                         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.8.10.7+                        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.8.10.7+                        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@@ -35,6 +43,12 @@                         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.8.10.7+                        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@@ -125,7 +139,7 @@                         tests/projects/stack-with-yaml/stack-with-yaml.cabal                         tests/projects/stack-with-yaml/src/Lib.hs -tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.4+tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.6 || ==9.6.2  Library   Default-Language:     Haskell2010@@ -162,11 +176,11 @@                         time                 >= 1.8.0 && < 1.13,                         extra                >= 1.6.14 && < 1.8,                         prettyprinter        ^>= 1.6 || ^>= 1.7.0,-                        ghc                  >= 8.6.1 && < 9.9,+                        ghc                  >= 8.6.1 && < 9.7,                         transformers         >= 0.5.2 && < 0.7,                         temporary            >= 1.2 && < 1.4,                         template-haskell,-                        text                 >= 1.2.3 && < 2.2,+                        text                 >= 1.2.3 && < 2.1,                         unix-compat          >= 0.5.1 && < 0.8,                         unordered-containers >= 0.2.9 && < 0.3,                         yaml                 >= 0.10.0 && < 0.12,

@@ -10,11 +10,12 @@     CabalType,     pattern CabalType,     cabalComponent,+    cabalProjectFile,     StackType,     pattern StackType,     stackComponent,     stackYaml,-    CradleType(..),+    CradleTree(..),     Callable(..)     ) where @@ -46,7 +47,7 @@         -- ^ Dependencies of a cradle.         -- Dependencies are expected to be relative to the root directory.         -- The given files are not required to exist.-        , cradleType :: CradleType a+        , cradleTree :: CradleTree a         -- ^ Type of the cradle to use. Actions to obtain         -- compiler flags from are dependant on this field.         }@@ -55,18 +56,28 @@ data Callable = Program FilePath | Command String     deriving (Show, Eq) +-- | A cabal yaml configuration consists of component configuration and project configuration.+--+-- The former specifies how we can find the compilation flags for any filepath+-- in the project.+-- There might be an explicit mapping from source directories to components,+-- or we let cabal figure it out on its own.+--+-- Project configuration is the 'cabal.project' file, we is by default named+-- 'cabal.project'. We allow to override that name to have an HLS specific+-- project configuration file. data CabalType-    = CabalType_ { _cabalComponent :: !(Last String) }+    = CabalType_ { _cabalComponent :: !(Last String), _cabalProjectFile :: !(Last FilePath) }     deriving (Eq)  instance Semigroup CabalType where-    CabalType_ cr <> CabalType_ cl = CabalType_ (cr <> cl)+    CabalType_ cr cpr <> CabalType_ cl cpl = CabalType_ (cr <> cl) (cpr <> cpl)  instance Monoid CabalType where-    mempty = CabalType_ mempty+    mempty = CabalType_ mempty mempty -pattern CabalType :: Maybe String -> CabalType-pattern CabalType { cabalComponent } = CabalType_ (Last cabalComponent)+pattern CabalType :: Maybe String -> Maybe FilePath -> CabalType+pattern CabalType { cabalComponent, cabalProjectFile } = CabalType_ (Last cabalComponent) (Last cabalProjectFile) {-# COMPLETE CabalType #-}  instance Show CabalType where@@ -82,14 +93,14 @@ instance Monoid StackType where     mempty = StackType_ mempty mempty -pattern StackType :: Maybe String -> Maybe String -> StackType+pattern StackType :: Maybe String -> Maybe FilePath -> StackType pattern StackType { stackComponent, stackYaml } = StackType_ (Last stackComponent) (Last stackYaml) {-# COMPLETE StackType #-}  instance Show StackType where   show = show . Stack -data CradleType a+data CradleTree a     = Cabal { cabalType :: !CabalType }     | CabalMulti { defaultCabal :: !CabalType, subCabalComponents :: [ (FilePath, CabalType) ] }     | Stack { stackType :: !StackType }@@ -114,7 +125,7 @@     | Other { otherConfig :: a, originalYamlValue :: Value }     deriving (Eq, Functor) -instance Show (CradleType a) where+instance Show (CradleTree a) where     show (Cabal comp) = "Cabal {component = " ++ show (cabalComponent comp) ++ "}"     show (CabalMulti d a) = "CabalMulti {defaultCabal = " ++ show d ++ ", subCabalComponents = " ++ show a ++ "}"     show (Stack comp) = "Stack {component = " ++ show (stackComponent comp) ++ ", stackYaml = " ++ show (stackYaml comp) ++ "}"@@ -143,30 +154,31 @@  fromYAMLConfig :: CradleConfigYAML a -> Config a fromYAMLConfig cradleYAML = Config $ CradleConfig (fromMaybe [] $ YAML.dependencies cradleYAML)-                                                  (toCradleType $ YAML.cradle cradleYAML)+                                                  (toCradleTree $ YAML.cradle cradleYAML) -toCradleType :: YAML.CradleComponent a -> CradleType a-toCradleType (YAML.Multi cpts)  =+toCradleTree :: YAML.CradleComponent a -> CradleTree a+toCradleTree (YAML.Multi cpts)  =   Multi $ (\(YAML.MultiSubComponent fp' cfg) -> (fp', cradle $ fromYAMLConfig cfg)) <$> cpts-toCradleType (YAML.Stack (YAML.StackConfig yaml cpts)) =+toCradleTree (YAML.Stack (YAML.StackConfig yaml 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.StackComponent fp' c cYAML) ->                                               (fp', StackType (Just c) cYAML)) <$> cs)-toCradleType (YAML.Cabal (YAML.CabalConfig cpts)) =+toCradleTree (YAML.Cabal (YAML.CabalConfig prjFile cpts)) =   case cpts of-    YAML.NoComponent          -> Cabal $ CabalType Nothing-    (YAML.SingleComponent c)  -> Cabal $ CabalType (Just c)-    (YAML.ManyComponents cs)  -> CabalMulti (CabalType Nothing)-                                            ((\(YAML.CabalComponent fp' c) -> (fp', CabalType (Just c))) <$> cs)-toCradleType (YAML.Direct cfg)  = Direct (YAML.arguments cfg)-toCradleType (YAML.Bios cfg)    = Bios  (toCallable $ YAML.callable cfg)+    YAML.NoComponent          -> Cabal $ CabalType Nothing prjFile+    (YAML.SingleComponent c)  -> Cabal $ CabalType (Just c) prjFile+    (YAML.ManyComponents cs)  -> CabalMulti (CabalType Nothing prjFile)+                                            ((\(YAML.CabalComponent fp' c cPrjFile) ->+                                              (fp', CabalType (Just c) cPrjFile)) <$> cs)+toCradleTree (YAML.Direct cfg)  = Direct (YAML.arguments cfg)+toCradleTree (YAML.Bios cfg)    = Bios  (toCallable $ YAML.callable cfg)                                         (toCallable <$> YAML.depsCallable cfg)                                         (YAML.ghcPath cfg)-toCradleType (YAML.None _)      = None-toCradleType (YAML.Other cfg)   = Other (YAML.otherConfig cfg)+toCradleTree (YAML.None _)      = None+toCradleTree (YAML.Other cfg)   = Other (YAML.otherConfig cfg)                                         (YAML.originalYamlValue cfg)  toCallable :: YAML.Callable -> Callable

@@ -29,8 +29,7 @@ import qualified Data.HashMap.Strict as Map import qualified Data.Text           as T #endif-import           Data.Aeson.Types    (Object, Parser, Value (Null),-                                      typeMismatch)+import           Data.Aeson.Types    (Parser, typeMismatch) import qualified Data.Char           as C (toLower) import           Data.List           ((\\)) import           GHC.Generics        (Generic)@@ -44,7 +43,7 @@ -- This used to be just a HashMap, but since aeson >= 2 -- this is an opaque datatype. type KeyMap v = Map.HashMap T.Text v- + keys :: KeyMap v -> [Key] keys = Map.keys #endif@@ -103,25 +102,33 @@                       } deriving (Generic, FromJSON)  data CabalConfig-  = CabalConfig { cabalComponents :: OneOrManyComponents CabalComponent }+  = CabalConfig { cabalProject    :: Maybe FilePath+                , cabalComponents :: OneOrManyComponents CabalComponent+                }  instance FromJSON CabalConfig where-  parseJSON v@(Array _)     = CabalConfig . ManyComponents <$> parseJSON v-  parseJSON v@(Object obj)  = (checkObjectKeys ["component", "components"] obj) *> (CabalConfig <$> parseJSON v)-  parseJSON Null            = pure $ CabalConfig NoComponent+  parseJSON v@(Array _)     = CabalConfig Nothing . ManyComponents <$> parseJSON v+  parseJSON v@(Object obj)  = (checkObjectKeys ["cabalProject", "component", "components"] obj)+                                *> (CabalConfig+                                  <$> obj .:? "cabalProject"+                                  <*> parseJSON v)+  parseJSON Null            = pure $ CabalConfig Nothing NoComponent   parseJSON v               = typeMismatch "CabalConfig" v  data CabalComponent   = CabalComponent { cabalPath      :: FilePath                    , cabalComponent :: String+                   , cabalComponentProject :: Maybe FilePath                    }  instance FromJSON CabalComponent where   parseJSON =-    let parseCabalComponent obj = checkObjectKeys ["path", "component"] obj+    let parseCabalComponent obj = checkObjectKeys ["path", "component", "cabalProject"] obj                                     *> (CabalComponent                                           <$> obj .: "path"-                                          <*> obj .: "component")+                                          <*> obj .: "component"+                                          <*> obj .:? "cabalProject"+                                        )      in withObject "CabalComponent" parseCabalComponent  data StackConfig@@ -132,7 +139,7 @@ data StackComponent   = StackComponent { stackPath          :: FilePath                    , stackComponent     :: String-                   , stackComponentYAML :: Maybe String+                   , stackComponentYAML :: Maybe FilePath                    }  instance FromJSON StackConfig where

@@ -2,6 +2,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE RecordWildCards #-} module HIE.Bios.Cradle (       findCradle     , loadCradle@@ -20,6 +23,9 @@     , readProcessWithOutputs     , readProcessWithCwd     , makeCradleResult+    -- | Cradle project configuration types+    , CradleProjectConfig(..)+    ,   ) where  import Control.Applicative ((<|>), optional)@@ -65,41 +71,9 @@ import GHC.Fingerprint (fingerprintString) import GHC.ResponseFile (escapeArgs) -------------------------------------------------------------------- Environment variables used by hie-bios.------ If you need more, add a constant here.--------------------------------------------------------------------- | Environment variable containing the filepath to which--- cradle actions write their results to.--- If the filepath does not exist, cradle actions must create them.-hie_bios_output :: String-hie_bios_output = "HIE_BIOS_OUTPUT"---- | Environment variable pointing to the GHC location used by--- cabal's and stack's GHC wrapper.------ If not set, will default to sensible defaults.-hie_bios_ghc :: String-hie_bios_ghc = "HIE_BIOS_GHC"---- | Environment variable with extra arguments passed to the GHC location--- in cabal's and stack's GHC wrapper.------ If not set, assume no extra arguments.-hie_bios_ghc_args :: String-hie_bios_ghc_args = "HIE_BIOS_GHC_ARGS"---- | Environment variable pointing to the source file location that caused--- the cradle action to be executed.-hie_bios_arg :: String-hie_bios_arg = "HIE_BIOS_ARG"---- | Environment variable pointing to a filepath to which dependencies--- of a cradle can be written to by the cradle action.-hie_bios_deps :: String-hie_bios_deps = "HIE_BIOS_DEPS"+import Data.Version+import System.IO.Unsafe (unsafeInterleaveIO)+import Text.ParserCombinators.ReadP (readP_to_S)  ---------------------------------------------------------------- @@ -110,76 +84,216 @@     runMaybeT (yamlConfig wdir)  -- | Given root\/hie.yaml load the Cradle.-loadCradle :: FilePath -> IO (Cradle Void)-loadCradle = loadCradleWithOpts absurd+loadCradle :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Cradle Void)+loadCradle l = loadCradleWithOpts l absurd  -- | Given root\/foo\/bar.hs, load an implicit cradle-loadImplicitCradle :: Show a => FilePath -> IO (Cradle a)-loadImplicitCradle wfile = do+loadImplicitCradle :: Show a => LogAction IO (WithSeverity Log) -> FilePath -> IO (Cradle a)+loadImplicitCradle l wfile = do   let wdir = takeDirectory wfile   cfg <- runMaybeT (implicitConfig wdir)-  return $ case cfg of-    Just bc -> getCradle absurd bc-    Nothing -> defaultCradle wdir+  case cfg of+    Just bc -> getCradle l absurd bc+    Nothing -> return $ defaultCradle l wdir  -- | Finding 'Cradle'. --   Find a cabal file by tracing ancestor directories. --   Find a sandbox according to a cabal sandbox config --   in a cabal directory.-loadCradleWithOpts :: (Yaml.FromJSON b) => (b -> Cradle a) -> FilePath -> IO (Cradle a)-loadCradleWithOpts buildCustomCradle wfile = do+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-    return $ getCradle buildCustomCradle (cradleConfig, takeDirectory wfile)+    getCradle l buildCustomCradle (cradleConfig, takeDirectory wfile) -getCradle :: (b -> Cradle a) -> (CradleConfig b, FilePath) -> Cradle a-getCradle buildCustomCradle (cc, wdir) = addCradleDeps cradleDeps $ case cradleType cc of-    Cabal CabalType{ cabalComponent = mc } -> cabalCradle wdir mc-    CabalMulti dc ms ->-      getCradle buildCustomCradle-        (CradleConfig cradleDeps-          (Multi [(p, CradleConfig [] (Cabal $ dc <> c)) | (p, c) <- ms])-        , wdir)-    Stack StackType{ stackComponent = mc, stackYaml = syaml} ->-      let-        stackYamlConfig = stackYamlFromMaybe wdir syaml-      in-        stackCradle wdir mc stackYamlConfig-    StackMulti ds ms ->-      getCradle buildCustomCradle-        (CradleConfig cradleDeps-          (Multi [(p, CradleConfig [] (Stack $ ds <> c)) | (p, c) <- ms])-        , wdir)- --   Bazel -> rulesHaskellCradle wdir- --   Obelisk -> obeliskCradle wdir-    Bios bios deps mbGhc -> biosCradle wdir bios deps mbGhc-    Direct xs -> directCradle wdir xs-    None      -> noneCradle wdir-    Multi ms  -> multiCradle buildCustomCradle wdir ms-    Other a _ -> buildCustomCradle a-    where-      cradleDeps = cradleDependencies cc+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+    resolvedCradlesToCradle l buildCustomCradle wdir rcs+  where+    cs = resolveCradleTree wdir cc -addCradleDeps :: [FilePath] -> Cradle a -> Cradle a-addCradleDeps deps c =-  c { cradleOptsProg = addActionDeps (cradleOptsProg c) }++-- | The actual type of action we will be using to process a file+data ConcreteCradle a+  = ConcreteCabal CabalType+  | ConcreteStack StackType+  | ConcreteBios Callable (Maybe Callable) (Maybe FilePath)+  | ConcreteDirect [String]+  | ConcreteNone+  | ConcreteOther a+  deriving Show++-- | ConcreteCradle augmented with information on which file the+-- cradle applies+data ResolvedCradle a+ = ResolvedCradle+ { prefix :: FilePath -- ^ the prefix to match files+ , cradleDeps :: [FilePath] -- ^ accumulated dependencies+ , concreteCradle :: ConcreteCradle a+ } deriving Show++-- | The final cradle config that specifies the cradle for+-- each prefix we know how to handle+data ResolvedCradles a+ = ResolvedCradles+ { cradleRoot :: FilePath+ , resolvedCradles :: [ResolvedCradle a] -- ^ In order of decreasing specificity+ , cradleProgramVersions :: ProgramVersions+ }++data ProgramVersions =+  ProgramVersions { cabalVersion  :: Maybe Version+                  , stackVersion  :: Maybe Version+                  , ghcVersion    :: Maybe Version+                  }++makeVersions :: LogAction IO (WithSeverity Log) -> FilePath -> ([String] -> IO (CradleLoadResult String)) -> IO ProgramVersions+makeVersions l wdir ghc = do+  cabalVersion <- unsafeInterleaveIO (getCabalVersion l wdir)+  stackVersion <- unsafeInterleaveIO (getStackVersion l wdir)+  ghcVersion <- unsafeInterleaveIO (getGhcVersion ghc)+  pure ProgramVersions{..}++getCabalVersion :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version)+getCabalVersion l wdir = do+  res <- readProcessWithCwd l wdir "cabal" ["--numeric-version"] ""+  case res of+    CradleSuccess stdo ->+      pure $ versionMaybe stdo+    _ -> pure Nothing++getStackVersion :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version)+getStackVersion l wdir = do+  res <- readProcessWithCwd l wdir "stack" ["--numeric-version"] ""+  case res of+    CradleSuccess stdo ->+      pure $ versionMaybe stdo+    _ -> pure Nothing++getGhcVersion :: ([String] -> IO (CradleLoadResult String)) -> IO (Maybe Version)+getGhcVersion ghc = do+  res <- ghc ["--numeric-version"]+  case res of+    CradleSuccess stdo ->+      pure $ versionMaybe stdo+    _ -> pure Nothing++versionMaybe :: String -> Maybe Version+versionMaybe xs = case reverse $ readP_to_S parseVersion xs of+  [] -> Nothing+  (x:_) -> Just (fst x)+++addActionDeps :: [FilePath] -> CradleLoadResult ComponentOptions -> CradleLoadResult ComponentOptions+addActionDeps deps =+  cradleLoadResult+      CradleNone+      (\err -> CradleFail (err { cradleErrorDependencies = cradleErrorDependencies err `union` deps }))+      (\(ComponentOptions os' dir ds) -> CradleSuccess (ComponentOptions os' dir (ds `union` deps)))+  ++resolvedCradlesToCradle :: Show a => LogAction IO (WithSeverity Log) -> (b -> CradleAction a) -> FilePath -> [ResolvedCradle b] -> IO (Cradle a)+resolvedCradlesToCradle logger buildCustomCradle root cs = mdo+  let run_ghc_cmd args =+        -- We're being lazy here and just returning the ghc path for the+        -- first non-none cradle. This shouldn't matter in practice: all+        -- sub cradles should be using the same ghc version!+        case filter (notNoneType . actionName) $ map snd cradleActions of+          [] -> return CradleNone+          (act:_) ->+            runGhcCmd+              act+              args+  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+        = ["Multi Cradle: No prefixes matched"+          , "pwd: " ++ root+          , "filepath: " ++ fp+          , "prefixes:"+          ] ++ [show (prefix pf, actionName cc) | (pf, cc) <- cradleActions]+  pure $ Cradle+    { cradleRootDir = root+    , cradleLogger = logger+    , cradleOptsProg = CradleAction+      { actionName = multiActionName+      , runCradle  = \fp prev -> do+          absfp <- makeAbsolute fp+          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)+      , runGhcCmd = run_ghc_cmd+      }+    }   where-    addActionDeps :: CradleAction a -> CradleAction a-    addActionDeps ca =-      ca { runCradle = \l fp ->-            (cradleLoadResult-                CradleNone-                (\err -> CradleFail (err { cradleErrorDependencies = cradleErrorDependencies err `union` deps }))-                (\(ComponentOptions os' dir ds) -> CradleSuccess (ComponentOptions os' dir (ds `union` deps)))-            )-            <$> runCradle ca l fp-         }+    multiActionName+      | all (\c -> isStackCradleConfig c || isNoneCradleConfig c) cs+      = Types.Stack+      | all (\c -> isCabalCradleConfig c || isNoneCradleConfig c) cs+      = Types.Cabal+      | [True] <- map isBiosCradleConfig $ filter (not . isNoneCradleConfig) cs+      = Types.Bios+      | [True] <- map isDirectCradleConfig $ filter (not . isNoneCradleConfig) cs+      = Types.Direct+      | otherwise+      = Types.Multi +    isStackCradleConfig cfg = case concreteCradle cfg of+      ConcreteStack{} -> True+      _               -> False++    isCabalCradleConfig cfg = case concreteCradle cfg of+      ConcreteCabal{} -> True+      _               -> False++    isBiosCradleConfig cfg = case concreteCradle cfg of+      ConcreteBios{}  -> True+      _               -> False++    isDirectCradleConfig cfg = case concreteCradle cfg of+      ConcreteDirect{} -> True+      _                -> False++    isNoneCradleConfig cfg = case concreteCradle cfg of+      ConcreteNone{} -> True+      _              -> False++    notNoneType Types.None = False+    notNoneType _ = True+++resolveCradleAction :: LogAction IO (WithSeverity Log) ->  (b -> CradleAction a) -> ResolvedCradles b -> FilePath -> ResolvedCradle b -> CradleAction a+resolveCradleAction l buildCustomCradle cs root cradle =+  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))+    ConcreteBios bios deps mbGhc -> biosCradle l root bios deps mbGhc+    ConcreteDirect xs -> directCradle l root xs+    ConcreteNone -> noneCradle+    ConcreteOther a -> buildCustomCradle a++resolveCradleTree :: FilePath -> CradleConfig a -> [ResolvedCradle a]+resolveCradleTree root (CradleConfig deps tree) = go root deps tree+  where+    go pfix deps tree = case tree of+      Cabal t              -> [ResolvedCradle pfix deps (ConcreteCabal t)]+      Stack t              -> [ResolvedCradle pfix deps (ConcreteStack t)]+      Bios bios dcmd mbGhc -> [ResolvedCradle pfix deps (ConcreteBios bios dcmd mbGhc)]+      Direct xs            -> [ResolvedCradle pfix deps (ConcreteDirect xs)]+      None                 -> [ResolvedCradle pfix deps ConcreteNone]+      Other a _            -> [ResolvedCradle pfix deps (ConcreteOther a)]+      CabalMulti dc xs     -> [ResolvedCradle p    deps (ConcreteCabal (dc <> c)) | (p, c) <- xs ]+      StackMulti dc xs     -> [ResolvedCradle p    deps (ConcreteStack (dc <> c)) | (p, c) <- xs ]+      Multi xs             -> concat [ go pfix' (deps ++ deps') tree' | (pfix', CradleConfig deps' tree') <- xs]+ -- | Try to infer an appropriate implicit cradle type from stuff we can find in the enclosing directories: --   * If a .hie-bios file is found, we can treat this as a @Bios@ cradle --   * If a stack.yaml file is found, we can treat this as a @Stack@ cradle --   * If a cabal.project or an xyz.cabal file is found, we can treat this as a @Cabal@ cradle-inferCradleType :: FilePath -> MaybeT IO (CradleType a, FilePath)-inferCradleType fp =+inferCradleTree :: FilePath -> MaybeT IO (CradleTree a, FilePath)+inferCradleTree fp =        maybeItsBios    <|> maybeItsStack    <|> maybeItsCabal@@ -191,16 +305,16 @@    maybeItsStack = stackExecutable >> (Stack $ StackType Nothing Nothing,) <$> stackWorkDir fp -  maybeItsCabal = (Cabal $ CabalType Nothing,) <$> cabalWorkDir fp+  maybeItsCabal = (Cabal $ CabalType Nothing Nothing,) <$> cabalWorkDir fp    -- maybeItsObelisk = (Obelisk,) <$> obeliskWorkDir fp    -- maybeItsBazel = (Bazel,) <$> rulesHaskellWorkDir fp  --- | Wraps up the cradle inferred by @inferCradleType@ as a @CradleConfig@ with no dependencies+-- | Wraps up the cradle inferred by @inferCradleTree@ as a @CradleConfig@ with no dependencies implicitConfig :: FilePath -> MaybeT IO (CradleConfig a, FilePath)-implicitConfig = (fmap . first) (CradleConfig noDeps) . inferCradleType+implicitConfig = (fmap . first) (CradleConfig noDeps) . inferCradleTree   where   noDeps :: [FilePath]   noDeps = []@@ -275,158 +389,85 @@  -- | Default cradle has no special options, not very useful for loading -- modules.-defaultCradle :: FilePath -> Cradle a-defaultCradle cur_dir =+defaultCradle :: LogAction IO (WithSeverity Log) -> FilePath -> Cradle a+defaultCradle l cur_dir =   Cradle     { cradleRootDir = cur_dir+    , cradleLogger = l     , cradleOptsProg = CradleAction         { actionName = Types.Default         , runCradle = \_ _ ->             return (CradleSuccess (ComponentOptions argDynamic cur_dir []))-        , runGhcCmd = \l -> runGhcCmdOnPath l cur_dir+        , runGhcCmd = runGhcCmdOnPath l cur_dir         }     }  --------------------------------------------------------------- -- | The none cradle tells us not to even attempt to load a certain directory -noneCradle :: FilePath -> Cradle a-noneCradle cur_dir =-  Cradle-    { cradleRootDir = cur_dir-    , cradleOptsProg = CradleAction-        { actionName = Types.None-        , runCradle = \_ _ -> return CradleNone-        , runGhcCmd = \_ _ -> return CradleNone-        }-    }+noneCradle :: CradleAction a+noneCradle =+  CradleAction+      { actionName = Types.None+      , runCradle = \_ _ -> return CradleNone+      , runGhcCmd = \_ -> return CradleNone+      }  --------------------------------------------------------------- -- | The multi cradle selects a cradle based on the filepath -multiCradle :: (b -> Cradle a) -> FilePath -> [(FilePath, CradleConfig b)] -> Cradle a-multiCradle buildCustomCradle cur_dir cs =-  Cradle-    { cradleRootDir  = cur_dir-    , cradleOptsProg = CradleAction-        { actionName = multiActionName-        , runCradle  = \l fp -> makeAbsolute fp >>= multiAction buildCustomCradle cur_dir cs l-        , runGhcCmd = \l args ->-            -- We're being lazy here and just returning the ghc path for the-            -- first non-none cradle. This shouldn't matter in practice: all-            -- sub cradles should be using the same ghc version!-            case filter (not . isNoneCradleConfig) $ map snd cs of-              [] -> return CradleNone-              (cfg:_) ->-                runGhcCmd-                  (cradleOptsProg $ getCradle buildCustomCradle (cfg, cur_dir))-                  l-                  args-        }-    }-  where-    cfgs = map snd cs--    multiActionName-      | all (\c -> isStackCradleConfig c || isNoneCradleConfig c) cfgs-      = Types.Stack-      | all (\c -> isCabalCradleConfig c || isNoneCradleConfig c) cfgs-      = Types.Cabal-      | otherwise-      = Types.Multi--    isStackCradleConfig cfg = case cradleType cfg of-      Stack{}      -> True-      StackMulti{} -> True-      _            -> False--    isCabalCradleConfig cfg = case cradleType cfg of-      Cabal{}      -> True-      CabalMulti{} -> True-      _            -> False--    isNoneCradleConfig cfg = case cradleType cfg of-      None -> True-      _    -> False--multiAction-  ::  forall b a-  . (b -> Cradle a)-  -> FilePath-  -> [(FilePath, CradleConfig b)]-  -> LogAction IO (WithSeverity Log)-  -> FilePath-  -> IO (CradleLoadResult ComponentOptions)-multiAction buildCustomCradle cur_dir cs l cur_fp =-    selectCradle =<< canonicalizeCradles--  where-    err_msg = ["Multi Cradle: No prefixes matched"-              , "pwd: " ++ cur_dir-              , "filepath: " ++ cur_fp-              , "prefixes:"-              ] ++ [show (pf, cradleType cc) | (pf, cc) <- cs]--    -- Canonicalize the relative paths present in the multi-cradle and-    -- also order the paths by most specific first. In the cradle selection-    -- function we want to choose the most specific cradle possible.-    canonicalizeCradles :: IO [(FilePath, CradleConfig b)]-    canonicalizeCradles =-      sortOn (Down . fst)-        <$> mapM (\(p, c) -> (,c) <$> makeAbsolute (cur_dir </> p)) cs+-- Canonicalize the relative paths present in the multi-cradle and+-- also order the paths by most specific first. In the cradle selection+-- function we want to choose the most specific cradle possible.+canonicalizeResolvedCradles :: FilePath -> [ResolvedCradle a] -> IO [ResolvedCradle a]+canonicalizeResolvedCradles cur_dir cs =+  sortOn (Down . prefix)+    <$> mapM (\c -> (\abs -> c {prefix = abs}) <$> makeAbsolute (cur_dir </> prefix c)) cs -    selectCradle [] =-      return (CradleFail (CradleError [] ExitSuccess err_msg))-    selectCradle ((p, c): css) =-        if p `isPrefixOf` cur_fp-          then runCradle-                  (cradleOptsProg (getCradle buildCustomCradle (c, cur_dir)))-                  l-                  cur_fp-          else selectCradle css+selectCradle :: (a -> FilePath) -> FilePath -> [a] -> Maybe a+selectCradle _ _ [] = Nothing+selectCradle k cur_fp (c: css) =+    if k c `isPrefixOf` cur_fp+      then Just c+      else selectCradle k cur_fp css   ------------------------------------------------------------------------- -directCradle :: FilePath -> [String] -> Cradle a-directCradle wdir args =-  Cradle-    { cradleRootDir = wdir-    , cradleOptsProg = CradleAction-        { actionName = Types.Direct-        , runCradle = \_ _ ->-            return (CradleSuccess (ComponentOptions (args ++ argDynamic) wdir []))-        , runGhcCmd = \l -> runGhcCmdOnPath l wdir-        }-    }+directCradle :: LogAction IO (WithSeverity Log) -> FilePath -> [String] -> CradleAction a+directCradle l wdir args+  = CradleAction+      { actionName = Types.Direct+      , runCradle = \_ _ ->+          return (CradleSuccess (ComponentOptions (args ++ argDynamic) wdir []))+      , runGhcCmd = runGhcCmdOnPath l wdir+      }+      -------------------------------------------------------------------------   -- | Find a cradle by finding an executable `hie-bios` file which will -- be executed to find the correct GHC options to use.-biosCradle :: FilePath -> Callable -> Maybe Callable -> Maybe FilePath -> Cradle a-biosCradle wdir biosCall biosDepsCall mbGhc =-  Cradle-    { cradleRootDir    = wdir-    , cradleOptsProg   = CradleAction-        { actionName = Types.Bios-        , runCradle = biosAction wdir biosCall biosDepsCall-        , runGhcCmd = \l args -> readProcessWithCwd l wdir (fromMaybe "ghc" mbGhc) args ""-        }-    }+biosCradle :: LogAction IO (WithSeverity Log) -> FilePath -> Callable -> Maybe Callable -> Maybe FilePath -> CradleAction a+biosCradle l wdir biosCall biosDepsCall mbGhc+  = CradleAction+      { actionName = Types.Bios+      , runCradle = biosAction wdir biosCall biosDepsCall l+      , runGhcCmd = \args -> readProcessWithCwd l wdir (fromMaybe "ghc" mbGhc) args ""+      }  biosWorkDir :: FilePath -> MaybeT IO FilePath biosWorkDir = findFileUpwards (".hie-bios" ==) -biosDepsAction :: LogAction IO (WithSeverity Log) -> FilePath -> Maybe Callable -> FilePath -> IO [FilePath]-biosDepsAction l wdir (Just biosDepsCall) fp = do-  biosDeps' <- callableToProcess biosDepsCall (Just fp)+biosDepsAction :: LogAction IO (WithSeverity Log) -> FilePath -> Maybe Callable -> FilePath -> [FilePath] -> IO [FilePath]+biosDepsAction l wdir (Just biosDepsCall) fp _prevs = do+  biosDeps' <- callableToProcess biosDepsCall (Just fp) -- TODO multi pass the previous files too   (ex, sout, serr, [(_, args)]) <- readProcessWithOutputs [hie_bios_output] l wdir biosDeps'   case ex of     ExitFailure _ ->  error $ show (ex, sout, serr)     ExitSuccess -> return $ fromMaybe [] args-biosDepsAction _ _ Nothing _ = return []+biosDepsAction _ _ Nothing _ _ = return []  biosAction   :: FilePath@@ -434,15 +475,16 @@   -> Maybe Callable   -> LogAction IO (WithSeverity Log)   -> FilePath+  -> [FilePath]   -> IO (CradleLoadResult ComponentOptions)-biosAction wdir bios bios_deps l fp = do-  bios' <- callableToProcess bios (Just fp)+biosAction wdir bios bios_deps l fp fps = do+  bios' <- callableToProcess bios (Just fp) -- TODO pass all the files instead of listToMaybe   (ex, _stdo, std, [(_, res),(_, mb_deps)]) <-     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+    Nothing -> biosDepsAction l wdir bios_deps fp fps         -- 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.@@ -458,25 +500,33 @@   return $ proc canon_path (maybeToList file)  ------------------------------------------------------------------------++projectFileProcessArgs :: CradleProjectConfig -> [String]+projectFileProcessArgs (ExplicitConfig prjFile) = ["--project-file", prjFile]+projectFileProcessArgs NoExplicitConfig = []++projectLocationOrDefault :: CradleProjectConfig -> [FilePath]+projectLocationOrDefault = \case+  NoExplicitConfig -> ["cabal.project", "cabal.project.local"]+  (ExplicitConfig prjFile) -> [prjFile, prjFile <.> "local"]+ -- |Cabal Cradle -- Works for new-build by invoking `v2-repl`.-cabalCradle :: FilePath -> Maybe String -> Cradle a-cabalCradle wdir mc =-  Cradle-    { cradleRootDir    = wdir-    , cradleOptsProg   = CradleAction-        { actionName = Types.Cabal-        , runCradle = \l f -> runCradleResultT . cabalAction wdir mc l $ f-        , runGhcCmd = \l args -> runCradleResultT $ do-            buildDir <- liftIO $ cabalBuildDir wdir-            -- Workaround for a cabal-install bug on 3.0.0.0:-            -- ./dist-newstyle/tmp/environment.-24811: createDirectory: does not exist (No such file or directory)-            liftIO $ createDirectoryIfMissing True (buildDir </> "tmp")-            -- Need to pass -v0 otherwise we get "resolving dependencies..."-            cabalProc <- cabalProcess l wdir "v2-exec" $ ["ghc", "-v0", "--"] ++ args-            readProcessWithCwd' cabalProc ""-        }+cabalCradle :: LogAction IO (WithSeverity Log) -> ResolvedCradles b -> FilePath -> Maybe String -> CradleProjectConfig -> CradleAction a+cabalCradle l cs wdir mc projectFile+  = CradleAction+    { actionName = Types.Cabal+    , runCradle = \fp -> runCradleResultT . cabalAction cs wdir mc l projectFile fp+    , runGhcCmd = \args -> runCradleResultT $ do+        buildDir <- liftIO $ cabalBuildDir wdir+        -- Workaround for a cabal-install bug on 3.0.0.0:+        -- ./dist-newstyle/tmp/environment.-24811: createDirectory: does not exist (No such file or directory)+        liftIO $ createDirectoryIfMissing True (buildDir </> "tmp")+        -- Need to pass -v0 otherwise we get "resolving dependencies..."+        cabalProc <- cabalProcess l projectFile wdir "v2-exec" $ ["ghc", "-v0", "--"] ++ args+        readProcessWithCwd' l cabalProc ""     }+      -- | Execute a cabal process in our custom cache-build directory configured -- with the custom ghc executable.@@ -487,9 +537,9 @@ -- to the custom ghc wrapper via 'hie_bios_ghc' environment variable which -- the custom ghc wrapper may use as a fallback if it can not respond to certain -- queries, such as ghc version or location of the libdir.-cabalProcess :: LogAction IO (WithSeverity Log) -> FilePath -> String -> [String] -> CradleLoadResultT IO CreateProcess-cabalProcess l workDir command args = do-  ghcDirs <- cabalGhcDirs l workDir+cabalProcess :: LogAction IO (WithSeverity Log) -> CradleProjectConfig -> FilePath -> String -> [String] -> CradleLoadResultT IO CreateProcess+cabalProcess l cabalProject workDir command args = do+  ghcDirs <- cabalGhcDirs l cabalProject workDir   newEnvironment <- liftIO $ setupEnvironment ghcDirs   cabalProc <- liftIO $ setupCabalCommand ghcDirs   pure $ (cabalProc@@ -516,8 +566,8 @@             , command             , "--with-compiler", wrapper_fp             , "--with-hc-pkg", ghcPkgPath-            ]-      loggedProc l "cabal" (extraCabalArgs ++ args)+            ] <> projectFileProcessArgs cabalProject+      pure $ proc "cabal" (extraCabalArgs ++ args)  -- | Discovers the location of 'ghc-pkg' given the absolute path to 'ghc' -- and its '$libdir' (obtainable by running @ghc --print-libdir@).@@ -578,24 +628,27 @@     -- Escape the filepath and trim excess newlines added by 'escapeArgs'     escapeFilePath fp = trimEnd $ escapeArgs [fp] --- | @'cabalCradleDependencies' rootDir componentDir@.+-- | @'cabalCradleDependencies' projectFile rootDir componentDir@. -- Compute the dependencies of the cabal cradle based--- on the cradle root and the component directory.+-- on cabal project configuration, the cradle root and the component directory. --+-- The @projectFile@ and @projectFile <> ".local"@ are always added to the list+-- of dependencies.+-- -- Directory 'componentDir' is a sub-directory where we look for -- package specific cradle dependencies, such as a '.cabal' file. -- -- Found dependencies are relative to 'rootDir'.-cabalCradleDependencies :: FilePath -> FilePath -> IO [FilePath]-cabalCradleDependencies rootDir componentDir = do+cabalCradleDependencies :: CradleProjectConfig -> FilePath -> FilePath -> IO [FilePath]+cabalCradleDependencies projectFile rootDir componentDir = do     let relFp = makeRelative rootDir componentDir     cabalFiles' <- findCabalFiles componentDir     let cabalFiles = map (relFp </>) cabalFiles'-    return $ map normalise $ cabalFiles ++ ["cabal.project", "cabal.project.local"]+    return $ map normalise $ cabalFiles ++ projectLocationOrDefault projectFile  -- |Find .cabal files in the given directory. ----- Might return multiple results, as we can not know in advance+-- Might return multiple results,biosAction as we can not know in advance -- which one is important to the user. findCabalFiles :: FilePath -> IO [FilePath] findCabalFiles wdir = do@@ -633,10 +686,12 @@         withSystemTempDirectory "hie-bios" $ \ tmpDir -> do           let wrapper_hs = wrapper_fp -<.> "hs"           writeFile wrapper_hs wrapperContents-          ghc <- loggedProc l mbGhc $-                      ghcArgs ++ ["-rtsopts=ignore", "-outputdir", tmpDir, "-o", wrapper_fp, wrapper_hs]-          let ghc' = ghc { cwd = Just wdir }-          readCreateProcess ghc' "" >>= putStr+          let ghcArgsWithExtras = ghcArgs ++ ["-rtsopts=ignore", "-outputdir", tmpDir, "-o", wrapper_fp, wrapper_hs]+          let ghcProc = (proc mbGhc ghcArgsWithExtras)+                      { cwd = Just wdir+                      }+          l <& LogCreateProcessRun ghcProc `WithSeverity` Debug+          readCreateProcess ghcProc "" >>= putStr       else writeFile wrapper_fp wrapperContents  -- | Create and cache a file in hie-bios's cache directory.@@ -681,32 +736,68 @@ -- 'withGhcWrapperTool'. -- -- If cabal can not figure it out, a 'CradleError' is returned.-cabalGhcDirs :: LogAction IO (WithSeverity Log) -> FilePath -> CradleLoadResultT IO (FilePath, FilePath)-cabalGhcDirs l workDir = do-  libdir <- readProcessWithCwd_ l workDir "cabal" ["exec", "-v0", "--", "ghc", "--print-libdir"] ""+cabalGhcDirs :: LogAction IO (WithSeverity Log) -> CradleProjectConfig -> FilePath -> CradleLoadResultT IO (FilePath, FilePath)+cabalGhcDirs l cabalProject workDir = do+  libdir <- readProcessWithCwd_ l workDir "cabal"+      (["exec"] +++       projectFileArgs +++       ["-v0", "--", "ghc", "--print-libdir"]+      )+      ""   exe <- readProcessWithCwd_ l workDir "cabal"       -- DON'T TOUCH THIS CODE       -- This works with 'NoImplicitPrelude', with 'RebindableSyntax' and other shenanigans.       -- @-package-env=-@ doesn't work with ghc prior 8.4.x-      [ "exec", "-v0", "--" , "ghc", "-package-env=-", "-ignore-dot-ghci", "-e"-      , "Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)"-      ]+      ([ "exec"] +++       projectFileArgs +++       [ "-v0", "--" , "ghc", "-package-env=-", "-ignore-dot-ghci", "-e"+       , "Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)"+       ]+      )       ""   pure (trimEnd exe, trimEnd libdir)+  where+    projectFileArgs = projectFileProcessArgs cabalProject + cabalAction-  :: FilePath+  :: ResolvedCradles a+  -> FilePath   -> Maybe String   -> LogAction IO (WithSeverity Log)+  -> CradleProjectConfig   -> FilePath+  -> [FilePath]   -> CradleLoadResultT IO ComponentOptions-cabalAction workDir mc l fp = do+cabalAction (ResolvedCradles root cs vs) workDir mc l projectFile fp fps = do   let     cabalCommand = "v2-repl"-    cabalArgs = [fromMaybe (fixTargetPath fp) mc]+    cabal_version = cabalVersion vs+    ghc_version = ghcVersion vs+    cabalArgs = case (cabal_version, ghc_version) of+      (Just cabal, Just ghc)+        -- Multi-component supported from cabal-install 3.11+        -- and ghc 9.4+        | ghc   >= makeVersion [9,4]+        , cabal >= makeVersion [3,11]+        -> case fps of+          [] -> [fromMaybe (fixTargetPath fp) mc]+          -- Start a multi-component session with all the old files+          _ -> "--keep-temp-files"+             : "--enable-multi-repl"+             : [fromMaybe (fixTargetPath fp) mc]+            ++ [fromMaybe (fixTargetPath old_fp) old_mc+               | old_fp <- fps+               -- Lookup the component for the old file+               , Just (ResolvedCradle{concreteCradle = ConcreteCabal ct}) <- [selectCradle prefix old_fp cs]+               -- Only include this file if the old component is in the same project+               , (projectConfigFromMaybe root (cabalProjectFile ct)) == projectFile+               , let old_mc = cabalComponent ct+               ]+      _ -> [fromMaybe (fixTargetPath fp) mc] -  cabalProc <- cabalProcess l workDir cabalCommand cabalArgs `modCradleError` \err -> do-      deps <- cabalCradleDependencies workDir workDir+  cabalProc <- cabalProcess l projectFile workDir cabalCommand cabalArgs `modCradleError` \err -> do+      deps <- cabalCradleDependencies projectFile workDir workDir       pure $ err { cradleErrorDependencies = cradleErrorDependencies err ++ deps }    (ex, output, stde, [(_, maybeArgs)]) <- liftIO $ readProcessWithOutputs [hie_bios_output] l workDir cabalProc@@ -721,7 +812,7 @@         <> prettyProcessEnv cabalProc    when (ex /= ExitSuccess) $ do-    deps <- liftIO $ cabalCradleDependencies workDir workDir+    deps <- liftIO $ cabalCradleDependencies projectFile workDir workDir     let cmd = show (["cabal", cabalCommand] <> cabalArgs)     let errorMsg = "Failed to run " <> cmd <> " in directory \"" <> workDir <> "\". Consult the logs for full command and error."     throwCE (CradleError deps ex ([errorMsg] <> errorDetails))@@ -731,11 +822,11 @@       -- Provide some dependencies an IDE can look for to trigger a reload.       -- Best effort. Assume the working directory is the       -- root of the component, so we are right in trivial cases at least.-      deps <- liftIO $ cabalCradleDependencies workDir workDir+      deps <- liftIO $ cabalCradleDependencies projectFile workDir workDir       throwCE (CradleError deps ex $                 (["Failed to parse result of calling cabal" ] <> errorDetails))     Just (componentDir, final_args) -> do-      deps <- liftIO $ cabalCradleDependencies workDir componentDir+      deps <- liftIO $ cabalCradleDependencies projectFile workDir componentDir       CradleLoadResultT $ pure $ makeCradleResult (ex, stde, componentDir, final_args) deps   where     -- Need to make relative on Windows, due to a Cabal bug with how it@@ -786,45 +877,47 @@       findFileUpwards (== "cabal.project") wdir   <|> findFileUpwards (\fp -> takeExtension fp == ".cabal") wdir + ------------------------------------------------------------------------ --- | Explicit data-type for stack.yaml configuration location.+-- | Explicit data-type for project configuration location. -- It is basically a 'Maybe' type, but helps to document the API -- and helps to avoid incorrect usage.-data StackYaml-  = NoExplicitYaml-  | ExplicitYaml FilePath+data CradleProjectConfig+  = NoExplicitConfig+  | ExplicitConfig FilePath+  deriving Eq --- | Create an explicit StackYaml configuration from the-stackYamlFromMaybe :: FilePath -> Maybe FilePath -> StackYaml-stackYamlFromMaybe _wdir Nothing = NoExplicitYaml-stackYamlFromMaybe wdir (Just fp) = ExplicitYaml (wdir </> fp)+-- | Create an explicit project configuration. Expects a working directory+-- followed by an optional name of the project configuration.+projectConfigFromMaybe :: FilePath -> Maybe FilePath -> CradleProjectConfig+projectConfigFromMaybe _wdir Nothing = NoExplicitConfig+projectConfigFromMaybe wdir (Just fp) = ExplicitConfig (wdir </> fp) -stackYamlProcessArgs :: StackYaml -> [String]-stackYamlProcessArgs (ExplicitYaml yaml) = ["--stack-yaml", yaml]-stackYamlProcessArgs NoExplicitYaml = []+------------------------------------------------------------------------ -stackYamlLocationOrDefault :: StackYaml -> FilePath-stackYamlLocationOrDefault NoExplicitYaml = "stack.yaml"-stackYamlLocationOrDefault (ExplicitYaml yaml) = yaml+stackYamlProcessArgs :: CradleProjectConfig -> [String]+stackYamlProcessArgs (ExplicitConfig yaml) = ["--stack-yaml", yaml]+stackYamlProcessArgs NoExplicitConfig = [] +stackYamlLocationOrDefault :: CradleProjectConfig -> FilePath+stackYamlLocationOrDefault NoExplicitConfig = "stack.yaml"+stackYamlLocationOrDefault (ExplicitConfig yaml) = yaml+ -- | Stack Cradle -- Works for by invoking `stack repl` with a wrapper script-stackCradle :: FilePath -> Maybe String -> StackYaml -> Cradle a-stackCradle wdir mc syaml =-  Cradle-    { cradleRootDir    = wdir-    , cradleOptsProg   = CradleAction-        { actionName = Types.Stack-        , runCradle = stackAction wdir mc syaml-        , runGhcCmd = \l 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-            _ <- readProcessWithCwd_ l wdir "stack" (stackYamlProcessArgs syaml <> ["setup", "--silent"]) ""-            readProcessWithCwd_ l wdir "stack"-              (stackYamlProcessArgs syaml <> ["exec", "ghc", "--"] <> args)-              ""-        }+stackCradle :: LogAction IO (WithSeverity Log) ->  FilePath -> Maybe String -> CradleProjectConfig -> CradleAction a+stackCradle l wdir mc syaml =+  CradleAction+    { actionName = Types.Stack+    , runCradle = stackAction wdir mc syaml l+    , 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+        _ <- readProcessWithCwd_ l wdir "stack" (stackYamlProcessArgs syaml <> ["setup", "--silent"]) ""+        readProcessWithCwd_ l wdir "stack"+          (stackYamlProcessArgs syaml <> ["exec", "ghc", "--"] <> args)+          ""     }  -- | @'stackCradleDependencies' rootDir componentDir@.@@ -836,7 +929,7 @@ -- a '.cabal' file. -- -- Found dependencies are relative to 'rootDir'.-stackCradleDependencies :: FilePath -> FilePath -> StackYaml -> IO [FilePath]+stackCradleDependencies :: FilePath -> FilePath -> CradleProjectConfig -> IO [FilePath] stackCradleDependencies wdir componentDir syaml = do   let relFp = makeRelative wdir componentDir   cabalFiles' <- findCabalFiles componentDir@@ -847,22 +940,25 @@ stackAction   :: FilePath   -> Maybe String-  -> StackYaml+  -> CradleProjectConfig   -> LogAction IO (WithSeverity Log)   -> FilePath+  -> [FilePath]   -> IO (CradleLoadResult ComponentOptions)-stackAction workDir mc syaml l _fp = do+stackAction workDir mc syaml l _fp _fps = do   let ghcProcArgs = ("stack", stackYamlProcessArgs syaml <> ["exec", "ghc", "--"])   -- Same wrapper works as with cabal   wrapper_fp <- withGhcWrapperTool l ghcProcArgs workDir   (ex1, _stdo, stde, [(_, maybeArgs)]) <--    stackProcess l syaml-                (["repl", "--no-nix-pure", "--with-ghc", wrapper_fp]-                    <> [ comp | Just comp <- [mc] ]) >>=-      readProcessWithOutputs [hie_bios_output] l workDir +    readProcessWithOutputs [hie_bios_output] l workDir+      $ stackProcess syaml+          $  ["repl", "--no-nix-pure", "--with-ghc", wrapper_fp]+          <> [ comp | Just comp <- [mc] ]+   (ex2, pkg_args, stdr, _) <--    stackProcess l syaml ["path", "--ghc-package-path"] >>=-      readProcessWithOutputs [hie_bios_output] l workDir+    readProcessWithOutputs [hie_bios_output] l workDir+      $ stackProcess syaml ["path", "--ghc-package-path"]+   let split_pkgs = concatMap splitSearchPath pkg_args       pkg_ghc_args = concatMap (\p -> ["-package-db", p] ) split_pkgs       args = fromMaybe [] maybeArgs@@ -887,8 +983,8 @@                   )                   deps -stackProcess :: LogAction IO (WithSeverity Log) -> StackYaml -> [String] -> IO CreateProcess-stackProcess l syaml args = loggedProc l "stack" $ stackYamlProcessArgs syaml <> args+stackProcess :: CradleProjectConfig -> [String] -> CreateProcess+stackProcess syaml args = proc "stack" $ stackYamlProcessArgs syaml <> args  combineExitCodes :: [ExitCode] -> ExitCode combineExitCodes = foldr go ExitSuccess@@ -1042,6 +1138,7 @@     -- Windows line endings are not converted so you have to filter out `'r` characters   let loggingConduit = C.decodeUtf8  C..| C.lines C..| C.filterE (/= '\r')         C..| C.map T.unpack C..| C.iterM (\msg -> l <& LogProcessOutput msg `WithSeverity` Debug) C..| C.sinkList+  liftIO $ l <& LogCreateProcessRun process `WithSeverity` Info   (ex, stdo, stde) <- liftIO $ sourceProcessWithStreams process mempty loggingConduit loggingConduit    res <- forM output_files $ \(name,path) ->@@ -1099,15 +1196,15 @@ readProcessWithCwd_ :: LogAction IO (WithSeverity Log) -> FilePath -> FilePath -> [String] -> String -> CradleLoadResultT IO String readProcessWithCwd_ l dir cmd args stdin = do   cleanEnv <- liftIO getCleanEnvironment-  createdProc <- liftIO $ loggedProc l cmd args-  let createdProc' = createdProc { cwd = Just dir, env = Just cleanEnv }-  readProcessWithCwd' createdProc' stdin+  let createdProc' = (proc cmd args) { cwd = Just dir, env = Just cleanEnv }+  readProcessWithCwd' l createdProc' stdin  -- | Wrapper around 'readCreateProcessWithExitCode', wrapping the result in -- a 'CradleLoadResult'. Provides better error messages than raw 'readCreateProcess'.-readProcessWithCwd' :: CreateProcess -> String -> CradleLoadResultT IO String-readProcessWithCwd' createdProcess stdin = do+readProcessWithCwd' :: LogAction IO (WithSeverity Log) -> CreateProcess -> String -> CradleLoadResultT IO String+readProcessWithCwd' l createdProcess stdin = do   mResult <- liftIO $ optional $ readCreateProcessWithExitCode createdProcess stdin+  liftIO $ l <& LogCreateProcessRun createdProcess `WithSeverity` Debug   let cmdString = prettyCmdSpec $ cmdspec createdProcess   case mResult of     Just (ExitSuccess, stdo, _) -> pure stdo@@ -1117,27 +1214,3 @@     Nothing -> throwCE $       CradleError [] ExitSuccess $         ["Couldn't execute " <> cmdString] <> prettyProcessEnv createdProcess---- | Prettify 'CmdSpec', so we can show the command to a user-prettyCmdSpec :: CmdSpec -> String-prettyCmdSpec (ShellCommand s) = s-prettyCmdSpec (RawCommand cmd args) = cmd ++ " " ++ unwords args---- | Pretty print hie-bios's relevant environment variables.-prettyProcessEnv :: CreateProcess -> [String]-prettyProcessEnv p =-  [ key <> ": " <> value-  | (key, value) <- fromMaybe [] (env p)-  , key `elem` [ hie_bios_output-               , hie_bios_ghc-               , hie_bios_ghc_args-               , hie_bios_arg-               , hie_bios_deps-               ]-  ]--loggedProc :: LogAction IO (WithSeverity Log) -> FilePath -> [String] -> IO CreateProcess-loggedProc l command args = do-  l <& LogProcessOutput (unwords $ "executing command:":command:args) `WithSeverity` Debug-  pure $ proc command args- 

@@ -68,20 +68,18 @@ -- -- -- Obtains libdir by calling 'runCradleGhc' on the provided cradle.-getRuntimeGhcLibDir :: LogAction IO (WithSeverity Log)-                    -> Cradle a+getRuntimeGhcLibDir :: Cradle a                     -> IO (CradleLoadResult FilePath)-getRuntimeGhcLibDir l cradle = fmap (fmap trim) $-      runGhcCmd (cradleOptsProg cradle) l ["--print-libdir"]+getRuntimeGhcLibDir cradle = fmap (fmap trim) $+      runGhcCmd (cradleOptsProg cradle) ["--print-libdir"]  -- | Gets the version of ghc used when compiling the cradle. It is based off of -- 'getRuntimeGhcLibDir'. If it can't work out the verison reliably, it will -- return a 'CradleError'-getRuntimeGhcVersion :: LogAction IO (WithSeverity Log)-                     -> Cradle a+getRuntimeGhcVersion :: Cradle a                      -> IO (CradleLoadResult String)-getRuntimeGhcVersion l cradle =-  fmap (fmap trim) $ runGhcCmd (cradleOptsProg cradle) l ["--numeric-version"]+getRuntimeGhcVersion cradle =+  fmap (fmap trim) $ runGhcCmd (cradleOptsProg cradle) ["--numeric-version"]  ---------------------------------------------------------------- 

@@ -7,10 +7,10 @@ -- | Initialize the 'DynFlags' relating to the compilation of a single -- file or GHC session according to the provided 'Cradle'. getCompilerOptions-  :: LogAction IO (WithSeverity Log)-  -> FilePath -- The file we are loading it because of+  :: FilePath -- ^ The file we are loading it because of+  -> [FilePath] -- ^ previous files we might want to include in the build   -> Cradle a   -> IO (CradleLoadResult ComponentOptions)-getCompilerOptions l fp cradle = do-  l <& LogProcessOutput "invoking build tool to determine build flags (this may take some time depending on the cache)" `WithSeverity` Info-  runCradle (cradleOptsProg cradle) l fp+getCompilerOptions fp fps 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 fps

@@ -33,24 +33,22 @@ -- | Initialize a GHC session by loading a given file into a given cradle. initializeFlagsWithCradle ::     GhcMonad m-    => LogAction IO (WithSeverity Log)-    -> FilePath -- ^ The file we are loading the 'Cradle' because of+    => FilePath -- ^ The file we are loading the 'Cradle' because of     -> Cradle a   -- ^ The cradle we want to load     -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions))-initializeFlagsWithCradle l = initializeFlagsWithCradleWithMessage l (Just Gap.batchMsg)+initializeFlagsWithCradle = initializeFlagsWithCradleWithMessage (Just Gap.batchMsg)  -- | The same as 'initializeFlagsWithCradle' but with an additional argument to control -- how the loading progress messages are displayed to the user. In @haskell-ide-engine@ -- the module loading progress is displayed in the UI by using a progress notification. initializeFlagsWithCradleWithMessage ::   GhcMonad m-  => LogAction IO (WithSeverity Log)-  -> Maybe G.Messager+  => Maybe G.Messager   -> FilePath -- ^ The file we are loading the 'Cradle' because of   -> Cradle a  -- ^ The cradle we want to load   -> m (CradleLoadResult (m G.SuccessFlag, ComponentOptions)) -- ^ Whether we actually loaded the cradle or not.-initializeFlagsWithCradleWithMessage l msg fp cradle =-    fmap (initSessionWithMessage msg) <$> liftIO (getCompilerOptions l fp cradle)+initializeFlagsWithCradleWithMessage msg fp cradle =+    fmap (initSessionWithMessage msg) <$> liftIO (getCompilerOptions fp [] 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

@@ -46,18 +46,17 @@ -- | Checking syntax of a target file using GHC. --   Warnings and errors are returned. checkSyntax :: Show a-            => LogAction IO (WithSeverity T.Log)-            -> LogAction IO (WithSeverity Log)+            => LogAction IO (WithSeverity Log)             -> Cradle a             -> [FilePath]  -- ^ The target files.             -> IO String-checkSyntax _       _          _      []    = return ""-checkSyntax logger checkLogger cradle files = do-    libDirRes <- getRuntimeGhcLibDir logger cradle+checkSyntax _           _      []    = return ""+checkSyntax checkLogger cradle files = do+    libDirRes <- getRuntimeGhcLibDir cradle     handleRes libDirRes $ \libDir ->       G.runGhcT (Just libDir) $ do         liftIO $ checkLogger <& LogCradle cradle `WithSeverity` Info-        res <- initializeFlagsWithCradle (cmap (fmap LogAny) checkLogger) (head files) cradle+        res <- initializeFlagsWithCradle (head files) cradle         handleRes res $ \(ini, _) -> do           _sf <- ini           either id id <$> check checkLogger files

@@ -158,11 +158,6 @@ import qualified GhcMake as G #endif -#if __GLASGOW_HASKELL__ >= 907-import GHC.Types.Error (mkUnknownDiagnostic, Messages)-import GHC.Driver.Errors.Types (DriverMessage)-#endif- ghcVersion :: String ghcVersion = VERSION_ghc @@ -174,10 +169,7 @@ homeUnitId_ = homeUnitId #endif -#if __GLASGOW_HASKELL__ >= 907-load' :: GhcMonad m => Maybe G.ModIfaceCache -> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag-load' mhmi_cache how_much = G.load' mhmi_cache how_much mkUnknownDiagnostic-#elif __GLASGOW_HASKELL__ >= 904+#if __GLASGOW_HASKELL__ >= 904 load' :: GhcMonad m => Maybe G.ModIfaceCache -> LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag load' = G.load' #else@@ -482,12 +474,7 @@     => Logger     -> DynFlags     -> [G.Located String]-    -> m (DynFlags, [G.Located String]-#if __GLASGOW_HASKELL__ >= 907-          , Messages DriverMessage)-#else-          , [CmdLine.Warn])-#endif+    -> m (DynFlags, [G.Located String], [CmdLine.Warn]) #if __GLASGOW_HASKELL__ >= 902 parseDynamicFlags = G.parseDynamicFlags #else

@@ -25,17 +25,17 @@ -- -- Otherwise, shows the error message and exit-code. debugInfo :: Show a-          => LogAction IO (WithSeverity Log)-          -> FilePath+          => FilePath           -> Cradle a           -> IO String-debugInfo logger fp cradle = unlines <$> do-    res <- getCompilerOptions logger fp cradle+debugInfo fp cradle = unlines <$> do+    let logger = cradleLogger cradle+    res <- getCompilerOptions fp [] cradle     canonFp <- canonicalizePath fp     conf <- findConfig canonFp-    crdl <- findCradle' canonFp-    ghcLibDir <- getRuntimeGhcLibDir logger cradle-    ghcVer <- getRuntimeGhcVersion logger cradle+    crdl <- findCradle' logger canonFp+    ghcLibDir <- getRuntimeGhcLibDir cradle+    ghcVer <- getRuntimeGhcVersion cradle     case res of       CradleSuccess (ComponentOptions gopts croot deps) -> do         return [@@ -84,19 +84,19 @@  ---------------------------------------------------------------- -cradleInfo :: [FilePath] -> IO String-cradleInfo [] = return "No files given"-cradleInfo args =+cradleInfo :: LogAction IO (WithSeverity Log) -> [FilePath] -> IO String+cradleInfo _ [] = return "No files given"+cradleInfo l args =   fmap unlines $ forM args $ \fp -> do     fp' <- canonicalizePath fp-    (("Cradle for \"" ++ fp' ++ "\": ") ++)  <$> findCradle' fp'+    (("Cradle for \"" ++ fp' ++ "\": ") ++)  <$> findCradle' l fp' -findCradle' :: FilePath -> IO String-findCradle' fp =+findCradle' :: LogAction IO (WithSeverity Log) -> FilePath -> IO String+findCradle' l fp =   findCradle fp >>= \case     Just yaml -> do-      crdl <- loadCradle yaml+      crdl <- loadCradle l yaml       return $ show crdl     Nothing -> do-      crdl <- loadImplicitCradle fp :: IO (Cradle Void)+      crdl <- loadImplicitCradle l fp :: IO (Cradle Void)       return $ show crdl

@@ -2,22 +2,57 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE OverloadedStrings #-} module HIE.Bios.Types where  import           System.Exit import qualified Colog.Core as L import           Control.Exception              ( Exception )-import           Control.Monad import           Control.Monad.IO.Class import           Control.Monad.Trans.Class #if MIN_VERSION_base(4,9,0) import qualified Control.Monad.Fail as Fail #endif import Data.Text.Prettyprint.Doc+import System.Process.Extra (CreateProcess (env, cmdspec), CmdSpec (..))+import Data.Maybe (fromMaybe) +----------------------------------------------------------------+-- Environment variables used by hie-bios.+--+-- If you need more, add a constant here.+---------------------------------------------------------------- -data BIOSVerbosity = Silent | Verbose+-- | Environment variable containing the filepath to which+-- cradle actions write their results to.+-- If the filepath does not exist, cradle actions must create them.+hie_bios_output :: String+hie_bios_output = "HIE_BIOS_OUTPUT" +-- | Environment variable pointing to the GHC location used by+-- cabal's and stack's GHC wrapper.+--+-- If not set, will default to sensible defaults.+hie_bios_ghc :: String+hie_bios_ghc = "HIE_BIOS_GHC"++-- | Environment variable with extra arguments passed to the GHC location+-- in cabal's and stack's GHC wrapper.+--+-- If not set, assume no extra arguments.+hie_bios_ghc_args :: String+hie_bios_ghc_args = "HIE_BIOS_GHC_ARGS"++-- | Environment variable pointing to the source file location that caused+-- the cradle action to be executed.+hie_bios_arg :: String+hie_bios_arg = "HIE_BIOS_ARG"++-- | Environment variable pointing to a filepath to which dependencies+-- of a cradle can be written to by the cradle action.+hie_bios_deps :: String+hie_bios_deps = "HIE_BIOS_DEPS"+ ----------------------------------------------------------------  -- | The environment of a single 'Cradle'.@@ -35,8 +70,15 @@   -- | The action which needs to be executed to get the correct   -- command line arguments.   , cradleOptsProg   :: CradleAction a-  } deriving (Show, Functor)+  , cradleLogger  :: L.LogAction IO (L.WithSeverity Log)+  } deriving (Functor) +instance Show a => Show (Cradle a) where+  show (Cradle root prog _)+    = "Cradle{ cradleRootDir = " ++ show root+          ++", cradleOptsProg = " ++ show prog+          ++"}"+ data ActionName a   = Stack   | Cabal@@ -48,21 +90,39 @@   | Other a   deriving (Show, Eq, Ord, Functor) -data Log =-  LogAny String+data Log +  = LogAny String   | LogProcessOutput String+  | LogCreateProcessRun CreateProcess+  | LogProcessRun FilePath [FilePath]   deriving Show  instance Pretty Log where   pretty (LogAny s) = pretty s   pretty (LogProcessOutput s) = pretty s+  pretty (LogProcessRun fp args) = pretty fp <+> pretty (unwords args)+  pretty (LogCreateProcessRun cp) =   +    vcat $ +      [ case cmdspec cp of+          ShellCommand sh -> pretty sh+          RawCommand cmd args -> pretty cmd <+> pretty (unwords args)+      ]+      <>+      if null envText+        then []+        else+          [ indent 2 $ "Environment Variables"+          , indent 2 $ vcat envText+          ]+    where+      envText = map (indent 2 . pretty) $ prettyProcessEnv cp  data CradleAction a = CradleAction {                         actionName    :: ActionName a                       -- ^ Name of the action.-                      , runCradle     :: L.LogAction IO (L.WithSeverity Log) -> FilePath -> IO (CradleLoadResult ComponentOptions)+                      , runCradle     :: FilePath -> [FilePath] -> IO (CradleLoadResult ComponentOptions)                       -- ^ Options to compile the given file with.-                      , runGhcCmd     :: L.LogAction IO (L.WithSeverity Log) -> [String] -> IO (CradleLoadResult String)+                      , runGhcCmd     :: [String] -> IO (CradleLoadResult String)                       -- ^ Executes the @ghc@ binary that is usually used to                       -- build the cradle. E.g. for a cabal cradle this should be                       -- equivalent to @cabal exec ghc -- args@@@ -191,3 +251,24 @@   -- changes the options that a Cradle may return, thus, needs reload   -- as soon as these files are created.   } deriving (Eq, Ord, Show)+++-- ------------------------------------------------++-- | Prettify 'CmdSpec', so we can show the command to a user+prettyCmdSpec :: CmdSpec -> String+prettyCmdSpec (ShellCommand s) = s+prettyCmdSpec (RawCommand cmd args) = cmd ++ " " ++ unwords args++-- | Pretty print hie-bios's relevant environment variables.+prettyProcessEnv :: CreateProcess -> [String]+prettyProcessEnv p =+  [ key <> ": " <> value+  | (key, value) <- fromMaybe [] (env p)+  , key `elem` [ hie_bios_output+               , hie_bios_ghc+               , hie_bios_ghc_args+               , hie_bios_arg+               , hie_bios_deps+               ]+  ]

@@ -196,6 +196,36 @@         loadRuntimeGhcVersion         assertGhcVersionIs extraGhcVersion     ]+  , testGroup "Cabal cabalProject"+    [ testCaseSteps "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'"+    , testCaseSteps "cabal-with-project, load" $ runTestEnv "cabal-with-project" $ do+        testDirectoryM isCabalCradle "src/MyLib.hs"+    , testCaseSteps "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'"+    , testCaseSteps "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+      [ testCaseSteps "Honours extra ghc setting" $ runTestEnv "cabal-with-ghc-and-project" $ do+          initCradle "src/MyLib.hs"+          assertCradle isCabalCradle+          loadRuntimeGhcLibDir+          assertLibDirVersionIs extraGhcVersion+          loadRuntimeGhcVersion+          assertGhcVersionIs extraGhcVersion+      ]+    ]   ]   where     cabalAttemptLoad :: FilePath -> TestM ()@@ -204,6 +234,13 @@       assertCradle isCabalCradle       loadComponentOptions fp +    cabalLoadOptions :: FilePath -> TestM ComponentOptions+    cabalLoadOptions fp = do+      initCradle fp+      assertCradle isCabalCradle+      loadComponentOptions fp+      assertLoadSuccess+ stackTestCases :: [TestTree] stackTestCases =   [ expectFailBecause "stack repl does not fail on an invalid cabal file" $@@ -303,10 +340,12 @@  stackYamlResolver :: String stackYamlResolver =-#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,4,4,0)))-  "nightly-2023-03-13" -- GHC 9.4.4+#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,6,2,0)))+  "nightly-2023-08-22" -- GHC 9.6.2+#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,4,4,0)))+  "lts-21.8" -- GHC 9.4.6 #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,2,7,0)))-  "lts-20.14" -- GHC 9.2.7+  "lts-20.26" -- GHC 9.2.8 #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,2,1,0)))   "lts-20.11" -- GHC 9.2.5 #elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(9,0,1,0)))

@@ -26,7 +26,7 @@ main :: IO () main = defaultMain $   testCase "Parser Tests" $ do-    assertParser "cabal-1.yaml" (noDeps (Cabal $ CabalType (Just "lib:hie-bios")))+    assertParser "cabal-1.yaml" (noDeps (Cabal $ CabalType (Just "lib:hie-bios") Nothing))     assertParser "stack-config.yaml" (noDeps (Stack $ StackType Nothing Nothing))     --assertParser "bazel.yaml" (noDeps Bazel)     assertParser "bios-1.yaml" (noDeps (Bios (Program "program") Nothing Nothing))@@ -34,16 +34,16 @@     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"))))+    assertParser "dependencies.yaml" (Config (CradleConfig ["depFile"] (Cabal $ CabalType (Just "lib:hie-bios") 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")))-                                             ,("./test", CradleConfig [] (Cabal $ CabalType (Just "test")) ) ]))+    assertParser "multi.yaml" (noDeps (Multi [("./src", CradleConfig [] (Cabal $ CabalType (Just "lib:hie-bios") Nothing))+                                             ,("./test", CradleConfig [] (Cabal $ CabalType (Just "test") Nothing))])) -    assertParser "cabal-multi.yaml" (noDeps (CabalMulti (CabalType Nothing)-                                                        [("./src", CabalType $ Just "lib:hie-bios")-                                                        ,("./", CabalType $ Just "lib:hie-bios")]))+    assertParser "cabal-multi.yaml" (noDeps (CabalMulti (CabalType Nothing Nothing)+                                                        [("./src", CabalType (Just "lib:hie-bios") Nothing)+                                                        ,("./", CabalType (Just "lib:hie-bios") Nothing)]))      assertParser "stack-multi.yaml" (noDeps (StackMulti (StackType Nothing Nothing)                                                         [("./src", StackType (Just "lib:hie-bios") Nothing)@@ -51,15 +51,25 @@      assertParser "nested-cabal-multi.yaml" (noDeps (Multi [("./test/testdata", CradleConfig [] None)                                                           ,("./", CradleConfig [] (-                                                                    CabalMulti (CabalType Nothing)-                                                                               [("./src", CabalType $ Just "lib:hie-bios")-                                                                               ,("./tests", CabalType $ Just "parser-tests")]))]))+                                                                    CabalMulti (CabalType Nothing Nothing)+                                                                               [("./src", CabalType (Just "lib:hie-bios") Nothing)+                                                                               ,("./tests", CabalType (Just "parser-tests") 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)]))]))+    -- Assertions for cabal.project files+    assertParser "cabal-with-project.yaml"+      (noDeps (Cabal $ CabalType Nothing (Just "cabal.project.8.10.7")))+    assertParser "cabal-with-both.yaml"+      (noDeps (Cabal $ CabalType (Just "hie-bios:hie") (Just "cabal.project.8.10.7")))+    assertParser "multi-cabal-with-project.yaml"+      (noDeps (CabalMulti (CabalType Nothing (Just "cabal.project.8.10.7"))+                          [("./src", CabalType (Just "lib:hie-bios") Nothing)+                          ,("./vendor", CabalType (Just "parser-tests") Nothing)]))+    -- Assertions for stack.yaml files     assertParser "stack-with-yaml.yaml"       (noDeps (Stack $ StackType Nothing (Just "stack-8.8.3.yaml")))     assertParser "stack-with-both.yaml"@@ -77,11 +87,11 @@       (noDeps (Multi         [ ("./src", CradleConfig [] (Other CabalHelperStack $ simpleCabalHelperYaml "stack"))         , ("./input", CradleConfig [] (Other CabalHelperCabal $ simpleCabalHelperYaml "cabal"))-        , ("./test", CradleConfig [] (Cabal $ CabalType (Just "test")))+        , ("./test", CradleConfig [] (Cabal $ CabalType (Just "test") Nothing))         , (".", CradleConfig [] None)         ]))     assertParserFails "keys-not-unique-fails.yaml" invalidYamlException-    assertParser "cabal-empty-config.yaml" (noDeps (Cabal $ CabalType Nothing))+    assertParser "cabal-empty-config.yaml" (noDeps (Cabal $ CabalType Nothing Nothing))  assertParser :: FilePath -> Config Void -> Assertion assertParser fp cc = do@@ -104,7 +114,7 @@                           , "Expected: " ++ show cc                           , "Actual: " ++ show conf ]) -noDeps :: CradleType a -> Config a+noDeps :: CradleTree a -> Config a noDeps c = Config (CradleConfig [] c)  shouldThrow :: (HasCallStack, Exception e) => IO a -> Selector e -> Assertion

@@ -253,15 +253,15 @@   relMcfg <- traverse relFile mcfg   step $ "Loading Cradle: " <> show relMcfg   crd <- case mcfg of-    Just cfg -> liftIO $ loadCradle cfg-    Nothing -> liftIO $ loadImplicitCradle a_fp+    Just cfg -> liftIO $ loadCradle testLogger cfg+    Nothing -> liftIO $ loadImplicitCradle testLogger a_fp   setCradle crd  initImplicitCradle :: FilePath -> TestM () initImplicitCradle fp = do   a_fp <- normFile fp   step $ "Loading implicit Cradle for: " <> fp-  crd <- liftIO $ loadImplicitCradle a_fp+  crd <- liftIO $ loadImplicitCradle testLogger a_fp   setCradle crd  loadComponentOptions :: FilePath -> TestM ()@@ -269,21 +269,21 @@   a_fp <- normFile fp   crd <- askCradle   step $ "Initialise flags for: " <> fp-  clr <- liftIO $ getCompilerOptions mempty a_fp crd+  clr <- liftIO $ getCompilerOptions a_fp [] crd   setLoadResult clr  loadRuntimeGhcLibDir :: TestM () loadRuntimeGhcLibDir = do   crd <- askCradle   step "Load run-time ghc libdir"-  libdirRes <- liftIO $ getRuntimeGhcLibDir testLogger crd+  libdirRes <- liftIO $ getRuntimeGhcLibDir crd   setLibDirResult libdirRes  loadRuntimeGhcVersion :: TestM () loadRuntimeGhcVersion = do   crd <- askCradle   step "Load run-time ghc version"-  ghcVersionRes <- liftIO $ getRuntimeGhcVersion testLogger crd+  ghcVersionRes <- liftIO $ getRuntimeGhcVersion crd   setGhcVersionResult ghcVersionRes  testLogger :: forall a . Pretty a => L.LogAction IO (L.WithSeverity a)@@ -325,7 +325,7 @@ assertCradle :: (Cradle Void -> Bool) -> TestM () assertCradle cradlePred = do   crd <- askCradle-  liftIO $ cradlePred crd @? "Must be the correct kind of cradle"+  liftIO $ cradlePred crd @? "Must be the correct kind of cradle, got " ++ show (actionName $ cradleOptsProg crd)  assertLibDirVersion :: TestM () assertLibDirVersion = assertLibDirVersionIs VERSION_ghc

@@ -0,0 +1,4 @@+cradle:+  cabal:+    cabalProject: "cabal.project.8.10.7"+    component: "hie-bios:hie"

@@ -0,0 +1,3 @@+cradle:+  cabal:+    cabalProject: "cabal.project.8.10.7"

@@ -0,0 +1,8 @@+cradle:+  cabal:+    cabalProject: "cabal.project.8.10.7"+    components:+      - path: "./src"+        component: "lib:hie-bios"+      - path: "./vendor"+        component: "parser-tests"

@@ -0,0 +1,9 @@+cabal-version:      2.4+name:               cabal-with-ghc+version:            0.1.0.0++library+    exposed-modules:  MyLib+    build-depends:    base+    hs-source-dirs:   src+    default-language: Haskell2010

@@ -0,0 +1,12 @@+packages: .++-- It is intended that this ghc version is different to at least one ghc version+-- that is tested in CI.+--+-- Project validates that hie-bios honours this field.+--+-- If you change this, make sure to also change the 'extraGhc' constant in+-- 'tests/BiosTests.hs'.+--+-- Additionally, CI needs a proper setup to execute this test-case.+with-compiler: ghc-8.10.7

@@ -0,0 +1,3 @@+cradle:+  cabal:+    cabalProject: cabal.project.8.10.7

@@ -0,0 +1,4 @@+module MyLib (someFunc) where++someFunc :: IO ()+someFunc = putStrLn "someFunc"

@@ -0,0 +1,9 @@+cabal-version:      2.4+name:               cabal-with-project+version:            0.1.0.0++library+    exposed-modules:  MyLib+    build-depends:    base+    hs-source-dirs:   src+    default-language: Haskell2010

@@ -0,0 +1,5 @@+-- Test file.+packages: ./++package cabal-with-project+    ghc-options: -O2

@@ -0,0 +1,3 @@+cradle:+  cabal:+    cabalProject: cabal.project.8.10.7

@@ -0,0 +1,4 @@+module MyLib (someFunc) where++someFunc :: IO ()+someFunc = putStrLn "someFunc"

@@ -0,0 +1,10 @@+cabal-version:       2.0+name:                appA+version:             0.1.0.0+build-type:          Simple++library+  exposed-modules: Lib+  build-depends:       base >=4.10 && < 5, filepath+  hs-source-dirs:      src+  default-language:    Haskell2010

@@ -0,0 +1,1 @@+module Lib where

@@ -0,0 +1,12 @@+cabal-version:       2.0+name:                appB+version:             0.1.0.0+build-type:          Simple++library+  exposed-modules: Lib+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.10 && < 5, filepath+  hs-source-dirs:      src+  default-language:    Haskell2010

@@ -0,0 +1,1 @@+module Lib where

@@ -0,0 +1,6 @@+packages: ./appA ./appB++-- Only appA gets the config+package appA+    ghc-options: -O2+

@@ -0,0 +1,16 @@+cradle:+  multi:+    - path: "appA"+      config:+        cradle:+          cabal:+            - path: appA/src+              component: appA:lib+              cabalProject: cabal.project.8.10.7+    - path: "appB"+      config:+        cradle:+          cabal:+            - path: appB/src+              component: appB:lib+              cabalProject: cabal.project.8.10.7