on master help sign in
command: Support custom Prelude
commit0cc7b39fa12268d80c2821abe94f49592e078825 authorElliot Cameron <eacameron@gmail.com> dateThu 14 May 2020, 16:12 (6 years ago) parentd97c3ad
1 file changed+31−17
lib/command/src/Obelisk/Command/Run.hs+31−17
lib/command/src/Obelisk/Command/Run.hs+31−17
@@ -31,7 +31,7 @@ import qualified Data.List.NonEmpty as NE
3131import Data.Map (Map)
3232import qualified Data.Map as Map
3333import qualified Data.Map.Monoidal as MMap
34−import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
34+import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
3535import Data.Ord (comparing)
3636import Data.Set (Set)
3737import qualified Data.Set as Set
@@ -163,12 +163,12 @@ profile profileBasePattern rtsFlags = withProjectRoot "." $ \root -> do
163163run :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()
164164run root interpretPaths = do
165165 pkgs <- getParsedLocalPkgs root interpretPaths
166− withGhciScript pkgs $ \dotGhciPath -> do
167− assets <- findProjectAssets root
168− putLog Debug $ "Assets impurely loaded from: " <> assets
169− ghciArgs <- getGhciSessionSettings pkgs root True
170− freePort <- getFreePort
171− runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs $ Just $ unwords
166+ assets <- findProjectAssets root
167+ putLog Debug $ "Assets impurely loaded from: " <> assets
168+ ghciArgs <- getGhciSessionSettings pkgs root True
169+ freePort <- getFreePort
170+ withGhciScriptArgs pkgs $ \dotGhciArgs -> do
171+ runGhcid root True (ghciArgs <> dotGhciArgs) pkgs $ Just $ unwords
172172 [ "Obelisk.Run.run"
173173 , show freePort
174174 , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"
@@ -180,15 +180,15 @@ runRepl :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()
180180runRepl root interpretPaths = do
181181 pkgs <- getParsedLocalPkgs root interpretPaths
182182 ghciArgs <- getGhciSessionSettings pkgs "." True
183− withGhciScript pkgs $ \dotGhciPath ->
184− runGhciRepl root pkgs (ghciArgs <> mkGhciScriptArg dotGhciPath)
183+ withGhciScriptArgs pkgs $ \dotGhciArgs ->
184+ runGhciRepl root pkgs (ghciArgs <> dotGhciArgs)
185185
186186runWatch :: MonadObelisk m => FilePath -> PathTree Interpret -> m ()
187187runWatch root interpretPaths = do
188188 pkgs <- getParsedLocalPkgs root interpretPaths
189189 ghciArgs <- getGhciSessionSettings pkgs root True
190− withGhciScript pkgs $ \dotGhciPath ->
191− runGhcid root True (ghciArgs <> mkGhciScriptArg dotGhciPath) pkgs Nothing
190+ withGhciScriptArgs pkgs $ \dotGhciArgs ->
191+ runGhcid root True (ghciArgs <> dotGhciArgs) pkgs Nothing
192192
193193exportGhciConfig :: MonadObelisk m => Bool -> FilePath -> PathTree Interpret -> m [String]
194194exportGhciConfig useRelativePaths root interpretPaths = do
@@ -395,13 +395,29 @@ parsePackagesOrFail dirs' = do
395395packageInfoToNamePathMap :: Foldable f => f CabalPackageInfo -> Map Text FilePath
396396packageInfoToNamePathMap = Map.fromList . map (_cabalPackageInfo_packageName &&& _cabalPackageInfo_packageRoot) . toList
397397
398+-- Like 'withGhciScript' but provides the precise ghci arguments to add to a ghci session
399+withGhciScriptArgs
400+ :: (MonadObelisk m, Foldable f)
401+ => f CabalPackageInfo -- ^ List of packages to load into ghci
402+ -> ([String] -> m ()) -- ^ Action to run with the extra ghci arguments
403+ -> m ()
404+withGhciScriptArgs packageInfos f = withGhciScript loadPreludeManually packageInfos $ \fp -> f ["-XNoImplicitPrelude", "-ghci-script", fp]
405+ where
406+ -- These lines must be first and allow the session to support a custom Prelude when @-XNoImplicitPrelude@
407+ -- is passed to the ghci session.
408+ loadPreludeManually =
409+ [ ":add Prelude" -- @:add@ is used because it's less noisy when there is no custom Prelude
410+ , ":set -XImplicitPrelude" -- Turn the default setting on
411+ ]
412+
398413-- | Create ghci configuration to load the given packages
399414withGhciScript
400415 :: (MonadObelisk m, Foldable f)
401− => f CabalPackageInfo -- ^ List of packages to load into ghci
416+ => [String] -- ^ Commands to prefix to file
417+ -> f CabalPackageInfo -- ^ List of packages to load into ghci
402418 -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci
403419 -> m ()
404−withGhciScript (toList -> packageInfos) f =
420+withGhciScript preCommands (toList -> packageInfos) f =
405421 withSystemTempDirectory "ob-ghci" $ \fp -> do
406422 let dotGhciPath = fp </> ".ghci"
407423 liftIO $ writeFile dotGhciPath dotGhci
@@ -413,7 +429,8 @@ withGhciScript (toList -> packageInfos) f =
413429 , [ "Backend" | "backend" `Set.member` packageNames ]
414430 , [ "Frontend" | "frontend" `Set.member` packageNames ]
415431 ]
416− dotGhci = unlines
432+ dotGhci = unlines $
433+ preCommands <>
417434 [ if null modulesToLoad then "" else ":load " <> unwords modulesToLoad
418435 , "import qualified Obelisk.Run"
419436 , "import qualified Frontend"
@@ -493,9 +510,6 @@ runGhcid root chdirToRoot ghciArgs (toList -> packages) mcmd =
493510 reloadFiles = map adjustRoot [root </> "config"]
494511 restartFiles = map (adjustRoot . _cabalPackageInfo_packageFile) packages
495512
496−mkGhciScriptArg :: FilePath -> [String]
497−mkGhciScriptArg dotGhci = ["-ghci-script", dotGhci]
498−
499513getFreePort :: MonadIO m => m Socket.PortNumber
500514getFreePort = liftIO $ Socket.withSocketsDo $ do
501515 addr:_ <- Socket.getAddrInfo (Just Socket.defaultHints) (Just "127.0.0.1") (Just "0")