tricorder-mcp 0.1.0.0 → 0.1.1.0

raw patch · 5 files changed

+203/−140 lines, 5 filesdep +directorydep +unixPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: directory, unix

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• src/Tricorder/MCP/Main.hs +2/−2
• src/Tricorder/MCP/Tools.hs +162/−110
• test/Unit/Tricorder/MCP/ToolsSpec.hs +25/−27
• tricorder-mcp.cabal +3/−1

@@ -7,6 +7,17 @@  ## [Unreleased] +## [0.1.1.0] - 2026-09-01++### Changed++- `tricorder-mcp` no longer requires the agent to pass the directory of the+  project in question, and will instead infer it from the current working+  directory or use the directory passed from the agent harness.+- Added more accurate and detailed descriptions for each tool.++## [0.1.0.0] - 2026-08-19+ ### Added  - Initial release.

@@ -7,7 +7,7 @@     , noHandlers     , runMcpServerStdio     )-import MCP.Server.Derive (deriveToolHandlerWithDescription)+import MCP.Server.Derive (deriveToolHandlerWithOptions)  import Paths_tricorder_mcp (version) import Tricorder.MCP.Tools (Tool, handleTool, toolDescriptions)@@ -20,7 +20,7 @@ handlers :: McpServerHandlers handlers =     noHandlers-        { tools = Just $(deriveToolHandlerWithDescription ''Tool 'handleTool toolDescriptions)+        { tools = Just $(deriveToolHandlerWithOptions ''Tool 'handleTool toolDescriptions)         }  

