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

module Unison.CommandLine
  ( ParseFailure (..),
    ExpansionFailure (..),
    FZFResolveFailure (..),
    allow,
    parseInput,
    prompt,
    reportParseFailure,
    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.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
import Data.Map qualified as Map
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Vector qualified as Vector
import System.FilePath (takeFileName)
import Text.Numeral (defaultInflection)
import Text.Numeral.Language.ENG qualified as Numeral
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.Editor.StructuredArgument (StructuredArgument)
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 IP
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Symbol (Symbol)
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)

data ExpansionFailure
  = TooManyArguments (NonEmpty InputPattern.Argument)
  | UnexpectedStructuredArgument StructuredArgument

-- | Expanding numbers is a bit complicated. Each `Parameter` expects either structured or “unstructured” arguments. So
--   we iterate over the parameters, if it doesn’t want structured, we just preserve the string. If it does want
--   structured, we have to expand the argument, which may result in /multiple/ structured arguments. We take the first
--   one for the param and pass the rest along. Now, if the next param wants unstructured, but we’ve already structured
--   it, then we’ve got an error.
expandArguments ::
  NumberedArgs ->
  InputPattern.Parameters ->
  [String] ->
  Either ExpansionFailure (InputPattern.Arguments, InputPattern.Parameters)
expandArguments :: NumberedArgs
-> Parameters
-> [String]
-> Either ExpansionFailure (Arguments, Parameters)
expandArguments NumberedArgs
numberedArgs Parameters
params =
  (NonEmpty Argument -> ExpansionFailure)
-> ((Arguments, Parameters) -> (Arguments, Parameters))
-> Either (NonEmpty Argument) (Arguments, Parameters)
-> Either ExpansionFailure (Arguments, Parameters)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap NonEmpty Argument -> ExpansionFailure
TooManyArguments ((Arguments -> Arguments)
-> (Arguments, Parameters) -> (Arguments, Parameters)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Arguments -> Arguments)
 -> (Arguments, Parameters) -> (Arguments, Parameters))
-> (Arguments -> Arguments)
-> (Arguments, Parameters)
-> (Arguments, Parameters)
forall a b. (a -> b) -> a -> b
$ Arguments -> Arguments
forall a. [a] -> [a]
reverse)
    (Either (NonEmpty Argument) (Arguments, Parameters)
 -> Either ExpansionFailure (Arguments, Parameters))
-> ([String]
    -> Either
         ExpansionFailure
         (Either (NonEmpty Argument) (Arguments, Parameters)))
-> [String]
-> Either ExpansionFailure (Arguments, Parameters)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Arguments
 -> Parameter
 -> Argument
 -> Either ExpansionFailure (Arguments, Arguments))
-> Arguments
-> Parameters
-> Arguments
-> Either
     ExpansionFailure
     (Either (NonEmpty Argument) (Arguments, Parameters))
forall (m :: * -> *) state arg.
Monad m =>
(state -> Parameter -> arg -> m (state, [arg]))
-> state
-> Parameters
-> [arg]
-> m (Either (NonEmpty arg) (state, Parameters))
InputPattern.foldParamsWithM
      ( \Arguments
acc (Text
_, ParameterType
param) Argument
arg ->
          if ParameterType -> Bool
InputPattern.isStructured ParameterType
param
            then
              (Arguments, Arguments)
-> Either ExpansionFailure (Arguments, Arguments)
forall a. a -> Either ExpansionFailure a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Arguments, Arguments)
 -> Either ExpansionFailure (Arguments, Arguments))
-> (Arguments, Arguments)
-> Either ExpansionFailure (Arguments, Arguments)
forall a b. (a -> b) -> a -> b
$
                (String -> (Arguments, Arguments))
