{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}

module Unison.CommandLine
  ( allow,
    parseInput,
    prompt,
    watchFileSystem,
  )
where

import Control.Concurrent (forkIO, killThread)
import Control.Lens hiding (aside)
import Control.Monad.Except
import Control.Monad.Trans.Except
import Data.List (isPrefixOf, isSuffixOf)
import Data.Map qualified as Map
import Data.Semialign qualified as Align
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.These (These (..))
import Data.Vector qualified as Vector
import System.FilePath (takeFileName)
import Text.Regex.TDFA ((=~))
import Unison.Codebase (Codebase)
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Editor.Input (Event (..), Input (..))
import Unison.Codebase.Editor.Output (NumberedArgs)
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.Watch qualified as Watch
import Unison.CommandLine.FZFResolvers qualified as FZFResolvers
import Unison.CommandLine.FuzzySelect qualified as Fuzzy
import Unison.CommandLine.Helpers (warn)
import Unison.CommandLine.InputPattern (InputPattern (..))
import Unison.CommandLine.InputPattern qualified as InputPattern
import Unison.CommandLine.InputPatterns qualified as IPs
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Symbol (Symbol)
import Unison.Util.ColorText qualified as CT
import Unison.Util.Monoid (foldMapM)
import Unison.Util.Pretty qualified as P
import Unison.Util.TQueue qualified as Q
import UnliftIO.STM
import Prelude hiding (readFile, writeFile)

allow :: FilePath -> Bool
allow :: String -> Bool
allow String
p =
  -- ignore Emacs .# prefixed files, see https://github.com/unisonweb/unison/issues/457
  Bool -> Bool
not (String
".#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String -> String
takeFileName String
p)
    Bool -> Bool -> Bool
&& (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".u" String
p Bool -> Bool -> Bool
|| String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
".uu" String
p)

watchFileSystem :: Q.TQueue Event -> FilePath -> IO (IO ())
watchFileSystem :: TQueue Event -> String -> IO (IO ())
watchFileSystem TQueue Event
q String
dir = do
  (IO ()
cancel, IO (String, Text)
watcher) <- String -> (String -> Bool) -> IO (IO (), IO (String, Text))
forall (m :: * -> *).
MonadIO m =>
String -> (String -> Bool) -> m (IO (), IO (String, Text))
Watch.watchDirectory String
dir String -> Bool
allow
  ThreadId
t <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> (IO () -> IO ()) -> IO () -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
    (String
filePath, Text
text) <- IO (String, Text)
watcher
    STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> (Event -> STM ()) -> Event -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TQueue Event -> Event -> STM ()
forall a. TQueue a -> a -> STM ()
Q.enqueue TQueue Event
q (Event -> IO ()) -> Event -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Event
UnisonFileChanged (String -> Text
Text.pack String
filePath) Text
text
  pure (IO ()
cancel IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ThreadId -> IO ()
killThread ThreadId
t)

parseInput ::
  Codebase IO Symbol Ann ->
  -- | Current location
  PP.ProjectPath ->
  IO (Branch.Branch IO) ->
  -- | Numbered arguments
  NumberedArgs ->
  -- | Input Pattern Map
  Map String InputPattern ->
  -- | command:arguments
  [String] ->
  -- Returns either an error message or the fully expanded arguments list and parsed input.
  -- If the output is `Nothing`, the user cancelled the input (e.g. ctrl-c)
  IO (Either (P.Pretty CT.ColorText) (Maybe (InputPattern.Arguments, Input)))
