-- | This module defines 'InputPattern' values for every supported input command.
module Unison.CommandLine.InputPatterns
  ( -- * Input commands
    add,
    aliasMany,
    aliasTerm,
    aliasType,
    api,
    authLogin,
    back,
    branchEmptyInputPattern,
    branchInputPattern,
    branchRenameInputPattern,
    branchesInputPattern,
    cd,
    clear,
    clone,
    compileScheme,
    createAuthor,
    debugClearWatchCache,
    debugDoctor,
    debugDumpNamespace,
    debugDumpNamespaceSimple,
    debugFileHashes,
    debugFormat,
    debugFuzzyOptions,
    debugLSPFoldRanges,
    debugNameDiff,
    debugNumberedArgs,
    debugTabCompletion,
    debugLspNameCompletion,
    debugTerm,
    debugTermVerbose,
    debugType,
    delete,
    deleteBranch,
    deleteNamespace,
    deleteNamespaceForce,
    deleteProject,
    deleteTerm,
    deleteTermVerbose,
    deleteType,
    deleteTypeVerbose,
    deleteVerbose,
    dependencies,
    dependents,
    diffNamespace,
    display,
    displayTo,
    docToMarkdown,
    docs,
    docsToHtml,
    edit,
    editNamespace,
    execute,
    find,
    findAll,
    findGlobal,
    findIn,
    findInAll,
    findShallow,
    findVerbose,
    findVerboseAll,
    forkLocal,
    help,
    helpTopics,
    history,
    ioTest,
    ioTestAll,
    libInstallInputPattern,
    load,
    makeStandalone,
    mergeBuiltins,
    mergeCommitInputPattern,
    mergeIOBuiltins,
    mergeInputPattern,
    mergeOldInputPattern,
    mergeOldPreviewInputPattern,
    mergeOldSquashInputPattern,
    moveAll,
    names,
    namespaceDependencies,
    previewAdd,
    previewUpdate,
    printVersion,
    projectCreate,
    projectCreateEmptyInputPattern,
    projectRenameInputPattern,
    projectSwitch,
    projectsInputPattern,
    pull,
    pullWithoutHistory,
    push,
    pushCreate,
    pushExhaustive,
    pushForce,
    quit,
    releaseDraft,
    renameBranch,
    renameTerm,
    renameType,
    reset,
    runScheme,
    saveExecuteResult,
    sfind,
    sfindReplace,
    textfind,
    test,
    testAll,
    todo,
    ui,
    undo,
    up,
    update,
    updateBuiltins,
    updateOld,
    updateOldNoPatch,
    upgrade,
    upgradeCommitInputPattern,
    view,
    viewGlobal,
    deprecatedViewRootReflog,
    branchReflog,
    projectReflog,
    globalReflog,

    -- * Misc
    formatStructuredArgument,
    helpFor,
    makeExample',
    makeExample,
    makeExampleEOS,
    makeExampleNoBackticks,
    patternMap,
    patternName,
    showPatternHelp,
    unifyArgument,
    validInputs,
  )
where

import Control.Lens.Cons qualified as Cons
import Data.Bitraversable (bitraverse)
import Data.List (intercalate)
import Data.List.Extra qualified as List
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as Map
import Data.Maybe (fromJust)
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.Char (isSpace)
import Data.These (These (..))
import Network.URI qualified as URI
import System.Console.Haskeline.Completion (Completion (Completion))
import System.Console.Haskeline.Completion qualified as Haskeline
import System.Console.Haskeline.Completion qualified as Line
import Text.Megaparsec qualified as Megaparsec
import Text.Numeral (defaultInflection)
import Text.Numeral.Language.ENG qualified as Numeral
import U.Codebase.HashTags (CausalHash (..))
import U.Codebase.Sqlite.DbId (ProjectBranchId)
import U.Codebase.Sqlite.Project qualified as Sqlite
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
import Unison.Cli.Pretty
  ( prettyPath',
    prettyProjectAndBranchName,
    prettyProjectBranchName,
    prettyProjectName,
    prettyProjectNameSlash,
    prettySlashProjectBranchName,
    prettyURI,
  )
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch.Merge qualified as Branch
import Unison.Codebase.Editor.Input (BranchIdG (..), DeleteOutput (..), DeleteTarget (..), Input)
import Unison.Codebase.Editor.Input qualified as Input
import Unison.Codebase.Editor.Output.PushPull (PushPull (Pull, Push))
import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace)
import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
import Unison.Codebase.Editor.SlurpResult qualified as SR
import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
import Unison.Codebase.Editor.StructuredArgument qualified as SA
import Unison.Codebase.Editor.UriParser (readRemoteNamespaceParser)
import Unison.Codebase.Editor.UriParser qualified as UriParser
import Unison.Codebase.Path (Path, Path')
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Path.Parse qualified as Path
import Unison.Codebase.ProjectPath (ProjectPath)
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.PushBehavior qualified as PushBehavior
import Unison.Codebase.ShortCausalHash (ShortCausalHash)
import Unison.Codebase.ShortCausalHash qualified as SCH
import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..), parseBranchRelativePath, parseIncrementalBranchRelativePath)
import Unison.CommandLine.BranchRelativePath qualified as BranchRelativePath
import Unison.CommandLine.Completion
import Unison.CommandLine.FZFResolvers qualified as Resolvers
import Unison.CommandLine.Helpers (aside, backtick, tip)
import Unison.CommandLine.InputPattern (ArgumentType (..), InputPattern (InputPattern), IsOptional (..), unionSuggestions)
import Unison.CommandLine.InputPattern qualified as I
import Unison.Core.Project (ProjectBranchName (..))
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment
import Unison.Parser.Ann (Ann)
import Unison.Prelude hiding (view)
import Unison.Project
  ( ProjectAndBranch (..),
    ProjectAndBranchNames (..),
    ProjectBranchNameOrLatestRelease (..),
    ProjectBranchSpecifier (..),
    ProjectName,
    Semver,
    branchWithOptionalProjectParser,
  )
import Unison.Referent qualified as Referent
import Unison.Server.Backend (ShallowListEntry (..))
import Unison.Server.Backend qualified as Backend
import Unison.Server.SearchResult (SearchResult)
import Unison.Server.SearchResult qualified as SR
import Unison.ShortHash (ShortHash)
import Unison.Syntax.HashQualified qualified as HQ (parseText, toText)
import Unison.Syntax.Name qualified as Name (parseTextEither, toText)
import Unison.Syntax.NameSegment qualified as NameSegment
import Unison.Util.ColorText qualified as CT
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Pretty qualified as P
import Unison.Util.Pretty.MegaParsec (prettyPrintParseError)

formatStructuredArgument :: Maybe Int -> StructuredArgument -> Text
formatStructuredArgument :: Maybe Int -> StructuredArgument -> Text
formatStructuredArgument Maybe Int
schLength = \case
  SA.AbsolutePath Absolute
path -> forall target source. From source target => source -> target
into @Text (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Absolute -> String
forall a. Show a => a -> String
show Absolute
path
  SA.Name Name
name -> Name -> Text
Name.toText Name
name
  SA.HashQualified HashQualified Name
hqName -> HashQualified Name -> Text
HQ.toText HashQualified Name
hqName
  SA.Project ProjectName
projectName -> forall target source. From source target => source -> target
into @Text ProjectName
projectName
  SA.ProjectBranch (ProjectAndBranch Maybe ProjectName
mproj ProjectBranchName
branch) ->
    (ProjectBranchName -> Text)
-> (ProjectName -> ProjectBranchName -> Text)
-> Maybe ProjectName
-> ProjectBranchName
-> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> Text -> Text
Text.cons Char
'/' (Text -> Text)
-> (ProjectBranchName -> Text) -> ProjectBranchName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @Text) (\ProjectName
project -> forall target source. From source target => source -> target
into @Text (ProjectAndBranch ProjectName ProjectBranchName -> Text)
-> (ProjectBranchName
    -> ProjectAndBranch ProjectName ProjectBranchName)
-> ProjectBranchName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
project) Maybe ProjectName
mproj ProjectBranchName
branch
  -- also: ("#" <>) . Hash.toBase32HexText . unCausalHash
  SA.Namespace CausalHash
causalHash -> (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> (ShortCausalHash -> Text) -> ShortCausalHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortCausalHash -> Text
SCH.toText (ShortCausalHash -> Text) -> ShortCausalHash -> Text
forall a b. (a -> b) -> a -> b
$ (CausalHash -> ShortCausalHash)
-> (Int -> CausalHash -> ShortCausalHash)
-> Maybe Int
-> CausalHash
-> ShortCausalHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CausalHash -> ShortCausalHash
forall h. Coercible h Hash => h -> ShortCausalHash
SCH.fromFullHash Int -> CausalHash -> ShortCausalHash
SCH.fromHash Maybe Int
schLength CausalHash
causalHash
  SA.NameWithBranchPrefix AbsBranchId
absBranchId Name
name -> AbsBranchId -> Name -> Text
prefixBranchId AbsBranchId
absBranchId Name
name
  SA.HashQualifiedWithBranchPrefix AbsBranchId
absBranchId HashQualified Name
hq'Name -> (Name -> Text) -> HashQualified Name -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ'.toTextWith (AbsBranchId -> Name -> Text
prefixBranchId AbsBranchId
absBranchId) HashQualified Name
hq'Name
  SA.ShallowListEntry Path'
path ShallowListEntry Symbol Ann
entry -> Path' -> ShallowListEntry Symbol Ann -> Text
forall v. Path' -> ShallowListEntry v Ann -> Text
entryToHQText Path'
path ShallowListEntry Symbol Ann
entry
  SA.SearchResult Maybe Path'
searchRoot SearchResult
searchResult -> HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text) -> HashQualified Name -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Path' -> SearchResult -> HashQualified Name
searchResultToHQ Maybe Path'
searchRoot SearchResult
searchResult
  where
    -- E.g.
    -- prefixBranchId "#abcdef" "base.List.map" -> "#abcdef:.base.List.map"
    -- prefixBranchId ".base" "List.map" -> ".base.List.map"
    prefixBranchId :: Input.AbsBranchId -> Name -> Text
    prefixBranchId :: AbsBranchId -> Name -> Text
prefixBranchId AbsBranchId
branchId Name
name = case AbsBranchId
branchId of
      BranchAtSCH ShortCausalHash
sch -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ShortCausalHash -> Text
SCH.toText ShortCausalHash
sch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
Name.toText (Name -> Name
Name.makeAbsolute Name
name)
      BranchAtPath Absolute
pathPrefix -> Name -> Text
Name.toText (Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
pathPrefix) Name
name)
      BranchAtProjectPath ProjectPath
pp ->
        ProjectPath
pp
          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
pathPrefix -> Absolute -> Path -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
pathPrefix (Name -> Path
Path.fromName Name
name))
          ProjectPath
-> (ProjectPath -> ProjectPathNames) -> ProjectPathNames
forall a b. a -> (a -> b) -> b
& ProjectPath -> ProjectPathNames
PP.toNames
          ProjectPathNames -> (ProjectPathNames -> Text) -> Text
forall a b. a -> (a -> b) -> b
& forall target source. From source target => source -> target
into @Text

    entryToHQText :: Path' -> ShallowListEntry v Ann -> Text
    entryToHQText :: forall v. Path' -> ShallowListEntry v Ann -> Text
entryToHQText Path'
pathArg =
      Text -> Text
fixup (Text -> Text)
-> (ShallowListEntry v Ann -> Text)
-> ShallowListEntry v Ann
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        ShallowTypeEntry TypeEntry
te -> TypeEntry -> Text
Backend.typeEntryDisplayName TypeEntry
te
        ShallowTermEntry TermEntry v Ann
te -> TermEntry v Ann -> Text
forall v a. TermEntry v a -> Text
Backend.termEntryDisplayName TermEntry v Ann
te
        ShallowBranchEntry NameSegment
ns CausalHash
_ NamespaceStats
_ -> NameSegment -> Text
NameSegment.toEscapedText NameSegment
ns
        ShallowPatchEntry NameSegment
ns -> NameSegment -> Text
NameSegment.toEscapedText NameSegment
ns
      where
        fixup :: Text -> Text
fixup Text
s =
          Text
pathArgStr
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
Text.null Text
pathArgStr Bool -> Bool -> Bool
|| Text -> Text -> Bool
Text.isSuffixOf Text
"." Text
pathArgStr
              then Text
s
              else Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
        pathArgStr :: Text
pathArgStr = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Path' -> String
forall a. Show a => a -> String
show Path'
pathArg

-- | Converts an arbitrary argument to a `String`. This is for cases where the
-- command /should/ accept a structured argument of some type, but currently
-- wants a `String`.
unifyArgument :: I.Argument -> String
unifyArgument :: Argument -> String
unifyArgument = (String -> String)
-> (StructuredArgument -> String) -> Argument -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> String
forall a. a -> a
id (Text -> String
Text.unpack (Text -> String)
-> (StructuredArgument -> Text) -> StructuredArgument -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> StructuredArgument -> Text
formatStructuredArgument Maybe Int
forall a. Maybe a
Nothing)

showPatternHelp :: InputPattern -> P.Pretty CT.ColorText
showPatternHelp :: InputPattern -> Pretty ColorText
showPatternHelp InputPattern
i =
  [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
    [ Pretty ColorText -> Pretty ColorText
P.bold (String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (String -> Pretty ColorText) -> String -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ InputPattern -> String
I.patternName InputPattern
i)
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> String -> Pretty ColorText
forall a. IsString a => String -> a
fromString
          ( if Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ InputPattern -> [String]
I.aliases InputPattern
i
              then String
" (or " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (InputPattern -> [String]
I.aliases InputPattern
i) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
              else String
""
          ),
      InputPattern -> Pretty ColorText
I.help InputPattern
i
    ]

shallowListEntryToHQ' :: ShallowListEntry v Ann -> HQ'.HashQualified Name
shallowListEntryToHQ' :: forall v. ShallowListEntry v Ann -> HashQualified Name
shallowListEntryToHQ' = \case
  ShallowTermEntry TermEntry v Ann
termEntry -> TermEntry v Ann -> HashQualified Name
forall v a. TermEntry v a -> HashQualified Name
Backend.termEntryHQName TermEntry v Ann
termEntry
  ShallowTypeEntry TypeEntry
typeEntry -> TypeEntry -> HashQualified Name
Backend.typeEntryHQName TypeEntry
typeEntry
  ShallowBranchEntry NameSegment
ns CausalHash
_ NamespaceStats
_ -> Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName (Name -> HashQualified Name) -> Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ NameSegment -> Name
Name.fromSegment NameSegment
ns
  ShallowPatchEntry NameSegment
ns -> Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName (Name -> HashQualified Name) -> Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ NameSegment -> Name
Name.fromSegment NameSegment
ns

-- | restores the full hash to these search results, for _numberedArgs purposes
searchResultToHQ :: Maybe Path' -> SearchResult -> HQ.HashQualified Name
searchResultToHQ :: Maybe Path' -> SearchResult -> HashQualified Name
searchResultToHQ Maybe Path'
oprefix = \case
  SR.Tm' HashQualified Name
n Referent
r Set (HashQualified Name)
_ -> HashQualified Name -> Referent -> HashQualified Name
HQ.requalify (Name -> Name
addPrefix (Name -> Name) -> HashQualified Name -> HashQualified Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified Name
n) Referent
r
  SR.Tp' HashQualified Name
n Reference
r Set (HashQualified Name)
_ -> HashQualified Name -> Referent -> HashQualified Name
HQ.requalify (Name -> Name
addPrefix (Name -> Name) -> HashQualified Name -> HashQualified Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified Name
n) (Reference -> Referent
Referent.Ref Reference
r)
  SearchResult
_ -> String -> HashQualified Name
forall a. HasCallStack => String -> a
error String
"impossible match failure"
  where
    addPrefix :: Name -> Name
    addPrefix :: Name -> Name
addPrefix = (Name -> Name)
-> (Path' -> Name -> Name) -> Maybe Path' -> Name -> Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Name -> Name
forall a. a -> a
id Path' -> Name -> Name
Path.prefixNameIfRel Maybe Path'
oprefix

unsupportedStructuredArgument :: InputPattern -> Text -> I.Argument -> Either (P.Pretty CT.ColorText) String
unsupportedStructuredArgument :: InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
command Text
expected =
  (String -> Either (Pretty ColorText) String)
-> (StructuredArgument -> Either (Pretty ColorText) String)
-> Argument
-> Either (Pretty ColorText) String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either (Pretty ColorText) String
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((StructuredArgument -> Either (Pretty ColorText) String)
 -> Argument -> Either (Pretty ColorText) String)
-> (Pretty ColorText
    -> StructuredArgument -> Either (Pretty ColorText) String)
-> Pretty ColorText
-> Argument
-> Either (Pretty ColorText) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Pretty ColorText) String
-> StructuredArgument -> Either (Pretty ColorText) String
forall a b. a -> b -> a
const (Either (Pretty ColorText) String
 -> StructuredArgument -> Either (Pretty ColorText) String)
-> (Pretty ColorText -> Either (Pretty ColorText) String)
-> Pretty ColorText
-> StructuredArgument
-> Either (Pretty ColorText) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Either (Pretty ColorText) String
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) String)
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> Either (Pretty ColorText) String
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 -> Argument -> Either (Pretty ColorText) String)
-> Pretty ColorText -> Argument -> Either (Pretty ColorText) String
forall a b. (a -> b) -> a -> b
$
    InputPattern -> Pretty ColorText
makeExample' InputPattern
command
      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"can’t accept a numbered argument for"
      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
expected
      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"and it’s not yet possible to provide un-expanded numbers as arguments."

expectedButActually' :: Text -> String -> P.Pretty CT.ColorText
expectedButActually' :: Text -> String -> Pretty ColorText
expectedButActually' Text
expected String
actualValue =
  Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text
"I expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but couldn’t recognize “" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
actualValue Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"” as one."

expectedButActually :: Text -> StructuredArgument -> Text -> P.Pretty CT.ColorText
expectedButActually :: Text -> StructuredArgument -> Text -> Pretty ColorText
expectedButActually Text
expected StructuredArgument
actualValue Text
actualType =
  Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
    Text
"I expected "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expected
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", but the numbered argument resulted in “"
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> StructuredArgument -> Text
formatStructuredArgument Maybe Int
forall a. Maybe a
Nothing StructuredArgument
actualValue
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"”, which is "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
actualType
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."

wrongStructuredArgument :: Text -> StructuredArgument -> P.Pretty CT.ColorText
wrongStructuredArgument :: Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
expected StructuredArgument
actual =
  Text -> StructuredArgument -> Text -> Pretty ColorText
expectedButActually
    Text
expected
    StructuredArgument
actual
    case StructuredArgument
actual of
      SA.Name Name
_ -> Text
"a name"
      SA.AbsolutePath Absolute
_ -> Text
"an absolute path"
      SA.Namespace CausalHash
_ -> Text
"a namespace"
      SA.Project ProjectName
_ -> Text
"a project"
      SA.ProjectBranch ProjectAndBranch (Maybe ProjectName) ProjectBranchName
_ -> Text
"a branch"
      SA.HashQualified HashQualified Name
_ -> Text
"a hash-qualified name"
      SA.NameWithBranchPrefix AbsBranchId
_ Name
_ -> Text
"a name"
      SA.HashQualifiedWithBranchPrefix AbsBranchId
_ HashQualified Name
_ -> Text
"a hash-qualified name"
      SA.ShallowListEntry Path'
_ ShallowListEntry Symbol Ann
_ -> Text
"a name"
      SA.SearchResult Maybe Path'
_ SearchResult
_ -> Text
"a search result"

wrongArgsLength :: Text -> [a] -> Either (P.Pretty CT.ColorText) b
wrongArgsLength :: forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
expected [a]
args =
  let foundCount :: Text
foundCount =
        case [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
args of
          Int
0 -> Text
"none"
          Int
n -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Int -> Text
forall a. Show a => a -> Text
tShow Int
n) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Inflection -> Int -> Maybe Text
forall a. Integral a => Inflection -> a -> Maybe Text
Numeral.us_cardinal Inflection
defaultInflection Int
n
   in Pretty ColorText -> Either (Pretty ColorText) b
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) b)
-> (Text -> Pretty ColorText)
-> Text
-> Either (Pretty ColorText) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Either (Pretty ColorText) b)
-> Text -> Either (Pretty ColorText) b
forall a b. (a -> b) -> a -> b
$ Text
"I expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", 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
"."

patternName :: InputPattern -> P.Pretty P.ColorText
patternName :: InputPattern -> Pretty ColorText
patternName = String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (String -> Pretty ColorText)
-> (InputPattern -> String) -> InputPattern -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPattern -> String
I.patternName

-- `example list ["foo", "bar"]` (haskell) becomes `list foo bar` (pretty)
makeExample, makeExampleNoBackticks :: InputPattern -> [P.Pretty CT.ColorText] -> P.Pretty CT.ColorText
makeExample :: InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
p [Pretty ColorText]
args = Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (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. IsString s => Pretty s -> Pretty s
backtick (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleNoBackticks InputPattern
p [Pretty ColorText]
args
makeExampleNoBackticks :: InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleNoBackticks InputPattern
p [Pretty ColorText]
args =
  Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
-> (Pretty ColorText -> Pretty ColorText)
-> [Pretty ColorText]
-> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
" " Pretty ColorText -> Pretty ColorText
forall a. a -> a
id ([Pretty ColorText] -> [Pretty ColorText]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
P.nonEmpty ([Pretty ColorText] -> [Pretty ColorText])
-> [Pretty ColorText] -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$ String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (InputPattern -> String
I.patternName InputPattern
p) Pretty ColorText -> [Pretty ColorText] -> [Pretty ColorText]
forall a. a -> [a] -> [a]
: [Pretty ColorText]
args)

makeExample' :: InputPattern -> P.Pretty CT.ColorText
makeExample' :: InputPattern -> Pretty ColorText
makeExample' InputPattern
p = InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
p []

makeExampleEOS :: InputPattern -> [P.Pretty CT.ColorText] -> P.Pretty CT.ColorText
makeExampleEOS :: InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleEOS InputPattern
p [Pretty ColorText]
args =
  Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
    Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
backtick (Pretty ColorText
-> (Pretty ColorText -> Pretty ColorText)
-> [Pretty ColorText]
-> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
" " Pretty ColorText -> Pretty ColorText
forall a. a -> a
id ([Pretty ColorText] -> [Pretty ColorText]
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> [Pretty s]
P.nonEmpty ([Pretty ColorText] -> [Pretty ColorText])
-> [Pretty ColorText] -> [Pretty ColorText]
forall a b. (a -> b) -> a -> b
$ String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (InputPattern -> String
I.patternName InputPattern
p) Pretty ColorText -> [Pretty ColorText] -> [Pretty ColorText]
forall a. a -> [a] -> [a]
: [Pretty ColorText]
args)) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"."

helpFor :: InputPattern -> P.Pretty CT.ColorText
helpFor :: InputPattern -> Pretty ColorText
helpFor = InputPattern -> Pretty ColorText
I.help

handleProjectArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectName
handleProjectArg :: Argument -> Either (Pretty ColorText) ProjectName
handleProjectArg =
  (String -> Either (Pretty ColorText) ProjectName)
-> (StructuredArgument -> Either (Pretty ColorText) ProjectName)
-> Argument
-> Either (Pretty ColorText) ProjectName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\String
name -> (TryFromException Text ProjectName -> Pretty ColorText)
-> Either (TryFromException Text ProjectName) ProjectName
-> Either (Pretty ColorText) ProjectName
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
-> TryFromException Text ProjectName -> Pretty ColorText
forall a b. a -> b -> a
const (Pretty ColorText
 -> TryFromException Text ProjectName -> Pretty ColorText)
-> Pretty ColorText
-> TryFromException Text ProjectName
-> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text -> String -> Pretty ColorText
expectedButActually' Text
"a project" String
name) (Either (TryFromException Text ProjectName) ProjectName
 -> Either (Pretty ColorText) ProjectName)
-> (Text -> Either (TryFromException Text ProjectName) ProjectName)
-> Text
-> Either (Pretty ColorText) ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @ProjectName (Text -> Either (Pretty ColorText) ProjectName)
-> Text -> Either (Pretty ColorText) ProjectName
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
name)
    \case
      SA.Project ProjectName
project -> ProjectName -> Either (Pretty ColorText) ProjectName
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectName
project
      StructuredArgument
otherArgType -> Pretty ColorText -> Either (Pretty ColorText) ProjectName
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) ProjectName)
-> Pretty ColorText -> Either (Pretty ColorText) ProjectName
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a project" StructuredArgument
otherArgType

handleMaybeProjectBranchArg ::
  I.Argument -> Either (P.Pretty CT.ColorText) (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg :: Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg =
  (String
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> (StructuredArgument
    -> Either
         (Pretty ColorText)
         (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (Parsec
  Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Text
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a. Parsec Void Text a -> Text -> Either (Pretty ColorText) a
megaparse Parsec
  Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
branchWithOptionalProjectParser (Text
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> (String -> Text)
-> String
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack)
    \case
      SA.ProjectBranch ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pb -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pb
      StructuredArgument
otherArgType -> Pretty ColorText
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Pretty ColorText
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a branch" StructuredArgument
otherArgType

handleProjectMaybeBranchArg ::
  I.Argument -> Either (P.Pretty CT.ColorText) (ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease))
handleProjectMaybeBranchArg :: Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
handleProjectMaybeBranchArg =
  (String
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> (StructuredArgument
    -> Either
         (Pretty ColorText)
         (ProjectAndBranch
            ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\String
str -> (TryFromException
   Text
   (ProjectAndBranch
      ProjectName (Maybe ProjectBranchNameOrLatestRelease))
 -> Pretty ColorText)
-> Either
     (TryFromException
        Text
        (ProjectAndBranch
           ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
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
-> TryFromException
     Text
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
-> Pretty ColorText
forall a b. a -> b -> a
const (Pretty ColorText
 -> TryFromException
      Text
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease))
 -> Pretty ColorText)
-> Pretty ColorText
-> TryFromException
     Text
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
-> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text -> String -> Pretty ColorText
expectedButActually' Text
"a project or branch" String
str) (Either
   (TryFromException
      Text
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
   (ProjectAndBranch
      ProjectName (Maybe ProjectBranchNameOrLatestRelease))
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> (Text
    -> Either
         (TryFromException
            Text
            (ProjectAndBranch
               ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
         (ProjectAndBranch
            ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> Text
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either
     (TryFromException
        Text
        (ProjectAndBranch
           ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto (Text
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> Text
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
str)
    \case
      SA.Project ProjectName
proj -> ProjectAndBranch
  ProjectName (Maybe ProjectBranchNameOrLatestRelease)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectAndBranch
   ProjectName (Maybe ProjectBranchNameOrLatestRelease)
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall a b. (a -> b) -> a -> b
$ ProjectName
-> Maybe ProjectBranchNameOrLatestRelease
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
proj Maybe ProjectBranchNameOrLatestRelease
forall a. Maybe a
Nothing
      SA.ProjectBranch (ProjectAndBranch (Just ProjectName
proj) ProjectBranchName
branch) ->
        ProjectAndBranch
  ProjectName (Maybe ProjectBranchNameOrLatestRelease)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectAndBranch
   ProjectName (Maybe ProjectBranchNameOrLatestRelease)
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> (ProjectBranchNameOrLatestRelease
    -> ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease))
-> ProjectBranchNameOrLatestRelease
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectName
-> Maybe ProjectBranchNameOrLatestRelease
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
proj (Maybe ProjectBranchNameOrLatestRelease
 -> ProjectAndBranch
      ProjectName (Maybe ProjectBranchNameOrLatestRelease))
-> (ProjectBranchNameOrLatestRelease
    -> Maybe ProjectBranchNameOrLatestRelease)
-> ProjectBranchNameOrLatestRelease
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectBranchNameOrLatestRelease
-> Maybe ProjectBranchNameOrLatestRelease
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectBranchNameOrLatestRelease
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> ProjectBranchNameOrLatestRelease
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall a b. (a -> b) -> a -> b
$ ProjectBranchName -> ProjectBranchNameOrLatestRelease
ProjectBranchNameOrLatestRelease'Name ProjectBranchName
branch
      StructuredArgument
otherArgType -> Pretty ColorText
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either
      (Pretty ColorText)
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> Pretty ColorText
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a project or branch" StructuredArgument
otherArgType

handleHashQualifiedNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) (HQ.HashQualified Name)
handleHashQualifiedNameArg :: Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg =
  (String -> Either (Pretty ColorText) (HashQualified Name))
-> (StructuredArgument
    -> Either (Pretty ColorText) (HashQualified Name))
-> Argument
-> Either (Pretty ColorText) (HashQualified Name)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    String -> Either (Pretty ColorText) (HashQualified Name)
parseHashQualifiedName
    \case
      SA.Name Name
name -> HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashQualified Name
 -> Either (Pretty ColorText) (HashQualified Name))
-> HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Name
name
      SA.NameWithBranchPrefix AbsBranchId
mprefix Name
name ->
        HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashQualified Name
 -> Either (Pretty ColorText) (HashQualified Name))
-> (Name -> HashQualified Name)
-> Name
-> Either (Pretty ColorText) (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (Name -> Either (Pretty ColorText) (HashQualified Name))
-> Name -> Either (Pretty ColorText) (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ (Absolute -> Name -> Name) -> Name -> AbsBranchId -> Name
forall a b. (a -> b -> b) -> b -> BranchIdG a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Path' -> Name -> Name
Path.prefixNameIfRel (Path' -> Name -> Name)
-> (Absolute -> Path') -> Absolute -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Path'
Path.AbsolutePath') Name
name AbsBranchId
mprefix
      SA.HashQualified HashQualified Name
hqname -> HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashQualified Name
hqname
      SA.HashQualifiedWithBranchPrefix AbsBranchId
mprefix HashQualified Name
hqname ->
        HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashQualified Name
 -> Either (Pretty ColorText) (HashQualified Name))
-> (HashQualified Name -> HashQualified Name)
-> HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (HashQualified Name
 -> Either (Pretty ColorText) (HashQualified Name))
-> HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ (Absolute -> HashQualified Name -> HashQualified Name)
-> HashQualified Name -> AbsBranchId -> HashQualified Name
forall a b. (a -> b -> b) -> b -> BranchIdG a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Absolute
prefix -> (Name -> Name) -> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Name -> Name) -> HashQualified Name -> HashQualified Name)
-> (Name -> Name) -> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix)) HashQualified Name
hqname AbsBranchId
mprefix
      SA.ShallowListEntry Path'
prefix ShallowListEntry Symbol Ann
entry ->
        HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashQualified Name
 -> Either (Pretty ColorText) (HashQualified Name))
-> (HashQualified Name -> HashQualified Name)
-> HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ (HashQualified Name -> HashQualified Name)
-> (HashQualified Name -> HashQualified Name)
-> HashQualified Name
-> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path' -> Name -> Name
Path.prefixNameIfRel Path'
prefix) (HashQualified Name
 -> Either (Pretty ColorText) (HashQualified Name))
-> HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ ShallowListEntry Symbol Ann -> HashQualified Name
forall v. ShallowListEntry v Ann -> HashQualified Name
shallowListEntryToHQ' ShallowListEntry Symbol Ann
entry
      SA.SearchResult Maybe Path'
mpath SearchResult
result -> HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashQualified Name
 -> Either (Pretty ColorText) (HashQualified Name))
-> HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ Maybe Path' -> SearchResult -> HashQualified Name
searchResultToHQ Maybe Path'
mpath SearchResult
result
      StructuredArgument
otherArgType -> Pretty ColorText -> Either (Pretty ColorText) (HashQualified Name)
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either (Pretty ColorText) (HashQualified Name))
-> Pretty ColorText
-> Either (Pretty ColorText) (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a hash-qualified name" StructuredArgument
otherArgType

handlePathArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path
handlePathArg :: Argument -> Either (Pretty ColorText) Path
handlePathArg =
  (String -> Either (Pretty ColorText) Path)
-> (StructuredArgument -> Either (Pretty ColorText) Path)
-> Argument
-> Either (Pretty ColorText) Path
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text Path -> Either (Pretty ColorText) Path
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text Path -> Either (Pretty ColorText) Path)
-> (String -> Either Text Path)
-> String
-> Either (Pretty ColorText) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text Path
Path.parsePath)
    \case
      SA.Name Name
name -> Path -> Either (Pretty ColorText) Path
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> Either (Pretty ColorText) Path)
-> Path -> Either (Pretty ColorText) Path
forall a b. (a -> b) -> a -> b
$ Name -> Path
Path.fromName Name
name
      SA.NameWithBranchPrefix AbsBranchId
_ Name
name -> Path -> Either (Pretty ColorText) Path
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> Either (Pretty ColorText) Path)
-> Path -> Either (Pretty ColorText) Path
forall a b. (a -> b) -> a -> b
$ Name -> Path
Path.fromName Name
name
      StructuredArgument
otherArgType ->
        (Pretty ColorText -> Either (Pretty ColorText) Path)
-> (Name -> Either (Pretty ColorText) Path)
-> Either (Pretty ColorText) Name
-> Either (Pretty ColorText) Path
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          (Either (Pretty ColorText) Path
-> Pretty ColorText -> Either (Pretty ColorText) Path
forall a b. a -> b -> a
const (Either (Pretty ColorText) Path
 -> Pretty ColorText -> Either (Pretty ColorText) Path)
-> (Pretty ColorText -> Either (Pretty ColorText) Path)
-> Pretty ColorText
-> Pretty ColorText
-> Either (Pretty ColorText) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Either (Pretty ColorText) Path
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Pretty ColorText -> Either (Pretty ColorText) Path)
-> Pretty ColorText
-> Pretty ColorText
-> Either (Pretty ColorText) Path
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a relative path" StructuredArgument
otherArgType)
          ( \Name
name ->
              if Name -> Bool
Name.isRelative Name
name
                then Path -> Either (Pretty ColorText) Path
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> Either (Pretty ColorText) Path)
-> Path -> Either (Pretty ColorText) Path
forall a b. (a -> b) -> a -> b
$ Name -> Path
Path.fromName Name
name
                else Pretty ColorText -> Either (Pretty ColorText) Path
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Path)
-> Pretty ColorText -> Either (Pretty ColorText) Path
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a relative path" StructuredArgument
otherArgType
          )
          (Either (Pretty ColorText) Name -> Either (Pretty ColorText) Path)
-> (Argument -> Either (Pretty ColorText) Name)
-> Argument
-> Either (Pretty ColorText) Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> Either (Pretty ColorText) Name
handleNameArg
          (Argument -> Either (Pretty ColorText) Path)
-> Argument -> Either (Pretty ColorText) Path
forall a b. (a -> b) -> a -> b
$ StructuredArgument -> Argument
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StructuredArgument
otherArgType

handlePath'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path'
handlePath'Arg :: Argument -> Either (Pretty ColorText) Path'
handlePath'Arg =
  (String -> Either (Pretty ColorText) Path')
-> (StructuredArgument -> Either (Pretty ColorText) Path')
-> Argument
-> Either (Pretty ColorText) Path'
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text Path' -> Either (Pretty ColorText) Path'
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text Path' -> Either (Pretty ColorText) Path')
-> (String -> Either Text Path')
-> String
-> Either (Pretty ColorText) Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text Path'
Path.parsePath')
    \case
      SA.AbsolutePath Absolute
path -> Path' -> Either (Pretty ColorText) Path'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path' -> Either (Pretty ColorText) Path')
-> Path' -> Either (Pretty ColorText) Path'
forall a b. (a -> b) -> a -> b
$ Absolute -> Path'
Path.absoluteToPath' Absolute
path
      SA.Name Name
name -> Path' -> Either (Pretty ColorText) Path'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path' -> Either (Pretty ColorText) Path')
-> Path' -> Either (Pretty ColorText) Path'
forall a b. (a -> b) -> a -> b
$ Name -> Path'
Path.fromName' Name
name
      SA.NameWithBranchPrefix AbsBranchId
mprefix Name
name ->
        Path' -> Either (Pretty ColorText) Path'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path' -> Either (Pretty ColorText) Path')
