module Unison.CommandLine.FZFResolvers
  ( FZFResolver (..),
    definitionOptions,
    termDefinitionOptions,
    typeDefinitionOptions,
    namespaceOptions,
    projectDependencyResolver,
    projectNameOptions,
    projectBranchOptions,
    projectBranchOptionsWithinCurrentProject,
    fuzzySelectFromList,
    multiResolver,
    definitionResolver,
    typeDefinitionResolver,
    termDefinitionResolver,
    namespaceResolver,
    namespaceOrDefinitionResolver,
    projectAndOrBranchArg,
    projectOrBranchResolver,
    projectBranchResolver,
    projectBranchWithinCurrentProjectResolver,
    projectNameResolver,
    fuzzySelectHeader,
  )
where

import Control.Lens
import Data.List.Extra qualified as List
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import U.Codebase.Sqlite.Project as SqliteProject
import U.Codebase.Sqlite.Queries qualified as Q
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Path (Path, Path' (..))
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names qualified as Names
import Unison.Parser.Ann (Ann)
import Unison.Position qualified as Position
import Unison.Prelude
import Unison.Symbol (Symbol)
import Unison.Syntax.HashQualified qualified as HQ (toText)
import Unison.Syntax.NameSegment qualified as NameSegment
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Relation qualified as Relation

type OptionFetcher = Codebase IO Symbol Ann -> PP.ProjectPath -> Branch0 IO -> IO [Text]

data FZFResolver = FZFResolver
  { FZFResolver -> OptionFetcher
getOptions :: OptionFetcher
  }

instance Show FZFResolver where
  show :: FZFResolver -> String
show FZFResolver
_ = String
"<FZFResolver>"

-- | Select a definition from the given branch.
-- Returned names will match the provided 'Position' type.
genericDefinitionOptions :: Bool -> Bool -> OptionFetcher
genericDefinitionOptions :: Bool -> Bool -> OptionFetcher
genericDefinitionOptions Bool
includeTerms Bool
includeTypes Codebase IO Symbol Ann
_codebase ProjectPath
_projCtx Branch0 IO
searchBranch0 = IO [Text] -> IO [Text]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO do
  let termsAndTypes :: Set (HashQualified Name)
termsAndTypes =
        Bool
-> (Relation (HashQualified Name) Referent
    -> Set (HashQualified Name))
-> Relation (HashQualified Name) Referent
-> Set (HashQualified Name)
forall a. Monoid a => Bool -> a -> a
Monoid.whenM Bool
includeTerms Relation (HashQualified Name) Referent -> Set (HashQualified Name)
forall a b. Relation a b -> Set a
Relation.dom (Relation Name Referent -> Relation (HashQualified Name) Referent
Names.hashQualifyTermsRelation (Relation Referent Name -> Relation Name Referent
forall a b. Relation a b -> Relation b a
Relation.swap (Relation Referent Name -> Relation Name Referent)
-> Relation Referent Name -> Relation Name Referent
forall a b. (a -> b) -> a -> b
$ Branch0 IO -> Relation Referent Name
forall (m :: * -> *). Branch0 m -> Relation Referent Name
Branch.deepTerms Branch0 IO
searchBranch0))
          Set (HashQualified Name)
-> Set (HashQualified Name) -> Set (HashQualified Name)
forall a. Semigroup a => a -> a -> a
<> Bool
-> (Relation (HashQualified Name) TypeReference
    -> Set (HashQualified Name))
-> Relation (HashQualified Name) TypeReference
-> Set (HashQualified Name)
forall a. Monoid a => Bool -> a -> a
Monoid.whenM Bool
includeTypes Relation (HashQualified Name) TypeReference
-> Set (HashQualified Name)
forall a b. Relation a b -> Set a
Relation.dom (Relation Name TypeReference
-> Relation (HashQualified Name) TypeReference
Names.hashQualifyTypesRelation (Relation TypeReference Name -> Relation Name TypeReference
forall a b. Relation a b -> Relation b a
Relation.swap (Relation TypeReference Name -> Relation Name TypeReference)
-> Relation TypeReference Name -> Relation Name TypeReference
forall a b. (a -> b) -> a -> b
$ Branch0 IO -> Relation TypeReference Name
forall (m :: * -> *). Branch0 m -> Relation TypeReference Name
Branch.deepTypes Branch0 IO
searchBranch0))
  Set (HashQualified Name)
termsAndTypes
    Set (HashQualified Name)
-> (Set (HashQualified Name) -> [HashQualified Name])
-> [HashQualified Name]
forall a b. a -> (a -> b) -> b
& Set (HashQualified Name) -> [HashQualified Name]
forall a. Set a -> [a]
Set.toList
    [HashQualified Name] -> ([HashQualified Name] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (HashQualified Name -> Text) -> [HashQualified Name] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> (HashQualified Name -> HashQualified Name)
-> HashQualified Name
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Position -> Name -> Name
Name.setPosition Position
Position.Relative))
    [Text] -> ([Text] -> IO [Text]) -> IO [Text]
