tricorder-mcp 0.1.1.0 → 0.1.2.1

raw patch · 5 files changed

+157/−79 lines, 5 filesdep ~atelier-coredep ~atelier-preludedep ~effectful-corePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: atelier-core, atelier-prelude, effectful-core, effectful-plugin, tricorder-types

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• README.md +0/−10
• src/Tricorder/MCP/Tools.hs +87/−32
• test/Unit/Tricorder/MCP/ToolsSpec.hs +38/−24
• tricorder-mcp.cabal +13/−13

@@ -7,6 +7,25 @@  ## [Unreleased] +## [0.1.2.1] - 2026-09-11++### Changed++- Require `tricorder-types ^>=0.3`.++## [0.1.2.0] - 2026-09-10++### Changed++- Require `effectful-core >=2.7 && <2.8`.+- Require `effectful-plugin >=2.2 && <2.3`.++### Added++- Reintroduce project root argument, but as an optional argument, defaulting to+  using the current working directory. This allows the agent to control+  multiple Tricorder sessions at the same time.+ ## [0.1.1.0] - 2026-09-01  ### Changed

@@ -56,16 +56,6 @@ 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).

@@ -1,11 +1,14 @@ module Tricorder.MCP.Tools     ( Tool (..)+    , StartOptions (..)     , StopOptions (..)     , RestartOptions (..)     , StatusOptions (..)     , TestResultsOptions (..)     , SourceOptions (..)     , EvalCommentsOptions (..)+    , LogPathOptions (..)+    , LogContentsOptions (..)     , handleTool     , toolCommand     , toolDescriptions@@ -22,6 +25,7 @@ import System.Posix (getWorkingDirectory) import System.Process.Typed (proc, readProcess, setWorkingDir) import Tricorder.SourceLookup.SourceQuery (parseSourceQuery)+import Prelude hiding (force)  import Data.ByteString.Lazy qualified as BSL import Data.List qualified as List@@ -29,44 +33,69 @@   data Tool-    = Start+    = Start StartOptions     | Stop StopOptions     | Restart RestartOptions     | Status StatusOptions     | TestResults TestResultsOptions     | Source SourceOptions     | EvalComments EvalCommentsOptions-    | LogPath-    | LogContents+    | LogPath LogPathOptions+    | LogContents LogContentsOptions  -newtype StopOptions = StopOptions {force :: Maybe Bool}+newtype StartOptions = StartOptions {projectRoot :: Maybe Text}  -newtype RestartOptions = RestartOptions {force :: Maybe Bool}+data StopOptions = StopOptions+    { force :: Maybe Bool+    , projectRoot :: Maybe Text+    }  +data RestartOptions = RestartOptions+    { force :: Maybe Bool+    , projectRoot :: Maybe Text+    }++ data StatusOptions = StatusOptions     { wait :: Maybe Bool     , verbose :: Maybe Bool     , expand :: Maybe Int+    , projectRoot :: Maybe Text     }   data TestResultsOptions = TestResultsOptions     { failed :: Maybe Bool     , wait :: Maybe Bool+    , projectRoot :: Maybe Text     }  -newtype SourceOptions = SourceOptions {modules :: [Text]}+data SourceOptions = SourceOptions+    { modules :: [Text]+    , projectRoot :: Maybe Text+    }  -newtype EvalCommentsOptions = EvalCommentsOptions+data EvalCommentsOptions = EvalCommentsOptions     { wait :: Maybe Bool+    , projectRoot :: Maybe Text     }  +newtype LogPathOptions = LogPathOptions+    { projectRoot :: Maybe Text+    }+++newtype LogContentsOptions = LogContentsOptions+    { projectRoot :: Maybe Text+    }++ toolDescriptions :: [(String, DefinitionOptions)] toolDescriptions =     [@@ -74,6 +103,7 @@         , defaultDefinitionOptions             { optDescription = Just "Start the tricorder daemon (no-op if already running)."             , optTitle = Just "Start daemon"+            , optFieldDescriptions = [projectRootDesc]             }         )     ,@@ -83,6 +113,7 @@             , optTitle = Just "Stop daemon"             , optFieldDescriptions =                 [ ("force", "Ignore pending queries instead of waiting for them to finish.")+                , projectRootDesc                 ]             }         )@@ -93,6 +124,7 @@             , optTitle = Just "Restart daemon"             , optFieldDescriptions =                 [ ("force", "Ignore pending queries instead of waiting for them to finish.")+                , projectRootDesc                 ]             }         )@@ -105,6 +137,7 @@                 [ ("wait", "Block until the current build cycle finishes before returning.")                 , ("verbose", "Include the full GHC message body under each diagnostic.")                 , ("expand", "Only show the summary line and full message body for diagnostic #N.")+                , projectRootDesc                 ]             }         )@@ -116,6 +149,7 @@             , optFieldDescriptions =                 [ ("wait", "Block until the current build cycle finishes before returning.")                 , ("failed", "Only show output from failed test suites.")+                , projectRootDesc                 ]             }         )@@ -128,6 +162,7 @@             , optTitle = Just "Lookup source"             , optFieldDescriptions =                 [ ("modules", "Module names to look up, e.g. Data.Map.Strict or Data.Map.Strict#insert.")+                , projectRootDesc                 ]             }         )@@ -138,6 +173,7 @@             , optTitle = Just "View eval comments"             , optFieldDescriptions =                 [ ("wait", "Block until the current build cycle finishes before returning.")+                , projectRootDesc                 ]             }         )@@ -146,6 +182,7 @@         , defaultDefinitionOptions             { optDescription = Just "Print the path to the daemon's log file."             , optTitle = Just "View log path"+            , optFieldDescriptions = [projectRootDesc]             }         )     ,@@ -153,50 +190,66 @@         , defaultDefinitionOptions             { optDescription = Just "Print the daemon's log output."             , optTitle = Just "View log contents"+            , optFieldDescriptions = [projectRootDesc]             }         )     ]+  where+    projectRootDesc =+        ( "projectRoot"+        , "Optional directory of the project wherein to run the Tricorder\+          \commands. Usually where the `cabal.project`, `.cabal` file or\+          \`package.yaml` lives. Defaults to the current working directory."+        )   -- | 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 -> [String]-toolCommand =-    CLI.commandToArgs . \case-        Start ->-            CLI.Start-        (Stop (StopOptions {force = doForce})) ->-            CLI.Stop $ toForce doForce-        (Restart (RestartOptions {force = doForce})) ->-            CLI.Restart $ toForce doForce-        (Status (StatusOptions {wait, verbose, expand})) ->-            CLI.Status+toolCommand :: Tool -> (Maybe Text, [String])+toolCommand = \case+    Start (StartOptions {projectRoot}) ->+        (projectRoot, CLI.commandToArgs CLI.Start)+    (Stop (StopOptions {force, projectRoot})) ->+        (projectRoot, CLI.commandToArgs $ CLI.Stop $ toForce force)+    (Restart (RestartOptions {force, projectRoot})) ->+        (projectRoot, CLI.commandToArgs $ CLI.Restart $ toForce force)+    (Status (StatusOptions {wait, verbose, expand, projectRoot})) ->+        ( projectRoot+        , CLI.commandToArgs+            $ CLI.Status                 CLI.StatusOptions                     { wait = toWaitMode wait                     , format = CLI.JsonOutput                     , verbosity = toVerbosity verbose                     , expand                     }-        (TestResults (TestResultsOptions {failed, wait})) ->-            CLI.Test+        )+    (TestResults (TestResultsOptions {failed, wait, projectRoot})) ->+        ( projectRoot+        , CLI.commandToArgs+            $ CLI.Test                 CLI.TestOptions                     { failedOnly = fromMaybe False failed                     , wait = toWaitMode wait                     }-        (Source (SourceOptions {modules})) ->-            CLI.Source $ parseSourceQuery <$> modules-        (EvalComments (EvalCommentsOptions {wait})) ->-            CLI.EvalComments+        )+    (Source (SourceOptions {modules, projectRoot})) ->+        (projectRoot, CLI.commandToArgs $ CLI.Source $ parseSourceQuery <$> modules)+    (EvalComments (EvalCommentsOptions {wait, projectRoot})) ->+        ( projectRoot+        , CLI.commandToArgs+            $ CLI.EvalComments                 CLI.EvalCommentsOptions                     { wait = toWaitMode wait                     , format = CLI.JsonOutput                     }-        LogPath ->-            CLI.Log CLI.ShowLogPath-        LogContents ->-            CLI.Log $ CLI.ShowLog CLI.NoFollow+        )+    LogPath (LogPathOptions {projectRoot}) ->+        (projectRoot, CLI.commandToArgs $ CLI.Log CLI.ShowLogPath)+    LogContents (LogContentsOptions {projectRoot}) ->+        (projectRoot, CLI.commandToArgs $ CLI.Log $ CLI.ShowLog CLI.NoFollow)   toForce :: Maybe Bool -> CLI.Force@@ -231,7 +284,9 @@ -- request. handleTool :: ClientContext -> Tool -> IO ToolResult handleTool _ tool = do-    mDir <- projectRoot+    mDir <- case passedDir of+        Just dir -> pure $ Right $ toString dir+        Nothing -> getProjectRoot     case mDir of         Left err ->             pure $ toolError $ "Failed to run tricorder: " <> err@@ -248,11 +303,11 @@                 Right (ExitFailure _, out, err) ->                     toolError $ "tricorder failed: " <> decodeUtf8 (if BSL.null err then out else err)   where-    args = toolCommand tool+    (passedDir, args) = toolCommand tool  -projectRoot :: IO (Either Text FilePath)-projectRoot = do+getProjectRoot :: IO (Either Text FilePath)+getProjectRoot = do     claudeDir <- lookupEnv "CLAUDE_PROJECT_DIR"     copilotDir <- lookupEnv "COPILOT_CWD"     workingDir <- getWorkingDirectory

