module Unison.Server.NameSearch
  ( Search (..),
    NameSearch (..),
    hoistSearch,
    hoistNameSearch,
    applySearch,
    SearchType (..),
  )
where

import Control.Lens
import Data.List qualified as List
import Data.Set qualified as Set
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.NamesWithHistory (SearchType (..))
import Unison.Prelude
import Unison.Reference (Reference)
import Unison.Referent (Referent)
import Unison.Server.SearchResult qualified as SR

-- | A @Search r@ is a small bag of functions that is used to power a search for @r@s.
--
-- There are currently two implementations of this interface:
--
-- * 'NameSearch.FromNames' which builds a name search from a 'Names' object
-- * 'NameSearch.Sqlite which builds a name search that uses a sqlite name lookup index.
--
-- You can use the individual methods of a name search or can use 'applySearch'.
data Search m r = Search
  { forall (m :: * -> *) r.
Search m r -> r -> m (Set (HashQualified Name))
lookupNames :: r -> m (Set (HQ'.HashQualified Name)),
    forall (m :: * -> *) r.
Search m r -> SearchType -> HashQualified Name -> m (Set r)
lookupRelativeHQRefs' :: SearchType -> HQ'.HashQualified Name -> m (Set r),
    forall (m :: * -> *) r.
Search m r
-> HashQualified Name
-> r
-> Set (HashQualified Name)
-> m SearchResult
makeResult :: HQ.HashQualified Name -> r -> Set (HQ'.HashQualified Name) -> m SR.SearchResult,
    forall (m :: * -> *) r.
Search m r -> Name -> r -> HashQualified Name -> Bool
matchesNamedRef :: Name -> r -> HQ'.HashQualified Name -> Bool
  }

hoistSearch :: (forall x. m x -> n x) -> Search m r -> Search n r
hoistSearch :: forall (m :: * -> *) (n :: * -> *) r.
(forall x. m x -> n x) -> Search m r -> Search n r
hoistSearch forall x. m x -> n x
f Search {r -> m (Set (HashQualified Name))
$sel:lookupNames:Search :: forall (m :: * -> *) r.
Search m r -> r -> m (Set (HashQualified Name))
lookupNames :: r -> m (Set (HashQualified Name))
lookupNames, SearchType -> HashQualified Name -> m (Set r)
$sel:lookupRelativeHQRefs':Search :: forall (m :: * -> *) r.
Search m r -> SearchType -> HashQualified Name -> m (Set r)
lookupRelativeHQRefs' :: SearchType -> HashQualified Name -> m (Set r)
lookupRelativeHQRefs', HashQualified Name
-> r -> Set (HashQualified Name) -> m SearchResult
$sel:makeResult:Search :: forall (m :: * -> *) r.
Search m r
-> HashQualified Name
-> r
-> Set (HashQualified Name)
-> m SearchResult
makeResult :: HashQualified Name
-> r -> Set (HashQualified Name) -> m SearchResult
makeResult, Name -> r -> HashQualified Name -> Bool
$sel:matchesNamedRef:Search :: forall (m :: * -> *) r.
Search m r -> Name -> r -> HashQualified Name -> Bool
matchesNamedRef :: Name -> r -> HashQualified Name -> Bool
matchesNamedRef} =
  Search
    { $sel:lookupNames:Search :: r -> n (Set (HashQualified Name))
lookupNames = m (Set (HashQualified Name)) -> n (Set (HashQualified Name))
forall x. m x -> n x
f (m (Set (HashQualified Name)) -> n (Set (HashQualified Name)))
-> (r -> m (Set (HashQualified Name)))
-> r
-> n (Set (HashQualified Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> m (Set (HashQualified Name))
lookupNames,
      $sel:lookupRelativeHQRefs':Search :: SearchType -> HashQualified Name -> n (Set r)
lookupRelativeHQRefs' = \SearchType
st HashQualified Name
hqname -> m (Set r) -> n (Set r)
forall x. m x -> n x
f (m (Set r) -> n (Set r)) -> m (Set r) -> n (Set r)
forall a b. (a -> b) -> a -> b
$ SearchType -> HashQualified Name -> m (Set r)
lookupRelativeHQRefs' SearchType
st HashQualified Name
hqname,
      $sel:makeResult:Search :: HashQualified Name
-> r -> Set (HashQualified Name) -> n SearchResult
makeResult = \HashQualified Name
n r
r -> m SearchResult -> n SearchResult
forall x. m x -> n x
f (m SearchResult -> n SearchResult)
-> (Set (HashQualified Name) -> m SearchResult)
-> Set (HashQualified Name)
-> n SearchResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name
-> r -> Set (HashQualified Name) -> m SearchResult
makeResult HashQualified Name
n r
r,
      $sel:matchesNamedRef:Search :: Name -> r -> HashQualified Name -> Bool
matchesNamedRef = \Name
n r
r -> Name -> r -> HashQualified Name -> Bool
matchesNamedRef Name
n r
r
    }

data NameSearch m = NameSearch
  { forall (m :: * -> *). NameSearch m -> Search m Reference
typeSearch :: Search m Reference,
    forall (m :: * -> *). NameSearch m -> Search m Referent
termSearch :: Search m Referent
  }

hoistNameSearch :: (forall x. m x -> n x) -> NameSearch m -> NameSearch n
hoistNameSearch :: forall (m :: * -> *) (n :: * -> *).
(forall x. m x -> n x) -> NameSearch m -> NameSearch n
hoistNameSearch forall x. m x -> n x
f NameSearch {Search m Reference
$sel:typeSearch:NameSearch :: forall (m :: * -> *). NameSearch m -> Search m Reference
typeSearch :: Search m Reference
typeSearch, Search m Referent
$sel:termSearch:NameSearch :: forall (m :: * -> *). NameSearch m -> Search m Referent
termSearch :: Search m Referent
termSearch} =
  NameSearch
    { $sel:typeSearch:NameSearch :: Search n Reference
typeSearch = (forall x. m x -> n x) -> Search m Reference -> Search n Reference
forall (m :: * -> *) (n :: * -> *) r.
(forall x. m x -> n x) -> Search m r -> Search n r
hoistSearch m x -> n x
forall x. m x -> n x
f Search m Reference
typeSearch,
      $sel:termSearch:NameSearch :: Search n Referent
termSearch = (forall x. m x -> n x) -> Search m Referent -> Search n Referent
forall (m :: * -> *) (n :: * -> *) r.
(forall x. m x -> n x) -> Search m r -> Search n r
hoistSearch m x -> n x
forall x. m x -> n x
f Search m Referent
termSearch
    }

-- | Interpret a 'Search' as a function from name to search results.
applySearch :: (Show r, Monad m) => Search m r -> SearchType -> HQ'.HashQualified Name -> m [SR.SearchResult]
applySearch :: forall r (m :: * -> *).
(Show r, Monad m) =>
Search m r -> SearchType -> HashQualified Name -> m [SearchResult]
applySearch Search {r -> m (Set (HashQualified Name))
$sel:lookupNames:Search :: forall (m :: * -> *) r.
Search m r -> r -> m (Set (HashQualified Name))
lookupNames :: r -> m (Set (HashQualified Name))
lookupNames, SearchType -> HashQualified Name -> m (Set r)
$sel:lookupRelativeHQRefs':Search :: forall (m :: * -> *) r.
Search m r -> SearchType -> HashQualified Name -> m (Set r)
lookupRelativeHQRefs' :: SearchType -> HashQualified Name -> m (Set r)
lookupRelativeHQRefs', HashQualified Name
-> r -> Set (HashQualified Name) -> m SearchResult
$sel:makeResult:Search :: forall (m :: * -> *) r.
Search m r
-> HashQualified Name
-> r
-> Set (HashQualified Name)
-> m SearchResult
makeResult :: HashQualified Name
-> r -> Set (HashQualified Name) -> m SearchResult
makeResult, Name -> r -> HashQualified Name -> Bool
$sel:matchesNamedRef:Search :: forall (m :: * -> *) r.
Search m r -> Name -> r -> HashQualified Name -> Bool
matchesNamedRef :: Name -> r -> HashQualified Name -> Bool
matchesNamedRef} SearchType
searchType HashQualified Name
query = do
  Set r
refs <- (SearchType -> HashQualified Name -> m (Set r)
lookupRelativeHQRefs' SearchType
searchType HashQualified Name
query)
  -- a bunch of references will match a HQ ref.
  [r] -> (r -> m SearchResult) -> m [SearchResult]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Set r -> [r]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set r
refs) \r
ref -> do
    let -- Precondition: the input set is non-empty
        prioritize :: Set (HQ'.HashQualified Name) -> (HQ'.HashQualified Name, Set (HQ'.HashQualified Name))
        prioritize :: Set (HashQualified Name)
-> (HashQualified Name, Set (HashQualified Name))
prioritize =
          Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
Set.toList
            (Set (HashQualified Name) -> [HashQualified Name])
-> ([HashQualified Name]
    -> (HashQualified Name, Set (HashQualified Name)))
-> Set (HashQualified Name)
-> (HashQualified Name, Set (HashQualified Name))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (HashQualified Name -> Bool)
-> [HashQualified Name] -> [HashQualified Name]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\HashQualified Name
n -> Name -> r -> HashQualified Name -> Bool
matchesNamedRef (HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
n) r
ref HashQualified Name
query)
            ([HashQualified Name] -> [HashQualified Name])
-> ([HashQualified Name]
    -> (HashQualified Name, Set (HashQualified Name)))
-> [HashQualified Name]
-> (HashQualified Name, Set (HashQualified Name))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [HashQualified Name]
-> Maybe (HashQualified Name, [HashQualified Name])
forall a. [a] -> Maybe (a, [a])
List.uncons
            ([HashQualified Name]
 -> Maybe (HashQualified Name, [HashQualified Name]))
-> (Maybe (HashQualified Name, [HashQualified Name])
    -> (HashQualified Name, Set (HashQualified Name)))
-> [HashQualified Name]
-> (HashQualified Name, Set (HashQualified Name))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (HashQualified Name, [HashQualified Name])
-> Maybe (HashQualified Name, [HashQualified Name])
-> (HashQualified Name, [HashQualified Name])
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (HashQualified Name, [HashQualified Name])
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char] -> [Char]
reportBug [Char]
"E839404" ([Char]
"query = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ HashQualified Name -> [Char]
forall a. Show a => a -> [Char]
show HashQualified Name
query [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", ref = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ r -> [Char]
forall a. Show a => a -> [Char]
show r
ref)))
            (Maybe (HashQualified Name, [HashQualified Name])
 -> (HashQualified Name, [HashQualified Name]))
-> ((HashQualified Name, [HashQualified Name])
    -> (HashQualified Name, Set (HashQualified Name)))
-> Maybe (HashQualified Name, [HashQualified Name])
-> (HashQualified Name, Set (HashQualified Name))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ASetter
  (HashQualified Name, [HashQualified Name])
  (HashQualified Name, Set (HashQualified Name))
  [HashQualified Name]
  (Set (HashQualified Name))
-> ([HashQualified Name] -> Set (HashQualified Name))
-> (HashQualified Name, [HashQualified Name])
-> (HashQualified Name, Set (HashQualified Name))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (HashQualified Name, [HashQualified Name])
  (HashQualified Name, Set (HashQualified Name))
  [HashQualified Name]
  (Set (HashQualified Name))
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (HashQualified Name, [HashQualified Name])
  (HashQualified Name, Set (HashQualified Name))
  [HashQualified Name]
  (Set (HashQualified Name))
_2 [HashQualified Name] -> Set (HashQualified Name)
forall a. Ord a => [a] -> Set a
Set.fromList
    Set (HashQualified Name)
names <- r -> m (Set (HashQualified Name))
lookupNames r
ref
    let (HashQualified Name
primaryName, Set (HashQualified Name)
aliases) =
          -- The precondition of `prioritize` should hold here because we are passing in the set of names that are
          -- related to this ref, which is itself one of the refs that the query name was related to! (Hence it should
          -- be non-empty).
          Set (HashQualified Name)
-> (HashQualified Name, Set (HashQualified Name))
prioritize Set (HashQualified Name)
names
    HashQualified Name
-> r -> Set (HashQualified Name) -> m SearchResult
makeResult (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
primaryName) r
ref Set (HashQualified Name)
aliases