diff --git a/node/src/Unison/Node.hs b/node/src/Unison/Node.hs index 220753362..8bb119cf1 100644 --- a/node/src/Unison/Node.hs +++ b/node/src/Unison/Node.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} + module Unison.Node where +import Data.Aeson.TH import Data.Set as S import Data.Map as M import Unison.Node.Metadata as MD @@ -8,6 +11,15 @@ import Unison.Edit.Term.Path as P import Unison.Edit.Type.Path as TP import Unison.Note (Noted) +data SearchResults k t e = + SearchResults + { references :: [(k, Metadata k)] + , matches :: ([e], Int) + , queryMatches :: ([e], Int) + , positionsExamined :: [Int] } + +deriveJSON defaultOptions ''SearchResults + data Node m k t e = Node { -- | Obtain the type of the given subterm, assuming the path is valid admissibleTypeOf :: e -> P.Path -> Noted m t, @@ -32,7 +44,7 @@ data Node m k t e = Node { -- | Access the metadata for the term and/or types identified by @k@ metadatas :: [k] -> Noted m (Map k (MD.Metadata k)), -- | Search for a term, optionally constrained to be of the given type - search :: Maybe t -> Query -> Noted m [e], + search :: Int -> Query -> Maybe t -> Noted m (SearchResults k t e), -- | Lookup the source of the term identified by @k@ terms :: [k] -> Noted m (Map k e), -- | Lookup the dependencies of @k@, optionally limited to those that intersect the given set diff --git a/node/src/Unison/Node/Common.hs b/node/src/Unison/Node/Common.hs index 4e6670742..3138d95ad 100644 --- a/node/src/Unison/Node/Common.hs +++ b/node/src/Unison/Node/Common.hs @@ -2,6 +2,7 @@ module Unison.Node.Common (node) where import Control.Applicative +import Data.Traversable (traverse) import Control.Monad import Unison.Edit.Term.Eval as Eval import Unison.Edit.Term.Path as Path @@ -86,13 +87,24 @@ node eval store = matchingLocals <- filterM f (locals >>= (\(v,t) -> TE.applications (E.Var v) t)) pure (current, admissible, annotatedLocals, matchingCurrentApplies, matchingLocals) - search t query = do + search limit query admissible = do + let typeOk e = maybe (pure True) (\t -> Type.admissible readTypeOf e t) admissible + let elaborate h = (\t -> TE.applications (E.Ref h) t) <$> readTypeOf h + let queryOk e = do mds <- traverse (readMetadata store) (S.toList (E.dependencies' e)) + pure $ any (MD.matches query) mds + let trim rs = (take limit rs, length (drop limit rs)) hs <- hashes store Nothing - hs' <- case t of - Nothing -> pure $ S.toList hs - Just t -> filterM (\h -> flip Type.isSubtype t <$> readTypeOf h) (S.toList hs) - mds <- mapM (\h -> (,) h <$> readMetadata store h) hs' - pure . map (\(h,_) -> E.Ref h) . filter (\(_,md) -> MD.matches query md) $ mds + tmatches <- do es <- traverse elaborate (S.toList hs) + filterM typeOk (join es) + qmatches <- filterM queryOk tmatches + qmatches' <- filterM queryOk (map E.Ref (S.toList hs)) + mds <- mapM (\h -> (,) h <$> readMetadata store h) + (S.toList (S.unions (map E.dependencies' qmatches))) + pure $ SearchResults + mds + (trim qmatches) + (trim qmatches') + (MD.queryPositions query) readTermRef (R.Derived h) = readTerm store h readTermRef r = pure (E.Ref r) diff --git a/node/src/Unison/Node/Metadata.hs b/node/src/Unison/Node/Metadata.hs index d3ca5e586..8488de548 100644 --- a/node/src/Unison/Node/Metadata.hs +++ b/node/src/Unison/Node/Metadata.hs @@ -2,6 +2,7 @@ module Unison.Node.Metadata where import Data.Text (Text) +import qualified Data.Text as Text -- import Data.Map as M import Data.Aeson.TH import qualified Unison.Edit.Term.Path as P @@ -44,6 +45,9 @@ data Names = Names [Symbol] deriving (Eq,Ord,Show) data Query = Query Text +queryPositions :: Query -> [Int] +queryPositions (Query q) = [0 .. (Text.length q - 1)] + -- data Examples k = Examples [(k, k)] deriveJSON defaultOptions ''Fixity diff --git a/node/src/Unison/Node/Server.hs b/node/src/Unison/Node/Server.hs index 3c32247c7..0e4c98284 100644 --- a/node/src/Unison/Node/Server.hs +++ b/node/src/Unison/Node/Server.hs @@ -99,8 +99,8 @@ server port node = S.scotty port $ do md <- runN $ N.metadatas node hs S.json md postRoute "/search" $ do - (t,q) <- S.jsonData - es <- runN $ N.search node t q + (limit,q,t) <- S.jsonData + es <- runN $ N.search node limit q t S.json es postRoute "/terms" $ do hs <- S.jsonData diff --git a/node/src/Unison/Syntax/Term.hs b/node/src/Unison/Syntax/Term.hs index 5a62b16d5..1eaafbffe 100644 --- a/node/src/Unison/Syntax/Term.hs +++ b/node/src/Unison/Syntax/Term.hs @@ -74,17 +74,19 @@ link env e = case e of Lam body -> Lam <$> link env body _ -> pure e -dependencies :: Term -> S.Set H.Hash -dependencies e = case e of - Ref (R.Derived h) -> S.singleton h - Ref _ -> S.empty +dependencies' :: Term -> S.Set R.Reference +dependencies' e = case e of + Ref r -> S.singleton r Var _ -> S.empty Lit _ -> S.empty Blank -> S.empty - App fn arg -> dependencies fn `S.union` dependencies arg - Ann e _ -> dependencies e - Vector vs -> Foldable.foldMap dependencies vs - Lam body -> dependencies body + App fn arg -> dependencies' fn `S.union` dependencies' arg + Ann e _ -> dependencies' e + Vector vs -> Foldable.foldMap dependencies' vs + Lam body -> dependencies' body + +dependencies :: Term -> S.Set H.Hash +dependencies e = S.fromList [ h | R.Derived h <- S.toList (dependencies' e) ] isClosed :: Term -> Bool isClosed e = go V.bound1 e