-> (StructuredArgument -> (Arguments, Arguments))
-> Argument
-> (Arguments, Arguments)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                  ( (Arguments, Arguments)
-> (NumberedArgs -> (Arguments, Arguments))
-> Maybe NumberedArgs
-> (Arguments, Arguments)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Argument
arg Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
acc, []) ((Arguments, Arguments)
-> (NonEmpty Argument -> (Arguments, Arguments))
-> Maybe (NonEmpty Argument)
-> (Arguments, Arguments)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Arguments
acc, []) (\(Argument
h :| Arguments
t) -> (Argument
h Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
acc, Arguments
t)) (Maybe (NonEmpty Argument) -> (Arguments, Arguments))
-> (NumberedArgs -> Maybe (NonEmpty Argument))
-> NumberedArgs
-> (Arguments, Arguments)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments -> Maybe (NonEmpty Argument)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (Arguments -> Maybe (NonEmpty Argument))
-> (NumberedArgs -> Arguments)
-> NumberedArgs
-> Maybe (NonEmpty Argument)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructuredArgument -> Argument) -> NumberedArgs -> Arguments
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructuredArgument -> Argument
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
                      (Maybe NumberedArgs -> (Arguments, Arguments))
-> (String -> Maybe NumberedArgs)
-> String
-> (Arguments, Arguments)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumberedArgs -> String -> Maybe NumberedArgs
expandNumber NumberedArgs
numberedArgs
                  )
                  ((,[]) (Arguments -> (Arguments, Arguments))
-> (StructuredArgument -> Arguments)
-> StructuredArgument
-> (Arguments, Arguments)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
acc) (Argument -> Arguments)
-> (StructuredArgument -> Argument)
-> StructuredArgument
-> Arguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredArgument -> Argument
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
                  Argument
arg
            else (,[]) (Arguments -> (Arguments, Arguments))
-> (Argument -> Arguments) -> Argument -> (Arguments, Arguments)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
acc) (Argument -> (Arguments, Arguments))
-> Either ExpansionFailure Argument
-> Either ExpansionFailure (Arguments, Arguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Either ExpansionFailure Argument)
-> (StructuredArgument -> Either ExpansionFailure Argument)
-> Argument
-> Either ExpansionFailure Argument
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Argument -> Either ExpansionFailure Argument
forall a. a -> Either ExpansionFailure a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Argument -> Either ExpansionFailure Argument)
-> (String -> Argument)
-> String
-> Either ExpansionFailure Argument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Argument
forall a b. a -> Either a b
Left) (ExpansionFailure -> Either ExpansionFailure Argument
forall a b. a -> Either a b
Left (ExpansionFailure -> Either ExpansionFailure Argument)
-> (StructuredArgument -> ExpansionFailure)
-> StructuredArgument
-> Either ExpansionFailure Argument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructuredArgument -> ExpansionFailure
UnexpectedStructuredArgument) Argument
arg
      )
      []
      Parameters
params
    (Arguments
 -> Either
      ExpansionFailure
      (Either (NonEmpty Argument) (Arguments, Parameters)))
-> ([String] -> Arguments)
-> [String]
-> Either
     ExpansionFailure
     (Either (NonEmpty Argument) (Arguments, Parameters))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Argument) -> [String] -> Arguments
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Argument
forall a b. a -> Either a b
Left

data ParseFailure
  = NoCommand
  | UnknownCommand String
  | ExpansionFailure String InputPattern ExpansionFailure
  | FZFResolveFailure InputPattern FZFResolveFailure
  | SubParseFailure String InputPattern (P.Pretty P.ColorText)

-- |
--
--  __TODO__: Move this closer to `main`, but right now it’s shared by @ucm@ and @transcripts@, so this is the closest
--            we can get without duplicating it.
reportParseFailure :: ParseFailure -> P.Pretty P.ColorText
reportParseFailure :: ParseFailure -> Pretty ColorText
reportParseFailure = \case
  ParseFailure
NoCommand -> Pretty ColorText
""
  UnknownCommand String
command ->
    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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
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
IP.makeExample' InputPattern
IP.help
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"or `?` to get help."
  ExpansionFailure String
command pat :: InputPattern
pat@InputPattern {Parameters
params :: Parameters
$sel:params:InputPattern :: InputPattern -> Parameters
params} ExpansionFailure
ef -> case ExpansionFailure
ef of
    TooManyArguments NonEmpty Argument