parseInput :: Codebase IO Symbol Ann
-> ProjectPath
-> IO (Branch IO)
-> NumberedArgs
-> Map String InputPattern
-> [String]
-> IO (Either (Pretty ColorText) (Maybe (Arguments, Input)))
parseInput Codebase IO Symbol Ann
codebase ProjectPath
projPath IO (Branch IO)
currentProjectRoot NumberedArgs
numberedArgs Map String InputPattern
patterns [String]
segments = ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input))
-> IO (Either (Pretty ColorText) (Maybe (Arguments, Input)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  let getCurrentBranch0 :: IO (Branch0 IO)
      getCurrentBranch0 :: IO (Branch0 IO)
getCurrentBranch0 = do
        Branch IO
projRoot <- IO (Branch IO)
currentProjectRoot
        Branch0 IO -> IO (Branch0 IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch0 IO -> IO (Branch0 IO))
-> (Branch IO -> Branch0 IO) -> Branch IO -> IO (Branch0 IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head (Branch IO -> IO (Branch0 IO)) -> Branch IO -> IO (Branch0 IO)
forall a b. (a -> b) -> a -> b
$ Path -> Branch IO -> Branch IO
forall (m :: * -> *). Path -> Branch m -> Branch m
Branch.getAt' (ProjectPath
projPath ProjectPath -> Getting Path ProjectPath Path -> Path
forall s a. s -> Getting a s a -> a
^. Getting Path ProjectPath Path
forall p b (f :: * -> *).
Functor f =>
(Path -> f Path) -> ProjectPathG p b -> f (ProjectPathG p b)
PP.path_) Branch IO
projRoot

  case [String]
segments of
    [] -> Pretty ColorText
-> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input))
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE Pretty ColorText
""
    String
command : [String]
args -> case String -> Map String InputPattern -> Maybe InputPattern
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
command Map String InputPattern
patterns of
      Just pat :: InputPattern
pat@(InputPattern {Arguments -> Either (Pretty ColorText) Input
parse :: Arguments -> Either (Pretty ColorText) Input
$sel:parse:InputPattern :: InputPattern -> Arguments -> Either (Pretty ColorText) Input
parse, Pretty ColorText
help :: Pretty ColorText
$sel:help:InputPattern :: InputPattern -> Pretty ColorText
help}) -> do
        let expandedNumbers :: InputPattern.Arguments
            expandedNumbers :: Arguments
expandedNumbers =
              (String -> Arguments) -> [String] -> Arguments
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\String
arg -> Arguments
-> (NumberedArgs -> Arguments) -> Maybe NumberedArgs -> Arguments
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [String -> Either String StructuredArgument
forall a b. a -> Either a b
Left String
arg] ((StructuredArgument -> Either String StructuredArgument)
-> NumberedArgs -> Arguments
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructuredArgument -> Either String StructuredArgument
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Maybe NumberedArgs -> Arguments)
-> Maybe NumberedArgs -> Arguments
forall a b. (a -> b) -> a -> b
$ NumberedArgs -> String -> Maybe NumberedArgs
expandNumber NumberedArgs
numberedArgs String
arg) [String]
args
        IO (Either FZFResolveFailure Arguments)
-> ExceptT
     (Pretty ColorText) IO (Either FZFResolveFailure Arguments)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (Pretty ColorText) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Codebase IO Symbol Ann
-> ProjectPath
-> IO (Branch0 IO)
-> InputPattern
-> Arguments
-> IO (Either FZFResolveFailure Arguments)
fzfResolve Codebase IO Symbol Ann
codebase ProjectPath
projPath IO (Branch0 IO)
getCurrentBranch0 InputPattern
pat Arguments
expandedNumbers) ExceptT (Pretty ColorText) IO (Either FZFResolveFailure Arguments)
-> (Either FZFResolveFailure Arguments
    -> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input)))
-> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input))
forall a b.
ExceptT (Pretty ColorText) IO a
-> (a -> ExceptT (Pretty ColorText) IO b)
-> ExceptT (Pretty ColorText) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left (NoFZFResolverForArgumentType Text
_argDesc) -> Pretty ColorText
-> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input))
forall a. Pretty ColorText -> ExceptT (Pretty ColorText) IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Pretty ColorText
help
          Left (NoFZFOptions Text
argDesc) -> Pretty ColorText
-> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input))
forall a. Pretty ColorText -> ExceptT (Pretty ColorText) IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> Pretty ColorText
forall {s}.
(Item s ~ Char, ListLike s Char, IsString s) =>
Text -> Pretty s
noCompletionsMessage Text
argDesc)
          Left FZFResolveFailure