-> (Name -> Path') -> Name -> Either (Pretty ColorText) Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Path'
Path.fromName' (Name -> Either (Pretty ColorText) Path')
-> Name -> Either (Pretty ColorText) Path'
forall a b. (a -> b) -> a -> b
$ (Absolute -> Name -> Name) -> Name -> AbsBranchId -> Name
forall a b. (a -> b -> b) -> b -> BranchIdG a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Path' -> Name -> Name
Path.prefixNameIfRel (Path' -> Name -> Name)
-> (Absolute -> Path') -> Absolute -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Path'
Path.AbsolutePath') Name
name AbsBranchId
mprefix
      StructuredArgument
otherArgType ->
        (Pretty ColorText -> Pretty ColorText)
-> (Name -> Path')
-> Either (Pretty ColorText) Name
-> Either (Pretty ColorText) Path'
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 (Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a b. a -> b -> a
const (Pretty ColorText -> Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a path" StructuredArgument
otherArgType) Name -> Path'
Path.fromName' (Either (Pretty ColorText) Name -> Either (Pretty ColorText) Path')
-> (Argument -> Either (Pretty ColorText) Name)
-> Argument
-> Either (Pretty ColorText) Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Argument -> Either (Pretty ColorText) Name
handleNameArg (Argument -> Either (Pretty ColorText) Path')
-> Argument -> Either (Pretty ColorText) Path'
forall a b. (a -> b) -> a -> b
$ StructuredArgument -> Argument
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StructuredArgument
otherArgType

handleNewName :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split'
handleNewName :: Argument -> Either (Pretty ColorText) Split'
handleNewName =
  (String -> Either (Pretty ColorText) Split')
-> (StructuredArgument -> Either (Pretty ColorText) Split')
-> Argument
-> Either (Pretty ColorText) Split'
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text Split' -> Either (Pretty ColorText) Split'
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text Split' -> Either (Pretty ColorText) Split')
-> (String -> Either Text Split')
-> String
-> Either (Pretty ColorText) Split'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text Split'
Path.parseSplit')
    (Either (Pretty ColorText) Split'
-> StructuredArgument -> Either (Pretty ColorText) Split'
forall a b. a -> b -> a
const (Either (Pretty ColorText) Split'
 -> StructuredArgument -> Either (Pretty ColorText) Split')
-> (Pretty ColorText -> Either (Pretty ColorText) Split')
-> Pretty ColorText
-> StructuredArgument
-> Either (Pretty ColorText) Split'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Either (Pretty ColorText) Split'
forall a b. a -> Either a b
Left (Pretty ColorText
 -> StructuredArgument -> Either (Pretty ColorText) Split')
-> Pretty ColorText
-> StructuredArgument
-> Either (Pretty ColorText) Split'
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"can’t use a numbered argument for a new name")

handleNewPath :: I.Argument -> Either (P.Pretty CT.ColorText) Path'
handleNewPath :: Argument -> Either (Pretty ColorText) Path'
handleNewPath =
  (String -> Either (Pretty ColorText) Path')
-> (StructuredArgument -> Either (Pretty ColorText) Path')
-> Argument
-> Either (Pretty ColorText) Path'
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text Path' -> Either (Pretty ColorText) Path'
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text Path' -> Either (Pretty ColorText) Path')
-> (String -> Either Text Path')
-> String
-> Either (Pretty ColorText) Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text Path'
Path.parsePath')
    (Either (Pretty ColorText) Path'
-> StructuredArgument -> Either (Pretty ColorText) Path'
forall a b. a -> b -> a
const (Either (Pretty ColorText) Path'
 -> StructuredArgument -> Either (Pretty ColorText) Path')
-> (Pretty ColorText -> Either (Pretty ColorText) Path')
-> Pretty ColorText
-> StructuredArgument
-> Either (Pretty ColorText) Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Either (Pretty ColorText) Path'
forall a b. a -> Either a b
Left (Pretty ColorText
 -> StructuredArgument -> Either (Pretty ColorText) Path')
-> Pretty ColorText
-> StructuredArgument
-> Either (Pretty ColorText) Path'
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"can’t use a numbered argument for a new namespace")

-- | When only a relative name is allowed.
handleSplitArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split
handleSplitArg :: Argument -> Either (Pretty ColorText) Split
handleSplitArg =
  (String -> Either (Pretty ColorText) Split)
-> (StructuredArgument -> Either (Pretty ColorText) Split)
-> Argument
-> Either (Pretty ColorText) Split
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text Split -> Either (Pretty ColorText) Split
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text Split -> Either (Pretty ColorText) Split)
-> (String -> Either Text Split)
-> String
-> Either (Pretty ColorText) Split
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text Split
Path.parseSplit)
    \case
      SA.Name Name
name | Name -> Bool
Name.isRelative Name
name -> Split -> Either (Pretty ColorText) Split
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Split -> Either (Pretty ColorText) Split)
-> Split -> Either (Pretty ColorText) Split
forall a b. (a -> b) -> a -> b
$ Name -> Split
Path.splitFromName Name
name
      SA.NameWithBranchPrefix AbsBranchId
_ Name
name | Name -> Bool
Name.isRelative Name
name -> Split -> Either (Pretty ColorText) Split
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Split -> Either (Pretty ColorText) Split)
-> Split -> Either (Pretty ColorText) Split
forall a b. (a -> b) -> a -> b
$ Name -> Split
Path.splitFromName Name
name
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) Split
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Split)
-> Pretty ColorText -> Either (Pretty ColorText) Split
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a relative name" StructuredArgument
otherNumArg

handleSplit'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.Split'
handleSplit'Arg :: Argument -> Either (Pretty ColorText) Split'
handleSplit'Arg =
  (String -> Either (Pretty ColorText) Split')
-> (StructuredArgument -> Either (Pretty ColorText) Split')
-> Argument
-> Either (Pretty ColorText) Split'
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text Split' -> Either (Pretty ColorText) Split'
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text Split' -> Either (Pretty ColorText) Split')
-> (String -> Either Text Split')
-> String
-> Either (Pretty ColorText) Split'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text Split'
Path.parseSplit')
    \case
      SA.Name Name
name -> Split' -> Either (Pretty ColorText) Split'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Split' -> Either (Pretty ColorText) Split')
-> Split' -> Either (Pretty ColorText) Split'
forall a b. (a -> b) -> a -> b
$ Name -> Split'
Path.splitFromName' Name
name
      SA.NameWithBranchPrefix (BranchAtSCH ShortCausalHash
_) Name
name -> Split' -> Either (Pretty ColorText) Split'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Split' -> Either (Pretty ColorText) Split')
-> Split' -> Either (Pretty ColorText) Split'
forall a b. (a -> b) -> a -> b
$ Name -> Split'
Path.splitFromName' Name
name
      SA.NameWithBranchPrefix (BranchAtPath Absolute
prefix) Name
name ->
        Split' -> Either (Pretty ColorText) Split'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Split' -> Either (Pretty ColorText) Split')
-> (Name -> Split') -> Name -> Either (Pretty ColorText) Split'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Split'
Path.splitFromName' (Name -> Either (Pretty ColorText) Split')
-> Name -> Either (Pretty ColorText) Split'
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) Name
name
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) Split'
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Split')
-> Pretty ColorText -> Either (Pretty ColorText) Split'
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a name" StructuredArgument
otherNumArg

handleProjectBranchNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectBranchName
handleProjectBranchNameArg :: Argument -> Either (Pretty ColorText) ProjectBranchName
handleProjectBranchNameArg =
  (String -> Either (Pretty ColorText) ProjectBranchName)
-> (StructuredArgument
    -> Either (Pretty ColorText) ProjectBranchName)
-> Argument
-> Either (Pretty ColorText) ProjectBranchName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((TryFromException Text ProjectBranchName -> Pretty ColorText)
-> Either
     (TryFromException Text ProjectBranchName) ProjectBranchName
-> Either (Pretty ColorText) ProjectBranchName
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
-> TryFromException Text ProjectBranchName -> Pretty ColorText
forall a b. a -> b -> a
const (Pretty ColorText
 -> TryFromException Text ProjectBranchName -> Pretty ColorText)
-> Pretty ColorText
-> TryFromException Text ProjectBranchName
-> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text Text
"Wanted a branch name, but it wasn’t") (Either (TryFromException Text ProjectBranchName) ProjectBranchName
 -> Either (Pretty ColorText) ProjectBranchName)
-> (String
    -> Either
         (TryFromException Text ProjectBranchName) ProjectBranchName)
-> String
-> Either (Pretty ColorText) ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Either
     (TryFromException Text ProjectBranchName) ProjectBranchName
forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto (Text
 -> Either
      (TryFromException Text ProjectBranchName) ProjectBranchName)
-> (String -> Text)
-> String
-> Either
     (TryFromException Text ProjectBranchName) ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack)
    \case
      SA.ProjectBranch (ProjectAndBranch Maybe ProjectName
_ ProjectBranchName
branch) -> ProjectBranchName -> Either (Pretty ColorText) ProjectBranchName
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectBranchName
branch
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) ProjectBranchName
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) ProjectBranchName)
-> Pretty ColorText -> Either (Pretty ColorText) ProjectBranchName
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a branch name" StructuredArgument
otherNumArg

handleBranchIdArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.BranchId
handleBranchIdArg :: Argument -> Either (Pretty ColorText) BranchId
handleBranchIdArg =
  (String -> Either (Pretty ColorText) BranchId)
-> (StructuredArgument -> Either (Pretty ColorText) BranchId)
-> Argument
-> Either (Pretty ColorText) BranchId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text BranchId -> Either (Pretty ColorText) BranchId
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text BranchId -> Either (Pretty ColorText) BranchId)
-> (String -> Either Text BranchId)
-> String
-> Either (Pretty ColorText) BranchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text BranchId
Input.parseBranchId)
    \case
      SA.AbsolutePath Absolute
path -> BranchId -> Either (Pretty ColorText) BranchId
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId -> Either (Pretty ColorText) BranchId)
-> (Path' -> BranchId)
-> Path'
-> Either (Pretty ColorText) BranchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchId
forall p. p -> BranchIdG p
BranchAtPath (Path' -> Either (Pretty ColorText) BranchId)
-> Path' -> Either (Pretty ColorText) BranchId
forall a b. (a -> b) -> a -> b
$ Absolute -> Path'
Path.absoluteToPath' Absolute
path
      SA.Name Name
name -> BranchId -> Either (Pretty ColorText) BranchId
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId -> Either (Pretty ColorText) BranchId)
-> (Path' -> BranchId)
-> Path'
-> Either (Pretty ColorText) BranchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchId
forall p. p -> BranchIdG p
BranchAtPath (Path' -> Either (Pretty ColorText) BranchId)
-> Path' -> Either (Pretty ColorText) BranchId
forall a b. (a -> b) -> a -> b
$ Name -> Path'
Path.fromName' Name
name
      SA.NameWithBranchPrefix AbsBranchId
mprefix Name
name ->
        BranchId -> Either (Pretty ColorText) BranchId
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId -> Either (Pretty ColorText) BranchId)
-> BranchId -> Either (Pretty ColorText) BranchId
forall a b. (a -> b) -> a -> b
$ case AbsBranchId
mprefix of
          BranchAtSCH ShortCausalHash
_sch -> Path' -> BranchId
forall p. p -> BranchIdG p
BranchAtPath (Path' -> BranchId) -> (Name -> Path') -> Name -> BranchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Path'
Path.fromName' (Name -> BranchId) -> Name -> BranchId
forall a b. (a -> b) -> a -> b
$ Name
name
          BranchAtPath Absolute
prefix -> Path' -> BranchId
forall p. p -> BranchIdG p
BranchAtPath (Path' -> BranchId) -> (Name -> Path') -> Name -> BranchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Path'
Path.fromName' (Name -> BranchId) -> Name -> BranchId
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) Name
name
          BranchAtProjectPath ProjectPath
pp ->
            ProjectPath
pp
              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
pathPrefix -> Absolute -> Path -> Absolute
forall l r o. Resolve l r o => l -> r -> o
Path.resolve Absolute
pathPrefix (Name -> Path
Path.fromName Name
name))
              ProjectPath -> (ProjectPath -> BranchId) -> BranchId
forall a b. a -> (a -> b) -> b
& ProjectPath -> BranchId
forall p. ProjectPath -> BranchIdG p
BranchAtProjectPath
      SA.Namespace CausalHash
hash -> BranchId -> Either (Pretty ColorText) BranchId
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId -> Either (Pretty ColorText) BranchId)
-> (ShortCausalHash -> BranchId)
-> ShortCausalHash
-> Either (Pretty ColorText) BranchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortCausalHash -> BranchId
forall p. ShortCausalHash -> BranchIdG p
BranchAtSCH (ShortCausalHash -> Either (Pretty ColorText) BranchId)
-> ShortCausalHash -> Either (Pretty ColorText) BranchId
forall a b. (a -> b) -> a -> b
$ CausalHash -> ShortCausalHash
forall h. Coercible h Hash => h -> ShortCausalHash
SCH.fromFullHash CausalHash
hash
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) BranchId
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) BranchId)
-> Pretty ColorText -> Either (Pretty ColorText) BranchId
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a branch id" StructuredArgument
otherNumArg

-- | TODO: Maybe remove?
_handleBranchIdOrProjectArg ::
  I.Argument ->
  Either (P.Pretty CT.ColorText) (These Input.BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
_handleBranchIdOrProjectArg :: Argument
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
_handleBranchIdOrProjectArg =
  (String
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> (StructuredArgument
    -> Either
         (Pretty ColorText)
         (These
            BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> Argument
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\String
str -> Either
  (Pretty ColorText)
  (These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> (These
      BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
    -> Either
         (Pretty ColorText)
         (These
            BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> Maybe
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Pretty ColorText
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> Pretty ColorText
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. (a -> b) -> a -> b
$ Text -> String -> Pretty ColorText
expectedButActually' Text
"a branch" String
str) These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
   (These
      BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> Maybe
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. (a -> b) -> a -> b
$ String
-> Maybe
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
branchIdOrProject String
str)
    \case
      SA.Namespace CausalHash
hash -> These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These
   BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> (ShortCausalHash
    -> These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> ShortCausalHash
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchId
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. a -> These a b
This (BranchId
 -> These
      BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> (ShortCausalHash -> BranchId)
-> ShortCausalHash
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortCausalHash -> BranchId
forall p. ShortCausalHash -> BranchIdG p
BranchAtSCH (ShortCausalHash
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> ShortCausalHash
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. (a -> b) -> a -> b
$ CausalHash -> ShortCausalHash
forall h. Coercible h Hash => h -> ShortCausalHash
SCH.fromFullHash CausalHash
hash
      SA.AbsolutePath Absolute
path -> These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These
   BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> (Path'
    -> These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Path'
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchId
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. a -> These a b
This (BranchId
 -> These
      BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> (Path' -> BranchId)
-> Path'
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchId
forall p. p -> BranchIdG p
BranchAtPath (Path'
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> Path'
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. (a -> b) -> a -> b
$ Absolute -> Path'
Path.absoluteToPath' Absolute
path
      SA.Name Name
name -> These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These
   BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> (Path'
    -> These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Path'
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchId
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. a -> These a b
This (BranchId
 -> These
      BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> (Path' -> BranchId)
-> Path'
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchId
forall p. p -> BranchIdG p
BranchAtPath (Path'
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> Path'
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. (a -> b) -> a -> b
$ Name -> Path'
Path.fromName' Name
name
      SA.NameWithBranchPrefix (BranchAtSCH ShortCausalHash
_) Name
name -> These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These
   BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> (Path'
    -> These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Path'
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchId
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. a -> These a b
This (BranchId
 -> These
      BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> (Path' -> BranchId)
-> Path'
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchId
forall p. p -> BranchIdG p
BranchAtPath (Path'
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> Path'
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. (a -> b) -> a -> b
$ Name -> Path'
Path.fromName' Name
name
      SA.NameWithBranchPrefix (BranchAtPath Absolute
prefix) Name
name ->
        These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These
   BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> (Name
    -> These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Name
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchId
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. a -> These a b
This (BranchId
 -> These
      BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> (Name -> BranchId)
-> Name
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchId
forall p. p -> BranchIdG p
BranchAtPath (Path' -> BranchId) -> (Name -> Path') -> Name -> BranchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Path'
Path.fromName' (Name
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> Name
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) Name
name
      SA.ProjectBranch ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pb -> These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These
   BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. (a -> b) -> a -> b
$ ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. b -> These a b
That ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pb
      StructuredArgument
otherArgType -> Pretty ColorText
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either
      (Pretty ColorText)
      (These
         BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)))
-> Pretty ColorText
-> Either
     (Pretty ColorText)
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a branch" StructuredArgument
otherArgType
  where
    branchIdOrProject ::
      String ->
      Maybe
        ( These
            Input.BranchId
            (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
        )
    branchIdOrProject :: String
-> Maybe
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
branchIdOrProject String
str =
      let branchIdRes :: Either Text BranchId
branchIdRes = String -> Either Text BranchId
Input.parseBranchId String
str
          projectRes :: Either
  (TryFromException
     Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
projectRes =
            forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @(ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
              (String -> Text
Text.pack String
str)
       in case (Either Text BranchId
branchIdRes, Either
  (TryFromException
     Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
projectRes) of
            (Left Text
_, Left TryFromException
  Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
_) -> Maybe
  (These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. Maybe a
Nothing
            (Left Text
_, Right ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pr) -> These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Maybe
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Maybe a
Just (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. b -> These a b
That ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pr)
            (Right BranchId
bid, Left TryFromException
  Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
_) -> These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Maybe
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Maybe a
Just (BranchId
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. a -> These a b
This BranchId
bid)
            (Right BranchId
bid, Right ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pr) -> These
  BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Maybe
     (These
        BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Maybe a
Just (BranchId
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> These
     BranchId (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a b. a -> b -> These a b
These BranchId
bid ProjectAndBranch (Maybe ProjectName) ProjectBranchName
pr)

handleBranchId2Arg :: I.Argument -> Either (P.Pretty P.ColorText) Input.BranchId2
handleBranchId2Arg :: Argument -> Either (Pretty ColorText) BranchId2
handleBranchId2Arg =
  (String -> Either (Pretty ColorText) BranchId2)
-> (StructuredArgument -> Either (Pretty ColorText) BranchId2)
-> Argument
-> Either (Pretty ColorText) BranchId2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    String -> Either (Pretty ColorText) BranchId2
Input.parseBranchId2
    \case
      SA.Namespace CausalHash
hash -> BranchId2 -> Either (Pretty ColorText) BranchId2
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId2 -> Either (Pretty ColorText) BranchId2)
-> (ShortCausalHash -> BranchId2)
-> ShortCausalHash
-> Either (Pretty ColorText) BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortCausalHash -> BranchId2
forall a b. a -> Either a b
Left (ShortCausalHash -> Either (Pretty ColorText) BranchId2)
-> ShortCausalHash -> Either (Pretty ColorText) BranchId2
forall a b. (a -> b) -> a -> b
$ CausalHash -> ShortCausalHash
forall h. Coercible h Hash => h -> ShortCausalHash
SCH.fromFullHash CausalHash
hash
      SA.AbsolutePath Absolute
path -> BranchId2 -> Either (Pretty ColorText) BranchId2
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId2 -> Either (Pretty ColorText) BranchId2)
-> (Path' -> BranchId2)
-> Path'
-> Either (Pretty ColorText) BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchRelativePath -> BranchId2
forall a. a -> Either ShortCausalHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> BranchId2)
-> (Path' -> BranchRelativePath) -> Path' -> BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> Either (Pretty ColorText) BranchId2)
-> Path' -> Either (Pretty ColorText) BranchId2
forall a b. (a -> b) -> a -> b
$ Absolute -> Path'
Path.absoluteToPath' Absolute
path
      SA.Name Name
name -> BranchId2 -> Either (Pretty ColorText) BranchId2
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId2 -> Either (Pretty ColorText) BranchId2)
-> (Path' -> BranchId2)
-> Path'
-> Either (Pretty ColorText) BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchRelativePath -> BranchId2
forall a. a -> Either ShortCausalHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> BranchId2)
-> (Path' -> BranchRelativePath) -> Path' -> BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> Either (Pretty ColorText) BranchId2)
-> Path' -> Either (Pretty ColorText) BranchId2
forall a b. (a -> b) -> a -> b
$ Name -> Path'
Path.fromName' Name
name
      SA.NameWithBranchPrefix (BranchAtSCH ShortCausalHash
_) Name
name -> BranchId2 -> Either (Pretty ColorText) BranchId2
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId2 -> Either (Pretty ColorText) BranchId2)
-> (Path' -> BranchId2)
-> Path'
-> Either (Pretty ColorText) BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchRelativePath -> BranchId2
forall a. a -> Either ShortCausalHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> BranchId2)
-> (Path' -> BranchRelativePath) -> Path' -> BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> Either (Pretty ColorText) BranchId2)
-> Path' -> Either (Pretty ColorText) BranchId2
forall a b. (a -> b) -> a -> b
$ Name -> Path'
Path.fromName' Name
name
      SA.NameWithBranchPrefix (BranchAtPath Absolute
prefix) Name
name ->
        BranchId2 -> Either (Pretty ColorText) BranchId2
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId2 -> Either (Pretty ColorText) BranchId2)
-> (Name -> BranchId2)
-> Name
-> Either (Pretty ColorText) BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchRelativePath -> BranchId2
forall a. a -> Either ShortCausalHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> BranchId2)
-> (Name -> BranchRelativePath) -> Name -> BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> BranchRelativePath)
-> (Name -> Path') -> Name -> BranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Path'
Path.fromName' (Name -> Either (Pretty ColorText) BranchId2)
-> Name -> Either (Pretty ColorText) BranchId2
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) Name
name
      SA.ProjectBranch (ProjectAndBranch Maybe ProjectName
mproject ProjectBranchName
branch) ->
        case Maybe ProjectName
mproject of
          Just ProjectName
proj -> BranchId2 -> Either (Pretty ColorText) BranchId2
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId2 -> Either (Pretty ColorText) BranchId2)
-> (BranchRelativePath -> BranchId2)
-> BranchRelativePath
-> Either (Pretty ColorText) BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchRelativePath -> BranchId2
forall a. a -> Either ShortCausalHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> Either (Pretty ColorText) BranchId2)
-> BranchRelativePath -> Either (Pretty ColorText) BranchId2
forall a b. (a -> b) -> a -> b
$ ProjectName -> ProjectBranchName -> Absolute -> BranchRelativePath
QualifiedBranchPath ProjectName
proj ProjectBranchName
branch Absolute
Path.absoluteEmpty
          Maybe ProjectName
Nothing -> BranchId2 -> Either (Pretty ColorText) BranchId2
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchId2 -> Either (Pretty ColorText) BranchId2)
-> (BranchRelativePath -> BranchId2)
-> BranchRelativePath
-> Either (Pretty ColorText) BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BranchRelativePath -> BranchId2
forall a. a -> Either ShortCausalHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> Either (Pretty ColorText) BranchId2)
-> BranchRelativePath -> Either (Pretty ColorText) BranchId2
forall a b. (a -> b) -> a -> b
$ ProjectBranchName -> Absolute -> BranchRelativePath
BranchPathInCurrentProject ProjectBranchName
branch Absolute
Path.absoluteEmpty
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) BranchId2
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) BranchId2)
-> Pretty ColorText -> Either (Pretty ColorText) BranchId2
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a branch id" StructuredArgument
otherNumArg

handleBranchRelativePathArg :: I.Argument -> Either (P.Pretty P.ColorText) BranchRelativePath
handleBranchRelativePathArg :: Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg =
  (String -> Either (Pretty ColorText) BranchRelativePath)
-> (StructuredArgument
    -> Either (Pretty ColorText) BranchRelativePath)
-> Argument
-> Either (Pretty ColorText) BranchRelativePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    String -> Either (Pretty ColorText) BranchRelativePath
parseBranchRelativePath
    \case
      SA.AbsolutePath Absolute
path -> BranchRelativePath -> Either (Pretty ColorText) BranchRelativePath
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath
 -> Either (Pretty ColorText) BranchRelativePath)
-> (Path' -> BranchRelativePath)
-> Path'
-> Either (Pretty ColorText) BranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> Either (Pretty ColorText) BranchRelativePath)
-> Path' -> Either (Pretty ColorText) BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Absolute -> Path'
Path.absoluteToPath' Absolute
path
      SA.Name Name
name -> BranchRelativePath -> Either (Pretty ColorText) BranchRelativePath
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath
 -> Either (Pretty ColorText) BranchRelativePath)
-> (Path' -> BranchRelativePath)
-> Path'
-> Either (Pretty ColorText) BranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> Either (Pretty ColorText) BranchRelativePath)
-> Path' -> Either (Pretty ColorText) BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Name -> Path'
Path.fromName' Name
name
      SA.NameWithBranchPrefix (BranchAtSCH ShortCausalHash
_) Name
name -> BranchRelativePath -> Either (Pretty ColorText) BranchRelativePath
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath
 -> Either (Pretty ColorText) BranchRelativePath)
-> (Path' -> BranchRelativePath)
-> Path'
-> Either (Pretty ColorText) BranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> Either (Pretty ColorText) BranchRelativePath)
-> Path' -> Either (Pretty ColorText) BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Name -> Path'
Path.fromName' Name
name
      SA.NameWithBranchPrefix (BranchAtPath Absolute
prefix) Name
name ->
        BranchRelativePath -> Either (Pretty ColorText) BranchRelativePath
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath
 -> Either (Pretty ColorText) BranchRelativePath)
-> (Name -> BranchRelativePath)
-> Name
-> Either (Pretty ColorText) BranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> BranchRelativePath)
-> (Name -> Path') -> Name -> BranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Path'
Path.fromName' (Name -> Either (Pretty ColorText) BranchRelativePath)
-> Name -> Either (Pretty ColorText) BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) Name
name
      SA.ProjectBranch (ProjectAndBranch Maybe ProjectName
mproject ProjectBranchName
branch) ->
        case Maybe ProjectName
mproject of
          Just ProjectName
proj -> BranchRelativePath -> Either (Pretty ColorText) BranchRelativePath
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath
 -> Either (Pretty ColorText) BranchRelativePath)
-> BranchRelativePath
-> Either (Pretty ColorText) BranchRelativePath
forall a b. (a -> b) -> a -> b
$ ProjectName -> ProjectBranchName -> Absolute -> BranchRelativePath
QualifiedBranchPath ProjectName
proj ProjectBranchName
branch Absolute
Path.absoluteEmpty
          Maybe ProjectName
Nothing -> BranchRelativePath -> Either (Pretty ColorText) BranchRelativePath
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath
 -> Either (Pretty ColorText) BranchRelativePath)
-> BranchRelativePath
-> Either (Pretty ColorText) BranchRelativePath
forall a b. (a -> b) -> a -> b
$ ProjectBranchName -> Absolute -> BranchRelativePath
BranchPathInCurrentProject ProjectBranchName
branch Absolute
Path.absoluteEmpty
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) BranchRelativePath
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) BranchRelativePath)
-> Pretty ColorText -> Either (Pretty ColorText) BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a branch id" StructuredArgument
otherNumArg

hqNameToSplit' :: HQ.HashQualified Name -> Either ShortHash Path.HQSplit'
hqNameToSplit' :: HashQualified Name -> Either ShortHash HQSplit'
hqNameToSplit' = \case
  HQ.HashOnly ShortHash
hash -> ShortHash -> Either ShortHash HQSplit'
forall a b. a -> Either a b
Left ShortHash
hash
  HQ.NameOnly Name
name -> HQSplit' -> Either ShortHash HQSplit'
forall a. a -> Either ShortHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Either ShortHash HQSplit')
-> (Split' -> HQSplit') -> Split' -> Either ShortHash HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSegment -> HQSegment) -> Split' -> HQSplit'
forall a b. (a -> b) -> (Path', a) -> (Path', b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameSegment -> HQSegment
forall n. n -> HashQualified n
HQ'.NameOnly (Split' -> Either ShortHash HQSplit')
-> Split' -> Either ShortHash HQSplit'
forall a b. (a -> b) -> a -> b
$ Name -> Split'
Path.splitFromName' Name
name
  HQ.HashQualified Name
name ShortHash
hash -> HQSplit' -> Either ShortHash HQSplit'
forall a. a -> Either ShortHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Either ShortHash HQSplit')
-> (Split' -> HQSplit') -> Split' -> Either ShortHash HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSegment -> HQSegment) -> Split' -> HQSplit'
forall a b. (a -> b) -> (Path', a) -> (Path', b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NameSegment -> ShortHash -> HQSegment
forall n. n -> ShortHash -> HashQualified n
`HQ'.HashQualified` ShortHash
hash) (Split' -> Either ShortHash HQSplit')
-> Split' -> Either ShortHash HQSplit'
forall a b. (a -> b) -> a -> b
$ Name -> Split'
Path.splitFromName' Name
name

hqNameToSplit :: HQ.HashQualified Name -> Either ShortHash Path.HQSplit
hqNameToSplit :: HashQualified Name -> Either ShortHash HQSplit
hqNameToSplit = \case
  HQ.HashOnly ShortHash
hash -> ShortHash -> Either ShortHash HQSplit
forall a b. a -> Either a b
Left ShortHash
hash
  HQ.NameOnly Name
name -> HQSplit -> Either ShortHash HQSplit
forall a. a -> Either ShortHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit -> Either ShortHash HQSplit)
-> (Split -> HQSplit) -> Split -> Either ShortHash HQSplit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSegment -> HQSegment) -> Split -> HQSplit
forall a b. (a -> b) -> (Path, a) -> (Path, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameSegment -> HQSegment
forall n. n -> HashQualified n
HQ'.NameOnly (Split -> Either ShortHash HQSplit)
-> Split -> Either ShortHash HQSplit
forall a b. (a -> b) -> a -> b
$ Name -> Split
Path.splitFromName Name
name
  HQ.HashQualified Name
name ShortHash
hash -> HQSplit -> Either ShortHash HQSplit
forall a. a -> Either ShortHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit -> Either ShortHash HQSplit)
-> (Split -> HQSplit) -> Split -> Either ShortHash HQSplit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSegment -> HQSegment) -> Split -> HQSplit
forall a b. (a -> b) -> (Path, a) -> (Path, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NameSegment -> ShortHash -> HQSegment
forall n. n -> ShortHash -> HashQualified n
`HQ'.HashQualified` ShortHash
hash) (Split -> Either ShortHash HQSplit)
-> Split -> Either ShortHash HQSplit
forall a b. (a -> b) -> a -> b
$ Name -> Split
Path.splitFromName Name
name

hq'NameToSplit' :: HQ'.HashQualified Name -> Path.HQSplit'
hq'NameToSplit' :: HashQualified Name -> HQSplit'
hq'NameToSplit' = \case
  HQ'.NameOnly Name
name -> NameSegment -> HQSegment
forall n. n -> HashQualified n
HQ'.NameOnly (NameSegment -> HQSegment) -> Split' -> HQSplit'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Split'
Path.splitFromName' Name
name
  HQ'.HashQualified Name
name ShortHash
hash -> (NameSegment -> ShortHash -> HQSegment)
-> ShortHash -> NameSegment -> HQSegment
forall a b c. (a -> b -> c) -> b -> a -> c
flip NameSegment -> ShortHash -> HQSegment
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified ShortHash
hash (NameSegment -> HQSegment) -> Split' -> HQSplit'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Split'
Path.splitFromName' Name
name

hq'NameToSplit :: HQ'.HashQualified Name -> Path.HQSplit
hq'NameToSplit :: HashQualified Name -> HQSplit
hq'NameToSplit = \case
  HQ'.NameOnly Name
name -> NameSegment -> HQSegment
forall n. n -> HashQualified n
HQ'.NameOnly (NameSegment -> HQSegment) -> Split -> HQSplit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Split
Path.splitFromName Name
name
  HQ'.HashQualified Name
name ShortHash
hash -> (NameSegment -> ShortHash -> HQSegment)
-> ShortHash -> NameSegment -> HQSegment
forall a b c. (a -> b -> c) -> b -> a -> c
flip NameSegment -> ShortHash -> HQSegment
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified ShortHash
hash (NameSegment -> HQSegment) -> Split -> HQSplit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Split
Path.splitFromName Name
name

handleHashQualifiedSplit'Arg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.HQSplit'
handleHashQualifiedSplit'Arg :: Argument -> Either (Pretty ColorText) HQSplit'
handleHashQualifiedSplit'Arg =
  (String -> Either (Pretty ColorText) HQSplit')
-> (StructuredArgument -> Either (Pretty ColorText) HQSplit')
-> Argument
-> Either (Pretty ColorText) HQSplit'
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text HQSplit' -> Either (Pretty ColorText) HQSplit'
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text HQSplit' -> Either (Pretty ColorText) HQSplit')
-> (String -> Either Text HQSplit')
-> String
-> Either (Pretty ColorText) HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text HQSplit'
Path.parseHQSplit')
    \case
      SA.Name Name
name -> HQSplit' -> Either (Pretty ColorText) HQSplit'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Either (Pretty ColorText) HQSplit')
-> HQSplit' -> Either (Pretty ColorText) HQSplit'
forall a b. (a -> b) -> a -> b
$ Name -> HQSplit'
Path.hqSplitFromName' Name
name
      hq :: StructuredArgument
hq@(SA.HashQualified HashQualified Name
name) -> (ShortHash -> Pretty ColorText)
-> Either ShortHash HQSplit' -> Either (Pretty ColorText) HQSplit'
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 -> ShortHash -> Pretty ColorText
forall a b. a -> b -> a
const (Pretty ColorText -> ShortHash -> Pretty ColorText)
-> Pretty ColorText -> ShortHash -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Text -> Pretty ColorText
expectedButActually Text
"a name" StructuredArgument
hq Text
"a hash") (Either ShortHash HQSplit' -> Either (Pretty ColorText) HQSplit')
-> Either ShortHash HQSplit' -> Either (Pretty ColorText) HQSplit'
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Either ShortHash HQSplit'
hqNameToSplit' HashQualified Name
name
      SA.HashQualifiedWithBranchPrefix (BranchAtSCH ShortCausalHash
_) HashQualified Name
hqname -> HQSplit' -> Either (Pretty ColorText) HQSplit'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Either (Pretty ColorText) HQSplit')
-> HQSplit' -> Either (Pretty ColorText) HQSplit'
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> HQSplit'
hq'NameToSplit' HashQualified Name
hqname
      SA.HashQualifiedWithBranchPrefix (BranchAtPath Absolute
prefix) HashQualified Name
hqname ->
        HQSplit' -> Either (Pretty ColorText) HQSplit'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Either (Pretty ColorText) HQSplit')
-> (HashQualified Name -> HQSplit')
-> HashQualified Name
-> Either (Pretty ColorText) HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> HQSplit'
hq'NameToSplit' (HashQualified Name -> Either (Pretty ColorText) HQSplit')
-> HashQualified Name -> Either (Pretty ColorText) HQSplit'
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) (Name -> Name) -> HashQualified Name -> HashQualified Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified Name
hqname
      SA.ShallowListEntry Path'
prefix ShallowListEntry Symbol Ann
entry ->
        HQSplit' -> Either (Pretty ColorText) HQSplit'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Either (Pretty ColorText) HQSplit')
-> (HashQualified Name -> HQSplit')
-> HashQualified Name
-> Either (Pretty ColorText) HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> HQSplit'
hq'NameToSplit' (HashQualified Name -> HQSplit')
-> (HashQualified Name -> HashQualified Name)
-> HashQualified Name
-> HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path' -> Name -> Name
Path.prefixNameIfRel Path'
prefix) (HashQualified Name -> Either (Pretty ColorText) HQSplit')
-> HashQualified Name -> Either (Pretty ColorText) HQSplit'
forall a b. (a -> b) -> a -> b
$ ShallowListEntry Symbol Ann -> HashQualified Name
forall v. ShallowListEntry v Ann -> HashQualified Name
shallowListEntryToHQ' ShallowListEntry Symbol Ann
entry
      sr :: StructuredArgument
sr@(SA.SearchResult Maybe Path'
mpath SearchResult
result) ->
        (ShortHash -> Pretty ColorText)
-> Either ShortHash HQSplit' -> Either (Pretty ColorText) HQSplit'
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 -> ShortHash -> Pretty ColorText
forall a b. a -> b -> a
const (Pretty ColorText -> ShortHash -> Pretty ColorText)
-> Pretty ColorText -> ShortHash -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Text -> Pretty ColorText
expectedButActually Text
"a name" StructuredArgument
sr Text
"a hash") (Either ShortHash HQSplit' -> Either (Pretty ColorText) HQSplit')
-> (HashQualified Name -> Either ShortHash HQSplit')
-> HashQualified Name
-> Either (Pretty ColorText) HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Either ShortHash HQSplit'
hqNameToSplit' (HashQualified Name -> Either (Pretty ColorText) HQSplit')
-> HashQualified Name -> Either (Pretty ColorText) HQSplit'
forall a b. (a -> b) -> a -> b
$ Maybe Path' -> SearchResult -> HashQualified Name
searchResultToHQ Maybe Path'
mpath SearchResult
result
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) HQSplit'
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) HQSplit')
-> Pretty ColorText -> Either (Pretty ColorText) HQSplit'
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a name" StructuredArgument
otherNumArg

handleHashQualifiedSplitArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.HQSplit
handleHashQualifiedSplitArg :: Argument -> Either (Pretty ColorText) HQSplit
handleHashQualifiedSplitArg =
  (String -> Either (Pretty ColorText) HQSplit)
-> (StructuredArgument -> Either (Pretty ColorText) HQSplit)
-> Argument
-> Either (Pretty ColorText) HQSplit
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text HQSplit -> Either (Pretty ColorText) HQSplit
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text HQSplit -> Either (Pretty ColorText) HQSplit)
-> (String -> Either Text HQSplit)
-> String
-> Either (Pretty ColorText) HQSplit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text HQSplit
Path.parseHQSplit)
    \case
      n :: StructuredArgument
n@(SA.Name Name
name) ->
        (Path' -> Either (Pretty ColorText) Path)
-> (HQSegment -> Either (Pretty ColorText) HQSegment)
-> HQSplit'
-> Either (Pretty ColorText) HQSplit
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse
          ( \case
              Path.AbsolutePath' Absolute
_ -> Pretty ColorText -> Either (Pretty ColorText) Path
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Path)
-> Pretty ColorText -> Either (Pretty ColorText) Path
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Text -> Pretty ColorText
expectedButActually Text
"a relative name" StructuredArgument
n Text
"an absolute name"
              Path.RelativePath' Relative
p -> Path -> Either (Pretty ColorText) Path
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> Either (Pretty ColorText) Path)
-> Path -> Either (Pretty ColorText) Path
forall a b. (a -> b) -> a -> b
$ Relative -> Path
Path.unrelative Relative
p
          )
          HQSegment -> Either (Pretty ColorText) HQSegment
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (HQSplit' -> Either (Pretty ColorText) HQSplit)
-> HQSplit' -> Either (Pretty ColorText) HQSplit
forall a b. (a -> b) -> a -> b
$ Name -> HQSplit'
Path.hqSplitFromName' Name
name
      hq :: StructuredArgument
hq@(SA.HashQualified HashQualified Name
name) -> (ShortHash -> Pretty ColorText)
-> Either ShortHash HQSplit -> Either (Pretty ColorText) HQSplit
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 -> ShortHash -> Pretty ColorText
forall a b. a -> b -> a
const (Pretty ColorText -> ShortHash -> Pretty ColorText)
-> Pretty ColorText -> ShortHash -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Text -> Pretty ColorText
expectedButActually Text
"a name" StructuredArgument
hq Text
"a hash") (Either ShortHash HQSplit -> Either (Pretty ColorText) HQSplit)
-> Either ShortHash HQSplit -> Either (Pretty ColorText) HQSplit
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Either ShortHash HQSplit
hqNameToSplit HashQualified Name
name
      SA.HashQualifiedWithBranchPrefix (BranchAtSCH ShortCausalHash
_) HashQualified Name
hqname -> HQSplit -> Either (Pretty ColorText) HQSplit
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit -> Either (Pretty ColorText) HQSplit)
-> HQSplit -> Either (Pretty ColorText) HQSplit
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> HQSplit
hq'NameToSplit HashQualified Name
hqname
      SA.HashQualifiedWithBranchPrefix (BranchAtPath Absolute
prefix) HashQualified Name
hqname ->
        HQSplit -> Either (Pretty ColorText) HQSplit
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit -> Either (Pretty ColorText) HQSplit)
-> (HashQualified Name -> HQSplit)
-> HashQualified Name
-> Either (Pretty ColorText) HQSplit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> HQSplit
hq'NameToSplit (HashQualified Name -> Either (Pretty ColorText) HQSplit)
-> HashQualified Name -> Either (Pretty ColorText) HQSplit
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) (Name -> Name) -> HashQualified Name -> HashQualified Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified Name
hqname
      SA.ShallowListEntry Path'
