d02c4e5 · obelisk · git.iko.soy

git.iko.soy/obelisk

Merge pull request #714 from obsidiansystems/eac@add-use-relative-paths

Use absolute paths by default in exported ghci config and other fixes

commitd02c4e5dbb4cd61c0e0e113e7bf34e2e898ea232 authorElliot Cameron <3noch@users.noreply.github.com> dateThu 23 Apr 2020, 10:43 (6 years ago) parentb72768e 5a81a09

4 files changed+28−18

compare with master

unifiedsplit

README.md+1 lib/command/src/Obelisk/Command.hs+11−5 lib/command/src/Obelisk/Command/Nix.hs+4−4 lib/command/src/Obelisk/Command/Run.hs+12−9

README.md+1

@@ -199,6 +199,7 @@ To try out the **experimental** [`ghcide`](https://github.com/digital-asset/ghci

199199 EOF

200200 chmod +x hie-bios.sh

201201 ```

202+ * **Note:** In some projects you need to use `ob internal export-ghci-configuration --use-relative-paths` in this script instead. This is known to happen when your project contains symlinks to other packages.

202203 * Add `hie.yaml` to the root of your project:

203204 ```shell

204205 echo 'cradle: { bios: { program: hie-bios.sh } }' > hie.yaml

lib/command/src/Obelisk/Command.hs+11−5

@@ -74,8 +74,8 @@ argsInfo cfg = info (args cfg <**> helper) $ mconcat

7474initSource :: Parser InitSource

7575initSource = foldl1 (<|>)

7676 [ pure InitSource_Default

77− , InitSource_Branch <$> strOption (long "branch" <> metavar "BRANCH")

78− , InitSource_Symlink <$> strOption (long "symlink" <> action "directory" <> metavar "PATH")

77+ , InitSource_Branch <$> strOption (long "branch" <> metavar "BRANCH" <> help "Initialize the project using the given BRANCH of Obelisk's official repository")

78+ , InitSource_Symlink <$> strOption (long "symlink" <> action "directory" <> metavar "PATH" <> help "(Use with caution) Initialize the project using the copy of Obelisk found at the given PATH")

7979 ]

8080

8181initForce :: Parser Bool

@@ -99,7 +99,9 @@ data ObInternal

9999 -- the preprocessor argument syntax is also handled outside

100100 -- optparse-applicative, but it shouldn't ever conflict with another syntax

101101 = ObInternal_ApplyPackages String String String [String]

102− | ObInternal_ExportGhciConfig [(FilePath, Interpret)]

102+ | ObInternal_ExportGhciConfig

103+ [(FilePath, Interpret)]

104+ Bool -- ^ Use relative paths

103105 deriving Show

104106

105107obCommand :: ArgsConfig -> Parser ObCommand

@@ -124,8 +126,11 @@ obCommand cfg = hsubparser

124126

125127internalCommand :: Parser ObInternal

126128internalCommand = hsubparser $ mconcat

127− [ command "export-ghci-configuration" $ info (ObInternal_ExportGhciConfig <$> interpretOpts) $ progDesc "Export the GHCi configuration used by ob run, etc.; useful for IDE integration"

129+ [ command "export-ghci-configuration" $ info (ObInternal_ExportGhciConfig <$> interpretOpts <*> useRelativePathsFlag)

130+ $ progDesc "Export the GHCi configuration used by ob run, etc.; useful for IDE integration"

128131 ]

132+ where

133+ useRelativePathsFlag = switch (long "use-relative-paths" <> help "Use relative paths")

129134

130135packageNames :: Parser [String]

131136packageNames = some (strArgument (metavar "PACKAGE-NAME..."))

@@ -401,7 +406,8 @@ ob = \case

401406 ObCommand_Internal icmd -> case icmd of

402407 ObInternal_ApplyPackages origPath inPath outPath packagePaths -> do

403408 liftIO $ Preprocessor.applyPackages origPath inPath outPath packagePaths

404− ObInternal_ExportGhciConfig interpretPathsList -> liftIO . putStrLn . unlines =<< withInterpretPaths interpretPathsList exportGhciConfig

409+ ObInternal_ExportGhciConfig interpretPathsList useRelativePaths ->

410+ liftIO . putStrLn . unlines =<< withInterpretPaths interpretPathsList (exportGhciConfig useRelativePaths)

405411

406412-- | A helper for the common case that the command you want to run needs the project root and a resolved

407413-- set of interpret paths.

lib/command/src/Obelisk/Command/Nix.hs+4−4

@@ -207,7 +207,7 @@ nixCmdProc' cmdCfg = (proc (T.unpack cmd) options, cmd)

207207 )

208208

209209nixCmd :: MonadObelisk m => NixCmd -> m FilePath

210−nixCmd cmdCfg = withSpinner' ("Running " <> cmd <> desc) (Just $ const $ "Built " <> desc) $ do

210+nixCmd cmdCfg = withSpinner' (T.unwords $ "Running" : cmd : desc) (Just $ const $ T.unwords $ "Built" : desc) $ do

211211 output <- readProcessAndLogStderr Debug cmdProc

212212 -- Remove final newline that Nix appends

213213 Just (outPath, '\n') <- pure $ T.unsnoc output

@@ -218,7 +218,7 @@ nixCmd cmdCfg = withSpinner' ("Running " <> cmd <> desc) (Just $ const $ "Built

218218 NixCmd_Build cfg' -> cfg' ^. nixCommonConfig

219219 NixCmd_Instantiate cfg' -> cfg' ^. nixCommonConfig

220220 path = commonCfg ^. nixCmdConfig_target . target_path

221− desc = T.pack $ mconcat $ catMaybes

222− [ ("on " <>) <$> path

223− , (\a -> " [" <> a <> "]") <$> (commonCfg ^. nixCmdConfig_target . target_attr)

221+ desc = concat $ catMaybes

222+ [ (\x -> ["on", T.pack x]) <$> path

223+ , (\a -> ["[" <> T.pack a <> "]"]) <$> (commonCfg ^. nixCmdConfig_target . target_attr)

224224 ]

lib/command/src/Obelisk/Command/Run.hs+12−9

@@ -167,7 +167,7 @@ run root interpretPaths = do

167167 withGhciScript pkgs $ \dotGhciPath -> do

168168 assets <- findProjectAssets root

169169 putLog Debug $ "Assets impurely loaded from: " <> assets

170− ghciArgs <- getGhciSessionSettings pkgs root

170+ ghciArgs <- getGhciSessionSettings pkgs root True

171171 freePort <- getFreePort

172172 runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs $ Just $ unwords

173173 [ "Obelisk.Run.run"

@@ -180,21 +180,21 @@ run root interpretPaths = do

180180runRepl :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

181181runRepl root interpretPaths = do

182182 pkgs <- getParsedLocalPkgs root interpretPaths

183− ghciArgs <- getGhciSessionSettings pkgs "."

183+ ghciArgs <- getGhciSessionSettings pkgs "." True

184184 withGhciScript pkgs $ \dotGhciPath ->

185185 runGhciRepl root pkgs (ghciArgs <> mkGhciScriptArg dotGhciPath)

186186

187187runWatch :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()

188188runWatch root interpretPaths = do

189189 pkgs <- getParsedLocalPkgs root interpretPaths

190− ghciArgs <- getGhciSessionSettings pkgs root

190+ ghciArgs <- getGhciSessionSettings pkgs root True

191191 withGhciScript pkgs $ \dotGhciPath ->

192192 runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs Nothing

193193

194−exportGhciConfig :: MonadObelisk m => FilePath -> PathTree Interpret -> m [String]

195−exportGhciConfig root interpretPaths = do

194+exportGhciConfig :: MonadObelisk m => Bool -> FilePath -> PathTree Interpret -> m [String]

195+exportGhciConfig useRelativePaths root interpretPaths = do

196196 pkgs <- getParsedLocalPkgs root interpretPaths

197− getGhciSessionSettings pkgs "."

197+ getGhciSessionSettings pkgs "." useRelativePaths

198198

199199nixShellForInterpretPaths :: MonadObelisk m => Bool -> String -> FilePath -> PathTree Interpret -> Maybe String -> m ()

200200nixShellForInterpretPaths isPure shell root interpretPaths cmd = do

@@ -427,8 +427,9 @@ getGhciSessionSettings

427427 :: (MonadObelisk m, Foldable f)

428428 => f CabalPackageInfo -- ^ List of packages to load into ghci

429429 -> FilePath -- ^ All paths will be relative to this path

430+ -> Bool -- ^ Use relative paths

430431 -> m [String]

431−getGhciSessionSettings (toList -> packageInfos) pathBase = do

432+getGhciSessionSettings (toList -> packageInfos) pathBase useRelativePaths = do

432433 -- N.B. ghci settings do NOT support escaping in any way. To minimize the likelihood that

433434 -- paths-with-spaces ruin our day, we first canonicalize everything, and then relativize

434435 -- all paths to 'pathBase'.

@@ -438,13 +439,15 @@ getGhciSessionSettings (toList -> packageInfos) pathBase = do

438439 (pkgFiles, pkgSrcPaths :: [NonEmpty FilePath]) <- fmap unzip $ liftIO $ for packageInfos $ \pkg -> do

439440 canonicalSrcDirs <- traverse canonicalizePath $ (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg

440441 canonicalPkgFile <- canonicalizePath $ _cabalPackageInfo_packageFile pkg

441− pure (canonicalPkgFile `relativeTo` canonicalPathBase, (`relativeTo` canonicalPathBase) <$> canonicalSrcDirs)

442+ pure (canonicalPkgFile `relativeTo'` canonicalPathBase, (`relativeTo'` canonicalPathBase) <$> canonicalSrcDirs)

442443

443444 pure

444445 $ baseGhciOptions

445446 <> ["-F", "-pgmF", selfExe, "-optF", preprocessorIdentifier]

446447 <> concatMap (\p -> ["-optF", p]) pkgFiles

447448 <> [ "-i" <> intercalate ":" (concatMap toList pkgSrcPaths) ]

449+ where

450+ relativeTo' = if useRelativePaths then relativeTo else const

448451

449452baseGhciOptions :: [String]

450453baseGhciOptions =

@@ -537,4 +540,4 @@ relativeTo dir base

537540 $ zipDefaultWith Nothing Nothing (,)

538541 (map Just $ splitDirectories base)

539542 (map Just $ splitDirectories dir)

540− where collapse = foldr (</>) ""

543+ where collapse = foldr (</>) ""