@@ -1,14 +1,11 @@ module Tricorder.MCP.Tools     ( Tool (..)-    , StartOptions (..)     , StopOptions (..)     , RestartOptions (..)     , StatusOptions (..)     , TestResultsOptions (..)     , SourceOptions (..)     , EvalCommentsOptions (..)-    , LogPathOptions (..)-    , LogContentsOptions (..)     , handleTool     , toolCommand     , toolDescriptions@@ -18,98 +15,146 @@  import Control.Exception (IOException, try) import MCP.Server (ClientContext, Content (..), ToolResult, toolError, toolResult)+import MCP.Server.Derive (DefinitionOptions (..), defaultDefinitionOptions)+import System.Directory (listDirectory)+import System.Environment (lookupEnv) import System.Exit (ExitCode (..))+import System.Posix (getWorkingDirectory) import System.Process.Typed (proc, readProcess, setWorkingDir) import Tricorder.SourceLookup.SourceQuery (parseSourceQuery)  import Data.ByteString.Lazy qualified as BSL+import Data.List qualified as List import Tricorder.CLI.Command qualified as CLI   data Tool-    = Start StartOptions+    = Start     | Stop StopOptions     | Restart RestartOptions     | Status StatusOptions     | TestResults TestResultsOptions     | Source SourceOptions     | EvalComments EvalCommentsOptions-    | LogPath LogPathOptions-    | LogContents LogContentsOptions---newtype StartOptions = StartOptions {directory :: Text}+    | LogPath+    | LogContents  -data StopOptions = StopOptions-    { directory :: Text-    , force :: Maybe Bool-    }+newtype StopOptions = StopOptions {force :: Maybe Bool}  -data RestartOptions = RestartOptions-    { directory :: Text-    , force :: Maybe Bool-    }+newtype RestartOptions = RestartOptions {force :: Maybe Bool}   data StatusOptions = StatusOptions-    { directory :: Text-    , wait :: Maybe Bool-    , json :: Maybe Bool+    { wait :: Maybe Bool     , verbose :: Maybe Bool     , expand :: Maybe Int     }   data TestResultsOptions = TestResultsOptions-    { directory :: Text-    , failed :: Maybe Bool+    { failed :: Maybe Bool     , wait :: Maybe Bool     }  -data SourceOptions = SourceOptions-    { directory :: Text-    , modules :: [Text]-    }+newtype SourceOptions = SourceOptions {modules :: [Text]}  -data EvalCommentsOptions = EvalCommentsOptions-    { directory :: Text-    , wait :: Maybe Bool-    , json :: Maybe Bool+newtype EvalCommentsOptions = EvalCommentsOptions+    { wait :: Maybe Bool     }  -newtype LogPathOptions = LogPathOptions {directory :: Text}---newtype LogContentsOptions = LogContentsOptions {directory :: Text}---toolDescriptions :: [(String, String)]+toolDescriptions :: [(String, DefinitionOptions)] 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")+    [+        ( "Start"+        , defaultDefinitionOptions+            { optDescription = Just "Start the tricorder daemon (no-op if already running)."+            , optTitle = Just "Start daemon"+            }+        )     ,-        ( "directory"-        , "Absolute path to the project's working directory (the tricorder daemon is scoped per-directory)"+        ( "Stop"+        , defaultDefinitionOptions+            { optDescription = Just "Stop the tricorder daemon."+            , optTitle = Just "Stop daemon"+            , optFieldDescriptions =+                [ ("force", "Ignore pending queries instead of waiting for them to finish.")+                ]+            }         )-    , ("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")+    ,+        ( "Restart"+        , defaultDefinitionOptions+            { optDescription = Just "Restart the tricorder daemon."+            , optTitle = Just "Restart daemon"+            , optFieldDescriptions =+                [ ("force", "Ignore pending queries instead of waiting for them to finish.")+                ]+            }+        )+    ,+        ( "Status"+        , defaultDefinitionOptions+            { optDescription = Just "Get the current GHCi build status: diagnostics, errors and warnings."+            , optTitle = Just "View built status"+            , optFieldDescriptions =+                [ ("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.")+                ]+            }+        )+    ,+        ( "TestResults"+        , defaultDefinitionOptions+            { optDescription = Just "Show output from the latest test suite runs."+            , optTitle = Just "View test results"+            , optFieldDescriptions =+                [ ("wait", "Block until the current build cycle finishes before returning.")+                , ("failed", "Only show output from failed test suites.")+                ]+            }+        )+    ,+        ( "Source"+        , defaultDefinitionOptions+            { optDescription =+                Just+                    "Print the Haskell source of one or more installed modules. Prefer this over downloading tarballs."+            , optTitle = Just "Lookup source"+            , optFieldDescriptions =+                [ ("modules", "Module names to look up, e.g. Data.Map.Strict or Data.Map.Strict#insert.")+                ]+            }+        )+    ,+        ( "EvalComments"+        , defaultDefinitionOptions+            { optDescription = Just "Show eval comments and their evaluated results from the latest build."+            , optTitle = Just "View eval comments"+            , optFieldDescriptions =+                [ ("wait", "Block until the current build cycle finishes before returning.")+                ]+            }+        )+    ,+        ( "LogPath"+        , defaultDefinitionOptions+            { optDescription = Just "Print the path to the daemon's log file."+            , optTitle = Just "View log path"+            }+        )+    ,+        ( "LogContents"+        , defaultDefinitionOptions+            { optDescription = Just "Print the daemon's log output."+            , optTitle = Just "View log contents"+            }+        )     ]  @@ -117,53 +162,41 @@ -- 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+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                 CLI.StatusOptions                     { wait = toWaitMode wait-                    , format = toFormat json+                    , format = CLI.JsonOutput                     , 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))-        )+        (TestResults (TestResultsOptions {failed, wait})) ->+            CLI.Test+                CLI.TestOptions+                    { failedOnly = fromMaybe False failed+                    , wait = toWaitMode wait+                    }+        (Source (SourceOptions {modules})) ->+            CLI.Source $ parseSourceQuery <$> modules+        (EvalComments (EvalCommentsOptions {wait})) ->+            CLI.EvalComments+                CLI.EvalCommentsOptions+                    { wait = toWaitMode wait+                    , format = CLI.JsonOutput+                    }+        LogPath ->+            CLI.Log CLI.ShowLogPath+        LogContents ->+            CLI.Log $ CLI.ShowLog CLI.NoFollow   toForce :: Maybe Bool -> CLI.Force@@ -174,10 +207,6 @@ 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) @@ -202,12 +231,35 @@ -- 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)+    mDir <- projectRoot+    case mDir of+        Left err ->+            pure $ toolError $ "Failed to run tricorder: " <> err+        Right directory -> do+            outcome <-+                try @IOException+                    $ readProcess+                    $ setWorkingDir 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)+  where+    args = toolCommand tool+++projectRoot :: IO (Either Text FilePath)+projectRoot = do+    claudeDir <- lookupEnv "CLAUDE_PROJECT_DIR"+    copilotDir <- lookupEnv "COPILOT_CWD"+    workingDir <- getWorkingDirectory+    let dir = fromMaybe workingDir $ claudeDir <|> copilotDir+    files <- listDirectory dir+    if not (any (\f -> ".cabal" `List.isSuffixOf` f || "cabal.project" `List.isPrefixOf` f) files)+        then+            pure $ Left $ "Could not find a `.cabal` file in the resolved project directory: " <> toText dir+        else+            pure $ Right dir

@@ -9,57 +9,55 @@ spec_Tools = do     describe "toolCommand" do         it "starts with just the directory" do-            toolCommand (Start (StartOptions {directory = "/proj"}))-                `shouldBe` ("/proj", ["start"])+            toolCommand Start+                `shouldBe` ["start"]          it "omits --force when unset" do-            toolCommand (Stop (StopOptions {directory = "/proj", force = Nothing}))-                `shouldBe` ("/proj", ["stop"])+            toolCommand (Stop (StopOptions {force = Nothing}))+                `shouldBe` ["stop"]          it "omits --force when explicitly false" do-            toolCommand (Restart (RestartOptions {directory = "/proj", force = Just False}))-                `shouldBe` ("/proj", ["restart"])+            toolCommand (Restart (RestartOptions {force = Just False}))+                `shouldBe` ["restart"]          it "includes --force when true" do-            toolCommand (Stop (StopOptions {directory = "/proj", force = Just True}))-                `shouldBe` ("/proj", ["stop", "--force"])+            toolCommand (Stop (StopOptions {force = Just True}))+                `shouldBe` ["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+                        { wait = Just True                         , verbose = Nothing                         , expand = Just 3                         }                 )-                `shouldBe` ("/proj", ["status", "--wait", "--json", "--expand", "3"])+                `shouldBe` ["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"])+                (Source (SourceOptions {modules = ["Data.Map.Strict", "Foo#bar"]}))+                `shouldBe` ["source", "Data.Map.Strict", "Foo#bar"]          it "maps log_path to --print-path" do-            toolCommand (LogPath (LogPathOptions {directory = "/proj"}))-                `shouldBe` ("/proj", ["log", "--print-path"])+            toolCommand LogPath+                `shouldBe` ["log", "--print-path"]          it "maps log_contents to plain log" do-            toolCommand (LogContents (LogContentsOptions {directory = "/proj"}))-                `shouldBe` ("/proj", ["log"])+            toolCommand LogContents+                `shouldBe` ["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+            reportsBuildOutcome (Status (StatusOptions Nothing Nothing Nothing)) `shouldBe` True+            reportsBuildOutcome (TestResults (TestResultsOptions Nothing Nothing)) `shouldBe` True+            reportsBuildOutcome (EvalComments (EvalCommentsOptions 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+            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

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           tricorder-mcp-version:        0.1.0.0+version:        0.1.1.0 synopsis:       MCP server for Tricorder description:    Model Context Protocol server for Tricorder. category:       AI,@@ -58,12 +58,14 @@     , atelier-prelude >=0.1 && <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     , mcp-server ==0.2.*     , process ==1.6.*     , tricorder-types ==0.1.*     , typed-process ==0.2.*+    , unix ==2.8.*   mixins:       base hiding (Prelude)   default-language: GHC2021