_ ShallowListEntry Symbol Ann
entry -> HQSplit -> Either (Pretty ColorText) HQSplit
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit -> Either (Pretty ColorText) HQSplit)
-> (HashQualified Name -> HQSplit)
-> HashQualified Name
-> Either (Pretty ColorText) HQSplit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> HQSplit
hq'NameToSplit (HashQualified Name -> Either (Pretty ColorText) HQSplit)
-> HashQualified Name -> Either (Pretty ColorText) HQSplit
forall a b. (a -> b) -> a -> b
$ ShallowListEntry Symbol Ann -> HashQualified Name
forall v. ShallowListEntry v Ann -> HashQualified Name
shallowListEntryToHQ' ShallowListEntry Symbol Ann
entry
      sr :: StructuredArgument
sr@(SA.SearchResult Maybe Path'
mpath SearchResult
result) ->
        (ShortHash -> Pretty ColorText)
-> Either ShortHash HQSplit -> Either (Pretty ColorText) HQSplit
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 -> ShortHash -> Pretty ColorText
forall a b. a -> b -> a
const (Pretty ColorText -> ShortHash -> Pretty ColorText)
-> Pretty ColorText -> ShortHash -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Text -> Pretty ColorText
expectedButActually Text
"a name" StructuredArgument
sr Text
"a hash") (Either ShortHash HQSplit -> Either (Pretty ColorText) HQSplit)
-> (HashQualified Name -> Either ShortHash HQSplit)
-> HashQualified Name
-> Either (Pretty ColorText) HQSplit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Either ShortHash HQSplit
hqNameToSplit (HashQualified Name -> Either (Pretty ColorText) HQSplit)
-> HashQualified Name -> Either (Pretty ColorText) HQSplit
forall a b. (a -> b) -> a -> b
$ Maybe Path' -> SearchResult -> HashQualified Name
searchResultToHQ Maybe Path'
mpath SearchResult
result
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) HQSplit
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) HQSplit)
-> Pretty ColorText -> Either (Pretty ColorText) HQSplit
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a relative name" StructuredArgument
otherNumArg

handleShortCausalHashArg :: I.Argument -> Either (P.Pretty CT.ColorText) ShortCausalHash
handleShortCausalHashArg :: Argument -> Either (Pretty ColorText) ShortCausalHash
handleShortCausalHashArg =
  (String -> Either (Pretty ColorText) ShortCausalHash)
-> (StructuredArgument
    -> Either (Pretty ColorText) ShortCausalHash)
-> Argument
-> Either (Pretty ColorText) ShortCausalHash
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((String -> Pretty ColorText)
-> Either String ShortCausalHash
-> Either (Pretty ColorText) ShortCausalHash
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 (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Pretty ColorText)
-> (String -> Text) -> String -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) (Either String ShortCausalHash
 -> Either (Pretty ColorText) ShortCausalHash)
-> (String -> Either String ShortCausalHash)
-> String
-> Either (Pretty ColorText) ShortCausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String ShortCausalHash
Input.parseShortCausalHash)
    \case
      SA.Namespace CausalHash
hash -> ShortCausalHash -> Either (Pretty ColorText) ShortCausalHash
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShortCausalHash -> Either (Pretty ColorText) ShortCausalHash)
-> ShortCausalHash -> Either (Pretty ColorText) ShortCausalHash
forall a b. (a -> b) -> a -> b
$ CausalHash -> ShortCausalHash
forall h. Coercible h Hash => h -> ShortCausalHash
SCH.fromFullHash CausalHash
hash
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) ShortCausalHash
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) ShortCausalHash)
-> Pretty ColorText -> Either (Pretty ColorText) ShortCausalHash
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a causal hash" StructuredArgument
otherNumArg

handleShortHashOrHQSplit'Arg ::
  I.Argument -> Either (P.Pretty CT.ColorText) (Either ShortHash Path.HQSplit')
handleShortHashOrHQSplit'Arg :: Argument -> Either (Pretty ColorText) (Either ShortHash HQSplit')
handleShortHashOrHQSplit'Arg =
  (String -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> (StructuredArgument
    -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> Argument
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text (Either ShortHash HQSplit')
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text (Either ShortHash HQSplit')
 -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> (String -> Either Text (Either ShortHash HQSplit'))
-> String
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text (Either ShortHash HQSplit')
Path.parseShortHashOrHQSplit')
    \case
      SA.HashQualified HashQualified Name
name -> Either ShortHash HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ShortHash HQSplit'
 -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> Either ShortHash HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Either ShortHash HQSplit'
hqNameToSplit' HashQualified Name
name
      SA.HashQualifiedWithBranchPrefix (BranchAtSCH ShortCausalHash
_) HashQualified Name
hqname -> Either ShortHash HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ShortHash HQSplit'
 -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> (HQSplit' -> Either ShortHash HQSplit')
-> HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HQSplit' -> Either ShortHash HQSplit'
forall a. a -> Either ShortHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> HQSplit'
hq'NameToSplit' HashQualified Name
hqname
      SA.HashQualifiedWithBranchPrefix (BranchAtPath Absolute
prefix) HashQualified Name
hqname ->
        Either ShortHash HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ShortHash HQSplit'
 -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> (HQSplit' -> Either ShortHash HQSplit')
-> HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HQSplit' -> Either ShortHash HQSplit'
forall a. a -> Either ShortHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> HQSplit'
hq'NameToSplit' (Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) (Name -> Name) -> HashQualified Name -> HashQualified Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashQualified Name
hqname)
      SA.ShallowListEntry Path'
prefix ShallowListEntry Symbol Ann
entry ->
        Either ShortHash HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ShortHash HQSplit'
 -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> (HashQualified Name -> Either ShortHash HQSplit')
-> HashQualified Name
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HQSplit' -> Either ShortHash HQSplit'
forall a. a -> Either ShortHash a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HQSplit' -> Either ShortHash HQSplit')
-> (HashQualified Name -> HQSplit')
-> HashQualified Name
-> Either ShortHash HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> HQSplit'
hq'NameToSplit' (HashQualified Name -> HQSplit')
-> (HashQualified Name -> HashQualified Name)
-> HashQualified Name
-> HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path' -> Name -> Name
Path.prefixNameIfRel Path'
prefix) (HashQualified Name
 -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> HashQualified Name
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a b. (a -> b) -> a -> b
$ ShallowListEntry Symbol Ann -> HashQualified Name
forall v. ShallowListEntry v Ann -> HashQualified Name
shallowListEntryToHQ' ShallowListEntry Symbol Ann
entry
      SA.SearchResult Maybe Path'
mpath SearchResult
result -> Either ShortHash HQSplit'
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ShortHash HQSplit'
 -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> (HashQualified Name -> Either ShortHash HQSplit')
-> HashQualified Name
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Either ShortHash HQSplit'
hqNameToSplit' (HashQualified Name
 -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> HashQualified Name
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a b. (a -> b) -> a -> b
$ Maybe Path' -> SearchResult -> HashQualified Name
searchResultToHQ Maybe Path'
mpath SearchResult
result
      StructuredArgument
otherNumArg -> Pretty ColorText
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either (Pretty ColorText) (Either ShortHash HQSplit'))
-> Pretty ColorText
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a hash or name" StructuredArgument
otherNumArg

handleRelativeNameSegmentArg :: I.Argument -> Either (P.Pretty CT.ColorText) NameSegment
handleRelativeNameSegmentArg :: Argument -> Either (Pretty ColorText) NameSegment
handleRelativeNameSegmentArg Argument
arg = do
  Name
name <- Argument -> Either (Pretty ColorText) Name
handleNameArg Argument
arg
  let (NameSegment
segment NE.:| [NameSegment]
tail) = Name -> NonEmpty NameSegment
Name.reverseSegments Name
name
  if Name -> Bool
Name.isRelative Name
name Bool -> Bool -> Bool
&& [NameSegment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NameSegment]
tail
    then NameSegment -> Either (Pretty ColorText) NameSegment
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NameSegment
segment
    else Pretty ColorText -> Either (Pretty ColorText) NameSegment
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) NameSegment)
-> Pretty ColorText -> Either (Pretty ColorText) NameSegment
forall a b. (a -> b) -> a -> b
$ Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text Text
"Wanted a single relative name segment, but it wasn’t."

handleNameArg :: I.Argument -> Either (P.Pretty CT.ColorText) Name
handleNameArg :: Argument -> Either (Pretty ColorText) Name
handleNameArg =
  (String -> Either (Pretty ColorText) Name)
-> (StructuredArgument -> Either (Pretty ColorText) Name)
-> Argument
-> Either (Pretty ColorText) Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    ((Text -> Pretty ColorText)
-> Either Text Name -> Either (Pretty ColorText) Name
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 Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Either Text Name -> Either (Pretty ColorText) Name)
-> (String -> Either Text Name)
-> String
-> Either (Pretty ColorText) Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Name
Name.parseTextEither (Text -> Either Text Name)
-> (String -> Text) -> String -> Either Text Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack)
    \case
      SA.Name Name
name -> Name -> Either (Pretty ColorText) Name
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
name
      SA.NameWithBranchPrefix (BranchAtSCH ShortCausalHash
_) Name
name -> Name -> Either (Pretty ColorText) Name
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
name
      SA.NameWithBranchPrefix (BranchAtPath Absolute
prefix) Name
name -> Name -> Either (Pretty ColorText) Name
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Either (Pretty ColorText) Name)
-> Name -> Either (Pretty ColorText) Name
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) Name
name
      SA.HashQualified HashQualified Name
hqname -> Either (Pretty ColorText) Name
-> (Name -> Either (Pretty ColorText) Name)
-> Maybe Name
-> Either (Pretty ColorText) Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Pretty ColorText -> Either (Pretty ColorText) Name
forall a b. a -> Either a b
Left Pretty ColorText
"can’t find a name from the numbered arg") Name -> Either (Pretty ColorText) Name
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Name -> Either (Pretty ColorText) Name)
-> Maybe Name -> Either (Pretty ColorText) Name
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName HashQualified Name
hqname
      SA.HashQualifiedWithBranchPrefix (BranchAtSCH ShortCausalHash
_) HashQualified Name
hqname -> Name -> Either (Pretty ColorText) Name
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Either (Pretty ColorText) Name)
-> Name -> Either (Pretty ColorText) Name
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
hqname
      SA.HashQualifiedWithBranchPrefix (BranchAtPath Absolute
prefix) HashQualified Name
hqname ->
        Name -> Either (Pretty ColorText) Name
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Either (Pretty ColorText) Name)
-> (Name -> Name) -> Name -> Either (Pretty ColorText) Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Name -> Name
Path.prefixNameIfRel (Absolute -> Path'
Path.AbsolutePath' Absolute
prefix) (Name -> Either (Pretty ColorText) Name)
-> Name -> Either (Pretty ColorText) Name
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName HashQualified Name
hqname
      SA.ShallowListEntry Path'
prefix ShallowListEntry Symbol Ann
entry ->
        Name -> Either (Pretty ColorText) Name
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Either (Pretty ColorText) Name)
-> (HashQualified Name -> Name)
-> HashQualified Name
-> Either (Pretty ColorText) Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Name
forall n. HashQualified n -> n
HQ'.toName (HashQualified Name -> Name)
-> (HashQualified Name -> HashQualified Name)
-> HashQualified Name
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Name) -> HashQualified Name -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path' -> Name -> Name
Path.prefixNameIfRel Path'
prefix) (HashQualified Name -> Either (Pretty ColorText) Name)
-> HashQualified Name -> Either (Pretty ColorText) Name
forall a b. (a -> b) -> a -> b
$ ShallowListEntry Symbol Ann -> HashQualified Name
forall v. ShallowListEntry v Ann -> HashQualified Name
shallowListEntryToHQ' ShallowListEntry Symbol Ann
entry
      SA.SearchResult Maybe Path'
mpath SearchResult
result ->
        Either (Pretty ColorText) Name
-> (Name -> Either (Pretty ColorText) Name)
-> Maybe Name
-> Either (Pretty ColorText) Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Pretty ColorText -> Either (Pretty ColorText) Name
forall a b. a -> Either a b
Left Pretty ColorText
"can’t find a name from the numbered arg") Name -> Either (Pretty ColorText) Name
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Name -> Either (Pretty ColorText) Name)
-> (HashQualified Name -> Maybe Name)
-> HashQualified Name
-> Either (Pretty ColorText) Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName (HashQualified Name -> Either (Pretty ColorText) Name)
-> HashQualified Name -> Either (Pretty ColorText) Name
forall a b. (a -> b) -> a -> b
$ Maybe Path' -> SearchResult -> HashQualified Name
searchResultToHQ Maybe Path'
mpath SearchResult
result
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) Name
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Name)
-> Pretty ColorText -> Either (Pretty ColorText) Name
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a name" StructuredArgument
otherNumArg

handlePullSourceArg ::
  I.Argument ->
  Either
    (P.Pretty CT.ColorText)
    (ReadRemoteNamespace (These ProjectName ProjectBranchNameOrLatestRelease))
handlePullSourceArg :: Argument
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
handlePullSourceArg =
  (String
 -> Either
      (Pretty ColorText)
      (ReadRemoteNamespace
         (These ProjectName ProjectBranchNameOrLatestRelease)))
-> (StructuredArgument
    -> Either
         (Pretty ColorText)
         (ReadRemoteNamespace
            (These ProjectName ProjectBranchNameOrLatestRelease)))
-> Argument
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (Parsec
  Void
  Text
  (ReadRemoteNamespace
     (These ProjectName ProjectBranchNameOrLatestRelease))
-> Text
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall a. Parsec Void Text a -> Text -> Either (Pretty ColorText) a
megaparse (ProjectBranchSpecifier ProjectBranchNameOrLatestRelease
-> Parsec
     Void
     Text
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall branch.
ProjectBranchSpecifier branch
-> P (ReadRemoteNamespace (These ProjectName branch))
readRemoteNamespaceParser ProjectBranchSpecifier ProjectBranchNameOrLatestRelease
ProjectBranchSpecifier'NameOrLatestRelease) (Text
 -> Either
      (Pretty ColorText)
      (ReadRemoteNamespace
         (These ProjectName ProjectBranchNameOrLatestRelease)))
-> (String -> Text)
-> String
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack)
    \case
      SA.Project ProjectName
project -> ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadRemoteNamespace
   (These ProjectName ProjectBranchNameOrLatestRelease)
 -> Either
      (Pretty ColorText)
      (ReadRemoteNamespace
         (These ProjectName ProjectBranchNameOrLatestRelease)))
-> (These ProjectName ProjectBranchNameOrLatestRelease
    -> ReadRemoteNamespace
         (These ProjectName ProjectBranchNameOrLatestRelease))
-> These ProjectName ProjectBranchNameOrLatestRelease
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These ProjectName ProjectBranchNameOrLatestRelease
-> ReadRemoteNamespace
     (These ProjectName ProjectBranchNameOrLatestRelease)
forall a. a -> ReadRemoteNamespace a
RemoteRepo.ReadShare'ProjectBranch (These ProjectName ProjectBranchNameOrLatestRelease
 -> Either
      (Pretty ColorText)
      (ReadRemoteNamespace
         (These ProjectName ProjectBranchNameOrLatestRelease)))
-> These ProjectName ProjectBranchNameOrLatestRelease
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall a b. (a -> b) -> a -> b
$ ProjectName -> These ProjectName ProjectBranchNameOrLatestRelease
forall a b. a -> These a b
This ProjectName
project
      SA.ProjectBranch (ProjectAndBranch Maybe ProjectName
project ProjectBranchName
branch) ->
        ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadRemoteNamespace
   (These ProjectName ProjectBranchNameOrLatestRelease)
 -> Either
      (Pretty ColorText)
      (ReadRemoteNamespace
         (These ProjectName ProjectBranchNameOrLatestRelease)))
-> (ProjectBranchNameOrLatestRelease
    -> ReadRemoteNamespace
         (These ProjectName ProjectBranchNameOrLatestRelease))
-> ProjectBranchNameOrLatestRelease
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These ProjectName ProjectBranchNameOrLatestRelease
-> ReadRemoteNamespace
     (These ProjectName ProjectBranchNameOrLatestRelease)
forall a. a -> ReadRemoteNamespace a
RemoteRepo.ReadShare'ProjectBranch (These ProjectName ProjectBranchNameOrLatestRelease
 -> ReadRemoteNamespace
      (These ProjectName ProjectBranchNameOrLatestRelease))
-> (ProjectBranchNameOrLatestRelease
    -> These ProjectName ProjectBranchNameOrLatestRelease)
-> ProjectBranchNameOrLatestRelease
-> ReadRemoteNamespace
     (These ProjectName ProjectBranchNameOrLatestRelease)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectBranchNameOrLatestRelease
 -> These ProjectName ProjectBranchNameOrLatestRelease)
-> (ProjectName
    -> ProjectBranchNameOrLatestRelease
    -> These ProjectName ProjectBranchNameOrLatestRelease)
-> Maybe ProjectName
-> ProjectBranchNameOrLatestRelease
-> These ProjectName ProjectBranchNameOrLatestRelease
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProjectBranchNameOrLatestRelease
-> These ProjectName ProjectBranchNameOrLatestRelease
forall a b. b -> These a b
That ProjectName
-> ProjectBranchNameOrLatestRelease
-> These ProjectName ProjectBranchNameOrLatestRelease
forall a b. a -> b -> These a b
These Maybe ProjectName
project (ProjectBranchNameOrLatestRelease
 -> Either
      (Pretty ColorText)
      (ReadRemoteNamespace
         (These ProjectName ProjectBranchNameOrLatestRelease)))
-> ProjectBranchNameOrLatestRelease
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall a b. (a -> b) -> a -> b
$
          ProjectBranchName -> ProjectBranchNameOrLatestRelease
ProjectBranchNameOrLatestRelease'Name ProjectBranchName
branch
      StructuredArgument
otherNumArg -> Pretty ColorText
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either
      (Pretty ColorText)
      (ReadRemoteNamespace
         (These ProjectName ProjectBranchNameOrLatestRelease)))
-> Pretty ColorText
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a source to pull from" StructuredArgument
otherNumArg

handlePushTargetArg ::
  I.Argument -> Either (P.Pretty CT.ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg :: Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg =
  (String
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> (StructuredArgument
    -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\String
str -> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> (These ProjectName ProjectBranchName
    -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> Maybe (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Pretty ColorText
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> Pretty ColorText
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ Text -> String -> Pretty ColorText
expectedButActually' Text
"a target to push to" String
str) These ProjectName ProjectBranchName
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (These ProjectName ProjectBranchName)
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> Maybe (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ String -> Maybe (These ProjectName ProjectBranchName)
parsePushTarget String
str)
    ((StructuredArgument
  -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
 -> Argument
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> (StructuredArgument
    -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ \case
      SA.Project ProjectName
project -> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These ProjectName ProjectBranchName
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ ProjectName -> These ProjectName ProjectBranchName
forall a b. a -> These a b
This ProjectName
project
      SA.ProjectBranch (ProjectAndBranch Maybe ProjectName
project ProjectBranchName
branch) -> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These ProjectName ProjectBranchName
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ (ProjectBranchName -> These ProjectName ProjectBranchName)
-> (ProjectName
    -> ProjectBranchName -> These ProjectName ProjectBranchName)
-> Maybe ProjectName
-> ProjectBranchName
-> These ProjectName ProjectBranchName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These Maybe ProjectName
project ProjectBranchName
branch
      StructuredArgument
otherNumArg -> Pretty ColorText
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> Pretty ColorText
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a target to push to" StructuredArgument
otherNumArg

handlePushSourceArg :: I.Argument -> Either (P.Pretty CT.ColorText) Input.PushSource
handlePushSourceArg :: Argument -> Either (Pretty ColorText) PushSource
handlePushSourceArg =
  (String -> Either (Pretty ColorText) PushSource)
-> (StructuredArgument -> Either (Pretty ColorText) PushSource)
-> Argument
-> Either (Pretty ColorText) PushSource
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\String
str -> Either (Pretty ColorText) PushSource
-> (PushSource -> Either (Pretty ColorText) PushSource)
-> Maybe PushSource
-> Either (Pretty ColorText) PushSource
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Pretty ColorText -> Either (Pretty ColorText) PushSource
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) PushSource)
-> Pretty ColorText -> Either (Pretty ColorText) PushSource
forall a b. (a -> b) -> a -> b
$ Text -> String -> Pretty ColorText
expectedButActually' Text
"a source to push from" String
str) PushSource -> Either (Pretty ColorText) PushSource
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PushSource -> Either (Pretty ColorText) PushSource)
-> Maybe PushSource -> Either (Pretty ColorText) PushSource
forall a b. (a -> b) -> a -> b
$ String -> Maybe PushSource
parsePushSource String
str)
    \case
      SA.Project ProjectName
project -> PushSource -> Either (Pretty ColorText) PushSource
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PushSource -> Either (Pretty ColorText) PushSource)
-> (These ProjectName ProjectBranchName -> PushSource)
-> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) PushSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These ProjectName ProjectBranchName -> PushSource
Input.ProjySource (These ProjectName ProjectBranchName
 -> Either (Pretty ColorText) PushSource)
-> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) PushSource
forall a b. (a -> b) -> a -> b
$ ProjectName -> These ProjectName ProjectBranchName
forall a b. a -> These a b
This ProjectName
project
      SA.ProjectBranch (ProjectAndBranch Maybe ProjectName
project ProjectBranchName
branch) -> PushSource -> Either (Pretty ColorText) PushSource
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PushSource -> Either (Pretty ColorText) PushSource)
-> (These ProjectName ProjectBranchName -> PushSource)
-> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) PushSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. These ProjectName ProjectBranchName -> PushSource
Input.ProjySource (These ProjectName ProjectBranchName
 -> Either (Pretty ColorText) PushSource)
-> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) PushSource
forall a b. (a -> b) -> a -> b
$ (ProjectBranchName -> These ProjectName ProjectBranchName)
-> (ProjectName
    -> ProjectBranchName -> These ProjectName ProjectBranchName)
-> Maybe ProjectName
-> ProjectBranchName
-> These ProjectName ProjectBranchName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These Maybe ProjectName
project ProjectBranchName
branch
      StructuredArgument
otherNumArg -> Pretty ColorText -> Either (Pretty ColorText) PushSource
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) PushSource)
-> Pretty ColorText -> Either (Pretty ColorText) PushSource
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a source to push from" StructuredArgument
otherNumArg

handleProjectAndBranchNamesArg :: I.Argument -> Either (P.Pretty CT.ColorText) ProjectAndBranchNames
handleProjectAndBranchNamesArg :: Argument -> Either (Pretty ColorText) ProjectAndBranchNames
handleProjectAndBranchNamesArg =
  (String -> Either (Pretty ColorText) ProjectAndBranchNames)
-> (StructuredArgument
    -> Either (Pretty ColorText) ProjectAndBranchNames)
-> Argument
-> Either (Pretty ColorText) ProjectAndBranchNames
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\String
str -> (TryFromException Text ProjectAndBranchNames -> Pretty ColorText)
-> Either
     (TryFromException Text ProjectAndBranchNames) ProjectAndBranchNames
-> Either (Pretty ColorText) ProjectAndBranchNames
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
-> TryFromException Text ProjectAndBranchNames -> Pretty ColorText
forall a b. a -> b -> a
const (Pretty ColorText
 -> TryFromException Text ProjectAndBranchNames -> Pretty ColorText)
-> Pretty ColorText
-> TryFromException Text ProjectAndBranchNames
-> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Text -> String -> Pretty ColorText
expectedButActually' Text
"a project or branch" String
str) (Either
   (TryFromException Text ProjectAndBranchNames) ProjectAndBranchNames
 -> Either (Pretty ColorText) ProjectAndBranchNames)
-> (Text
    -> Either
         (TryFromException Text ProjectAndBranchNames)
         ProjectAndBranchNames)
-> Text
-> Either (Pretty ColorText) ProjectAndBranchNames
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @ProjectAndBranchNames (Text -> Either (Pretty ColorText) ProjectAndBranchNames)
-> Text -> Either (Pretty ColorText) ProjectAndBranchNames
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
str)
    ((StructuredArgument
  -> Either (Pretty ColorText) ProjectAndBranchNames)
 -> Argument -> Either (Pretty ColorText) ProjectAndBranchNames)
-> (StructuredArgument
    -> Either (Pretty ColorText) ProjectAndBranchNames)
-> Argument
-> Either (Pretty ColorText) ProjectAndBranchNames
forall a b. (a -> b) -> a -> b
$ (These ProjectName ProjectBranchName -> ProjectAndBranchNames)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) ProjectAndBranchNames
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap These ProjectName ProjectBranchName -> ProjectAndBranchNames
ProjectAndBranchNames'Unambiguous (Either (Pretty ColorText) (These ProjectName ProjectBranchName)
 -> Either (Pretty ColorText) ProjectAndBranchNames)
-> (StructuredArgument
    -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> StructuredArgument
-> Either (Pretty ColorText) ProjectAndBranchNames
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      SA.Project ProjectName
project -> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These ProjectName ProjectBranchName
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ ProjectName -> These ProjectName ProjectBranchName
forall a b. a -> These a b
This ProjectName
project
      SA.ProjectBranch (ProjectAndBranch Maybe ProjectName
mproj ProjectBranchName
branch) -> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These ProjectName ProjectBranchName
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> These ProjectName ProjectBranchName
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ (ProjectBranchName -> These ProjectName ProjectBranchName)
-> (ProjectName
    -> ProjectBranchName -> These ProjectName ProjectBranchName)
-> Maybe ProjectName
-> ProjectBranchName
-> These ProjectName ProjectBranchName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These Maybe ProjectName
mproj ProjectBranchName
branch
      StructuredArgument
otherNumArg -> Pretty ColorText
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. a -> Either a b
Left (Pretty ColorText
 -> Either (Pretty ColorText) (These ProjectName ProjectBranchName))
-> Pretty ColorText
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ Text -> StructuredArgument -> Pretty ColorText
wrongStructuredArgument Text
"a project or branch" StructuredArgument
otherNumArg

mergeBuiltins :: InputPattern
mergeBuiltins :: InputPattern
mergeBuiltins =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"builtins.merge"
    []
    Visibility
I.Hidden
    [(Text
"namespace", IsOptional
Optional, ArgumentType
namespaceArg)]
    Pretty ColorText
"Adds the builtins (excluding `io` and misc) to the specified namespace. Defaults to `builtin.`"
    \case
      [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> (Maybe Path -> Input)
-> Maybe Path
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Path -> Input
Input.MergeBuiltinsI (Maybe Path -> Either (Pretty ColorText) Input)
-> Maybe Path -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Maybe Path
forall a. Maybe a
Nothing
      [Argument
p] -> Maybe Path -> Input
Input.MergeBuiltinsI (Maybe Path -> Input) -> (Path -> Maybe Path) -> Path -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Maybe Path
forall a. a -> Maybe a
Just (Path -> Input)
-> Either (Pretty ColorText) Path
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Path
handlePathArg Argument
p
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args

mergeIOBuiltins :: InputPattern
mergeIOBuiltins :: InputPattern
mergeIOBuiltins =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"builtins.mergeio"
    []
    Visibility
I.Hidden
    [(Text
"namespace", IsOptional
Optional, ArgumentType
namespaceArg)]
    Pretty ColorText
"Adds all the builtins, including `io` and misc., to the specified namespace. Defaults to `builtin.`"
    \case
      [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> (Maybe Path -> Input)
-> Maybe Path
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Path -> Input
Input.MergeIOBuiltinsI (Maybe Path -> Either (Pretty ColorText) Input)
-> Maybe Path -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Maybe Path
forall a. Maybe a
Nothing
      [Argument
p] -> Maybe Path -> Input
Input.MergeIOBuiltinsI (Maybe Path -> Input) -> (Path -> Maybe Path) -> Path -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Maybe Path
forall a. a -> Maybe a
Just (Path -> Input)
-> Either (Pretty ColorText) Path
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Path
handlePathArg Argument
p
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args

updateBuiltins :: InputPattern
updateBuiltins :: InputPattern
updateBuiltins =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"builtins.update"
    []
    Visibility
I.Hidden
    []
    ( Pretty ColorText
"Adds all the builtins that are missing from this namespace, "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"and deprecate the ones that don't exist in this version of Unison."
    )
    (Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> (Input -> Either (Pretty ColorText) Input)
-> Input
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Arguments -> Either (Pretty ColorText) Input)
-> Input -> Arguments -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input
Input.UpdateBuiltinsI)

todo :: InputPattern
todo :: InputPattern
todo =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"todo"
    []
    Visibility
I.Visible
    []
    ( 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
$
        InputPattern -> Pretty ColorText
makeExample' InputPattern
todo
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"lists the current namespace's outstanding issues, including conflicted names, dependencies with missing"
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"names, and merge precondition violations."
    )
    \case
      [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.TodoI
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args

load :: InputPattern
load :: InputPattern
load =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"load"
    []
    Visibility
I.Visible
    [(Text
"scratch file", IsOptional
Optional, ArgumentType
filePathArg)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( InputPattern -> Pretty ColorText
makeExample' InputPattern
load,
            Pretty ColorText
"parses, typechecks, and evaluates the most recent scratch file."
          ),
          ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
load [Pretty ColorText
"<scratch file>"],
            Pretty ColorText
"parses, typechecks, and evaluates the given scratch file."
          )
        ]
    )
    \case
      [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Maybe String -> Input
Input.LoadI Maybe String
forall a. Maybe a
Nothing
      [Argument
file] -> Maybe String -> Input
Input.LoadI (Maybe String -> Input)
-> (String -> Maybe String) -> String -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Input)
-> Either (Pretty ColorText) String
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
load Text
"a file name" Argument
file
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args

clear :: InputPattern
clear :: InputPattern
clear =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"clear"
    []
    Visibility
I.Visible
    []
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( InputPattern -> Pretty ColorText
makeExample' InputPattern
clear,
            Pretty ColorText
"Clears the screen."
          )
        ]
    )
    \case
      [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
Input.ClearI
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args

add :: InputPattern
add :: InputPattern
add =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"add"
    []
    Visibility
I.Visible
    [(Text
"definition", IsOptional
ZeroPlus, ArgumentType
noCompletionsArg)]
    ( Pretty ColorText
"`add` adds to the codebase all the definitions from the most recently "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"typechecked file."
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ ([Name] -> Input)
-> Either (Pretty ColorText) [Name]
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set Name -> Input
Input.AddI (Set Name -> Input) -> ([Name] -> Set Name) -> [Name] -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList) (Either (Pretty ColorText) [Name]
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) [Name])
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) Name)
-> Arguments -> Either (Pretty ColorText) [Name]
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 Argument -> Either (Pretty ColorText) Name
handleNameArg

previewAdd :: InputPattern
previewAdd :: InputPattern
previewAdd =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"add.preview"
    []
    Visibility
I.Visible
    [(Text
"definition", IsOptional
ZeroPlus, ArgumentType
noCompletionsArg)]
    ( Pretty ColorText
"`add.preview` previews additions to the codebase from the most recently "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"typechecked file. This command only displays cached typechecking "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"results. Use `load` to reparse & typecheck the file if the context "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"has changed."
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ ([Name] -> Input)
-> Either (Pretty ColorText) [Name]
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set Name -> Input
Input.PreviewAddI (Set Name -> Input) -> ([Name] -> Set Name) -> [Name] -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList) (Either (Pretty ColorText) [Name]
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) [Name])
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) Name)
-> Arguments -> Either (Pretty ColorText) [Name]
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 Argument -> Either (Pretty ColorText) Name
handleNameArg

update :: InputPattern
update :: InputPattern
update =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"update",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help =
        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
"Adds everything in the most recently typechecked file to the namespace,"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"replacing existing definitions having the same name, and attempts to update all the existing dependents accordingly. If the process"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"can't be completed automatically, the dependents will be added back to the scratch file"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"for your review.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
Input.Update2I
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args
    }

updateOldNoPatch :: InputPattern
updateOldNoPatch :: InputPattern
updateOldNoPatch =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"update.old.nopatch"
    []
    Visibility
I.Visible
    [(Text
"definition", IsOptional
ZeroPlus, ArgumentType
noCompletionsArg)]
    ( Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
        ( InputPattern -> Pretty ColorText
makeExample' InputPattern
updateOldNoPatch
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"works like"
            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 (InputPattern -> Pretty ColorText
makeExample' InputPattern
updateOld 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
"except it doesn't add a patch entry for any updates. "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"Use this when you want to make changes to definitions without "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"pushing those changes to dependents beyond your codebase. "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"An example is when updating docs, or when updating a term you "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"just added."
        )
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ ( InputPattern -> Pretty ColorText
makeExample' InputPattern
updateOldNoPatch,
              Pretty ColorText
"updates all definitions in the .u file."
            ),
            ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
updateOldNoPatch [Pretty ColorText
"foo", Pretty ColorText
"bar"],
              Pretty ColorText
"updates `foo`, `bar`, and their dependents from the .u file."
            )
          ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ ([Name] -> Input)
-> Either (Pretty ColorText) [Name]
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OptionalPatch -> Set Name -> Input
Input.UpdateI OptionalPatch
Input.NoPatch (Set Name -> Input) -> ([Name] -> Set Name) -> [Name] -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList) (Either (Pretty ColorText) [Name]
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) [Name])
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) Name)
-> Arguments -> Either (Pretty ColorText) [Name]
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 Argument -> Either (Pretty ColorText) Name
handleNameArg

updateOld :: InputPattern
updateOld :: InputPattern
updateOld =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"update.old"
    []
    Visibility
I.Visible
    [(Text
"patch", IsOptional
Optional, ArgumentType
patchArg), (Text
"definition", IsOptional
ZeroPlus, ArgumentType
noCompletionsArg)]
    ( Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
        ( InputPattern -> Pretty ColorText
makeExample' InputPattern
updateOld
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"works like"
            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 (InputPattern -> Pretty ColorText
makeExample' InputPattern
add 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
"except that if a definition in the file has the same name as an"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"existing definition, the name gets updated to point to the new"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"definition. If the old definition has any dependents, `update` will"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"add those dependents to a refactoring session, specified by an"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"optional patch."
        )
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ ( InputPattern -> Pretty ColorText
makeExample' InputPattern
updateOld,
              Pretty ColorText
"adds all definitions in the .u file, noting replacements in the"
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"default patch for the current namespace."
            ),
            ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
updateOld [Pretty ColorText
"<patch>"],
              Pretty ColorText
"adds all definitions in the .u file, noting replacements in the"
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"specified patch."
            ),
            ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
updateOld [Pretty ColorText
"<patch>", Pretty ColorText
"foo", Pretty ColorText
"bar"],
              Pretty ColorText
"adds `foo`, `bar`, and their dependents from the .u file, noting"
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"any replacements into the specified patch."
            )
          ]
    )
    \case
      Argument
patchStr : Arguments
ws ->
        OptionalPatch -> Set Name -> Input
Input.UpdateI (OptionalPatch -> Set Name -> Input)
-> (Split' -> OptionalPatch) -> Split' -> Set Name -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split' -> OptionalPatch
Input.UsePatch (Split' -> Set Name -> Input)
-> Either (Pretty ColorText) Split'
-> Either (Pretty ColorText) (Set Name -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Split'
handleSplit'Arg Argument
patchStr Either (Pretty ColorText) (Set Name -> Input)
-> Either (Pretty ColorText) (Set Name)
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Name] -> Set Name)
-> Either (Pretty ColorText) [Name]
-> Either (Pretty ColorText) (Set Name)
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList ((Argument -> Either (Pretty ColorText) Name)
-> Arguments -> Either (Pretty ColorText) [Name]
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 Argument -> Either (Pretty ColorText) Name
handleNameArg Arguments
ws)
      [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ OptionalPatch -> Set Name -> Input
Input.UpdateI OptionalPatch
Input.DefaultPatch Set Name
forall a. Monoid a => a
mempty

previewUpdate :: InputPattern
previewUpdate :: InputPattern
previewUpdate =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"update.old.preview"
    []
    Visibility
I.Visible
    [(Text
"definition", IsOptional
ZeroPlus, ArgumentType
noCompletionsArg)]
    ( Pretty ColorText
"`update.old.preview` previews updates to the codebase from the most "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"recently typechecked file. This command only displays cached "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"typechecking results. Use `load` to reparse & typecheck the file if "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"the context has changed."
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ ([Name] -> Input)
-> Either (Pretty ColorText) [Name]
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set Name -> Input
Input.PreviewUpdateI (Set Name -> Input) -> ([Name] -> Set Name) -> [Name] -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Set Name
forall a. Ord a => [a] -> Set a
Set.fromList) (Either (Pretty ColorText) [Name]
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) [Name])
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) Name)
-> Arguments -> Either (Pretty ColorText) [Name]
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 Argument -> Either (Pretty ColorText) Name
handleNameArg

view :: InputPattern
view :: InputPattern
view =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"view"
    []
    Visibility
I.Visible
    [(Text
"definition to view", IsOptional
OnePlus, ArgumentType
definitionQueryArg)]
    ( [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
view [Pretty ColorText
"foo"] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"shows definitions named `foo` within your current namespace.",
          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
$ InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
view [] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH.",
          Pretty ColorText
" ", -- hmm, this blankline seems to be ignored by pretty printer
          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
"Supports glob syntax, where ? acts a wildcard, so"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
view [Pretty ColorText
"List.?"]
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"will show `List.map`, `List.filter`, etc, but "
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"not `List.map.doc` (since ? only matches 1 name segment)."
        ]
    )
    ( Either (Pretty ColorText) Input
-> (NonEmpty Argument -> Either (Pretty ColorText) Input)
-> Maybe (NonEmpty Argument)
-> Either (Pretty ColorText) Input
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Text -> [Any] -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least one argument" [])
        ( (NonEmpty (HashQualified Name) -> Input)
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OutputLocation
-> ShowDefinitionScope -> NonEmpty (HashQualified Name) -> Input
Input.ShowDefinitionI OutputLocation
Input.ConsoleLocation ShowDefinitionScope
Input.ShowDefinitionLocal)
            (Either (Pretty ColorText) (NonEmpty (HashQualified Name))
 -> Either (Pretty ColorText) Input)
-> (NonEmpty Argument
    -> Either (Pretty ColorText) (NonEmpty (HashQualified Name)))
-> NonEmpty Argument
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) (HashQualified Name))
-> NonEmpty Argument
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
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) -> NonEmpty a -> f (NonEmpty b)
traverse Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg
        )
        (Maybe (NonEmpty Argument) -> Either (Pretty ColorText) Input)
