Add options page for stack executable

10 files changed, 255 insertions, 8 deletions

diff --git a/plugins/haskell/ghcmod.cpp b/plugins/haskell/ghcmod.cpp
index f51841b..4eabc1a 100644
--- a/plugins/haskell/ghcmod.cpp
+++ b/plugins/haskell/ghcmod.cpp
@@ -40,7 +40,6 @@ Q_LOGGING_CATEGORY(ghcModLog, "qtc.haskell.ghcmod")
 Q_LOGGING_CATEGORY(asyncGhcModLog, "qtc.haskell.ghcmod.async")
 
 // TODO do not hardcode
-const char STACK_EXE[] = "/usr/local/bin/stack";
 const int kTimeoutMS = 10 * 1000;
 
 using namespace Utils;
@@ -48,6 +47,9 @@ using namespace Utils;
 namespace Haskell {
 namespace Internal {
 
+FileName GhcMod::m_stackExecutable = Utils::FileName::fromString("stack");
+QMutex GhcMod::m_mutex;
+
 GhcMod::GhcMod(const Utils::FileName &path)
     : m_path(path)
 {
@@ -82,15 +84,22 @@ Utils::optional<QString> GhcMod::typeInfo(const FileName &filePath, int line, in
 
 bool GhcMod::ensureStarted()
 {
+    m_mutex.lock();
+    const FileName plainStackExecutable = m_stackExecutable;
+    m_mutex.unlock();
+    Environment env = Environment::systemEnvironment();
+    const FileName stackExecutable = env.searchInPath(plainStackExecutable.toString());
+    if (m_process && FileName::fromString(m_process->program()) != stackExecutable)
+        shutdown();
     if (m_process)
         return true;
     log("starting");
-    Environment env = Environment::systemEnvironment();
-    env.prependOrSetPath(QFileInfo(STACK_EXE).absolutePath()); // for ghc-mod finding stack back
+    // for ghc-mod finding stack back:
+    env.prependOrSetPath(stackExecutable.toFileInfo().absolutePath());
     m_process.reset(new QProcess);
     m_process->setWorkingDirectory(m_path.toString());
     m_process->setEnvironment(env.toStringList());
-    m_process->start(STACK_EXE, {"exec", "ghc-mod", "--", "legacy-interactive"});
+    m_process->start(stackExecutable.toString(), {"exec", "ghc-mod", "--", "legacy-interactive"});
     if (!m_process->waitForStarted(kTimeoutMS)) {
         log("failed to start");
         return false;
@@ -208,6 +217,12 @@ Utils::optional<QString> GhcMod::parseTypeInfo(const Utils::optional<QByteArray>
     return Utils::nullopt;
 }
 
+void GhcMod::setStackExecutable(const FileName &filePath)
+{
+    QMutexLocker lock(&m_mutex);
+    m_stackExecutable = filePath;
+}
+
 AsyncGhcMod::AsyncGhcMod(const FileName &path)
     : m_ghcmod(path)
 {
diff --git a/plugins/haskell/ghcmod.h b/plugins/haskell/ghcmod.h
index 770a0b7..450b112 100644
--- a/plugins/haskell/ghcmod.h
+++ b/plugins/haskell/ghcmod.h
@@ -78,11 +78,17 @@ public:
 
     static Utils::optional<SymbolInfo> parseFindSymbol(const Utils::optional<QByteArray> &response);
     static Utils::optional<QString> parseTypeInfo(const Utils::optional<QByteArray> &response);
+
+   static void setStackExecutable(const Utils::FileName &filePath);
+
 private:
     bool ensureStarted();
     void shutdown();
     void log(const QString &message);
 
+    static Utils::FileName m_stackExecutable;
+    static QMutex m_mutex;
+
     Utils::FileName m_path;
     unique_ghcmod_process m_process; // kills process on reset
 };
diff --git a/plugins/haskell/haskell.pro b/plugins/haskell/haskell.pro
index 0fd3737..45dd9d3 100644
--- a/plugins/haskell/haskell.pro
+++ b/plugins/haskell/haskell.pro
@@ -11,7 +11,8 @@ SOURCES += \
     haskelltokenizer.cpp \
     ghcmod.cpp \
     haskellmanager.cpp \
-    haskelldocument.cpp
+    haskelldocument.cpp \
+    optionspage.cpp
 
 HEADERS += \
     haskell_global.h \
@@ -24,7 +25,8 @@ HEADERS += \
     haskelltokenizer.h \
     ghcmod.h \
     haskellmanager.h \
-    haskelldocument.h
+    haskelldocument.h \
+    optionspage.h
 
 ## uncomment to build plugin into user config directory
 ## <localappdata>/plugins/<ideversion>
@@ -53,3 +55,6 @@ QTC_PLUGIN_RECOMMENDS += \
 
 include(config.pri)
 include($$IDE_SOURCE_TREE/src/qtcreatorplugin.pri)
+
+RESOURCES += \
+    haskell.qrc
diff --git a/plugins/haskell/haskell.qrc b/plugins/haskell/haskell.qrc
new file mode 100644
index 0000000..654f458
--- /dev/null
+++ b/plugins/haskell/haskell.qrc
@@ -0,0 +1,5 @@
+<RCC>
+    <qresource prefix="/haskell">
+        <file>images/category_haskell.png</file>
+    </qresource>
+</RCC>
diff --git a/plugins/haskell/haskellmanager.cpp b/plugins/haskell/haskellmanager.cpp
index 275c921..0867edf 100644
--- a/plugins/haskell/haskellmanager.cpp
+++ b/plugins/haskell/haskellmanager.cpp
@@ -27,11 +27,16 @@
 
 #include "ghcmod.h"
 
+#include <utils/hostosinfo.h>
+
 #include <QDir>
 #include <QFileInfo>
+#include <QSettings>
 
 #include <unordered_map>
 
+static const char kStackExecutableKey[] = "Haskell/StackExecutable";
+
 using namespace Utils;
 
 namespace Haskell {
@@ -41,9 +46,16 @@ class HaskellManagerPrivate
 {
 public:
     std::unordered_map<FileName, std::weak_ptr<AsyncGhcMod>> ghcModCache;
+    FileName stackExecutable;
 };
 
-Q_GLOBAL_STATIC(HaskellManagerPrivate, m_d);
+Q_GLOBAL_STATIC(HaskellManagerPrivate, m_d)
+Q_GLOBAL_STATIC(HaskellManager, m_instance)
+
+HaskellManager *HaskellManager::instance()
+{
+    return m_instance;
+}
 
 FileName HaskellManager::findProjectDirectory(const FileName &filePath)
 {
@@ -76,5 +88,43 @@ std::shared_ptr<AsyncGhcMod> HaskellManager::ghcModForFile(const FileName &fileP
     return ghcmod;
 }
 
+FileName defaultStackExecutable()
+{
+    // stack from brew or the installer script from https://docs.haskellstack.org
+    // install to /usr/local/bin.
+    if (HostOsInfo::isAnyUnixHost())
+        return FileName::fromString("/usr/local/bin/stack");
+    return FileName::fromString("stack");
+}
+
+FileName HaskellManager::stackExecutable()
+{
+    return m_d->stackExecutable;
+}
+
+void HaskellManager::setStackExecutable(const FileName &filePath)
+{
+    if (filePath == m_d->stackExecutable)
+        return;
+    m_d->stackExecutable = filePath;
+    emit m_instance->stackExecutableChanged(m_d->stackExecutable);
+}
+
+void HaskellManager::readSettings(QSettings *settings)
+{
+    m_d->stackExecutable = FileName::fromString(
+                settings->value(kStackExecutableKey,
+                                defaultStackExecutable().toString()).toString());
+    emit m_instance->stackExecutableChanged(m_d->stackExecutable);
+}
+
+void HaskellManager::writeSettings(QSettings *settings)
+{
+    if (m_d->stackExecutable == defaultStackExecutable())
+        settings->remove(kStackExecutableKey);
+    else
+        settings->setValue(kStackExecutableKey, m_d->stackExecutable.toString());
+}
+
 } // namespace Internal
 } // namespace Haskell
diff --git a/plugins/haskell/haskellmanager.h b/plugins/haskell/haskellmanager.h
index 5fbad6c..87c08e8 100644
--- a/plugins/haskell/haskellmanager.h
+++ b/plugins/haskell/haskellmanager.h
@@ -25,18 +25,35 @@
 
 #pragma once
 
+#include <QObject>
+
 #include <utils/fileutils.h>
 
+QT_BEGIN_NAMESPACE
+class QSettings;
+QT_END_NAMESPACE
+
 namespace Haskell {
 namespace Internal {
 
 class AsyncGhcMod;
 
-class HaskellManager
+class HaskellManager : public QObject
 {
+    Q_OBJECT
+
 public:
+    static HaskellManager *instance();
+
     static Utils::FileName findProjectDirectory(const Utils::FileName &filePath);
     static std::shared_ptr<AsyncGhcMod> ghcModForFile(const Utils::FileName &filePath);
+    static Utils::FileName stackExecutable();
+    static void setStackExecutable(const Utils::FileName &filePath);
+    static void readSettings(QSettings *settings);
+    static void writeSettings(QSettings *settings);
+
+signals:
+    void stackExecutableChanged(const Utils::FileName &filePath);
 };
 
 } // namespace Internal
diff --git a/plugins/haskell/haskellplugin.cpp b/plugins/haskell/haskellplugin.cpp
index fd6827f..362e00f 100644
--- a/plugins/haskell/haskellplugin.cpp
+++ b/plugins/haskell/haskellplugin.cpp
@@ -24,9 +24,14 @@
 ****************************************************************************/
 
 #include "haskellplugin.h"
+
+#include "ghcmod.h"
 #include "haskellconstants.h"
 #include "haskelleditorfactory.h"
+#include "haskellmanager.h"
+#include "optionspage.h"
 
+#include <coreplugin/icore.h>
 #include <texteditor/snippets/snippetprovider.h>
 
 namespace Haskell {
@@ -56,10 +61,18 @@ bool HaskellPlugin::initialize(const QStringList &arguments, QString *errorStrin
     Q_UNUSED(errorString)
 
     addAutoReleasedObject(new HaskellEditorFactory);
+    addAutoReleasedObject(new OptionsPage);
 
     TextEditor::SnippetProvider::registerGroup(Constants::C_HASKELLSNIPPETSGROUP_ID,
                                                tr("Haskell", "SnippetProvider"));
 
+    connect(Core::ICore::instance(), &Core::ICore::saveSettingsRequested, this, [] {
+        HaskellManager::writeSettings(Core::ICore::settings());
+    });
+    connect(HaskellManager::instance(), &HaskellManager::stackExecutableChanged,
+            &GhcMod::setStackExecutable);
+
+    HaskellManager::readSettings(Core::ICore::settings());
     return true;
 }
 
diff --git a/plugins/haskell/images/category_haskell.png b/plugins/haskell/images/category_haskell.png
new file mode 100644
index 0000000..947f948
--- /dev/null
+++ b/plugins/haskell/images/category_haskell.png
diff --git a/plugins/haskell/optionspage.cpp b/plugins/haskell/optionspage.cpp
new file mode 100644
index 0000000..88a5792
--- /dev/null
+++ b/plugins/haskell/optionspage.cpp
@@ -0,0 +1,83 @@
+/****************************************************************************
+**
+** Copyright (C) 2017 The Qt Company Ltd.
+** Contact: https://www.qt.io/licensing/
+**
+** This file is part of Qt Creator.
+**
+** Commercial License Usage
+** Licensees holding valid commercial Qt licenses may use this file in
+** accordance with the commercial license agreement provided with the
+** Software or, alternatively, in accordance with the terms contained in
+** a written agreement between you and The Qt Company. For licensing terms
+** and conditions see https://www.qt.io/terms-conditions. For further
+** information use the contact form at https://www.qt.io/contact-us.
+**
+** GNU General Public License Usage
+** Alternatively, this file may be used under the terms of the GNU
+** General Public License version 3 as published by the Free Software
+** Foundation with exceptions as appearing in the file LICENSE.GPL3-EXCEPT
+** included in the packaging of this file. Please review the following
+** information to ensure the GNU General Public License requirements will
+** be met: https://www.gnu.org/licenses/gpl-3.0.html.
+**
+****************************************************************************/
+
+#include "optionspage.h"
+
+#include "haskellmanager.h"
+
+#include <QGroupBox>
+#include <QHBoxLayout>
+#include <QLabel>
+#include <QVBoxLayout>
+#include <QWidget>
+
+namespace Haskell {
+namespace Internal {
+
+OptionsPage::OptionsPage()
+{
+    setId("A.General");
+    setDisplayName(tr("General"));
+    setCategory("J.Z.Haskell");
+    setDisplayCategory(tr("Haskell"));
+    setCategoryIcon(Utils::Icon(":/haskell/images/category_haskell.png"));
+}
+
+QWidget *OptionsPage::widget()
+{
+    using namespace Utils;
+    if (!m_widget) {
+        m_widget = new QWidget;
+        auto topLayout = new QVBoxLayout;
+        m_widget->setLayout(topLayout);
+        auto generalBox = new QGroupBox(tr("General"));
+        topLayout->addWidget(generalBox);
+        topLayout->addStretch(10);
+        auto boxLayout = new QHBoxLayout;
+        generalBox->setLayout(boxLayout);
+        boxLayout->addWidget(new QLabel(tr("Stack executable:")));
+        m_stackPath = new PathChooser();
+        m_stackPath->setExpectedKind(PathChooser::ExistingCommand);
+        m_stackPath->setPromptDialogTitle(tr("Choose Stack Executable"));
+        m_stackPath->setFileName(HaskellManager::stackExecutable());
+        m_stackPath->setCommandVersionArguments({"--version"});
+        boxLayout->addWidget(m_stackPath);
+    }
+    return m_widget;
+}
+
+void OptionsPage::apply()
+{
+    if (!m_widget)
+        return;
+    HaskellManager::setStackExecutable(m_stackPath->rawFileName());
+}
+
+void OptionsPage::finish()
+{
+}
+
+} // namespace Internal
+} // namespace Haskell
diff --git a/plugins/haskell/optionspage.h b/plugins/haskell/optionspage.h
new file mode 100644
index 0000000..c1663c7
--- /dev/null
+++ b/plugins/haskell/optionspage.h
@@ -0,0 +1,53 @@
+/****************************************************************************
+**
+** Copyright (C) 2017 The Qt Company Ltd.
+** Contact: https://www.qt.io/licensing/
+**
+** This file is part of Qt Creator.
+**
+** Commercial License Usage
+** Licensees holding valid commercial Qt licenses may use this file in
+** accordance with the commercial license agreement provided with the
+** Software or, alternatively, in accordance with the terms contained in
+** a written agreement between you and The Qt Company. For licensing terms
+** and conditions see https://www.qt.io/terms-conditions. For further
+** information use the contact form at https://www.qt.io/contact-us.
+**
+** GNU General Public License Usage
+** Alternatively, this file may be used under the terms of the GNU
+** General Public License version 3 as published by the Free Software
+** Foundation with exceptions as appearing in the file LICENSE.GPL3-EXCEPT
+** included in the packaging of this file. Please review the following
+** information to ensure the GNU General Public License requirements will
+** be met: https://www.gnu.org/licenses/gpl-3.0.html.
+**
+****************************************************************************/
+
+#pragma once
+
+#include <coreplugin/dialogs/ioptionspage.h>
+#include <utils/pathchooser.h>
+
+#include <QPointer>
+
+namespace Haskell {
+namespace Internal {
+
+class OptionsPage : public Core::IOptionsPage
+{
+    Q_OBJECT
+
+public:
+    OptionsPage();
+
+    QWidget *widget() override;
+    void apply() override;
+    void finish() override;
+
+private:
+    QPointer<QWidget> m_widget;
+    QPointer<Utils::PathChooser> m_stackPath;
+};
+
+} // namespace Internal
+} // namespace Haskell