forall a b. a -> (a -> b) -> b
& [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Select a definition from the given branch.
definitionOptions :: OptionFetcher
definitionOptions :: OptionFetcher
definitionOptions = Bool -> Bool -> OptionFetcher
genericDefinitionOptions Bool
True Bool
True

-- | Select a term definition from the given branch.
-- Returned names will match the provided 'Position' type.
termDefinitionOptions :: OptionFetcher
termDefinitionOptions :: OptionFetcher
termDefinitionOptions = Bool -> Bool -> OptionFetcher
genericDefinitionOptions Bool
True Bool
False

-- | Select a type definition from the given branch.
-- Returned names will match the provided 'Position' type.
typeDefinitionOptions :: OptionFetcher
typeDefinitionOptions :: OptionFetcher
typeDefinitionOptions = Bool -> Bool -> OptionFetcher
genericDefinitionOptions Bool
False Bool
True

-- | Select a namespace from the given branch.
-- Returned Path's will match the provided 'Position' type.
namespaceOptions :: OptionFetcher
namespaceOptions :: OptionFetcher
namespaceOptions Codebase IO Symbol Ann
_codebase ProjectPath
_projCtx Branch0 IO
searchBranch0 = do
  let intoPath' :: Path -> Path'
      intoPath' :: Path -> Path'
intoPath' = Either Absolute Relative -> Path'
Path' (Either Absolute Relative -> Path')
-> (Path -> Either Absolute Relative) -> Path -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Either Absolute Relative
forall a b. b -> Either a b
Right (Relative -> Either Absolute Relative)
-> (Path -> Relative) -> Path -> Either Absolute Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative
Path.Relative
  Branch0 IO
searchBranch0
    Branch0 IO -> (Branch0 IO -> Set Path) -> Set Path
forall a b. a -> (a -> b) -> b
& Branch0 IO -> Set Path
forall (m :: * -> *). Branch0 m -> Set Path
Branch.deepPaths
    Set Path -> (Set Path -> Set Path) -> Set Path