FZFCancelled -> Maybe (Arguments, Input)
-> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input))
forall a. a -> ExceptT (Pretty ColorText) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Arguments, Input)
forall a. Maybe a
Nothing
          Right Arguments
resolvedArgs -> do
            Input
parsedInput <-
              Either (Pretty ColorText) Input
-> ExceptT (Pretty ColorText) IO Input
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except
                (Either (Pretty ColorText) Input
 -> ExceptT (Pretty ColorText) IO Input)
-> (Either (Pretty ColorText) Input
    -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> ExceptT (Pretty ColorText) IO Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty ColorText -> Pretty ColorText)
-> Either (Pretty ColorText) Input
-> Either (Pretty ColorText) Input
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
                  ( \Pretty ColorText
msg ->
                      Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.warnCallout (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                        Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"Sorry, I wasn’t sure how to process your request:"
                          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
P.newline
                          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
P.newline
                          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 Pretty ColorText
msg
                          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
P.newline
                          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall s. IsString s => Pretty s
P.newline
                          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
                            ( Pretty ColorText
"You can run"
                                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
IPs.makeExample InputPattern
IPs.help [String -> Pretty ColorText
forall a. IsString a => String -> a
fromString String
command]
                                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"for more information on using"
                                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
IPs.makeExampleEOS InputPattern
pat []
                            )
                  )
                (Either (Pretty ColorText) Input
 -> ExceptT (Pretty ColorText) IO Input)
-> Either (Pretty ColorText) Input
-> ExceptT (Pretty ColorText) IO Input
forall a b. (a -> b) -> a -> b
$ Arguments -> Either (Pretty ColorText) Input
parse Arguments
resolvedArgs
            pure $ (Arguments, Input) -> Maybe (Arguments, Input)
forall a. a -> Maybe a
Just (String -> Either String StructuredArgument
forall a b. a -> Either a b
Left String
command Either String StructuredArgument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
resolvedArgs, Input
parsedInput)
      Maybe InputPattern
Nothing ->
        Pretty ColorText
-> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input))
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE
          (Pretty ColorText
 -> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input)))
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
warn
          (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
          (Pretty ColorText
 -> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input)))
-> Pretty ColorText
-> ExceptT (Pretty ColorText) IO (Maybe (Arguments, Input))
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"I don't know how to"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (String -> Pretty ColorText
forall a. IsString a => String -> a
fromString String
command Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"Type"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
IPs.makeExample' InputPattern
IPs.help
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"or `?` to get help."
  where
    noCompletionsMessage :: Text -> Pretty s
noCompletionsMessage Text
argDesc =
      Pretty s -> Pretty s -> Pretty s
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty s
"⚠️" (Pretty s -> Pretty s) -> Pretty s -> Pretty s
forall a b. (a -> b) -> a -> b
$
        [Pretty s] -> Pretty s
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ ( Pretty s
"Sorry, I was expecting an argument for the "
                Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty s
forall s. IsString s => Text -> Pretty s
P.text Text
argDesc
                Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
", and I couldn't find any to suggest to you. 😅"
            )
          ]

-- Expand a numeric argument like `1` or a range like `3-9`
expandNumber :: NumberedArgs -> String -> Maybe NumberedArgs
expandNumber :: NumberedArgs -> String -> Maybe NumberedArgs
expandNumber NumberedArgs
numberedArgs String
s =
  (\[Int]
nums -> [StructuredArgument
arg | Int
i <- [Int]
nums, Just StructuredArgument
arg <- [Vector StructuredArgument
vargs Vector StructuredArgument -> Int -> Maybe StructuredArgument
forall a. Vector a -> Int -> Maybe a
Vector.!? (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]]) ([Int] -> NumberedArgs) -> Maybe [Int] -> Maybe NumberedArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Int]
expandedNumber
  where
    vargs :: Vector StructuredArgument
