@@ -3,47 +3,77 @@
3{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6−{-# LANGUAGE TemplateHaskell #-}
7{-# LANGUAGE TupleSections #-}
6{-# LANGUAGE TupleSections #-}
7+{-# LANGUAGE QuasiQuotes #-}
8module Obelisk.Command.Run where
8module Obelisk.Command.Run where
10−import Control.Applicative (liftA2)
10+import Control.Arrow ((&&&))
11import Control.Exception (Exception, bracket)
11import Control.Exception (Exception, bracket)
12−import Control.Monad
12+import Control.Lens (ifor, (.~), (&))
13+import Control.Monad (filterM, unless, void)
13import Control.Monad.Except (runExceptT, throwError)
14import Control.Monad.Except (runExceptT, throwError)
14import Control.Monad.IO.Class (liftIO)
15import Control.Monad.IO.Class (liftIO)
15import Control.Monad.Reader (MonadIO)
16import Control.Monad.Reader (MonadIO)
17+import Data.Coerce (coerce)
18+import Data.Default (def)
16import Data.Either
19import Data.Either
17−import Data.Foldable (for_)
20+import Data.Foldable (for_, toList)
18−import qualified Data.List as L
19import qualified Data.List.NonEmpty as NE
21import qualified Data.List.NonEmpty as NE
23+import qualified Data.Map as Map
20import Data.Maybe
24import Data.Maybe
25+import qualified Data.Set as Set
26+import Data.Text (Text)
21import qualified Data.Text as T
27import qualified Data.Text as T
28+import Data.Time.Clock (getCurrentTime)
29+import Data.Time.Format (formatTime, defaultTimeLocale)
30+import Data.Traversable (for)
31+import Debug.Trace (trace)
22import Distribution.Compiler (CompilerFlavor(..))
32import Distribution.Compiler (CompilerFlavor(..))
23import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
33import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
24import Distribution.Parsec.ParseResult (runParseResult)
34import Distribution.Parsec.ParseResult (runParseResult)
25−import Distribution.Pretty
35+import qualified Distribution.System as Dist
26import Distribution.Types.BuildInfo
36import Distribution.Types.BuildInfo
27import Distribution.Types.CondTree
37import Distribution.Types.CondTree
28import Distribution.Types.GenericPackageDescription
38import Distribution.Types.GenericPackageDescription
29import Distribution.Types.Library
39import Distribution.Types.Library
30import Distribution.Utils.Generic
40import Distribution.Utils.Generic
41+import qualified Distribution.Parsec.Common as Dist
31import qualified Hpack.Config as Hpack
42import qualified Hpack.Config as Hpack
32import qualified Hpack.Render as Hpack
43import qualified Hpack.Render as Hpack
33import qualified Hpack.Yaml as Hpack
44import qualified Hpack.Yaml as Hpack
34import Language.Haskell.Extension
45import Language.Haskell.Extension
35import Network.Socket hiding (Debug)
46import Network.Socket hiding (Debug)
36import System.Directory
47import System.Directory
48+import System.Environment (getExecutablePath)
37import System.FilePath
49import System.FilePath
50+import qualified System.Info
38import System.IO.Temp (withSystemTempDirectory)
51import System.IO.Temp (withSystemTempDirectory)
39−import System.Which (staticWhich)
41−import Obelisk.App (MonadObelisk, ObeliskT)
53+import Obelisk.App (MonadObelisk)
54+import Obelisk.CliApp (
60+ readCreateProcessWithExitCode,
42−import Obelisk.CliApp (Severity (..) , callCommand, failWith, putLog, proc, readProcessAndLogStderr)
61+ readProcessAndLogStderr,
43−import Obelisk.Command.Project (inProjectShell, withProjectRoot)
67+import Obelisk.Command.Nix
68+import Obelisk.Command.Project (nixShellWithPkgs, toImplDir, withProjectRoot, findProjectAssets)
69+import Obelisk.Command.Thunk (attrCacheFileName)
70+import Obelisk.Command.Utils (findExePath, ghcidExePath)
45data CabalPackageInfo = CabalPackageInfo
72data CabalPackageInfo = CabalPackageInfo
73+ { _cabalPackageInfo_packageFile :: FilePath
74+ , _cabalPackageInfo_packageName :: T.Text
46− { _cabalPackageInfo_packageRoot :: FilePath
75+ , _cabalPackageInfo_packageRoot :: FilePath
76+ , _cabalPackageInfo_buildable :: Bool
47 , _cabalPackageInfo_sourceDirs :: NE.NonEmpty FilePath
77 , _cabalPackageInfo_sourceDirs :: NE.NonEmpty FilePath
48 -- ^ List of hs src dirs of the library component
78 -- ^ List of hs src dirs of the library component
49 , _cabalPackageInfo_defaultExtensions :: [Extension]
79 , _cabalPackageInfo_defaultExtensions :: [Extension]
@@ -54,108 +84,182 @@ data CabalPackageInfo = CabalPackageInfo
54 -- ^ List of compiler-specific options (e.g., the "ghc-options" field of the cabal file)
84 -- ^ List of compiler-specific options (e.g., the "ghc-options" field of the cabal file)
57−-- NOTE: `run` is not polymorphic like the rest because we use StaticPtr to invoke it.
87+-- | Used to signal to obelisk that it's being invoked as a preprocessor
58−run :: ObeliskT IO ()
88+preprocessorIdentifier :: String
59−run = do
89+preprocessorIdentifier = "__preprocessor-apply-packages"
60− let nixPath = $(staticWhich "nix")
90+
61− nixBuildPath = $(staticWhich "nix-build")
91+profile
96+profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do
97+ putLog Debug "Using profiled build of project."
99+ outPath <- withSpinner "Building profiled executable" $
100+ fmap (T.unpack . T.strip) $ readProcessAndLogStderr Debug $ setCwd (Just root) $ nixCmdProc $
102+ & nixBuildConfig_outLink .~ OutLink_None
103+ & nixCmdConfig_target .~ Target
104+ { _target_path = Just "."
105+ , _target_attr = Just "__unstable__.profiledObRun"
106+ , _target_expr = Nothing
108+ assets <- findProjectAssets root
109+ putLog Debug $ "Assets impurely loaded from: " <> assets
110+ time <- liftIO getCurrentTime
111+ let profileBaseName = formatTime defaultTimeLocale profileBasePattern time
112+ liftIO $ createDirectoryIfMissing True $ takeDirectory $ root </> profileBaseName
113+ putLog Debug $ "Storing profiled data under base name of " <> T.pack (root </> profileBaseName)
114+ freePort <- getFreePort
115+ (_, _, _, ph) <- createProcess_ "runProfExe" $ setCwd (Just root) $ setDelegateCtlc True $ proc (outPath </> "bin" </> "ob-run") $
120+ , "-po" <> profileBaseName
123+ void $ waitForProcess ph
128+run = withProjectRoot "." $ \root -> do
62− pkgs <- getLocalPkgs
129+ pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root
63− withGhciScript pkgs $ \dotGhciPath -> do
130+ withGhciScript pkgs root $ \dotGhciPath -> do
64 freePort <- getFreePort
131 freePort <- getFreePort
65− assets <- withProjectRoot "." $ \root -> do
132+ assets <- findProjectAssets root
66− let importableRoot = if "/" `isInfixOf` root
69− isDerivation <- readProcessAndLogStderr Debug $
74− , "(let a = import " <> importableRoot <> " {}; in toString (a.reflex.nixpkgs.lib.isDerivation a.passthru.staticFilesImpure))"
76− -- `--raw` is not available with old nix-instantiate. It drops quotation
77− -- marks and trailing newline, so is very convenient for shelling out.
79− -- Check whether the impure static files are a derivation (and so must be built)
80− if isDerivation == "1"
81− then fmap T.strip $ readProcessAndLogStderr Debug $ -- Strip whitespace here because nix-build has no --raw option
84− , "-E", "(import " <> importableRoot <> "{}).passthru.staticFilesImpure"
86− else readProcessAndLogStderr Debug $
87− proc nixPath ["eval", "-f", root, "passthru.staticFilesImpure", "--raw"]
88 putLog Debug $ "Assets impurely loaded from: " <> assets
133 putLog Debug $ "Assets impurely loaded from: " <> assets
89− runGhcid dotGhciPath $ Just $ unwords
134+ runGhcid root True dotGhciPath pkgs $ Just $ unwords
90 [ "Obelisk.Run.run"
135 [ "Obelisk.Run.run"
91 , show freePort
136 , show freePort
92− , "(runServeAsset " ++ show assets ++ ")"
137+ , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"
93 , "Backend.backend"
138 , "Backend.backend"
94 , "Frontend.frontend"
139 , "Frontend.frontend"
97runRepl :: MonadObelisk m => m ()
142runRepl :: MonadObelisk m => m ()
98−runRepl = do
143+runRepl = withProjectRoot "." $ \root -> do
99− pkgs <- getLocalPkgs
144+ pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root
100− withGhciScript pkgs $ \dotGhciPath -> do
145+ withGhciScript pkgs "." $ \dotGhciPath ->
101− runGhciRepl dotGhciPath
146+ runGhciRepl root pkgs dotGhciPath
103runWatch :: MonadObelisk m => m ()
148runWatch :: MonadObelisk m => m ()
104−runWatch = do
149+runWatch = withProjectRoot "." $ \root -> do
105− pkgs <- getLocalPkgs
150+ pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root
106− withGhciScript pkgs $ \dotGhciPath -> runGhcid dotGhciPath Nothing
151+ withGhciScript pkgs root $ \dotGhciPath ->
152+ runGhcid root True dotGhciPath pkgs Nothing
154+-- | Relative paths to local packages of an obelisk project.
156+-- These are a combination of the obelisk predefined local packages,
157+-- and any packages that the user has set with the @packages@ argument
158+-- to the Nix @project@ function.
159+getLocalPkgs :: MonadObelisk m => FilePath -> m [FilePath]
160+getLocalPkgs root = do
161+ obeliskPaths <- runFind ["-L", root, "-name", ".obelisk", "-type", "d"]
163+ -- We do not want to find packages that are embedded inside other obelisk projects, unless that
164+ -- obelisk project is our own.
165+ let exclusions = filter (/= root) $ map takeDirectory obeliskPaths
166+ fmap (map (makeRelative ".")) $ runFind $
167+ ["-L", root, "(", "-name", "*.cabal", "-o", "-name", Hpack.packageConfig, ")", "-a", "-type", "f"]
168+ <> concat [["-not", "-path", p </> "*"] | p <- (toImplDir "*" </> attrCacheFileName) : exclusions]
171+ (_exitCode, out, err) <- readCreateProcessWithExitCode $ proc findExePath args
172+ putLog Debug $ T.strip $ T.pack err
173+ pure $ map T.unpack $ T.lines $ T.strip $ T.pack out
108data GuessPackageFileError = GuessPackageFileError_Ambiguous [FilePath] | GuessPackageFileError_NotFound
175data GuessPackageFileError = GuessPackageFileError_Ambiguous [FilePath] | GuessPackageFileError_NotFound
109 deriving (Eq, Ord, Show)
176 deriving (Eq, Ord, Show)
110instance Exception GuessPackageFileError
177instance Exception GuessPackageFileError
179+newtype HPackFilePath = HPackFilePath { unHPackFilePath :: FilePath } deriving (Eq, Ord, Show)
180+newtype CabalFilePath = CabalFilePath { unCabalFilePath :: FilePath } deriving (Eq, Ord, Show)
112-- | Given a directory, try to guess what the appropriate @.cabal@ or @package.yaml@ file is for the package.
182-- | Given a directory, try to guess what the appropriate @.cabal@ or @package.yaml@ file is for the package.
113guessCabalPackageFile
183guessCabalPackageFile
114− :: MonadIO m
184+ :: (MonadIO m)
115− => FilePath -- ^ Directory to search for cabal package
185+ => FilePath -- ^ Directory or path to search for cabal package
116− -> m (Either GuessPackageFileError (Either FilePath FilePath))
186+ -> m (Either GuessPackageFileError (Either CabalFilePath HPackFilePath))
117− -- ^ 'Right' 'Left' for hpack package, 'Right' 'Right' for cabal package; 'FilePath' is relative to given directory.
118−guessCabalPackageFile dir = do
187+guessCabalPackageFile pkg = do
119− candidates <- liftIO $
188+ liftIO (doesDirectoryExist pkg) >>= \case
189+ False -> case cabalOrHpackFile pkg of
190+ (Just hpack@(Right _)) -> pure $ Right hpack
191+ (Just cabal@(Left (CabalFilePath cabalFilePath))) -> do
192+ -- If the cabal file has a sibling hpack file, we use that instead
193+ -- since running hpack often generates a sibling cabal file
194+ let possibleHpackSibling = takeDirectory cabalFilePath </> Hpack.packageConfig
195+ hasHpackSibling <- liftIO $ doesFileExist possibleHpackSibling
196+ pure $ Right $ if hasHpackSibling then Right (HPackFilePath possibleHpackSibling) else cabal
197+ Nothing -> pure $ Left GuessPackageFileError_NotFound
199+ candidates <- liftIO $
120− filterM (doesFileExist . (dir </>))
200+ filterM (doesFileExist . either unCabalFilePath unHPackFilePath)
121− =<< filter (liftA2 (||) (== Hpack.packageConfig) (".cabal" `L.isSuffixOf`))
122− <$> listDirectory dir
201+ =<< mapMaybe (cabalOrHpackFile . (pkg </>)) <$> listDirectory pkg
123− pure $ case L.partition (== Hpack.packageConfig) candidates of
202+ pure $ case partitionEithers candidates of
124− ([hpack], _) -> Right $ Left hpack
203+ ([hpack], _) -> Right $ Left hpack
125− ([], [cabal]) -> Right $ Right cabal
204+ ([], [cabal]) -> Right $ Right cabal
126− ([], []) -> Left GuessPackageFileError_NotFound
205+ ([], []) -> Left GuessPackageFileError_NotFound
127− (hpacks, cabals) -> Left $ GuessPackageFileError_Ambiguous $ hpacks <> cabals
206+ (hpacks, cabals) -> Left $ GuessPackageFileError_Ambiguous $ coerce hpacks <> coerce cabals
129−-- | Relative paths to local packages of an obelisk project
208+cabalOrHpackFile :: FilePath -> Maybe (Either CabalFilePath HPackFilePath)
130−-- TODO a way to query this
209+cabalOrHpackFile = \case
131−getLocalPkgs :: Applicative f => f [FilePath]
210+ x | takeExtension x == ".cabal" -> Just (Left $ CabalFilePath x)
132−getLocalPkgs = pure ["backend", "common", "frontend"]
211+ | takeFileName x == Hpack.packageConfig -> Just (Right $ HPackFilePath x)
212+ | otherwise -> Nothing
214+-- | Parses the cabal package in a given directory.
215+-- This automatically figures out which .cabal file or package.yaml (hpack) file to use in the given directory.
134parseCabalPackage
216parseCabalPackage
135− :: (MonadObelisk m)
217+ :: MonadObelisk m
136− => FilePath -- ^ package directory
218+ => FilePath -- ^ Package directory
137 -> m (Maybe CabalPackageInfo)
219 -> m (Maybe CabalPackageInfo)
138−parseCabalPackage dir = either ((Nothing <$) . putLog Error) (pure . Just) <=< runExceptT $ do
220+parseCabalPackage dir = parseCabalPackage' dir >>= \case
221+ Left err -> Nothing <$ putLog Error err
222+ Right (warnings, pkgInfo) -> do
223+ for_ warnings $ putLog Warning . T.pack . show
226+-- | Like 'parseCabalPackage' but returns errors and warnings directly so as to avoid 'MonadObelisk'.
229+ => FilePath -- ^ Package directory
230+ -> m (Either T.Text ([Dist.PWarning], CabalPackageInfo))
231+parseCabalPackage' pkg = runExceptT $ do
139− (cabalContents, packageFile) <- guessCabalPackageFile dir >>= \case
232+ (cabalContents, packageFile, packageName) <- guessCabalPackageFile pkg >>= \case
140− Left GuessPackageFileError_NotFound -> throwError $ "No .cabal or package.yaml file found in " <> T.pack dir
233+ Left GuessPackageFileError_NotFound -> throwError $ "No .cabal or package.yaml file found in " <> T.pack pkg
141− Left (GuessPackageFileError_Ambiguous _) -> throwError $ "Unable to determine which .cabal file to use in " <> T.pack dir
234+ Left (GuessPackageFileError_Ambiguous _) -> throwError $ "Unable to determine which .cabal file to use in " <> T.pack pkg
142− Right (Right cabalFileName) -> let file = dir </> cabalFileName in (, file) <$> liftIO (readUTF8File file)
235+ Right (Left (CabalFilePath file)) -> (, file, takeBaseName file) <$> liftIO (readUTF8File file)
143− Right (Left hpackFileName) -> do
236+ Right (Right (HPackFilePath file)) -> do
145− file = dir </> hpackFileName
146 decodeOptions = Hpack.DecodeOptions (Hpack.ProgramName "ob") file Nothing Hpack.decodeYaml
238 decodeOptions = Hpack.DecodeOptions (Hpack.ProgramName "ob") file Nothing Hpack.decodeYaml
147 liftIO (Hpack.readPackageConfig decodeOptions) >>= \case
239 liftIO (Hpack.readPackageConfig decodeOptions) >>= \case
148 Left err -> throwError $ T.pack $ "Failed to parse " <> file <> ": " <> err
240 Left err -> throwError $ T.pack $ "Failed to parse " <> file <> ": " <> err
149− Right (Hpack.DecodeResult hpackPackage _ _ _) -> pure (Hpack.renderPackage [] hpackPackage, file)
241+ Right (Hpack.DecodeResult hpackPackage _ _ _) -> pure (Hpack.renderPackage [] hpackPackage, file, Hpack.packageName hpackPackage)
151− let (warnings, result) = runParseResult $ parseGenericPackageDescription $
244+ (warnings, result) = runParseResult $ parseGenericPackageDescription $ toUTF8BS cabalContents
152− toUTF8BS cabalContents
245+ osConfVar = case System.Info.os of
153− for_ warnings $ putLog Warning . T.pack . show
246+ "linux" -> Just Dist.Linux
247+ "darwin" -> Just Dist.OSX
248+ _ -> trace "Unrecgonized System.Info.os" Nothing
249+ archConfVar = Just Dist.X86_64 -- TODO: Actually infer this
250+ evalConfVar v = Right $ case v of
251+ OS osVar -> Just osVar == osConfVar
252+ Arch archVar -> Just archVar == archConfVar
253+ Impl GHC _ -> True -- TODO: Actually check version range
154 case condLibrary <$> result of
255 case condLibrary <$> result of
155 Right (Just condLib) -> do
256 Right (Just condLib) -> do
156− let (_, lib) = simplifyCondTree (const $ pure True) condLib
257+ let (_, lib) = simplifyCondTree evalConfVar condLib
157− pure $ CabalPackageInfo
258+ pure $ (warnings,) $ CabalPackageInfo
259+ { _cabalPackageInfo_packageName = T.pack packageName
260+ , _cabalPackageInfo_packageFile = packageFile
158− { _cabalPackageInfo_packageRoot = dir
261+ , _cabalPackageInfo_packageRoot = takeDirectory packageFile
262+ , _cabalPackageInfo_buildable = buildable $ libBuildInfo lib
159 , _cabalPackageInfo_sourceDirs =
263 , _cabalPackageInfo_sourceDirs =
160 fromMaybe (pure ".") $ NE.nonEmpty $ hsSourceDirs $ libBuildInfo lib
264 fromMaybe (pure ".") $ NE.nonEmpty $ hsSourceDirs $ libBuildInfo lib
161 , _cabalPackageInfo_defaultExtensions =
265 , _cabalPackageInfo_defaultExtensions =
@@ -168,45 +272,60 @@ parseCabalPackage dir = either ((Nothing <$) . putLog Error) (pure . Just) <=< r
168 Left (_, errors) ->
272 Left (_, errors) ->
169 throwError $ T.pack $ "Failed to parse " <> packageFile <> ":\n" <> unlines (map show errors)
273 throwError $ T.pack $ "Failed to parse " <> packageFile <> ":\n" <> unlines (map show errors)
275+parsePackagesOrFail :: MonadObelisk m => [FilePath] -> m (NE.NonEmpty CabalPackageInfo)
276+parsePackagesOrFail dirs = do
277+ (pkgDirErrs, packageInfos') <- fmap partitionEithers $ for dirs $ \dir -> do
278+ flip fmap (parseCabalPackage dir) $ \case
280+ | _cabalPackageInfo_buildable packageInfo -> Right packageInfo
283+ let packagesByName = Map.fromListWith (<>) [(_cabalPackageInfo_packageName p, p NE.:| []) | p <- packageInfos']
284+ unambiguous <- ifor packagesByName $ \packageName ps -> case ps of
285+ p NE.:| [] -> pure p -- No ambiguity here
287+ putLog Warning $ T.pack $
288+ "Packages named '" <> T.unpack packageName <> "' appear in " <> show (length ps) <> " different locations: "
289+ <> intercalate ", " (map _cabalPackageInfo_packageFile $ toList ps)
290+ <> "; Picking " <> _cabalPackageInfo_packageFile p
293+ packageInfos <- case NE.nonEmpty $ toList unambiguous of
294+ Nothing -> failWith $ T.pack $ "No valid, buildable packages found in " <> intercalate ", " dirs
297+ unless (null pkgDirErrs) $
298+ putLog Warning $ T.pack $ "Failed to find buildable packages in " <> intercalate ", " pkgDirErrs
302+packageInfoToNamePathMap :: [CabalPackageInfo] -> Map Text FilePath
303+packageInfoToNamePathMap = Map.fromList . map (_cabalPackageInfo_packageName &&& _cabalPackageInfo_packageRoot)
171-- | Create ghci configuration to load the given packages
305-- | Create ghci configuration to load the given packages
172withGhciScript
306withGhciScript
173 :: MonadObelisk m
307 :: MonadObelisk m
174− => [FilePath] -- ^ List of packages to load into ghci
308+ => [CabalPackageInfo] -- ^ List of packages to load into ghci
309+ -> FilePath -- ^ All paths written to the .ghci file will be relative to this path
175 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci
310 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci
177−withGhciScript dirs f = do
312+withGhciScript packageInfos pathBase f = do
178− (pkgDirErrs, packageInfos) <- fmap partitionEithers $ forM dirs $ \dir -> do
313+ selfExe <- liftIO getExecutablePath
179− flip fmap (parseCabalPackage dir) $ \case
314+ let
180− Nothing -> Left dir
315+ packageNames = Set.fromList $ map _cabalPackageInfo_packageName packageInfos
181− Just packageInfo -> Right packageInfo
316+ modulesToLoad = mconcat
182−
317+ [ [ "Obelisk.Run" | "obelisk-run" `Set.member` packageNames ]
183− when (null packageInfos) $
318+ , [ "Backend" | "backend" `Set.member` packageNames ]
184− failWith $ T.pack $ "No valid pkgs found in " <> intercalate ", " dirs
319+ , [ "Frontend" | "frontend" `Set.member` packageNames ]
185− unless (null pkgDirErrs) $
320+ ]
186− putLog Warning $ T.pack $ "Failed to find pkgs in " <> intercalate ", " pkgDirErrs
321+ dotGhci = unlines
187−
322+ -- TODO: Shell escape
188− let extensions = packageInfos >>= _cabalPackageInfo_defaultExtensions
323+ [ ":set -F -pgmF " <> selfExe <> " -optF " <> preprocessorIdentifier <> " " <> unwords (map (("-optF " <>) . makeRelative pathBase . _cabalPackageInfo_packageFile) packageInfos)
189− languageFromPkgs = L.nub $ mapMaybe _cabalPackageInfo_defaultLanguage packageInfos
324+ , ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)
190− -- NOTE when no default-language is present cabal sets Haskell98
325+ , if null modulesToLoad then "" else ":load " <> unwords modulesToLoad
191− language = NE.toList $ fromMaybe (Haskell98 NE.:| []) $ NE.nonEmpty languageFromPkgs
192− extensionsLine = if extensions == mempty
194− else ":set " <> unwords (("-X" <>) . prettyShow <$> extensions)
195− ghcOptions = concat $ mapMaybe (\case (GHC, xs) -> Just xs; _ -> Nothing) $
196− packageInfos >>= _cabalPackageInfo_compilerOptions
198− [ ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)
199− , case ghcOptions of
201− xs -> ":set " <> unwords xs
203− , ":set " <> unwords (("-X" <>) . prettyShow <$> language)
204− , ":load Backend Frontend"
205− , "import Obelisk.Run"
326+ , "import qualified Obelisk.Run"
206− , "import qualified Frontend"
327+ , "import qualified Frontend"
207− , "import qualified Backend"
328+ , "import qualified Backend" ]
209− warnDifferentLanguages language
210 withSystemTempDirectory "ob-ghci" $ \fp -> do
329 withSystemTempDirectory "ob-ghci" $ \fp -> do
211 let dotGhciPath = fp </> ".ghci"
330 let dotGhciPath = fp </> ".ghci"
212 liftIO $ writeFile dotGhciPath dotGhci
331 liftIO $ writeFile dotGhciPath dotGhci
@@ -214,35 +333,44 @@ withGhciScript dirs f = do
216 rootedSourceDirs pkg = NE.toList $
335 rootedSourceDirs pkg = NE.toList $
217− (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg
336+ makeRelative pathBase . (_cabalPackageInfo_packageRoot pkg </>) <$> _cabalPackageInfo_sourceDirs pkg
219−warnDifferentLanguages :: MonadObelisk m => [Language] -> m ()
220−warnDifferentLanguages (_:_:_) = putLog Warning "Different languages detected across packages which may result in errors when loading the repl"
221−warnDifferentLanguages _ = return ()
223-- | Run ghci repl
338-- | Run ghci repl
224runGhciRepl
339runGhciRepl
225 :: MonadObelisk m
340 :: MonadObelisk m
226− => FilePath -- ^ Path to .ghci
341+ => FilePath -- ^ Path to project root
342+ -> [CabalPackageInfo]
343+ -> FilePath -- ^ Path to .ghci
228−runGhciRepl dotGhci = inProjectShell "ghc" $ "ghci " <> makeBaseGhciOptions dotGhci
345+runGhciRepl root packages dotGhci =
346+ -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the
347+ -- ghc that is provided by the shell in the user's project.
348+ nixShellWithPkgs root True False (packageInfoToNamePathMap packages) $ Just $ "ghci " <> makeBaseGhciOptions dotGhci -- TODO: Shell escape
230-- | Run ghcid
350-- | Run ghcid
232 :: MonadObelisk m
352 :: MonadObelisk m
233− => FilePath -- ^ Path to .ghci
353+ => FilePath -- ^ Path to project root
354+ -> Bool -- ^ Should we chdir to root when running this process?
355+ -> FilePath -- ^ Path to .ghci
356+ -> [CabalPackageInfo]
234 -> Maybe String -- ^ Optional command to run at every reload
357 -> Maybe String -- ^ Optional command to run at every reload
236−runGhcid dotGhci mcmd = callCommand $ unwords $ $(staticWhich "ghcid") : opts
359+runGhcid root chdirToRoot dotGhci packages mcmd =
360+ nixShellWithPkgs root True chdirToRoot (packageInfoToNamePathMap packages) (Just $ unwords $ ghcidExePath : opts) -- TODO: Shell escape
240− --TODO: The decision of whether to use -fwarn-redundant-constraints should probably be made by the user
241− , "--command='ghci -Wall -ignore-dot-ghci -fwarn-redundant-constraints " <> makeBaseGhciOptions dotGhci <> "' "
364+ , "--command='ghci -ignore-dot-ghci " <> makeBaseGhciOptions dotGhci <> "' "
243 , "--outputfile=ghcid-output.txt"
365 , "--outputfile=ghcid-output.txt"
366+ ] <> map (\x -> "--reload='" <> x <> "'") reloadFiles
367+ <> map (\x -> "--restart='" <> x <> "'") restartFiles
244− ] <> testCmd
368+ <> testCmd
245− testCmd = maybeToList (flip fmap mcmd $ \cmd -> "--test='" <> cmd <> "'")
369+ testCmd = maybeToList (flip fmap mcmd $ \cmd -> "--test='" <> cmd <> "'") -- TODO: Shell escape
371+ adjustRoot x = if chdirToRoot then makeRelative root x else x
372+ reloadFiles = map adjustRoot [root </> "config"]
373+ restartFiles = map (adjustRoot . _cabalPackageInfo_packageFile) packages
247makeBaseGhciOptions :: FilePath -> String
375makeBaseGhciOptions :: FilePath -> String
248makeBaseGhciOptions dotGhci =
376makeBaseGhciOptions dotGhci =