packages feed

tricorder-mcp (empty) → 0.1.0.0

raw patch · 9 files changed

+579/−0 lines, 9 filesdep +atelier-coredep +atelier-preludedep +base

Dependencies added: atelier-core, atelier-prelude, base, bytestring, effectful-core, effectful-plugin, hspec, mcp-server, process, tasty, tasty-hspec, tricorder-mcp, tricorder-types, typed-process

Files

+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++All notable changes to `tricorder-mcp` will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),+and this project adheres to the [PVP](https://pvp.haskell.org/).++## [Unreleased]++### Added++- Initial release.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Tweag++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,71 @@+# tricorder-mcp++Model Context Protocol server for [Tricorder](../tricorder/README.md).++## Installation++`tricorder-mcp` needs to be downloaded or installed onto your machine before Claude or Copilot can use it.++### Hackage++Download or install from [Hackage](https://hackage.haskell.org/package/tricorder-mcp):++```bash+cabal install tricorder-mcp+# or+stack install tricorder-mcp+```++### GitHub release++Download and install from [GitHub releases](https://github.com/tweag/tricorder/releases), and place the binary in your `PATH`.++## Add MCP server to your agent++### With Claude++If you put `tricorder-mcp` in your `PATH`:++```bash+claude mcp add tricorder -- tricorder-mcp+```++Alternatively, if you want to refer to `tricorder-mcp` by an absolute path:++```bash+claude mcp add tricorder -- /path/to/tricorder-mcp+```++### With Copilot++Use the `/mcp add` command within Copilot, or use the CLI directly:++```bash+copilot mcp add tricorder -- tricorder-mcp+```++Alternatively, if you want to refer to `tricorder-mcp` by an absolute path:++```bash+copilot mcp add tricorder -- /path/to/tricorder-mcp+```++## Usage++Prompt your agent to use the `tricorder` MCP server whenever you want it to+perform some work. Alternatively, you can add it to your repo's `AGENT.md` to+ensure your agent always knows that the MCP server is available.++## Built on atelier++`tricorder-mcp` is built on the **atelier** toolkit, also developed in this repository:++- [`atelier-prelude`](https://github.com/tweag/tricorder/tree/main/atelier-prelude) — relude-based prelude with Effectful conventions+- [`atelier-core`](https://github.com/tweag/tricorder/tree/main/atelier-core) — foundational effects and utilities+- [`atelier-db`](https://github.com/tweag/tricorder/tree/main/atelier-db) — relational database effect (Hasql/Rel8)+- [`atelier-testing`](https://github.com/tweag/tricorder/tree/main/atelier-testing) — database-backed test utilities+- [`atelier-monitoring`](https://github.com/tweag/tricorder/tree/main/atelier-monitoring) - observability and monitoring effects and utilities++## License++MIT — see [LICENSE](LICENSE).
+ app/Main.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Tricorder.MCP.Main qualified as MCP+++main :: IO ()+main = MCP.main
+ src/Tricorder/MCP/Main.hs view
@@ -0,0 +1,33 @@+module Tricorder.MCP.Main (main) where++import Data.Version (showVersion)+import MCP.Server+    ( McpServerHandlers (..)+    , McpServerInfo (..)+    , noHandlers+    , runMcpServerStdio+    )+import MCP.Server.Derive (deriveToolHandlerWithDescription)++import Paths_tricorder_mcp (version)+import Tricorder.MCP.Tools (Tool, handleTool, toolDescriptions)+++main :: IO ()+main = runMcpServerStdio serverInfo handlers+++handlers :: McpServerHandlers+handlers =+    noHandlers+        { tools = Just $(deriveToolHandlerWithDescription ''Tool 'handleTool toolDescriptions)+        }+++serverInfo :: McpServerInfo+serverInfo =+    McpServerInfo+        { serverName = "Tricorder MCP Server"+        , serverVersion = toText (showVersion version)+        , serverInstructions = "A server to manage and use Tricorder for development purposes."+        }
+ src/Tricorder/MCP/Tools.hs view
@@ -0,0 +1,213 @@+module Tricorder.MCP.Tools+    ( Tool (..)+    , StartOptions (..)+    , StopOptions (..)+    , RestartOptions (..)+    , StatusOptions (..)+    , TestResultsOptions (..)+    , SourceOptions (..)+    , EvalCommentsOptions (..)+    , LogPathOptions (..)+    , LogContentsOptions (..)+    , handleTool+    , toolCommand+    , toolDescriptions+    , reportsBuildOutcome+    )+where++import Control.Exception (IOException, try)+import MCP.Server (ClientContext, Content (..), ToolResult, toolError, toolResult)+import System.Exit (ExitCode (..))+import System.Process.Typed (proc, readProcess, setWorkingDir)+import Tricorder.SourceLookup.SourceQuery (parseSourceQuery)++import Data.ByteString.Lazy qualified as BSL+import Tricorder.CLI.Command qualified as CLI+++data Tool+    = Start StartOptions+    | Stop StopOptions+    | Restart RestartOptions+    | Status StatusOptions+    | TestResults TestResultsOptions+    | Source SourceOptions+    | EvalComments EvalCommentsOptions+    | LogPath LogPathOptions+    | LogContents LogContentsOptions+++newtype StartOptions = StartOptions {directory :: Text}+++data StopOptions = StopOptions+    { directory :: Text+    , force :: Maybe Bool+    }+++data RestartOptions = RestartOptions+    { directory :: Text+    , force :: Maybe Bool+    }+++data StatusOptions = StatusOptions+    { directory :: Text+    , wait :: Maybe Bool+    , json :: Maybe Bool+    , verbose :: Maybe Bool+    , expand :: Maybe Int+    }+++data TestResultsOptions = TestResultsOptions+    { directory :: Text+    , failed :: Maybe Bool+    , wait :: Maybe Bool+    }+++data SourceOptions = SourceOptions+    { directory :: Text+    , modules :: [Text]+    }+++data EvalCommentsOptions = EvalCommentsOptions+    { directory :: Text+    , wait :: Maybe Bool+    , json :: Maybe Bool+    }+++newtype LogPathOptions = LogPathOptions {directory :: Text}+++newtype LogContentsOptions = LogContentsOptions {directory :: Text}+++toolDescriptions :: [(String, String)]+toolDescriptions =+    [ ("Start", "Start the tricorder daemon for a project (no-op if already running)")+    , ("Stop", "Stop the tricorder daemon for a project")+    , ("Restart", "Restart the tricorder daemon for a project")+    , ("Status", "Get the current GHCi build status: diagnostics, errors and warnings")+    , ("TestResults", "Show output from the latest test run")+    , ("Source", "Print the Haskell source of one or more installed modules")+    , ("EvalComments", "Show eval comments and their evaluated results from the latest build")+    , ("LogPath", "Print the path to the daemon's log file")+    , ("LogContents", "Print the daemon's log output")+    ,+        ( "directory"+        , "Absolute path to the project's working directory (the tricorder daemon is scoped per-directory)"+        )+    , ("force", "Ignore pending queries instead of waiting for them to finish")+    , ("wait", "Block until the current build cycle finishes before returning")+    , ("json", "Return machine-readable JSON instead of the default text output")+    , ("verbose", "Include the full GHC message body under each diagnostic")+    , ("expand", "Only show the summary line and full message body for diagnostic #N")+    , ("failed", "Only show output from failed test suites")+    , ("modules", "Module names to look up, e.g. Data.Map.Strict or Data.Map.Strict#insert")+    ]+++-- | The @tricorder@ invocation for a tool call: the project directory to run+-- it in, and the subcommand plus flags to pass. Builds the shared 'CLI.Command'+-- and renders it via 'CLI.commandToArgs' so the flags stay in sync with+-- "Tricorder.CLI.Arguments" instead of being duplicated here.+toolCommand :: Tool -> (Text, [String])+toolCommand = \case+    (Start (StartOptions {directory})) ->+        ( directory+        , CLI.commandToArgs CLI.Start+        )+    (Stop (StopOptions {directory, force = doForce})) ->+        ( directory+        , CLI.commandToArgs (CLI.Stop (toForce doForce))+        )+    (Restart (RestartOptions {directory, force = doForce})) ->+        ( directory+        , CLI.commandToArgs (CLI.Restart (toForce doForce))+        )+    (Status (StatusOptions {directory, wait, json, verbose, expand})) ->+        ( directory+        , CLI.commandToArgs+            $ CLI.Status+                CLI.StatusOptions+                    { wait = toWaitMode wait+                    , format = toFormat json+                    , verbosity = toVerbosity verbose+                    , expand+                    }+        )+    (TestResults (TestResultsOptions {directory, failed, wait})) ->+        ( directory+        , CLI.commandToArgs+            $ CLI.Test CLI.TestOptions {failedOnly = fromMaybe False failed, wait = toWaitMode wait}+        )+    (Source (SourceOptions {directory, modules})) ->+        ( directory+        , CLI.commandToArgs (CLI.Source (map parseSourceQuery modules))+        )+    (EvalComments (EvalCommentsOptions {directory, wait, json})) ->+        ( directory+        , CLI.commandToArgs+            $ CLI.EvalComments CLI.EvalCommentsOptions {wait = toWaitMode wait, format = toFormat json}+        )+    (LogPath (LogPathOptions {directory})) ->+        ( directory+        , CLI.commandToArgs (CLI.Log CLI.ShowLogPath)+        )+    (LogContents (LogContentsOptions {directory})) ->+        ( directory+        , CLI.commandToArgs (CLI.Log (CLI.ShowLog CLI.NoFollow))+        )+++toForce :: Maybe Bool -> CLI.Force+toForce = maybe CLI.NoForce (\enabled -> if enabled then CLI.Force else CLI.NoForce)+++toWaitMode :: Maybe Bool -> CLI.WaitMode+toWaitMode = maybe CLI.ShowCurrent (\enabled -> if enabled then CLI.WaitForBuild else CLI.ShowCurrent)+++toFormat :: Maybe Bool -> CLI.OutputFormat+toFormat = maybe CLI.TextOutput (\enabled -> if enabled then CLI.JsonOutput else CLI.TextOutput)+++toVerbosity :: Maybe Bool -> CLI.Verbosity+toVerbosity = maybe CLI.Concise (\enabled -> if enabled then CLI.Verbose else CLI.Concise)+++-- | Whether a tool's exit code reports a build/test outcome (errors present,+-- tests failed) rather than the CLI process itself failing. @tricorder+-- status@, @test-results@ and @eval-comments@ exit non-zero to signal what+-- they found, not that the command failed, so their output is trusted+-- regardless of exit code; every other command only exits non-zero on a+-- genuine execution failure.+reportsBuildOutcome :: Tool -> Bool+reportsBuildOutcome (Status _) = True+reportsBuildOutcome (TestResults _) = True+reportsBuildOutcome (EvalComments _) = True+reportsBuildOutcome _ = False+++-- | Spawning @tricorder@ can fail before it ever runs (e.g. the given+-- directory does not exist, or the binary is not on @PATH@): 'readProcess'+-- reports that as an 'IOException' rather than an 'ExitCode', and left+-- uncaught it would take the whole server down with it, not just this+-- request.+handleTool :: ClientContext -> Tool -> IO ToolResult+handleTool _ tool = do+    let (directory, args) = toolCommand tool+    outcome <-+        try @IOException $ readProcess $ setWorkingDir (toString directory) $ proc "tricorder" args+    pure $ case outcome of+        Left ex -> toolError $ "Failed to run tricorder: " <> show ex+        Right (ExitSuccess, out, _) -> toolResult [ContentText (decodeUtf8 out)]+        Right (ExitFailure _, out, _) | reportsBuildOutcome tool -> toolResult [ContentText (decodeUtf8 out)]+        Right (ExitFailure _, out, err) ->+            toolError $ "tricorder failed: " <> decodeUtf8 (if BSL.null err then out else err)
+ test/Driver.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}+
+ test/Unit/Tricorder/MCP/ToolsSpec.hs view
@@ -0,0 +1,65 @@+module Unit.Tricorder.MCP.ToolsSpec (spec_Tools) where++import Test.Hspec (Spec, describe, it, shouldBe)++import Tricorder.MCP.Tools+++spec_Tools :: Spec+spec_Tools = do+    describe "toolCommand" do+        it "starts with just the directory" do+            toolCommand (Start (StartOptions {directory = "/proj"}))+                `shouldBe` ("/proj", ["start"])++        it "omits --force when unset" do+            toolCommand (Stop (StopOptions {directory = "/proj", force = Nothing}))+                `shouldBe` ("/proj", ["stop"])++        it "omits --force when explicitly false" do+            toolCommand (Restart (RestartOptions {directory = "/proj", force = Just False}))+                `shouldBe` ("/proj", ["restart"])++        it "includes --force when true" do+            toolCommand (Stop (StopOptions {directory = "/proj", force = Just True}))+                `shouldBe` ("/proj", ["stop", "--force"])++        it "combines status flags in order, with --expand carrying its argument" do+            toolCommand+                ( Status+                    StatusOptions+                        { directory = "/proj"+                        , wait = Just True+                        , json = Just True+                        , verbose = Nothing+                        , expand = Just 3+                        }+                )+                `shouldBe` ("/proj", ["status", "--wait", "--json", "--expand", "3"])++        it "turns modules into positional arguments" do+            toolCommand+                (Source (SourceOptions {directory = "/proj", modules = ["Data.Map.Strict", "Foo#bar"]}))+                `shouldBe` ("/proj", ["source", "Data.Map.Strict", "Foo#bar"])++        it "maps log_path to --print-path" do+            toolCommand (LogPath (LogPathOptions {directory = "/proj"}))+                `shouldBe` ("/proj", ["log", "--print-path"])++        it "maps log_contents to plain log" do+            toolCommand (LogContents (LogContentsOptions {directory = "/proj"}))+                `shouldBe` ("/proj", ["log"])++    describe "reportsBuildOutcome" do+        it "is true for status, test_results and eval_comments" do+            reportsBuildOutcome (Status (StatusOptions "/p" Nothing Nothing Nothing Nothing)) `shouldBe` True+            reportsBuildOutcome (TestResults (TestResultsOptions "/p" Nothing Nothing)) `shouldBe` True+            reportsBuildOutcome (EvalComments (EvalCommentsOptions "/p" Nothing Nothing)) `shouldBe` True++        it "is false for commands whose exit code reflects process failure" do+            reportsBuildOutcome (Start (StartOptions "/p")) `shouldBe` False+            reportsBuildOutcome (Stop (StopOptions "/p" Nothing)) `shouldBe` False+            reportsBuildOutcome (Restart (RestartOptions "/p" Nothing)) `shouldBe` False+            reportsBuildOutcome (Source (SourceOptions "/p" [])) `shouldBe` False+            reportsBuildOutcome (LogPath (LogPathOptions "/p")) `shouldBe` False+            reportsBuildOutcome (LogContents (LogContentsOptions "/p")) `shouldBe` False
+ tricorder-mcp.cabal view
@@ -0,0 +1,155 @@+cabal-version: 2.0++-- This file has been generated from package.yaml by hpack version 0.38.3.+--+-- see: https://github.com/sol/hpack++name:           tricorder-mcp+version:        0.1.0.0+synopsis:       MCP server for Tricorder+description:    Model Context Protocol server for Tricorder.+category:       AI,+                Development+homepage:       https://github.com/tweag/tricorder#readme+bug-reports:    https://github.com/tweag/tricorder/issues+author:         Victor Nascimento Bakke+maintainer:     victor.bakke@tweag.io+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/tweag/tricorder++library tricorder-mcp-internal+  exposed-modules:+      Tricorder.MCP.Main+      Tricorder.MCP.Tools+  other-modules:+      Paths_tricorder_mcp+  autogen-modules:+      Paths_tricorder_mcp+  hs-source-dirs:+      src+  default-extensions:+      BlockArguments+      DataKinds+      DeriveAnyClass+      DerivingStrategies+      DerivingVia+      DuplicateRecordFields+      FlexibleContexts+      GADTs+      LambdaCase+      MultiWayIf+      OverloadedLabels+      OverloadedRecordDot+      OverloadedStrings+      StrictData+      TemplateHaskell+      TypeFamilies+  ghc-options: -Weverything -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction -Wno-missing-kind-signatures -Wno-missing-local-signatures -Wno-missing-import-lists -Wno-implicit-prelude -Wno-unticked-promoted-constructors -Wno-unused-packages -Wno-all-missed-specialisations -Wno-missed-specialisations -fplugin=Effectful.Plugin -threaded+  build-depends:+      atelier-core >=0.3 && <0.5+    , atelier-prelude >=0.1 && <0.3+    , base >=4.18 && <4.23+    , bytestring >=0.11 && <0.13+    , effectful-core ==2.6.*+    , effectful-plugin >=2.0 && <2.2+    , mcp-server ==0.2.*+    , process ==1.6.*+    , tricorder-types ==0.1.*+    , typed-process ==0.2.*+  mixins:+      base hiding (Prelude)+  default-language: GHC2021+  if impl(GHC >= 9.8)+    ghc-options: -Wno-missing-poly-kind-signatures -Wno-missing-role-annotations++executable tricorder-mcp+  main-is: Main.hs+  other-modules:+      Paths_tricorder_mcp+  autogen-modules:+      Paths_tricorder_mcp+  hs-source-dirs:+      app+  default-extensions:+      BlockArguments+      DataKinds+      DeriveAnyClass+      DerivingStrategies+      DerivingVia+      DuplicateRecordFields+      FlexibleContexts+      GADTs+      LambdaCase+      MultiWayIf+      OverloadedLabels+      OverloadedRecordDot+      OverloadedStrings+      StrictData+      TemplateHaskell+      TypeFamilies+  ghc-options: -Weverything -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction -Wno-missing-kind-signatures -Wno-missing-local-signatures -Wno-missing-import-lists -Wno-implicit-prelude -Wno-unticked-promoted-constructors -Wno-unused-packages -Wno-all-missed-specialisations -Wno-missed-specialisations -fplugin=Effectful.Plugin -threaded "-with-rtsopts=-N -T"+  build-depends:+      atelier-prelude >=0.1 && <0.3+    , base >=4.18 && <4.23+    , effectful-core ==2.6.*+    , effectful-plugin >=2.0 && <2.2+    , tricorder-mcp-internal+  mixins:+      base hiding (Prelude)+  default-language: GHC2021+  if impl(GHC >= 9.8)+    ghc-options: -Wno-missing-poly-kind-signatures -Wno-missing-role-annotations++test-suite tricorder-mcp-test+  type: exitcode-stdio-1.0+  main-is: Driver.hs+  other-modules:+      Unit.Tricorder.MCP.ToolsSpec+      Paths_tricorder_mcp+  autogen-modules:+      Paths_tricorder_mcp+  hs-source-dirs:+      test+  default-extensions:+      BlockArguments+      DataKinds+      DeriveAnyClass+      DerivingStrategies+      DerivingVia+      DuplicateRecordFields+      FlexibleContexts+      GADTs+      LambdaCase+      MultiWayIf+      OverloadedLabels+      OverloadedRecordDot+      OverloadedStrings+      StrictData+      TemplateHaskell+      TypeFamilies+  ghc-options: -Weverything -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction -Wno-missing-kind-signatures -Wno-missing-local-signatures -Wno-missing-import-lists -Wno-implicit-prelude -Wno-unticked-promoted-constructors -Wno-unused-packages -Wno-all-missed-specialisations -Wno-missed-specialisations -fplugin=Effectful.Plugin -threaded -Wno-prepositive-qualified-module+  build-tool-depends:+      tasty-discover:tasty-discover+  build-depends:+      atelier-core >=0.3 && <0.5+    , atelier-prelude >=0.1 && <0.3+    , base >=4.18 && <4.23+    , effectful-core ==2.6.*+    , effectful-plugin >=2.0 && <2.2+    , hspec ==2.11.*+    , tasty ==1.5.*+    , tasty-hspec ==1.2.*+    , tricorder-mcp-internal+  mixins:+      base hiding (Prelude)+  default-language: GHC2021+  if impl(GHC >= 9.8)+    ghc-options: -Wno-missing-poly-kind-signatures -Wno-missing-role-annotations