@@ -9,20 +9,27 @@ spec_Tools = do     describe "toolCommand" do         it "starts with just the directory" do-            toolCommand Start-                `shouldBe` ["start"]+            toolCommand (Start StartOptions {projectRoot = Nothing})+                `shouldBe` (Nothing, ["start"])          it "omits --force when unset" do-            toolCommand (Stop (StopOptions {force = Nothing}))-                `shouldBe` ["stop"]+            toolCommand (Stop (StopOptions {force = Nothing, projectRoot = Nothing}))+                `shouldBe` (Nothing, ["stop"])          it "omits --force when explicitly false" do-            toolCommand (Restart (RestartOptions {force = Just False}))-                `shouldBe` ["restart"]+            toolCommand (Restart (RestartOptions {force = Just False, projectRoot = Nothing}))+                `shouldBe` (Nothing, ["restart"])          it "includes --force when true" do-            toolCommand (Stop (StopOptions {force = Just True}))-                `shouldBe` ["stop", "--force"]+            toolCommand+                ( Stop+                    ( StopOptions+                        { force = Just True+                        , projectRoot = Nothing+                        }+                    )+                )+                `shouldBe` (Nothing, ["stop", "--force"])          it "combines status flags in order, with --expand carrying its argument" do             toolCommand@@ -31,33 +38,40 @@                         { wait = Just True                         , verbose = Nothing                         , expand = Just 3+                        , projectRoot = Nothing                         }                 )-                `shouldBe` ["status", "--wait", "--json", "--expand", "3"]+                `shouldBe` (Nothing, ["status", "--wait", "--json", "--expand", "3"])          it "turns modules into positional arguments" do             toolCommand-                (Source (SourceOptions {modules = ["Data.Map.Strict", "Foo#bar"]}))-                `shouldBe` ["source", "Data.Map.Strict", "Foo#bar"]+                ( Source+                    ( SourceOptions+                        { projectRoot = Nothing+                        , modules = ["Data.Map.Strict", "Foo#bar"]+                        }+                    )+                )+                `shouldBe` (Nothing, ["source", "Data.Map.Strict", "Foo#bar"])          it "maps log_path to --print-path" do-            toolCommand LogPath-                `shouldBe` ["log", "--print-path"]+            toolCommand (LogPath LogPathOptions {projectRoot = Nothing})+                `shouldBe` (Nothing, ["log", "--print-path"])          it "maps log_contents to plain log" do-            toolCommand LogContents-                `shouldBe` ["log"]+            toolCommand (LogContents LogContentsOptions {projectRoot = Nothing})+                `shouldBe` (Nothing, ["log"])      describe "reportsBuildOutcome" do         it "is true for status, test_results and eval_comments" do-            reportsBuildOutcome (Status (StatusOptions Nothing Nothing Nothing)) `shouldBe` True-            reportsBuildOutcome (TestResults (TestResultsOptions Nothing Nothing)) `shouldBe` True-            reportsBuildOutcome (EvalComments (EvalCommentsOptions Nothing)) `shouldBe` True+            reportsBuildOutcome (Status (StatusOptions Nothing Nothing Nothing Nothing)) `shouldBe` True+            reportsBuildOutcome (TestResults (TestResultsOptions Nothing Nothing Nothing)) `shouldBe` True+            reportsBuildOutcome (EvalComments (EvalCommentsOptions Nothing Nothing)) `shouldBe` True          it "is false for commands whose exit code reflects process failure" do-            reportsBuildOutcome Start `shouldBe` False-            reportsBuildOutcome (Stop (StopOptions Nothing)) `shouldBe` False-            reportsBuildOutcome (Restart (RestartOptions Nothing)) `shouldBe` False-            reportsBuildOutcome (Source (SourceOptions [])) `shouldBe` False-            reportsBuildOutcome LogPath `shouldBe` False-            reportsBuildOutcome LogContents `shouldBe` False+            reportsBuildOutcome (Start $ StartOptions Nothing) `shouldBe` False+            reportsBuildOutcome (Stop $ StopOptions Nothing Nothing) `shouldBe` False+            reportsBuildOutcome (Restart $ RestartOptions Nothing Nothing) `shouldBe` False+            reportsBuildOutcome (Source $ SourceOptions [] Nothing) `shouldBe` False+            reportsBuildOutcome (LogPath $ LogPathOptions Nothing) `shouldBe` False+            reportsBuildOutcome (LogContents $ LogContentsOptions Nothing) `shouldBe` False

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           tricorder-mcp-version:        0.1.1.0+version:        0.1.2.1 synopsis:       MCP server for Tricorder description:    Model Context Protocol server for Tricorder. category:       AI,@@ -54,16 +54,16 @@       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+      atelier-core ==0.6.*+    , atelier-prelude ==0.3.*     , base >=4.18 && <4.23     , bytestring >=0.11 && <0.13     , directory ==1.3.*-    , effectful-core ==2.6.*-    , effectful-plugin >=2.0 && <2.2+    , effectful-core ==2.7.*+    , effectful-plugin ==2.2.*     , mcp-server ==0.2.*     , process ==1.6.*-    , tricorder-types ==0.1.*+    , tricorder-types ==0.3.*     , typed-process ==0.2.*     , unix ==2.8.*   mixins:@@ -99,10 +99,10 @@       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+      atelier-prelude ==0.3.*     , base >=4.18 && <4.23-    , effectful-core ==2.6.*-    , effectful-plugin >=2.0 && <2.2+    , effectful-core ==2.7.*+    , effectful-plugin ==2.2.*     , tricorder-mcp-internal   mixins:       base hiding (Prelude)@@ -141,11 +141,11 @@   build-tool-depends:       tasty-discover:tasty-discover   build-depends:-      atelier-core >=0.3 && <0.5-    , atelier-prelude >=0.1 && <0.3+      atelier-core ==0.6.*+    , atelier-prelude ==0.3.*     , base >=4.18 && <4.23-    , effectful-core ==2.6.*-    , effectful-plugin >=2.0 && <2.2+    , effectful-core ==2.7.*+    , effectful-plugin ==2.2.*     , hspec ==2.11.*     , tasty ==1.5.*     , tasty-hspec ==1.2.*