@@ -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)
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
@@ -61,12 +72,16 @@ import System.Directory
6172import System.Environment (getExecutablePath)
6273import System.FilePath
6374import qualified System.Info
75+import System.IO (hClose, hGetLine)
6476import System.IO.Temp (withSystemTempDirectory)
77+import System.Process (CreateProcess (..), StdStream (..))
6578
66−import Obelisk.App (MonadObelisk)
79+import Obelisk.App (MonadObelisk, getObelisk, runObelisk)
6780import Obelisk.CliApp (
6881 Severity (..),
82+ createProcess_,
6983 failWith,
84+ overCreateProcess,
7085 proc,
7186 putLog,
7287 readCreateProcessWithExitCode,
@@ -77,7 +92,7 @@ import Obelisk.CliApp (
7792 withSpinner,
7893 )
7994import Obelisk.Command.Nix
80−import Obelisk.Command.Project (nixShellWithoutPkgs, withProjectRoot, findProjectAssets, bashEscape)
95+import Obelisk.Command.Project
8196import Obelisk.Command.Thunk (attrCacheFileName)
8297import Obelisk.Command.Utils (findExePath, ghcidExePath)
8398
@@ -96,6 +111,8 @@ data CabalPackageInfo = CabalPackageInfo
96111 -- ^ List of compiler-specific options (e.g., the "ghc-options" field of the cabal file)
97112 , _cabalPackageInfo_cppOptions :: [String]
98113 -- ^ List of CPP (C Preprocessor) options (e.g. the "cpp-options" field of the cabal file)
114+ , _cabalPackageInfo_buildDepends :: [Dependency]
115+ -- ^ List of build dependencies listed in the cabal file
99116 }
100117
101118-- | 'Bool' with a better name for its purpose.
@@ -144,8 +161,8 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do
144161 , _target_attr = Just "__unstable__.profiledObRun"
145162 , _target_expr = Nothing
146163 }
147− assets <- findProjectAssets root
148− putLog Debug $ "Assets impurely loaded from: " <> assets
164+ (assetType, assets) <- findProjectAssets root
165+ putLog Debug $ describeImpureAssetSource assetType assets
149166 time <- liftIO getCurrentTime
150167 let profileBaseName = formatTime defaultTimeLocale profileBasePattern time
151168 liftIO $ createDirectoryIfMissing True $ takeDirectory $ root </> profileBaseName
@@ -163,9 +180,16 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do
163180run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()
164181run root interpretPaths = do
165182 pkgs <- getParsedLocalPkgs root interpretPaths
166− assets <- findProjectAssets root
167− putLog Debug $ "Assets impurely loaded from: " <> assets
168− ghciArgs <- getGhciSessionSettings pkgs root True
183+ (assetType, assets) <- findProjectAssets root
184+ manifestPkg <- parsePackagesOrFail . (:[]) . T.unpack =<< getHaskellManifestProjectPath root
185+ putLog Debug $ describeImpureAssetSource assetType assets
186+ case assetType of
187+ AssetSource_Derivation -> do
188+ ob <- getObelisk
189+ putLog Debug "Starting static file derivation watcher..."
190+ void $ liftIO $ forkIO $ runObelisk ob $ watchStaticFilesDerivation root
191+ _ -> pure ()
192+ ghciArgs <- getGhciSessionSettings (pkgs <> manifestPkg) root True
169193 freePort <- getFreePort
170194 withGhciScriptArgs pkgs $ \dotGhciArgs -> do
171195 runGhcid root True (ghciArgs <> dotGhciArgs) pkgs $ Just $ unwords
@@ -222,7 +246,12 @@ getLocalPkgs root interpretPaths = do
222246 let rootsAndExclusions = calcIntepretFinds "" interpretPaths
223247
224248 fmap fold $ for (MMap.toAscList rootsAndExclusions) $ \(interpretPathRoot, exclusions) ->
225− let allExclusions = obeliskPackageExclusions <> exclusions <> Set.singleton ("*" </> attrCacheFileName)
249+ let allExclusions = obeliskPackageExclusions
250+ <> exclusions
251+ <> Set.singleton ("*" </> attrCacheFileName)
252+ <> Set.singleton ("*" </> "lib/asset/manifest") -- NB: obelisk-asset-manifest is excluded because it generates
253+ -- a module that in turn imports it. This will cause ob run to
254+ -- fail in its current implementation.
226255 in fmap (Set.fromList . map normalise) $ runFind $
227256 ["-L", interpretPathRoot, "(", "-name", "*.cabal", "-o", "-name", Hpack.packageConfig, ")", "-a", "-type", "f"]
228257 <> concat [["-not", "-path", p </> "*"] | p <- toList allExclusions]
@@ -354,6 +383,7 @@ parseCabalPackage' pkg = runExceptT $ do
354383 defaultLanguage $ libBuildInfo lib
355384 , _cabalPackageInfo_compilerOptions = options $ libBuildInfo lib
356385 , _cabalPackageInfo_cppOptions = cppOptions $ libBuildInfo lib
386+ , _cabalPackageInfo_buildDepends = targetBuildDepends $ libBuildInfo lib
357387 }
358388 Right Nothing -> pure Nothing
359389 Left (_, errors) ->
@@ -400,7 +430,8 @@ withGhciScriptArgs
400430 => f CabalPackageInfo -- ^ List of packages to load into ghci
401431 -> ([String] -> m ()) -- ^ Action to run with the extra ghci arguments
402432 -> m ()
403−withGhciScriptArgs packageInfos f = withGhciScript loadPreludeManually packageInfos $ \fp -> f ["-XNoImplicitPrelude", "-ghci-script", fp]
433+withGhciScriptArgs packageInfos f = withGhciScript loadPreludeManually packageInfos $ \fp ->
434+ f ["-XNoImplicitPrelude", "-ghci-script", fp]
404435 where
405436 -- These lines must be first and allow the session to support a custom Prelude when @-XNoImplicitPrelude@
406437 -- is passed to the ghci session.
@@ -450,6 +481,7 @@ getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do
450481 -- all paths to 'pathBase'.
451482 selfExe <- liftIO $ canonicalizePath =<< getExecutablePath
452483 canonicalPathBase <- liftIO $ canonicalizePath pathBase
484+ installedPackageIndex <- loadPackageIndex pathBase
453485
454486 (pkgFiles, pkgSrcPaths :: [NonEmpty FilePath]) <- fmap unzip $ liftIO $ for packageInfos $ \pkg -> do
455487 canonicalSrcDirs <- traverse canonicalizePath $ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg
@@ -458,16 +490,52 @@ getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do
458490
459491 pure
460492 $ baseGhciOptions
493+ <> ["-DOBELISK_ASSET_PASSTHRU"] -- For passthrough static assets
461494 <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]
462495 <> concatMap (\p -> ["-optF", p]) pkgFiles
463496 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]
497+ <> concatMap (\packageId -> ["-package-id", packageId ])
498+ (packageIds installedPackageIndex)
464499 where
465500 relativeTo' = if useRelativePaths then relativeTo else const
501+ -- Package names we're building and not needed from the package DB
502+ packageNames =
503+ map (mkPackageName . T.unpack . _cabalPackageInfo_packageName)
504+ packageInfos
505+ packageIds installedPackageIndex =
506+ map (dependencyPackageId installedPackageIndex) $
507+ filter ((`notElem` packageNames) . depPkgName) $
508+ concatMap _cabalPackageInfo_buildDepends packageInfos <>
509+ [Dependency (mkPackageName "obelisk-run") anyVersion]
510+ dependencyPackageId installedPackageIndex dep =
511+ case lookupDependency installedPackageIndex dep of
512+ ((_version,installedPackageInfo:_) :_) ->
513+ compatPackageKey installedPackageInfo
514+ _ -> error $ "Couldn't resolve dependency for " <> prettyShow dep
515+
516+-- Load the package index used by the GHC in this path's nix project
517+loadPackageIndex :: (MonadObelisk m) => FilePath -> m InstalledPackageIndex
518+loadPackageIndex root = do
519+ ghcPath <- getPathInNixEnvironment "bash -c 'type -p ghc'"
520+ ghcPkgPath <- getPathInNixEnvironment "bash -c 'type -p ghc-pkg'"
521+ (compiler, _platform, programDb) <- liftIO
522+ $ configCompilerEx (Just GHC) (Just ghcPath) (Just ghcPkgPath) defaultProgramDb Verbosity.silent
523+ liftIO $ getInstalledPackages Verbosity.silent compiler [GlobalPackageDB] programDb
524+ where
525+ getPathInNixEnvironment cmd = do
526+ procSpec <- runProc <$> nixShellRunConfig root True (Just cmd)
527+ (_,Just h,_,_) <- createProcess_ "loadPackageIndex" procSpec
528+ path <- liftIO $ hGetLine h >>= canonicalizePath
529+ liftIO $ hClose h
530+ pure path
531+ runProc =
532+ overCreateProcess (\cs -> cs { std_out = CreatePipe }) . nixShellRunProc
466533
467534baseGhciOptions :: [String]
468535baseGhciOptions =
469536 [ "-ignore-dot-ghci"
470537 , "-no-user-package-db"
538+ , "-hide-all-packages"
471539 , "-package-env", "-"
472540 ]
473541