{-
   This module defines tab-completion strategies for entering info via the CLI
-}
{-# LANGUAGE RecordWildCards #-}

module Unison.CommandLine.Completion
  ( -- * Completers
    exactComplete,
    prefixCompleteTermOrType,
    prefixCompleteTerm,
    prefixCompleteType,
    noCompletions,
    prefixCompleteNamespace,
    fixupCompletion,
    haskelineTabComplete,
    completeShareUser,
    completeShareProject,
    completeShareBranchOrRelease,
    filenameCompletion,
    -- Unused for now, but may be useful later
    prettyCompletion,
  )
where

import Control.Lens
import Data.Aeson (FromJSON)
import Data.Aeson qualified as Aeson
import Data.List (isPrefixOf)
import Data.List qualified as List
import Data.List.Extra (nubOrdOn)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as Map
import Data.Set.NonEmpty (NESet)
import Data.Set.NonEmpty qualified as NESet
import Data.Text qualified as Text
import Network.HTTP.Client qualified as HTTP
import Network.URI qualified as URI
import System.Console.Haskeline qualified as Line
import System.Console.Haskeline.Completion (Completion)
import System.Console.Haskeline.Completion qualified as Haskeline
import Text.Megaparsec qualified as P
import U.Codebase.Branch qualified as V2Branch
import U.Codebase.Causal qualified as V2Causal
import U.Codebase.Reference qualified as Reference
import U.Codebase.Referent qualified as Referent
import Unison.Auth.HTTPClient (AuthenticatedHttpClient (..))
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Path.Parse qualified as Path
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv
import Unison.CommandLine.InputPattern qualified as IP
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.NameSegment.Internal (NameSegment (NameSegment))
import Unison.Prelude
import Unison.Share.Codeserver qualified as Codeserver
import Unison.Share.Types qualified as Share
import Unison.Sqlite qualified as Sqlite
import Unison.Syntax.NameSegment qualified as NameSegment
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Pretty qualified as P
import UnliftIO qualified
import Prelude hiding (readFile, writeFile)

-- | A completion func for use with Haskeline
haskelineTabComplete ::
  (MonadIO m) =>
  Map String IP.InputPattern ->
  Codebase m v a ->
  AuthenticatedHttpClient ->
  PP.ProjectPath ->
  Line.CompletionFunc m
haskelineTabComplete :: forall (m :: * -> *) v a.
MonadIO m =>
Map String InputPattern
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> CompletionFunc m
haskelineTabComplete Map String InputPattern
patterns Codebase m v a
codebase AuthenticatedHttpClient
authedHTTPClient ProjectPath
ppCtx = Maybe Char
-> String
-> (String -> String -> m [Completion])
-> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String
-> (String -> String -> m [Completion])
-> CompletionFunc m
Line.completeWordWithPrev Maybe Char
forall a. Maybe a
Nothing String
" " ((String -> String -> m [Completion]) -> CompletionFunc m)
-> (String -> String -> m [Completion]) -> CompletionFunc m
forall a b. (a -> b) -> a -> b
$ \String
prev String
word ->
  -- User hasn't finished a command name, complete from command names
  if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
prev
    then [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion] -> m [Completion])
-> ([String] -> [Completion]) -> [String] -> m [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [Completion]
exactComplete String
word ([String] -> m [Completion]) -> [String] -> m [Completion]
forall a b. (a -> b) -> a -> b
$ Map String InputPattern -> [String]
forall k a. Map k a -> [k]
Map.keys Map String InputPattern
patterns
    else -- User has finished a command name; use completions for that command
    case String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
prev of
      String
h : [String]
t -> m [Completion] -> Maybe (m [Completion]) -> m [Completion]
forall a. a -> Maybe a -> a
fromMaybe ([Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Maybe (m [Completion]) -> m [Completion])
-> Maybe (m [Completion]) -> m [Completion]
forall a b. (a -> b) -> a -> b
$ do
        InputPattern
p <- String -> Map String InputPattern -> Maybe InputPattern
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
h Map String InputPattern
patterns
        ParameterType
paramType <- Parameters -> Int -> Maybe ParameterType
IP.paramType (InputPattern -> Parameters
IP.params InputPattern
p) ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
t)
        m [Completion] -> Maybe (m [Completion])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m [Completion] -> Maybe (m [Completion]))
-> m [Completion] -> Maybe (m [Completion])
forall a b. (a -> b) -> a -> b
$ ParameterType
-> forall (m :: * -> *) v a.
   MonadIO m =>
   String
   -> Codebase m v a
   -> AuthenticatedHttpClient
   -> ProjectPath
   -> m [Completion]
IP.suggestions ParameterType
paramType String
word Codebase m v a
codebase AuthenticatedHttpClient
authedHTTPClient ProjectPath
ppCtx
      [String]
