Merge pull request #176 from fwcd/haskell-commands

Re-add Haskell commands

Author: fwcd

Dockerfile

@@ -29,7 +29,14 @@ RUN curl -sL https://deb.nodesource.com/setup_18.x | bash -
 
 # Install native dependencies
 COPY Scripts/install-runtime-dependencies-apt Scripts/
-RUN Scripts/install-runtime-dependencies-apt && rm -rf /var/lib/apt/lists/*
+RUN Scripts/install-runtime-dependencies-apt && apt-get install -y cabal-install && rm -rf /var/lib/apt/lists/*
+
+# Install Haskell dependencies
+COPY Scripts/install-haskell-dependencies Scripts/
+RUN cabal update && Scripts/install-haskell-dependencies cabal
+
+# Add Cabal to PATH
+ENV PATH /.cabal/bin:/root/.cabal/bin:$PATH
 
 # Install Node dependencies
 COPY Scripts/install-node-dependencies Scripts/

README.md

@@ -23,6 +23,7 @@ To build and run D2 locally, make sure to have the following installed:
 
 - Linux or macOS
 - Swift 6+
+- Haskell + cabal-install or Stack (for Hoogle, Pointfree, ...)
 - Node.js and npm (for LaTeX rendering)
 
 On Ubuntu, run
@@ -41,7 +42,17 @@ Scripts/install-dependencies-brew
 
 Create a folder named `local` under the repository and add configuration files as described in [the configuration section](#configuration).
 
-To install the dependencies for node packages used by D2, run
+To install the Haskell packages used by D2, please install Haskell Stack or cabal-install externally (e.g. via `ghcup`), then run
+
+```sh
+Scripts/install-haskell-dependencies stack
+```
+
+> If this fails due to version conflicts, check whether your global Stack resolver is too old in `~/.stack/global-project/stack.yaml` and/or append the `--allow-newer` flag to the command, which will be forwarded to Stack by the script.
+
+> This is the command for Haskell Stack, for cabal-install substitute `cabal` for `stack` above.
+
+To install the Node packages used by D2, run
 
 ```sh
 Scripts/install-node-dependencies

Scripts/install-haskell-dependencies

@@ -0,0 +1,15 @@
+#!/bin/bash
+
+# Installs all Haskell packages that are needed to run D2's Haskell-related commands
+
+set -e
+
+if [ $# -lt 1 ]; then
+  echo "Usage: $0 <stack or cabal> [additional flags...]"
+  exit 1
+fi
+
+tool="$1"
+shift
+
+"$tool" install "$@" happy show mueval pointfree

Sources/D2Commands/Programming/HaskellEvalCommand.swift

@@ -0,0 +1,28 @@
+import Logging
+import D2MessageIO
+import Utils
+
+fileprivate let log = Logger(label: "D2Commands.HaskellEvalCommand")
+
+public class HaskellEvalCommand: StringCommand {
+    public let info = CommandInfo(
+        category: .programming,
+        shortDescription: "Evaluates a Haskell expression",
+        longDescription: "Computes the result of a (pure) Haskell expression using Mueval",
+        presented: true,
+        requiredPermissionLevel: .basic
+    )
+    public let outputValueType: RichValueType = .code
+    private let timeout: Int = 4
+
+    public init() {}
+
+    public func invoke(with input: String, output: CommandOutput, context: CommandContext) async {
+        do {
+            let value = try await Shell().utf8(for: "mueval", args: ["-e", input, "-t", String(timeout)]).get() ?? "No output"
+            await output.append(.code(value, language: "haskell"))
+        } catch {
+            await output.append(error, errorText: "Could not evaluate expression.")
+        }
+    }
+}

Sources/D2Commands/Programming/HaskellTypeCommand.swift

@@ -0,0 +1,33 @@
+import Logging
+import D2MessageIO
+import Utils
+
+fileprivate let log = Logger(label: "D2Commands.HaskellTypeCommand")
+
+public class HaskellTypeCommand: StringCommand {
+    public let info = CommandInfo(
+        category: .programming,
+        shortDescription: "Fetches the type of a Haskell expression",
+        longDescription: "Computes the inferred type of a (pure) Haskell expression using Mueval",
+        presented: true,
+        requiredPermissionLevel: .basic
+    )
+    public let outputValueType: RichValueType = .code
+    private let timeout: Int = 4
+
+    public init() {}
+
+    public func invoke(with input: String, output: CommandOutput, context: CommandContext) async {
+        do {
+            let lines = try await Array((Shell().utf8(for: "mueval", args: ["-iTe", input, "-t", String(timeout)]).get() ?? "").split(separator: "\n"))
+            guard lines.count >= 2 else {
+                log.error("Invalid mueval output: \(lines)")
+                await output.append(errorText: "Invalid mueval output")
+                return
+            }
+            await output.append(.code("\(lines[0]) :: \(lines[1])", language: "haskell"))
+        } catch {
+            await output.append(error, errorText: "Could not fetch inferred expression type.")
+        }
+    }
+}

Sources/D2Commands/Programming/PointfreeCommand.swift

@@ -0,0 +1,27 @@
+import Logging
+import D2MessageIO
+import Utils
+
+fileprivate let log = Logger(label: "D2Commands.PointfreeCommand")
+
+public class PointfreeCommand: StringCommand {
+    public let info = CommandInfo(
+        category: .programming,
+        shortDescription: "Pointfree notation converter",
+        longDescription: "Converts a Haskell expression into pointfree notation",
+        presented: true,
+        requiredPermissionLevel: .basic
+    )
+    public let outputValueType: RichValueType = .code
+
+    public init() {}
+
+    public func invoke(with input: String, output: CommandOutput, context: CommandContext) async {
+        do {
+            let pointfree = try await Shell().utf8(for: "pointfree", args: [input]).get()
+            await output.append(.code(pointfree ?? "No results", language: "haskell"))
+        } catch {
+            await output.append(error, errorText: "An error occurred while converting to pointfree notation")
+        }
+    }
+}

Sources/D2Handlers/D2Receiver.swift

@@ -303,6 +303,9 @@ public class D2Receiver: Receiver {
         registry["buzzwordphrase", aka: ["buzzword", "buzzwords", "buzzphrase", "buzz"]] = BuzzwordPhraseCommand()
         registry["buzzwordbingo", aka: ["buzzbingo"]] = BuzzwordBingoCommand()
         registry["hoogle"] = HoogleCommand()
+        registry["haskelleval", aka: ["haskell"]] = HaskellEvalCommand()
+        registry["haskelltype"] = HaskellTypeCommand()
+        registry["pointfree"] = PointfreeCommand()
         registry["prolog"] = PrologCommand()
         registry["reindent", aka: ["indent", "redent"]] = ReindentCommand()
         registry["morseencode", aka: ["morse", "morsify"]] = MorseEncoderCommand()