-> (Arguments -> Maybe (NonEmpty Argument))
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments -> Maybe (NonEmpty Argument)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
    )

viewGlobal :: InputPattern
viewGlobal :: InputPattern
viewGlobal =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"view.global"
    []
    Visibility
I.Visible
    [(Text
"definition to view", IsOptional
ZeroPlus, ArgumentType
definitionQueryArg)]
    ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty ColorText
"`view.global foo` prints definitions of `foo` within your codebase.",
          Pretty ColorText
"`view.global` without arguments invokes a search to select definitions to view, which requires that `fzf` can be found within your PATH."
        ]
    )
    ( Either (Pretty ColorText) Input
-> (NonEmpty Argument -> Either (Pretty ColorText) Input)
-> Maybe (NonEmpty Argument)
-> Either (Pretty ColorText) Input
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (Text -> [Any] -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least one argument" [])
        ( (NonEmpty (HashQualified Name) -> Input)
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OutputLocation
-> ShowDefinitionScope -> NonEmpty (HashQualified Name) -> Input
Input.ShowDefinitionI OutputLocation
Input.ConsoleLocation ShowDefinitionScope
Input.ShowDefinitionGlobal)
            (Either (Pretty ColorText) (NonEmpty (HashQualified Name))
 -> Either (Pretty ColorText) Input)
-> (NonEmpty Argument
    -> Either (Pretty ColorText) (NonEmpty (HashQualified Name)))
-> NonEmpty Argument
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) (HashQualified Name))
-> NonEmpty Argument
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
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) -> NonEmpty a -> f (NonEmpty b)
traverse Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg
        )
        (Maybe (NonEmpty Argument) -> Either (Pretty ColorText) Input)
-> (Arguments -> Maybe (NonEmpty Argument))
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments -> Maybe (NonEmpty Argument)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
    )

display :: InputPattern
display :: InputPattern
display =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"display"
    []
    Visibility
I.Visible
    [(Text
"definition to display", IsOptional
OnePlus, ArgumentType
definitionQueryArg)]
    ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty ColorText
"`display foo` prints a rendered version of the term `foo`.",
          Pretty ColorText
"`display` without arguments invokes a search to select a definition to display, which requires that `fzf` can be found within your PATH."
        ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ Either (Pretty ColorText) Input
-> (NonEmpty Argument -> Either (Pretty ColorText) Input)
-> Maybe (NonEmpty Argument)
-> Either (Pretty ColorText) Input
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Text -> [Any] -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least one argument" [])
      ((NonEmpty (HashQualified Name) -> Input)
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OutputLocation -> NonEmpty (HashQualified Name) -> Input
Input.DisplayI OutputLocation
Input.ConsoleLocation) (Either (Pretty ColorText) (NonEmpty (HashQualified Name))
 -> Either (Pretty ColorText) Input)
-> (NonEmpty Argument
    -> Either (Pretty ColorText) (NonEmpty (HashQualified Name)))
-> NonEmpty Argument
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) (HashQualified Name))
-> NonEmpty Argument
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
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) -> NonEmpty a -> f (NonEmpty b)
traverse Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg)
      (Maybe (NonEmpty Argument) -> Either (Pretty ColorText) Input)
-> (Arguments -> Maybe (NonEmpty Argument))
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments -> Maybe (NonEmpty Argument)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty

displayTo :: InputPattern
displayTo :: InputPattern
displayTo =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"display.to"
    []
    Visibility
I.Visible
    [(Text
"destination file name", IsOptional
Required, ArgumentType
filePathArg), (Text
"definition to display", IsOptional
OnePlus, ArgumentType
definitionQueryArg)]
    ( 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
$
        InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
displayTo [Pretty ColorText
"<filename>", Pretty ColorText
"foo"]
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"prints a rendered version of the term `foo` to the given file."
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      Argument
file : Arguments
defs ->
        Either (Pretty ColorText) Input
-> (NonEmpty Argument -> Either (Pretty ColorText) Input)
-> Maybe (NonEmpty Argument)
-> Either (Pretty ColorText) Input
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least two arguments" [Argument
file])
          ( \NonEmpty Argument
defs ->
              OutputLocation -> NonEmpty (HashQualified Name) -> Input
Input.DisplayI (OutputLocation -> NonEmpty (HashQualified Name) -> Input)
-> (String -> OutputLocation)
-> String
-> NonEmpty (HashQualified Name)
-> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OutputLocation
Input.FileLocation
                (String -> NonEmpty (HashQualified Name) -> Input)
-> Either (Pretty ColorText) String
-> Either
     (Pretty ColorText) (NonEmpty (HashQualified Name) -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
displayTo Text
"a file name" Argument
file
                Either (Pretty ColorText) (NonEmpty (HashQualified Name) -> Input)
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Argument -> Either (Pretty ColorText) (HashQualified Name))
-> NonEmpty Argument
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
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) -> NonEmpty a -> f (NonEmpty b)
traverse Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg NonEmpty Argument
defs
          )
          (Maybe (NonEmpty Argument) -> Either (Pretty ColorText) Input)
-> Maybe (NonEmpty Argument) -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Arguments -> Maybe (NonEmpty Argument)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty Arguments
defs
      [] -> Text -> [Any] -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least two arguments" []

docs :: InputPattern
docs :: InputPattern
docs =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"docs"
    []
    Visibility
I.Visible
    [(Text
"definition", IsOptional
OnePlus, ArgumentType
definitionQueryArg)]
    ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty ColorText
"`docs foo` shows documentation for the definition `foo`.",
          Pretty ColorText
"`docs` without arguments invokes a search to select which definition to view documentation for, which requires that `fzf` can be found within your PATH."
        ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ Either (Pretty ColorText) Input
-> (NonEmpty Argument -> Either (Pretty ColorText) Input)
-> Maybe (NonEmpty Argument)
-> Either (Pretty ColorText) Input
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> [Any] -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least one argument" []) ((NonEmpty Name -> Input)
-> Either (Pretty ColorText) (NonEmpty Name)
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Name -> Input
Input.DocsI (Either (Pretty ColorText) (NonEmpty Name)
 -> Either (Pretty ColorText) Input)
-> (NonEmpty Argument -> Either (Pretty ColorText) (NonEmpty Name))
-> NonEmpty Argument
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) Name)
-> NonEmpty Argument -> Either (Pretty ColorText) (NonEmpty Name)
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) -> NonEmpty a -> f (NonEmpty b)
traverse Argument -> Either (Pretty ColorText) Name
handleNameArg) (Maybe (NonEmpty Argument) -> Either (Pretty ColorText) Input)
-> (Arguments -> Maybe (NonEmpty Argument))
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments -> Maybe (NonEmpty Argument)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty

api :: InputPattern
api :: InputPattern
api =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"api"
    []
    Visibility
I.Visible
    []
    Pretty ColorText
"`api` provides details about the API."
    (Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> Arguments
-> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
Input.ApiI)

ui :: InputPattern
ui :: InputPattern
ui =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"ui",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"definition to load", IsOptional
Optional, ArgumentType
namespaceOrDefinitionArg)],
      $sel:help:InputPattern :: Pretty ColorText
help = Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"`ui` opens the Local UI in the default browser.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Path' -> Input
Input.UiI Path'
Path.relativeEmpty'
        [Argument
path] -> Path' -> Input
Input.UiI (Path' -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
path
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args
    }

undo :: InputPattern
undo :: InputPattern
undo =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"undo"
    []
    Visibility
I.Visible
    []
    Pretty ColorText
"`undo` reverts the most recent change to the codebase."
    (Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> Arguments
-> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
Input.UndoI)

textfind :: Bool -> InputPattern
textfind :: Bool -> InputPattern
textfind Bool
allowLib =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern String
cmdName [String]
aliases Visibility
I.Visible [(Text
"token", IsOptional
OnePlus, ArgumentType
noCompletionsArg)] Pretty ColorText
msg Arguments -> Either (Pretty ColorText) Input
parse
  where
    (String
cmdName, [String]
aliases, Pretty ColorText
alternate) = 
      if Bool
allowLib then 
        (String
"text.find.all", [String
"grep.all"], Pretty ColorText
"Use `text.find` to exclude `lib` from search.")
      else
        (String
"text.find", [String
"grep"], Pretty ColorText
"Use `text.find.all` to include search of `lib`.")
    parse :: Arguments -> Either (Pretty ColorText) Input
parse = \case
      [] -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text Text
"Please supply at least one token.")
      Arguments
words -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Bool -> [String] -> Input
Input.TextFindI Bool
allowLib ([String] -> [String]
untokenize ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [ String
e | Left String
e <- Arguments
words ])
    msg :: Pretty ColorText
msg =
      [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample (Bool -> InputPattern
textfind Bool
allowLib) [Pretty ColorText
"token1", Pretty ColorText
"\"99\"", Pretty ColorText
"token2"]
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" finds terms with literals (text or numeric) containing"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"`token1`, `99`, and `token2`.",
          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
"Numeric literals must be quoted (ex: \"42\")" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<>
                   Pretty ColorText
"but single words need not be quoted.",
          Pretty ColorText
"",
          Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
alternate
        ]

-- | Reinterprets `"` in the expected way, combining tokens until reaching 
-- the closing quote. 
-- Example: `untokenize ["\"uno", "dos\""]` becomes `["uno dos"]`.
untokenize :: [String] -> [String]
untokenize :: [String] -> [String]
untokenize [String]
words = String -> [String]
go ([String] -> String
unwords [String]
words)
  where
  go :: String -> [String]
go String
words = case String
words of
    [] -> []
    Char
'"' : String
quoted -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') String
quoted String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
go (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
quoted)
    String
unquoted -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
ok String
unquoted of 
      (String
"", String
rem) -> String -> [String]
go ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
rem)
      (String
tok, String
rem) -> String
tok String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
go ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
rem) 
      where
        ok :: Char -> Bool
ok Char
ch = Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
ch)

sfind :: InputPattern
sfind :: InputPattern
sfind =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern String
"rewrite.find" [String
"sfind"] Visibility
I.Visible [(Text
"rewrite-rule definition", IsOptional
Required, ArgumentType
definitionQueryArg)] Pretty ColorText
msg Arguments -> Either (Pretty ColorText) Input
parse
  where
    parse :: Arguments -> Either (Pretty ColorText) Input
parse = \case
      [Argument
q] -> FindScope -> HashQualified Name -> Input
Input.StructuredFindI (Path' -> FindScope
Input.FindLocal Path'
Path.relativeEmpty') (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
q
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    msg :: Pretty ColorText
msg =
      [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
sfind [Pretty ColorText
"rule1"]
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" finds definitions that match any of the left side(s) of `rule`"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"in the current namespace.",
          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
"The argument `rule1` must refer to a `@rewrite` block or a function that immediately returns"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"a `@rewrite` block."
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"It can be in the codebase or scratch file. An example:",
          Pretty ColorText
"",
          Pretty ColorText
"    -- right of ==> is ignored by this command",
          Pretty ColorText
"    rule1 x = @rewrite term x + 1 ==> ()",
          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
"Here, `x` will stand in for any expression,"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"so this rule will match "
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s -> Pretty s
P.backticked' Pretty ColorText
"(42+10+11) + 1" Pretty ColorText
".",
          Pretty ColorText
"",
          Pretty ColorText
"See https://unison-lang.org/learn/structured-find to learn more.",
          Pretty ColorText
"",
          Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText
"Also see the related command" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
sfindReplace [])
        ]

sfindReplace :: InputPattern
sfindReplace :: InputPattern
sfindReplace =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern String
"rewrite" [String
"sfind.replace"] Visibility
I.Visible [(Text
"rewrite-rule definition", IsOptional
Required, ArgumentType
definitionQueryArg)] Pretty ColorText
msg Arguments -> Either (Pretty ColorText) Input
parse
  where
    parse :: Arguments -> Either (Pretty ColorText) Input
parse [Argument
q] = HashQualified Name -> Input
Input.StructuredFindReplaceI (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
q
    parse Arguments
args = Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    msg :: P.Pretty CT.ColorText
    msg :: Pretty ColorText
msg =
      [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
sfindReplace [Pretty ColorText
"rule1"] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" rewrites definitions in the latest scratch file.",
          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
"The argument `rule1` must refer to a `@rewrite` block or a function that immediately returns"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"a `@rewrite` block."
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"It can be in the codebase or scratch file. An example:",
          Pretty ColorText
"",
          Pretty ColorText
"    rule1 x = @rewrite term x + 1 ==> Nat.increment x",
          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
"Here, `x` will stand in for any expression wherever this rewrite is applied,"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"so this rule will match "
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
P.backticked Pretty ColorText
"(42+10+11) + 1"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"and replace it with"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s -> Pretty s
P.backticked' Pretty ColorText
"Nat.increment (42+10+11)" Pretty ColorText
".",
          Pretty ColorText
"",
          Pretty ColorText
"See https://unison-lang.org/learn/structured-find to learn more.",
          Pretty ColorText
"",
          Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap (Pretty ColorText
"Also see the related command" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
sfind [])
        ]

find :: InputPattern
find :: InputPattern
find = String -> FindScope -> InputPattern
find' String
"find" (Path' -> FindScope
Input.FindLocal Path'
Path.relativeEmpty')

findAll :: InputPattern
findAll :: InputPattern
findAll = String -> FindScope -> InputPattern
find' String
"find.all" (Path' -> FindScope
Input.FindLocalAndDeps Path'
Path.relativeEmpty')

findGlobal :: InputPattern
findGlobal :: InputPattern
findGlobal = String -> FindScope -> InputPattern
find' String
"debug.find.global" FindScope
Input.FindGlobal

findIn, findInAll :: InputPattern
findIn :: InputPattern
findIn = String -> (Path' -> FindScope) -> InputPattern
findIn' String
"find-in" Path' -> FindScope
Input.FindLocal
findInAll :: InputPattern
findInAll = String -> (Path' -> FindScope) -> InputPattern
findIn' String
"find-in.all" Path' -> FindScope
Input.FindLocalAndDeps

findIn' :: String -> (Path' -> Input.FindScope) -> InputPattern
findIn' :: String -> (Path' -> FindScope) -> InputPattern
findIn' String
cmd Path' -> FindScope
mkfscope =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
cmd
    []
    Visibility
I.Visible
    [(Text
"namespace", IsOptional
Required, ArgumentType
namespaceArg), (Text
"query", IsOptional
ZeroPlus, ArgumentType
exactDefinitionArg)]
    Pretty ColorText
findHelp
    \case
      Argument
p : Arguments
args -> Bool -> FindScope -> [String] -> Input
Input.FindI Bool
False (FindScope -> [String] -> Input)
-> (Path' -> FindScope) -> Path' -> [String] -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> FindScope
mkfscope (Path' -> [String] -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) ([String] -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
p Either (Pretty ColorText) ([String] -> Input)
-> Either (Pretty ColorText) [String]
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String] -> Either (Pretty ColorText) [String]
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Argument -> String
unifyArgument (Argument -> String) -> Arguments -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Arguments
args)
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least one argument" Arguments
args

findHelp :: P.Pretty CT.ColorText
findHelp :: Pretty ColorText
findHelp =
  ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
      [ (Pretty ColorText
"`find`", Pretty ColorText
"lists all definitions in the current namespace."),
        ( Pretty ColorText
"`find foo`",
          Pretty ColorText
"lists all definitions with a name similar to 'foo' in the current "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"namespace (excluding those under 'lib')."
        ),
        ( Pretty ColorText
"`find foo bar`",
          Pretty ColorText
"lists all definitions with a name similar to 'foo' or 'bar' in the "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"current namespace (excluding those under 'lib')."
        ),
        ( Pretty ColorText
"`find-in namespace`",
          Pretty ColorText
"lists all definitions in the specified subnamespace."
        ),
        ( Pretty ColorText
"`find-in namespace foo bar`",
          Pretty ColorText
"lists all definitions with a name similar to 'foo' or 'bar' in the "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"specified subnamespace."
        ),
        ( Pretty ColorText
"find.all foo",
          Pretty ColorText
"lists all definitions with a name similar to 'foo' in the current "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"namespace (including one level of 'lib')."
        ),
        ( Pretty ColorText
"`find-in.all namespace`",
          Pretty ColorText
"lists all definitions in the specified subnamespace (including one level of its 'lib')."
        ),
        ( Pretty ColorText
"`find-in.all namespace foo bar`",
          Pretty ColorText
"lists all definitions with a name similar to 'foo' or 'bar' in the "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"specified subnamespace (including one level of its 'lib')."
        ),
        ( Pretty ColorText
"debug.find.global foo",
          Pretty ColorText
"Iteratively searches all projects and branches and lists all definitions with a name similar to 'foo'. Note that this is a very slow operation."
        )
      ]
  )

find' :: String -> Input.FindScope -> InputPattern
find' :: String -> FindScope -> InputPattern
find' String
cmd FindScope
fscope =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
cmd
    []
    Visibility
I.Visible
    [(Text
"query", IsOptional
ZeroPlus, ArgumentType
exactDefinitionArg)]
    Pretty ColorText
findHelp
    (Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> (Arguments -> Input)
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FindScope -> [String] -> Input
Input.FindI Bool
False FindScope
fscope ([String] -> Input)
-> (Arguments -> [String]) -> Arguments -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> String) -> Arguments -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Argument -> String
unifyArgument)

findShallow :: InputPattern
findShallow :: InputPattern
findShallow =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"list"
    [String
"ls", String
"dir"]
    Visibility
I.Visible
    [(Text
"namespace", IsOptional
Optional, ArgumentType
namespaceArg)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ (Pretty ColorText
"`list`", Pretty ColorText
"lists definitions and namespaces at the current level of the current namespace."),
          (Pretty ColorText
"`list foo`", Pretty ColorText
"lists the 'foo' namespace."),
          (Pretty ColorText
"`list .foo`", Pretty ColorText
"lists the '.foo' namespace.")
        ]
    )
    ( (Path' -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path' -> Input
Input.FindShallowI (Either (Pretty ColorText) Path'
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) Path')
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        [] -> Path' -> Either (Pretty ColorText) Path'
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path'
Path.relativeEmpty'
        [Argument
path] -> Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
path
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Path'
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args
    )

findVerbose :: InputPattern
findVerbose :: InputPattern
findVerbose =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"find.verbose"
    []
    Visibility
I.Visible
    [(Text
"query", IsOptional
ZeroPlus, ArgumentType
exactDefinitionArg)]
    ( Pretty ColorText
"`find.verbose` searches for definitions like `find`, but includes hashes "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"and aliases in the results."
    )
    (Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> (Arguments -> Input)
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FindScope -> [String] -> Input
Input.FindI Bool
True (Path' -> FindScope
Input.FindLocal Path'
Path.relativeEmpty') ([String] -> Input)
-> (Arguments -> [String]) -> Arguments -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> String) -> Arguments -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Argument -> String
unifyArgument)

findVerboseAll :: InputPattern
findVerboseAll :: InputPattern
findVerboseAll =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"find.all.verbose"
    []
    Visibility
I.Visible
    [(Text
"query", IsOptional
ZeroPlus, ArgumentType
exactDefinitionArg)]
    ( Pretty ColorText
"`find.all.verbose` searches for definitions like `find.all`, but includes hashes "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"and aliases in the results."
    )
    (Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> (Arguments -> Input)
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FindScope -> [String] -> Input
Input.FindI Bool
True (Path' -> FindScope
Input.FindLocalAndDeps Path'
Path.relativeEmpty') ([String] -> Input)
-> (Arguments -> [String]) -> Arguments -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> String) -> Arguments -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Argument -> String
unifyArgument)

renameTerm :: InputPattern
renameTerm :: InputPattern
renameTerm =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"move.term"
    [String
"rename.term"]
    Visibility
I.Visible
    [ (Text
"definition to move", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg),
      (Text
"new location", IsOptional
Required, ArgumentType
newNameArg)
    ]
    Pretty ColorText
"`move.term foo bar` renames `foo` to `bar`."
    \case
      [Argument
oldName, Argument
newName] -> HQSplit' -> Split' -> Input
Input.MoveTermI (HQSplit' -> Split' -> Input)
-> Either (Pretty ColorText) HQSplit'
-> Either (Pretty ColorText) (Split' -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) HQSplit'
handleHashQualifiedSplit'Arg Argument
oldName Either (Pretty ColorText) (Split' -> Input)
-> Either (Pretty ColorText) Split'
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) Split'
handleNewName Argument
newName
      Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
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
"`rename.term` takes two arguments, like `rename.term oldname newname`."

moveAll :: InputPattern
moveAll :: InputPattern
moveAll =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"move"
    [String
"rename"]
    Visibility
I.Visible
    [ (Text
"definition to move", IsOptional
Required, ArgumentType
namespaceOrDefinitionArg),
      (Text
"new location", IsOptional
Required, ArgumentType
newNameArg)
    ]
    Pretty ColorText
"`move foo bar` renames the term, type, and namespace foo to bar."
    \case
      [Argument
oldName, Argument
newName] -> Path' -> Path' -> Input
Input.MoveAllI (Path' -> Path' -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) (Path' -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
oldName Either (Pretty ColorText) (Path' -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) Path'
handleNewPath Argument
newName
      Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
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
"`move` takes two arguments, like `move oldname newname`."

renameType :: InputPattern
renameType :: InputPattern
renameType =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"move.type"
    [String
"rename.type"]
    Visibility
I.Visible
    [ (Text
"type to move", IsOptional
Required, ArgumentType
exactDefinitionTypeQueryArg),
      (Text
"new location", IsOptional
Required, ArgumentType
newNameArg)
    ]
    Pretty ColorText
"`move.type foo bar` renames `foo` to `bar`."
    \case
      [Argument
oldName, Argument
newName] -> HQSplit' -> Split' -> Input
Input.MoveTypeI (HQSplit' -> Split' -> Input)
-> Either (Pretty ColorText) HQSplit'
-> Either (Pretty ColorText) (Split' -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) HQSplit'
handleHashQualifiedSplit'Arg Argument
oldName Either (Pretty ColorText) (Split' -> Input)
-> Either (Pretty ColorText) Split'
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) Split'
handleNewName Argument
newName
      Arguments
_ ->
        Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
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
"`rename.type` takes two arguments, like `rename.type oldname newname`."

deleteGen :: Maybe String -> ArgumentType -> String -> ([Path.HQSplit'] -> DeleteTarget) -> InputPattern
deleteGen :: Maybe String
-> ArgumentType
-> String
-> ([HQSplit'] -> DeleteTarget)
-> InputPattern
deleteGen Maybe String
suffix ArgumentType
queryCompletionArg String
target [HQSplit'] -> DeleteTarget
mkTarget =
  let cmd :: String
cmd = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"delete" (String
"delete." String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) Maybe String
suffix
      info :: Pretty ColorText
info =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ ( Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep
                Pretty ColorText
" "
                [ Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
backtick (Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty ColorText
" " [String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string String
cmd, Pretty ColorText
"foo"]),
                  Pretty ColorText
"removes the",
                  String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string String
target,
                  Pretty ColorText
"name `foo` from the namespace."
                ],
              Pretty ColorText
""
            ),
            ( Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep
                Pretty ColorText
" "
                [ Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
backtick (Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty ColorText
" " [String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string String
cmd, Pretty ColorText
"foo bar"]),
                  Pretty ColorText
"removes the",
                  String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string String
target,
                  Pretty ColorText
"name `foo` and `bar` from the namespace."
                ],
              Pretty ColorText
""
            )
          ]
      warning :: Pretty ColorText
warning =
        Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep
          Pretty ColorText
" "
          [ Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
backtick (String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string String
cmd),
            Pretty ColorText
"takes an argument, like",
            Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
backtick (Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty ColorText
" " [String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string String
cmd, Pretty ColorText
"name"]) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"."
          ]
   in String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
        String
cmd
        []
        Visibility
I.Visible
        [(Text
"definition to delete", IsOptional
OnePlus, ArgumentType
queryCompletionArg)]
        Pretty ColorText
info
        \case
          [] -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
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
warning
          Arguments
queries -> DeleteTarget -> Input
Input.DeleteI (DeleteTarget -> Input)
-> ([HQSplit'] -> DeleteTarget) -> [HQSplit'] -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HQSplit'] -> DeleteTarget
mkTarget ([HQSplit'] -> Input)
-> Either (Pretty ColorText) [HQSplit']
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Argument -> Either (Pretty ColorText) HQSplit')
-> Arguments -> Either (Pretty ColorText) [HQSplit']
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 Argument -> Either (Pretty ColorText) HQSplit'
handleHashQualifiedSplit'Arg Arguments
queries

delete :: InputPattern
delete :: InputPattern
delete = Maybe String
-> ArgumentType
-> String
-> ([HQSplit'] -> DeleteTarget)
-> InputPattern
deleteGen Maybe String
forall a. Maybe a
Nothing ArgumentType
exactDefinitionTypeOrTermQueryArg String
"term or type" (DeleteOutput -> [HQSplit'] -> DeleteTarget
DeleteTarget'TermOrType DeleteOutput
DeleteOutput'NoDiff)

deleteVerbose :: InputPattern
deleteVerbose :: InputPattern
deleteVerbose = Maybe String
-> ArgumentType
-> String
-> ([HQSplit'] -> DeleteTarget)
-> InputPattern
deleteGen (String -> Maybe String
forall a. a -> Maybe a
Just String
"verbose") ArgumentType
exactDefinitionTypeOrTermQueryArg String
"term or type" (DeleteOutput -> [HQSplit'] -> DeleteTarget
DeleteTarget'TermOrType DeleteOutput
DeleteOutput'Diff)

deleteTerm :: InputPattern
deleteTerm :: InputPattern
deleteTerm = Maybe String
-> ArgumentType
-> String
-> ([HQSplit'] -> DeleteTarget)
-> InputPattern
deleteGen (String -> Maybe String
forall a. a -> Maybe a
Just String
"term") ArgumentType
exactDefinitionTermQueryArg String
"term" (DeleteOutput -> [HQSplit'] -> DeleteTarget
DeleteTarget'Term DeleteOutput
DeleteOutput'NoDiff)

deleteTermVerbose :: InputPattern
deleteTermVerbose :: InputPattern
deleteTermVerbose = Maybe String
-> ArgumentType
-> String
-> ([HQSplit'] -> DeleteTarget)
-> InputPattern
deleteGen (String -> Maybe String
forall a. a -> Maybe a
Just String
"term.verbose") ArgumentType
exactDefinitionTermQueryArg String
"term" (DeleteOutput -> [HQSplit'] -> DeleteTarget
DeleteTarget'Term DeleteOutput
DeleteOutput'Diff)

deleteType :: InputPattern
deleteType :: InputPattern
deleteType = Maybe String
-> ArgumentType
-> String
-> ([HQSplit'] -> DeleteTarget)
-> InputPattern
deleteGen (String -> Maybe String
forall a. a -> Maybe a
Just String
"type") ArgumentType
exactDefinitionTypeQueryArg String
"type" (DeleteOutput -> [HQSplit'] -> DeleteTarget
DeleteTarget'Type DeleteOutput
DeleteOutput'NoDiff)

deleteTypeVerbose :: InputPattern
deleteTypeVerbose :: InputPattern
deleteTypeVerbose = Maybe String
-> ArgumentType
-> String
-> ([HQSplit'] -> DeleteTarget)
-> InputPattern
deleteGen (String -> Maybe String
forall a. a -> Maybe a
Just String
"type.verbose") ArgumentType
exactDefinitionTypeQueryArg String
"type" (DeleteOutput -> [HQSplit'] -> DeleteTarget
DeleteTarget'Type DeleteOutput
DeleteOutput'Diff)

deleteProject :: InputPattern
deleteProject :: InputPattern
deleteProject =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"delete.project",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"project.delete"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"project to delete", IsOptional
Required, ArgumentType
projectNameArg)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ (Pretty ColorText
"`delete.project foo`", Pretty ColorText
"deletes the local project `foo`")
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
name] -> DeleteTarget -> Input
Input.DeleteI (DeleteTarget -> Input)
-> (ProjectName -> DeleteTarget) -> ProjectName -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectName -> DeleteTarget
DeleteTarget'Project (ProjectName -> Input)
-> Either (Pretty ColorText) ProjectName
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectName
handleProjectArg Argument
name
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }

deleteBranch :: InputPattern
deleteBranch :: InputPattern
deleteBranch =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"delete.branch",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"branch.delete"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"branch to delete", IsOptional
Required, ProjectBranchSuggestionsConfig -> ArgumentType
projectBranchNameArg ProjectBranchSuggestionsConfig
suggestionsConfig)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ (Pretty ColorText
"`delete.branch foo/bar`", Pretty ColorText
"deletes the branch `bar` in the project `foo`"),
            (Pretty ColorText
"`delete.branch /bar`", Pretty ColorText
"deletes the branch `bar` in the current project")
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
name] -> DeleteTarget -> Input
Input.DeleteI (DeleteTarget -> Input)
-> (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
    -> DeleteTarget)
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> DeleteTarget
DeleteTarget'ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg Argument
name
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }
  where
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
OnlyWithinCurrentProject,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

aliasTerm :: InputPattern
aliasTerm :: InputPattern
aliasTerm =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"alias.term",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"term to alias", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg), (Text
"alias name", IsOptional
Required, ArgumentType
newNameArg)],
      $sel:help:InputPattern :: Pretty ColorText
help = Pretty ColorText
"`alias.term foo bar` introduces `bar` with the same definition as `foo`.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
oldName, Argument
newName] -> Bool -> Either ShortHash HQSplit' -> Split' -> Input
Input.AliasTermI Bool
False (Either ShortHash HQSplit' -> Split' -> Input)
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
-> Either (Pretty ColorText) (Split' -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (Either ShortHash HQSplit')
handleShortHashOrHQSplit'Arg Argument
oldName Either (Pretty ColorText) (Split' -> Input)
-> Either (Pretty ColorText) Split'
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) Split'
handleSplit'Arg Argument
newName
        Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
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
"`alias.term` takes two arguments, like `alias.term oldname newname`."
    }

debugAliasTermForce :: InputPattern
debugAliasTermForce :: InputPattern
debugAliasTermForce =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"debug.alias.term.force",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Hidden,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"term to alias", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg), (Text
"alias name", IsOptional
Required, ArgumentType
newNameArg)],
      $sel:help:InputPattern :: Pretty ColorText
help = Pretty ColorText
"`debug.alias.term.force foo bar` introduces `bar` with the same definition as `foo`.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
oldName, Argument
newName] -> Bool -> Either ShortHash HQSplit' -> Split' -> Input
Input.AliasTermI Bool
True (Either ShortHash HQSplit' -> Split' -> Input)
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
-> Either (Pretty ColorText) (Split' -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (Either ShortHash HQSplit')
handleShortHashOrHQSplit'Arg Argument
oldName Either (Pretty ColorText) (Split' -> Input)
-> Either (Pretty ColorText) Split'
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) Split'
handleSplit'Arg Argument
newName
        Arguments
_ ->
          Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
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
"`debug.alias.term.force` takes two arguments, like `debug.alias.term.force oldname newname`."
    }

aliasType :: InputPattern
aliasType :: InputPattern
aliasType =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"alias.type"
    []
    Visibility
I.Visible
    [(Text
"type to alias", IsOptional
Required, ArgumentType
exactDefinitionTypeQueryArg), (Text
"alias name", IsOptional
Required, ArgumentType
newNameArg)]
    Pretty ColorText
"`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`."
    \case
      [Argument
oldName, Argument
newName] -> Bool -> Either ShortHash HQSplit' -> Split' -> Input
Input.AliasTypeI Bool
False (Either ShortHash HQSplit' -> Split' -> Input)
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
-> Either (Pretty ColorText) (Split' -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (Either ShortHash HQSplit')
handleShortHashOrHQSplit'Arg Argument
oldName Either (Pretty ColorText) (Split' -> Input)
-> Either (Pretty ColorText) Split'
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) Split'
handleSplit'Arg Argument
newName
      Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
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
"`alias.type` takes two arguments, like `alias.type oldname newname`."

debugAliasTypeForce :: InputPattern
debugAliasTypeForce :: InputPattern
debugAliasTypeForce =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"debug.alias.type.force",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Hidden,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"type to alias", IsOptional
Required, ArgumentType
exactDefinitionTypeQueryArg), (Text
"alias name", IsOptional
Required, ArgumentType
newNameArg)],
      $sel:help:InputPattern :: Pretty ColorText
help = Pretty ColorText
"`debug.alias.type.force Foo Bar` introduces `Bar` with the same definition as `Foo`.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
oldName, Argument
newName] -> Bool -> Either ShortHash HQSplit' -> Split' -> Input
Input.AliasTypeI Bool
True (Either ShortHash HQSplit' -> Split' -> Input)
-> Either (Pretty ColorText) (Either ShortHash HQSplit')
-> Either (Pretty ColorText) (Split' -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (Either ShortHash HQSplit')
handleShortHashOrHQSplit'Arg Argument
oldName Either (Pretty ColorText) (Split' -> Input)
-> Either (Pretty ColorText) Split'
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) Split'
handleSplit'Arg Argument
newName
        Arguments
_ ->
          Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
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
"`debug.alias.type.force` takes two arguments, like `debug.alias.type.force oldname newname`."
    }

aliasMany :: InputPattern
aliasMany :: InputPattern
aliasMany =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"alias.many"
    [String
"copy"]
    Visibility
I.Visible
    [(Text
"definition to alias", IsOptional
Required, ArgumentType
definitionQueryArg), (Text
"alias names", IsOptional
OnePlus, ArgumentType
exactDefinitionArg)]
    ( Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (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 (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
aliasMany [Pretty ColorText
"<relative1>", Pretty ColorText
"[relative2...]", Pretty ColorText
"<namespace>"])
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"creates aliases `relative1`, `relative2`, ... in the namespace `namespace`.",
          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 -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
aliasMany [Pretty ColorText
"foo.foo", Pretty ColorText
"bar.bar", Pretty ColorText
".quux"])
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"creates aliases `.quux.foo.foo` and `.quux.bar.bar`."
        ]
    )
    \case
      srcs :: Arguments
srcs@(Argument
_ : Arguments
_) Cons.:> Argument
dest ->
        [HQSplit] -> Path' -> Input
Input.AliasManyI ([HQSplit] -> Path' -> Input)
-> Either (Pretty ColorText) [HQSplit]
-> Either (Pretty ColorText) (Path' -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Argument -> Either (Pretty ColorText) HQSplit)
-> Arguments -> Either (Pretty ColorText) [HQSplit]
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 Argument -> Either (Pretty ColorText) HQSplit
handleHashQualifiedSplitArg Arguments
srcs Either (Pretty ColorText) (Path' -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
dest
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least two arguments" Arguments
args

up :: InputPattern
up :: InputPattern
up =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"deprecated.up"
    []
    Visibility
I.Hidden
    []
    ([(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2 [(InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
up [], Pretty ColorText
"move current path up one level (deprecated)")])
    \case
      [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.UpI
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args

cd :: InputPattern
cd :: InputPattern
cd =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"deprecated.cd"
    [String
"deprecated.namespace"]
    Visibility
I.Visible
    [(Text
"namespace", IsOptional
Required, ArgumentType
namespaceArg)]
    ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty ColorText
"Moves your perspective to a different namespace. Deprecated for now because too many important things depend on your perspective selection.",
          Pretty ColorText
"",
          [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
            [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
cd [Pretty ColorText
"foo.bar"],
                Pretty ColorText
"descends into foo.bar from the current namespace."
              ),
              ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
cd [Pretty ColorText
".cat.dog"],
                Pretty ColorText
"sets the current namespace to the absolute namespace .cat.dog."
              ),
              ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
cd [Pretty ColorText
".."],
                Pretty ColorText
"moves to the parent of the current namespace. E.g. moves from '.cat.dog' to '.cat'"
              ),
              ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
cd [],
                Pretty ColorText
"invokes a search to select which namespace to move to, which requires that `fzf` can be found within your PATH."
              )
            ]
        ]
    )
    \case
      [Left String
".."] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.UpI
      [Argument
p] -> Path' -> Input
Input.SwitchBranchI (Path' -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
p
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args

back :: InputPattern
back :: InputPattern
back =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"back"
    [String
"popd"]
    Visibility
I.Visible
    []
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
back [],
            Pretty ColorText
"undoes the last" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
projectSwitch Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"command."
          )
        ]
    )
    \case
      [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
Input.PopBranchI
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args

deleteNamespace :: InputPattern
deleteNamespace :: InputPattern
deleteNamespace =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"delete.namespace"
    []
    Visibility
I.Visible
    [(Text
"namespace to delete", IsOptional
Required, ArgumentType
namespaceArg)]
    Pretty ColorText
"`delete.namespace <foo>` deletes the namespace `foo`"
    (Insistence -> Arguments -> Either (Pretty ColorText) Input
deleteNamespaceParser Insistence
Input.Try)

deleteNamespaceForce :: InputPattern
deleteNamespaceForce :: InputPattern
deleteNamespaceForce =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"delete.namespace.force"
    []
    Visibility
I.Visible
    [(Text
"namespace to delete", IsOptional
Required, ArgumentType
namespaceArg)]
    ( Pretty ColorText
"`delete.namespace.force <foo>` deletes the namespace `foo`,"
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"deletion will proceed even if other code depends on definitions in foo."
    )
    (Insistence -> Arguments -> Either (Pretty ColorText) Input
deleteNamespaceParser Insistence
Input.Force)

deleteNamespaceParser :: Input.Insistence -> I.Arguments -> Either (P.Pretty CT.ColorText) Input
deleteNamespaceParser :: Insistence -> Arguments -> Either (Pretty ColorText) Input
deleteNamespaceParser Insistence
insistence = \case
  [Left String
"."] -> (String -> Pretty ColorText)
-> Either String 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 String -> Pretty ColorText
forall a. IsString a => String -> a
fromString (Either String Input -> Either (Pretty ColorText) Input)
-> (Input -> Either String Input)
-> Input
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Either String Input
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ DeleteTarget -> Input
Input.DeleteI (Insistence -> Maybe Split -> DeleteTarget
DeleteTarget'Namespace Insistence
insistence Maybe Split
forall a. Maybe a
Nothing)
  [Argument
p] -> DeleteTarget -> Input
Input.DeleteI (DeleteTarget -> Input)
-> (Maybe Split -> DeleteTarget) -> Maybe Split -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Insistence -> Maybe Split -> DeleteTarget
DeleteTarget'Namespace Insistence
insistence (Maybe Split -> Input)
-> Either (Pretty ColorText) (Maybe Split)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Split -> Maybe Split
forall a. a -> Maybe a
Just (Split -> Maybe Split)
-> Either (Pretty ColorText) Split
-> Either (Pretty ColorText) (Maybe Split)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Split
handleSplitArg Argument
p)
  Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args

renameBranch :: InputPattern
renameBranch :: InputPattern
renameBranch =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"move.namespace"
    [String
"rename.namespace"]
    Visibility
I.Visible
    [(Text
"namespace to move", IsOptional
Required, ArgumentType
namespaceArg), (Text
"new location", IsOptional
Required, ArgumentType
newNameArg)]
    Pretty ColorText
"`move.namespace foo bar` renames the path `foo` to `bar`."
    \case
      [Argument
src, Argument
dest] -> Path' -> Path' -> Input
Input.MoveBranchI (Path' -> Path' -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) (Path' -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
src Either (Pretty ColorText) (Path' -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
dest
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly two arguments" Arguments
args

history :: InputPattern
history :: InputPattern
history =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"history"
    []
    Visibility
I.Visible
    [(Text
"namespace", IsOptional
Optional, ArgumentType
namespaceArg)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ (InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
history [], Pretty ColorText
"Shows the history of the current path."),
          (InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
history [Pretty ColorText
".foo"], Pretty ColorText
"Shows history of the path .foo."),
          ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
history [Pretty ColorText
"#9dndk3kbsk13nbpeu"],
            Pretty ColorText
"Shows the history of the namespace with the given hash."
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"The full hash must be provided."
          )
        ]
    )
    \case
      [Argument
src] -> Maybe Int -> Maybe Int -> BranchId -> Input
Input.HistoryI (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10) (BranchId -> Input)
-> Either (Pretty ColorText) BranchId
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchId
handleBranchIdArg Argument
src
      [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> BranchId -> Input
Input.HistoryI (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10) (Path' -> BranchId
forall p. p -> BranchIdG p
BranchAtPath Path'
Path.currentPath)
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args

forkLocal :: InputPattern
forkLocal :: InputPattern
forkLocal =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"fork"
    [String
"copy.namespace"]
    Visibility
I.Visible
    [ (Text
"source location", IsOptional
Required, ArgumentType
branchRelativePathArg),
      (Text
"dest location", IsOptional
Required, ArgumentType
branchRelativePathArg)
    ]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
forkLocal [Pretty ColorText
"src", Pretty ColorText
"dest"],
            Pretty ColorText
"creates the namespace `dest` as a copy of `src`."
          ),
          ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
forkLocal [Pretty ColorText
"project0/branch0:a.path", Pretty ColorText
"project1/branch1:foo"],
            Pretty ColorText
"creates the namespace `foo` in `branch1` of `project1` as a copy of `a.path` in `project0/branch0`."
          ),
          ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
forkLocal [Pretty ColorText
"srcproject/srcbranch", Pretty ColorText
"dest"],
            Pretty ColorText
"creates the namespace `dest` as a copy of the branch `srcbranch` of `srcproject`."
          )
        ]
    )
    \case
      [Argument
src, Argument
dest] -> BranchId2 -> BranchRelativePath -> Input
Input.ForkLocalBranchI (BranchId2 -> BranchRelativePath -> Input)
-> Either (Pretty ColorText) BranchId2
-> Either (Pretty ColorText) (BranchRelativePath -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchId2
handleBranchId2Arg Argument
src Either (Pretty ColorText) (BranchRelativePath -> Input)
-> Either (Pretty ColorText) BranchRelativePath
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
dest
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly two arguments" Arguments
args

libInstallInputPattern :: InputPattern
libInstallInputPattern :: InputPattern
libInstallInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"lib.install",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"install.lib"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
              Pretty ColorText
"The"
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
libInstallInputPattern
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"command installs a dependency into the `lib` namespace.",
            Pretty ColorText
"",
            [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
              [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
libInstallInputPattern [Pretty ColorText
"@unison/base/releases/latest"],
                  Pretty ColorText
"installs the latest release of `@unison/base`"
                ),
                ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
libInstallInputPattern [Pretty ColorText
"@unison/base/releases/3.0.0"],
                  Pretty ColorText
"installs version 3.0.0 of `@unison/base`"
                ),
                ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
libInstallInputPattern [Pretty ColorText
"@unison/base/topic"],
                  Pretty ColorText
"installs the `topic` branch of `@unison/base`"
                )
              ]
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
arg] -> Bool
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
-> Input
Input.LibInstallI Bool
False (ProjectAndBranch
   ProjectName (Maybe ProjectBranchNameOrLatestRelease)
 -> Input)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
handleProjectMaybeBranchArg Argument
arg
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }

reset :: InputPattern
reset :: InputPattern
reset =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"reset"
    []
    Visibility
I.Visible
    [ (Text
"namespace, hash, or branch to reset to", IsOptional
Required, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
config),
      (Text
"namespace to be reset", IsOptional
Optional, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
config)
    ]
    ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
            [ (Pretty ColorText
"`reset #pvfd222s8n`", Pretty ColorText
"reset the current namespace to the hash `#pvfd222s8n`"),
              (Pretty ColorText
"`reset foo`", Pretty ColorText
"reset the current namespace to the state of the `foo` namespace."),
              (Pretty ColorText
"`reset #pvfd222s8n /topic`", Pretty ColorText
"reset the branch `topic` of the current project to the causal `#pvfd222s8n`.")
            ],
          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
"If you make a mistake using reset, consult the " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
branchReflog Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" command and use another " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
reset Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" command to return to a previous state."
        ]
    )
    \case
      [Argument
resetTo] -> BranchId2
-> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Input
Input.ResetI (BranchId2
 -> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
 -> Input)
-> Either (Pretty ColorText) BranchId2
-> Either
     (Pretty ColorText)
     (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
      -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchId2
handleBranchId2Arg Argument
resetTo Either
  (Pretty ColorText)
  (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
   -> Input)
-> Either
     (Pretty ColorText)
     (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a. Maybe a
Nothing
      [Argument
resetTo, Argument
branchToReset] -> BranchId2
-> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Input
Input.ResetI (BranchId2
 -> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
 -> Input)
-> Either (Pretty ColorText) BranchId2
-> Either
     (Pretty ColorText)
     (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
      -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchId2
handleBranchId2Arg Argument
resetTo Either
  (Pretty ColorText)
  (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
   -> Input)
-> Either
     (Pretty ColorText)
     (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
 -> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg Argument
branchToReset)
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"one or two arguments" Arguments
args
  where
    config :: ProjectBranchSuggestionsConfig
config =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

pull :: InputPattern
pull :: InputPattern
pull =
  String -> [String] -> PullMode -> Pretty ColorText -> InputPattern
pullImpl String
"pull" [] PullMode
Input.PullWithHistory Pretty ColorText
""

pullWithoutHistory :: InputPattern
pullWithoutHistory :: InputPattern
pullWithoutHistory =
  String -> [String] -> PullMode -> Pretty ColorText -> InputPattern
pullImpl
    String
"pull.without-history"
    []
    PullMode
Input.PullWithoutHistory
    Pretty ColorText
"without including the remote's history. This usually results in smaller codebase sizes."

pullImpl :: String -> [String] -> Input.PullMode -> P.Pretty CT.ColorText -> InputPattern
pullImpl :: String -> [String] -> PullMode -> Pretty ColorText -> InputPattern
pullImpl String
name [String]
aliases PullMode
pullMode Pretty ColorText
addendum = do
  InputPattern
self
  where
    self :: InputPattern
self =
      InputPattern
        { $sel:patternName:InputPattern :: String
patternName = String
name,
          $sel:aliases:InputPattern :: [String]
aliases = [String]
aliases,
          $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
          $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args =
            [ (Text
"remote namespace to pull", IsOptional
Optional, ArgumentType
remoteNamespaceArg),
              ( Text
"destination branch",
                IsOptional
Optional,
                ProjectBranchSuggestionsConfig -> ArgumentType
projectBranchNameArg
                  ProjectBranchSuggestionsConfig
                    { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
                      $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
                      $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
                    }
              )
            ],
          $sel:help:InputPattern :: Pretty ColorText
help =
            [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                  Pretty ColorText
"The"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
self
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"command merges a remote namespace into a local branch"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
addendum,
                Pretty ColorText
"",
                [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
                  [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
self [Pretty ColorText
"@unison/base/main"],
                      Pretty ColorText
"merges the branch `main`"
                        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"of the Unison Share hosted project `@unison/base`"
                        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"into the current branch"
                    ),
                    ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
self [Pretty ColorText
"@unison/base/main", Pretty ColorText
"my-base/topic"],
                      Pretty ColorText
"merges the branch `main`"
                        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"of the Unison Share hosted project `@unison/base`"
                        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"into the branch `topic` of the local `my-base` project"
                    )
                  ],
                Pretty ColorText
"",
                PushPull -> Pretty ColorText
explainRemote PushPull
Pull
              ],
          $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
            [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ PullSourceTarget -> PullMode -> Input
Input.PullI PullSourceTarget
Input.PullSourceTarget0 PullMode
pullMode
            [Argument
sourceArg] -> do
              ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
source <- Argument
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
handlePullSourceArg Argument
sourceArg
              pure (PullSourceTarget -> PullMode -> Input
Input.PullI (ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
-> PullSourceTarget
Input.PullSourceTarget1 ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
source) PullMode
pullMode)
            [Argument
sourceArg, Argument
targetArg] ->
              -- You used to be able to pull into a path, so this arg parser is a little complicated, because
              -- we want to provide helpful suggestions if you are doing a deprecated or invalid thing.
              case ( Argument
-> Either
     (Pretty ColorText)
     (ReadRemoteNamespace
        (These ProjectName ProjectBranchNameOrLatestRelease))
handlePullSourceArg Argument
sourceArg,
                     Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg Argument
targetArg,
                     Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
targetArg
                   ) of
                (Right ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
source, Right ProjectAndBranch (Maybe ProjectName) ProjectBranchName
target, Either (Pretty ColorText) Path'
_) -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (PullSourceTarget -> PullMode -> Input
Input.PullI (ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> PullSourceTarget
Input.PullSourceTarget2 ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
source ProjectAndBranch (Maybe ProjectName) ProjectBranchName
target) PullMode
pullMode)
                (Left Pretty ColorText
err, Either
  (Pretty ColorText)
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
_, Either (Pretty ColorText) Path'
_) -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left Pretty ColorText
err
                -- Parsing as a path didn't work either; just show the branch parse error
                (Right ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
_, Left Pretty ColorText
err, Left Pretty ColorText
_) -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left Pretty ColorText
err
                -- The user is trying to pull a branch into `lib`, but you can't do that anymore. We will ignore
                -- the name they've chosed (e.g. "lib.base"), and instead run `lib.install` (which picks a
                -- name), with a reminder message that `lib.install` is the new way.
                --
                -- Oops we're ignoring the "pull mode" but `pull.without-history` shouldn't really be a `pull` anyway...
                ( Right (RemoteRepo.ReadShare'ProjectBranch These ProjectName ProjectBranchNameOrLatestRelease
source),
                  Left Pretty ColorText
_,
                  Right (Path.RelativePath' (Path.Relative (Path -> [NameSegment]
Path.toList -> NameSegment
NameSegment.LibSegment : [NameSegment]
_)))
                  ) ->
                    case These ProjectName ProjectBranchNameOrLatestRelease
source of
                      This ProjectName
sourceProject -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Bool
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
-> Input
Input.LibInstallI Bool
True (ProjectName
-> Maybe ProjectBranchNameOrLatestRelease
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
sourceProject Maybe ProjectBranchNameOrLatestRelease
forall a. Maybe a
Nothing))
                      -- Nice, since we can `pull /branch` but can't `lib.install /branch`, we fail here after all.
                      That ProjectBranchNameOrLatestRelease
_sourceBranch ->
                        Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
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
"The use of"
                                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
pull
                                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"to install libraries is now deprecated. Going forward, you can use"
                                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 (InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
libInstallInputPattern [Pretty ColorText
"@user/project/branch-or-release"] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
                            )
                      These ProjectName
sourceProject ProjectBranchNameOrLatestRelease
sourceBranch ->
                        Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Bool
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
-> Input
Input.LibInstallI Bool
True (ProjectName
-> Maybe ProjectBranchNameOrLatestRelease
-> ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease)
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
sourceProject (ProjectBranchNameOrLatestRelease
-> Maybe ProjectBranchNameOrLatestRelease
forall a. a -> Maybe a
Just ProjectBranchNameOrLatestRelease
sourceBranch)))
                (Right ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
source, Left Pretty ColorText
_, Right Path'
path) ->
                  Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> Either (Pretty ColorText) 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
P.wrap (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$
                    Pretty ColorText
"I think you want to merge "
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> case ReadRemoteNamespace
  (These ProjectName ProjectBranchNameOrLatestRelease)
source of
                        RemoteRepo.ReadShare'LooseCode ReadShareLooseCode
_sourcePath -> Pretty ColorText
"some non-project code"
                        RemoteRepo.ReadShare'ProjectBranch (This ProjectName
sourceProject) ->
                          ProjectName -> Pretty ColorText
prettyProjectNameSlash ProjectName
sourceProject
                        RemoteRepo.ReadShare'ProjectBranch (That ProjectBranchNameOrLatestRelease
ProjectBranchNameOrLatestRelease'LatestRelease) ->
                          Pretty ColorText
"the latest release"
                        RemoteRepo.ReadShare'ProjectBranch (That (ProjectBranchNameOrLatestRelease'Name ProjectBranchName
sourceBranch)) ->
                          ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
sourceBranch
                        RemoteRepo.ReadShare'ProjectBranch (These ProjectName
sourceProject ProjectBranchNameOrLatestRelease
ProjectBranchNameOrLatestRelease'LatestRelease) ->
                          Pretty ColorText
"the latest release of" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ProjectName -> Pretty ColorText
prettyProjectName ProjectName
sourceProject
                        RemoteRepo.ReadShare'ProjectBranch (These ProjectName
sourceProject (ProjectBranchNameOrLatestRelease'Name ProjectBranchName
sourceBranch)) ->
                          ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyProjectAndBranchName (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
sourceProject ProjectBranchName
sourceBranch)
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" into the "
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Path' -> Pretty ColorText
prettyPath' Path'
path
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" namespace, but the "
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
pull
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" command only supports merging into the top level of a local project branch."
            Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than two arguments" Arguments
args
        }

debugTabCompletion :: InputPattern
debugTabCompletion :: InputPattern
debugTabCompletion =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.tab-complete"
    []
    Visibility
I.Hidden
    [(Text
"command arguments", IsOptional
ZeroPlus, ArgumentType
noCompletionsArg)]
    ( [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"This command can be used to test and debug ucm's tab-completion within transcripts.",
          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
"Completions which are finished are prefixed with a * represent finished completions."
        ]
    )
    (([String] -> Input)
-> Either (Pretty ColorText) [String]
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> Input
Input.DebugTabCompletionI (Either (Pretty ColorText) [String]
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) [String])
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) String)
-> Arguments -> Either (Pretty ColorText) [String]
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 (InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
debugTabCompletion Text
"text"))

debugLspNameCompletion :: InputPattern
debugLspNameCompletion :: InputPattern
debugLspNameCompletion =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.lsp-name-completion"
    []
    Visibility
I.Hidden
    [(Text
"Completion prefix", IsOptional
OnePlus, ArgumentType
noCompletionsArg)]
    ( [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"This command can be used to test and debug ucm's LSP name-completion within transcripts."
        ]
    )
    \case
      [Argument
prefix] -> Text -> Input
Input.DebugLSPNameCompletionI (Text -> Input) -> (String -> Text) -> String -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Input)
-> Either (Pretty ColorText) String
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
debugLspNameCompletion Text
"text" Argument
prefix
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args