extraArgs ->
      let showNum :: a -> Text
showNum a
n = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (a -> Text
forall a. Show a => a -> Text
tShow a
n) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Inflection -> a -> Maybe Text
forall a. Integral a => Inflection -> a -> Maybe Text
Numeral.us_cardinal Inflection
defaultInflection a
n
       in String -> InputPattern -> Pretty ColorText -> Pretty ColorText
wrapFailure String
command InputPattern
pat
            (Pretty ColorText -> Pretty ColorText)
-> (Maybe Int -> Pretty ColorText) -> Maybe Int -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text
            (Text -> Pretty ColorText)
-> (Maybe Int -> Text) -> Maybe Int -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              ( Text
"Internal error: fuzzy finder complained that there are "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall {a}. (Integral a, Show a) => a -> Text
showNum (NonEmpty Argument -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Argument
extraArgs)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" too many arguments provided, but the command apparently allows an unbounded number of arguments."
              )
              ( \Int
maxCount ->
                  let foundCount :: Text
foundCount = Int -> Text
forall {a}. (Integral a, Show a) => a -> Text
showNum (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
maxCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ NonEmpty Argument -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Argument
extraArgs
                   in case Int
maxCount of
                        Int
0 -> Text
"I expected no arguments, but received " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
foundCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                        Int
_ -> Text
"I expected no more than " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall {a}. (Integral a, Show a) => a -> Text
showNum Int
maxCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" arguments, but received " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
foundCount Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
              )
            (Maybe Int -> Pretty ColorText) -> Maybe Int -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Parameters -> Maybe Int
InputPattern.maxArgs Parameters
params
    UnexpectedStructuredArgument StructuredArgument
_arg -> Pretty ColorText
"Internal error: Expected a String, but got a structured argument instead."
  FZFResolveFailure InputPattern
pat FZFResolveFailure
frf -> case FZFResolveFailure
frf of
    NoFZFResolverForArgumentType Text
_argDesc -> InputPattern -> Pretty ColorText
InputPattern.help InputPattern
pat
    NoFZFOptions Text
argDesc ->
      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty ColorText
"⚠️" (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
        Pretty ColorText
"Sorry, I was expecting an argument for the " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text Text
argDesc Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
", and I couldn't find any to suggest to you. 😅"
  SubParseFailure String
command InputPattern
pat Pretty ColorText
msg -> String -> InputPattern -> Pretty ColorText -> Pretty ColorText
wrapFailure String
command InputPattern
pat Pretty ColorText
msg
  where
    wrapFailure :: String -> InputPattern -> Pretty ColorText -> Pretty ColorText
wrapFailure String
command InputPattern
pat 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 (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ 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
"",
            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 s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
              Pretty ColorText
"You can run"
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
IP.makeExample InputPattern
IP.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
IP.makeExampleEOS InputPattern
pat []
          ]

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 ParseFailure (Maybe (InputPattern.Arguments, Input)))
parseInput :: Codebase IO Symbol Ann
-> ProjectPath
-> IO (Branch IO)
-> NumberedArgs
-> Map String InputPattern
-> [String]
-> IO (Either ParseFailure (Maybe (Arguments, Input)))
parseInput Codebase IO Symbol Ann
codebase ProjectPath
projPath IO (Branch IO)
currentProjectRoot NumberedArgs
numberedArgs Map String InputPattern
patterns [String]
segments = ExceptT ParseFailure IO (Maybe (Arguments, Input))
-> IO (Either ParseFailure (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
    [] -> ParseFailure -> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE ParseFailure
NoCommand
    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 {Parameters
$sel:params:InputPattern :: InputPattern -> Parameters
params :: Parameters
params, Arguments -> Either (Pretty ColorText) Input
parse :: Arguments -> Either (Pretty ColorText) Input
$sel:parse:InputPattern :: InputPattern -> Arguments -> Either (Pretty ColorText) Input
parse}) -> do
        (Arguments
expandedArgs, Parameters
remainingParams) <-
          Either ParseFailure (Arguments, Parameters)
-> ExceptT ParseFailure IO (Arguments, Parameters)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either ParseFailure (Arguments, Parameters)
 -> ExceptT ParseFailure IO (Arguments, Parameters))
-> (Either ExpansionFailure (Arguments, Parameters)
    -> Either ParseFailure (Arguments, Parameters))
-> Either ExpansionFailure (Arguments, Parameters)
-> ExceptT ParseFailure IO (Arguments, Parameters)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExpansionFailure -> ParseFailure)
-> Either ExpansionFailure (Arguments, Parameters)
-> Either ParseFailure (Arguments, Parameters)
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 (String -> InputPattern -> ExpansionFailure -> ParseFailure
ExpansionFailure String
command InputPattern
pat) (Either ExpansionFailure (Arguments, Parameters)
 -> ExceptT ParseFailure IO (Arguments, Parameters))
