@@ -7,16 +7,17 @@
77module Obelisk.Command.Run where
88
99import Control.Exception (Exception, bracket)
10−import Control.Monad (filterM, unless, when)
10+import Control.Monad (filterM, unless)
1111import Control.Monad.Except (runExceptT, throwError)
1212import Control.Monad.IO.Class (liftIO)
1313import Control.Monad.Reader (MonadIO)
1414import Data.Coerce (coerce)
1515import Data.Either
16−import Data.Foldable (for_)
16+import Data.Foldable (for_, toList)
1717import Data.List.Extra (dropPrefix)
1818import qualified Data.List.NonEmpty as NE
1919import Data.Maybe
20+import qualified Data.Set as Set
2021import qualified Data.Text as T
2122import Data.Traversable (for)
2223import Debug.Trace (trace)
@@ -43,7 +44,7 @@ import System.IO.Temp (withSystemTempDirectory)
4344
4445import Obelisk.App (MonadObelisk)
4546import Obelisk.CliApp (Severity (..) , failWith, putLog, proc, readCreateProcessWithExitCode, readProcessAndLogStderr)
46−import Obelisk.Command.Project (inProjectShell, obeliskDirName, toObeliskDir, withProjectRoot)
47+import Obelisk.Command.Project (obeliskDirName, toObeliskDir, withProjectRoot, nixShellWithPkgs, toNixPath)
4748import Obelisk.Command.Utils (findExePath, ghcidExePath, nixBuildExePath, nixExePath)
4849
4950data CabalPackageInfo = CabalPackageInfo
@@ -66,7 +67,7 @@ preprocessorIdentifier = "__preprocessor-apply-packages"
6667
6768run :: MonadObelisk m => m ()
6869run = withProjectRoot "." $ \root -> do
69− pkgs <- getLocalPkgs root
70+ pkgs <- fmap toList . parsePackagesOrFail =<< getLocalPkgs root
7071 withGhciScript pkgs $ \dotGhciPath -> do
7172 freePort <- getFreePort
7273 assets <- do
@@ -91,7 +92,7 @@ run = withProjectRoot "." $ \root -> do
9192 else readProcessAndLogStderr Debug $
9293 proc nixExePath ["eval", "-f", root, "passthru.staticFilesImpure", "--raw"]
9394 putLog Debug $ "Assets impurely loaded from: " <> assets
94− runGhcid dotGhciPath $ Just $ unwords
95+ runGhcid dotGhciPath pkgs $ Just $ unwords
9596 [ "Obelisk.Run.run"
9697 , show freePort
9798 , "(Obelisk.Run.runServeAsset " ++ show assets ++ ")"
@@ -99,30 +100,23 @@ run = withProjectRoot "." $ \root -> do
99100 , "Frontend.frontend"
100101 ]
101102
102−-- | Nix syntax requires relative paths to be prefixed by @./@ or
103−-- @../@. This will make a 'FilePath' that can be embedded in a Nix
104−-- expression.
105−toNixPath :: FilePath -> FilePath
106−toNixPath root | "/" `isInfixOf` root = root
107− | otherwise = "./" <> root
108−
109103runRepl :: MonadObelisk m => m ()
110104runRepl = do
111− pkgs <- withProjectRoot "." getLocalPkgs
105+ pkgs <- fmap toList . parsePackagesOrFail =<< withProjectRoot "." getLocalPkgs
112106 withGhciScript pkgs $ \dotGhciPath -> do
113− runGhciRepl dotGhciPath
107+ runGhciRepl pkgs dotGhciPath
114108
115109runWatch :: MonadObelisk m => m ()
116110runWatch = do
117− pkgs <- withProjectRoot "." getLocalPkgs
118− withGhciScript pkgs $ \dotGhciPath -> runGhcid dotGhciPath Nothing
111+ pkgs <- fmap toList . parsePackagesOrFail =<< withProjectRoot "." getLocalPkgs
112+ withGhciScript pkgs $ \dotGhciPath -> runGhcid dotGhciPath pkgs Nothing
119113
120114-- | Relative paths to local packages of an obelisk project.
121115--
122116-- These are a combination of the obelisk predefined local packages,
123117-- and any packages that the user has set with the @packages@ argument
124118-- to the Nix @project@ function.
125−getLocalPkgs :: (MonadObelisk m, MonadIO m) => FilePath -> m [FilePath]
119+getLocalPkgs :: MonadObelisk m => FilePath -> m [FilePath]
126120getLocalPkgs root = do
127121 (_exitCode, out, err) <- readCreateProcessWithExitCode $
128122 proc findExePath ["-L", root, "(", "-name", "*.cabal", "-o", "-name", Hpack.packageConfig, ")", "-a", "-type", "f"]
@@ -233,33 +227,42 @@ parseCabalPackage' pkg = runExceptT $ do
233227 Left (_, errors) ->
234228 throwError $ T.pack $ "Failed to parse " <> packageFile <> ":\n" <> unlines (map show errors)
235229
236−-- | Create ghci configuration to load the given packages
237−withGhciScript
238− :: MonadObelisk m
239− => [FilePath] -- ^ List of packages to load into ghci
240− -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci
241− -> m ()
242−withGhciScript dirs f = do
243− (pkgDirErrs, packageInfos) <- fmap partitionEithers $ for dirs $ \dir -> do
230+parsePackagesOrFail :: MonadObelisk m => [FilePath] -> m (NE.NonEmpty CabalPackageInfo)
231+parsePackagesOrFail dirs = do
232+ (pkgDirErrs, packageInfos') <- fmap partitionEithers $ for dirs $ \dir -> do
244233 flip fmap (parseCabalPackage dir) $ \case
245234 Nothing -> Left dir
246235 Just packageInfo -> Right packageInfo
247236
248− when (null packageInfos) $
249− failWith $ T.pack $ "No valid packages found in " <> intercalate ", " dirs
237+ packageInfos <- case NE.nonEmpty packageInfos' of
238+ Nothing -> failWith $ T.pack $ "No valid packages found in " <> intercalate ", " dirs
239+ Just xs -> pure xs
240+
250241 unless (null pkgDirErrs) $
251242 putLog Warning $ T.pack $ "Failed to find packages in " <> intercalate ", " pkgDirErrs
252243
244+ pure packageInfos
245+
246+-- | Create ghci configuration to load the given packages
247+withGhciScript
248+ :: MonadObelisk m
249+ => [CabalPackageInfo] -- ^ List of packages to load into ghci
250+ -> (FilePath -> m ()) -- ^ Action to run with the path to generated temporary .ghci
251+ -> m ()
252+withGhciScript packageInfos f = do
253253 selfExe <- liftIO getExecutablePath
254254 let
255− packageNames = map _cabalPackageInfo_packageName packageInfos
255+ packageNames = Set.fromList $ map _cabalPackageInfo_packageName packageInfos
256+ modulesToLoad = mconcat
257+ [ [ "Obelisk.Run" | "obelisk-run" `Set.member` packageNames ]
258+ , [ "Backend" | "backend" `Set.member` packageNames ]
259+ , [ "Frontend" | "frontend" `Set.member` packageNames ]
260+ ]
256261 dotGhci = unlines
257262 -- TODO: Shell escape
258263 [ ":set -pgmF " <> selfExe <> " -optF " <> preprocessorIdentifier <> " " <> unwords (map (("-optF " <>) . _cabalPackageInfo_packageRoot) packageInfos)
259264 , ":set -i" <> intercalate ":" (packageInfos >>= rootedSourceDirs)
260− , ":load Backend Frontend"
261− -- We need to also load 'Obelisk.Run' if it's part of our ghci session.
262− <> if "obelisk-run" `elem` packageNames then " Obelisk.Run" else ""
265+ , if null modulesToLoad then "" else ":load " <> unwords modulesToLoad
263266 , "import qualified Obelisk.Run"
264267 , "import qualified Frontend"
265268 , "import qualified Backend"
@@ -276,21 +279,27 @@ withGhciScript dirs f = do
276279-- | Run ghci repl
277280runGhciRepl
278281 :: MonadObelisk m
279− => FilePath -- ^ Path to .ghci
282+ => [CabalPackageInfo]
283+ -> FilePath -- ^ Path to .ghci
280284 -> m ()
281−runGhciRepl dotGhci =
285+runGhciRepl packages dotGhci = withProjectRoot "." $ \root ->
282286 -- NOTE: We do *not* want to use $(staticWhich "ghci") here because we need the
283287 -- ghc that is provided by the shell in the user's project.
284− inProjectShell "ghc" $ "ghci " <> makeBaseGhciOptions dotGhci
288+ nixShellWithPkgs root True packageNames $ Just $ "ghci " <> makeBaseGhciOptions dotGhci -- TODO: Shell escape
289+ where
290+ packageNames = map (T.unpack . _cabalPackageInfo_packageName) packages
285291
286292-- | Run ghcid
287293runGhcid
288294 :: MonadObelisk m
289295 => FilePath -- ^ Path to .ghci
296+ -> [CabalPackageInfo]
290297 -> Maybe String -- ^ Optional command to run at every reload
291298 -> m ()
292−runGhcid dotGhci mcmd = inProjectShell "ghc" $ unwords $ ghcidExePath : opts -- TODO: Shell escape
299+runGhcid dotGhci packages mcmd = withProjectRoot "." $ \root ->
300+ nixShellWithPkgs root True packageNames (Just $ unwords $ ghcidExePath : opts) -- TODO: Shell escape
293301 where
302+ packageNames = map (T.unpack . _cabalPackageInfo_packageName) packages
294303 opts =
295304 [ "-W"
296305 --TODO: The decision of whether to use -fwarn-redundant-constraints should probably be made by the user