vargs = NumberedArgs -> Vector StructuredArgument
forall a. [a] -> Vector a
Vector.fromList NumberedArgs
numberedArgs
    rangeRegex :: String
rangeRegex = String
"([0-9]+)-([0-9]+)" :: String
    (String
junk, String
_, String
moreJunk, [String]
ns) =
      String
s String -> String -> (String, String, String, [String])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
rangeRegex :: (String, String, String, [String])
    expandedNumber :: Maybe [Int]
expandedNumber =
      case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay String
s of
        Just Int
i -> [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int
i]
        Maybe Int
Nothing ->
          -- check for a range
          case (String
junk, String
moreJunk, [String]
ns) of
            (String
"", String
"", [String
from, String
to]) ->
              (\Int
x Int
y -> [Int
x .. Int
y]) (Int -> Int -> [Int]) -> Maybe Int -> Maybe (Int -> [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay String
from Maybe (Int -> [Int]) -> Maybe Int -> Maybe [Int]
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay String
to
            (String, String, [String])
_ -> Maybe [Int]
forall a. Maybe a
Nothing

data FZFResolveFailure
  = NoFZFResolverForArgumentType InputPattern.ArgumentDescription
  | NoFZFOptions Text {- argument description -}
  | FZFCancelled

fzfResolve :: Codebase IO Symbol Ann -> PP.ProjectPath -> (IO (Branch0 IO)) -> InputPattern -> InputPattern.Arguments -> IO (Either FZFResolveFailure InputPattern.Arguments)
fzfResolve :: Codebase IO Symbol Ann
-> ProjectPath
-> IO (Branch0 IO)
-> InputPattern
-> Arguments
-> IO (Either FZFResolveFailure Arguments)
fzfResolve Codebase IO Symbol Ann
codebase ProjectPath
ppCtx IO (Branch0 IO)
getCurrentBranch InputPattern
pat Arguments
args = ExceptT FZFResolveFailure IO Arguments
-> IO (Either FZFResolveFailure Arguments)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  -- We resolve args in two steps, first we check that all arguments that will require a fzf
  -- resolver have one, and only if so do we prompt the user to actually do a fuzzy search.
  -- Otherwise, we might ask the user to perform a search only to realize we don't have a resolver
  -- for a later arg.
  [ExceptT FZFResolveFailure IO Arguments]
argumentResolvers :: [ExceptT FZFResolveFailure IO InputPattern.Arguments] <-
    ([(Text, IsOptional, ArgumentType)]
-> Arguments
-> [These
      (Text, IsOptional, ArgumentType)
      (Either String StructuredArgument)]
forall a b. [a] -> [b] -> [These a b]
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
Align.align (InputPattern -> [(Text, IsOptional, ArgumentType)]
InputPattern.args InputPattern
pat) Arguments
args)
      [These
   (Text, IsOptional, ArgumentType)
   (Either String StructuredArgument)]
-> ([These
       (Text, IsOptional, ArgumentType)
       (Either String StructuredArgument)]
    -> ExceptT
         FZFResolveFailure IO [ExceptT FZFResolveFailure IO Arguments])
-> ExceptT
     FZFResolveFailure IO [ExceptT FZFResolveFailure IO Arguments]
forall a b. a -> (a -> b) -> b
& (These
   (Text, IsOptional, ArgumentType) (Either String StructuredArgument)
 -> ExceptT
      FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments))
-> [These
      (Text, IsOptional, ArgumentType)
      (Either String StructuredArgument)]
-> ExceptT
     FZFResolveFailure IO [ExceptT FZFResolveFailure IO Arguments]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse \case
        This (Text
argName, IsOptional
opt, InputPattern.ArgumentType {Maybe FZFResolver
fzfResolver :: Maybe FZFResolver
$sel:fzfResolver:ArgumentType :: ArgumentType -> Maybe FZFResolver
fzfResolver})
          | IsOptional
opt IsOptional -> IsOptional -> Bool
forall a. Eq a => a -> a -> Bool
== IsOptional
InputPattern.Required Bool -> Bool -> Bool
|| IsOptional
opt IsOptional -> IsOptional -> Bool
forall a. Eq a => a -> a -> Bool
== IsOptional
InputPattern.OnePlus ->
              case Maybe FZFResolver
fzfResolver of
                Maybe FZFResolver
Nothing -> FZFResolveFailure
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a. FZFResolveFailure -> ExceptT FZFResolveFailure IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FZFResolveFailure
 -> ExceptT
      FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments))
