Skip to content

Commit 971395b

Browse files
sridsrid
committed
refactor(lowy): split Tools.hs into pure ToolCatalog + wire Tools
Two volatility axes were braided in one module: notebook-query helpers (findNotes, getBacklinks, resolveWikilink, NoteMatch, ResolveResult) and MCP wire scaffolding (InputSchema literals, argument parsing, ToolHandler construction, toolJsonResult / toolError). Phase 2 encapsulated the analogous split for resources: pure Catalog beside MCP-typed Handlers. Tools collapsed the same seam. Mirror the established pattern. ToolCatalog now owns the pure surface (no dpella/mcp imports — verifiable from the import list); Tools is just the wire adapter on top. ToolsSpec moves to ToolCatalogSpec since the tests cover the pure helpers.
1 parent 349240a commit 971395b

4 files changed

Lines changed: 189 additions & 166 deletions

File tree

‎emanote/emanote.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -176,6 +176,7 @@ library
176176
Emanote.MCP.Catalog
177177
Emanote.MCP.Handlers
178178
Emanote.MCP.Server
179+
Emanote.MCP.ToolCatalog
179180
Emanote.MCP.Tools
180181
Emanote.MCP.Types
181182
Emanote.MCP.Uri

‎emanote/src/Emanote/MCP/ToolCatalog.hs‎

