diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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). diff --git a/src/Tricorder/MCP/Tools.hs b/src/Tricorder/MCP/Tools.hs --- a/src/Tricorder/MCP/Tools.hs +++ b/src/Tricorder/MCP/Tools.hs @@ -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 diff --git a/test/Unit/Tricorder/MCP/ToolsSpec.hs b/test/Unit/Tricorder/MCP/ToolsSpec.hs --- a/test/Unit/Tricorder/MCP/ToolsSpec.hs +++ b/test/Unit/Tricorder/MCP/ToolsSpec.hs @@ -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 diff --git a/tricorder-mcp.cabal b/tricorder-mcp.cabal --- a/tricorder-mcp.cabal +++ b/tricorder-mcp.cabal @@ -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.*