-> FZFResolveFailure
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a b. (a -> b) -> a -> b
$ Text -> FZFResolveFailure
NoFZFResolverForArgumentType Text
argName
                Just FZFResolver
fzfResolver -> ExceptT FZFResolveFailure IO Arguments
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT FZFResolveFailure IO Arguments
 -> ExceptT
      FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments))
-> ExceptT FZFResolveFailure IO Arguments
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a b. (a -> b) -> a -> b
$ IsOptional
-> Text -> FZFResolver -> ExceptT FZFResolveFailure IO Arguments
fuzzyFillArg IsOptional
opt Text
argName FZFResolver
fzfResolver
          | Bool
otherwise -> ExceptT FZFResolveFailure IO Arguments
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT FZFResolveFailure IO Arguments
 -> ExceptT
      FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments))
-> ExceptT FZFResolveFailure IO Arguments
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a b. (a -> b) -> a -> b
$ Arguments -> ExceptT FZFResolveFailure IO Arguments
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        That Either String StructuredArgument
arg -> ExceptT FZFResolveFailure IO Arguments
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT FZFResolveFailure IO Arguments
 -> ExceptT
      FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments))
-> ExceptT FZFResolveFailure IO Arguments
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a b. (a -> b) -> a -> b
$ Arguments -> ExceptT FZFResolveFailure IO Arguments
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Either String StructuredArgument
arg]
        These (Text, IsOptional, ArgumentType)
_ Either String StructuredArgument
arg -> ExceptT FZFResolveFailure IO Arguments
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExceptT FZFResolveFailure IO Arguments
 -> ExceptT
      FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments))
-> ExceptT FZFResolveFailure IO Arguments
-> ExceptT
     FZFResolveFailure IO (ExceptT FZFResolveFailure IO Arguments)
forall a b. (a -> b) -> a -> b
$ Arguments -> ExceptT FZFResolveFailure IO Arguments
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Either String StructuredArgument
arg]
  [ExceptT FZFResolveFailure IO Arguments]
argumentResolvers [ExceptT FZFResolveFailure IO Arguments]
-> ([ExceptT FZFResolveFailure IO Arguments]
    -> ExceptT FZFResolveFailure IO Arguments)
-> ExceptT FZFResolveFailure IO Arguments
forall a b. a -> (a -> b) -> b
& (ExceptT FZFResolveFailure IO Arguments
 -> ExceptT FZFResolveFailure IO Arguments)
-> [ExceptT FZFResolveFailure IO Arguments]
-> ExceptT FZFResolveFailure IO Arguments
forall (m :: * -> *) (f :: * -> *) b a.
(Monad m, Foldable f, Monoid b) =>
(a -> m b) -> f a -> m b
foldMapM ExceptT FZFResolveFailure IO Arguments
-> ExceptT FZFResolveFailure IO Arguments
forall a. a -> a
id
  where
    fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO InputPattern.Arguments
    fuzzyFillArg :: IsOptional
-> Text -> FZFResolver -> ExceptT FZFResolveFailure IO Arguments
fuzzyFillArg IsOptional
opt Text
argDesc InputPattern.FZFResolver {OptionFetcher
getOptions :: OptionFetcher
$sel:getOptions:FZFResolver :: FZFResolver -> OptionFetcher
getOptions} = do
      Branch0 IO
