Browse files

Make `scion-load` smarter. It should now mostly DWIM.

`scion-load` now automatically configures a Cabal project when needed.
  • Loading branch information...
1 parent bae148c commit 414639d4f54c317783fb4f2d868826497f556304 @nominolo nominolo committed Mar 11, 2009
Showing with 85 additions and 2 deletions.
  1. +45 −2 emacs/scion.el
  2. +19 −0 src/Scion/Server/Commands.hs
  3. +21 −0 src/Scion/Session.hs
View
47 emacs/scion.el
@@ -2230,10 +2230,53 @@ If the file is within a Cabal project, prompts the user which
component to load, or whether only the current file should be
loaded."
(interactive (list (scion-select-component)))
+ (cond
+ ((null comp)
+ (error "Invalid component"))
+
+ ((scion-cabal-component-p comp)
+ (let* ((curr-cabal-file (scion-eval '(current-cabal-file)))
+ ;; (current-component (scion-eval '(current-component))
+ (root-dir (scion-cabal-root-dir))
+ (new-cabal-file (ignore-errors (scion-cabal-file root-dir))))
+ ;; if we have a component
+ (assert (not (null new-cabal-file)))
+ (if (equal curr-cabal-file new-cabal-file)
+ ;; Same Cabal project, just load the component
+ (scion-load-component% comp)
+
+ ;; Different Cabal project, we must configure it first.
+ (let ((rel-dist-dir (read-from-minibuffer "Dist directory: " ".dist-scion"))
+ (extra-args (read-from-minibuffer "Configure Flags: " "")))
+ (lexical-let ((root-dir root-dir)
+ (comp comp))
+ (scion-eval-async `(open-cabal-project ,(expand-file-name root-dir)
+ ,rel-dist-dir
+ ,extra-args)
+ (scion-handling-failure (x)
+ (setq scion-project-root-dir root-dir)
+ (message (format "Cabal project loaded: %s" x))
+ (scion-load-component% comp))))))))
+
+ ((eq (car comp) :file)
+ (scion-load-component% comp))))
+
+(defun scion-load-component% (comp)
(message "Loading %s..." (scion-format-component comp))
(scion-eval-async `(load ,comp)
- (scion-handling-failure (result)
- (scion-report-compilation-result result))))
+ (scion-handling-failure (result)
+ (scion-report-compilation-result result))))
+
+(defun scion-cabal-component-p (comp)
+ (cond
+ ((eq comp :library)
+ t)
+ ((and (consp comp)
+ (eq (car comp)
+ :executable))
+ t)
+ (t
+ nil)))
(defun scion-select-component ()
(let* ((cabal-dir (scion-cabal-root-dir))
View
19 src/Scion/Server/Commands.hs
@@ -57,12 +57,15 @@ instance Applicative ReadP where
------------------------------------------------------------------------------
+-- | All Commands supported by this Server.
allCommands :: [Command]
allCommands =
[ cmdConnectionInfo
, cmdOpenCabalProject
, cmdConfigureCabalProject
, cmdLoadComponent
+ , cmdCurrentComponent
+ , cmdCurrentCabalFile
, cmdListCabalComponents
, cmdListSupportedLanguages
, cmdListSupportedPragmas
@@ -341,3 +344,19 @@ cmdGetVerbosity =
Command $ do
string "get-verbosity"
return $ toString <$> verbosityToInt <$> getVerbosity
+
+cmdCurrentComponent :: Command
+cmdCurrentComponent =
+ Command $ do
+ string "current-component"
+ return $ toString <$> getActiveComponent
+
+cmdCurrentCabalFile :: Command
+cmdCurrentCabalFile =
+ Command $ do
+ string "current-cabal-file"
+ return $ toString <$> (do
+ r <- gtry currentCabalFile
+ case r of
+ Right f -> return (Just f)
+ Left (_::SomeScionException) -> return Nothing)
View
21 src/Scion/Session.hs
@@ -168,6 +168,23 @@ currentCabalPackage = do
lbi <- getLocalBuildInfo
return (localPkgDescr lbi)
+-- | Return path to the .cabal file of the current Cabal package.
+--
+-- This is useful to identify the project when communicating with Scion from
+-- foreign code, because this does not require serialising the local build
+-- info.
+--
+-- Throws:
+--
+-- * 'NoCurrentCabalProject' if there is no current Cabal project or the
+-- current project has no .cabal file.
+--
+currentCabalFile :: ScionM FilePath
+currentCabalFile = do
+ lbi <- getLocalBuildInfo
+ case pkgDescrFile lbi of
+ Just f -> return f
+ Nothing -> liftIO $ throwIO $ NoCurrentCabalProject
cabalProjectComponents :: FilePath -- ^ The .cabal file
-> ScionM [Component]
@@ -363,6 +380,10 @@ setActiveComponent comp = do
needs_unloading (Just c) | c /= comp = True
needs_unloading _ = False
+-- | Return the currently active component.
+getActiveComponent :: ScionM (Maybe Component)
+getActiveComponent = gets activeComponent
+
-- * Compilation
-- | Wrapper for 'GHC.load'.

0 comments on commit 414639d

Please sign in to comment.