-> Either ExpansionFailure (Arguments, Parameters)
-> ExceptT ParseFailure IO (Arguments, Parameters)
forall a b. (a -> b) -> a -> b
$ NumberedArgs
-> Parameters
-> [String]
-> Either ExpansionFailure (Arguments, Parameters)
expandArguments NumberedArgs
numberedArgs Parameters
params [String]
args
        IO (Either FZFResolveFailure (Maybe Arguments))
-> ExceptT
     ParseFailure IO (Either FZFResolveFailure (Maybe Arguments))
forall (m :: * -> *) a. Monad m => m a -> ExceptT ParseFailure m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Codebase IO Symbol Ann
-> ProjectPath
-> IO (Branch0 IO)
-> Parameters
-> IO (Either FZFResolveFailure (Maybe Arguments))
fzfResolve Codebase IO Symbol Ann
codebase ProjectPath
projPath IO (Branch0 IO)
getCurrentBranch0 Parameters
remainingParams)
          ExceptT
  ParseFailure IO (Either FZFResolveFailure (Maybe Arguments))
-> (Either FZFResolveFailure (Maybe Arguments)
    -> ExceptT ParseFailure IO (Maybe (Arguments, Input)))
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall a b.
ExceptT ParseFailure IO a
-> (a -> ExceptT ParseFailure IO b) -> ExceptT ParseFailure IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FZFResolveFailure
 -> ExceptT ParseFailure IO (Maybe (Arguments, Input)))
-> (Maybe Arguments
    -> ExceptT ParseFailure IO (Maybe (Arguments, Input)))
-> Either FZFResolveFailure (Maybe Arguments)
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            (ParseFailure -> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ParseFailure
 -> ExceptT ParseFailure IO (Maybe (Arguments, Input)))
-> (FZFResolveFailure -> ParseFailure)
-> FZFResolveFailure
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPattern -> FZFResolveFailure -> ParseFailure
FZFResolveFailure InputPattern
pat)
            ( (Arguments -> ExceptT ParseFailure IO (Arguments, Input))
-> Maybe Arguments
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
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) -> Maybe a -> f (Maybe b)
traverse \Arguments
resolvedArgs ->
                let allArgs :: Arguments
allArgs = Arguments
expandedArgs Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<> Arguments
resolvedArgs
                 in Either ParseFailure (Arguments, Input)
-> ExceptT ParseFailure IO (Arguments, Input)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either ParseFailure (Arguments, Input)
 -> ExceptT ParseFailure IO (Arguments, Input))
-> (Either (Pretty ColorText) Input
    -> Either ParseFailure (Arguments, Input))
-> Either (Pretty ColorText) Input
-> ExceptT ParseFailure IO (Arguments, Input)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty ColorText -> ParseFailure)
-> (Input -> (Arguments, Input))
-> Either (Pretty ColorText) Input
-> Either ParseFailure (Arguments, Input)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> InputPattern -> Pretty ColorText -> ParseFailure
SubParseFailure String
command InputPattern
pat) (String -> Argument
forall a b. a -> Either a b
Left String
command Argument -> Arguments -> Arguments
forall a. a -> [a] -> [a]
: Arguments
allArgs,) (Either (Pretty ColorText) Input
 -> ExceptT ParseFailure IO (Arguments, Input))
