6d896e1 · obelisk · git.iko.soy

git.iko.soy/obelisk

command: Allow export-ghci-config to decide whether or not to use relative paths

commit6d896e1dd284e503067189f924aa434810644a15 authorElliot Cameron <eacameron@gmail.com> dateWed 22 Apr 2020, 19:13 (6 years ago) parent1b969d9

2 files changed+21−12

compare with master

unifiedsplit

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

lib/command/src/Obelisk/Command.hs+9−3

@@ -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/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 (</>) ""