@@ -14,7 +14,8 @@ module Obelisk.Command.Run where
1414import Control.Arrow ((&&&))
1515import Control.Exception (Exception, bracket)
1616import Control.Lens (ifor, (.~), (&))
17−import Control.Monad (filterM, unless)
17+import Control.Concurrent (forkIO)
18+import Control.Monad (filterM, void)
1819import Control.Monad.Except (runExceptT, throwError)
1920import Control.Monad.IO.Class (liftIO)
2021import Control.Monad.Reader (MonadIO)
@@ -45,13 +46,23 @@ import Debug.Trace (trace)
4546import Distribution.Compiler (CompilerFlavor(..))
4647import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
4748import Distribution.Parsec.ParseResult (runParseResult)
49+import Distribution.Pretty (prettyShow)
50+import Distribution.Simple.Compiler (PackageDB (GlobalPackageDB))
51+import Distribution.Simple.Configure (configCompilerEx, getInstalledPackages)
52+import Distribution.Simple.PackageIndex (InstalledPackageIndex, lookupDependency)
53+import Distribution.Simple.Program.Db (defaultProgramDb)
4854import qualified Distribution.System as Dist
49−import Distribution.Types.BuildInfo (buildable, cppOptions, defaultExtensions, defaultLanguage, hsSourceDirs, options)
55+import Distribution.Types.BuildInfo (buildable, cppOptions, defaultExtensions, defaultLanguage, hsSourceDirs, options, targetBuildDepends)
5056import Distribution.Types.CondTree (simplifyCondTree)
57+import Distribution.Types.Dependency (Dependency (..), depPkgName)
5158import Distribution.Types.GenericPackageDescription (ConfVar (Arch, Impl, OS), condLibrary)
59+import Distribution.Types.InstalledPackageInfo (compatPackageKey)
5260import Distribution.Types.Library (libBuildInfo)
61+import Distribution.Types.PackageName (mkPackageName)
62+import Distribution.Types.VersionRange (anyVersion)
5363import Distribution.Utils.Generic (toUTF8BS, readUTF8File)
5464import qualified Distribution.Parsec.Common as Dist
65+import qualified Distribution.Verbosity as Verbosity (silent)
5566import qualified Hpack.Config as Hpack
5667import qualified Hpack.Render as Hpack
5768import qualified Hpack.Yaml as Hpack
@@ -63,7 +74,7 @@ import System.FilePath
6374import qualified System.Info
6475import System.IO.Temp (withSystemTempDirectory)
6576
66−import Obelisk.App (MonadObelisk)
77+import Obelisk.App (MonadObelisk, getObelisk, runObelisk)
6778import Obelisk.CliApp (
6879 Severity (..),
6980 failWith,
@@ -77,7 +88,7 @@ import Obelisk.CliApp (
7788 withSpinner,
7889 )
7990import Obelisk.Command.Nix
80−import Obelisk.Command.Project (nixShellWithoutPkgs, withProjectRoot, findProjectAssets, bashEscape)
91+import Obelisk.Command.Project
8192import Obelisk.Command.Thunk (attrCacheFileName)
8293import Obelisk.Command.Utils (findExePath, ghcidExePath)
8394
@@ -96,6 +107,8 @@ data CabalPackageInfo = CabalPackageInfo
96107 -- ^ List of compiler-specific options (e.g., the "ghc-options" field of the cabal file)
97108 , _cabalPackageInfo_cppOptions :: [String]
98109 -- ^ List of CPP (C Preprocessor) options (e.g. the "cpp-options" field of the cabal file)
110+ , _cabalPackageInfo_buildDepends :: [Dependency]
111+ -- ^ List of build dependencies listed in the cabal file
99112 }
100113
101114-- | 'Bool' with a better name for its purpose.
@@ -144,8 +157,8 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do
144157 , _target_attr = Just "__unstable__.profiledObRun"
145158 , _target_expr = Nothing
146159 }
147− assets <- findProjectAssets root
148− putLog Debug $ "Assets impurely loaded from: " <> assets
160+ (assetType, assets) <- findProjectAssets root
161+ putLog Debug $ describeImpureAssetSource assetType assets
149162 time <- liftIO getCurrentTime
150163 let profileBaseName = formatTime defaultTimeLocale profileBasePattern time
151164 liftIO $ createDirectoryIfMissing True $ takeDirectory $ root </> profileBaseName
@@ -163,9 +176,16 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do
163176run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()
164177run root interpretPaths = do
165178 pkgs <- getParsedLocalPkgs root interpretPaths
166− assets <- findProjectAssets root
167− putLog Debug $ "Assets impurely loaded from: " <> assets
168− ghciArgs <- getGhciSessionSettings pkgs root True
179+ (assetType, assets) <- findProjectAssets root
180+ manifestPkg <- parsePackagesOrFail . (:[]) . T.unpack =<< getHaskellManifestProjectPath root
181+ putLog Debug $ describeImpureAssetSource assetType assets
182+ case assetType of
183+ AssetSource_Derivation -> do
184+ ob <- getObelisk
185+ putLog Debug "Starting static file derivation watcher..."
186+ void $ liftIO $ forkIO $ runObelisk ob $ watchStaticFilesDerivation root
187+ _ -> pure ()
188+ ghciArgs <- getGhciSessionSettings (pkgs <> manifestPkg) root True
169189 freePort <- getFreePort
170190 withGhciScriptArgs pkgs $ \dotGhciArgs -> do
171191 runGhcid root True (ghciArgs <> dotGhciArgs) pkgs $ Just $ unwords
@@ -222,7 +242,12 @@ getLocalPkgs root interpretPaths = do
222242 let rootsAndExclusions = calcIntepretFinds "" interpretPaths
223243
224244 fmap fold $ for (MMap.toAscList rootsAndExclusions) $ \(interpretPathRoot, exclusions) ->
225− let allExclusions = obeliskPackageExclusions <> exclusions <> Set.singleton ("*" </> attrCacheFileName)
245+ let allExclusions = obeliskPackageExclusions
246+ <> exclusions
247+ <> Set.singleton ("*" </> attrCacheFileName)
248+ <> Set.singleton ("*" </> "lib/asset/manifest") -- NB: obelisk-asset-manifest is excluded because it generates
249+ -- a module that in turn imports it. This will cause ob run to
250+ -- fail in its current implementation.
226251 in fmap (Set.fromList . map normalise) $ runFind $
227252 ["-L", interpretPathRoot, "(", "-name", "*.cabal", "-o", "-name", Hpack.packageConfig, ")", "-a", "-type", "f"]
228253 <> concat [["-not", "-path", p </> "*"] | p <- toList allExclusions]
@@ -304,15 +329,16 @@ parseCabalPackage
304329 -> m (Maybe CabalPackageInfo)
305330parseCabalPackage dir = parseCabalPackage' dir >>= \case
306331 Left err -> Nothing <$ putLog Error err
307− Right (warnings, pkgInfo) -> do
332+ Right (Just (warnings, pkgInfo)) -> do
308333 for_ warnings $ putLog Warning . T.pack . show
309334 pure $ Just pkgInfo
335+ Right Nothing -> pure Nothing
310336
311337-- | Like 'parseCabalPackage' but returns errors and warnings directly so as to avoid 'MonadObelisk'.
312338parseCabalPackage'
313339 :: (MonadIO m)
314340 => FilePath -- ^ Package directory
315− -> m (Either T.Text ([Dist.PWarning], CabalPackageInfo))
341+ -> m (Either T.Text (Maybe ([Dist.PWarning], CabalPackageInfo)))
316342parseCabalPackage' pkg = runExceptT $ do
317343 (cabalContents, packageFile, packageName) <- guessCabalPackageFile pkg >>= \case
318344 Left GuessPackageFileError_NotFound -> throwError $ "No .cabal or package.yaml file found in " <> T.pack pkg
@@ -340,7 +366,7 @@ parseCabalPackage' pkg = runExceptT $ do
340366 case condLibrary <$> result of
341367 Right (Just condLib) -> do
342368 let (_, lib) = simplifyCondTree evalConfVar condLib
343− pure $ (warnings,) $ CabalPackageInfo
369+ pure $ Just $ (warnings,) $ CabalPackageInfo
344370 { _cabalPackageInfo_packageName = T.pack packageName
345371 , _cabalPackageInfo_packageFile = packageFile
346372 , _cabalPackageInfo_packageRoot = takeDirectory packageFile
@@ -353,18 +379,19 @@ parseCabalPackage' pkg = runExceptT $ do
353379 defaultLanguage $ libBuildInfo lib
354380 , _cabalPackageInfo_compilerOptions = options $ libBuildInfo lib
355381 , _cabalPackageInfo_cppOptions = cppOptions $ libBuildInfo lib
382+ , _cabalPackageInfo_buildDepends = targetBuildDepends $ libBuildInfo lib
356383 }
357− Right Nothing -> throwError "Haskell package has no library component"
384+ Right Nothing -> pure Nothing
358385 Left (_, errors) ->
359386 throwError $ T.pack $ "Failed to parse " <> packageFile <> ":\n" <> unlines (map show errors)
360387
361388parsePackagesOrFail :: (MonadObelisk m, Foldable f) => f FilePath -> m (NE.NonEmpty CabalPackageInfo)
362389parsePackagesOrFail dirs' = do
363− (pkgDirErrs, packageInfos') <- fmap partitionEithers $ for dirs $ \dir -> do
390+ packageInfos' <- fmap catMaybes $ for dirs $ \dir -> do
364391 flip fmap (parseCabalPackage dir) $ \case
365392 Just packageInfo
366− | _cabalPackageInfo_buildable packageInfo -> Right packageInfo
367− _ -> Left dir
393+ | _cabalPackageInfo_buildable packageInfo -> Just packageInfo
394+ _ -> Nothing
368395
369396 -- Sort duplicate packages such that we prefer shorter paths, but fall back to alphabetical ordering.
370397 let packagesByName = Map.map (NE.sortBy $ comparing $ \p -> let n = _cabalPackageInfo_packageFile p in (length n, n))
@@ -386,9 +413,6 @@ parsePackagesOrFail dirs' = do
386413 "No valid, buildable packages found" <> (if null dirs then "" else " in " <> intercalate ", " dirs)
387414 Just xs -> pure xs
388415
389− unless (null pkgDirErrs) $
390− putLog Warning $ T.pack $ "Failed to find buildable packages in " <> intercalate ", " pkgDirErrs
391−
392416 pure packageInfos
393417 where
394418 dirs = toList dirs'
@@ -402,7 +426,8 @@ withGhciScriptArgs
402426 => f CabalPackageInfo -- ^ List of packages to load into ghci
403427 -> ([String] -> m ()) -- ^ Action to run with the extra ghci arguments
404428 -> m ()
405−withGhciScriptArgs packageInfos f = withGhciScript loadPreludeManually packageInfos $ \fp -> f ["-XNoImplicitPrelude", "-ghci-script", fp]
429+withGhciScriptArgs packageInfos f = withGhciScript loadPreludeManually packageInfos $ \fp ->
430+ f ["-XNoImplicitPrelude", "-ghci-script", fp]
406431 where
407432 -- These lines must be first and allow the session to support a custom Prelude when @-XNoImplicitPrelude@
408433 -- is passed to the ghci session.
@@ -452,6 +477,7 @@ getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do
452477 -- all paths to 'pathBase'.
453478 selfExe <- liftIO $ canonicalizePath =<< getExecutablePath
454479 canonicalPathBase <- liftIO $ canonicalizePath pathBase
480+ installedPackageIndex <- loadPackageIndex packageInfos pathBase
455481
456482 (pkgFiles, pkgSrcPaths :: [NonEmpty FilePath]) <- fmap unzip $ liftIO $ for packageInfos $ \pkg -> do
457483 canonicalSrcDirs <- traverse canonicalizePath $ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg
@@ -460,16 +486,47 @@ getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do
460486
461487 pure
462488 $ baseGhciOptions
489+ <> ["-DOBELISK_ASSET_PASSTHRU"] -- For passthrough static assets
463490 <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]
464491 <> concatMap (\p -> ["-optF", p]) pkgFiles
465492 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]
493+ <> concatMap (\packageId -> ["-package-id", packageId ])
494+ (packageIds installedPackageIndex)
466495 where
467496 relativeTo' = if useRelativePaths then relativeTo else const
497+ -- Package names we're building and not needed from the package DB
498+ packageNames =
499+ map (mkPackageName . T.unpack . _cabalPackageInfo_packageName)
500+ packageInfos
501+ packageIds installedPackageIndex =
502+ map (dependencyPackageId installedPackageIndex) $
503+ filter ((`notElem` packageNames) . depPkgName) $
504+ concatMap _cabalPackageInfo_buildDepends packageInfos <>
505+ [Dependency (mkPackageName "obelisk-run") anyVersion]
506+ dependencyPackageId installedPackageIndex dep =
507+ case lookupDependency installedPackageIndex dep of
508+ ((_version,installedPackageInfo:_) :_) ->
509+ compatPackageKey installedPackageInfo
510+ _ -> error $ "Couldn't resolve dependency for " <> prettyShow dep
511+
512+-- Load the package index used by the GHC in this path's nix project
513+loadPackageIndex :: MonadObelisk m => [CabalPackageInfo] -> FilePath -> m InstalledPackageIndex
514+loadPackageIndex packageInfos root = do
515+ ghcPath <- getPathInNixEnvironment "bash -c 'type -p ghc'"
516+ ghcPkgPath <- getPathInNixEnvironment "bash -c 'type -p ghc-pkg'"
517+ (compiler, _platform, programDb) <- liftIO
518+ $ configCompilerEx (Just GHC) (Just ghcPath) (Just ghcPkgPath) defaultProgramDb Verbosity.silent
519+ liftIO $ getInstalledPackages Verbosity.silent compiler [GlobalPackageDB] programDb
520+ where
521+ getPathInNixEnvironment cmd = do
522+ path <- readProcessAndLogStderr Debug =<< mkObNixShellProc root False True (packageInfoToNamePathMap packageInfos) "ghc" (Just cmd)
523+ liftIO $ canonicalizePath $ T.unpack $ T.strip path
468524
469525baseGhciOptions :: [String]
470526baseGhciOptions =
471527 [ "-ignore-dot-ghci"
472528 , "-no-user-package-db"
529+ , "-hide-all-packages"
473530 , "-package-env", "-"
474531 ]
475532