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>"
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
definitionOptions :: OptionFetcher
definitionOptions :: OptionFetcher
definitionOptions = Bool -> Bool -> OptionFetcher
genericDefinitionOptions Bool
True Bool
True
termDefinitionOptions :: OptionFetcher
termDefinitionOptions :: OptionFetcher
termDefinitionOptions = Bool -> Bool -> OptionFetcher
genericDefinitionOptions Bool
True Bool
False
typeDefinitionOptions :: OptionFetcher
typeDefinitionOptions :: OptionFetcher
typeDefinitionOptions = Bool -> Bool -> OptionFetcher
genericDefinitionOptions Bool
False Bool
True
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 )
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
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
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})
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}
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}
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
projectBranchOptions :: OptionFetcher
projectBranchOptions :: OptionFetcher
projectBranchOptions Codebase IO Symbol Ann
codebase ProjectPath
projCtx Branch0 IO
_searchBranch0 = do
[(ProjectAndBranch ProjectName ProjectBranchName,
ProjectAndBranch ProjectId ProjectBranchId)]
projs <- 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
[(ProjectAndBranch ProjectName ProjectBranchName,
ProjectAndBranch ProjectId ProjectBranchId)]
projs
[(ProjectAndBranch ProjectName ProjectBranchName,
ProjectAndBranch ProjectId ProjectBranchId)]
-> ([(ProjectAndBranch ProjectName ProjectBranchName,
ProjectAndBranch ProjectId ProjectBranchId)]
-> [(Int, Text)])
-> [(Int, Text)]
forall a b. a -> (a -> b) -> b
& ((ProjectAndBranch ProjectName ProjectBranchName,
ProjectAndBranch ProjectId ProjectBranchId)
-> [(Int, Text)])
-> [(ProjectAndBranch ProjectName ProjectBranchName,
ProjectAndBranch ProjectId ProjectBranchId)]
-> [(Int, Text)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
( \(ProjectAndBranch ProjectName ProjectBranchName
names, ProjectAndBranch ProjectId ProjectBranchId
projIds) ->
if ProjectAndBranch ProjectId ProjectBranchId
projIds.project ProjectId -> ProjectId -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectPath
projCtx.project.projectId
then
[(Int
0 :: Int, Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
names.branch), (Int
2, forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
names)]
else [(Int
1, forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
names)]
)
[(Int, Text)] -> ([(Int, Text)] -> [(Int, Text)]) -> [(Int, Text)]
forall a b. a -> (a -> b) -> b
& [(Int, Text)] -> [(Int, Text)]
forall a. Ord a => [a] -> [a]
List.sort
[(Int, Text)] -> ([(Int, Text)] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& ((Int, Text) -> Text) -> [(Int, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Text) -> Text
forall a b. (a, b) -> b
snd
[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
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)
fuzzySelectHeader :: Text -> Text
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"