Lines changed: 171 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,171 @@
1+
{-# LANGUAGE DuplicateRecordFields #-}
2+
{-# LANGUAGE NamedFieldPuns #-}
3+
4+
{- | Pure query helpers backing the MCP tools.
5+
6+
MCP-independent by design: this module has no @dpella/mcp@ imports, only the
7+
in-repo URI scheme and the model query layer. Tools live next door in
8+
"Emanote.MCP.Tools" and adapt these helpers to MCP wire types. Mirrors the
9+
'Emanote.MCP.Catalog' / 'Emanote.MCP.Handlers' split phase 2 introduced for
10+
resources.
11+
-}
12+
module Emanote.MCP.ToolCatalog (
13+
NoteMatch (..),
14+
ResolveResult (..),
15+
findNotes,
16+
getBacklinks,
17+
resolveWikilink,
18+
) where
19+
20+
import Commonmark.Extensions.WikiLink qualified as WL
21+
import Data.Aeson (ToJSON (..), (.=))
22+
import Data.Aeson qualified as Aeson
23+
import Data.IxSet.Typed qualified as Ix
24+
import Data.Text qualified as T
25+
import Emanote.MCP.Uri (noteUriPrefix)
26+
import Emanote.Model (Model)
27+
import Emanote.Model qualified as M
28+
import Emanote.Model.Graph qualified as G
29+
import Emanote.Model.Link.Rel qualified as Rel
30+
import Emanote.Model.Link.Resolve qualified as Resolve
31+
import Emanote.Model.Note qualified as N
32+
import Emanote.Model.StaticFile qualified as SF
33+
import Emanote.Model.Title qualified as Tit
34+
import Emanote.Route qualified as R
35+
import Network.URI.Slug qualified as Slug
36+
import Optics.Operators ((^.))
37+
import Relude
38+
39+
-- ---------------------------------------------------------------------------
40+
-- Result shapes
41+
-- ---------------------------------------------------------------------------
42+
43+
-- | A single note hit returned by 'findNotes' and 'getBacklinks'.
44+
data NoteMatch = NoteMatch
45+
{ path :: Text
46+
, title :: Text
47+
}
48+
deriving stock (Eq, Show, Generic)
49+
50+
{- | The @uri@ field is derived from @path@ so there is no way for the two to
51+
diverge: drift in 'noteUriPrefix' propagates to every consumer through
52+
one place.
53+
-}
54+
instance ToJSON NoteMatch where
55+
toJSON NoteMatch {path, title} =
56+
Aeson.object
57+
[ "path" .= path
58+
, "title" .= title
59+
, "uri" .= (noteUriPrefix <> path)
60+
]
61+
62+
-- | Outcome of resolving a wikilink, mirroring 'Rel.ResolvedRelTarget'.
63+
data ResolveResult
64+
= ResolvedNote NoteMatch
65+
| ResolvedStatic Text
66+
| UnresolvedMissing
67+
| UnresolvedAmbiguous [Either NoteMatch Text]
68+
deriving stock (Eq, Show, Generic)
69+
70+
instance ToJSON ResolveResult where
71+
toJSON = \case
72+
ResolvedNote nm ->
73+
Aeson.object ["result" .= ("found" :: Text), "kind" .= ("note" :: Text), "note" .= nm]
74+
ResolvedStatic p ->
75+
Aeson.object ["result" .= ("found" :: Text), "kind" .= ("static" :: Text), "path" .= p]
76+
UnresolvedMissing ->
77+
Aeson.object ["result" .= ("missing" :: Text)]
78+
UnresolvedAmbiguous cs ->
79+
Aeson.object
80+
[ "result" .= ("ambiguous" :: Text)
81+
, "candidates" .= (candidateValue <$> cs)
82+
]
83+
where
84+
candidateValue = \case
85+
Left nm -> Aeson.object ["kind" .= ("note" :: Text), "note" .= nm]
86+
Right p -> Aeson.object ["kind" .= ("static" :: Text), "path" .= p]
87+
88+
noteMatchOf :: N.Note -> NoteMatch
89+
noteMatchOf note =
90+
NoteMatch
91+
{ path = toText $ R.lmlSourcePath (note ^. N.noteRoute)
92+
, title = Tit.toPlain (note ^. N.noteTitle)
93+
}
94+
95+
{- | Build a 'NoteMatch' from a route. Falls back to a route-derived title
96+
when the note can't be looked up — used by callers that hold a route but
97+
not the 'N.Note' (e.g. backlink sources).
98+
-}
99+
noteMatchOfRoute :: Model -> R.LMLRoute -> NoteMatch
100+
noteMatchOfRoute model r =
101+
maybe fallback noteMatchOf (M.modelLookupNoteByRoute' r model)
102+
where
103+
fallback =
104+
NoteMatch
105+
{ path = toText $ R.lmlSourcePath r
106+
, title = Tit.toPlain (Tit.fromRoute r)
107+
}
108+
109+
-- ---------------------------------------------------------------------------
110+
-- Queries
111+
-- ---------------------------------------------------------------------------
112+
113+
{- | Substring search (case-insensitive) over note titles and source paths.
114+
115+
Returns up to @limit@ matches in 'IxSet' iteration order; this is stable
116+
under a given model snapshot but not lexicographically sorted. Callers that
117+
want ordered output should sort downstream.
118+
-}
119+
findNotes :: Text -> Int -> Model -> [NoteMatch]
120+
findNotes query lim model =
121+
let q = T.toLower query
122+
hit note =
123+
let m = noteMatchOf note
124+
in if q `T.isInfixOf` T.toLower (title m) || q `T.isInfixOf` T.toLower (path m)
125+
then Just m
126+
else Nothing
127+
in take (max 0 lim) $ mapMaybe hit $ Ix.toList (model ^. M.modelNotes)
128+
129+
{- | Backlinks for the note at the given source path.
130+
131+
Returns 'Left' if @path@ isn't a recognised LML source path
132+
(@guide/mcp.md@, @daily/2024-01-01.org@, …). An empty list is a valid
133+
'Right' result and means the note exists but no other note links to it.
134+
-}
135+
getBacklinks :: FilePath -> Model -> Either Text [NoteMatch]
136+
getBacklinks fp model =
137+
case R.mkLMLRouteFromMdOrOrgFilePath fp of
138+
Nothing -> Left $ "Not a recognised note path: " <> toText fp
139+
Just r ->
140+
Right $ noteMatchOfRoute model . fst <$> G.modelLookupBacklinks r model
141+
142+
{- | Resolve a wikilink string (without brackets), optionally relative to a
143+
source note for ambiguity disambiguation. Defaults the @from@ context to
144+
the notebook index when unspecified.
145+
-}
146+
resolveWikilink :: Text -> Maybe FilePath -> Model -> Either Text ResolveResult
147+
resolveWikilink wlText mFromPath model = do
148+
wl <- maybeToRight ("Not a valid wikilink: " <> wlText) (parseWikiLinkText wlText)
149+
fromR <- case mFromPath of
150+
Nothing -> Right (M.modelIndexRoute model)
151+
Just p -> maybeToRight ("Not a recognised note path: " <> toText p) (R.mkLMLRouteFromMdOrOrgFilePath p)
152+
Right $ case Resolve.resolveWikiLinkMustExist model fromR wl of
153+
Rel.RRTFound (Left (_, note)) -> ResolvedNote (noteMatchOf note)
154+
Rel.RRTFound (Right sf) -> ResolvedStatic (staticFilePath sf)
155+
Rel.RRTMissing -> UnresolvedMissing
156+
Rel.RRTAmbiguous cs -> UnresolvedAmbiguous $ toList $ candidate <$> cs
157+
where
158+
candidate = \case
159+
Left (_, note) -> Left (noteMatchOf note)
160+
Right sf -> Right (staticFilePath sf)
161+
staticFilePath sf = toText $ R.encodeRoute (sf ^. SF.staticFileRoute)
162+
163+
-- ---------------------------------------------------------------------------
164+
-- Internal helpers
165+
-- ---------------------------------------------------------------------------
166+
167+
-- | Parse a slash-separated wikilink target (e.g. "foo/bar") into a 'WL.WikiLink'.
168+
parseWikiLinkText :: Text -> Maybe WL.WikiLink
169+
parseWikiLinkText s
170+
| T.null s = Nothing
171+
| otherwise = viaNonEmpty WL.mkWikiLinkFromSlugs (Slug.decodeSlug <$> T.splitOn "/" s)

0 commit comments

Comments
 (0)