_ -> [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Things which we may want to complete for.
data CompletionType
  = NamespaceCompletion
  | TermCompletion
  | TypeCompletion
  deriving (Int -> CompletionType -> String -> String
[CompletionType] -> String -> String
CompletionType -> String
(Int -> CompletionType -> String -> String)
-> (CompletionType -> String)
-> ([CompletionType] -> String -> String)
-> Show CompletionType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CompletionType -> String -> String
showsPrec :: Int -> CompletionType -> String -> String
$cshow :: CompletionType -> String
show :: CompletionType -> String
$cshowList :: [CompletionType] -> String -> String
showList :: [CompletionType] -> String -> String
Show, CompletionType -> CompletionType -> Bool
(CompletionType -> CompletionType -> Bool)
-> (CompletionType -> CompletionType -> Bool) -> Eq CompletionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionType -> CompletionType -> Bool
== :: CompletionType -> CompletionType -> Bool
$c/= :: CompletionType -> CompletionType -> Bool
/= :: CompletionType -> CompletionType -> Bool
Eq, Eq CompletionType
Eq CompletionType =>
(CompletionType -> CompletionType -> Ordering)
-> (CompletionType -> CompletionType -> Bool)
-> (CompletionType -> CompletionType -> Bool)
-> (CompletionType -> CompletionType -> Bool)
-> (CompletionType -> CompletionType -> Bool)
-> (CompletionType -> CompletionType -> CompletionType)
-> (CompletionType -> CompletionType -> CompletionType)
-> Ord CompletionType
CompletionType -> CompletionType -> Bool
CompletionType -> CompletionType -> Ordering
CompletionType -> CompletionType -> CompletionType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CompletionType -> CompletionType -> Ordering
compare :: CompletionType -> CompletionType -> Ordering
$c< :: CompletionType -> CompletionType -> Bool
< :: CompletionType -> CompletionType -> Bool
$c<= :: CompletionType -> CompletionType -> Bool
<= :: CompletionType -> CompletionType -> Bool
$c> :: CompletionType -> CompletionType -> Bool
> :: CompletionType -> CompletionType -> Bool
$c>= :: CompletionType -> CompletionType -> Bool
>= :: CompletionType -> CompletionType -> Bool
$cmax :: CompletionType -> CompletionType -> CompletionType
max :: CompletionType -> CompletionType -> CompletionType
$cmin :: CompletionType -> CompletionType -> CompletionType
min :: CompletionType -> CompletionType -> CompletionType
Ord)

-- | The empty completor.
noCompletions ::
  (MonadIO m) =>
  String ->
  Codebase m v a ->
  AuthenticatedHttpClient ->
  PP.ProjectPath ->
  m [System.Console.Haskeline.Completion.Completion]
noCompletions :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
noCompletions String
_ Codebase m v a
_ AuthenticatedHttpClient
_ ProjectPath
_ = [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Finds names of the selected completion types within the path provided by the query.
--
-- Given a codebase with these terms:
--
-- @@
-- .base.List.map.doc
-- .base.List
-- .bar.foo
-- @@
--
-- We will return:
--
-- @@
-- .> cd bas<Tab>
-- base
--
-- .> cd base<Tab>
-- base
-- base.List
--
-- .> cd base.<Tab>
-- base.List
--
-- .> cd base.List.<Tab>
-- base.List.map
--
-- If conflicted, or if there's a # in the query, we expand completions into short-hashes.
-- This is also a convenient way to just see the shorthash for a given term.
--
-- .> view base.List.map#<Tab>
-- base.List.map#0q926sgnn6
completeWithinNamespace ::
  -- | The types of completions to return
  NESet CompletionType ->
  -- | The portion of this are that the user has already typed.
  String ->
  PP.ProjectPath ->
  Sqlite.Transaction [System.Console.Haskeline.Completion.Completion]
completeWithinNamespace :: NESet CompletionType
-> String -> ProjectPath -> Transaction [Completion]
completeWithinNamespace NESet CompletionType
compTypes String
query ProjectPath
ppCtx = do
  Int
shortHashLen <- Transaction Int
Codebase.hashLength
  Branch Transaction
b <- ProjectPath -> Transaction (Branch Transaction)
Codebase.getShallowBranchAtProjectPath ProjectPath
queryProjectPath
  [Completion]
currentBranchSuggestions <- do
    [(CompletionType, Bool, Text)]
nib <- Int
-> Branch Transaction -> Transaction [(CompletionType, Bool, Text)]
namesInBranch Int
shortHashLen Branch Transaction
b
    [(CompletionType, Bool, Text)]
nib
      [(CompletionType, Bool, Text)]
-> ([(CompletionType, Bool, Text)] -> [(Bool, String)])
-> [(Bool, String)]
forall a b. a -> (a -> b) -> b
& ((CompletionType, Bool, Text) -> (Bool, String))
-> [(CompletionType, Bool, Text)] -> [(Bool, String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \(CompletionType
ty, Bool
isFinished, Text
match) ->
            ( Bool
isFinished,
              Text -> String
Text.unpack (CompletionType -> Text -> Text
dotifyNamespace CompletionType
ty (Path' -> Text
forall path. Pathy path => path -> Text
Path.toText (Path' -> NameSegment -> Path'
forall path. Pathy path => path -> NameSegment -> path
Path.descend Path'
queryPathPrefix (NameSegment -> Path') -> NameSegment -> Path'
forall a b. (a -> b) -> a -> b
$ Text -> NameSegment
NameSegment Text
match)))
            )
        )
      [(Bool, String)]
-> ([(Bool, String)] -> [(Bool, String)]) -> [(Bool, String)]
forall a b. a -> (a -> b) -> b
& ((Bool, String) -> Bool) -> [(Bool, String)] -> [(Bool, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Bool
_isFinished, String
match) -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf String
query String
match)
      [(Bool, String)]
-> ([(Bool, String)] -> [Completion]) -> [Completion]
forall a b. a -> (a -> b) -> b
& ((Bool, String) -> Completion) -> [(Bool, String)] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Bool
isFinished, String
match) -> Bool -> String -> String -> Completion
prettyCompletionWithQueryPrefix Bool
isFinished String
query String
match)
      [Completion]
-> ([Completion] -> Transaction [Completion])
-> Transaction [Completion]
forall a b. a -> (a -> b) -> b
& [Completion] -> Transaction [Completion]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  [Completion]
childSuggestions <- Int -> Branch Transaction -> Transaction [Completion]
getChildSuggestions Int
shortHashLen Branch Transaction
b
  let allSuggestions :: [Completion]
allSuggestions =
        [Completion]
currentBranchSuggestions
          -- Only show child suggestions when the current branch isn't ambiguous
          [Completion] -> [Completion] -> [Completion]
forall a. Semigroup a => a -> a -> a
<> Bool -> [Completion] -> [Completion]
forall a. Monoid a => Bool -> a -> a
Monoid.whenM ([Completion] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Completion]
currentBranchSuggestions Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1) [Completion]
childSuggestions
  [Completion] -> Transaction [Completion]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion] -> Transaction [Completion])
-> ([Completion] -> [Completion])
-> [Completion]
-> Transaction [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Completion -> String) -> [Completion] -> [Completion]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn Completion -> String
Haskeline.replacement ([Completion] -> [Completion])
-> ([Completion] -> [Completion]) -> [Completion] -> [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Completion -> String) -> [Completion] -> [Completion]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn Completion -> String
Haskeline.replacement ([Completion] -> Transaction [Completion])
-> [Completion] -> Transaction [Completion]
forall a b. (a -> b) -> a -> b
$ [Completion]
allSuggestions
  where
    queryPathPrefix :: Path.Path'
    querySuffix :: Text
    (Path'
queryPathPrefix, Text
querySuffix) = Text -> (Path', Text)
parseLaxPath'Query (String -> Text
Text.pack String
query)
    queryProjectPath :: PP.ProjectPath
    queryProjectPath :: ProjectPath
queryProjectPath = ProjectPath
ppCtx ProjectPath -> (ProjectPath -> ProjectPath) -> ProjectPath
forall a b. a -> (a -> b) -> b
& (Absolute -> Identity Absolute)
-> ProjectPath -> Identity ProjectPath
forall p b (f :: * -> *).
Functor f =>
(Absolute -> f Absolute)
-> ProjectPathG p b -> f (ProjectPathG p b)
PP.absPath_ ((Absolute -> Identity Absolute)
 -> ProjectPath -> Identity ProjectPath)
-> (Absolute -> Absolute) -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Absolute
curPath -> Absolute -> Path' -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
curPath Path'
queryPathPrefix
    getChildSuggestions :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [Completion]
    getChildSuggestions :: Int -> Branch Transaction -> Transaction [Completion]
getChildSuggestions Int
shortHashLen Branch Transaction
b
      | Text -> Bool
Text.null Text
querySuffix = [Completion] -> Transaction [Completion]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      | Bool
otherwise =
          case Text -> Either Text NameSegment
NameSegment.parseText Text
querySuffix of
            Left Text
_ -> [Completion] -> Transaction [Completion]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Right NameSegment
suffix -> do
              Map NameSegment (CausalBranch Transaction)
nonEmptyChildren <- Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
V2Branch.nonEmptyChildren Branch Transaction
b
              case NameSegment
-> Map NameSegment (CausalBranch Transaction)
-> Maybe (CausalBranch Transaction)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NameSegment
suffix Map NameSegment (CausalBranch Transaction)
nonEmptyChildren of
                Maybe (CausalBranch Transaction)
Nothing -> [Completion] -> Transaction [Completion]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                Just CausalBranch Transaction
childCausal -> do
                  Branch Transaction
childBranch <- CausalBranch Transaction -> Transaction (Branch Transaction)
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> m e
V2Causal.value CausalBranch Transaction
childCausal
                  [(CompletionType, Bool, Text)]
nib <- Int
-> Branch Transaction -> Transaction [(CompletionType, Bool, Text)]
namesInBranch Int
shortHashLen Branch Transaction
childBranch
                  [(CompletionType, Bool, Text)]
nib
                    [(CompletionType, Bool, Text)]
-> ([(CompletionType, Bool, Text)] -> [(Bool, String)])
-> [(Bool, String)]
forall a b. a -> (a -> b) -> b
& ((CompletionType, Bool, Text) -> (Bool, String))
-> [(CompletionType, Bool, Text)] -> [(Bool, String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                      ( \(CompletionType
ty, Bool
isFinished, Text
match) ->
                          ( Bool
isFinished,
                            Text -> String
Text.unpack (CompletionType -> Text -> Text
dotifyNamespace CompletionType
ty (Path' -> Text
forall path. Pathy path => path -> Text
Path.toText (Path' -> NameSegment -> Path'
forall path. Pathy path => path -> NameSegment -> path
Path.descend (Path' -> NameSegment -> Path'
forall path. Pathy path => path -> NameSegment -> path
Path.descend Path'
queryPathPrefix NameSegment
suffix) (NameSegment -> Path') -> NameSegment -> Path'
forall a b. (a -> b) -> a -> b
$ Text -> NameSegment
NameSegment Text
match)))
                          )
                      )
                    [(Bool, String)]
-> ([(Bool, String)] -> [(Bool, String)]) -> [(Bool, String)]
forall a b. a -> (a -> b) -> b
& ((Bool, String) -> Bool) -> [(Bool, String)] -> [(Bool, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Bool
_isFinished, String
match) -> String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf String
query String
match)
                    [(Bool, String)]
-> ([(Bool, String)] -> [Completion]) -> [Completion]
forall a b. a -> (a -> b) -> b
& ((Bool, String) -> Completion) -> [(Bool, String)] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Bool
isFinished, String
match) -> Bool -> String -> String -> Completion
prettyCompletionWithQueryPrefix Bool
isFinished String
query String
match)
                    [Completion]
-> ([Completion] -> Transaction [Completion])
-> Transaction [Completion]
forall a b. a -> (a -> b) -> b
& [Completion] -> Transaction [Completion]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    namesInBranch :: Int -> V2Branch.Branch Sqlite.Transaction -> Sqlite.Transaction [(CompletionType, Bool, Text)]
    namesInBranch :: Int
-> Branch Transaction -> Transaction [(CompletionType, Bool, Text)]
namesInBranch Int
hashLen Branch Transaction
b = do
      Map NameSegment (CausalBranch Transaction)
nonEmptyChildren <- Branch Transaction
-> Transaction (Map NameSegment (CausalBranch Transaction))
forall (m :: * -> *).
Branch m -> Transaction (Map NameSegment (CausalBranch m))
V2Branch.nonEmptyChildren Branch Transaction
b
      [(CompletionType, Bool, Text)]
-> Transaction [(CompletionType, Bool, Text)]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(CompletionType, Bool, Text)]
 -> Transaction [(CompletionType, Bool, Text)])