debugFuzzyOptions :: InputPattern
debugFuzzyOptions :: InputPattern
debugFuzzyOptions =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.fuzzy-options"
    []
    Visibility
I.Hidden
    [(Text
"command arguments", IsOptional
OnePlus, ArgumentType
noCompletionsArg)]
    ( [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"This command can be used to test and debug ucm's fuzzy-options within transcripts.",
          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
"Write a command invocation with _ for any args you'd like to see completion options for.",
          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
"We use _ instead of ! because ! will be expanded by the input parser before it hits the command itself.",
          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
"E.g. `debug.fuzzy-options view _`",
          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
"or `debug.fuzzy-options merge - _`"
        ]
    )
    \case
      (Argument
cmd : Arguments
args) ->
        String -> [String] -> Input
Input.DebugFuzzyOptionsI
          (String -> [String] -> Input)
-> Either (Pretty ColorText) String
-> Either (Pretty ColorText) ([String] -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
debugFuzzyOptions Text
"a command" Argument
cmd
          Either (Pretty ColorText) ([String] -> Input)
-> Either (Pretty ColorText) [String]
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Argument -> Either (Pretty ColorText) String)
-> Arguments -> Either (Pretty ColorText) [String]
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 (InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
debugFuzzyOptions Text
"text") Arguments
args
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least one argument" Arguments
args

debugFormat :: InputPattern
debugFormat :: InputPattern
debugFormat =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.format"
    []
    Visibility
I.Hidden
    [(Text
"source-file", IsOptional
Optional, ArgumentType
filePathArg)]
    ( [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"This command can be used to test ucm's file formatter on the latest typechecked file.",
          InputPattern -> Pretty ColorText
makeExample' InputPattern
debugFormat
        ]
    )
    ( \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.DebugFormatI
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args
    )

push :: InputPattern
push :: InputPattern
push =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"push"
    []
    Visibility
I.Visible
    [(Text
"remote destination", IsOptional
Optional, ArgumentType
remoteNamespaceArg), (Text
"local target", IsOptional
Optional, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig)]
    ( [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
"The `push` command merges a local project or namespace into a remote project or namespace.",
          Pretty ColorText
"",
          [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
            [ ( Pretty ColorText
"`push <remote> <local>`",
                Pretty ColorText
"publishes the contents of a local namespace or branch"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"into a remote namespace or branch."
              ),
              ( Pretty ColorText
"`push <remote>`",
                Pretty ColorText
"publishes the current namespace or branch into a remote namespace or branch"
              ),
              ( Pretty ColorText
"`push`",
                Pretty ColorText
"publishes the current namespace or branch. Remote mappings for namespaces are configured in"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"your `.unisonConfig` at the key `RemoteMappings.<namespace>` where `<namespace>` is the "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"current namespace. Remote mappings for branches default to the branch that you cloned from"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"or pushed to initially. Otherwise, it is pushed 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 Pretty ColorText
"@<user handle>/<local project name>"
              )
            ],
          Pretty ColorText
"",
          PushPull -> Pretty ColorText
explainRemote PushPull
Push
        ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ (PushSourceTarget -> Input)
-> Either (Pretty ColorText) PushSourceTarget
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \PushSourceTarget
sourceTarget ->
          PushRemoteBranchInput -> Input
Input.PushRemoteBranchI
            Input.PushRemoteBranchInput
              { PushSourceTarget
sourceTarget :: PushSourceTarget
$sel:sourceTarget:PushRemoteBranchInput :: PushSourceTarget
sourceTarget,
                $sel:pushBehavior:PushRemoteBranchInput :: PushBehavior
pushBehavior = PushBehavior
PushBehavior.RequireNonEmpty
              }
      )
      (Either (Pretty ColorText) PushSourceTarget
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) PushSourceTarget)
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        [] -> PushSourceTarget -> Either (Pretty ColorText) PushSourceTarget
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PushSourceTarget
Input.PushSourceTarget0
        [Argument
targetStr] -> These ProjectName ProjectBranchName -> PushSourceTarget
Input.PushSourceTarget1 (These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) PushSourceTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg Argument
targetStr
        [Argument
targetStr, Argument
sourceStr] ->
          PushSource
-> These ProjectName ProjectBranchName -> PushSourceTarget
Input.PushSourceTarget2 (PushSource
 -> These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) PushSource
-> Either
     (Pretty ColorText)
     (These ProjectName ProjectBranchName -> PushSourceTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) PushSource
handlePushSourceArg Argument
sourceStr Either
  (Pretty ColorText)
  (These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) PushSourceTarget
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg Argument
targetStr
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) PushSourceTarget
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than two arguments" Arguments
args
  where
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

pushCreate :: InputPattern
pushCreate :: InputPattern
pushCreate =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"push.create"
    []
    Visibility
I.Visible
    [(Text
"remote destination", IsOptional
Optional, ArgumentType
remoteNamespaceArg), (Text
"local target", IsOptional
Optional, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig)]
    ( [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
"The `push.create` command pushes a local namespace to an empty remote namespace.",
          Pretty ColorText
"",
          [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
            [ ( Pretty ColorText
"`push.create remote local`",
                Pretty ColorText
"pushes the contents of the local namespace `local`"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"into the empty remote namespace `remote`."
              ),
              ( Pretty ColorText
"`push.create remote`",
                Pretty ColorText
"publishes the current namespace into the empty remote namespace `remote`"
              ),
              ( Pretty ColorText
"`push.create`",
                Pretty ColorText
"publishes the current namespace into the remote namespace configured in your `.unisonConfig`"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"at the key `RemoteMappings.<namespace>` where `<namespace>` is the current namespace,"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"then publishes the current namespace to that location."
              )
            ],
          Pretty ColorText
"",
          PushPull -> Pretty ColorText
explainRemote PushPull
Push
        ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ (PushSourceTarget -> Input)
-> Either (Pretty ColorText) PushSourceTarget
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \PushSourceTarget
sourceTarget ->
          PushRemoteBranchInput -> Input
Input.PushRemoteBranchI
            Input.PushRemoteBranchInput
              { PushSourceTarget
$sel:sourceTarget:PushRemoteBranchInput :: PushSourceTarget
sourceTarget :: PushSourceTarget
sourceTarget,
                $sel:pushBehavior:PushRemoteBranchInput :: PushBehavior
pushBehavior = PushBehavior
PushBehavior.RequireEmpty
              }
      )
      (Either (Pretty ColorText) PushSourceTarget
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) PushSourceTarget)
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        [] -> PushSourceTarget -> Either (Pretty ColorText) PushSourceTarget
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PushSourceTarget
Input.PushSourceTarget0
        [Argument
targetStr] -> These ProjectName ProjectBranchName -> PushSourceTarget
Input.PushSourceTarget1 (These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) PushSourceTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg Argument
targetStr
        [Argument
targetStr, Argument
sourceStr] ->
          PushSource
-> These ProjectName ProjectBranchName -> PushSourceTarget
Input.PushSourceTarget2 (PushSource
 -> These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) PushSource
-> Either
     (Pretty ColorText)
     (These ProjectName ProjectBranchName -> PushSourceTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) PushSource
handlePushSourceArg Argument
sourceStr Either
  (Pretty ColorText)
  (These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) PushSourceTarget
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg Argument
targetStr
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) PushSourceTarget
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than two arguments" Arguments
args
  where
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

pushForce :: InputPattern
pushForce :: InputPattern
pushForce =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"unsafe.force-push"
    []
    Visibility
I.Hidden
    [(Text
"remote destination", IsOptional
Optional, ArgumentType
remoteNamespaceArg), (Text
"local source", IsOptional
Optional, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig)]
    (Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"Like `push`, but overwrites any remote namespace.")
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ (PushSourceTarget -> Input)
-> Either (Pretty ColorText) PushSourceTarget
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \PushSourceTarget
sourceTarget ->
          PushRemoteBranchInput -> Input
Input.PushRemoteBranchI
            Input.PushRemoteBranchInput
              { PushSourceTarget
$sel:sourceTarget:PushRemoteBranchInput :: PushSourceTarget
sourceTarget :: PushSourceTarget
sourceTarget,
                $sel:pushBehavior:PushRemoteBranchInput :: PushBehavior
pushBehavior = PushBehavior
PushBehavior.ForcePush
              }
      )
      (Either (Pretty ColorText) PushSourceTarget
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) PushSourceTarget)
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        [] -> PushSourceTarget -> Either (Pretty ColorText) PushSourceTarget
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PushSourceTarget
Input.PushSourceTarget0
        [Argument
targetStr] -> These ProjectName ProjectBranchName -> PushSourceTarget
Input.PushSourceTarget1 (These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) PushSourceTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg Argument
targetStr
        [Argument
targetStr, Argument
sourceStr] ->
          PushSource
-> These ProjectName ProjectBranchName -> PushSourceTarget
Input.PushSourceTarget2 (PushSource
 -> These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) PushSource
-> Either
     (Pretty ColorText)
     (These ProjectName ProjectBranchName -> PushSourceTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) PushSource
handlePushSourceArg Argument
sourceStr Either
  (Pretty ColorText)
  (These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) PushSourceTarget
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg Argument
targetStr
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) PushSourceTarget
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than two arguments" Arguments
args
  where
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

pushExhaustive :: InputPattern
pushExhaustive :: InputPattern
pushExhaustive =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.push-exhaustive"
    []
    Visibility
I.Hidden
    [(Text
"remote destination", IsOptional
Optional, ArgumentType
remoteNamespaceArg), (Text
"local target", IsOptional
Optional, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig)]
    ( [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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText
"The "
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
pushExhaustive
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"command can be used in place of"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
push
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"to repair remote namespaces"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"which were pushed incompletely due to a bug in UCM"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"versions M1l and earlier. It may be extra slow!"
        ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ (PushSourceTarget -> Input)
-> Either (Pretty ColorText) PushSourceTarget
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \PushSourceTarget
sourceTarget ->
          PushRemoteBranchInput -> Input
Input.PushRemoteBranchI
            Input.PushRemoteBranchInput
              { PushSourceTarget
$sel:sourceTarget:PushRemoteBranchInput :: PushSourceTarget
sourceTarget :: PushSourceTarget
sourceTarget,
                $sel:pushBehavior:PushRemoteBranchInput :: PushBehavior
pushBehavior = PushBehavior
PushBehavior.RequireNonEmpty
              }
      )
      (Either (Pretty ColorText) PushSourceTarget
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) PushSourceTarget)
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        [] -> PushSourceTarget -> Either (Pretty ColorText) PushSourceTarget
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PushSourceTarget
Input.PushSourceTarget0
        [Argument
targetStr] -> These ProjectName ProjectBranchName -> PushSourceTarget
Input.PushSourceTarget1 (These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) PushSourceTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg Argument
targetStr
        [Argument
targetStr, Argument
sourceStr] ->
          PushSource
-> These ProjectName ProjectBranchName -> PushSourceTarget
Input.PushSourceTarget2 (PushSource
 -> These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) PushSource
-> Either
     (Pretty ColorText)
     (These ProjectName ProjectBranchName -> PushSourceTarget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) PushSource
handlePushSourceArg Argument
sourceStr Either
  (Pretty ColorText)
  (These ProjectName ProjectBranchName -> PushSourceTarget)
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
-> Either (Pretty ColorText) PushSourceTarget
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument
-> Either (Pretty ColorText) (These ProjectName ProjectBranchName)
handlePushTargetArg Argument
targetStr
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) PushSourceTarget
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than two arguments" Arguments
args
  where
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

mergeOldSquashInputPattern :: InputPattern
mergeOldSquashInputPattern :: InputPattern
mergeOldSquashInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"merge.old.squash",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"squash.old"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Hidden,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args =
        [ (Text
"namespace or branch to be squashed", IsOptional
Required, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig),
          (Text
"merge destination", IsOptional
Required, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig)
        ],
      $sel:help:InputPattern :: Pretty ColorText
help =
        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
$
          InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeOldSquashInputPattern [Pretty ColorText
"src", Pretty ColorText
"dest"]
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"merges `src` namespace or branch into the `dest` namespace or branch,"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"discarding the history of `src` in the process."
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"The resulting `dest` will have (at most) 1"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"additional history entry.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
src] ->
          BranchRelativePath
-> Maybe BranchRelativePath -> MergeMode -> Input
Input.MergeLocalBranchI
            (BranchRelativePath
 -> Maybe BranchRelativePath -> MergeMode -> Input)
-> Either (Pretty ColorText) BranchRelativePath
-> Either
     (Pretty ColorText) (Maybe BranchRelativePath -> MergeMode -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
src
            Either
  (Pretty ColorText) (Maybe BranchRelativePath -> MergeMode -> Input)
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
-> Either (Pretty ColorText) (MergeMode -> Input)
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe BranchRelativePath
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BranchRelativePath
forall a. Maybe a
Nothing
            Either (Pretty ColorText) (MergeMode -> Input)
-> Either (Pretty ColorText) MergeMode
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MergeMode -> Either (Pretty ColorText) MergeMode
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeMode
Branch.SquashMerge
        [Argument
src, Argument
dest] ->
          BranchRelativePath
-> Maybe BranchRelativePath -> MergeMode -> Input
Input.MergeLocalBranchI
            (BranchRelativePath
 -> Maybe BranchRelativePath -> MergeMode -> Input)
-> Either (Pretty ColorText) BranchRelativePath
-> Either
     (Pretty ColorText) (Maybe BranchRelativePath -> MergeMode -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
src
            Either
  (Pretty ColorText) (Maybe BranchRelativePath -> MergeMode -> Input)
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
-> Either (Pretty ColorText) (MergeMode -> Input)
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BranchRelativePath -> Maybe BranchRelativePath
forall a. a -> Maybe a
Just (BranchRelativePath -> Maybe BranchRelativePath)
-> Either (Pretty ColorText) BranchRelativePath
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
dest)
            Either (Pretty ColorText) (MergeMode -> Input)
-> Either (Pretty ColorText) MergeMode
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MergeMode -> Either (Pretty ColorText) MergeMode
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeMode
Branch.SquashMerge
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly two arguments" Arguments
args
    }
  where
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

mergeOldInputPattern :: InputPattern
mergeOldInputPattern :: InputPattern
mergeOldInputPattern =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"merge.old"
    []
    Visibility
I.Hidden
    [ (Text
"branch or namespace to merge", IsOptional
Required, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
config),
      (Text
"merge destination", IsOptional
Optional, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
config)
    ]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2
        [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeOldInputPattern [Pretty ColorText
"foo/bar", Pretty ColorText
"baz/qux"],
            Pretty ColorText
"merges the `foo/bar` branch into the `baz/qux` branch"
          ),
          ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeOldInputPattern [Pretty ColorText
"/topic", Pretty ColorText
"/main"],
            Pretty ColorText
"merges the branch `topic` of the current project into the `main` branch of the current project"
          ),
          ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeOldInputPattern [Pretty ColorText
"foo/topic", Pretty ColorText
"/main"],
            Pretty ColorText
"merges the branch `topic` of the project `foo` into the `main` branch of the current project"
          ),
          ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeOldInputPattern [Pretty ColorText
"/topic", Pretty ColorText
"foo/main"],
            Pretty ColorText
"merges the branch `topic` of the current project into the `main` branch of the project 'foo`"
          )
        ]
    )
    ( \case
        [Argument
src] ->
          BranchRelativePath
-> Maybe BranchRelativePath -> MergeMode -> Input
Input.MergeLocalBranchI
            (BranchRelativePath
 -> Maybe BranchRelativePath -> MergeMode -> Input)
-> Either (Pretty ColorText) BranchRelativePath
-> Either
     (Pretty ColorText) (Maybe BranchRelativePath -> MergeMode -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
src
            Either
  (Pretty ColorText) (Maybe BranchRelativePath -> MergeMode -> Input)
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
-> Either (Pretty ColorText) (MergeMode -> Input)
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe BranchRelativePath
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BranchRelativePath
forall a. Maybe a
Nothing
            Either (Pretty ColorText) (MergeMode -> Input)
-> Either (Pretty ColorText) MergeMode
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MergeMode -> Either (Pretty ColorText) MergeMode
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeMode
Branch.RegularMerge
        [Argument
src, Argument
dest] ->
          BranchRelativePath
-> Maybe BranchRelativePath -> MergeMode -> Input
Input.MergeLocalBranchI
            (BranchRelativePath
 -> Maybe BranchRelativePath -> MergeMode -> Input)
-> Either (Pretty ColorText) BranchRelativePath
-> Either
     (Pretty ColorText) (Maybe BranchRelativePath -> MergeMode -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
src
            Either
  (Pretty ColorText) (Maybe BranchRelativePath -> MergeMode -> Input)
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
-> Either (Pretty ColorText) (MergeMode -> Input)
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BranchRelativePath -> Maybe BranchRelativePath
forall a. a -> Maybe a
Just (BranchRelativePath -> Maybe BranchRelativePath)
-> Either (Pretty ColorText) BranchRelativePath
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
dest)
            Either (Pretty ColorText) (MergeMode -> Input)
-> Either (Pretty ColorText) MergeMode
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MergeMode -> Either (Pretty ColorText) MergeMode
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MergeMode
Branch.RegularMerge
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"one or two arguments" Arguments
args
    )
  where
    config :: ProjectBranchSuggestionsConfig
config =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

mergeInputPattern :: InputPattern
mergeInputPattern :: InputPattern
mergeInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"merge",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args =
        [ ( Text
"branch to merge",
            IsOptional
Required,
            ProjectBranchSuggestionsConfig -> ArgumentType
projectBranchNameArg
              ProjectBranchSuggestionsConfig
                { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
True,
                  $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
                  $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
ExcludeCurrentBranch
                }
          )
        ],
      $sel:help:InputPattern :: Pretty ColorText
help = 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
$ InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeInputPattern [Pretty ColorText
"/branch"] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"merges `branch` into the current branch",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse =
        \case
          [Argument
branchString] -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input
Input.MergeI (ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg Argument
branchString
          Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }

mergeCommitInputPattern :: InputPattern
mergeCommitInputPattern :: InputPattern
mergeCommitInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"merge.commit",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"commit.merge"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help =
        let mainBranch :: ProjectBranchName
mainBranch = Text -> ProjectBranchName
UnsafeProjectBranchName Text
"main"
            tempBranch :: ProjectBranchName
tempBranch = Text -> ProjectBranchName
UnsafeProjectBranchName Text
"merge-topic-into-main"
         in Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
              ( InputPattern -> Pretty ColorText
makeExample' InputPattern
mergeCommitInputPattern
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"merges a temporary branch created by the"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
mergeInputPattern
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"command back into its parent branch, and removes the temporary branch."
              )
              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
"For example, if you've done"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeInputPattern [Pretty ColorText
"topic"]
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"from"
                    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 (ProjectBranchName -> Pretty ColorText
prettyProjectBranchName ProjectBranchName
mainBranch 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
"then"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
mergeCommitInputPattern
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"is equivalent to doing"
                )
              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] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
P.bulleted
                    [ InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleNoBackticks InputPattern
projectSwitch [ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
mainBranch],
                      InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleNoBackticks InputPattern
mergeInputPattern [ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
tempBranch],
                      InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleNoBackticks InputPattern
deleteBranch [ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
tempBranch]
                    ]
                ),
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.MergeCommitI
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args
    }

diffNamespace :: InputPattern
diffNamespace :: InputPattern
diffNamespace =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"diff.namespace"
    []
    Visibility
I.Visible
    [(Text
"before namespace", IsOptional
Required, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig), (Text
"after namespace", IsOptional
Optional, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2
        [ ( Pretty ColorText
"`diff.namespace before after`",
            Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"shows how the namespace `after` differs from the namespace `before`"
          ),
          ( Pretty ColorText
"`diff.namespace before`",
            Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"shows how the current namespace differs from the namespace `before`"
          )
        ]
    )
    ( \case
        [Argument
before, Argument
after] -> BranchId2 -> BranchId2 -> Input
Input.DiffNamespaceI (BranchId2 -> BranchId2 -> Input)
-> Either (Pretty ColorText) BranchId2
-> Either (Pretty ColorText) (BranchId2 -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchId2
handleBranchId2Arg Argument
before Either (Pretty ColorText) (BranchId2 -> Input)
-> Either (Pretty ColorText) BranchId2
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) BranchId2
handleBranchId2Arg Argument
after
        [Argument
before] -> BranchId2 -> BranchId2 -> Input
Input.DiffNamespaceI (BranchId2 -> BranchId2 -> Input)
-> Either (Pretty ColorText) BranchId2
-> Either (Pretty ColorText) (BranchId2 -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchId2
handleBranchId2Arg Argument
before Either (Pretty ColorText) (BranchId2 -> Input)
-> Either (Pretty ColorText) BranchId2
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BranchId2 -> Either (Pretty ColorText) BranchId2
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> BranchId2
forall a b. b -> Either a b
Right (BranchRelativePath -> BranchId2)
-> (Path' -> BranchRelativePath) -> Path' -> BranchId2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> BranchId2) -> Path' -> BranchId2
forall a b. (a -> b) -> a -> b
$ Path'
Path.currentPath)
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"one or two arguments" Arguments
args
    )
  where
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

mergeOldPreviewInputPattern :: InputPattern
mergeOldPreviewInputPattern :: InputPattern
mergeOldPreviewInputPattern =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"merge.old.preview"
    []
    Visibility
I.Hidden
    [(Text
"branch or namespace to merge", IsOptional
Required, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig), (Text
"merge destination", IsOptional
Optional, ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
suggestionsConfig)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2
        [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeOldPreviewInputPattern [Pretty ColorText
"src"],
            Pretty ColorText
"shows how the current namespace will change after a " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeOldInputPattern [Pretty ColorText
"src"]
          ),
          ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeOldPreviewInputPattern [Pretty ColorText
"src", Pretty ColorText
"dest"],
            Pretty ColorText
"shows how `dest` namespace will change after a " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
mergeOldInputPattern [Pretty ColorText
"src", Pretty ColorText
"dest"]
          )
        ]
    )
    ( \case
        [Argument
src] -> BranchRelativePath -> Maybe BranchRelativePath -> Input
Input.PreviewMergeLocalBranchI (BranchRelativePath -> Maybe BranchRelativePath -> Input)
-> Either (Pretty ColorText) BranchRelativePath
-> Either (Pretty ColorText) (Maybe BranchRelativePath -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
src Either (Pretty ColorText) (Maybe BranchRelativePath -> Input)
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe BranchRelativePath
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe BranchRelativePath
forall a. Maybe a
Nothing
        [Argument
src, Argument
dest] ->
          BranchRelativePath -> Maybe BranchRelativePath -> Input
Input.PreviewMergeLocalBranchI (BranchRelativePath -> Maybe BranchRelativePath -> Input)
-> Either (Pretty ColorText) BranchRelativePath
-> Either (Pretty ColorText) (Maybe BranchRelativePath -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
src Either (Pretty ColorText) (Maybe BranchRelativePath -> Input)
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (BranchRelativePath -> Maybe BranchRelativePath
forall a. a -> Maybe a
Just (BranchRelativePath -> Maybe BranchRelativePath)
-> Either (Pretty ColorText) BranchRelativePath
-> Either (Pretty ColorText) (Maybe BranchRelativePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
dest)
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"one or two arguments" Arguments
args
    )
  where
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

deprecatedViewRootReflog :: InputPattern
deprecatedViewRootReflog :: InputPattern
deprecatedViewRootReflog =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"deprecated.root-reflog"
    []
    Visibility
I.Visible
    []
    ( Pretty ColorText
"`deprecated.root-reflog` lists the changes that have affected the root namespace. This has been deprecated in favor of "
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
branchReflog []
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" which shows the reflog for the current project."
    )
    ( \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
Input.ShowRootReflogI
        Arguments
_ ->
          Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> (String -> Pretty ColorText)
-> String
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string (String -> Either (Pretty ColorText) Input)
-> String -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$
            InputPattern -> String
I.patternName InputPattern
deprecatedViewRootReflog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" doesn't take any arguments."
    )

branchReflog :: InputPattern
branchReflog :: InputPattern
branchReflog =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"reflog"
    [String
"reflog.branch", String
"branch.reflog"]
    Visibility
I.Visible
    []
    ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty ColorText
"`reflog` lists all the changes that have affected the current branch.",
          Pretty ColorText
"`reflog /mybranch` lists all the changes that have affected /mybranch."
        ]
    )
    ( \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Input
Input.ShowProjectBranchReflogI Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a. Maybe a
Nothing
        [Argument
branchRef] -> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Input
Input.ShowProjectBranchReflogI (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
 -> Input)
-> Either
     (Pretty ColorText)
     (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a. a -> Maybe a
Just (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
 -> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg Argument
branchRef)
        Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (InputPattern -> Pretty ColorText
I.help InputPattern
branchReflog)
    )

projectReflog :: InputPattern
projectReflog :: InputPattern
projectReflog =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"project.reflog"
    [String
"reflog.project"]
    Visibility
I.Visible
    []
    ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty ColorText
"`project.reflog` lists all the changes that have affected any branches in the current project.",
          Pretty ColorText
"`project.reflog myproject` lists all the changes that have affected any branches in myproject."
        ]
    )
    ( \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Maybe ProjectName -> Input
Input.ShowProjectReflogI Maybe ProjectName
forall a. Maybe a
Nothing
        [Argument
projectRef] -> Maybe ProjectName -> Input
Input.ShowProjectReflogI (Maybe ProjectName -> Input)
-> Either (Pretty ColorText) (Maybe ProjectName)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProjectName -> Maybe ProjectName
forall a. a -> Maybe a
Just (ProjectName -> Maybe ProjectName)
-> Either (Pretty ColorText) ProjectName
-> Either (Pretty ColorText) (Maybe ProjectName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectName
handleProjectArg Argument
projectRef)
        Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (InputPattern -> Pretty ColorText
I.help InputPattern
projectReflog)
    )