-> Either (Pretty ColorText) Input
-> ExceptT ParseFailure IO (Arguments, Input)
forall a b. (a -> b) -> a -> b
$ Arguments -> Either (Pretty ColorText) Input
parse Arguments
allArgs
            )
      Maybe InputPattern
Nothing -> ParseFailure -> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ParseFailure
 -> ExceptT ParseFailure IO (Maybe (Arguments, Input)))
-> ParseFailure
-> ExceptT ParseFailure IO (Maybe (Arguments, Input))
forall a b. (a -> b) -> a -> b
$ String -> ParseFailure
UnknownCommand String
command

-- 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 =
  [Maybe StructuredArgument] -> NumberedArgs
forall a. [Maybe a] -> [a]
catMaybes ([Maybe StructuredArgument] -> NumberedArgs)
-> ([Int] -> [Maybe StructuredArgument]) -> [Int] -> NumberedArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Maybe StructuredArgument)
-> [Int] -> [Maybe StructuredArgument]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vector StructuredArgument
vargs Vector StructuredArgument -> Int -> Maybe StructuredArgument
forall a. Vector a -> Int -> Maybe a
Vector.!?) (Int -> Maybe StructuredArgument)
-> (Int -> Int) -> Int -> Maybe StructuredArgument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred) ([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 -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo (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.ParameterDescription
  | NoFZFOptions
      -- | argument description
      Text

fzfResolve ::
  Codebase IO Symbol Ann ->
  PP.ProjectPath ->
  (IO (Branch0 IO)) ->
  InputPattern.Parameters ->
  IO (Either FZFResolveFailure (Maybe InputPattern.Arguments))
fzfResolve :: Codebase IO Symbol Ann
-> ProjectPath
-> IO (Branch0 IO)
-> Parameters
-> IO (Either FZFResolveFailure (Maybe Arguments))
fzfResolve Codebase IO Symbol Ann
codebase ProjectPath
ppCtx IO (Branch0 IO)
getCurrentBranch InputPattern.Parameters {[Parameter]
requiredParams :: [Parameter]
$sel:requiredParams:Parameters :: Parameters -> [Parameter]
requiredParams, TrailingParameters
trailingParams :: TrailingParameters
$sel:trailingParams:Parameters :: Parameters -> TrailingParameters
trailingParams} = ExceptT FZFResolveFailure IO (Maybe Arguments)
-> IO (Either FZFResolveFailure (Maybe Arguments))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT do
  -- We build up a list of `ExceptT` inside an outer `ExceptT` to allow us to fail immediately if /any/ required
  -- argument is missing a resolver, before we start prompting 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.
  [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
argumentResolvers :: [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty InputPattern.Argument)] <-
    ([MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
 -> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
 -> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)])
-> ExceptT
     FZFResolveFailure
     IO
     [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> ExceptT
     FZFResolveFailure
     IO
     [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> ExceptT
     FZFResolveFailure
     IO
     [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a b c.
(a -> b -> c)
-> ExceptT FZFResolveFailure IO a
-> ExceptT FZFResolveFailure IO b
-> ExceptT FZFResolveFailure IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a. Semigroup a => a -> a -> a
(<>) ((Parameter
 -> ExceptT
      FZFResolveFailure
      IO
      (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)))
-> [Parameter]
-> ExceptT
     FZFResolveFailure
     IO
     [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
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 (Bool
-> Parameter
-> ExceptT
     FZFResolveFailure
     IO
     (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall {m :: * -> *}.
MonadError FZFResolveFailure m =>
Bool
-> Parameter
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
maybeFillArg Bool
False) [Parameter]
requiredParams) case TrailingParameters
trailingParams of
      InputPattern.Optional [Parameter]
_ Maybe Parameter
_ -> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> ExceptT
     FZFResolveFailure
     IO
     [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a. a -> ExceptT FZFResolveFailure IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a. Monoid a => a
mempty
      InputPattern.OnePlus Parameter
p -> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
 -> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)])
-> ExceptT
     FZFResolveFailure
     IO
     (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
-> ExceptT
     FZFResolveFailure
     IO
     [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Parameter
-> ExceptT
     FZFResolveFailure
     IO
     (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall {m :: * -> *}.
MonadError FZFResolveFailure m =>
Bool
-> Parameter
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
maybeFillArg Bool
True Parameter
p
  MaybeT (ExceptT FZFResolveFailure IO) Arguments
-> ExceptT FZFResolveFailure IO (Maybe Arguments)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ExceptT FZFResolveFailure IO) Arguments
 -> ExceptT FZFResolveFailure IO (Maybe Arguments))
-> MaybeT (ExceptT FZFResolveFailure IO) Arguments
-> ExceptT FZFResolveFailure IO (Maybe Arguments)
forall a b. (a -> b) -> a -> b
$ (Arguments
 -> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
 -> MaybeT (ExceptT FZFResolveFailure IO) Arguments)
-> Arguments
-> [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
-> MaybeT (ExceptT FZFResolveFailure IO) Arguments
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Arguments
bs -> ((Arguments
bs Arguments -> Arguments -> Arguments
forall a. Semigroup a => a -> a -> a
<>) (Arguments -> Arguments)
-> (NonEmpty Argument -> Arguments)
-> NonEmpty Argument
-> Arguments
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Argument -> Arguments
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Argument -> Arguments)
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
-> MaybeT (ExceptT FZFResolveFailure IO) Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) [] [MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)]
argumentResolvers
  where
    maybeFillArg :: Bool
-> Parameter
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
maybeFillArg Bool
allowMulti (Text
argName, InputPattern.ParameterType {Maybe FZFResolver
fzfResolver :: Maybe FZFResolver
$sel:fzfResolver:ParameterType :: ParameterType -> Maybe FZFResolver
fzfResolver}) =
      m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
-> (FZFResolver
    -> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)))
-> Maybe FZFResolver
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (FZFResolveFailure
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall a. FZFResolveFailure -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FZFResolveFailure
 -> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)))
