From 75227d7de717fff33da3658a82f7451e7907a36d Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 7 Aug 2023 14:52:18 +0530 Subject: [PATCH] Move Logger into Cradle --- exe/Main.hs | 22 +++--- src/HIE/Bios/Cradle.hs | 127 ++++++++++++++++----------------- src/HIE/Bios/Environment.hs | 14 ++-- src/HIE/Bios/Flags.hs | 9 ++- src/HIE/Bios/Ghc/Api.hs | 12 ++-- src/HIE/Bios/Ghc/Check.hs | 11 ++- src/HIE/Bios/Internal/Debug.hs | 30 ++++---- src/HIE/Bios/Types.hs | 13 +++- 8 files changed, 119 insertions(+), 119 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 3339e0e3..a00963fb 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -63,28 +63,28 @@ main = do 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 @@ main = do 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 diff --git a/src/HIE/Bios/Cradle.hs b/src/HIE/Bios/Cradle.hs index de6f6f53..151994b3 100644 --- a/src/HIE/Bios/Cradle.hs +++ b/src/HIE/Bios/Cradle.hs @@ -84,31 +84,31 @@ findCradle wfile = do 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) case cfg of - Just bc -> getCradle absurd bc - Nothing -> return $ defaultCradle wdir + 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, Show a) => (b -> CradleAction 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 - getCradle buildCustomCradle (cradleConfig, takeDirectory wfile) + getCradle l buildCustomCradle (cradleConfig, takeDirectory wfile) -getCradle :: Show a => (b -> CradleAction a) -> (CradleConfig b, FilePath) -> IO (Cradle a) -getCradle buildCustomCradle (cc, wdir) = do +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 buildCustomCradle wdir rcs + resolvedCradlesToCradle l buildCustomCradle wdir rcs where cs = resolveCradleTree wdir cc @@ -147,36 +147,34 @@ data ProgramVersions = , ghcVersion :: Maybe Version } -makeVersions :: ([String] -> IO (CradleLoadResult String)) -> IO ProgramVersions -makeVersions ghc = do - cabalVersion <- unsafeInterleaveIO getCabalVersion - stackVersion <- unsafeInterleaveIO getStackVersion +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 :: IO (Maybe Version) -getCabalVersion = do - let p = proc "cabal" ["--numeric-version"] - res <- optional $ readCreateProcessWithExitCode p "" +getCabalVersion :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version) +getCabalVersion l wdir = do + res <- readProcessWithCwd l wdir "cabal" ["--numeric-version"] "" case res of - Just (ExitSuccess,stdo,_) -> + CradleSuccess stdo -> pure $ versionMaybe stdo _ -> pure Nothing -getStackVersion :: IO (Maybe Version) -getStackVersion = do - let p = proc "stack" ["--numeric-version"] - res <- optional $ readCreateProcessWithExitCode p "" +getStackVersion :: LogAction IO (WithSeverity Log) -> FilePath -> IO (Maybe Version) +getStackVersion l wdir = do + res <- readProcessWithCwd l wdir "stack" ["--numeric-version"] "" case res of - Just (ExitSuccess,stdo,_) -> + CradleSuccess stdo -> pure $ versionMaybe stdo _ -> pure Nothing getGhcVersion :: ([String] -> IO (CradleLoadResult String)) -> IO (Maybe Version) getGhcVersion ghc = do - res <- optional $ ghc ["--numeric-version"] + res <- ghc ["--numeric-version"] case res of - Just (CradleSuccess stdo) -> + CradleSuccess stdo -> pure $ versionMaybe stdo _ -> pure Nothing @@ -194,9 +192,9 @@ addActionDeps deps = (\(ComponentOptions os' dir ds) -> CradleSuccess (ComponentOptions os' dir (ds `union` deps))) -resolvedCradlesToCradle :: Show a => (b -> CradleAction a) -> FilePath -> [ResolvedCradle b] -> IO (Cradle a) -resolvedCradlesToCradle buildCustomCradle root cs = mdo - let run_ghc_cmd l args = +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! @@ -205,11 +203,10 @@ resolvedCradlesToCradle buildCustomCradle root cs = mdo (act:_) -> runGhcCmd act - l args - versions <- makeVersions (run_ghc_cmd mempty) + versions <- makeVersions logger root run_ghc_cmd let rcs = ResolvedCradles root cs versions - cradleActions = [ (c, resolveCradleAction buildCustomCradle rcs root c) | c <- cs ] + cradleActions = [ (c, resolveCradleAction logger buildCustomCradle rcs root c) | c <- cs ] err_msg fp = ["Multi Cradle: No prefixes matched" , "pwd: " ++ root @@ -218,13 +215,14 @@ resolvedCradlesToCradle buildCustomCradle root cs = mdo ] ++ [show (prefix pf, actionName cc) | (pf, cc) <- cradleActions] pure $ Cradle { cradleRootDir = root + , cradleLogger = logger , cradleOptsProg = CradleAction { actionName = multiActionName - , runCradle = \l fp prev -> do + , runCradle = \fp prev -> do absfp <- makeAbsolute fp case selectCradle (prefix . fst) absfp cradleActions of Just (rc, act) -> do - addActionDeps (cradleDeps rc) <$> runCradle act l fp prev + addActionDeps (cradleDeps rc) <$> runCradle act fp prev Nothing -> return $ CradleFail $ CradleError [] ExitSuccess (err_msg fp) , runGhcCmd = run_ghc_cmd } @@ -266,13 +264,13 @@ resolvedCradlesToCradle buildCustomCradle root cs = mdo notNoneType _ = True -resolveCradleAction :: (b -> CradleAction a) -> ResolvedCradles b -> FilePath -> ResolvedCradle b -> CradleAction a -resolveCradleAction buildCustomCradle cs root cradle = +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 cs root (cabalComponent t) (projectConfigFromMaybe root (cabalProjectFile t)) - ConcreteStack t -> stackCradle root (stackComponent t) (projectConfigFromMaybe root (stackYaml t)) - ConcreteBios bios deps mbGhc -> biosCradle root bios deps mbGhc - ConcreteDirect xs -> directCradle root xs + 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 @@ -391,15 +389,16 @@ isOtherCradle crdl = case actionName (cradleOptsProg crdl) of -- | 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 = \_ _ _ -> + , runCradle = \_ _ -> return (CradleSuccess (ComponentOptions argDynamic cur_dir [])) - , runGhcCmd = \l -> runGhcCmdOnPath l cur_dir + , runGhcCmd = runGhcCmdOnPath l cur_dir } } @@ -410,8 +409,8 @@ noneCradle :: CradleAction a noneCradle = CradleAction { actionName = Types.None - , runCradle = \_ _ _ -> return CradleNone - , runGhcCmd = \_ _ -> return CradleNone + , runCradle = \_ _ -> return CradleNone + , runGhcCmd = \_ -> return CradleNone } --------------------------------------------------------------- @@ -435,13 +434,13 @@ selectCradle k cur_fp (c: css) = ------------------------------------------------------------------------- -directCradle :: FilePath -> [String] -> CradleAction a -directCradle wdir args +directCradle :: LogAction IO (WithSeverity Log) -> FilePath -> [String] -> CradleAction a +directCradle l wdir args = CradleAction { actionName = Types.Direct - , runCradle = \_ _ _ -> + , runCradle = \_ _ -> return (CradleSuccess (ComponentOptions (args ++ argDynamic) wdir [])) - , runGhcCmd = \l -> runGhcCmdOnPath l wdir + , runGhcCmd = runGhcCmdOnPath l wdir } @@ -450,12 +449,12 @@ directCradle wdir args -- | 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 -> CradleAction a -biosCradle wdir biosCall biosDepsCall mbGhc +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 - , runGhcCmd = \l args -> readProcessWithCwd l wdir (fromMaybe "ghc" mbGhc) args "" + , runCradle = biosAction wdir biosCall biosDepsCall l + , runGhcCmd = \args -> readProcessWithCwd l wdir (fromMaybe "ghc" mbGhc) args "" } biosWorkDir :: FilePath -> MaybeT IO FilePath @@ -513,12 +512,12 @@ projectLocationOrDefault = \case -- |Cabal Cradle -- Works for new-build by invoking `v2-repl`. -cabalCradle :: ResolvedCradles b -> FilePath -> Maybe String -> CradleProjectConfig -> CradleAction a -cabalCradle cs wdir mc projectFile +cabalCradle :: LogAction IO (WithSeverity Log) -> ResolvedCradles b -> FilePath -> Maybe String -> CradleProjectConfig -> CradleAction a +cabalCradle l cs wdir mc projectFile = CradleAction { actionName = Types.Cabal - , runCradle = \l fp -> runCradleResultT . cabalAction cs wdir mc l projectFile fp - , runGhcCmd = \l args -> runCradleResultT $ do + , 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) @@ -906,12 +905,12 @@ stackYamlLocationOrDefault (ExplicitConfig yaml) = yaml -- | Stack Cradle -- Works for by invoking `stack repl` with a wrapper script -stackCradle :: FilePath -> Maybe String -> CradleProjectConfig -> CradleAction a -stackCradle wdir mc syaml = +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 - , runGhcCmd = \l args -> runCradleResultT $ do + , 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"]) "" diff --git a/src/HIE/Bios/Environment.hs b/src/HIE/Bios/Environment.hs index 23180422..a750ddd2 100644 --- a/src/HIE/Bios/Environment.hs +++ b/src/HIE/Bios/Environment.hs @@ -68,20 +68,18 @@ makeTargetIdAbsolute _ tid = tid -- -- -- 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"] ---------------------------------------------------------------- diff --git a/src/HIE/Bios/Flags.hs b/src/HIE/Bios/Flags.hs index 652ef089..ccf73cf3 100644 --- a/src/HIE/Bios/Flags.hs +++ b/src/HIE/Bios/Flags.hs @@ -7,11 +7,10 @@ import Colog.Core (LogAction (..), WithSeverity (..), Severity (..), (<&)) -- | 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 fps 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 fps +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 diff --git a/src/HIE/Bios/Ghc/Api.hs b/src/HIE/Bios/Ghc/Api.hs index a27d0003..0749581b 100644 --- a/src/HIE/Bios/Ghc/Api.hs +++ b/src/HIE/Bios/Ghc/Api.hs @@ -33,24 +33,22 @@ import HIE.Bios.Flags -- | 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 diff --git a/src/HIE/Bios/Ghc/Check.hs b/src/HIE/Bios/Ghc/Check.hs index 9468532f..d08bd352 100644 --- a/src/HIE/Bios/Ghc/Check.hs +++ b/src/HIE/Bios/Ghc/Check.hs @@ -46,18 +46,17 @@ instance Pretty Log where -- | 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 diff --git a/src/HIE/Bios/Internal/Debug.hs b/src/HIE/Bios/Internal/Debug.hs index 1ecbc019..2eac8f96 100644 --- a/src/HIE/Bios/Internal/Debug.hs +++ b/src/HIE/Bios/Internal/Debug.hs @@ -25,17 +25,17 @@ import System.Directory -- -- 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 @@ findConfig fp = findCradle fp >>= \case ---------------------------------------------------------------- -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 diff --git a/src/HIE/Bios/Types.hs b/src/HIE/Bios/Types.hs index 81b2206b..6dd5daa3 100644 --- a/src/HIE/Bios/Types.hs +++ b/src/HIE/Bios/Types.hs @@ -70,7 +70,14 @@ data Cradle a = Cradle { -- | 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 @@ -113,9 +120,9 @@ instance Pretty Log where data CradleAction a = CradleAction { actionName :: ActionName a -- ^ Name of the action. - , runCradle :: L.LogAction IO (L.WithSeverity Log) -> FilePath -> [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@