globalReflog :: InputPattern
globalReflog :: InputPattern
globalReflog =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"reflog.global"
    []
    Visibility
I.Visible
    []
    ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
        [ Pretty ColorText
"`reflog.global` lists all recent changes across all projects and branches."
        ]
    )
    ( \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input
Input.ShowGlobalReflogI
        Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (InputPattern -> Pretty ColorText
I.help InputPattern
globalReflog)
    )

edit :: InputPattern
edit :: InputPattern
edit =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"edit",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"definition to edit", IsOptional
OnePlus, ArgumentType
definitionQueryArg)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty ColorText
"`edit foo` prepends the definition of `foo` to the top of the most "
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"recently saved file.",
            Pretty ColorText
"`edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH."
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse =
        Either (Pretty ColorText) Input
-> (NonEmpty Argument -> Either (Pretty ColorText) Input)
-> Maybe (NonEmpty Argument)
-> Either (Pretty ColorText) Input
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Text -> [Any] -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least one argument" [])
          ( (NonEmpty (HashQualified Name) -> Input)
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OutputLocation
-> ShowDefinitionScope -> NonEmpty (HashQualified Name) -> Input
Input.ShowDefinitionI OutputLocation
Input.LatestFileLocation ShowDefinitionScope
Input.ShowDefinitionLocal)
              (Either (Pretty ColorText) (NonEmpty (HashQualified Name))
 -> Either (Pretty ColorText) Input)
-> (NonEmpty Argument
    -> Either (Pretty ColorText) (NonEmpty (HashQualified Name)))
-> NonEmpty Argument
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) (HashQualified Name))
-> NonEmpty Argument
-> Either (Pretty ColorText) (NonEmpty (HashQualified Name))
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) -> NonEmpty a -> f (NonEmpty b)
traverse Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg
          )
          (Maybe (NonEmpty Argument) -> Either (Pretty ColorText) Input)
-> (Arguments -> Maybe (NonEmpty Argument))
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments -> Maybe (NonEmpty Argument)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
    }

editNamespace :: InputPattern
editNamespace :: InputPattern
editNamespace =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"edit.namespace",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"namespace to load definitions from", IsOptional
ZeroPlus, ArgumentType
namespaceArg)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty ColorText
"`edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries.",
            Pretty ColorText
"`edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces."
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = ([Path] -> Input)
-> Either (Pretty ColorText) [Path]
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Path] -> Input
Input.EditNamespaceI (Either (Pretty ColorText) [Path]
 -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) [Path])
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument -> Either (Pretty ColorText) Path)
-> Arguments -> Either (Pretty ColorText) [Path]
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 Argument -> Either (Pretty ColorText) Path
handlePathArg
    }

topicNameArg :: ArgumentType
topicNameArg :: ArgumentType
topicNameArg =
  let topics :: [String]
topics = Map String (Pretty ColorText) -> [String]
forall k a. Map k a -> [k]
Map.keys Map String (Pretty ColorText)
helpTopicsMap
   in ArgumentType
        { $sel:typeName:ArgumentType :: String
typeName = String
"topic",
          $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
_ AuthenticatedHttpClient
_ ProjectPath
_ -> [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String] -> [Completion]
exactComplete String
q [String]
topics),
          $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just (FZFResolver -> Maybe FZFResolver)
-> FZFResolver -> Maybe FZFResolver
forall a b. (a -> b) -> a -> b
$ [Text] -> FZFResolver
Resolvers.fuzzySelectFromList (String -> Text
Text.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
topics)
        }

helpTopics :: InputPattern
helpTopics :: InputPattern
helpTopics =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"help-topics"
    [String
"help-topic"]
    Visibility
I.Visible
    [(Text
"topic", IsOptional
Optional, ArgumentType
topicNameArg)]
    (Pretty ColorText
"`help-topics` lists all topics and `help-topics <topic>` shows an explanation of that topic.")
    ( \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Input
Input.CreateMessage Pretty ColorText
topics
        [Argument
topic] -> do
          String
topic <- InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
helpTopics Text
"a help topic" Argument
topic
          case String -> Map String (Pretty ColorText) -> Maybe (Pretty ColorText)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
topic Map String (Pretty ColorText)
helpTopicsMap of
            Maybe (Pretty ColorText)
Nothing -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"I don't know of that topic. Try `help-topics`."
            Just Pretty ColorText
t -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Input
Input.CreateMessage Pretty ColorText
t
        Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"Use `help-topics <topic>` or `help-topics`."
    )
  where
    topics :: Pretty ColorText
topics =
      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] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines
          [ Pretty ColorText
"Here's a list of topics I can tell you more about: ",
            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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
P.sep Pretty ColorText
"\n" (String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string (String -> Pretty ColorText) -> [String] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String (Pretty ColorText) -> [String]
forall k a. Map k a -> [k]
Map.keys Map String (Pretty ColorText)
helpTopicsMap),
            Pretty ColorText
"",
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
aside Pretty ColorText
"Example" Pretty ColorText
"use `help-topics filestatus` to learn more about that topic."
          ]

helpTopicsMap :: Map String (P.Pretty P.ColorText)
helpTopicsMap :: Map String (Pretty ColorText)
helpTopicsMap =
  [(String, Pretty ColorText)] -> Map String (Pretty ColorText)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (String
"testcache", Pretty ColorText
testCacheMsg),
      (String
"filestatus", Pretty ColorText
fileStatusMsg),
      (String
"messages.disallowedAbsolute", Pretty ColorText
disallowedAbsoluteMsg),
      (String
"remotes", Pretty ColorText
remotesMsg),
      (String
"namespaces", Pretty ColorText
pathnamesMsg),
      (String
"projects", Pretty ColorText
projectsMsg)
    ]
  where
    blankline :: (Pretty ColorText, Pretty ColorText)
blankline = (Pretty ColorText
"", Pretty ColorText
"")
    fileStatusMsg :: Pretty ColorText
fileStatusMsg =
      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)
-> [Pretty ColorText]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText
"Here's a list of possible status messages you might see"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"for definitions in a .u file.",
          Pretty ColorText
