on master help sign in
Make ob run chdir to root so that getConfig works
commit427d690f68312f467d233b94a5ccb2585f1d9fb1 authorElliot Cameron <eacameron@gmail.com> dateThu 30 Jan 2020, 18:21 (7 years ago) parent5b645da
2 files changed+27−23
lib/command/src/Obelisk/Command/Project.hs+5−4 lib/command/src/Obelisk/Command/Run.hs+22−19
lib/command/src/Obelisk/Command/Project.hs+5−4
@@ -253,13 +253,14 @@ toNixPath :: FilePath -> FilePath
253253toNixPath root | "/" `isInfixOf` root = root
254254 | otherwise = "./" <> root
255255
256−nixShellWithPkgs :: MonadObelisk m => FilePath -> Bool -> Map Text FilePath -> Maybe String -> m ()
257−nixShellWithPkgs root isPure packageNamesAndPaths command = do
256+nixShellWithPkgs :: MonadObelisk m => FilePath -> Bool -> Bool -> Map Text FilePath -> Maybe String -> m ()
257+nixShellWithPkgs root isPure chdirToRoot packageNamesAndPaths command = do
258258 packageNamesAndAbsPaths <- liftIO $ for packageNamesAndPaths makeAbsolute
259259 nixpkgsPath <- fmap T.strip $ readProcessAndLogStderr Debug $ setCwd (Just root) $
260260 proc nixExePath ["eval", "(import .obelisk/impl {}).nixpkgs.path"]
261+ let setCwd_ = if chdirToRoot then setCwd (Just root) else id
261262 nixRemote <- liftIO $ lookupEnv "NIX_REMOTE"
262− (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setDelegateCtlc True $ setCwd (Just root) $ proc "nix-shell" $
263+ (_, _, _, ph) <- createProcess_ "runNixShellAttr" $ setDelegateCtlc True $ setCwd_ $ proc "nix-shell" $
263264 runNixShellConfig $ def
264265 & nixShellConfig_pure .~ isPure
265266 & nixShellConfig_common . nixCmdConfig_target .~ (def
@@ -270,7 +271,7 @@ nixShellWithPkgs root isPure packageNamesAndPaths command = do
270271 \).project.shells.ghc"
271272 )
272273 & nixShellConfig_common . nixCmdConfig_args .~
273− [ rawArg "root" $ toNixPath root
274+ [ rawArg "root" $ toNixPath $ if chdirToRoot then "." else root
274275 , strArg "pkgs" (T.unpack $ decodeUtf8 $ BSL.toStrict $ Json.encode packageNamesAndAbsPaths)
275276 ]
276277 & nixShellConfig_run .~ (command <&> \c -> mconcat
lib/command/src/Obelisk/Command/Run.hs+22−19
@@ -72,7 +72,7 @@ preprocessorIdentifier = "__preprocessor-apply-packages"
7272run :: MonadObelisk m => m ()
7373run = withProjectRoot "." $ \root -> do
7474 pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root
75− withGhciScript pkgs $ \dotGhciPath -> do
75+ withGhciScript pkgs root $ \dotGhciPath -> do
7676 freePort <- getFreePort
7777 assets <- do
7878 let importableRoot = toNixPath root
@@ -96,7 +96,7 @@ run = withProjectRoot "." $ \root -> do
9696 else readProcessAndLogStderr Debug $
9797 proc nixExePath ["eval", "-f", root, "passthru.staticFilesImpure", "--raw"]
9898 putLog Debug $ "Assets impurely loaded from: " <> assets
99− runGhcid dotGhciPath pkgs $ Just $ unwords
99+ runGhcid root True dotGhciPath pkgs $ Just $ unwords
100100 [ "Obelisk.Run.run"
101101 , show freePort
102102 , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"
@@ -105,15 +105,16 @@ run = withProjectRoot "." $ \root -> do
105105 ]
106106
107107runRepl :: MonadObelisk m => m ()
108−runRepl = do
109− pkgs <- fmap toList . parsePackagesOrFail =<< withProjectRoot "." getLocalPkgs
110− withGhciScript pkgs $ \dotGhciPath -> do
111− runGhciRepl pkgs dotGhciPath
108+runRepl = withProjectRoot "." $ \root -> do
109+ pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root
110+ withGhciScript pkgs "." $ \dotGhciPath ->
111+ runGhciRepl root pkgs dotGhciPath
112112
113113runWatch :: MonadObelisk m => m ()
114−runWatch = do
115− pkgs <- fmap toList . parsePackagesOrFail =<< withProjectRoot "." getLocalPkgs
116− withGhciScript pkgs $ \dotGhciPath -> runGhcid dotGhciPath pkgs Nothing
114+runWatch = withProjectRoot "." $ \root -> do
115+ pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root
116+ withGhciScript pkgs root $ \dotGhciPath ->
117+ runGhcid root True dotGhciPath pkgs Nothing
117118
118119-- | Relative paths to local packages of an obelisk project.
119120--
@@ -254,9 +255,10 @@ packageInfoToNamePathMap = Map.fromList . map (_cabalPackageInfo_packageName &&&
254255withGhciScript
255256 :: MonadObelisk m
256257 => [CabalPackageInfo] -- ^ List of packages to load into ghci
258+ -> FilePath -- ^ All paths written to the .ghci file will be relative to this path
257259 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci
258260 -> m ()
259−withGhciScript packageInfos f = do
261+withGhciScript packageInfos pathBase f = do
260262 selfExe <- liftIO getExecutablePath
261263 let
262264 packageNames = Set.fromList $ map _cabalPackageInfo_packageName packageInfos
@@ -281,30 +283,31 @@ withGhciScript packageInfos f = do
281283
282284 where
283285 rootedSourceDirs pkg = NE.toList $
284− (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg
286+ makeRelative pathBase . (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg
285287
286288-- | Run ghci repl
287289runGhciRepl
288290 :: MonadObelisk m
289− => [CabalPackageInfo]
291+ => FilePath -- ^ Path to project root
292+ -> [CabalPackageInfo]
290293 -> FilePath -- ^ Path to .ghci
291294 -> m ()
292−runGhciRepl packages dotGhci = withProjectRoot "." $ \root -> do
295+runGhciRepl root packages dotGhci =
293296 -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the
294297 -- ghc that is provided by the shell in the user's project.
295− rootAbs <- liftIO $ makeAbsolute root
296− nixShellWithPkgs root True (packageInfoToNamePathMap packages) $ Just $ "ghci " <> makeBaseGhciOptions dotGhci -- TODO: Shell escape
298+ nixShellWithPkgs root True False (packageInfoToNamePathMap packages) $ Just $ "ghci " <> makeBaseGhciOptions dotGhci -- TODO: Shell escape
297299
298300-- | Run ghcid
299301runGhcid
300302 :: MonadObelisk m
301− => FilePath -- ^ Path to .ghci
303+ => FilePath -- ^ Path to project root
304+ -> Bool -- ^ Should we chdir to root when running this process?
305+ -> FilePath -- ^ Path to .ghci
302306 -> [CabalPackageInfo]
303307 -> Maybe String -- ^ Optional command to run at every reload
304308 -> m ()
305−runGhcid dotGhci packages mcmd = withProjectRoot "." $ \root -> do
306− rootAbs <- liftIO $ makeAbsolute root
307− nixShellWithPkgs rootAbs True (packageInfoToNamePathMap packages) (Just $ unwords $ ghcidExePath : opts) -- TODO: Shell escape
309+runGhcid root chdirToRoot dotGhci packages mcmd =
310+ nixShellWithPkgs root True chdirToRoot (packageInfoToNamePathMap packages) (Just $ unwords $ ghcidExePath : opts) -- TODO: Shell escape
308311 where
309312 opts =
310313 [ "-W"