-> [(CompletionType, Bool, Text)]
-> Transaction [(CompletionType, Bool, Text)]
forall a b. (a -> b) -> a -> b
$
        [[(CompletionType, Bool, Text)]] -> [(CompletionType, Bool, Text)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ (CompletionType
NamespaceCompletion,Bool
False,) (Text -> (CompletionType, Bool, Text))
-> [Text] -> [(CompletionType, Bool, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 ([NameSegment] -> [Text])
-> (Map NameSegment (CausalBranch Transaction) -> [NameSegment])
-> Map NameSegment (CausalBranch Transaction)
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NameSegment (CausalBranch Transaction) -> [NameSegment]
forall k a. Map k a -> [k]
Map.keys (Map NameSegment (CausalBranch Transaction) -> [Text])
-> Map NameSegment (CausalBranch Transaction) -> [Text]
forall a b. (a -> b) -> a -> b
$ Map NameSegment (CausalBranch Transaction)
nonEmptyChildren),
            Bool
-> [(CompletionType, Bool, Text)] -> [(CompletionType, Bool, Text)]
forall a. Monoid a => Bool -> a -> a
Monoid.whenM
              (CompletionType -> NESet CompletionType -> Bool
forall a. Ord a => a -> NESet a -> Bool
NESet.member CompletionType
TermCompletion NESet CompletionType
compTypes)
              (((Bool, Text) -> (CompletionType, Bool, Text))
-> [(Bool, Text)] -> [(CompletionType, Bool, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bool
x, Text
y) -> (CompletionType
TermCompletion, Bool
x, Text
y)) ((NameSegment -> Referent -> HashQualified NameSegment)
-> Map NameSegment (Map Referent (Transaction MdValues))
-> [(Bool, Text)]
forall r metadata.
(NameSegment -> r -> HashQualified NameSegment)
-> Map NameSegment (Map r metadata) -> [(Bool, Text)]
textifyHQ (Int -> NameSegment -> Referent -> HashQualified NameSegment
hqFromNamedV2Referent Int
hashLen) (Map NameSegment (Map Referent (Transaction MdValues))
 -> [(Bool, Text)])
-> Map NameSegment (Map Referent (Transaction MdValues))
-> [(Bool, Text)]
forall a b. (a -> b) -> a -> b
$ Branch Transaction
-> Map NameSegment (Map Referent (Transaction MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Referent (m MdValues))
V2Branch.terms Branch Transaction
b)),
            Bool
-> [(CompletionType, Bool, Text)] -> [(CompletionType, Bool, Text)]
forall a. Monoid a => Bool -> a -> a
Monoid.whenM
              (CompletionType -> NESet CompletionType -> Bool
forall a. Ord a => a -> NESet a -> Bool
NESet.member CompletionType
TypeCompletion NESet CompletionType
compTypes)
              (((Bool, Text) -> (CompletionType, Bool, Text))
-> [(Bool, Text)] -> [(CompletionType, Bool, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Bool
x, Text
y) -> (CompletionType
TypeCompletion, Bool
x, Text
y)) ((NameSegment -> Reference -> HashQualified NameSegment)
-> Map NameSegment (Map Reference (Transaction MdValues))
-> [(Bool, Text)]
forall r metadata.
(NameSegment -> r -> HashQualified NameSegment)
-> Map NameSegment (Map r metadata) -> [(Bool, Text)]
textifyHQ (Int -> NameSegment -> Reference -> HashQualified NameSegment
hqFromNamedV2Reference Int
hashLen) (Map NameSegment (Map Reference (Transaction MdValues))
 -> [(Bool, Text)])
-> Map NameSegment (Map Reference (Transaction MdValues))
-> [(Bool, Text)]
forall a b. (a -> b) -> a -> b
$ Branch Transaction
-> Map NameSegment (Map Reference (Transaction MdValues))
forall (m :: * -> *).
Branch m -> Map NameSegment (Map Reference (m MdValues))
V2Branch.types Branch Transaction
b))
          ]

    textifyHQ :: (NameSegment -> r -> HQ'.HashQualified NameSegment) -> Map NameSegment (Map r metadata) -> [(Bool, Text)]
    textifyHQ :: forall r metadata.
(NameSegment -> r -> HashQualified NameSegment)
-> Map NameSegment (Map r metadata) -> [(Bool, Text)]
textifyHQ NameSegment -> r -> HashQualified NameSegment
f Map NameSegment (Map r metadata)
xs =
      Map NameSegment (Map r metadata)
xs
        Map NameSegment (Map r metadata)
-> (Map NameSegment (Map r metadata)
    -> [HashQualified NameSegment])
-> [HashQualified NameSegment]
forall a b. a -> (a -> b) -> b
& (NameSegment -> r -> HashQualified NameSegment)
-> Map NameSegment (Map r metadata) -> [HashQualified NameSegment]
forall r metadata.
(NameSegment -> r -> HashQualified NameSegment)
-> Map NameSegment (Map r metadata) -> [HashQualified NameSegment]
hashQualifyCompletions NameSegment -> r -> HashQualified NameSegment
f
        [HashQualified NameSegment]
-> ([HashQualified NameSegment] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (HashQualified NameSegment -> Text)
-> [HashQualified NameSegment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NameSegment -> Text) -> HashQualified NameSegment -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ'.toTextWith NameSegment -> Text
NameSegment.toEscapedText)
        [Text] -> ([Text] -> [(Bool, Text)]) -> [(Bool, Text)]
forall a b. a -> (a -> b) -> b
& (Text -> (Bool, Text)) -> [Text] -> [(Bool, Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool
True,)
    -- Regrettably there'shqFromNamedV2Referencenot a great spot to combinators for V2 references and shorthashes right now.
    hqFromNamedV2Referent :: Int -> NameSegment -> Referent.Referent -> HQ'.HashQualified NameSegment
    hqFromNamedV2Referent :: Int -> NameSegment -> Referent -> HashQualified NameSegment
hqFromNamedV2Referent Int
hashLen NameSegment
n Referent
r = NameSegment -> ShortHash -> HashQualified NameSegment
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified NameSegment
n (Maybe Int -> Referent -> ShortHash
Cv.referent2toshorthash1 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
hashLen) Referent
r)
    hqFromNamedV2Reference :: Int -> NameSegment -> Reference.Reference -> HQ'.HashQualified NameSegment
    hqFromNamedV2Reference :: Int -> NameSegment -> Reference -> HashQualified NameSegment
hqFromNamedV2Reference Int
hashLen NameSegment
n Reference
r = NameSegment -> ShortHash -> HashQualified NameSegment
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified NameSegment
n (Maybe Int -> Reference -> ShortHash
Cv.reference2toshorthash1 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
hashLen) Reference
r)
    hashQualifyCompletions :: forall r metadata. (NameSegment -> r -> HQ'.HashQualified NameSegment) -> Map NameSegment (Map r metadata) -> [HQ'.HashQualified NameSegment]
    hashQualifyCompletions :: forall r metadata.
(NameSegment -> r -> HashQualified NameSegment)
-> Map NameSegment (Map r metadata) -> [HashQualified NameSegment]
hashQualifyCompletions NameSegment -> r -> HashQualified NameSegment
qualify Map NameSegment (Map r metadata)
defs = (NameSegment -> Map r metadata -> [HashQualified NameSegment])
-> Map NameSegment (Map r metadata) -> [HashQualified NameSegment]
forall m a.
Monoid m =>
(NameSegment -> a -> m) -> Map NameSegment a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap NameSegment -> Map r metadata -> [HashQualified NameSegment]
qualifyRefs Map NameSegment (Map r metadata)
defs
      where
        -- Qualify any conflicted definitions. If the query has a "#" in it, then qualify ALL
        -- completions.
        qualifyRefs :: NameSegment -> Map r metadata -> [HQ'.HashQualified NameSegment]
        qualifyRefs :: NameSegment -> Map r metadata -> [HashQualified NameSegment]
qualifyRefs NameSegment
n Map r metadata
refs
          | Text -> Text -> Bool
Text.isInfixOf Text
"#" Text
querySuffix Bool -> Bool -> Bool
|| Map r metadata -> Int
forall a. Map r a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map r metadata
refs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Map r metadata
refs Map r metadata -> (Map r metadata -> [r]) -> [r]
forall a b. a -> (a -> b) -> b
& Map r metadata -> [r]
forall k a. Map k a -> [k]
Map.keys [r]
-> (r -> HashQualified NameSegment) -> [HashQualified NameSegment]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NameSegment -> r -> HashQualified NameSegment
qualify NameSegment
n
          | Bool
otherwise = [NameSegment -> HashQualified NameSegment
forall n. n -> HashQualified n
HQ'.NameOnly NameSegment
n]

    -- If we're not completing namespaces, then all namespace completions should automatically
    -- drill-down by adding a trailing '.'
    dotifyNamespace :: CompletionType -> Text -> Text
    dotifyNamespace :: CompletionType -> Text -> Text
dotifyNamespace CompletionType
NamespaceCompletion | Bool -> Bool
not (CompletionType -> NESet CompletionType -> Bool
forall a. Ord a => a -> NESet a -> Bool
NESet.member CompletionType
NamespaceCompletion NESet CompletionType
compTypes) = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".")
    dotifyNamespace CompletionType
_ = Text -> Text
forall a. a -> a
id

-- | A path parser which which is more lax with respect to well formed paths,
-- specifically we can determine a valid path prefix with a (possibly empty) suffix query.
-- This is used in tab-completion where the difference between `.base` and `.base.` is
-- relevant, but can't be detected when running something like 'Path.fromText''
--
-- >>> parseLaxPath'Query ".base."
-- (.base,"")
--
-- >>> parseLaxPath'Query ".base"
-- (.,"base")
--
-- >>> parseLaxPath'Query ".base.List"
-- (.base,"List")
--
-- >>> parseLaxPath'Query ""
-- (,"")
--
-- >>> parseLaxPath'Query "base"
-- (,"base")
--
-- >>> parseLaxPath'Query "base."
-- (base,"")
--
-- >>> parseLaxPath'Query "base.List"
-- (base,"List")
parseLaxPath'Query :: Text -> (Path.Path', Text)
parseLaxPath'Query :: Text -> (Path', Text)
parseLaxPath'Query Text
txt =
  case Parsec (Token Text) String (Split Path', String)
-> String
-> String
-> Either
     (ParseErrorBundle String (Token Text)) (Split Path', String)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser ((,) (Split Path' -> String -> (Split Path', String))
-> ParsecT (Token Text) String Identity (Split Path')
-> ParsecT
     (Token Text) String Identity (String -> (Split Path', String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Token Text) String Identity (Split Path')
Path.splitP' ParsecT
  (Token Text) String Identity (String -> (Split Path', String))
-> ParsecT (Token Text) String Identity String
-> Parsec (Token Text) String (Split Path', String)
forall a b.
ParsecT (Token Text) String Identity (a -> b)
-> ParsecT (Token Text) String Identity a
-> ParsecT (Token Text) String Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT (Token Text) String Identity String
ParsecT (Token Text) String Identity (Tokens String)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
P.takeRest) String
"" (Text -> String
Text.unpack Text
txt) of
    Left ParseErrorBundle String (Token Text)
_err -> (Path'
Path.Current', Text
txt)
    Right (Split Path'
name, String
rest) ->
      if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
rest String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"."
        then (Split Path' -> Path'
forall path. Pathy path => Split path -> path
Path.unsplit Split Path'
name, Text
Text.empty)
        else NameSegment -> Text
NameSegment.toEscapedText (NameSegment -> Text) -> Split Path' -> (Path', Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Split Path'
name

-- | Completes a namespace argument by prefix-matching against the query.
prefixCompleteNamespace ::
  String ->
  PP.ProjectPath ->
  Sqlite.Transaction [Line.Completion]
prefixCompleteNamespace :: String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace = NESet CompletionType
-> String -> ProjectPath -> Transaction [Completion]
completeWithinNamespace (CompletionType -> NESet CompletionType
forall a. a -> NESet a
NESet.singleton CompletionType
NamespaceCompletion)

-- | Completes a term or type argument by prefix-matching against the query.
prefixCompleteTermOrType ::
  String ->
  PP.ProjectPath ->
  Sqlite.Transaction [Line.Completion]
prefixCompleteTermOrType :: String -> ProjectPath -> Transaction [Completion]
prefixCompleteTermOrType = NESet CompletionType
-> String -> ProjectPath -> Transaction [Completion]
completeWithinNamespace (NonEmpty CompletionType -> NESet CompletionType
forall a. Ord a => NonEmpty a -> NESet a
NESet.fromList (CompletionType
TermCompletion CompletionType -> [CompletionType] -> NonEmpty CompletionType
forall a. a -> [a] -> NonEmpty a
NE.:| [CompletionType
TypeCompletion]))

-- | Completes a term argument by prefix-matching against the query.
prefixCompleteTerm ::
  String ->
  PP.ProjectPath ->
  Sqlite.Transaction [Line.Completion]
prefixCompleteTerm :: String -> ProjectPath -> Transaction [Completion]
prefixCompleteTerm = NESet CompletionType
-> String -> ProjectPath -> Transaction [Completion]
completeWithinNamespace (CompletionType -> NESet CompletionType
forall a. a -> NESet a
NESet.singleton CompletionType
TermCompletion)

-- | Completes a term or type argument by prefix-matching against the query.
prefixCompleteType ::
  String ->
  PP.ProjectPath ->
  Sqlite.Transaction [Line.Completion]
prefixCompleteType :: String -> ProjectPath -> Transaction [Completion]
prefixCompleteType = NESet CompletionType
-> String -> ProjectPath -> Transaction [Completion]
completeWithinNamespace (CompletionType -> NESet CompletionType
forall a. a -> NESet a
NESet.singleton CompletionType
TypeCompletion)

-- | Renders a completion option with the prefix matching the query greyed out.
prettyCompletionWithQueryPrefix ::
  Bool ->
  -- | query
  String ->
  -- | completion
  String ->
  Line.Completion
prettyCompletionWithQueryPrefix :: Bool -> String -> String -> Completion
prettyCompletionWithQueryPrefix Bool
endWithSpace String
query String
s =
  let coloredMatch :: Pretty ColorText
coloredMatch = Pretty ColorText -> Pretty ColorText
P.hiBlack (String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string String
query) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
query) String
s)
   in String -> String -> Bool -> Completion
Line.Completion String
s (Pretty ColorText -> String
P.toAnsiUnbroken Pretty ColorText
coloredMatch) Bool
endWithSpace

-- discards formatting in favor of better alignment
-- prettyCompletion (s, p) = Line.Completion s (P.toPlainUnbroken p) True
-- preserves formatting, but Haskeline doesn't know how to align
prettyCompletion :: Bool -> (String, P.Pretty P.ColorText) -> Line.Completion
prettyCompletion :: Bool -> (String, Pretty ColorText) -> Completion
prettyCompletion Bool
endWithSpace (String
s, Pretty ColorText
p) = String -> String -> Bool -> Completion
Line.Completion String
s (Pretty ColorText -> String
P.toAnsiUnbroken Pretty ColorText
p) Bool
endWithSpace

-- | Constructs a list of 'Completion's from a query and completion options by
-- filtering them for prefix matches. A completion will be selected if it's an exact match for
-- a provided option.
exactComplete :: String -> [String] -> [Line.Completion]
exactComplete :: String -> [String] -> [Completion]
exactComplete String
q [String]
ss = String -> Completion
go (String -> Completion) -> [String] -> [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
q) [String]
ss
  where
    go :: String -> Completion
go String
s = Bool -> String -> String -> Completion
prettyCompletionWithQueryPrefix (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
q) String
q String
s

-- workaround for https://github.com/judah/haskeline/issues/100
-- if the common prefix of all the completions is smaller than
-- the query, we make all the replacements equal to the query,
-- which will preserve what the user has typed
fixupCompletion :: String -> [Line.Completion] -> [Line.Completion]
fixupCompletion :: String -> [Completion] -> [Completion]
fixupCompletion String
_q [] = []
fixupCompletion String
_q [Completion
c] = [Completion
c]
fixupCompletion String
q cs :: [Completion]
cs@(Completion
h : [Completion]
t) =
  let commonPrefix :: String -> String -> String
commonPrefix (Char
h1 : String
t1) (Char
h2 : String
t2) | Char
h1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
h2 = Char
h1 Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String -> String
commonPrefix String
t1 String
t2
      commonPrefix String
_ String
_ = String
""
      overallCommonPrefix :: String
overallCommonPrefix =
        (String -> String -> String) -> String -> [String] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl String -> String -> String
commonPrefix (Completion -> String
Line.replacement Completion
h) (Completion -> String
Line.replacement (Completion -> String) -> [Completion] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Completion]
t)
   in if Bool -> Bool
not (String
q String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
overallCommonPrefix)
        then [Completion
c {Line.replacement = q} | Completion
c <- [Completion]
cs]
        else [Completion]
cs

data SearchKind = UserKind | ProjectKind
  deriving (Int -> SearchKind -> String -> String
[SearchKind] -> String -> String
SearchKind -> String
(Int -> SearchKind -> String -> String)
-> (SearchKind -> String)
-> ([SearchKind] -> String -> String)
-> Show SearchKind
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SearchKind -> String -> String
showsPrec :: Int -> SearchKind -> String -> String
$cshow :: SearchKind -> String
show :: SearchKind -> String
$cshowList :: [SearchKind] -> String -> String
showList :: [SearchKind] -> String -> String
Show, SearchKind -> SearchKind -> Bool
(SearchKind -> SearchKind -> Bool)
-> (SearchKind -> SearchKind -> Bool) -> Eq SearchKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchKind -> SearchKind -> Bool
== :: SearchKind -> SearchKind -> Bool
$c/= :: SearchKind -> SearchKind -> Bool
/= :: SearchKind -> SearchKind -> Bool
Eq)

-- | Completes a user handle by searching Share.
completeShareUser ::
  (MonadIO m) =>
  AuthenticatedHttpClient ->
  String ->
  m [Completion]
completeShareUser :: forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> String -> m [Completion]
completeShareUser AuthenticatedHttpClient
authHTTPClient String
query =
  AuthenticatedHttpClient -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> m [Text]
completeShareUserHelper AuthenticatedHttpClient
authHTTPClient (String -> Text
Text.pack String
query)
    m [Text] -> ([Text] -> [Completion]) -> m [Completion]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Completion) -> [Text] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \Text
handle ->
      Line.Completion
        { replacement :: String
Line.replacement = Text -> String
Text.unpack Text
handle,
          display :: String
Line.display = Text -> String
Text.unpack Text
handle,
          isFinished :: Bool
Line.isFinished = Bool
False
        }

-- | E.g. "@uni" -> "@unison"
completeShareUserHelper ::
  (MonadIO m) =>
  AuthenticatedHttpClient ->
  Text ->
  m [Text]
completeShareUserHelper :: forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> m [Text]
completeShareUserHelper AuthenticatedHttpClient
authHTTPClient Text
query = do
  [SearchResult]
results <- AuthenticatedHttpClient
-> NESet SearchKind -> Text -> Maybe Text -> m [SearchResult]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient
-> NESet SearchKind -> Text -> Maybe Text -> m [SearchResult]
runShareOmniSearch AuthenticatedHttpClient
authHTTPClient (SearchKind -> NESet SearchKind
forall a. a -> NESet a
NESet.singleton SearchKind
UserKind) Text
query Maybe Text
forall a. Maybe a
Nothing
  [SearchResult]
results
    [SearchResult] -> ([SearchResult] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (SearchResult -> Maybe Text) -> [SearchResult] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \case
      SearchResultUserLike Text
handle -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
handle
      SearchResultProject Text
_ -> Maybe Text
forall a. Maybe a
Nothing
    [Text] -> ([Text] -> m [Text]) -> m [Text]
forall a b. a -> (a -> b) -> b
& [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Does progressive tab-completion, so if you're working on the user-segment it'll complete that, then if you mash tab
-- it'll proceed to project completion.
-- E.g. "@uni" -> "@unison/"
-- Then "@unison/" -> "@unison/base"
completeShareProject ::
  (MonadIO m) =>
  AuthenticatedHttpClient ->
  String ->
  m [Completion]
completeShareProject :: forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> String -> m [Completion]
completeShareProject AuthenticatedHttpClient
authHTTPClient String
query =
  AuthenticatedHttpClient -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> m [Text]
completeShareProjectHelper AuthenticatedHttpClient
authHTTPClient (String -> Text
Text.pack String
query)
    m [Text] -> ([Text] -> [Completion]) -> m [Completion]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Completion) -> [Text] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \Text
ref ->
      Line.Completion
        { replacement :: String
Line.replacement = Text -> String
Text.unpack Text
ref,
          display :: String
Line.display = Text -> String
Text.unpack Text
ref,
          isFinished :: Bool
Line.isFinished = Bool
False
        }

completeShareProjectHelper ::
  (MonadIO m) =>
  AuthenticatedHttpClient ->
  Text ->
  m [Text]
completeShareProjectHelper :: forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> m [Text]
completeShareProjectHelper AuthenticatedHttpClient
authHTTPClient Text
query
  | Text -> Text -> Bool
Text.isInfixOf Text
"/" Text
query = do
      [SearchResult]
results <- AuthenticatedHttpClient
-> NESet SearchKind -> Text -> Maybe Text -> m [SearchResult]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient
-> NESet SearchKind -> Text -> Maybe Text -> m [SearchResult]
runShareOmniSearch AuthenticatedHttpClient
authHTTPClient (SearchKind -> NESet SearchKind
forall a. a -> NESet a
NESet.singleton SearchKind
ProjectKind) Text
query (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"slug-prefix")
      [SearchResult]
results
        [SearchResult] -> ([SearchResult] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (SearchResult -> Maybe Text) -> [SearchResult] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \case
          SearchResultUserLike Text
_ -> Maybe Text
forall a. Maybe a
Nothing
          SearchResultProject Text
ref -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ref
        [Text] -> ([Text] -> m [Text]) -> m [Text]
forall a b. a -> (a -> b) -> b
& [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  | Bool
otherwise =
      AuthenticatedHttpClient -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> m [Text]
completeShareUserHelper AuthenticatedHttpClient
authHTTPClient Text
query
        m [Text] -> ([Text] -> [Text]) -> m [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \Text
handle -> Text -> Text
ensureTrailingSlash Text
handle

-- | Does progressive tab-completion, so if you're working on the user-segment it'll complete that, then if you mash tab
-- it'll proceed to project completion, then branch or release completion.
-- E.g. "@uni" -> "@unison/"
-- Then "@unison/" -> "@unison/base/"
-- Then "@unison/base/" -> "@unison/base/main"
-- or "@unison/base/@cont" -> "@unison/base/@contributor/"
-- or "@unison/base/@contributor/" -> "@unison/base/@contributor/feature"
-- or "@unison/base/releases/lat" -> "@unison/base/releases/latest"
-- or "@unison/base/releases/1." -> "@unison/base/releases/1.2.3"
completeShareBranchOrRelease ::
  (MonadIO m) =>
  AuthenticatedHttpClient ->
  String ->
  m [Completion]
completeShareBranchOrRelease :: forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> String -> m [Completion]
completeShareBranchOrRelease AuthenticatedHttpClient
authHTTPClient String
query = do
  AuthenticatedHttpClient -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> m [Text]
completeShareBranchHelper AuthenticatedHttpClient
authHTTPClient (String -> Text
Text.pack String
query)
    m [Text] -> ([Text] -> [Completion]) -> m [Completion]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Completion) -> [Text] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \Text
branch ->
      Line.Completion
        { replacement :: String
Line.replacement = Text -> String
Text.unpack Text
branch,
          display :: String
Line.display = Text -> String
Text.unpack Text
branch,
          isFinished :: Bool
Line.isFinished = Bool
False
        }

completeShareBranchHelper ::
  (MonadIO m) =>
  AuthenticatedHttpClient ->
  Text ->
  m [Text]
completeShareBranchHelper :: forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> m [Text]
completeShareBranchHelper AuthenticatedHttpClient
authHTTPClient Text
query = do
  case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"/" Text
query of
    -- /branch
    [Text
"", Text
_branchQuery] ->
      -- TODO: Add support for inferring the remote project branch.
      [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    -- @handle/proj/branch
    [Text
handle, Text
proj, Text
branchOrContributorPrefix]
      | Text -> Text -> Bool
Text.isPrefixOf Text
"@" Text
branchOrContributorPrefix -> do
          -- Search contributors instead.
          AuthenticatedHttpClient -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> m [Text]
completeShareUserHelper AuthenticatedHttpClient
authHTTPClient Text
branchOrContributorPrefix
            m [Text] -> ([Text] -> [Text]) -> m [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \Text
contributorHandle ->
              Text
handle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
proj Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
ensureTrailingSlash Text
contributorHandle
      | Bool
otherwise -> do
          [Text]
results <- AuthenticatedHttpClient
-> Text -> Text -> Maybe Text -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient
-> Text -> Text -> Maybe Text -> Text -> m [Text]
searchProjectBranches AuthenticatedHttpClient
authHTTPClient Text
handle Text
proj Maybe Text
forall a. Maybe a
Nothing Text
branchOrContributorPrefix
          [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$
            Bool -> [Text] -> [Text]
forall a. Monoid a => Bool -> a -> a
Monoid.whenM (Text -> Text -> Bool
Text.isPrefixOf Text
branchOrContributorPrefix Text
"releases") [Text
handle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
proj Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/releases/"]
              [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
results
    [Text
handle, Text
proj, Text
"releases", Text
""] -> do
      AuthenticatedHttpClient -> Text -> Text -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> Text -> Text -> m [Text]
searchProjectReleases AuthenticatedHttpClient
authHTTPClient Text
handle Text
proj Text
""
        m [Text] -> ([Text] -> [Text]) -> m [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text
handle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
proj Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/releases/latest" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)
    [Text
handle, Text
proj, Text
"releases", Text
branch]
      | Text -> Text -> Bool
Text.isPrefixOf Text
branch Text
"latest" -> [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
handle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
proj Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/releases/latest"]
      | Bool
otherwise -> do
          AuthenticatedHttpClient -> Text -> Text -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> Text -> Text -> m [Text]
searchProjectReleases AuthenticatedHttpClient
authHTTPClient Text
handle Text
proj Text
branch
    [Text
handle, Text
proj, Text
contributor, Text
branch] ->
      AuthenticatedHttpClient
-> Text -> Text -> Maybe Text -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient
-> Text -> Text -> Maybe Text -> Text -> m [Text]
searchProjectBranches AuthenticatedHttpClient
authHTTPClient Text
handle Text
proj (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
contributor) Text
branch
    [Text]
_ ->
      AuthenticatedHttpClient -> Text -> m [Text]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> m [Text]
completeShareProjectHelper AuthenticatedHttpClient
authHTTPClient Text
query
        m [Text] -> ([Text] -> [Text]) -> m [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
ensureTrailingSlash

-- | Search share for branches within the provided handle and project
searchProjectBranches ::
  (MonadIO m) =>
  AuthenticatedHttpClient ->
  Text ->
  Text ->
  Maybe Text ->
  Text ->
  m [Text]
searchProjectBranches :: forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient
-> Text -> Text -> Maybe Text -> Text -> m [Text]
searchProjectBranches (AuthenticatedHttpClient Manager
httpManager) Text
handle Text
proj Maybe Text
contributor Text
query = do
  [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> m (Maybe [Text]) -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m [Text] -> m (Maybe [Text])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    let (Text
searchKind, Text
contributorFilter) = case Maybe Text
contributor of
          Just Text
contributor -> (Text
"contributor", Text
"&contributor-handle=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contributor)
          Maybe Text
Nothing -> (Text
"core", Text
"")
    let cleanedHandle :: Text
cleanedHandle = (Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@') Text
handle
    let uri :: URI
uri =
          (CodeserverURI -> URI
Share.codeserverToURI CodeserverURI
Codeserver.defaultCodeserver)
            { URI.uriPath = "/users/" <> Text.unpack cleanedHandle <> "/projects/" <> Text.unpack proj <> "/branches",
              URI.uriQuery = Text.unpack $ "?name-prefix=" <> query <> "&kind=" <> searchKind <> contributorFilter
            }
    Request
req <- m (Maybe Request) -> MaybeT m Request
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Request) -> MaybeT m Request)
-> m (Maybe Request) -> MaybeT m Request
forall a b. (a -> b) -> a -> b
$ Maybe Request -> m (Maybe Request)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URI -> Maybe Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
HTTP.requestFromURI URI
uri)
    let req' :: Request
req' = Request
req {HTTP.responseTimeout = HTTP.responseTimeoutMicro 5000000} -- 5 seconds
    -- Set a timeout on the request
    Either SomeException (Response ByteString)
fullResp <- IO (Either SomeException (Response ByteString))
-> MaybeT m (Either SomeException (Response ByteString))
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException (Response ByteString))
 -> MaybeT m (Either SomeException (Response ByteString)))
-> IO (Either SomeException (Response ByteString))
-> MaybeT m (Either SomeException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
UnliftIO.tryAny (IO (Response ByteString)
 -> IO (Either SomeException (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
req' Manager
httpManager
    Response ByteString
resp <- (SomeException -> MaybeT m (Response ByteString))
-> (Response ByteString -> MaybeT m (Response ByteString))
-> Either SomeException (Response ByteString)
-> MaybeT m (Response ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MaybeT m (Response ByteString)
-> SomeException -> MaybeT m (Response ByteString)
forall a b. a -> b -> a
const MaybeT m (Response ByteString)
forall a. MaybeT m a
forall (f :: * -> *) a. Alternative f => f a
empty) Response ByteString -> MaybeT m (Response ByteString)
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Response ByteString)
 -> MaybeT m (Response ByteString))
-> Either SomeException (Response ByteString)
-> MaybeT m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Either SomeException (Response ByteString)
fullResp
    (m (Maybe (PagedResponse BranchResult))
-> MaybeT m (PagedResponse BranchResult)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (PagedResponse BranchResult))
 -> MaybeT m (PagedResponse BranchResult))
-> (ByteString -> m (Maybe (PagedResponse BranchResult)))
-> ByteString
-> MaybeT m (PagedResponse BranchResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (PagedResponse BranchResult)
-> m (Maybe (PagedResponse BranchResult))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PagedResponse BranchResult)
 -> m (Maybe (PagedResponse BranchResult)))
-> (ByteString -> Maybe (PagedResponse BranchResult))
-> ByteString
-> m (Maybe (PagedResponse BranchResult))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode @(PagedResponse BranchResult) (ByteString -> MaybeT m (PagedResponse BranchResult))
-> ByteString -> MaybeT m (PagedResponse BranchResult)
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
HTTP.responseBody Response ByteString
resp)
      MaybeT m (PagedResponse BranchResult)
-> (PagedResponse BranchResult -> [Text]) -> MaybeT m [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(PagedResponse {[BranchResult]
items :: [BranchResult]
$sel:items:PagedResponse :: forall a. PagedResponse a -> [a]
items}) ->
        [BranchResult]
items [BranchResult] -> (BranchResult -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \BranchResult {Text
branchRef :: Text
$sel:branchRef:BranchResult :: BranchResult -> Text
branchRef, Text
projectSlug :: Text
$sel:projectSlug:BranchResult :: BranchResult -> Text
projectSlug, Text
projectOwnerHandle :: Text
$sel:projectOwnerHandle:BranchResult :: BranchResult -> Text
projectOwnerHandle} ->
          Text
projectOwnerHandle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
projectSlug Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branchRef

-- | Search share for releases within the provided handle and project
searchProjectReleases ::
  (MonadIO m) =>
  AuthenticatedHttpClient ->
  Text ->
  Text ->
  Text ->
  m [Text]
searchProjectReleases :: forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> Text -> Text -> Text -> m [Text]
searchProjectReleases (AuthenticatedHttpClient Manager
httpManager) Text
handle Text
proj Text
query = do
  [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> m (Maybe [Text]) -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m [Text] -> m (Maybe [Text])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    let cleanedHandle :: Text
cleanedHandle = (Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@') Text
handle
    let uri :: URI
uri =
          (CodeserverURI -> URI
Share.codeserverToURI CodeserverURI
Codeserver.defaultCodeserver)
            { URI.uriPath = "/users/" <> Text.unpack cleanedHandle <> "/projects/" <> Text.unpack proj <> "/releases",
              URI.uriQuery = Text.unpack $ "?version-prefix=" <> query
            }
    Request
req <- m (Maybe Request) -> MaybeT m Request
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Request) -> MaybeT m Request)
-> m (Maybe Request) -> MaybeT m Request
forall a b. (a -> b) -> a -> b
$ Maybe Request -> m (Maybe Request)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URI -> Maybe Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
HTTP.requestFromURI URI
uri)
    let req' :: Request
req' = Request
req {HTTP.responseTimeout = HTTP.responseTimeoutMicro 5000000} -- 5 seconds
    -- Set a timeout on the request
    Either SomeException (Response ByteString)
fullResp <- IO (Either SomeException (Response ByteString))
-> MaybeT m (Either SomeException (Response ByteString))
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException (Response ByteString))
 -> MaybeT m (Either SomeException (Response ByteString)))
-> IO (Either SomeException (Response ByteString))
-> MaybeT m (Either SomeException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
UnliftIO.tryAny (IO (Response ByteString)
 -> IO (Either SomeException (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
req' Manager
httpManager
    Response ByteString
resp <- (SomeException -> MaybeT m (Response ByteString))
-> (Response ByteString -> MaybeT m (Response ByteString))
-> Either SomeException (Response ByteString)
-> MaybeT m (Response ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MaybeT m (Response ByteString)
-> SomeException -> MaybeT m (Response ByteString)
forall a b. a -> b -> a
const MaybeT m (Response ByteString)
forall a. MaybeT m a
forall (f :: * -> *) a. Alternative f => f a
empty) Response ByteString -> MaybeT m (Response ByteString)
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Response ByteString)
 -> MaybeT m (Response ByteString))
-> Either SomeException (Response ByteString)
-> MaybeT m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Either SomeException (Response ByteString)
fullResp
    (m (Maybe (PagedResponse ReleaseResult))
-> MaybeT m (PagedResponse ReleaseResult)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe (PagedResponse ReleaseResult))
 -> MaybeT m (PagedResponse ReleaseResult))
-> (ByteString -> m (Maybe (PagedResponse ReleaseResult)))
-> ByteString
-> MaybeT m (PagedResponse ReleaseResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (PagedResponse ReleaseResult)
-> m (Maybe (PagedResponse ReleaseResult))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PagedResponse ReleaseResult)
 -> m (Maybe (PagedResponse ReleaseResult)))
-> (ByteString -> Maybe (PagedResponse ReleaseResult))
-> ByteString
-> m (Maybe (PagedResponse ReleaseResult))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode @(PagedResponse ReleaseResult) (ByteString -> MaybeT m (PagedResponse ReleaseResult))
-> ByteString -> MaybeT m (PagedResponse ReleaseResult)
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
HTTP.responseBody Response ByteString
resp)
      MaybeT m (PagedResponse ReleaseResult)
-> (PagedResponse ReleaseResult -> [Text]) -> MaybeT m [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(PagedResponse {[ReleaseResult]
$sel:items:PagedResponse :: forall a. PagedResponse a -> [a]
items :: [ReleaseResult]
items}) ->
        [ReleaseResult]
items [ReleaseResult] -> (ReleaseResult -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ReleaseResult {Text
projectRef :: Text
$sel:projectRef:ReleaseResult :: ReleaseResult -> Text
projectRef, Text
version :: Text
$sel:version:ReleaseResult :: ReleaseResult -> Text
version} ->
          Text
projectRef Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/releases/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
version

ensureTrailingSlash :: Text -> Text
ensureTrailingSlash :: Text -> Text
ensureTrailingSlash Text
ref =
  case Text -> Text -> Maybe Text
Text.stripSuffix Text
"/" Text
ref of
    Maybe Text
Nothing -> Text
ref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
    Just Text
stripped -> Text
stripped Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"

-- | Search Share for users and projects based on the provided query and search kinds.
runShareOmniSearch :: (MonadIO m) => AuthenticatedHttpClient -> NESet SearchKind -> Text -> Maybe Text -> m [SearchResult]
runShareOmniSearch :: forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient
-> NESet SearchKind -> Text -> Maybe Text -> m [SearchResult]
runShareOmniSearch (AuthenticatedHttpClient Manager
httpManager) NESet SearchKind
kinds Text
query Maybe Text
mayPsk = do
  [SearchResult] -> Maybe [SearchResult] -> [SearchResult]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SearchResult] -> [SearchResult])
-> m (Maybe [SearchResult]) -> m [SearchResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m [SearchResult] -> m (Maybe [SearchResult])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    let uri :: URI
uri =
          (CodeserverURI -> URI
Share.codeserverToURI CodeserverURI
Codeserver.defaultCodeserver)
            { URI.uriPath = "/search",
              URI.uriQuery = Text.unpack $ "?user-search-kind=handle-prefix&kinds=" <> searchKinds <> "&query=" <> query <> psk
            }
    Request
req <- m (Maybe Request) -> MaybeT m Request
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Request) -> MaybeT m Request)
-> m (Maybe Request) -> MaybeT m Request
forall a b. (a -> b) -> a -> b
$ Maybe Request -> m (Maybe Request)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URI -> Maybe Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
HTTP.requestFromURI URI
uri)
    let req' :: Request
req' = Request
req {HTTP.responseTimeout = HTTP.responseTimeoutMicro 5000000} -- 5 seconds
    Either SomeException (Response ByteString)
fullResp <- IO (Either SomeException (Response ByteString))
-> MaybeT m (Either SomeException (Response ByteString))
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException (Response ByteString))
 -> MaybeT m (Either SomeException (Response ByteString)))
-> IO (Either SomeException (Response ByteString))
-> MaybeT m (Either SomeException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
UnliftIO.tryAny (IO (Response ByteString)
 -> IO (Either SomeException (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either SomeException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
req' Manager
httpManager
    Response ByteString
resp <- (SomeException -> MaybeT m (Response ByteString))
-> (Response ByteString -> MaybeT m (Response ByteString))
-> Either SomeException (Response ByteString)
-> MaybeT m (Response ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MaybeT m (Response ByteString)
-> SomeException -> MaybeT m (Response ByteString)
forall a b. a -> b -> a
const MaybeT m (Response ByteString)
forall a. MaybeT m a
forall (f :: * -> *) a. Alternative f => f a
empty) Response ByteString -> MaybeT m (Response ByteString)
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException (Response ByteString)
 -> MaybeT m (Response ByteString))
-> Either SomeException (Response ByteString)
-> MaybeT m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Either SomeException (Response ByteString)
fullResp
    (m (Maybe [SearchResult]) -> MaybeT m [SearchResult]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe [SearchResult]) -> MaybeT m [SearchResult])
-> (ByteString -> m (Maybe [SearchResult]))
-> ByteString
-> MaybeT m [SearchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [SearchResult] -> m (Maybe [SearchResult])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [SearchResult] -> m (Maybe [SearchResult]))
-> (ByteString -> Maybe [SearchResult])
-> ByteString
-> m (Maybe [SearchResult])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode @[SearchResult] (ByteString -> MaybeT m [SearchResult])
-> ByteString -> MaybeT m [SearchResult]
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
HTTP.responseBody Response ByteString
resp)
  where
    psk :: Text
    psk :: Text
psk =
      case Maybe Text
mayPsk of
        Just Text
p -> Text
"&project-search-kind=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
        Maybe Text
Nothing -> Text
""
    searchKinds :: Text
    searchKinds :: Text
searchKinds =
      NESet SearchKind -> [SearchKind]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NESet SearchKind
kinds
        [SearchKind] -> ([SearchKind] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> (SearchKind -> Text) -> [SearchKind] -> Text
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
Monoid.intercalateMap Text
"," \case
          SearchKind
UserKind -> Text
"users"
          SearchKind
ProjectKind -> Text
"projects"

data UserLike = UserLike
  { UserLike -> Text
handle :: Text
  }
  deriving (Int -> UserLike -> String -> String
[UserLike] -> String -> String
UserLike -> String
(Int -> UserLike -> String -> String)
-> (UserLike -> String)
-> ([UserLike] -> String -> String)
-> Show UserLike
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UserLike -> String -> String
showsPrec :: Int -> UserLike -> String -> String
$cshow :: UserLike -> String
show :: UserLike -> String
$cshowList :: [UserLike] -> String -> String
showList :: [UserLike] -> String -> String
Show)

instance FromJSON SearchResult where
  parseJSON :: Value -> Parser SearchResult
parseJSON = String
-> (Object -> Parser SearchResult) -> Value -> Parser SearchResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SearchResultUserLike" \Object
obj -> do
    Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"tag" Parser Text -> (Text -> Parser SearchResult) -> Parser SearchResult
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (Text
"user" :: Text) -> Text -> SearchResult
SearchResultUserLike (Text -> SearchResult) -> Parser Text -> Parser SearchResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"handle")
      Text
"org" -> do
        Object
user <- Object
obj Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"user"
        Text -> SearchResult
SearchResultUserLike (Text -> SearchResult) -> Parser Text -> Parser SearchResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
user Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"handle")
      Text
"project" -> do
        Text
ref <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"projectRef"
        SearchResult -> Parser SearchResult
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchResult -> Parser SearchResult)
-> SearchResult -> Parser SearchResult
forall a b. (a -> b) -> a -> b
$ Text -> SearchResult
SearchResultProject Text
ref
      Text
_ -> String -> Parser SearchResult
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected 'user' or 'org' or 'project' tag"

data SearchResult
  = SearchResultUserLike Text
  | SearchResultProject Text
  deriving (Int -> SearchResult -> String -> String
[SearchResult] -> String -> String
SearchResult -> String
(Int -> SearchResult -> String -> String)
-> (SearchResult -> String)
-> ([SearchResult] -> String -> String)
-> Show SearchResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SearchResult -> String -> String
showsPrec :: Int -> SearchResult -> String -> String
$cshow :: SearchResult -> String
show :: SearchResult -> String
$cshowList :: [SearchResult] -> String -> String
showList :: [SearchResult] -> String -> String
Show)

data PagedResponse a = PagedResponse
  { forall a. PagedResponse a -> [a]
items :: [a]
  }
  deriving (Int -> PagedResponse a -> String -> String
[PagedResponse a] -> String -> String
PagedResponse a -> String
(Int -> PagedResponse a -> String -> String)
-> (PagedResponse a -> String)
-> ([PagedResponse a] -> String -> String)
-> Show (PagedResponse a)
forall a. Show a => Int -> PagedResponse a -> String -> String
forall a. Show a => [PagedResponse a] -> String -> String
forall a. Show a => PagedResponse a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PagedResponse a -> String -> String
showsPrec :: Int -> PagedResponse a -> String -> String
$cshow :: forall a. Show a => PagedResponse a -> String
show :: PagedResponse a -> String
$cshowList :: forall a. Show a => [PagedResponse a] -> String -> String
showList :: [PagedResponse a] -> String -> String
Show)

instance (FromJSON a) => FromJSON (PagedResponse a) where
  parseJSON :: Value -> Parser (PagedResponse a)
parseJSON = String
-> (Object -> Parser (PagedResponse a))
-> Value
-> Parser (PagedResponse a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"PagedResponse" \Object
obj -> do
    [a]
items <- Object
obj Object -> Key -> Parser [a]
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"items"
    PagedResponse a -> Parser (PagedResponse a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PagedResponse a -> Parser (PagedResponse a))
-> PagedResponse a -> Parser (PagedResponse a)
forall a b. (a -> b) -> a -> b
$ [a] -> PagedResponse a
forall a. [a] -> PagedResponse a
PagedResponse [a]
items

data BranchResult = BranchResult
  { BranchResult -> Text
branchRef :: Text,
    BranchResult -> Text
projectSlug :: Text,
    BranchResult -> Text
projectOwnerHandle :: Text
  }
  deriving (Int -> BranchResult -> String -> String
[BranchResult] -> String -> String
BranchResult -> String
(Int -> BranchResult -> String -> String)
-> (BranchResult -> String)
-> ([BranchResult] -> String -> String)
-> Show BranchResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> BranchResult -> String -> String
showsPrec :: Int -> BranchResult -> String -> String
$cshow :: BranchResult -> String
show :: BranchResult -> String
$cshowList :: [BranchResult] -> String -> String
showList :: [BranchResult] -> String -> String
Show)

instance FromJSON BranchResult where
  parseJSON :: Value -> Parser BranchResult
parseJSON = String
-> (Object -> Parser BranchResult) -> Value -> Parser BranchResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"BranchResult" \Object
obj -> do
    Text
branchRef <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"branchRef"
    Object
project <- Object
obj Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"project"
    Text
projectSlug <- Object
project Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"slug"
    Object
owner <- Object
project Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"owner"
    Text
projectOwnerHandle <- Object
owner Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"handle"
    BranchResult -> Parser BranchResult
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchResult -> Parser BranchResult)
-> BranchResult -> Parser BranchResult
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> BranchResult
BranchResult Text
branchRef Text
projectSlug Text
projectOwnerHandle

data ReleaseResult = ReleaseResult
  { ReleaseResult -> Text
projectRef :: Text,
    ReleaseResult -> Text
version :: Text
  }
  deriving (Int -> ReleaseResult -> String -> String
[ReleaseResult] -> String -> String
ReleaseResult -> String
(Int -> ReleaseResult -> String -> String)
-> (ReleaseResult -> String)
-> ([ReleaseResult] -> String -> String)
-> Show ReleaseResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ReleaseResult -> String -> String
showsPrec :: Int -> ReleaseResult -> String -> String
$cshow :: ReleaseResult -> String
show :: ReleaseResult -> String
$cshowList :: [ReleaseResult] -> String -> String
showList :: [ReleaseResult] -> String -> String
Show)

instance FromJSON ReleaseResult where
  parseJSON :: Value -> Parser ReleaseResult
parseJSON = String
-> (Object -> Parser ReleaseResult)
-> Value
-> Parser ReleaseResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ReleaseResult" \Object
obj -> do
    Text
projectRef <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"projectRef"
    Text
version <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"version"
    ReleaseResult -> Parser ReleaseResult
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReleaseResult -> Parser ReleaseResult)
-> ReleaseResult -> Parser ReleaseResult
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ReleaseResult
ReleaseResult Text
projectRef Text
version

filenameCompletion ::
  (MonadIO m) =>
  String ->
  m [Completion]
filenameCompletion :: forall (m :: * -> *). MonadIO m => String -> m [Completion]
filenameCompletion String
query = do
  -- Haskeline uses a zipper-style cursor format, so it expects the prefix to be reversed.
  let prefix :: String
prefix = String -> String
forall a. [a] -> [a]
reverse String
query
  (String
_leftovers, [Completion]
results) <- CompletionFunc m
forall (m :: * -> *). MonadIO m => CompletionFunc m
Line.completeFilename (String
prefix, String
"")
  [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Completion]
results