"",
          [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
            [ ( Pretty ColorText -> Pretty ColorText
P.bold (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Status -> Pretty ColorText
SR.prettyStatus Status
SR.Collision,
                Pretty ColorText
"A definition with the same name as an existing definition. Doing"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"`update` instead of `add` will turn this failure into a successful"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"update."
              ),
              (Pretty ColorText, Pretty ColorText)
blankline,
              ( Pretty ColorText -> Pretty ColorText
P.bold (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Status -> Pretty ColorText
SR.prettyStatus Status
SR.TermExistingConstructorCollision,
                Pretty ColorText
"A definition with the same name as an existing constructor for "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"some data type. Rename your definition or the data type before"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"trying again to `add` or `update`."
              ),
              (Pretty ColorText, Pretty ColorText)
blankline,
              ( Pretty ColorText -> Pretty ColorText
P.bold (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Status -> Pretty ColorText
SR.prettyStatus Status
SR.ConstructorExistingTermCollision,
                Pretty ColorText
"A type defined in the file has a constructor that's named the"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"same as an existing term. Rename that term or your constructor"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"before trying again to `add` or `update`."
              ),
              (Pretty ColorText, Pretty ColorText)
blankline,
              ( Pretty ColorText -> Pretty ColorText
P.bold (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Status -> Pretty ColorText
SR.prettyStatus Status
SR.BlockedDependency,
                Pretty ColorText
"This definition was blocked because it dependended on "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"a definition with a failed status."
              ),
              (Pretty ColorText, Pretty ColorText)
blankline,
              ( Pretty ColorText -> Pretty ColorText
P.bold (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Status -> Pretty ColorText
SR.prettyStatus Status
SR.ExtraDefinition,
                Pretty ColorText
"This definition was added because it was a dependency of"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"a definition explicitly selected."
              )
            ]
        ]
    testCacheMsg :: Pretty ColorText
testCacheMsg =
      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)
-> [Pretty ColorText]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText
"Unison caches the results of "
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
"test>"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"watch expressions. Since these expressions are pure and"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"always yield the same result when evaluated, there's no need"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"to run them more than once!",
          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
"A test is rerun only if it has changed, or if one"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"of the definitions it depends on has changed."
        ]
    pathnamesMsg :: Pretty ColorText
pathnamesMsg =
      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty ColorText
"\129488" (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 (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText
"There are two kinds of namespaces,"
              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 (Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
"absolute" 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
"such as"
              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 (Pretty ColorText
"(" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
".foo.bar")
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"or"
              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 (Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
".base.math.+" 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
"and"
              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 (Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"relative" 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
"such as"
              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 (Pretty ColorText
"(" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"math.sqrt")
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"or"
              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 (Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"util.List.++" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")."),
          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
"Relative names are converted to absolute names by prepending the current namespace."
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"For example, if your Unison prompt reads:",
          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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
".foo.bar>",
          Pretty ColorText
"",
          Pretty ColorText
"and your .u file looks like:",
          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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"x" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" = 41",
          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
"then doing an"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
"add"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"will create the definition with the absolute name"
              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 (Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
".foo.bar.x" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" = 41"),
          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
"and you can refer to"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.green Pretty ColorText
"x"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"by its absolute name "
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
".foo.bar.x"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"elsewhere"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"in your code. For instance:",
          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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText
"answerToLifeTheUniverseAndEverything = " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
".foo.bar.x" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" + 1"
        ]

    disallowedAbsoluteMsg :: Pretty ColorText
disallowedAbsoluteMsg =
      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty ColorText
"\129302" (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 (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText
"Although I can understand absolute (ex: .foo.bar) or"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"relative (ex: util.math.sqrt) references to existing definitions"
              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 (Pretty ColorText
"(" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
P.blue Pretty ColorText
"help namespaces")
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"to learn more),"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"I can't yet handle giving new definitions with absolute names in a .u file.",
          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
"As a workaround, you can give definitions with a relative name"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"temporarily (like `exports.blah.foo`) and then use `move.*`."
        ]
    remotesMsg :: Pretty ColorText
remotesMsg =
      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
P.callout Pretty ColorText
"\129302" (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 (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText
"Local projects may be associated with at most one remote project on Unison Share."
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"When this relationship is established, it becomes the default argument for a"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"number of share commands. For example, running `push` or `pull` in a project"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"with no arguments will push to or pull from the associated remote, if it exists.",
          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
"This association is created automatically on when a project is created by `clone`."
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"If the project was created locally then the relationship will be established on"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"the first `push`."
        ]
    projectsMsg :: Pretty ColorText
projectsMsg =
      [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
P.lines ([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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText
"A project is a versioned collection of code that can be edited, published, and depended on other projects."
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"Unison projects are analogous to Git repositories.",
          Pretty ColorText
"",
          [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2
            [ (InputPattern -> Pretty ColorText
patternName InputPattern
projectCreate, Pretty ColorText
"create a new project"),
              (InputPattern -> Pretty ColorText
patternName InputPattern
projectsInputPattern, Pretty ColorText
"list all your projects"),
              (InputPattern -> Pretty ColorText
patternName InputPattern
branchInputPattern, Pretty ColorText
"create a new workstream"),
              (InputPattern -> Pretty ColorText
patternName InputPattern
branchesInputPattern, Pretty ColorText
"list all your branches"),
              (InputPattern -> Pretty ColorText
patternName InputPattern
mergeInputPattern, Pretty ColorText
"merge one branch into another"),
              (InputPattern -> Pretty ColorText
patternName InputPattern
projectSwitch, Pretty ColorText
"switch to a project or branch"),
              (InputPattern -> Pretty ColorText
patternName InputPattern
push, Pretty ColorText
"upload your changes to Unison Share"),
              (InputPattern -> Pretty ColorText
patternName InputPattern
pull, Pretty ColorText
"download code(/changes/updates) from Unison Share"),
              (InputPattern -> Pretty ColorText
patternName InputPattern
clone, Pretty ColorText
"download a Unison Share project or branch for contribution")
            ],
          Pretty ColorText
"",
          Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
tip (Pretty ColorText
"Use" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
help [InputPattern -> Pretty ColorText
patternName InputPattern
projectCreate] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"to learn more."),
          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
"For full documentation, see"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> URI -> Pretty ColorText
prettyURI (Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe URI
URI.parseURI String
"https://unison-lang.org/learn/projects"))
        ]

help :: InputPattern
help :: InputPattern
help =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"help"
    [String
"?"]
    Visibility
I.Visible
    [(Text
"command", IsOptional
Optional, ArgumentType
commandNameArg)]
    Pretty ColorText
"`help` shows general help and `help <cmd>` shows help for one command."
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      [] ->
        Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> (Pretty ColorText -> Input)
-> Pretty ColorText
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Input
Input.CreateMessage (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$
          Pretty ColorText
-> (InputPattern -> Pretty ColorText)
-> [InputPattern]
-> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap
            Pretty ColorText
"\n\n"
            InputPattern -> Pretty ColorText
showPatternHelp
            [InputPattern]
visibleInputs
      [Argument
cmd] -> do
        String
cmd <- InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
help Text
"a command" Argument
cmd
        case (String -> Map String InputPattern -> Maybe InputPattern
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
cmd Map String InputPattern
commandsByName, String -> Maybe (Pretty ColorText)
isHelp String
cmd) of
          (Maybe InputPattern
Nothing, Just Pretty ColorText
msg) -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Pretty ColorText -> Input
Input.CreateMessage Pretty ColorText
msg
          (Maybe InputPattern
Nothing, Maybe (Pretty ColorText)
Nothing) -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"I don't know of that command. Try" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleEOS InputPattern
help []
          (Just InputPattern
pat, Maybe (Pretty ColorText)
Nothing) -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> (Pretty ColorText -> Input)
-> Pretty ColorText
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Input
Input.CreateMessage (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ InputPattern -> Pretty ColorText
showPatternHelp InputPattern
pat
          -- If we have a command and a help topic with the same name (like "projects"), then append a tip to the
          -- command's help that suggests running `help-topic command`
          (Just InputPattern
pat, Just Pretty ColorText
_) ->
            Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> (Pretty ColorText -> Input)
-> Pretty ColorText
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Input
Input.CreateMessage (Pretty ColorText -> Either (Pretty ColorText) Input)
-> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$
              InputPattern -> Pretty ColorText
showPatternHelp InputPattern
pat
                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
tip (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                       Pretty ColorText
"To read more about"
                         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 s. IsString s => String -> Pretty s
P.string String
cmd 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
"use"
                         Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
helpTopics [String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string String
cmd]
                   )
      Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left Pretty ColorText
"Use `help <cmd>` or `help`."
  where
    commandsByName :: Map String InputPattern
commandsByName =
      [(String, InputPattern)] -> Map String InputPattern
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, InputPattern)] -> Map String InputPattern)
-> [(String, InputPattern)] -> Map String InputPattern
forall a b. (a -> b) -> a -> b
$ do
        input :: InputPattern
input@I.InputPattern {String
$sel:patternName:InputPattern :: InputPattern -> String
patternName :: String
I.patternName, [String]
$sel:aliases:InputPattern :: InputPattern -> [String]
aliases :: [String]
I.aliases} <- [InputPattern]
validInputs
        String
name <- String
patternName String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
aliases
        pure (String
name, InputPattern
input)
    isHelp :: String -> Maybe (Pretty ColorText)
isHelp String
s = String -> Map String (Pretty ColorText) -> Maybe (Pretty ColorText)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
s Map String (Pretty ColorText)
helpTopicsMap

quit :: InputPattern
quit :: InputPattern
quit =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"quit"
    [String
"exit", String
":q"]
    Visibility
I.Visible
    []
    Pretty ColorText
"Exits the Unison command line interface."
    \case
      [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
Input.QuitI
      Arguments
_ -> Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left Pretty ColorText
"Use `quit`, `exit`, or <Ctrl-D> to quit."

names :: Input.IsGlobal -> InputPattern
names :: Bool -> InputPattern
names Bool
isGlobal =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
cmdName
    []
    Visibility
I.Visible
    [(Text
"name or hash", IsOptional
Required, ArgumentType
definitionQueryArg)]
    (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
$ InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample (Bool -> InputPattern
names Bool
isGlobal) [Pretty ColorText
"foo"] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
description)
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      [Argument
thing] -> Bool -> HashQualified Name -> Input
Input.NamesI Bool
isGlobal (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
thing
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
  where
    description :: Pretty ColorText
description
      | Bool
isGlobal = Pretty ColorText
"Iteratively search across all projects and branches for names matching `foo`. Note that this is expected to be quite slow and is primarily for debugging issues with your codebase."
      | Bool
otherwise = Pretty ColorText
"List all known names for `foo` in the current branch."
    cmdName :: String
cmdName = if Bool
isGlobal then String
"debug.names.global" else String
"names"

dependents, dependencies :: InputPattern
dependents :: InputPattern
dependents =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"dependents"
    []
    Visibility
I.Visible
    [(Text
"definition", IsOptional
Required, ArgumentType
definitionQueryArg)]
    Pretty ColorText
"List the named dependents of the specified definition."
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      [Argument
thing] -> HashQualified Name -> Input
Input.ListDependentsI (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
thing
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
dependencies :: InputPattern
dependencies =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"dependencies"
    []
    Visibility
I.Visible
    [(Text
"definition", IsOptional
Required, ArgumentType
definitionQueryArg)]
    Pretty ColorText
"List the dependencies of the specified definition."
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      [Argument
thing] -> HashQualified Name -> Input
Input.ListDependenciesI (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
thing
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args

namespaceDependencies :: InputPattern
namespaceDependencies :: InputPattern
namespaceDependencies =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"namespace.dependencies"
    []
    Visibility
I.Visible
    [(Text
"namespace", IsOptional
Optional, ArgumentType
namespaceArg)]
    Pretty ColorText
"List the external dependencies of the specified namespace."
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      [Argument
p] -> Maybe Path' -> Input
Input.NamespaceDependenciesI (Maybe Path' -> Input) -> (Path' -> Maybe Path') -> Path' -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Maybe Path'
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path' -> Input)
-> Either (Pretty ColorText) Path'
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Path'
handlePath'Arg Argument
p
      [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Path' -> Input
Input.NamespaceDependenciesI Maybe Path'
forall a. Maybe a
Nothing)
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args

debugNumberedArgs :: InputPattern
debugNumberedArgs :: InputPattern
debugNumberedArgs =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.numberedArgs"
    []
    Visibility
I.Visible
    []
    Pretty ColorText
"Dump the contents of the numbered args state."
    (Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> Arguments
-> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.DebugNumberedArgsI)

debugFileHashes :: InputPattern
debugFileHashes :: InputPattern
debugFileHashes =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.file"
    []
    Visibility
I.Visible
    []
    Pretty ColorText
"View details about the most recent successfully typechecked file."
    (Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> Arguments
-> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.DebugTypecheckedUnisonFileI)

debugDumpNamespace :: InputPattern
debugDumpNamespace :: InputPattern
debugDumpNamespace =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.dump-namespace"
    []
    Visibility
I.Visible
    []
    Pretty ColorText
"Dump the namespace to a text file"
    (Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> Arguments
-> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.DebugDumpNamespacesI)

debugDumpNamespaceSimple :: InputPattern
debugDumpNamespaceSimple :: InputPattern
debugDumpNamespaceSimple =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.dump-namespace-simple"
    []
    Visibility
I.Visible
    []
    Pretty ColorText
"Dump the namespace to a text file"
    (Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> Arguments
-> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.DebugDumpNamespaceSimpleI)

debugTerm :: InputPattern
debugTerm :: InputPattern
debugTerm =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.term.abt"
    []
    Visibility
I.Hidden
    [(Text
"term", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg)]
    Pretty ColorText
"View debugging information for a given term."
    ( \case
        [Argument
thing] -> Bool -> HashQualified Name -> Input
Input.DebugTermI Bool
False (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
thing
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    )

debugTermVerbose :: InputPattern
debugTermVerbose :: InputPattern
debugTermVerbose =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.term.abt.verbose"
    []
    Visibility
I.Hidden
    [(Text
"term", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg)]
    Pretty ColorText
"View verbose debugging information for a given term."
    ( \case
        [Argument
thing] -> Bool -> HashQualified Name -> Input
Input.DebugTermI Bool
True (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
thing
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    )

debugType :: InputPattern
debugType :: InputPattern
debugType =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.type.abt"
    []
    Visibility
I.Hidden
    [(Text
"type", IsOptional
Required, ArgumentType
exactDefinitionTypeQueryArg)]
    Pretty ColorText
"View debugging information for a given type."
    ( \case
        [Argument
thing] -> HashQualified Name -> Input
Input.DebugTypeI (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
thing
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    )

debugLSPFoldRanges :: InputPattern
debugLSPFoldRanges :: InputPattern
debugLSPFoldRanges =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.lsp.fold-ranges"
    []
    Visibility
I.Hidden
    []
    Pretty ColorText
"Output the source from the most recently parsed file, but annotated with the computed fold ranges."
    (Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> Arguments
-> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.DebugLSPFoldRangesI)

debugClearWatchCache :: InputPattern
debugClearWatchCache :: InputPattern
debugClearWatchCache =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.clear-cache"
    []
    Visibility
I.Visible
    []
    Pretty ColorText
"Clear the watch expression cache"
    (Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> Arguments
-> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.DebugClearWatchI)

debugDoctor :: InputPattern
debugDoctor :: InputPattern
debugDoctor =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.doctor"
    []
    Visibility
I.Visible
    []
    ( Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"Analyze your codebase for errors and inconsistencies."
    )
    ( \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input
Input.DebugDoctorI
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args
    )

debugNameDiff :: InputPattern
debugNameDiff :: InputPattern
debugNameDiff =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"debug.name-diff",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Hidden,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"before namespace", IsOptional
Required, ArgumentType
namespaceArg), (Text
"after namespace", IsOptional
Required, ArgumentType
namespaceArg)],
      $sel:help:InputPattern :: Pretty ColorText
help = Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"List all name changes between two causal hashes. Does not detect patch changes.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
from, Argument
to] -> ShortCausalHash -> ShortCausalHash -> Input
Input.DebugNameDiffI (ShortCausalHash -> ShortCausalHash -> Input)
-> Either (Pretty ColorText) ShortCausalHash
-> Either (Pretty ColorText) (ShortCausalHash -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ShortCausalHash
handleShortCausalHashArg Argument
from Either (Pretty ColorText) (ShortCausalHash -> Input)
-> Either (Pretty ColorText) ShortCausalHash
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) ShortCausalHash
handleShortCausalHashArg Argument
to
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly two arguments" Arguments
args
    }

test :: InputPattern
test :: InputPattern
test =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"test",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"namespace", IsOptional
Optional, ArgumentType
namespaceArg)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ (Pretty ColorText
"`test`", Pretty ColorText
"runs unit tests for the current branch"),
            (Pretty ColorText
"`test foo`", Pretty ColorText
"runs unit tests for the current branch defined in namespace `foo`")
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse =
        (Path -> Input)
-> Either (Pretty ColorText) Path
-> Either (Pretty ColorText) Input
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ( \Path
path ->
              TestInput -> Input
Input.TestI
                Input.TestInput
                  { $sel:includeLibNamespace:TestInput :: Bool
includeLibNamespace = Bool
False,
                    Path
path :: Path
$sel:path:TestInput :: Path
path,
                    $sel:showFailures:TestInput :: Bool
showFailures = Bool
True,
                    $sel:showSuccesses:TestInput :: Bool
showSuccesses = Bool
True
                  }
          )
          (Either (Pretty ColorText) Path -> Either (Pretty ColorText) Input)
-> (Arguments -> Either (Pretty ColorText) Path)
-> Arguments
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            [] -> Path -> Either (Pretty ColorText) Path
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
Path.empty
            [Argument
pathString] -> Argument -> Either (Pretty ColorText) Path
handlePathArg Argument
pathString
            Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Path
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args
    }

testAll :: InputPattern
testAll :: InputPattern
testAll =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"test.all"
    []
    Visibility
I.Visible
    []
    Pretty ColorText
"`test.all` runs unit tests for the current branch (including the `lib` namespace)."
    ( Either (Pretty ColorText) Input
-> Arguments -> Either (Pretty ColorText) Input
forall a b. a -> b -> a
const (Either (Pretty ColorText) Input
 -> Arguments -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
-> Arguments
-> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$
        Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$
          TestInput -> Input
Input.TestI
            Input.TestInput
              { $sel:includeLibNamespace:TestInput :: Bool
includeLibNamespace = Bool
True,
                $sel:path:TestInput :: Path
path = Path
Path.empty,
                $sel:showFailures:TestInput :: Bool
showFailures = Bool
True,
                $sel:showSuccesses:TestInput :: Bool
showSuccesses = Bool
True
              }
    )

docsToHtml :: InputPattern
docsToHtml :: InputPattern
docsToHtml =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"docs.to-html"
    []
    Visibility
I.Visible
    [(Text
"namespace", IsOptional
Required, ArgumentType
branchRelativePathArg), (Text
"", IsOptional
Required, ArgumentType
filePathArg)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
docsToHtml [Pretty ColorText
".path.to.ns", Pretty ColorText
"doc-dir"],
            Pretty ColorText
"Render all docs contained within the namespace `.path.to.ns`, no matter how deep, to html files in `doc-dir` in the directory UCM was run from."
          ),
          ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
docsToHtml [Pretty ColorText
"project0/branch0:a.path", Pretty ColorText
"/tmp/doc-dir"],
            Pretty ColorText
"Renders all docs anywhere in the namespace `a.path` from `branch0` of `project0` to html in `/tmp/doc-dir`."
          )
        ]
    )
    \case
      [Argument
namespacePath, Argument
destinationFilePath] ->
        BranchRelativePath -> String -> Input
Input.DocsToHtmlI
          (BranchRelativePath -> String -> Input)
-> Either (Pretty ColorText) BranchRelativePath
-> Either (Pretty ColorText) (String -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) BranchRelativePath
handleBranchRelativePathArg Argument
namespacePath
          Either (Pretty ColorText) (String -> Input)
-> Either (Pretty ColorText) String
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
docsToHtml Text
"a file name" Argument
destinationFilePath
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly two arguments" Arguments
args

docToMarkdown :: InputPattern
docToMarkdown :: InputPattern
docToMarkdown =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"debug.doc-to-markdown"
    []
    Visibility
I.Visible
    [(Text
"doc to render", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( Pretty ColorText
"`debug.doc-to-markdown term.doc`",
            Pretty ColorText
"Render a doc to markdown."
          )
        ]
    )
    \case
      [Argument
docNameText] -> Name -> Input
Input.DocToMarkdownI (Name -> Input)
-> Either (Pretty ColorText) Name
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Name
handleNameArg Argument
docNameText
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args

execute :: InputPattern
execute :: InputPattern
execute =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"run"
    []
    Visibility
I.Visible
    [(Text
"definition to execute", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg), (Text
"argument", IsOptional
ZeroPlus, ArgumentType
noCompletionsArg)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( Pretty ColorText
"`run mymain args...`",
            Pretty ColorText
"Runs `!mymain`, where `mymain` is searched for in the most recent"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"typechecked file, or in the codebase."
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"Any provided arguments will be passed as program arguments as though they were"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"provided at the command line when running mymain as an executable."
          )
        ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      Argument
main : Arguments
args ->
        HashQualified Name -> [String] -> Input
Input.ExecuteI
          (HashQualified Name -> [String] -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) ([String] -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
main
          Either (Pretty ColorText) ([String] -> Input)
-> Either (Pretty ColorText) [String]
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Argument -> Either (Pretty ColorText) String)
-> Arguments -> Either (Pretty ColorText) [String]
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 (InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
execute Text
"a command-line argument") Arguments
args
      [] -> Text -> [Any] -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least one argument" []

saveExecuteResult :: InputPattern
saveExecuteResult :: InputPattern
saveExecuteResult =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"add.run"
    []
    Visibility
I.Visible
    [(Text
"new name", IsOptional
Required, ArgumentType
newNameArg)]
    ( Pretty ColorText
"`add.run name` adds to the codebase the result of the most recent `run` command"
        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" as `name`."
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      [Argument
w] -> Name -> Input
Input.SaveExecuteResultI (Name -> Input)
-> Either (Pretty ColorText) Name
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Name
handleNameArg Argument
w
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args

ioTest :: InputPattern
ioTest :: InputPattern
ioTest =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"io.test",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"test.io"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"test to run", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ ( Pretty ColorText
"`io.test mytest`",
              Pretty ColorText
"Runs `!mytest`, where `mytest` is a delayed test that can use the `IO` and `Exception` abilities."
            )
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
thing] -> HashQualified Name -> Input
Input.IOTestI (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
thing
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }

ioTestAll :: InputPattern
ioTestAll :: InputPattern
ioTestAll =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"io.test.all",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"test.io.all"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ ( Pretty ColorText
"`io.test.all`",
              Pretty ColorText
"runs unit tests for the current branch that use IO"
            )
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.IOTestAllI
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args
    }

makeStandalone :: InputPattern
makeStandalone :: InputPattern
makeStandalone =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"compile"
    [String
"compile.output"]
    Visibility
I.Visible
    [(Text
"definition to compile", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg), (Text
"output file", IsOptional
Required, ArgumentType
filePathArg)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( Pretty ColorText
"`compile main file`",
            Pretty ColorText
"Outputs a stand alone file that can be directly loaded and"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"executed by unison. Said execution will have the effect of"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"running `!main`."
          )
        ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      [Argument
main, Argument
file] ->
        String -> HashQualified Name -> Input
Input.MakeStandaloneI
          (String -> HashQualified Name -> Input)
-> Either (Pretty ColorText) String
-> Either (Pretty ColorText) (HashQualified Name -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
makeStandalone Text
"a file name" Argument
file
          Either (Pretty ColorText) (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
main
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly two arguments" Arguments
args

runScheme :: InputPattern
runScheme :: InputPattern
runScheme =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"run.native"
    []
    Visibility
I.Visible
    [(Text
"definition to run", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg), (Text
"arguments", IsOptional
ZeroPlus, ArgumentType
noCompletionsArg)]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
runScheme [Pretty ColorText
"main", Pretty ColorText
"args"],
            Pretty ColorText
"Executes !main using native compilation via scheme."
          )
        ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      Argument
main : Arguments
args ->
        HashQualified Name -> [String] -> Input
Input.ExecuteSchemeI
          (HashQualified Name -> [String] -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) ([String] -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
main
          Either (Pretty ColorText) ([String] -> Input)
-> Either (Pretty ColorText) [String]
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Argument -> Either (Pretty ColorText) String)
-> Arguments -> Either (Pretty ColorText) [String]
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 (InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
runScheme Text
"a command-line argument") Arguments
args
      [] -> Text -> [Any] -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least one argument" []

compileScheme :: InputPattern
compileScheme :: InputPattern
compileScheme =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"compile.native"
    []
    Visibility
I.Hidden
    [ (Text
"definition to compile", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg),
      (Text
"output file", IsOptional
Required, ArgumentType
filePathArg),
      (Text
"profile", IsOptional
Optional, ArgumentType
profileArg)
    ]
    ( [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
        [ ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
compileScheme [Pretty ColorText
"main", Pretty ColorText
"file", Pretty ColorText
"profile"],
            Pretty ColorText
"Creates stand alone executable via compilation to"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"scheme. The created executable will have the effect"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"of running `!main`. Providing `profile` as a third"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"argument will enable profiling."
          )
        ]
    )
    ((Arguments -> Either (Pretty ColorText) Input) -> InputPattern)
-> (Arguments -> Either (Pretty ColorText) Input) -> InputPattern
forall a b. (a -> b) -> a -> b
$ \case
      [Argument
main, Argument
file] -> Bool -> Argument -> Argument -> Either (Pretty ColorText) Input
mkCompileScheme Bool
False Argument
file Argument
main
      [Argument
main, Argument
file, Argument
prof] -> do
        InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
compileScheme Text
"profile" Argument
prof
          Either (Pretty ColorText) String
-> (String -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) a
-> (a -> Either (Pretty ColorText) b)
-> Either (Pretty ColorText) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            String
"profile" -> Bool -> Argument -> Argument -> Either (Pretty ColorText) Input
mkCompileScheme Bool
True Argument
file Argument
main
            String
parg ->
              Pretty ColorText -> Either (Pretty ColorText) Input
forall a b. a -> Either a b
Left (Pretty ColorText -> Either (Pretty ColorText) Input)
-> (Text -> Pretty ColorText)
-> Text
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
P.text (Text -> Either (Pretty ColorText) Input)
-> Text -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$
                Text
"I expected the third argument to be `profile`, but"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" instead recieved `"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
parg
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`."
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"two or three arguments" Arguments
args
  where
    mkCompileScheme :: Bool -> Argument -> Argument -> Either (Pretty ColorText) Input
mkCompileScheme Bool
pf Argument
fn Argument
mn =
      Bool -> Text -> HashQualified Name -> Input
Input.CompileSchemeI Bool
pf (Text -> HashQualified Name -> Input)
-> (String -> Text) -> String -> HashQualified Name -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
        (String -> HashQualified Name -> Input)
-> Either (Pretty ColorText) String
-> Either (Pretty ColorText) (HashQualified Name -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
compileScheme Text
"a file name" Argument
fn
        Either (Pretty ColorText) (HashQualified Name -> Input)
-> Either (Pretty ColorText) (HashQualified Name)
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) (HashQualified Name)
handleHashQualifiedNameArg Argument
mn

createAuthor :: InputPattern
createAuthor :: InputPattern
createAuthor =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"create.author"
    []
    Visibility
I.Visible
    [(Text
"definition name", IsOptional
Required, ArgumentType
noCompletionsArg), (Text
"author name", IsOptional
Required, ArgumentType
noCompletionsArg)]
    ( InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
createAuthor [Pretty ColorText
"alicecoder", Pretty ColorText
"\"Alice McGee\""]
        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 -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
          ( Pretty ColorText
" creates "
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
backtick Pretty ColorText
"alicecoder"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"values in"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
backtick Pretty ColorText
"metadata.authors"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"and"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
backtick (Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (Pretty ColorText
"metadata.copyrightHolders" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"."))
          )
    )
    \case
      Argument
symbolStr : authorStr :: Arguments
authorStr@(Argument
_ : Arguments
_) ->
        NameSegment -> Text -> Input
Input.CreateAuthorI
          (NameSegment -> Text -> Input)
-> Either (Pretty ColorText) NameSegment
-> Either (Pretty ColorText) (Text -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) NameSegment
handleRelativeNameSegmentArg Argument
symbolStr
          Either (Pretty ColorText) (Text -> Input)
-> Either (Pretty ColorText) Text
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([String] -> Text)
-> Either (Pretty ColorText) [String]
-> Either (Pretty ColorText) Text
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (String -> Text
parseAuthorName (String -> Text) -> ([String] -> String) -> [String] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords)
            ((Argument -> Either (Pretty ColorText) String)
-> Arguments -> Either (Pretty ColorText) [String]
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 (InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
createAuthor Text
"text") Arguments
authorStr)
      Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"at least two arguments" Arguments
args
  where
    -- let's have a real parser in not too long
    parseAuthorName :: String -> Text
    parseAuthorName :: String -> Text
parseAuthorName =
      String -> Text
Text.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        (Char
'"' : String
quoted) -> String -> String
forall a. HasCallStack => [a] -> [a]
init String
quoted
        String
bare -> String
bare

authLogin :: InputPattern
authLogin :: InputPattern
authLogin =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"auth.login"
    []
    Visibility
I.Visible
    []
    ( [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
"Obtain an authentication session with Unison Share.",
          InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
authLogin []
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"authenticates ucm with Unison Share."
        ]
    )
    ( \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input
Input.AuthLoginI
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args
    )

printVersion :: InputPattern
printVersion :: InputPattern
printVersion =
  String
-> [String]
-> Visibility
-> [(Text, IsOptional, ArgumentType)]
-> Pretty ColorText
-> (Arguments -> Either (Pretty ColorText) Input)
-> InputPattern
InputPattern
    String
"version"
    []
    Visibility
I.Visible
    []
    ( Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"Print the version of unison you're running"
    )
    ( \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Input
Input.VersionI
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args
    )

projectCreate :: InputPattern
projectCreate :: InputPattern
projectCreate =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"project.create",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"create.project"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ (Pretty ColorText
"`project.create`", Pretty ColorText
"creates a project with a random name"),
            (Pretty ColorText
"`project.create foo`", Pretty ColorText
"creates a project named `foo`")
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ProjectName -> Input
Input.ProjectCreateI Bool
True Maybe ProjectName
forall a. Maybe a
Nothing
        [Argument
name] -> Bool -> Maybe ProjectName -> Input
Input.ProjectCreateI Bool
True (Maybe ProjectName -> Input)
-> (ProjectName -> Maybe ProjectName) -> ProjectName -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectName -> Maybe ProjectName
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName -> Input)
-> Either (Pretty ColorText) ProjectName
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectName
handleProjectArg Argument
name
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args
    }

projectCreateEmptyInputPattern :: InputPattern
projectCreateEmptyInputPattern :: InputPattern
projectCreateEmptyInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"project.create-empty",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"create.empty-project"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Hidden,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ (Pretty ColorText
"`project.create-empty`", Pretty ColorText
"creates an empty project with a random name"),
            (Pretty ColorText
"`project.create-empty foo`", Pretty ColorText
"creates an empty project named `foo`")
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Input -> Either (Pretty ColorText) Input)
-> Input -> Either (Pretty ColorText) Input
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ProjectName -> Input
Input.ProjectCreateI Bool
False Maybe ProjectName
forall a. Maybe a
Nothing
        [Argument
name] -> Bool -> Maybe ProjectName -> Input
Input.ProjectCreateI Bool
False (Maybe ProjectName -> Input)
-> (ProjectName -> Maybe ProjectName) -> ProjectName -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectName -> Maybe ProjectName
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName -> Input)
-> Either (Pretty ColorText) ProjectName
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectName
handleProjectArg Argument
name
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args
    }

projectRenameInputPattern :: InputPattern
projectRenameInputPattern :: InputPattern
projectRenameInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"project.rename",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"rename.project"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"new name", IsOptional
Required, ArgumentType
projectNameArg)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ (Pretty ColorText
"`project.rename foo`", Pretty ColorText
"renames the current project to `foo`")
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
nameString] -> ProjectName -> Input
Input.ProjectRenameI (ProjectName -> Input)
-> Either (Pretty ColorText) ProjectName
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectName
handleProjectArg Argument
nameString
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }

projectSwitch :: InputPattern
projectSwitch :: InputPattern
projectSwitch =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"switch",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"project or branch to switch to", IsOptional
Required, ProjectBranchSuggestionsConfig -> ArgumentType
projectAndBranchNamesArg ProjectBranchSuggestionsConfig
suggestionsConfig)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ (Pretty ColorText
"`switch`", Pretty ColorText
"opens an interactive selector to pick a project and branch"),
            (Pretty ColorText
"`switch foo/bar`", Pretty ColorText
"switches to the branch `bar` in the project `foo`"),
            (Pretty ColorText
"`switch foo/`", Pretty ColorText
"switches to the last branch you visited in the project `foo`"),
            (Pretty ColorText
"`switch /bar`", Pretty ColorText
"switches to the branch `bar` in the current project")
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
name] -> ProjectAndBranchNames -> Input
Input.ProjectSwitchI (ProjectAndBranchNames -> Input)
-> Either (Pretty ColorText) ProjectAndBranchNames
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectAndBranchNames
handleProjectAndBranchNamesArg Argument
name
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }
  where
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
True,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
ExcludeCurrentBranch
        }

projectsInputPattern :: InputPattern
projectsInputPattern :: InputPattern
projectsInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"projects",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"list.project", String
"ls.project", String
"project.list"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help = Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"List projects.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \Arguments
_ -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.ProjectsI
    }

branchesInputPattern :: InputPattern
branchesInputPattern :: InputPattern
branchesInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"branches",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"list.branch", String
"ls.branch", String
"branch.list"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"project", IsOptional
Optional, ArgumentType
projectNameArg)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ (Pretty ColorText
"`branches`", Pretty ColorText
"lists all branches in the current project"),
            (Pretty ColorText
"`branches foo`", Pretty ColorText
"lists all branches in the project `foo`")
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right (Maybe ProjectName -> Input
Input.BranchesI Maybe ProjectName
forall a. Maybe a
Nothing)
        [Argument
nameString] -> Maybe ProjectName -> Input
Input.BranchesI (Maybe ProjectName -> Input)
-> (ProjectName -> Maybe ProjectName) -> ProjectName -> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectName -> Maybe ProjectName
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName -> Input)
-> Either (Pretty ColorText) ProjectName
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectName
handleProjectArg Argument
nameString
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no more than one argument" Arguments
args
    }

branchInputPattern :: InputPattern
branchInputPattern :: InputPattern
branchInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"branch",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"branch.create", String
"create.branch"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args =
        [ (Text
"branch", IsOptional
Required, ProjectBranchSuggestionsConfig -> ArgumentType
projectBranchNameArg ProjectBranchSuggestionsConfig
suggestionsConfig),
          (Text
"branch", IsOptional
Optional, ArgumentType
newBranchNameArg)
        ],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ (Pretty ColorText
"`branch foo`", Pretty ColorText
"forks the current project branch to a new branch `foo`"),
            (Pretty ColorText
"`branch /bar foo`", Pretty ColorText
"forks the branch `bar` of the current project to a new branch `foo`")
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
source0, Argument
name] ->
          BranchSourceI
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input
Input.BranchI (BranchSourceI
 -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input)
-> (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
    -> BranchSourceI)
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> BranchSourceI
Input.BranchSourceI'UnresolvedProjectBranch
            (ProjectAndBranch (Maybe ProjectName) ProjectBranchName
 -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg Argument
source0
            Either
  (Pretty ColorText)
  (ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg Argument
name
        [Argument
name] -> BranchSourceI
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input
Input.BranchI BranchSourceI
Input.BranchSourceI'CurrentContext (ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg Argument
name
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"one or two arguments" Arguments
args
    }
  where
    newBranchNameArg :: ArgumentType
newBranchNameArg =
      ArgumentType
        { $sel:typeName:ArgumentType :: String
typeName = String
"new-branch",
          $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
_ Codebase m v a
_ AuthenticatedHttpClient
_ ProjectPath
_ -> [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [],
          $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = Maybe FZFResolver
forall a. Maybe a
Nothing
        }
    suggestionsConfig :: ProjectBranchSuggestionsConfig
suggestionsConfig =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
False,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

branchEmptyInputPattern :: InputPattern
branchEmptyInputPattern :: InputPattern
branchEmptyInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"branch.empty",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"branch.create-empty", String
"create.empty-branch"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help = Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"Create a new empty branch.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
name] ->
          BranchSourceI
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input
Input.BranchI BranchSourceI
Input.BranchSourceI'Empty
            (ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Input)
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument
-> Either
     (Pretty ColorText)
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
handleMaybeProjectBranchArg Argument
name
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }

branchRenameInputPattern :: InputPattern
branchRenameInputPattern :: InputPattern
branchRenameInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"branch.rename",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"rename.branch"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [(Pretty ColorText
"`branch.rename foo`", Pretty ColorText
"renames the current branch to `foo`")],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
name] -> ProjectBranchName -> Input
Input.BranchRenameI (ProjectBranchName -> Input)
-> Either (Pretty ColorText) ProjectBranchName
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectBranchName
handleProjectBranchNameArg Argument
name
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }

clone :: InputPattern
clone :: InputPattern
clone =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"clone",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help =
        [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.wrapColumn2
          [ ( Pretty ColorText
"`clone @unison/json/topic json/my-topic`",
              Pretty ColorText
"creates `json/my-topic` from the remote branch `@unison/json/topic`"
            ),
            ( Pretty ColorText
"`clone @unison/base base/`",
              Pretty ColorText
"creates `base/main` from the remote branch `@unison/base/main`"
            ),
            ( Pretty ColorText
"`clone @unison/base /main2`",
              Pretty ColorText
"creates the branch `main2` in the current project from the remote branch `@unison/base/main`"
            ),
            ( Pretty ColorText
"`clone /main /main2`",
              Pretty ColorText
"creates the branch `main2` in the current project from the remote branch `main` of the current project's associated remote"
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"(see"
                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 (InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
helpTopics [Pretty ColorText
"remotes"] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")")
            ),
            ( Pretty ColorText
"`clone /main my-fork/`",
              Pretty ColorText
"creates `my-fork/main` from the branch `main` of the current project's associated remote"
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"(see"
                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 (InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
helpTopics [Pretty ColorText
"remotes"] Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")")
            )
          ],
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
remoteNames] -> ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Input
Input.CloneI (ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Input)
-> Either (Pretty ColorText) ProjectAndBranchNames
-> Either (Pretty ColorText) (Maybe ProjectAndBranchNames -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectAndBranchNames
handleProjectAndBranchNamesArg Argument
remoteNames Either (Pretty ColorText) (Maybe ProjectAndBranchNames -> Input)
-> Either (Pretty ColorText) (Maybe ProjectAndBranchNames)
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ProjectAndBranchNames
-> Either (Pretty ColorText) (Maybe ProjectAndBranchNames)
forall a. a -> Either (Pretty ColorText) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ProjectAndBranchNames
forall a. Maybe a
Nothing
        [Argument
remoteNames, Argument
localNames] ->
          ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Input
Input.CloneI
            (ProjectAndBranchNames -> Maybe ProjectAndBranchNames -> Input)
-> Either (Pretty ColorText) ProjectAndBranchNames
-> Either (Pretty ColorText) (Maybe ProjectAndBranchNames -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) ProjectAndBranchNames
handleProjectAndBranchNamesArg Argument
remoteNames
            Either (Pretty ColorText) (Maybe ProjectAndBranchNames -> Input)
-> Either (Pretty ColorText) (Maybe ProjectAndBranchNames)
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ProjectAndBranchNames -> Maybe ProjectAndBranchNames)
-> Either (Pretty ColorText) ProjectAndBranchNames
-> Either (Pretty ColorText) (Maybe ProjectAndBranchNames)
forall a b.
(a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProjectAndBranchNames -> Maybe ProjectAndBranchNames
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Argument -> Either (Pretty ColorText) ProjectAndBranchNames
handleProjectAndBranchNamesArg Argument
localNames)
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"one or two arguments" Arguments
args
    }

releaseDraft :: InputPattern
releaseDraft :: InputPattern
releaseDraft =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"release.draft",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"draft.release"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help = Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap Pretty ColorText
"Draft a release.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
semverString] ->
          (TryFromException Text Semver -> Pretty ColorText)
-> (Semver -> Input)
-> Either (TryFromException Text Semver) Semver
-> Either (Pretty ColorText) 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 (Pretty ColorText
-> TryFromException Text Semver -> Pretty ColorText
forall a b. a -> b -> a
const Pretty ColorText
"Couldn’t parse version number") Semver -> Input
Input.ReleaseDraftI
            (Either (TryFromException Text Semver) Semver
 -> Either (Pretty ColorText) Input)
-> (String -> Either (TryFromException Text Semver) Semver)
-> String
-> Either (Pretty ColorText) Input
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @Semver
            (Text -> Either (TryFromException Text Semver) Semver)
-> (String -> Text)
-> String
-> Either (TryFromException Text Semver) Semver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
            (String -> Either (Pretty ColorText) Input)
-> Either (Pretty ColorText) String
-> Either (Pretty ColorText) Input
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InputPattern
-> Text -> Argument -> Either (Pretty ColorText) String
unsupportedStructuredArgument InputPattern
releaseDraft Text
"a version number" Argument
semverString
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }

upgrade :: InputPattern
upgrade :: InputPattern
upgrade =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"upgrade",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"dependency to upgrade", IsOptional
Required, ArgumentType
dependencyArg), (Text
"dependency to upgrade to", IsOptional
Required, ArgumentType
dependencyArg)],
      $sel:help:InputPattern :: Pretty ColorText
help =
        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
"`upgrade old new` upgrades library dependency `lib.old` to `lib.new`, and, if successful, deletes `lib.old`.",
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
oldString, Argument
newString] ->
          NameSegment -> NameSegment -> Input
Input.UpgradeI (NameSegment -> NameSegment -> Input)
-> Either (Pretty ColorText) NameSegment
-> Either (Pretty ColorText) (NameSegment -> Input)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) NameSegment
handleRelativeNameSegmentArg Argument
oldString Either (Pretty ColorText) (NameSegment -> Input)
-> Either (Pretty ColorText) NameSegment
-> Either (Pretty ColorText) Input
forall a b.
Either (Pretty ColorText) (a -> b)
-> Either (Pretty ColorText) a -> Either (Pretty ColorText) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Argument -> Either (Pretty ColorText) NameSegment
handleRelativeNameSegmentArg Argument
newString
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly two arguments" Arguments
args
    }

upgradeCommitInputPattern :: InputPattern
upgradeCommitInputPattern :: InputPattern
upgradeCommitInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"upgrade.commit",
      $sel:aliases:InputPattern :: [String]
aliases = [String
"commit.upgrade"],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Visible,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [],
      $sel:help:InputPattern :: Pretty ColorText
help =
        let mainBranch :: ProjectBranchName
mainBranch = Text -> ProjectBranchName
UnsafeProjectBranchName Text
"main"
            tempBranch :: ProjectBranchName
tempBranch = Text -> ProjectBranchName
UnsafeProjectBranchName Text
"upgrade-foo-to-bar"
         in Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
P.wrap
              ( InputPattern -> Pretty ColorText
makeExample' InputPattern
upgradeCommitInputPattern
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"merges a temporary branch created by the"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
upgrade
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"command back into its parent branch, and removes the temporary branch."
              )
              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
"For example, if you've done"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExample InputPattern
upgrade [Pretty ColorText
"foo", Pretty ColorText
"bar"]
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"from"
                    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 (ProjectBranchName -> Pretty ColorText
prettyProjectBranchName ProjectBranchName
mainBranch 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
"then"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> InputPattern -> Pretty ColorText
makeExample' InputPattern
upgradeCommitInputPattern
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"is equivalent to doing"
                )
              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] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
P.bulleted
                    [ InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleNoBackticks InputPattern
projectSwitch [ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
mainBranch],
                      InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleNoBackticks InputPattern
mergeInputPattern [ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
tempBranch],
                      InputPattern -> [Pretty ColorText] -> Pretty ColorText
makeExampleNoBackticks InputPattern
deleteBranch [ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
tempBranch]
                    ]
                ),
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [] -> Input -> Either (Pretty ColorText) Input
forall a b. b -> Either a b
Right Input
Input.UpgradeCommitI
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"no arguments" Arguments
args
    }

debugSynhashTermInputPattern :: InputPattern
debugSynhashTermInputPattern :: InputPattern
debugSynhashTermInputPattern =
  InputPattern
    { $sel:patternName:InputPattern :: String
patternName = String
"debug.synhash.term",
      $sel:aliases:InputPattern :: [String]
aliases = [],
      $sel:visibility:InputPattern :: Visibility
visibility = Visibility
I.Hidden,
      $sel:args:InputPattern :: [(Text, IsOptional, ArgumentType)]
args = [(Text
"term", IsOptional
Required, ArgumentType
exactDefinitionTermQueryArg)],
      $sel:help:InputPattern :: Pretty ColorText
help = Pretty ColorText
forall a. Monoid a => a
mempty,
      $sel:parse:InputPattern :: Arguments -> Either (Pretty ColorText) Input
parse = \case
        [Argument
arg] -> Name -> Input
Input.DebugSynhashTermI (Name -> Input)
-> Either (Pretty ColorText) Name
-> Either (Pretty ColorText) Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Argument -> Either (Pretty ColorText) Name
handleNameArg Argument
arg
        Arguments
args -> Text -> Arguments -> Either (Pretty ColorText) Input
forall a b. Text -> [a] -> Either (Pretty ColorText) b
wrongArgsLength Text
"exactly one argument" Arguments
args
    }

validInputs :: [InputPattern]
validInputs :: [InputPattern]
validInputs =
  (InputPattern -> String) -> [InputPattern] -> [InputPattern]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn
    InputPattern -> String
I.patternName
    [ InputPattern
add,
      InputPattern
aliasMany,
      InputPattern
aliasTerm,
      InputPattern
aliasType,
      InputPattern
api,
      InputPattern
authLogin,
      InputPattern
back,
      InputPattern
branchEmptyInputPattern,
      InputPattern
branchInputPattern,
      InputPattern
branchRenameInputPattern,
      InputPattern
branchesInputPattern,
      InputPattern
cd,
      InputPattern
clear,
      InputPattern
clone,
      InputPattern
compileScheme,
      InputPattern
createAuthor,
      InputPattern
debugAliasTermForce,
      InputPattern
debugAliasTypeForce,
      InputPattern
debugClearWatchCache,
      InputPattern
debugDoctor,
      InputPattern
debugDumpNamespace,
      InputPattern
debugDumpNamespaceSimple,
      InputPattern
debugSynhashTermInputPattern,
      InputPattern
debugTerm,
      InputPattern
debugTermVerbose,
      InputPattern
debugType,
      InputPattern
debugLSPFoldRanges,
      InputPattern
debugFileHashes,
      InputPattern
debugNameDiff,
      InputPattern
debugNumberedArgs,
      InputPattern
debugTabCompletion,
      InputPattern
debugLspNameCompletion,
      InputPattern
debugFuzzyOptions,
      InputPattern
debugFormat,
      InputPattern
delete,
      InputPattern
deleteBranch,
      InputPattern
deleteProject,
      InputPattern
deleteNamespace,
      InputPattern
deleteNamespaceForce,
      InputPattern
deleteTerm,
      InputPattern
deleteTermVerbose,
      InputPattern
deleteType,
      InputPattern
deleteTypeVerbose,
      InputPattern
deleteVerbose,
      InputPattern
dependencies,
      InputPattern
dependents,
      InputPattern
diffNamespace,
      InputPattern
display,
      InputPattern
displayTo,
      InputPattern
docToMarkdown,
      InputPattern
docs,
      InputPattern
docsToHtml,
      InputPattern
edit,
      InputPattern
editNamespace,
      InputPattern
execute,
      InputPattern
find,
      InputPattern
findIn,
      InputPattern
findAll,
      InputPattern
findInAll,
      InputPattern
findGlobal,
      InputPattern
findShallow,
      InputPattern
findVerbose,
      InputPattern
findVerboseAll,
      InputPattern
sfind,
      InputPattern
sfindReplace,
      Bool -> InputPattern
textfind Bool
False,
      Bool -> InputPattern
textfind Bool
True,
      InputPattern
forkLocal,
      InputPattern
help,
      InputPattern
helpTopics,
      InputPattern
history,
      InputPattern
ioTest,
      InputPattern
ioTestAll,
      InputPattern
libInstallInputPattern,
      InputPattern
load,
      InputPattern
makeStandalone,
      InputPattern
mergeBuiltins,
      InputPattern
mergeIOBuiltins,
      InputPattern
mergeOldInputPattern,
      InputPattern
mergeOldPreviewInputPattern,
      InputPattern
mergeOldSquashInputPattern,
      InputPattern
mergeInputPattern,
      InputPattern
mergeCommitInputPattern,
      Bool -> InputPattern
names Bool
False, -- names
      Bool -> InputPattern
names Bool
True, -- debug.names.global
      InputPattern
namespaceDependencies,
      InputPattern
previewAdd,
      InputPattern
previewUpdate,
      InputPattern
printVersion,
      InputPattern
projectCreate,
      InputPattern
projectCreateEmptyInputPattern,
      InputPattern
projectRenameInputPattern,
      InputPattern
projectSwitch,
      InputPattern
projectsInputPattern,
      InputPattern
pull,
      InputPattern
pullWithoutHistory,
      InputPattern
push,
      InputPattern
pushCreate,
      InputPattern
pushExhaustive,
      InputPattern
pushForce,
      InputPattern
quit,
      InputPattern
releaseDraft,
      InputPattern
renameBranch,
      InputPattern
renameTerm,
      InputPattern
renameType,
      InputPattern
moveAll,
      InputPattern
reset,
      InputPattern
runScheme,
      InputPattern
saveExecuteResult,
      InputPattern
test,
      InputPattern
testAll,
      InputPattern
todo,
      InputPattern
ui,
      InputPattern
undo,
      InputPattern
up,
      InputPattern
update,
      InputPattern
updateBuiltins,
      InputPattern
updateOld,
      InputPattern
updateOldNoPatch,
      InputPattern
upgrade,
      InputPattern
upgradeCommitInputPattern,
      InputPattern
view,
      InputPattern
viewGlobal,
      InputPattern
deprecatedViewRootReflog,
      InputPattern
branchReflog,
      InputPattern
projectReflog,
      InputPattern
globalReflog
    ]

-- | A map of all command patterns by pattern name or alias.
patternMap :: Map String InputPattern
patternMap :: Map String InputPattern
patternMap =
  [(String, InputPattern)] -> Map String InputPattern
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, InputPattern)] -> Map String InputPattern)
-> [(String, InputPattern)] -> Map String InputPattern
forall a b. (a -> b) -> a -> b
$
    [InputPattern]
validInputs
      [InputPattern]
-> (InputPattern -> [(String, InputPattern)])
-> [(String, InputPattern)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\InputPattern
p -> (InputPattern -> String
I.patternName InputPattern
p, InputPattern
p) (String, InputPattern)
-> [(String, InputPattern)] -> [(String, InputPattern)]
forall a. a -> [a] -> [a]
: ((,InputPattern
p) (String -> (String, InputPattern))
-> [String] -> [(String, InputPattern)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputPattern -> [String]
I.aliases InputPattern
p))

visibleInputs :: [InputPattern]
visibleInputs :: [InputPattern]
visibleInputs = (InputPattern -> Bool) -> [InputPattern] -> [InputPattern]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
I.Visible) (Visibility -> Bool)
-> (InputPattern -> Visibility) -> InputPattern -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPattern -> Visibility
I.visibility) [InputPattern]
validInputs

commandNames :: [String]
commandNames :: [String]
commandNames = [InputPattern]
visibleInputs [InputPattern] -> (InputPattern -> [String]) -> [String]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \InputPattern
i -> InputPattern -> String
I.patternName InputPattern
i String -> [String] -> [String]
forall a. a -> [a] -> [a]
: InputPattern -> [String]
I.aliases InputPattern
i

commandNameArg :: ArgumentType
commandNameArg :: ArgumentType
commandNameArg =
  let options :: [String]
options = [String]
commandNames [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> Map String (Pretty ColorText) -> [String]
forall k a. Map k a -> [k]
Map.keys Map String (Pretty ColorText)
helpTopicsMap
   in ArgumentType
        { $sel:typeName:ArgumentType :: String
typeName = String
"command",
          $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
_ AuthenticatedHttpClient
_ ProjectPath
_ -> [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String] -> [Completion]
exactComplete String
q [String]
options),
          $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just (FZFResolver -> Maybe FZFResolver)
-> FZFResolver -> Maybe FZFResolver
forall a b. (a -> b) -> a -> b
$ [Text] -> FZFResolver
Resolvers.fuzzySelectFromList (String -> Text
Text.pack (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
options)
        }

exactDefinitionArg :: ArgumentType
exactDefinitionArg :: ArgumentType
exactDefinitionArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"definition",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
cb AuthenticatedHttpClient
_http ProjectPath
p -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb (String -> ProjectPath -> Transaction [Completion]
prefixCompleteTermOrType String
q ProjectPath
p),
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.definitionResolver
    }

definitionQueryArg :: ArgumentType
definitionQueryArg :: ArgumentType
definitionQueryArg = ArgumentType
exactDefinitionArg {typeName = "definition query"}

exactDefinitionTypeQueryArg :: ArgumentType
exactDefinitionTypeQueryArg :: ArgumentType
exactDefinitionTypeQueryArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"type definition query",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
cb AuthenticatedHttpClient
_http ProjectPath
p -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb (String -> ProjectPath -> Transaction [Completion]
prefixCompleteType String
q ProjectPath
p),
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.typeDefinitionResolver
    }

exactDefinitionTypeOrTermQueryArg :: ArgumentType
exactDefinitionTypeOrTermQueryArg :: ArgumentType
exactDefinitionTypeOrTermQueryArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"type or term definition query",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
cb AuthenticatedHttpClient
_http ProjectPath
p -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb (String -> ProjectPath -> Transaction [Completion]
prefixCompleteTermOrType String
q ProjectPath
p),
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.definitionResolver
    }

exactDefinitionTermQueryArg :: ArgumentType
exactDefinitionTermQueryArg :: ArgumentType
exactDefinitionTermQueryArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"term definition query",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
cb AuthenticatedHttpClient
_http ProjectPath
p -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb (String -> ProjectPath -> Transaction [Completion]
prefixCompleteTerm String
q ProjectPath
p),
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.termDefinitionResolver
    }

patchArg :: ArgumentType
patchArg :: ArgumentType
patchArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"patch",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
cb AuthenticatedHttpClient
_http ProjectPath
p -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb (String -> ProjectPath -> Transaction [Completion]
prefixCompletePatch String
q ProjectPath
p),
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = Maybe FZFResolver
forall a. Maybe a
Nothing
    }

namespaceArg :: ArgumentType
namespaceArg :: ArgumentType
namespaceArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"namespace",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
cb AuthenticatedHttpClient
_http ProjectPath
p -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb (String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace String
q ProjectPath
p),
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.namespaceResolver
    }

-- | Usually you'll want one or the other, but some commands support both right now.
namespaceOrProjectBranchArg :: ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg :: ProjectBranchSuggestionsConfig -> ArgumentType
namespaceOrProjectBranchArg ProjectBranchSuggestionsConfig
config =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"namespace or branch",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions =
        let namespaceSuggestions :: String -> Codebase m v a -> p -> ProjectPath -> m [Completion]
namespaceSuggestions = \String
q Codebase m v a
cb p
_http ProjectPath
pp -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb (String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace String
q ProjectPath
pp)
         in [String
 -> Codebase m v a
 -> AuthenticatedHttpClient
 -> ProjectPath
 -> m [Completion]]
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
[String
 -> Codebase m v a
 -> AuthenticatedHttpClient
 -> ProjectPath
 -> m [Completion]]
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
unionSuggestions
              [ ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
projectAndOrBranchSuggestions ProjectBranchSuggestionsConfig
config,
                String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
forall {v} {a} {p}.
String -> Codebase m v a -> p -> ProjectPath -> m [Completion]
namespaceSuggestions
              ],
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.projectOrBranchResolver
    }

namespaceOrDefinitionArg :: ArgumentType
namespaceOrDefinitionArg :: ArgumentType
namespaceOrDefinitionArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"term, type, or namespace",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
cb AuthenticatedHttpClient
_http ProjectPath
p -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb do
        [Completion]
namespaces <- String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace String
q ProjectPath
p
        [Completion]
termsTypes <- String -> ProjectPath -> Transaction [Completion]
prefixCompleteTermOrType String
q ProjectPath
p
        pure ([Completion] -> [Completion]
forall a. Ord a => [a] -> [a]
List.nubOrd ([Completion] -> [Completion]) -> [Completion] -> [Completion]
forall a b. (a -> b) -> a -> b
$ [Completion]
namespaces [Completion] -> [Completion] -> [Completion]
forall a. Semigroup a => a -> a -> a
<> [Completion]
termsTypes),
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver =
        FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.namespaceOrDefinitionResolver
    }

-- | A dependency name. E.g. if your project has `lib.base`, `base` would be a dependency
-- name.
dependencyArg :: ArgumentType
dependencyArg :: ArgumentType
dependencyArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"project dependency",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
cb AuthenticatedHttpClient
_http ProjectPath
pp -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb do
        String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace String
q (ProjectPath
pp ProjectPath -> (ProjectPath -> ProjectPath) -> ProjectPath
forall a b. a -> (a -> b) -> b
& (Path -> Identity Path) -> ProjectPath -> Identity ProjectPath
forall p b (f :: * -> *).
Functor f =>
(Path -> f Path) -> ProjectPathG p b -> f (ProjectPathG p b)
PP.path_ ((Path -> Identity Path) -> ProjectPath -> Identity ProjectPath)
-> Path -> ProjectPath -> ProjectPath
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NameSegment -> Path
Path.singleton NameSegment
NameSegment.libSegment),
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.projectDependencyResolver
    }

newNameArg :: ArgumentType
newNameArg :: ArgumentType
newNameArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"new-name",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
q Codebase m v a
cb AuthenticatedHttpClient
_http ProjectPath
p -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
cb (String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace String
q ProjectPath
p),
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = Maybe FZFResolver
forall a. Maybe a
Nothing
    }

noCompletionsArg :: ArgumentType
noCompletionsArg :: ArgumentType
noCompletionsArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"word",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
noCompletions,
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = Maybe FZFResolver
forall a. Maybe a
Nothing
    }

filePathArg :: ArgumentType
filePathArg :: ArgumentType
filePathArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"file-path",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
noCompletions,
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = Maybe FZFResolver
forall a. Maybe a
Nothing
    }

-- | Refers to a namespace on some remote code host.
remoteNamespaceArg :: ArgumentType
remoteNamespaceArg :: ArgumentType
remoteNamespaceArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"remote-namespace",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
input Codebase m v a
_cb AuthenticatedHttpClient
http ProjectPath
_p -> AuthenticatedHttpClient -> String -> m [Completion]
forall (m :: * -> *).
MonadIO m =>
AuthenticatedHttpClient -> String -> m [Completion]
sharePathCompletion AuthenticatedHttpClient
http String
input,
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = Maybe FZFResolver
forall a. Maybe a
Nothing
    }

profileArg :: ArgumentType
profileArg :: ArgumentType
profileArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"profile",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
_input Codebase m v a
_cb AuthenticatedHttpClient
_http ProjectPath
_p ->
        [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String -> Completion
Line.simpleCompletion String
"profile"],
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = Maybe FZFResolver
forall a. Maybe a
Nothing
    }

data ProjectInclusion = OnlyWithinCurrentProject | OnlyOutsideCurrentProject | AllProjects
  deriving stock (ProjectInclusion -> ProjectInclusion -> Bool
(ProjectInclusion -> ProjectInclusion -> Bool)
-> (ProjectInclusion -> ProjectInclusion -> Bool)
-> Eq ProjectInclusion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectInclusion -> ProjectInclusion -> Bool
== :: ProjectInclusion -> ProjectInclusion -> Bool
$c/= :: ProjectInclusion -> ProjectInclusion -> Bool
/= :: ProjectInclusion -> ProjectInclusion -> Bool
Eq, Eq ProjectInclusion
Eq ProjectInclusion =>
(ProjectInclusion -> ProjectInclusion -> Ordering)
-> (ProjectInclusion -> ProjectInclusion -> Bool)
-> (ProjectInclusion -> ProjectInclusion -> Bool)
-> (ProjectInclusion -> ProjectInclusion -> Bool)
-> (ProjectInclusion -> ProjectInclusion -> Bool)
-> (ProjectInclusion -> ProjectInclusion -> ProjectInclusion)
-> (ProjectInclusion -> ProjectInclusion -> ProjectInclusion)
-> Ord ProjectInclusion
ProjectInclusion -> ProjectInclusion -> Bool
ProjectInclusion -> ProjectInclusion -> Ordering
ProjectInclusion -> ProjectInclusion -> ProjectInclusion
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 :: ProjectInclusion -> ProjectInclusion -> Ordering
compare :: ProjectInclusion -> ProjectInclusion -> Ordering
$c< :: ProjectInclusion -> ProjectInclusion -> Bool
< :: ProjectInclusion -> ProjectInclusion -> Bool
$c<= :: ProjectInclusion -> ProjectInclusion -> Bool
<= :: ProjectInclusion -> ProjectInclusion -> Bool
$c> :: ProjectInclusion -> ProjectInclusion -> Bool
> :: ProjectInclusion -> ProjectInclusion -> Bool
$c>= :: ProjectInclusion -> ProjectInclusion -> Bool
>= :: ProjectInclusion -> ProjectInclusion -> Bool
$cmax :: ProjectInclusion -> ProjectInclusion -> ProjectInclusion
max :: ProjectInclusion -> ProjectInclusion -> ProjectInclusion
$cmin :: ProjectInclusion -> ProjectInclusion -> ProjectInclusion
min :: ProjectInclusion -> ProjectInclusion -> ProjectInclusion
Ord, Int -> ProjectInclusion -> String -> String
[ProjectInclusion] -> String -> String
ProjectInclusion -> String
(Int -> ProjectInclusion -> String -> String)
-> (ProjectInclusion -> String)
-> ([ProjectInclusion] -> String -> String)
-> Show ProjectInclusion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ProjectInclusion -> String -> String
showsPrec :: Int -> ProjectInclusion -> String -> String
$cshow :: ProjectInclusion -> String
show :: ProjectInclusion -> String
$cshowList :: [ProjectInclusion] -> String -> String
showList :: [ProjectInclusion] -> String -> String
Show)

data BranchInclusion = ExcludeCurrentBranch | AllBranches
  deriving stock (BranchInclusion -> BranchInclusion -> Bool
(BranchInclusion -> BranchInclusion -> Bool)
-> (BranchInclusion -> BranchInclusion -> Bool)
-> Eq BranchInclusion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BranchInclusion -> BranchInclusion -> Bool
== :: BranchInclusion -> BranchInclusion -> Bool
$c/= :: BranchInclusion -> BranchInclusion -> Bool
/= :: BranchInclusion -> BranchInclusion -> Bool
Eq, Eq BranchInclusion
Eq BranchInclusion =>
(BranchInclusion -> BranchInclusion -> Ordering)
-> (BranchInclusion -> BranchInclusion -> Bool)
-> (BranchInclusion -> BranchInclusion -> Bool)
-> (BranchInclusion -> BranchInclusion -> Bool)
-> (BranchInclusion -> BranchInclusion -> Bool)
-> (BranchInclusion -> BranchInclusion -> BranchInclusion)
-> (BranchInclusion -> BranchInclusion -> BranchInclusion)
-> Ord BranchInclusion
BranchInclusion -> BranchInclusion -> Bool
BranchInclusion -> BranchInclusion -> Ordering
BranchInclusion -> BranchInclusion -> BranchInclusion
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 :: BranchInclusion -> BranchInclusion -> Ordering
compare :: BranchInclusion -> BranchInclusion -> Ordering
$c< :: BranchInclusion -> BranchInclusion -> Bool
< :: BranchInclusion -> BranchInclusion -> Bool
$c<= :: BranchInclusion -> BranchInclusion -> Bool
<= :: BranchInclusion -> BranchInclusion -> Bool
$c> :: BranchInclusion -> BranchInclusion -> Bool
> :: BranchInclusion -> BranchInclusion -> Bool
$c>= :: BranchInclusion -> BranchInclusion -> Bool
>= :: BranchInclusion -> BranchInclusion -> Bool
$cmax :: BranchInclusion -> BranchInclusion -> BranchInclusion
max :: BranchInclusion -> BranchInclusion -> BranchInclusion
$cmin :: BranchInclusion -> BranchInclusion -> BranchInclusion
min :: BranchInclusion -> BranchInclusion -> BranchInclusion
Ord, Int -> BranchInclusion -> String -> String
[BranchInclusion] -> String -> String
BranchInclusion -> String
(Int -> BranchInclusion -> String -> String)
-> (BranchInclusion -> String)
-> ([BranchInclusion] -> String -> String)
-> Show BranchInclusion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> BranchInclusion -> String -> String
showsPrec :: Int -> BranchInclusion -> String -> String
$cshow :: BranchInclusion -> String
show :: BranchInclusion -> String
$cshowList :: [BranchInclusion] -> String -> String
showList :: [BranchInclusion] -> String -> String
Show)

data ProjectBranchSuggestionsConfig = ProjectBranchSuggestionsConfig
  { -- Whether projects (without branches) should be considered possible completions.
    ProjectBranchSuggestionsConfig -> Bool
showProjectCompletions :: Bool,
    -- Whether to include projects/branches within the current project, only outside the
    -- current project, or either.
    ProjectBranchSuggestionsConfig -> ProjectInclusion
projectInclusion :: ProjectInclusion,
    -- Whether to include the current branch as a possible completion.
    ProjectBranchSuggestionsConfig -> BranchInclusion
branchInclusion :: BranchInclusion
  }

projectAndOrBranchSuggestions ::
  (MonadIO m) =>
  ProjectBranchSuggestionsConfig ->
  String ->
  Codebase m v a ->
  AuthenticatedHttpClient ->
  ProjectPath ->
  m [Line.Completion]
projectAndOrBranchSuggestions :: forall (m :: * -> *) v a.
MonadIO m =>
ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
projectAndOrBranchSuggestions ProjectBranchSuggestionsConfig
config String
inputStr Codebase m v a
codebase AuthenticatedHttpClient
_httpClient ProjectPath
pp = do
  case Text -> Maybe (Char, Text)
Text.uncons Text
input of
    -- Things like "/foo" would be parsed as unambiguous branches in the logic below, except we also want to
    -- handle "/<TAB>" and "/@<TAB>" inputs, which aren't valid branch names, but are valid branch prefixes. So,
    -- if the input begins with a forward slash, just rip it off and treat the rest as the branch prefix.
    Just (Char
'/', Text
input1) -> Text -> Codebase m v a -> ProjectPath -> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
Text -> Codebase m v a -> ProjectPath -> m [Completion]
handleBranchesComplete Text
input1 Codebase m v a
codebase ProjectPath
pp
    Maybe (Char, Text)
_ ->
      case forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @ProjectAndBranchNames Text
input of
        -- This case handles inputs like "", "@", and possibly other things that don't look like a valid project
        -- or branch, but are a valid prefix of one
        Left TryFromException Text ProjectAndBranchNames
_err -> Text -> Codebase m v a -> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
Text -> Codebase m v a -> m [Completion]
handleAmbiguousComplete Text
input Codebase m v a
codebase
        Right (ProjectAndBranchNames'Ambiguous ProjectName
_ ProjectBranchName
_) -> Text -> Codebase m v a -> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
Text -> Codebase m v a -> m [Completion]
handleAmbiguousComplete Text
input Codebase m v a
codebase
        -- Here we assume that if we've unambiguously parsed a project, it ended in a forward slash, so we're ready
        -- to suggest branches in that project as autocompletions.
        --
        -- Conceivably, with some other syntax, it may be possible to unambiguously parse a project name, while
        -- still wanting to suggest full project names (e.g. I type "PROJECT=foo<tab>" to get a list of projects
        -- that begin with "foo"), but because that's not how our syntax works today, we don't inspect the input
        -- string for a trailing forward slash.
        Right (ProjectAndBranchNames'Unambiguous (This ProjectName
projectName)) -> do
          [(ProjectBranchId, ProjectBranchName)]
branches <-
            Codebase m v a
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> m [(ProjectBranchId, ProjectBranchName)]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase do
              ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
projectName Transaction (Maybe Project)
-> (Maybe Project
    -> Transaction [(ProjectBranchId, ProjectBranchName)])
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe Project
Nothing -> [(ProjectBranchId, ProjectBranchName)]
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                Just Project
project -> do
                  let projectId :: ProjectId
projectId = Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId
                  ([(ProjectBranchId, ProjectBranchName)]
 -> [(ProjectBranchId, ProjectBranchName)])
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProjectBranchSuggestionsConfig
-> ProjectPath
-> [(ProjectBranchId, ProjectBranchName)]
-> [(ProjectBranchId, ProjectBranchName)]
forall a.
ProjectBranchSuggestionsConfig
-> ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
filterBranches ProjectBranchSuggestionsConfig
config ProjectPath
pp) do
                    ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Queries.loadAllProjectBranchesBeginningWith ProjectId
projectId Maybe Text
forall a. Maybe a
Nothing
          pure (((ProjectBranchId, ProjectBranchName) -> Completion)
-> [(ProjectBranchId, ProjectBranchName)] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion
projectBranchToCompletion ProjectName
projectName) [(ProjectBranchId, ProjectBranchName)]
branches)
        -- This branch is probably dead due to intercepting inputs that begin with "/" above
        Right (ProjectAndBranchNames'Unambiguous (That ProjectBranchName
branchName)) ->
          Text -> Codebase m v a -> ProjectPath -> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
Text -> Codebase m v a -> ProjectPath -> m [Completion]
handleBranchesComplete (forall target source. From source target => source -> target
into @Text ProjectBranchName
branchName) Codebase m v a
codebase ProjectPath
pp
        Right (ProjectAndBranchNames'Unambiguous (These ProjectName
projectName ProjectBranchName
branchName)) -> do
          [(ProjectBranchId, ProjectBranchName)]
branches <-
            Codebase m v a
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> m [(ProjectBranchId, ProjectBranchName)]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase do
              ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
projectName Transaction (Maybe Project)
-> (Maybe Project
    -> Transaction [(ProjectBranchId, ProjectBranchName)])
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe Project
Nothing -> [(ProjectBranchId, ProjectBranchName)]
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                Just Project
project -> do
                  let projectId :: ProjectId
projectId = Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId
                  ([(ProjectBranchId, ProjectBranchName)]
 -> [(ProjectBranchId, ProjectBranchName)])
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProjectBranchSuggestionsConfig
-> ProjectPath
-> [(ProjectBranchId, ProjectBranchName)]
-> [(ProjectBranchId, ProjectBranchName)]
forall a.
ProjectBranchSuggestionsConfig
-> ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
filterBranches ProjectBranchSuggestionsConfig
config ProjectPath
pp) do
                    ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Queries.loadAllProjectBranchesBeginningWith ProjectId
projectId (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ forall target source. From source target => source -> target
into @Text ProjectBranchName
branchName)
          pure (((ProjectBranchId, ProjectBranchName) -> Completion)
-> [(ProjectBranchId, ProjectBranchName)] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion
projectBranchToCompletion ProjectName
projectName) [(ProjectBranchId, ProjectBranchName)]
branches)
  where
    input :: Text
input = Text -> Text
Text.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
inputStr

    handleAmbiguousComplete ::
      (MonadIO m) =>
      Text ->
      Codebase m v a ->
      m [Completion]
    handleAmbiguousComplete :: forall (m :: * -> *) v a.
MonadIO m =>
Text -> Codebase m v a -> m [Completion]
handleAmbiguousComplete Text
input Codebase m v a
codebase = do
      ([(ProjectBranchId, ProjectBranchName)]
branches, [Project]
projects) <-
        Codebase m v a
-> Transaction ([(ProjectBranchId, ProjectBranchName)], [Project])
-> m ([(ProjectBranchId, ProjectBranchName)], [Project])
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase do
          [(ProjectBranchId, ProjectBranchName)]
branches <-
            ([(ProjectBranchId, ProjectBranchName)]
 -> [(ProjectBranchId, ProjectBranchName)])
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProjectBranchSuggestionsConfig
-> ProjectPath
-> [(ProjectBranchId, ProjectBranchName)]
-> [(ProjectBranchId, ProjectBranchName)]
forall a.
ProjectBranchSuggestionsConfig
-> ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
filterBranches ProjectBranchSuggestionsConfig
config ProjectPath
pp) do
              ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Queries.loadAllProjectBranchesBeginningWith ProjectId
currentProjectId (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
input)
          [Project]
projects <- case ProjectBranchSuggestionsConfig -> ProjectInclusion
projectInclusion ProjectBranchSuggestionsConfig
config of
            ProjectInclusion
OnlyWithinCurrentProject -> ProjectId -> Transaction (Maybe Project)
Queries.loadProject ProjectId
currentProjectId Transaction (Maybe Project)
-> (Maybe Project -> [Project]) -> Transaction [Project]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe Project -> [Project]
forall a. Maybe a -> [a]
maybeToList
            ProjectInclusion
_ -> Maybe Text -> Transaction [Project]
Queries.loadAllProjectsBeginningWith (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
input) Transaction [Project]
-> ([Project] -> [Project]) -> Transaction [Project]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Project] -> [Project]
filterProjects
          pure ([(ProjectBranchId, ProjectBranchName)]
branches, [Project]
projects)
      let branchCompletions :: [Completion]
branchCompletions = ((ProjectBranchId, ProjectBranchName) -> Completion)
-> [(ProjectBranchId, ProjectBranchName)] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (ProjectBranchId, ProjectBranchName) -> Completion
currentProjectBranchToCompletion [(ProjectBranchId, ProjectBranchName)]
branches
      let projectCompletions :: [Completion]
projectCompletions = (Project -> Completion) -> [Project] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map Project -> Completion
projectToCompletion [Project]
projects
      -- There's one final wibble to deal with here at the eleventh hour. You might think we can just append
      -- branchCompletions to projectCompletions and call it a day, *however*...!
      --
      -- Say we have two branches "bar" and "biz". These branches are rendered (and completed) with leading forward
      -- slashes.
      --
      --   > switch b<TAB>
      --   /bar /biz
      --
      --   > switch ba<TAB>
      --   > switch /bar -- the completion
      --
      -- Now say we repeat the above, but with a project "bongo".
      --
      --   > switch <TAB>
      --   /bar /biz bongo
      --
      -- If the user types a prefix that's common to both a branch and a project, like "b", their input will simply
      -- disappear. Wtf, haskeline?!
      --
      --   > switch b<TAB>
      --   > switch -- the completion
      --
      -- Well, it makes sense: we tell haskeline that we have three completions, "/bar", "/biz", and "bongo", with
      -- partial input "b". The longest common prefix here is the empty string "".
      --
      -- So, we have this final check. If there are indeed matching projects *and* matching branches, and the user
      -- has input at least one character (i.e. they aren't just tab-completing like "switch <TAB>" to see
      -- everything), then we pretend (for the sake of tab-completion) that there are only matching projects. This
      -- makes the back-and-forth with the tab completer much more intuitive:
      --
      --   > switch <TAB>
      --   /bar /biz bongo
      --   > switch b<TAB>
      --   > switch bongo -- the completion
      --
      -- A more optimal interface would not hide branches at all, even though their tab-completions end up prefixing
      -- a forward-slash:
      --
      --   > switch <TAB>
      --   /bar /biz bongo
      --   > switch b<TAB>
      --   /bar /biz bongo
      --   > switch ba<TAB>
      --   > switch /bar -- the completion
      --
      -- However, that simly doesn't seem possible with haskeline. Another sub-optimal point in the design space
      -- would be to *not* actually tab-complete branch names with leading forward slashes, even though they are
      -- rendered as such in the tab-completion options. For example,
      --
      --   > switch <TAB>
      --   /bar /biz
      --   > switch ba<TAB>
      --   > switch bar -- the completion
      --
      -- However, this has the unfortunate disadvantage of tab-completing a possibly ambiguous thing for the user,
      -- as in the case when there's both a branch and project with the same name:
      --
      --   > switch <TAB>
      --   /bar /biz bar
      --   > switch ba<TAB>
      --   > switch bar -- the completion
      --
      --   Ambiguous! Try `switch /bar` or `switch bar/`
      [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        if Bool -> Bool
not ([Completion] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Completion]
branchCompletions) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Completion] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Completion]
projectCompletions) Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
Text.null Text
input)
          then [Completion]
projectCompletions
          else [Completion]
branchCompletions [Completion] -> [Completion] -> [Completion]
forall a. [a] -> [a] -> [a]
++ [Completion]
projectCompletions

    -- Complete the text into a branch name within the provided project
    handleBranchesComplete :: (MonadIO m) => Text -> Codebase m v a -> PP.ProjectPath -> m [Completion]
    handleBranchesComplete :: forall (m :: * -> *) v a.
MonadIO m =>
Text -> Codebase m v a -> ProjectPath -> m [Completion]
handleBranchesComplete Text
branchName Codebase m v a
codebase ProjectPath
pp = do
      let projId :: ProjectId
projId = ProjectPath
pp ProjectPath -> Getting ProjectId ProjectPath ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. (Project -> Const ProjectId Project)
-> ProjectPath -> Const ProjectId ProjectPath
#project ((Project -> Const ProjectId Project)
 -> ProjectPath -> Const ProjectId ProjectPath)
-> Getting ProjectId Project ProjectId
-> Getting ProjectId ProjectPath ProjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProjectId Project ProjectId
#projectId
      [(ProjectBranchId, ProjectBranchName)]
branches <-
        Codebase m v a
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> m [(ProjectBranchId, ProjectBranchName)]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase do
          ([(ProjectBranchId, ProjectBranchName)]
 -> [(ProjectBranchId, ProjectBranchName)])
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProjectBranchSuggestionsConfig
-> ProjectPath
-> [(ProjectBranchId, ProjectBranchName)]
-> [(ProjectBranchId, ProjectBranchName)]
forall a.
ProjectBranchSuggestionsConfig
-> ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
filterBranches ProjectBranchSuggestionsConfig
config ProjectPath
pp) do
            ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Queries.loadAllProjectBranchesBeginningWith ProjectId
projId (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
branchName)
      pure (((ProjectBranchId, ProjectBranchName) -> Completion)
-> [(ProjectBranchId, ProjectBranchName)] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (ProjectBranchId, ProjectBranchName) -> Completion
currentProjectBranchToCompletion [(ProjectBranchId, ProjectBranchName)]
branches)

    filterProjects :: [Sqlite.Project] -> [Sqlite.Project]
    filterProjects :: [Project] -> [Project]
filterProjects [Project]
projects =
      case (ProjectBranchSuggestionsConfig -> ProjectInclusion
projectInclusion ProjectBranchSuggestionsConfig
config) of
        ProjectInclusion
AllProjects -> [Project]
projects
        ProjectInclusion
OnlyOutsideCurrentProject -> [Project]
projects [Project] -> ([Project] -> [Project]) -> [Project]
forall a b. a -> (a -> b) -> b
& (Project -> Bool) -> [Project] -> [Project]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Sqlite.Project {ProjectId
projectId :: ProjectId
$sel:projectId:Project :: Project -> ProjectId
projectId} -> ProjectId
projectId ProjectId -> ProjectId -> Bool
forall a. Eq a => a -> a -> Bool
/= ProjectId
currentProjectId)
        ProjectInclusion
OnlyWithinCurrentProject ->
          [Project]
projects
            [Project] -> ([Project] -> Maybe Project) -> Maybe Project
forall a b. a -> (a -> b) -> b
& (Project -> Bool) -> [Project] -> Maybe Project
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Sqlite.Project {ProjectId
$sel:projectId:Project :: Project -> ProjectId
projectId :: ProjectId
projectId} -> ProjectId
projectId ProjectId -> ProjectId -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectId
currentProjectId)
            Maybe Project -> (Maybe Project -> [Project]) -> [Project]
forall a b. a -> (a -> b) -> b
& Maybe Project -> [Project]
forall a. Maybe a -> [a]
maybeToList

    PP.ProjectPath ProjectId
currentProjectId ProjectBranchId
_currentBranchId Absolute
_currentPath = ProjectPath -> ProjectPathG ProjectId ProjectBranchId
PP.toIds ProjectPath
pp

projectToCompletion :: Sqlite.Project -> Completion
projectToCompletion :: Project -> Completion
projectToCompletion Project
project =
  Completion
    { replacement :: String
replacement = String
stringProjectName,
      display :: String
display = Pretty ColorText -> String
P.toAnsiUnbroken (ProjectName -> Pretty ColorText
prettyProjectNameSlash (Project
project Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name)),
      isFinished :: Bool
isFinished = Bool
False
    }
  where
    stringProjectName :: String
stringProjectName = Text -> String
Text.unpack (forall target source. From source target => source -> target
into @Text (Project
project Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/")

projectBranchToCompletion :: ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion
projectBranchToCompletion :: ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion
projectBranchToCompletion ProjectName
projectName (ProjectBranchId
_, ProjectBranchName
branchName) =
  Completion
    { replacement :: String
replacement = Text -> String
Text.unpack (forall target source. From source target => source -> target
into @Text (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName)),
      display :: String
display = Pretty ColorText -> String
P.toAnsiUnbroken (ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
branchName),
      isFinished :: Bool
isFinished = Bool
False
    }

handleBranchesComplete ::
  (MonadIO m) =>
  ProjectBranchSuggestionsConfig ->
  Text ->
  Codebase m v a ->
  PP.ProjectPath ->
  m [Completion]
handleBranchesComplete :: forall (m :: * -> *) v a.
MonadIO m =>
ProjectBranchSuggestionsConfig
-> Text -> Codebase m v a -> ProjectPath -> m [Completion]
handleBranchesComplete ProjectBranchSuggestionsConfig
config Text
branchName Codebase m v a
codebase ProjectPath
pp = do
  [(ProjectBranchId, ProjectBranchName)]
branches <-
    Codebase m v a
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> m [(ProjectBranchId, ProjectBranchName)]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase do
      ([(ProjectBranchId, ProjectBranchName)]
 -> [(ProjectBranchId, ProjectBranchName)])
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProjectBranchSuggestionsConfig
-> ProjectPath
-> [(ProjectBranchId, ProjectBranchName)]
-> [(ProjectBranchId, ProjectBranchName)]
forall a.
ProjectBranchSuggestionsConfig
-> ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
filterBranches ProjectBranchSuggestionsConfig
config ProjectPath
pp) do
        ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Queries.loadAllProjectBranchesBeginningWith (ProjectPath
pp ProjectPath -> Getting ProjectId ProjectPath ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. (Project -> Const ProjectId Project)
-> ProjectPath -> Const ProjectId ProjectPath
#project ((Project -> Const ProjectId Project)
 -> ProjectPath -> Const ProjectId ProjectPath)
-> Getting ProjectId Project ProjectId
-> Getting ProjectId ProjectPath ProjectId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProjectId Project ProjectId
#projectId) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
branchName)
  pure (((ProjectBranchId, ProjectBranchName) -> Completion)
-> [(ProjectBranchId, ProjectBranchName)] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (ProjectBranchId, ProjectBranchName) -> Completion
currentProjectBranchToCompletion [(ProjectBranchId, ProjectBranchName)]
branches)

filterBranches :: ProjectBranchSuggestionsConfig -> PP.ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
filterBranches :: forall a.
ProjectBranchSuggestionsConfig
-> ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
filterBranches ProjectBranchSuggestionsConfig
config ProjectPath
pp [(ProjectBranchId, a)]
branches =
  case (ProjectBranchSuggestionsConfig -> BranchInclusion
branchInclusion ProjectBranchSuggestionsConfig
config) of
    BranchInclusion
AllBranches -> [(ProjectBranchId, a)]
branches
    BranchInclusion
ExcludeCurrentBranch -> [(ProjectBranchId, a)]
branches [(ProjectBranchId, a)]
-> ([(ProjectBranchId, a)] -> [(ProjectBranchId, a)])
-> [(ProjectBranchId, a)]
forall a b. a -> (a -> b) -> b
& ((ProjectBranchId, a) -> Bool)
-> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ProjectBranchId
branchId, a
_) -> ProjectBranchId
branchId ProjectBranchId -> ProjectBranchId -> Bool
forall a. Eq a => a -> a -> Bool
/= ProjectBranchId
currentBranchId)
  where
    currentBranchId :: ProjectBranchId
currentBranchId = ProjectPath
pp ProjectPath
-> Getting ProjectBranchId ProjectPath ProjectBranchId
-> ProjectBranchId
forall s a. s -> Getting a s a -> a
^. (ProjectBranch -> Const ProjectBranchId ProjectBranch)
-> ProjectPath -> Const ProjectBranchId ProjectPath
#branch ((ProjectBranch -> Const ProjectBranchId ProjectBranch)
 -> ProjectPath -> Const ProjectBranchId ProjectPath)
-> ((ProjectBranchId -> Const ProjectBranchId ProjectBranchId)
    -> ProjectBranch -> Const ProjectBranchId ProjectBranch)
-> Getting ProjectBranchId ProjectPath ProjectBranchId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProjectBranchId -> Const ProjectBranchId ProjectBranchId)
-> ProjectBranch -> Const ProjectBranchId ProjectBranch
#branchId

currentProjectBranchToCompletion :: (ProjectBranchId, ProjectBranchName) -> Completion
currentProjectBranchToCompletion :: (ProjectBranchId, ProjectBranchName) -> Completion
currentProjectBranchToCompletion (ProjectBranchId
_, ProjectBranchName
branchName) =
  Completion
    { replacement :: String
replacement = Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: Text -> String
Text.unpack (forall target source. From source target => source -> target
into @Text ProjectBranchName
branchName),
      display :: String
display = Pretty ColorText -> String
P.toAnsiUnbroken (ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
branchName),
      isFinished :: Bool
isFinished = Bool
False
    }

branchRelativePathSuggestions ::
  (MonadIO m) =>
  ProjectBranchSuggestionsConfig ->
  String ->
  Codebase m v a ->
  AuthenticatedHttpClient ->
  PP.ProjectPath ->
  m [Line.Completion]
branchRelativePathSuggestions :: forall (m :: * -> *) v a.
MonadIO m =>
ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
branchRelativePathSuggestions ProjectBranchSuggestionsConfig
config String
inputStr Codebase m v a
codebase AuthenticatedHttpClient
_httpClient ProjectPath
pp = do
  case String -> Either (Pretty ColorText) IncrementalBranchRelativePath
parseIncrementalBranchRelativePath String
inputStr of
    Left Pretty ColorText
_ -> [Completion] -> m [Completion]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Right IncrementalBranchRelativePath
ibrp -> case IncrementalBranchRelativePath
ibrp of
      BranchRelativePath.ProjectOrPath' Text
_txt Path'
_path -> do
        [Completion]
namespaceSuggestions <- Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase (String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace String
inputStr ProjectPath
pp)
        [Completion]
projectSuggestions <- OptionalSlash -> String -> Codebase m v a -> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
OptionalSlash -> String -> Codebase m v a -> m [Completion]
projectNameSuggestions OptionalSlash
WithSlash String
inputStr Codebase m v a
codebase
        pure ([Completion]
namespaceSuggestions [Completion] -> [Completion] -> [Completion]
forall a. [a] -> [a] -> [a]
++ [Completion]
projectSuggestions)
      BranchRelativePath.OnlyPath' Path'
_path ->
        Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase (String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace String
inputStr ProjectPath
pp)
      BranchRelativePath.IncompleteProject ProjectName
_proj ->
        OptionalSlash -> String -> Codebase m v a -> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
OptionalSlash -> String -> Codebase m v a -> m [Completion]
projectNameSuggestions OptionalSlash
WithSlash String
inputStr Codebase m v a
codebase
      BranchRelativePath.IncompleteBranch Maybe ProjectName
mproj Maybe ProjectBranchName
mbranch -> case Maybe ProjectName
mproj of
        Maybe ProjectName
Nothing -> (Completion -> Completion) -> [Completion] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map Completion -> Completion
suffixPathSep ([Completion] -> [Completion]) -> m [Completion] -> m [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectBranchSuggestionsConfig
-> Text -> Codebase m v a -> ProjectPath -> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
ProjectBranchSuggestionsConfig
-> Text -> Codebase m v a -> ProjectPath -> m [Completion]
handleBranchesComplete ProjectBranchSuggestionsConfig
config (Text
-> (ProjectBranchName -> Text) -> Maybe ProjectBranchName -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ProjectBranchName -> Text
forall target source. From source target => source -> target
into Maybe ProjectBranchName
mbranch) Codebase m v a
codebase ProjectPath
pp
        Just ProjectName
projectName -> do
          [(ProjectBranchId, ProjectBranchName)]
branches <-
            Codebase m v a
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> m [(ProjectBranchId, ProjectBranchName)]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase do
              ProjectName -> Transaction (Maybe Project)
Queries.loadProjectByName ProjectName
projectName Transaction (Maybe Project)
-> (Maybe Project
    -> Transaction [(ProjectBranchId, ProjectBranchName)])
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe Project
Nothing -> [(ProjectBranchId, ProjectBranchName)]
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
                Just Project
project -> do
                  let projectId :: ProjectId
projectId = Project
project Project -> Getting ProjectId Project ProjectId -> ProjectId
forall s a. s -> Getting a s a -> a
^. Getting ProjectId Project ProjectId
#projectId
                  ([(ProjectBranchId, ProjectBranchName)]
 -> [(ProjectBranchId, ProjectBranchName)])
-> Transaction [(ProjectBranchId, ProjectBranchName)]
-> Transaction [(ProjectBranchId, ProjectBranchName)]
forall a b. (a -> b) -> Transaction a -> Transaction b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProjectBranchSuggestionsConfig
-> ProjectPath
-> [(ProjectBranchId, ProjectBranchName)]
-> [(ProjectBranchId, ProjectBranchName)]
forall a.
ProjectBranchSuggestionsConfig
-> ProjectPath -> [(ProjectBranchId, a)] -> [(ProjectBranchId, a)]
filterBranches ProjectBranchSuggestionsConfig
config ProjectPath
pp) do
                    ProjectId
-> Maybe Text -> Transaction [(ProjectBranchId, ProjectBranchName)]
Queries.loadAllProjectBranchesBeginningWith ProjectId
projectId (forall target source. From source target => source -> target
into @Text (ProjectBranchName -> Text)
-> Maybe ProjectBranchName -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ProjectBranchName
mbranch)
          pure (((ProjectBranchId, ProjectBranchName) -> Completion)
-> [(ProjectBranchId, ProjectBranchName)] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion
projectBranchToCompletionWithSep ProjectName
projectName) [(ProjectBranchId, ProjectBranchName)]
branches)
      BranchRelativePath.PathRelativeToCurrentBranch Absolute
absPath -> Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase do
        (Completion -> Completion) -> [Completion] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map Completion -> Completion
prefixPathSep ([Completion] -> [Completion])
-> Transaction [Completion] -> Transaction [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace (Text -> String
Text.unpack (Text -> String) -> (Path' -> Text) -> Path' -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Text
Path.toText' (Path' -> String) -> Path' -> String
forall a b. (a -> b) -> a -> b
$ Absolute -> Path'
Path.AbsolutePath' Absolute
absPath) ProjectPath
pp
      BranchRelativePath.IncompletePath Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
projStuff Maybe Absolute
mpath -> do
        Codebase m v a -> Transaction [Completion] -> m [Completion]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase do
          (Completion -> Completion) -> [Completion] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
-> Completion -> Completion
addBranchPrefix Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
projStuff) ([Completion] -> [Completion])
-> Transaction [Completion] -> Transaction [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ProjectPath -> Transaction [Completion]
prefixCompleteNamespace (String -> (Absolute -> String) -> Maybe Absolute -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Text -> String
Text.unpack (Text -> String) -> (Absolute -> Text) -> Absolute -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Text
Path.toText' (Path' -> Text) -> (Absolute -> Path') -> Absolute -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Path'
Path.AbsolutePath') Maybe Absolute
mpath) ProjectPath
pp
  where
    projectBranchToCompletionWithSep :: ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion
    projectBranchToCompletionWithSep :: ProjectName -> (ProjectBranchId, ProjectBranchName) -> Completion
projectBranchToCompletionWithSep ProjectName
projectName (ProjectBranchId
_, ProjectBranchName
branchName) =
      Completion
        { replacement :: String
replacement = Text -> String
Text.unpack (forall target source. From source target => source -> target
into @Text (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
forall s. IsString s => s
branchPathSep),
          display :: String
display = Pretty ColorText -> String
P.toAnsiUnbroken (ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
branchName Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
branchPathSepPretty),
          isFinished :: Bool
isFinished = Bool
False
        }

    prefixPathSep :: Completion -> Completion
    prefixPathSep :: Completion -> Completion
prefixPathSep Completion
c =
      Completion
c
        { Line.replacement = branchPathSep <> Line.replacement c,
          Line.display = P.toAnsiUnbroken branchPathSepPretty <> Line.display c
        }

    suffixPathSep :: Completion -> Completion
    suffixPathSep :: Completion -> Completion
suffixPathSep Completion
c =
      Completion
c
        { Line.replacement = Line.replacement c <> branchPathSep,
          Line.display = Line.display c <> P.toAnsiUnbroken branchPathSepPretty
        }

    addBranchPrefix ::
      Either (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName ->
      Completion ->
      Completion
    addBranchPrefix :: Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
-> Completion -> Completion
addBranchPrefix Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
eproj =
      let (Text
prefixText, Pretty ColorText
prefixPretty) = case Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
eproj of
            Left ProjectAndBranch ProjectName ProjectBranchName
pb ->
              ( forall target source. From source target => source -> target
into @Text ProjectAndBranch ProjectName ProjectBranchName
pb,
                ProjectAndBranch ProjectName ProjectBranchName -> Pretty ColorText
prettyProjectAndBranchName ProjectAndBranch ProjectName ProjectBranchName
pb
              )
            Right ProjectBranchName
branch ->
              ( Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall target source. From source target => source -> target
into @Text ProjectBranchName
branch,
                ProjectBranchName -> Pretty ColorText
prettySlashProjectBranchName ProjectBranchName
branch
              )
       in \Completion
c ->
            Completion
c
              { Line.replacement = Text.unpack prefixText <> branchPathSep <> Line.replacement c,
                Line.display = P.toAnsiUnbroken (prefixPretty <> branchPathSepPretty) <> Line.display c
              }

    branchPathSepPretty :: Pretty ColorText
branchPathSepPretty = Pretty ColorText -> Pretty ColorText
P.hiBlack Pretty ColorText
forall s. IsString s => s
branchPathSep

    branchPathSep :: (IsString s) => s
    branchPathSep :: forall s. IsString s => s
branchPathSep = s
":"

-- | A project name, branch name, or both.
projectAndBranchNamesArg :: ProjectBranchSuggestionsConfig -> ArgumentType
projectAndBranchNamesArg :: ProjectBranchSuggestionsConfig -> ArgumentType
projectAndBranchNamesArg ProjectBranchSuggestionsConfig
config =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"project-and-branch-names",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
projectAndOrBranchSuggestions ProjectBranchSuggestionsConfig
config,
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.projectAndOrBranchArg
    }

-- | A project branch name.
projectBranchNameArg :: ProjectBranchSuggestionsConfig -> ArgumentType
projectBranchNameArg :: ProjectBranchSuggestionsConfig -> ArgumentType
projectBranchNameArg ProjectBranchSuggestionsConfig
config =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"project-branch-name",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
projectAndOrBranchSuggestions ProjectBranchSuggestionsConfig
config,
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just FZFResolver
Resolvers.projectBranchResolver
    }

branchRelativePathArg :: ArgumentType
branchRelativePathArg :: ArgumentType
branchRelativePathArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"branch-relative-path",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
ProjectBranchSuggestionsConfig
-> String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
branchRelativePathSuggestions ProjectBranchSuggestionsConfig
config,
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = Maybe FZFResolver
forall a. Maybe a
Nothing
    }
  where
    config :: ProjectBranchSuggestionsConfig
config =
      ProjectBranchSuggestionsConfig
        { $sel:showProjectCompletions:ProjectBranchSuggestionsConfig :: Bool
showProjectCompletions = Bool
True,
          $sel:projectInclusion:ProjectBranchSuggestionsConfig :: ProjectInclusion
projectInclusion = ProjectInclusion
AllProjects,
          $sel:branchInclusion:ProjectBranchSuggestionsConfig :: BranchInclusion
branchInclusion = BranchInclusion
AllBranches
        }

-- | A project name.
projectNameArg :: ArgumentType
projectNameArg :: ArgumentType
projectNameArg =
  ArgumentType
    { $sel:typeName:ArgumentType :: String
typeName = String
"project-name",
      $sel:suggestions:ArgumentType :: forall (m :: * -> *) v a.
MonadIO m =>
String
-> Codebase m v a
-> AuthenticatedHttpClient
-> ProjectPath
-> m [Completion]
suggestions = \String
input Codebase m v a
codebase AuthenticatedHttpClient
_httpClient ProjectPath
_path -> OptionalSlash -> String -> Codebase m v a -> m [Completion]
forall (m :: * -> *) v a.
MonadIO m =>
OptionalSlash -> String -> Codebase m v a -> m [Completion]
projectNameSuggestions OptionalSlash
NoSlash String
input Codebase m v a
codebase,
      $sel:fzfResolver:ArgumentType :: Maybe FZFResolver
fzfResolver = FZFResolver -> Maybe FZFResolver
forall a. a -> Maybe a
Just (FZFResolver -> Maybe FZFResolver)
-> FZFResolver -> Maybe FZFResolver
forall a b. (a -> b) -> a -> b
$ [OptionFetcher] -> FZFResolver
Resolvers.multiResolver [OptionFetcher
Resolvers.projectNameOptions]
    }

data OptionalSlash
  = WithSlash
  | NoSlash

projectNameSuggestions ::
  (MonadIO m) =>
  OptionalSlash ->
  String ->
  Codebase m v a ->
  m [Line.Completion]
projectNameSuggestions :: forall (m :: * -> *) v a.
MonadIO m =>
OptionalSlash -> String -> Codebase m v a -> m [Completion]
projectNameSuggestions OptionalSlash
slash (Text -> Text
Text.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack -> Text
input) Codebase m v a
codebase = do
  [Project]
projects <-
    Codebase m v a -> Transaction [Project] -> m [Project]
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase m v a
codebase do
      Maybe Text -> Transaction [Project]
Queries.loadAllProjectsBeginningWith (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
input)
  pure $ (Project -> Completion) -> [Project] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map Project -> Completion
projectToCompletion [Project]
projects
  where
    projectToCompletion :: Sqlite.Project -> Completion
    projectToCompletion :: Project -> Completion
projectToCompletion =
      let toPretty :: ProjectName -> Pretty ColorText
toPretty = case OptionalSlash
slash of
            OptionalSlash
NoSlash -> ProjectName -> Pretty ColorText
prettyProjectName
            OptionalSlash
WithSlash -> ProjectName -> Pretty ColorText
prettyProjectNameSlash
          toText :: Project -> Text
toText Project
project = case OptionalSlash
slash of
            OptionalSlash
NoSlash -> forall target source. From source target => source -> target
into @Text (Project
project Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name)
            OptionalSlash
WithSlash -> Text -> Char -> Text
Text.snoc (forall target source. From source target => source -> target
into @Text (Project
project Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name)) Char
'/'
       in \Project
project ->
            Completion
              { replacement :: String
replacement = Text -> String
Text.unpack (Project -> Text
toText Project
project),
                display :: String
display = Pretty ColorText -> String
P.toAnsiUnbroken (ProjectName -> Pretty ColorText
toPretty (Project
project Project -> Getting ProjectName Project ProjectName -> ProjectName
forall s a. s -> Getting a s a -> a
^. Getting ProjectName Project ProjectName
#name)),
                isFinished :: Bool
isFinished = Bool
False
              }

-- | Parse a 'Input.PushSource'.
parsePushSource :: String -> Maybe Input.PushSource
parsePushSource :: String -> Maybe PushSource
parsePushSource String
sourceStr =
  (These ProjectName ProjectBranchName -> PushSource)
-> Either
     (TryFromException Text (These ProjectName ProjectBranchName))
     (These ProjectName ProjectBranchName)
-> Maybe PushSource
forall {b} {a} {a}. (b -> a) -> Either a b -> Maybe a
fixup These ProjectName ProjectBranchName -> PushSource
Input.ProjySource (Text
-> Either
     (TryFromException Text (These ProjectName ProjectBranchName))
     (These ProjectName ProjectBranchName)
forall source target.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryFrom (Text
 -> Either
      (TryFromException Text (These ProjectName ProjectBranchName))
      (These ProjectName ProjectBranchName))
-> Text
-> Either
     (TryFromException Text (These ProjectName ProjectBranchName))
     (These ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
sourceStr)
  where
    fixup :: (b -> a) -> Either a b -> Maybe a
fixup = (a -> Maybe a) -> (b -> Maybe a) -> Either a b -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) ((b -> Maybe a) -> Either a b -> Maybe a)
-> ((b -> a) -> b -> Maybe a) -> (b -> a) -> Either a b -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a) -> (b -> a) -> b -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

-- | Parse a push target.
parsePushTarget :: String -> Maybe (These ProjectName ProjectBranchName)
parsePushTarget :: String -> Maybe (These ProjectName ProjectBranchName)
parsePushTarget = Parsec Void Text (These ProjectName ProjectBranchName)
-> Text -> Maybe (These ProjectName ProjectBranchName)
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe Parsec Void Text (These ProjectName ProjectBranchName)
UriParser.writeRemoteNamespace (Text -> Maybe (These ProjectName ProjectBranchName))
-> (String -> Text)
-> String
-> Maybe (These ProjectName ProjectBranchName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

parseHashQualifiedName ::
  String -> Either (P.Pretty CT.ColorText) (HQ.HashQualified Name)
parseHashQualifiedName :: String -> Either (Pretty ColorText) (HashQualified Name)
parseHashQualifiedName String
s =
  Either (Pretty ColorText) (HashQualified Name)
-> (HashQualified Name
    -> Either (Pretty ColorText) (HashQualified Name))
-> Maybe (HashQualified Name)
-> Either (Pretty ColorText) (HashQualified Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    ( Pretty ColorText -> Either (Pretty ColorText) (HashQualified Name)
forall a b. a -> Either a b
Left
        (Pretty ColorText
 -> Either (Pretty ColorText) (HashQualified Name))
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> Either (Pretty ColorText) (HashQualified Name)
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
 -> Either (Pretty ColorText) (HashQualified Name))
-> Pretty ColorText
-> Either (Pretty ColorText) (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string String
s
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" is not a well-formed name, hash, or hash-qualified name. "
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"I expected something like `foo`, `#abc123`, or `foo#abc123`."
    )
    HashQualified Name
-> Either (Pretty ColorText) (HashQualified Name)
forall a b. b -> Either a b
Right
    (Maybe (HashQualified Name)
 -> Either (Pretty ColorText) (HashQualified Name))
-> Maybe (HashQualified Name)
-> Either (Pretty ColorText) (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (HashQualified Name)
HQ.parseText (String -> Text
Text.pack String
s)

explainRemote :: PushPull -> P.Pretty CT.ColorText
explainRemote :: PushPull -> Pretty ColorText
explainRemote PushPull
pushPull =
  Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
P.group (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 -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"where `remote` is a project or project branch, such as:",
        Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
P.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> ([(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)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
P.column2 ([(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
          [ (Pretty ColorText
"Project (defaults to the /main branch)", Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
P.backticked Pretty ColorText
"@unison/base"),
            (Pretty ColorText
"Project Branch", Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
P.backticked Pretty ColorText
"@unison/base/feature"),
            (Pretty ColorText
"Contributor Branch", Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
P.backticked Pretty ColorText
"@unison/base/@johnsmith/feature")
          ]
            [(Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText)]
forall a. Semigroup a => a -> a -> a
<> Bool
-> [(Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText)]
forall a. Monoid a => Bool -> a -> a
Monoid.whenM (PushPull
pushPull PushPull -> PushPull -> Bool
forall a. Eq a => a -> a -> Bool
== PushPull
Pull) [(Pretty ColorText
"Project Release", Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
P.backticked Pretty ColorText
"@unison/base/releases/1.0.0")]
      ]

megaparse :: Megaparsec.Parsec Void Text a -> Text -> Either (P.Pretty P.ColorText) a
megaparse :: forall a. Parsec Void Text a -> Text -> Either (Pretty ColorText) a
megaparse Parsec Void Text a
parser Text
input =
  Text
input
    Text
-> (Text -> Either (ParseErrorBundle Text Void) a)
-> Either (ParseErrorBundle Text Void) a
forall a b. a -> (a -> b) -> b
& Parsec Void Text a
-> String -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.parse (Parsec Void Text a
parser Parsec Void Text a
-> ParsecT Void Text Identity () -> Parsec Void Text a
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Megaparsec.eof) String
""
    Either (ParseErrorBundle Text Void) a
-> (Either (ParseErrorBundle Text Void) a
    -> Either (Pretty ColorText) a)
-> Either (Pretty ColorText) a
forall a b. a -> (a -> b) -> b
& (ParseErrorBundle Text Void -> Pretty ColorText)
-> Either (ParseErrorBundle Text Void) a
-> Either (Pretty ColorText) a
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft (String -> ParseErrorBundle Text Void -> Pretty ColorText
prettyPrintParseError (Text -> String
Text.unpack Text
input))