forall a b. a -> (a -> b) -> b
& Path -> Set Path -> Set Path
forall a. Ord a => a -> Set a -> Set a
Set.delete (Path
Path.empty {- The current path just renders as an empty string which isn't a valid arg -})
    Set Path -> (Set Path -> [Path]) -> [Path]
forall a b. a -> (a -> b) -> b
& Set Path -> [Path]
forall a. Set a -> [a]
Set.toList
    [Path] -> ([Path] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Path -> Text) -> [Path] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Path' -> Text
Path.toText' (Path' -> Text) -> (Path -> Path') -> Path -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Path'
intoPath')
    [Text] -> ([Text] -> IO [Text]) -> IO [Text]
forall a b. a -> (a -> b) -> b
& [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Lists all dependencies of the current project.
--
-- E.g. if the current project has `lib.base` and `lib.distributed`, it will list:
-- ["base", "distributed"]
projectDependencyOptions :: OptionFetcher
projectDependencyOptions :: OptionFetcher
projectDependencyOptions Codebase IO Symbol Ann
_codebase ProjectPath
_projCtx Branch0 IO
searchBranch0 = do
  Branch0 IO
searchBranch0
    Branch0 IO -> (Branch0 IO -> Branch0 IO) -> Branch0 IO
forall a b. a -> (a -> b) -> b
& Path -> Branch0 IO -> Branch0 IO
forall (m :: * -> *). Path -> Branch0 m -> Branch0 m
Branch.getAt0 (NameSegment -> Path
Path.singleton NameSegment
NameSegment.libSegment)
    Branch0 IO
-> (Branch0 IO -> Map NameSegment (Branch IO))
-> Map NameSegment (Branch IO)
forall a b. a -> (a -> b) -> b
& Branch0 IO -> Map NameSegment (Branch IO)
forall (m :: * -> *). Branch0 m -> Map NameSegment (Branch m)
Branch.nonEmptyChildren
    Map NameSegment (Branch IO)
-> (Map NameSegment (Branch IO) -> [NameSegment]) -> [NameSegment]
forall a b. a -> (a -> b) -> b
& Map NameSegment (Branch IO) -> [NameSegment]
forall k a. Map k a -> [k]
Map.keys
    [NameSegment] -> ([NameSegment] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (NameSegment -> Text) -> [NameSegment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameSegment -> Text
NameSegment.toEscapedText
    [Text] -> ([Text] -> IO [Text]) -> IO [Text]
forall a b. a -> (a -> b) -> b
& [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Select a namespace from the given branch.
-- Returned Path's will match the provided 'Position' type.
fuzzySelectFromList :: [Text] -> FZFResolver
fuzzySelectFromList :: [Text] -> FZFResolver
fuzzySelectFromList [Text]
options =
  (FZFResolver {$sel:getOptions:FZFResolver :: OptionFetcher
getOptions = \Codebase IO Symbol Ann
_codebase ProjectPath
_projCtx Branch0 IO
_branch -> [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
options})

-- | Combine multiple option fetchers into one resolver.
multiResolver :: [OptionFetcher] -> FZFResolver
multiResolver :: [OptionFetcher] -> FZFResolver
multiResolver [OptionFetcher]
resolvers =
  let getOptions :: Codebase IO Symbol Ann -> PP.ProjectPath -> Branch0 IO -> IO [Text]
      getOptions :: OptionFetcher
getOptions Codebase IO Symbol Ann
codebase ProjectPath
projCtx Branch0 IO
searchBranch0 = do
        [Text] -> [Text]
forall a. Ord a => [a] -> [a]
List.nubOrd ([Text] -> [Text]) -> IO [Text] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OptionFetcher -> IO [Text]) -> [OptionFetcher] -> IO [Text]
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM (\OptionFetcher
f -> OptionFetcher
f Codebase IO Symbol Ann
codebase ProjectPath
projCtx Branch0 IO
searchBranch0) [OptionFetcher]
resolvers
   in (FZFResolver {OptionFetcher
$sel:getOptions:FZFResolver :: OptionFetcher
getOptions :: OptionFetcher
getOptions})

definitionResolver :: FZFResolver
definitionResolver :: FZFResolver
definitionResolver = FZFResolver {$sel:getOptions:FZFResolver :: OptionFetcher
getOptions = OptionFetcher
definitionOptions}

typeDefinitionResolver :: FZFResolver
typeDefinitionResolver :: FZFResolver
typeDefinitionResolver = FZFResolver {$sel:getOptions:FZFResolver :: OptionFetcher
getOptions = OptionFetcher
typeDefinitionOptions}

termDefinitionResolver :: FZFResolver
termDefinitionResolver :: FZFResolver
termDefinitionResolver = FZFResolver {$sel:getOptions:FZFResolver :: OptionFetcher
getOptions = OptionFetcher
termDefinitionOptions}

namespaceResolver :: FZFResolver
namespaceResolver :: FZFResolver
namespaceResolver = FZFResolver {$sel:getOptions:FZFResolver :: OptionFetcher
getOptions = OptionFetcher
namespaceOptions}

namespaceOrDefinitionResolver :: FZFResolver
namespaceOrDefinitionResolver :: FZFResolver
namespaceOrDefinitionResolver = [OptionFetcher] -> FZFResolver
multiResolver [OptionFetcher
definitionOptions, OptionFetcher
namespaceOptions]

projectDependencyResolver :: FZFResolver
projectDependencyResolver :: FZFResolver
projectDependencyResolver = FZFResolver {$sel:getOptions:FZFResolver :: OptionFetcher
getOptions = OptionFetcher
projectDependencyOptions}

-- | A project name, branch name, or both.
projectAndOrBranchArg :: FZFResolver
projectAndOrBranchArg :: FZFResolver
projectAndOrBranchArg = [OptionFetcher] -> FZFResolver
multiResolver [OptionFetcher
projectBranchOptions, OptionFetcher
projectNameOptions]

projectOrBranchResolver :: FZFResolver
projectOrBranchResolver :: FZFResolver
projectOrBranchResolver = [OptionFetcher] -> FZFResolver
multiResolver [OptionFetcher
projectBranchOptions, OptionFetcher
namespaceOptions]

projectBranchResolver :: FZFResolver
projectBranchResolver :: FZFResolver
projectBranchResolver = FZFResolver {$sel:getOptions:FZFResolver :: OptionFetcher
getOptions = OptionFetcher
projectBranchOptions}

projectBranchWithinCurrentProjectResolver :: FZFResolver
projectBranchWithinCurrentProjectResolver :: FZFResolver
projectBranchWithinCurrentProjectResolver = FZFResolver {$sel:getOptions:FZFResolver :: OptionFetcher
getOptions = OptionFetcher
projectBranchOptionsWithinCurrentProject}

projectNameResolver :: FZFResolver
projectNameResolver :: FZFResolver
projectNameResolver = FZFResolver {$sel:getOptions:FZFResolver :: OptionFetcher
getOptions = OptionFetcher
projectNameOptions}

-- | All possible local project names
-- E.g. '@unison/base'
projectNameOptions :: OptionFetcher
projectNameOptions :: OptionFetcher
projectNameOptions Codebase IO Symbol Ann
codebase ProjectPath
_projCtx Branch0 IO
_searchBranch0 = do
  (Project -> Text) -> [Project] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall target source. From source target => source -> target
into @Text (ProjectName -> Text)
-> (Project -> ProjectName) -> Project -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Project -> ProjectName
SqliteProject.name) ([Project] -> [Text]) -> IO [Project] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann -> Transaction [Project] -> IO [Project]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase Transaction [Project]
Q.loadAllProjects

-- | All possible local project/branch names.
-- E.g. '@unison/base/main'
projectBranchOptions :: OptionFetcher
projectBranchOptions :: OptionFetcher
projectBranchOptions Codebase IO Symbol Ann
codebase ProjectPath
_projCtx Branch0 IO
_searchBranch0 = do
  Codebase IO Symbol Ann
-> Transaction
     [(ProjectAndBranch ProjectName ProjectBranchName,
       ProjectAndBranch ProjectId ProjectBranchId)]
-> IO
     [(ProjectAndBranch ProjectName ProjectBranchName,
       ProjectAndBranch ProjectId ProjectBranchId)]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase Transaction
  [(ProjectAndBranch ProjectName ProjectBranchName,
    ProjectAndBranch ProjectId ProjectBranchId)]
Q.loadAllProjectBranchNamePairs
    IO
  [(ProjectAndBranch ProjectName ProjectBranchName,
    ProjectAndBranch ProjectId ProjectBranchId)]
-> ([(ProjectAndBranch ProjectName ProjectBranchName,
      ProjectAndBranch ProjectId ProjectBranchId)]
    -> [Text])
-> IO [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((ProjectAndBranch ProjectName ProjectBranchName,
  ProjectAndBranch ProjectId ProjectBranchId)
 -> Text)
-> [(ProjectAndBranch ProjectName ProjectBranchName,
     ProjectAndBranch ProjectId ProjectBranchId)]
-> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall target source. From source target => source -> target
into @Text (ProjectAndBranch ProjectName ProjectBranchName -> Text)
-> ((ProjectAndBranch ProjectName ProjectBranchName,
     ProjectAndBranch ProjectId ProjectBranchId)
    -> ProjectAndBranch ProjectName ProjectBranchName)
-> (ProjectAndBranch ProjectName ProjectBranchName,
    ProjectAndBranch ProjectId ProjectBranchId)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectAndBranch ProjectName ProjectBranchName,
 ProjectAndBranch ProjectId ProjectBranchId)
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. (a, b) -> a
fst)

-- | All possible local branch names within the current project.
-- E.g. '@unison/base/main'
projectBranchOptionsWithinCurrentProject :: OptionFetcher
projectBranchOptionsWithinCurrentProject :: OptionFetcher
projectBranchOptionsWithinCurrentProject Codebase IO Symbol Ann
codebase ProjectPath
projCtx Branch0 IO
_searchBranch0 = do
  Codebase IO Symbol Ann
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> IO [(ProjectBranchId, ProjectBranchName)]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO Symbol Ann
codebase (ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Q.loadAllProjectBranchesBeginningWith (ProjectPath
projCtx ProjectPath -> Getting ProjectId ProjectPath ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. (Project -> Const ProjectId Project)
-> ProjectPath -> Const ProjectId ProjectPath
#project ((Project -> Const ProjectId Project)
 -> ProjectPath -> Const ProjectId ProjectPath)
-> ((ProjectId -> Const ProjectId ProjectId)
    -> Project -> Const ProjectId Project)
-> Getting ProjectId ProjectPath ProjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectId -> Const ProjectId ProjectId)
-> Project -> Const ProjectId Project
#projectId) Maybe Text
forall a. Maybe a
Nothing)
    IO [(ProjectBranchId, ProjectBranchName)]
-> ([(ProjectBranchId, ProjectBranchName)] -> [Text]) -> IO [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((ProjectBranchId, ProjectBranchName) -> Text)
-> [(ProjectBranchId, ProjectBranchName)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall target source. From source target => source -> target
into @Text (ProjectBranchName -> Text)
-> ((ProjectBranchId, ProjectBranchName) -> ProjectBranchName)
-> (ProjectBranchId, ProjectBranchName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectBranchId, ProjectBranchName) -> ProjectBranchName
forall a b. (a, b) -> b
snd)

-- | Exported from here just so the debug command and actual implementation can use the same
-- messaging.
--
-- >>> fuzzySelectHeader "definition to view"
-- "Select a definition to view:"
--
-- >>> fuzzySelectHeader "alias name"
-- "Select an alias name:"
fuzzySelectHeader :: Text -> Text
fuzzySelectHeader :: Text -> Text
fuzzySelectHeader Text
argDesc = Text
"Select " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
aOrAn Text
argDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
argDesc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
  where
    aOrAn :: Text -> Text
    aOrAn :: Text -> Text
aOrAn Text
txt =
      Text -> Maybe (Char, Text)
Text.uncons Text
txt Maybe (Char, Text) -> (Maybe (Char, Text) -> Text) -> Text
forall a b. a -> (a -> b) -> b
& \case
        Just (Char
c, Text
_) | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"aeiou" :: [Char]) -> Text
"an"
        Maybe (Char, Text)
_ -> Text
"a"