@@ -76,7 +76,7 @@ import Obelisk.CliApp (
7676 withSpinner,
7777 )
7878import Obelisk.Command.Nix
79−import Obelisk.Command.Project (nixShellWithPkgs, withProjectRoot, findProjectAssets)
79+import Obelisk.Command.Project (nixShellWithoutPkgs, withProjectRoot, findProjectAssets)
8080import Obelisk.Command.Thunk (attrCacheFileName)
8181import Obelisk.Command.Utils (findExePath, ghcidExePath)
8282
@@ -164,11 +164,12 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do
164164run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()
165165run root interpretPaths = do
166166 pkgs <- getParsedLocalPkgs root interpretPaths
167− withGhciScript pkgs root $ \dotGhciPath -> do
168− freePort <- getFreePort
167+ withGhciScript pkgs $ \dotGhciPath -> do
169168 assets <- findProjectAssets root
170169 putLog Debug $ "Assets impurely loaded from: " <> assets
171− runGhcid root True dotGhciPath pkgs $ Just $ unwords
170+ ghciArgs <- getGhciSessionSettings pkgs root
171+ freePort <- getFreePort
172+ runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs $ Just $ unwords
172173 [ "Obelisk.Run.run"
173174 , show freePort
174175 , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"
@@ -179,14 +180,16 @@ run root interpretPaths = do
179180runRepl :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()
180181runRepl root interpretPaths = do
181182 pkgs <- getParsedLocalPkgs root interpretPaths
182− withGhciScript pkgs "." $ \dotGhciPath ->
183− runGhciRepl root pkgs dotGhciPath
183+ ghciArgs <- getGhciSessionSettings pkgs "."
184+ withGhciScript pkgs $ \dotGhciPath ->
185+ runGhciRepl root pkgs (ghciArgs <> mkGhciScriptArg dotGhciPath)
184186
185187runWatch :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()
186188runWatch root interpretPaths = do
187189 pkgs <- getParsedLocalPkgs root interpretPaths
188− withGhciScript pkgs root $ \dotGhciPath ->
189− runGhcid root True dotGhciPath pkgs Nothing
190+ ghciArgs <- getGhciSessionSettings pkgs root
191+ withGhciScript pkgs $ \dotGhciPath ->
192+ runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs Nothing
190193
191194exportGhciConfig :: MonadObelisk m => FilePath -> PathTree Interpret -> m [String]
192195exportGhciConfig root interpretPaths = do
@@ -196,7 +199,7 @@ exportGhciConfig root interpretPaths = do
196199nixShellForInterpretPaths :: MonadObelisk m => Bool -> String -> FilePath -> PathTree Interpret -> Maybe String -> m ()
197200nixShellForInterpretPaths isPure shell root interpretPaths cmd = do
198201 pkgs <- getParsedLocalPkgs root interpretPaths
199− nixShellWithPkgs root isPure False (packageInfoToNamePathMap pkgs) shell cmd
202+ nixShellWithoutPkgs root isPure False (packageInfoToNamePathMap pkgs) shell cmd
200203
201204-- | Like 'getLocalPkgs' but also parses them and fails if any of them can't be parsed.
202205getParsedLocalPkgs :: MonadObelisk m => FilePath -> PathTree Interpret -> m (NonEmpty CabalPackageInfo)
@@ -397,12 +400,14 @@ packageInfoToNamePathMap = Map.fromList . map (_cabalPackageInfo_packageName &&&
397400withGhciScript
398401 :: (MonadObelisk m, Foldable f)
399402 => f CabalPackageInfo -- ^ List of packages to load into ghci
400− -> FilePath -- ^ All paths written to the .ghci file will be relative to this path
401403 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci
402404 -> m ()
403−withGhciScript (toList -> packageInfos) pathBase f = do
404− ghciSettings <- getGhciSessionSettings packageInfos pathBase
405− let
405+withGhciScript (toList -> packageInfos) f =
406+ withSystemTempDirectory "ob-ghci" $ \fp -> do
407+ let dotGhciPath = fp </> ".ghci"
408+ liftIO $ writeFile dotGhciPath dotGhci
409+ f dotGhciPath
410+ where
406411 packageNames = Set.fromList $ map _cabalPackageInfo_packageName packageInfos
407412 modulesToLoad = mconcat
408413 [ [ "Obelisk.Run" | "obelisk-run" `Set.member` packageNames ]
@@ -410,22 +415,18 @@ withGhciScript (toList -> packageInfos) pathBase f = do
410415 , [ "Frontend" | "frontend" `Set.member` packageNames ]
411416 ]
412417 dotGhci = unlines
413− [ ":set " <> unwords ghciSettings -- TODO: Shell escape
414− , if null modulesToLoad then "" else ":load " <> unwords modulesToLoad
418+ [ if null modulesToLoad then "" else ":load " <> unwords modulesToLoad
415419 , "import qualified Obelisk.Run"
416420 , "import qualified Frontend"
417− , "import qualified Backend" ]
418− withSystemTempDirectory "ob-ghci" $ \fp -> do
419− let dotGhciPath = fp </> ".ghci"
420− liftIO $ writeFile dotGhciPath dotGhci
421− f dotGhciPath
421+ , "import qualified Backend"
422+ ]
422423
423424-- | Builds a list of options to pass to ghci or set in .ghci file that configures
424425-- the preprocessor and source includes.
425426getGhciSessionSettings
426427 :: (MonadObelisk m, Foldable f)
427428 => f CabalPackageInfo -- ^ List of packages to load into ghci
428− -> FilePath -- ^ All paths written to the .ghci file will be relative to this path
429+ -> FilePath -- ^ All paths will be relative to this path
429430 -> m [String]
430431getGhciSessionSettings (toList -> packageInfos) pathBase = do
431432 -- N.B. ghci settings do NOT support escaping in any way. To minimize the likelihood that
@@ -440,54 +441,59 @@ getGhciSessionSettings (toList -> packageInfos) pathBase = do
440441 pure (canonicalPkgFile `relativeTo` canonicalPathBase, (`relativeTo` canonicalPathBase) <$> canonicalSrcDirs)
441442
442443 pure
443− $ ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]
444+ $ baseGhciOptions
445+ <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]
444446 <> concatMap (\p -> ["-optF", p]) pkgFiles
445447 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]
446448
449+baseGhciOptions :: [String]
450+baseGhciOptions =
451+ [ "-ignore-dot-ghci"
452+ , "-no-user-package-db"
453+ , "-package-env", "-"
454+ ]
455+
447456-- | Run ghci repl
448457runGhciRepl
449458 :: (MonadObelisk m, Foldable f)
450459 => FilePath -- ^ Path to project root
451− -> f CabalPackageInfo
452− -> FilePath -- ^ Path to .ghci
460+ -> f CabalPackageInfo -- ^ Packages to keep unbuilt
461+ -> [String] -- ^ GHCi arguments
453462 -> m ()
454−runGhciRepl root (toList -> packages) dotGhci =
463+runGhciRepl root (toList -> packages) ghciArgs =
455464 -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the
456465 -- ghc that is provided by the shell in the user's project.
457− nixShellWithPkgs root True False (packageInfoToNamePathMap packages) "ghc" $ Just $ "ghci " <> makeBaseGhciOptions dotGhci -- TODO: Shell escape
466+ nixShellWithoutPkgs root True False (packageInfoToNamePathMap packages) "ghc" $
467+ Just $ unwords $ "ghci" : ghciArgs -- TODO: Shell escape
458468
459469-- | Run ghcid
460470runGhcid
461471 :: (MonadObelisk m, Foldable f)
462472 => FilePath -- ^ Path to project root
463473 -> Bool -- ^ Should we chdir to root when running this process?
464− -> FilePath -- ^ Path to .ghci
465− -> f CabalPackageInfo
474+ -> [String] -- ^ GHCi arguments
475+ -> f CabalPackageInfo -- ^ Packages to keep unbuilt
466476 -> Maybe String -- ^ Optional command to run at every reload
467477 -> m ()
468−runGhcid root chdirToRoot dotGhci (toList -> packages) mcmd =
469− nixShellWithPkgs root True chdirToRoot (packageInfoToNamePathMap packages) "ghc" $ Just $ unwords $ ghcidExePath : opts -- TODO: Shell escape
478+runGhcid root chdirToRoot ghciArgs (toList -> packages) mcmd =
479+ nixShellWithoutPkgs root True chdirToRoot (packageInfoToNamePathMap packages) "ghc" $
480+ Just $ unwords $ ghcidExePath : opts -- TODO: Shell escape
470481 where
471482 opts =
472483 [ "-W"
473− , "--command='ghci -ignore-dot-ghci " <> makeBaseGhciOptions dotGhci <> "' "
474484 , "--outputfile=ghcid-output.txt"
475485 ] <> map (\x -> "--reload='" <> x <> "'") reloadFiles
476486 <> map (\x -> "--restart='" <> x <> "'") restartFiles
477487 <> testCmd
488+ <> ["--command='" <> unwords ("ghci" : ghciArgs) <> "'"] -- TODO: Shell escape
478489 testCmd = maybeToList (flip fmap mcmd $ \cmd -> "--test='" <> cmd <> "'") -- TODO: Shell escape
479490
480491 adjustRoot x = if chdirToRoot then makeRelative root x else x
481492 reloadFiles = map adjustRoot [root </> "config"]
482493 restartFiles = map (adjustRoot . _cabalPackageInfo_packageFile) packages
483494
484−makeBaseGhciOptions :: FilePath -> String
485−makeBaseGhciOptions dotGhci =
486− unwords
487− [ "-no-user-package-db"
488− , "-package-env -"
489− , "-ghci-script " <> dotGhci
490− ]
495+mkGhciScriptArg :: FilePath -> [String]
496+mkGhciScriptArg dotGhci = ["-ghci-script", dotGhci]
491497
492498getFreePort :: MonadIO m => m PortNumber
493499getFreePort = liftIO $ withSocketsDo $ do