currentBranch <- Branch0 IO -> Branch0 IO
forall (m :: * -> *). Branch0 m -> Branch0 m
Branch.withoutTransitiveLibs (Branch0 IO -> Branch0 IO)
-> ExceptT FZFResolveFailure IO (Branch0 IO)
-> ExceptT FZFResolveFailure IO (Branch0 IO)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Branch0 IO) -> ExceptT FZFResolveFailure IO (Branch0 IO)
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Branch0 IO)
getCurrentBranch
      [Text]
options <- IO [Text] -> ExceptT FZFResolveFailure IO [Text]
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> ExceptT FZFResolveFailure IO [Text])
-> IO [Text] -> ExceptT FZFResolveFailure IO [Text]
forall a b. (a -> b) -> a -> b
$ OptionFetcher
getOptions Codebase IO Symbol Ann
codebase ProjectPath
ppCtx Branch0 IO
currentBranch
      Bool
-> ExceptT FZFResolveFailure IO ()
-> ExceptT FZFResolveFailure IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
options) (ExceptT FZFResolveFailure IO ()
 -> ExceptT FZFResolveFailure IO ())
-> ExceptT FZFResolveFailure IO ()
-> ExceptT FZFResolveFailure IO ()
forall a b. (a -> b) -> a -> b
$ FZFResolveFailure -> ExceptT FZFResolveFailure IO ()
forall a. FZFResolveFailure -> ExceptT FZFResolveFailure IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FZFResolveFailure -> ExceptT FZFResolveFailure IO ())
-> FZFResolveFailure -> ExceptT FZFResolveFailure IO ()
forall a b. (a -> b) -> a -> b
$ Text -> FZFResolveFailure
NoFZFOptions Text
argDesc
      IO () -> ExceptT FZFResolveFailure IO ()
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT FZFResolveFailure IO ())
-> IO () -> ExceptT FZFResolveFailure IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (Text -> Text
FZFResolvers.fuzzySelectHeader Text
argDesc)
      [Text]
results <-
        IO (Maybe [Text]) -> ExceptT FZFResolveFailure IO (Maybe [Text])
forall a. IO a -> ExceptT FZFResolveFailure IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Options -> (Text -> Text) -> [Text] -> IO (Maybe [Text])
forall a. Options -> (a -> Text) -> [a] -> IO (Maybe [a])
Fuzzy.fuzzySelect Options
Fuzzy.defaultOptions {Fuzzy.allowMultiSelect = multiSelectForOptional opt} Text -> Text
forall a. a -> a
id [Text]
options)
          ExceptT FZFResolveFailure IO (Maybe [Text])
-> ExceptT FZFResolveFailure IO [Text]
-> ExceptT FZFResolveFailure IO [Text]
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`whenNothingM` FZFResolveFailure -> ExceptT FZFResolveFailure IO [Text]
forall a. FZFResolveFailure -> ExceptT FZFResolveFailure IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FZFResolveFailure
FZFCancelled
      -- If the user triggered the fuzzy finder, but selected nothing, abort the command rather than continuing execution
      -- with no arguments.
      if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
results
        then FZFResolveFailure -> ExceptT FZFResolveFailure IO Arguments
forall a. FZFResolveFailure -> ExceptT FZFResolveFailure IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FZFResolveFailure
FZFCancelled
        else Arguments -> ExceptT FZFResolveFailure IO Arguments
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String StructuredArgument
forall a b. a -> Either a b
Left (String -> Either String StructuredArgument)
-> (Text -> String) -> Text -> Either String StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Either String StructuredArgument) -> [Text] -> Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
results)

    multiSelectForOptional :: InputPattern.IsOptional -> Bool
    multiSelectForOptional :: IsOptional -> Bool
multiSelectForOptional = \case
      IsOptional
InputPattern.Required -> Bool
False
      IsOptional
InputPattern.Optional -> Bool
False
      IsOptional
InputPattern.OnePlus -> Bool
True
      IsOptional
InputPattern.ZeroPlus -> Bool
True

prompt :: String
prompt :: String
prompt = String
"> "