-> FZFResolveFailure
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall a b. (a -> b) -> a -> b
$ Text -> FZFResolveFailure
NoFZFResolverForArgumentType Text
argName)
        (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
 -> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)))
-> (FZFResolver
    -> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
-> FZFResolver
-> m (MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> Text
-> FZFResolver
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
fuzzyFillArg Bool
allowMulti Text
argName)
        Maybe FZFResolver
fzfResolver
    fuzzyFillArg ::
      Bool -> Text -> InputPattern.FZFResolver -> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty InputPattern.Argument)
    fuzzyFillArg :: Bool
-> Text
-> FZFResolver
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
fuzzyFillArg Bool
allowMulti Text
argDesc InputPattern.FZFResolver {OptionFetcher
getOptions :: OptionFetcher
$sel:getOptions:FZFResolver :: FZFResolver -> OptionFetcher
getOptions} = ExceptT FZFResolveFailure IO (Maybe (NonEmpty Argument))
-> MaybeT (ExceptT FZFResolveFailure IO) (NonEmpty Argument)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT 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 ())
-> (FZFResolveFailure -> ExceptT FZFResolveFailure IO ())
-> FZFResolveFailure
-> ExceptT FZFResolveFailure IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
      Maybe [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 = allowMulti} Text -> Text
forall a. a -> a
id [Text]
options)
      -- If the user triggered the fuzzy finder, but selected nothing, abort the command rather than continuing
      -- execution with no arguments.
      pure $ (NonEmpty Text -> NonEmpty Argument)
-> Maybe (NonEmpty Text) -> Maybe (NonEmpty Argument)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Argument
forall a b. a -> Either a b
Left (String -> Argument) -> (Text -> String) -> Text -> Argument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Argument) -> NonEmpty Text -> NonEmpty Argument
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (NonEmpty Text) -> Maybe (NonEmpty Argument))
-> ([Text] -> Maybe (NonEmpty Text))
-> [Text]
-> Maybe (NonEmpty Argument)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Text] -> Maybe (NonEmpty Argument))
-> Maybe [Text] -> Maybe (NonEmpty Argument)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [Text]
results

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