{-# LANGUAGE RecordWildCards #-}

-- | This module handles parsing CLI arguments into 'Command's.
-- See the excellent documentation at https://hackage.haskell.org/package/optparse-applicative
module ArgParse where

import Data.List qualified as List
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as Text
import Options.Applicative
  ( CommandFields,
    Mod,
    ParseError (ShowHelpText),
    Parser,
    ParserInfo,
    ParserPrefs,
    ReadM,
    action,
    argument,
    auto,
    columns,
    command,
    customExecParser,
    flag,
    footerDoc,
    fullDesc,
    headerDoc,
    help,
    helpShowGlobals,
    helper,
    hsubparser,
    info,
    infoOption,
    long,
    maybeReader,
    metavar,
    option,
    parserFailure,
    prefs,
    progDesc,
    renderFailure,
    short,
    showHelpOnError,
    strArgument,
    strOption,
    subparserInline,
  )
import Options.Applicative qualified as OptParse
import Options.Applicative.Builder.Internal (noGlobal {- https://github.com/pcapriotti/optparse-applicative/issues/461 -})
import Options.Applicative.Help (bold, (<+>))
import Options.Applicative.Help.Pretty qualified as P
import Stats
import System.Environment (lookupEnv)
import Text.Megaparsec qualified as Megaparsec
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Path.Parse qualified as Path
import Unison.Codebase.ProjectPath (ProjectPathNames)
import Unison.Codebase.ProjectPath qualified as PP
import Unison.CommandLine.Types (ShouldWatchFiles (..))
import Unison.Core.Project (ProjectAndBranch, ProjectBranchName, ProjectName)
import Unison.HashQualified (HashQualified)
import Unison.LSP (LspFormattingConfig (..))
import Unison.Name (Name)
import Unison.Prelude
import Unison.PrettyTerminal qualified as PT
import Unison.Project qualified as Project
import Unison.Server.CodebaseServer (CodebaseServerOpts (..))
import Unison.Server.CodebaseServer qualified as Server
import Unison.Syntax.HashQualified qualified as HQ
import Unison.Util.Pretty (Width (..))

-- | Valid ways to provide source code to the run command
data RunSource
  = RunFromPipe (HashQualified Name)
  | RunFromSymbol ProjectPathNames
  | RunFromFile FilePath (HashQualified Name)
  | RunCompiled FilePath
  deriving (Int -> RunSource -> ShowS
[RunSource] -> ShowS
RunSource -> FilePath
(Int -> RunSource -> ShowS)
-> (RunSource -> FilePath)
-> ([RunSource] -> ShowS)
-> Show RunSource
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunSource -> ShowS
showsPrec :: Int -> RunSource -> ShowS
$cshow :: RunSource -> FilePath
show :: RunSource -> FilePath
$cshowList :: [RunSource] -> ShowS
showList :: [RunSource] -> ShowS
Show, RunSource -> RunSource -> Bool
(RunSource -> RunSource -> Bool)
-> (RunSource -> RunSource -> Bool) -> Eq RunSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunSource -> RunSource -> Bool
== :: RunSource -> RunSource -> Bool
$c/= :: RunSource -> RunSource -> Bool
/= :: RunSource -> RunSource -> Bool
Eq)

data ShouldForkCodebase
  = UseFork
  | DontFork
  deriving (Int -> ShouldForkCodebase -> ShowS
[ShouldForkCodebase] -> ShowS
ShouldForkCodebase -> FilePath
(Int -> ShouldForkCodebase -> ShowS)
-> (ShouldForkCodebase -> FilePath)
-> ([ShouldForkCodebase] -> ShowS)
-> Show ShouldForkCodebase
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShouldForkCodebase -> ShowS
showsPrec :: Int -> ShouldForkCodebase -> ShowS
$cshow :: ShouldForkCodebase -> FilePath
show :: ShouldForkCodebase -> FilePath
$cshowList :: [ShouldForkCodebase] -> ShowS
showList :: [ShouldForkCodebase] -> ShowS
Show, ShouldForkCodebase -> ShouldForkCodebase -> Bool
(ShouldForkCodebase -> ShouldForkCodebase -> Bool)
-> (ShouldForkCodebase -> ShouldForkCodebase -> Bool)
-> Eq ShouldForkCodebase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShouldForkCodebase -> ShouldForkCodebase -> Bool
== :: ShouldForkCodebase -> ShouldForkCodebase -> Bool
$c/= :: ShouldForkCodebase -> ShouldForkCodebase -> Bool
/= :: ShouldForkCodebase -> ShouldForkCodebase -> Bool
Eq)

data ShouldSaveCodebase
  = SaveCodebase (Maybe FilePath)
  | DontSaveCodebase
  deriving (Int -> ShouldSaveCodebase -> ShowS
[ShouldSaveCodebase] -> ShowS
ShouldSaveCodebase -> FilePath
(Int -> ShouldSaveCodebase -> ShowS)
-> (ShouldSaveCodebase -> FilePath)
-> ([ShouldSaveCodebase] -> ShowS)
-> Show ShouldSaveCodebase
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShouldSaveCodebase -> ShowS
showsPrec :: Int -> ShouldSaveCodebase -> ShowS
$cshow :: ShouldSaveCodebase -> FilePath
show :: ShouldSaveCodebase -> FilePath
$cshowList :: [ShouldSaveCodebase] -> ShowS
showList :: [ShouldSaveCodebase] -> ShowS
Show, ShouldSaveCodebase -> ShouldSaveCodebase -> Bool
(ShouldSaveCodebase -> ShouldSaveCodebase -> Bool)
-> (ShouldSaveCodebase -> ShouldSaveCodebase -> Bool)
-> Eq ShouldSaveCodebase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShouldSaveCodebase -> ShouldSaveCodebase -> Bool
== :: ShouldSaveCodebase -> ShouldSaveCodebase -> Bool
$c/= :: ShouldSaveCodebase -> ShouldSaveCodebase -> Bool
/= :: ShouldSaveCodebase -> ShouldSaveCodebase -> Bool
Eq)

data CodebasePathOption
  = CreateCodebaseWhenMissing FilePath
  | DontCreateCodebaseWhenMissing FilePath
  deriving (Int -> CodebasePathOption -> ShowS
[CodebasePathOption] -> ShowS
CodebasePathOption -> FilePath
(Int -> CodebasePathOption -> ShowS)
-> (CodebasePathOption -> FilePath)
-> ([CodebasePathOption] -> ShowS)
-> Show CodebasePathOption
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodebasePathOption -> ShowS
showsPrec :: Int -> CodebasePathOption -> ShowS
$cshow :: CodebasePathOption -> FilePath
show :: CodebasePathOption -> FilePath
$cshowList :: [CodebasePathOption] -> ShowS
showList :: [CodebasePathOption] -> ShowS
Show, CodebasePathOption -> CodebasePathOption -> Bool
(CodebasePathOption -> CodebasePathOption -> Bool)
-> (CodebasePathOption -> CodebasePathOption -> Bool)
-> Eq CodebasePathOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodebasePathOption -> CodebasePathOption -> Bool
== :: CodebasePathOption -> CodebasePathOption -> Bool
$c/= :: CodebasePathOption -> CodebasePathOption -> Bool
/= :: CodebasePathOption -> CodebasePathOption -> Bool
Eq)

data ShouldExit = Exit | DoNotExit
  deriving (Int -> ShouldExit -> ShowS
[ShouldExit] -> ShowS
ShouldExit -> FilePath
(Int -> ShouldExit -> ShowS)
-> (ShouldExit -> FilePath)
-> ([ShouldExit] -> ShowS)
-> Show ShouldExit
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShouldExit -> ShowS
showsPrec :: Int -> ShouldExit -> ShowS
$cshow :: ShouldExit -> FilePath
show :: ShouldExit -> FilePath
$cshowList :: [ShouldExit] -> ShowS
showList :: [ShouldExit] -> ShowS
Show, ShouldExit -> ShouldExit -> Bool
(ShouldExit -> ShouldExit -> Bool)
-> (ShouldExit -> ShouldExit -> Bool) -> Eq ShouldExit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShouldExit -> ShouldExit -> Bool
== :: ShouldExit -> ShouldExit -> Bool
$c/= :: ShouldExit -> ShouldExit -> Bool
/= :: ShouldExit -> ShouldExit -> Bool
Eq)

data IsHeadless = Headless | WithCLI
  deriving (Int -> IsHeadless -> ShowS
[IsHeadless] -> ShowS
IsHeadless -> FilePath
(Int -> IsHeadless -> ShowS)
-> (IsHeadless -> FilePath)
-> ([IsHeadless] -> ShowS)
-> Show IsHeadless
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsHeadless -> ShowS
showsPrec :: Int -> IsHeadless -> ShowS
$cshow :: IsHeadless -> FilePath
show :: IsHeadless -> FilePath
$cshowList :: [IsHeadless] -> ShowS
showList :: [IsHeadless] -> ShowS
Show, IsHeadless -> IsHeadless -> Bool
(IsHeadless -> IsHeadless -> Bool)
-> (IsHeadless -> IsHeadless -> Bool) -> Eq IsHeadless
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsHeadless -> IsHeadless -> Bool
== :: IsHeadless -> IsHeadless -> Bool
$c/= :: IsHeadless -> IsHeadless -> Bool
/= :: IsHeadless -> IsHeadless -> Bool
Eq)

-- | Represents commands the cli can run.
--
-- Note that this is not one-to-one with command-parsers since some are simple variants.
-- E.g. run, run.file, run.pipe
data Command
  = Launch
      IsHeadless
      CodebaseServerOpts
      -- Starting project
      (Maybe (ProjectAndBranch ProjectName ProjectBranchName))
      ShouldWatchFiles
  | PrintVersion
  | -- @deprecated in trunk after M2g. Remove the Init command completely after M2h has been released
    Init
  | Run RunSource [String]
  | Transcript ShouldForkCodebase ShouldSaveCodebase (Maybe RtsStatsPath) (NonEmpty FilePath)
  deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> FilePath
(Int -> Command -> ShowS)
-> (Command -> FilePath) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Command -> ShowS
showsPrec :: Int -> Command -> ShowS
$cshow :: Command -> FilePath
show :: Command -> FilePath
$cshowList :: [Command] -> ShowS
showList :: [Command] -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
/= :: Command -> Command -> Bool
Eq)

-- | Options shared by sufficiently many subcommands.
data GlobalOptions = GlobalOptions
  { GlobalOptions -> Maybe CodebasePathOption
codebasePathOption :: Maybe CodebasePathOption,
    GlobalOptions -> ShouldExit
exitOption :: ShouldExit,
    GlobalOptions -> Maybe FilePath
nativeRuntimePath :: Maybe FilePath,
    GlobalOptions -> LspFormattingConfig
lspFormattingConfig :: LspFormattingConfig
  }
  deriving (Int -> GlobalOptions -> ShowS
[GlobalOptions] -> ShowS
GlobalOptions -> FilePath
(Int -> GlobalOptions -> ShowS)
-> (GlobalOptions -> FilePath)
-> ([GlobalOptions] -> ShowS)
-> Show GlobalOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobalOptions -> ShowS
showsPrec :: Int -> GlobalOptions -> ShowS
$cshow :: GlobalOptions -> FilePath
show :: GlobalOptions -> FilePath
$cshowList :: [GlobalOptions] -> ShowS
showList :: [GlobalOptions] -> ShowS
Show, GlobalOptions -> GlobalOptions -> Bool
(GlobalOptions -> GlobalOptions -> Bool)
-> (GlobalOptions -> GlobalOptions -> Bool) -> Eq GlobalOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobalOptions -> GlobalOptions -> Bool
== :: GlobalOptions -> GlobalOptions -> Bool
$c/= :: GlobalOptions -> GlobalOptions -> Bool
/= :: GlobalOptions -> GlobalOptions -> Bool
Eq)

-- | The root-level 'ParserInfo'.
rootParserInfo :: String -> String -> CodebaseServerOpts -> ParserInfo (GlobalOptions, Command)
rootParserInfo :: FilePath
-> FilePath
-> CodebaseServerOpts
-> ParserInfo (GlobalOptions, Command)
rootParserInfo FilePath
progName FilePath
version CodebaseServerOpts
envOpts =
  Parser (GlobalOptions, Command)
-> InfoMod (GlobalOptions, Command)
-> ParserInfo (GlobalOptions, Command)
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Parser
  (((GlobalOptions, Command) -> (GlobalOptions, Command))
   -> (GlobalOptions, Command) -> (GlobalOptions, Command))
forall a. Parser (a -> a)
helper Parser
  (((GlobalOptions, Command) -> (GlobalOptions, Command))
   -> (GlobalOptions, Command) -> (GlobalOptions, Command))
-> Parser ((GlobalOptions, Command) -> (GlobalOptions, Command))
-> Parser ((GlobalOptions, Command) -> (GlobalOptions, Command))
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath
-> FilePath
-> Parser ((GlobalOptions, Command) -> (GlobalOptions, Command))
forall a. FilePath -> FilePath -> Parser (a -> a)
versionOptionParser FilePath
progName FilePath
version Parser ((GlobalOptions, Command) -> (GlobalOptions, Command))
-> Parser (GlobalOptions, Command)
-> Parser (GlobalOptions, Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) (GlobalOptions -> Command -> (GlobalOptions, Command))
-> Parser GlobalOptions
-> Parser (Command -> (GlobalOptions, Command))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GlobalOptions
globalOptionsParser Parser (Command -> (GlobalOptions, Command))
-> Parser Command -> Parser (GlobalOptions, Command)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CodebaseServerOpts -> Parser Command
commandParser CodebaseServerOpts
envOpts))
    ( InfoMod (GlobalOptions, Command)
forall a. InfoMod a
fullDesc
        InfoMod (GlobalOptions, Command)
-> InfoMod (GlobalOptions, Command)
-> InfoMod (GlobalOptions, Command)
forall a. Semigroup a => a -> a -> a
<> Maybe (Doc AnsiStyle) -> InfoMod (GlobalOptions, Command)
forall a. Maybe (Doc AnsiStyle) -> InfoMod a
headerDoc (Doc AnsiStyle -> Maybe (Doc AnsiStyle)
forall a. a -> Maybe a
Just (Doc AnsiStyle -> Maybe (Doc AnsiStyle))
-> Doc AnsiStyle -> Maybe (Doc AnsiStyle)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Doc AnsiStyle
unisonHelp FilePath
progName FilePath
version)
    )

type UsageRenderer =
  -- | Optional sub-command to render help for
  Maybe String ->
  String

-- | Parse the command description, options, and usage information from provided cli arguments.
parseCLIArgs :: String -> String -> IO (UsageRenderer, GlobalOptions, Command)
parseCLIArgs :: FilePath -> FilePath -> IO (UsageRenderer, GlobalOptions, Command)
parseCLIArgs FilePath
progName FilePath
version = do
  (Width Int
cols) <- IO Width
PT.getAvailableWidth
  CodebaseServerOpts
envOpts <- IO CodebaseServerOpts
codebaseServerOptsFromEnv
  let parserInfo :: ParserInfo (GlobalOptions, Command)
parserInfo = FilePath
-> FilePath
-> CodebaseServerOpts
-> ParserInfo (GlobalOptions, Command)
rootParserInfo FilePath
progName FilePath
version CodebaseServerOpts
envOpts
  let preferences :: ParserPrefs
preferences = PrefsMod -> ParserPrefs
prefs (PrefsMod -> ParserPrefs) -> PrefsMod -> ParserPrefs
forall a b. (a -> b) -> a -> b
$ PrefsMod
showHelpOnError PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
helpShowGlobals PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> Int -> PrefsMod
columns Int
cols PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
subparserInline
  let usage :: UsageRenderer
usage = FilePath
-> ParserInfo (GlobalOptions, Command)
-> ParserPrefs
-> UsageRenderer
forall a. FilePath -> ParserInfo a -> ParserPrefs -> UsageRenderer
renderUsage FilePath
progName ParserInfo (GlobalOptions, Command)
parserInfo ParserPrefs
preferences
  (GlobalOptions
globalOptions, Command
command) <- ParserPrefs
-> ParserInfo (GlobalOptions, Command)
-> IO (GlobalOptions, Command)
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
preferences ParserInfo (GlobalOptions, Command)
parserInfo
  (UsageRenderer, GlobalOptions, Command)
-> IO (UsageRenderer, GlobalOptions, Command)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((UsageRenderer, GlobalOptions, Command)
 -> IO (UsageRenderer, GlobalOptions, Command))
-> (UsageRenderer, GlobalOptions, Command)
-> IO (UsageRenderer, GlobalOptions, Command)
forall a b. (a -> b) -> a -> b
$ (UsageRenderer
usage, GlobalOptions
globalOptions, Command
command)

-- | Load default options from environment variables.
codebaseServerOptsFromEnv :: IO CodebaseServerOpts
codebaseServerOptsFromEnv :: IO CodebaseServerOpts
codebaseServerOptsFromEnv = do
  Maybe FilePath
token <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
Server.ucmTokenVar
  Maybe FilePath
host <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
Server.ucmHostVar
  Maybe FilePath
allowCorsHost <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
Server.ucmAllowCorsHost
  Maybe Int
port <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
Server.ucmPortVar IO (Maybe FilePath)
-> (Maybe FilePath -> Maybe Int) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Maybe FilePath -> (FilePath -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe)
  Maybe FilePath
codebaseUIPath <- FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
Server.ucmUIVar
  pure $ CodebaseServerOpts {Maybe Int
Maybe FilePath
token :: Maybe FilePath
host :: Maybe FilePath
allowCorsHost :: Maybe FilePath
port :: Maybe Int
codebaseUIPath :: Maybe FilePath
$sel:token:CodebaseServerOpts :: Maybe FilePath
$sel:host:CodebaseServerOpts :: Maybe FilePath
$sel:port:CodebaseServerOpts :: Maybe Int
$sel:allowCorsHost:CodebaseServerOpts :: Maybe FilePath
$sel:codebaseUIPath:CodebaseServerOpts :: Maybe FilePath
..}

-- | Purely renders the full help summary for the CLI, or an optional subcommand.
renderUsage :: String -> ParserInfo a -> ParserPrefs -> Maybe String -> String
renderUsage :: forall a. FilePath -> ParserInfo a -> ParserPrefs -> UsageRenderer
renderUsage FilePath
programName ParserInfo a
pInfo ParserPrefs
preferences Maybe FilePath
subCommand =
  let showHelpFailure :: ParserFailure ParserHelp
showHelpFailure = ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
forall a.
ParserPrefs
-> ParserInfo a
-> ParseError
-> [Context]
-> ParserFailure ParserHelp
parserFailure ParserPrefs
preferences ParserInfo a
pInfo (Maybe FilePath -> ParseError
ShowHelpText Maybe FilePath
subCommand) [Context]
forall a. Monoid a => a
mempty
      (FilePath
helpText, ExitCode
_exitCode) = ParserFailure ParserHelp -> FilePath -> (FilePath, ExitCode)
renderFailure ParserFailure ParserHelp
showHelpFailure FilePath
programName
   in FilePath
helpText

versionCommand :: Mod CommandFields Command
versionCommand :: Mod CommandFields Command
versionCommand = FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"version" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
versionParser (InfoMod Command
forall a. InfoMod a
fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Print the version of unison you're running"))

initCommand :: Mod CommandFields Command
initCommand :: Mod CommandFields Command
initCommand = FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"init" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
initParser (FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
initHelp))
  where
    initHelp :: FilePath
initHelp =
      FilePath
"This command is has been removed. Use --codebase-create instead to create a codebase in the specified directory when starting the UCM."

runDesc :: String -> String -> String
runDesc :: FilePath -> ShowS
runDesc FilePath
cmd FilePath
location =
  FilePath
"Execute a definition from "
    FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
location
    FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
", passing on the provided arguments. "
    FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" To pass flags to your program, use `"
    FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
cmd
    FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" -- --my-flag`"

runSymbolCommand :: Mod CommandFields Command
runSymbolCommand :: Mod CommandFields Command
runSymbolCommand =
  FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"run" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
runSymbolParser (InfoMod Command
forall a. InfoMod a
fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
help))
  where
    help :: FilePath
help =
      FilePath
"Execute a definition from the codebase, passing on the provided arguments. "
        FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" To pass flags to your program, use `run <symbol> -- --my-flag`"

runFileCommand :: Mod CommandFields Command
runFileCommand :: Mod CommandFields Command
runFileCommand =
  FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"run.file" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
runFileParser (InfoMod Command
forall a. InfoMod a
fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
help))
  where
    help :: FilePath
help =
      FilePath
"Execute a definition from a file, passing on the provided arguments. "
        FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" To pass flags to your program, use `run.file <file> -- --my-flag`"

runPipeCommand :: Mod CommandFields Command
runPipeCommand :: Mod CommandFields Command
runPipeCommand =
  FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"run.pipe" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
runPipeParser (InfoMod Command
forall a. InfoMod a
fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
help))
  where
    help :: FilePath
help =
      FilePath
"Execute a definition from stdin, passing on the provided arguments. "
        FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" To pass flags to your program, use `run -- --my-flag`"

runCompiledCommand :: Mod CommandFields Command
runCompiledCommand :: Mod CommandFields Command
runCompiledCommand =
  FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"run.compiled" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
runCompiledParser (InfoMod Command
forall a. InfoMod a
fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
help))
  where
    help :: FilePath
help =
      FilePath
"Execute a definition from a previously compiled file, passing on the provided arguments. "
        FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" To pass flags to your program, use `run <file> -- --my-flag`"

transcriptCommand :: Mod CommandFields Command
transcriptCommand :: Mod CommandFields Command
transcriptCommand =
  FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"transcript" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
transcriptParser (InfoMod Command
forall a. InfoMod a
fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
transcriptHelp InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> Maybe (Doc AnsiStyle) -> InfoMod Command
forall a. Maybe (Doc AnsiStyle) -> InfoMod a
footerDoc Maybe (Doc AnsiStyle)
transcriptFooter))
  where
    transcriptHelp :: FilePath
transcriptHelp = FilePath
"Execute transcript markdown files"
    transcriptFooter :: Maybe (Doc AnsiStyle)
transcriptFooter =
      Doc AnsiStyle -> Maybe (Doc AnsiStyle)
forall a. a -> Maybe a
Just (Doc AnsiStyle -> Maybe (Doc AnsiStyle))
-> ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle]
-> Maybe (Doc AnsiStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> Doc AnsiStyle
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> [Doc AnsiStyle]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. a -> [a] -> [a]
List.intersperse Doc AnsiStyle
forall ann. Doc ann
P.line ([Doc AnsiStyle] -> Maybe (Doc AnsiStyle))
-> [Doc AnsiStyle] -> Maybe (Doc AnsiStyle)
forall a b. (a -> b) -> a -> b
$
        [ Doc AnsiStyle
"For each <transcript>.md file provided this executes the transcript and creates" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
P.annotate AnsiStyle
bold Doc AnsiStyle
"<transcript>.output.md" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"if successful.",
          Doc AnsiStyle
"Exits after completion, and deletes the temporary directory created, unless --save-codebase is provided",
          Doc AnsiStyle
"Multiple transcript files may be provided; they are processed in sequence" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"starting from the same codebase."
        ]

transcriptForkCommand :: Mod CommandFields Command
transcriptForkCommand :: Mod CommandFields Command
transcriptForkCommand =
  FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"transcript.fork" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser Command
transcriptForkParser (InfoMod Command
forall a. InfoMod a
fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
transcriptHelp InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<> Maybe (Doc AnsiStyle) -> InfoMod Command
forall a. Maybe (Doc AnsiStyle) -> InfoMod a
footerDoc Maybe (Doc AnsiStyle)
transcriptFooter))
  where
    transcriptHelp :: FilePath
transcriptHelp = FilePath
"Execute transcript markdown files in a sandboxed codebase"
    transcriptFooter :: Maybe (Doc AnsiStyle)
transcriptFooter =
      Doc AnsiStyle -> Maybe (Doc AnsiStyle)
forall a. a -> Maybe a
Just (Doc AnsiStyle -> Maybe (Doc AnsiStyle))
-> ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle]
-> Maybe (Doc AnsiStyle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc AnsiStyle] -> Doc AnsiStyle
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> [Doc AnsiStyle]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. a -> [a] -> [a]
List.intersperse Doc AnsiStyle
forall ann. Doc ann
P.line ([Doc AnsiStyle] -> Maybe (Doc AnsiStyle))
-> [Doc AnsiStyle] -> Maybe (Doc AnsiStyle)
forall a b. (a -> b) -> a -> b
$
        [ Doc AnsiStyle
"For each <transcript>.md file provided this executes the transcript in a sandbox codebase and creates" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
P.annotate AnsiStyle
bold Doc AnsiStyle
"<transcript>.output.md" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"if successful.",
          Doc AnsiStyle
"Exits after completion, and deletes the temporary directory created, unless --save-codebase is provided",
          Doc AnsiStyle
"Multiple transcript files may be provided; they are processed in sequence" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"starting from the same codebase."
        ]

commandParser :: CodebaseServerOpts -> Parser Command
commandParser :: CodebaseServerOpts -> Parser Command
commandParser CodebaseServerOpts
envOpts =
  Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser Mod CommandFields Command
commands Parser Command -> Parser Command -> Parser Command
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CodebaseServerOpts -> IsHeadless -> Parser Command
launchParser CodebaseServerOpts
envOpts IsHeadless
WithCLI
  where
    commands :: Mod CommandFields Command
commands =
      [Mod CommandFields Command] -> Mod CommandFields Command
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
        [ Mod CommandFields Command
versionCommand,
          Mod CommandFields Command
initCommand,
          Mod CommandFields Command
runSymbolCommand,
          Mod CommandFields Command
runCompiledCommand,
          Mod CommandFields Command
runFileCommand,
          Mod CommandFields Command
runPipeCommand,
          Mod CommandFields Command
transcriptCommand,
          Mod CommandFields Command
transcriptForkCommand,
          CodebaseServerOpts -> Mod CommandFields Command
launchHeadlessCommand CodebaseServerOpts
envOpts
        ]

globalOptionsParser :: Parser GlobalOptions
globalOptionsParser :: Parser GlobalOptions
globalOptionsParser = do
  -- ApplicativeDo
  Maybe CodebasePathOption
codebasePathOption <- Parser (Maybe CodebasePathOption)
codebasePathParser Parser (Maybe CodebasePathOption)
-> Parser (Maybe CodebasePathOption)
-> Parser (Maybe CodebasePathOption)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe CodebasePathOption)
codebaseCreateParser
  ShouldExit
exitOption <- Parser ShouldExit
exitParser
  Maybe FilePath
nativeRuntimePath <- Parser (Maybe FilePath)
nativeRuntimePathFlag
  LspFormattingConfig
lspFormattingConfig <- Parser LspFormattingConfig
lspFormattingParser

  pure
    GlobalOptions {Maybe CodebasePathOption
$sel:codebasePathOption:GlobalOptions :: Maybe CodebasePathOption
codebasePathOption :: Maybe CodebasePathOption
codebasePathOption, ShouldExit
$sel:exitOption:GlobalOptions :: ShouldExit
exitOption :: ShouldExit
exitOption, Maybe FilePath
$sel:nativeRuntimePath:GlobalOptions :: Maybe FilePath
nativeRuntimePath :: Maybe FilePath
nativeRuntimePath, LspFormattingConfig
$sel:lspFormattingConfig:GlobalOptions :: LspFormattingConfig
lspFormattingConfig :: LspFormattingConfig
lspFormattingConfig}

codebasePathParser :: Parser (Maybe CodebasePathOption)
codebasePathParser :: Parser (Maybe CodebasePathOption)
codebasePathParser = do
  Maybe FilePath
optString <-
    Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
      FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"codebase"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c'
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"CODEBASE/PATH"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The path to an existing codebase"
  pure ((FilePath -> CodebasePathOption)
-> Maybe FilePath -> Maybe CodebasePathOption
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> CodebasePathOption
DontCreateCodebaseWhenMissing Maybe FilePath
optString)

codebaseCreateParser :: Parser (Maybe CodebasePathOption)
codebaseCreateParser :: Parser (Maybe CodebasePathOption)
codebaseCreateParser = do
  Maybe FilePath
path <-
    Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
      FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"codebase-create"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'C'
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"CODEBASE/PATH"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The path to a new or existing codebase (one will be created if there isn't one)"
  pure ((FilePath -> CodebasePathOption)
-> Maybe FilePath -> Maybe CodebasePathOption
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> CodebasePathOption
CreateCodebaseWhenMissing Maybe FilePath
path)

exitParser :: Parser ShouldExit
exitParser :: Parser ShouldExit
exitParser = ShouldExit
-> ShouldExit -> Mod FlagFields ShouldExit -> Parser ShouldExit
forall a. a -> a -> Mod FlagFields a -> Parser a
flag ShouldExit
DoNotExit ShouldExit
Exit (FilePath -> Mod FlagFields ShouldExit
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"exit" Mod FlagFields ShouldExit
-> Mod FlagFields ShouldExit -> Mod FlagFields ShouldExit
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields ShouldExit
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
exitHelp)
  where
    exitHelp :: FilePath
exitHelp = FilePath
"Exit repl after the command."

lspFormattingParser :: Parser LspFormattingConfig
lspFormattingParser :: Parser LspFormattingConfig
lspFormattingParser = LspFormattingConfig
-> LspFormattingConfig
-> Mod FlagFields LspFormattingConfig
-> Parser LspFormattingConfig
forall a. a -> a -> Mod FlagFields a -> Parser a
flag LspFormattingConfig
LspFormatDisabled LspFormattingConfig
LspFormatEnabled (FilePath -> Mod FlagFields LspFormattingConfig
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"lsp-format" Mod FlagFields LspFormattingConfig
-> Mod FlagFields LspFormattingConfig
-> Mod FlagFields LspFormattingConfig
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields LspFormattingConfig
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
lspFormatHelp)
  where
    lspFormatHelp :: FilePath
lspFormatHelp = FilePath
"[Experimental] Enable formatting of source files via LSP."

versionOptionParser :: String -> String -> Parser (a -> a)
versionOptionParser :: forall a. FilePath -> FilePath -> Parser (a -> a)
versionOptionParser FilePath
progName FilePath
version =
  FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (FilePath
progName FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" version: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
version) (Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show version")

launchHeadlessCommand :: CodebaseServerOpts -> Mod CommandFields Command
launchHeadlessCommand :: CodebaseServerOpts -> Mod CommandFields Command
launchHeadlessCommand CodebaseServerOpts
envOpts =
  FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"headless" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (CodebaseServerOpts -> IsHeadless -> Parser Command
launchParser CodebaseServerOpts
envOpts IsHeadless
Headless) (FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
headlessHelp))
  where
    headlessHelp :: FilePath
headlessHelp = FilePath
"Runs the codebase server without the command-line interface."

codebaseServerOptsParser :: CodebaseServerOpts -> Parser CodebaseServerOpts
codebaseServerOptsParser :: CodebaseServerOpts -> Parser CodebaseServerOpts
codebaseServerOptsParser CodebaseServerOpts
envOpts = do
  -- ApplicativeDo
  Maybe FilePath
cliToken <- Parser (Maybe FilePath)
tokenFlag Parser (Maybe FilePath)
-> Parser (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FilePath -> Parser (Maybe FilePath)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodebaseServerOpts -> Maybe FilePath
token CodebaseServerOpts
envOpts)
  Maybe FilePath
cliHost <- Parser (Maybe FilePath)
hostFlag Parser (Maybe FilePath)
-> Parser (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FilePath -> Parser (Maybe FilePath)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodebaseServerOpts -> Maybe FilePath
host CodebaseServerOpts
envOpts)
  Maybe Int
cliPort <- Parser (Maybe Int)
portFlag Parser (Maybe Int) -> Parser (Maybe Int) -> Parser (Maybe Int)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> Parser (Maybe Int)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodebaseServerOpts -> Maybe Int
port CodebaseServerOpts
envOpts)
  Maybe FilePath
cliAllowCorsHost <- Parser (Maybe FilePath)
allowCorsHostFlag Parser (Maybe FilePath)
-> Parser (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FilePath -> Parser (Maybe FilePath)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodebaseServerOpts -> Maybe FilePath
allowCorsHost CodebaseServerOpts
envOpts)
  Maybe FilePath
cliCodebaseUIPath <- Parser (Maybe FilePath)
codebaseUIPathFlag Parser (Maybe FilePath)
-> Parser (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FilePath -> Parser (Maybe FilePath)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodebaseServerOpts -> Maybe FilePath
codebaseUIPath CodebaseServerOpts
envOpts)
  pure
    CodebaseServerOpts
      { $sel:token:CodebaseServerOpts :: Maybe FilePath
token = Maybe FilePath
cliToken Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CodebaseServerOpts -> Maybe FilePath
token CodebaseServerOpts
envOpts,
        $sel:host:CodebaseServerOpts :: Maybe FilePath
host = Maybe FilePath
cliHost Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CodebaseServerOpts -> Maybe FilePath
host CodebaseServerOpts
envOpts,
        $sel:port:CodebaseServerOpts :: Maybe Int
port = Maybe Int
cliPort Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CodebaseServerOpts -> Maybe Int
port CodebaseServerOpts
envOpts,
        $sel:allowCorsHost:CodebaseServerOpts :: Maybe FilePath
allowCorsHost = Maybe FilePath
cliAllowCorsHost Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CodebaseServerOpts -> Maybe FilePath
allowCorsHost CodebaseServerOpts
envOpts,
        $sel:codebaseUIPath:CodebaseServerOpts :: Maybe FilePath
codebaseUIPath = Maybe FilePath
cliCodebaseUIPath Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CodebaseServerOpts -> Maybe FilePath
codebaseUIPath CodebaseServerOpts
envOpts
      }
  where
    tokenFlag :: Parser (Maybe FilePath)
tokenFlag =
      Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
        FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"token"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"STRING"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"API auth token"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall (f :: * -> *) a. Mod f a
noGlobal
    hostFlag :: Parser (Maybe FilePath)
hostFlag =
      Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
        FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"host"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"STRING"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Codebase server host"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall (f :: * -> *) a. Mod f a
noGlobal
    portFlag :: Parser (Maybe Int)
portFlag =
      Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Int -> Parser (Maybe Int))
-> (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int
-> Parser (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (Mod OptionFields Int -> Parser (Maybe Int))
-> Mod OptionFields Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$
        FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"port"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NUMBER"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Codebase server port"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall (f :: * -> *) a. Mod f a
noGlobal
    allowCorsHostFlag :: Parser (Maybe FilePath)
allowCorsHostFlag =
      Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
        FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"allow-cors-host"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"STRING"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Host that should be allowed to access api (cors)"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall (f :: * -> *) a. Mod f a
noGlobal
    codebaseUIPathFlag :: Parser (Maybe FilePath)
codebaseUIPathFlag =
      Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
        FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"ui"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to codebase ui root"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall (f :: * -> *) a. Mod f a
noGlobal

launchParser :: CodebaseServerOpts -> IsHeadless -> Parser Command
launchParser :: CodebaseServerOpts -> IsHeadless -> Parser Command
launchParser CodebaseServerOpts
envOpts IsHeadless
isHeadless = do
  -- ApplicativeDo
  CodebaseServerOpts
codebaseServerOpts <- CodebaseServerOpts -> Parser CodebaseServerOpts
codebaseServerOptsParser CodebaseServerOpts
envOpts
  Maybe (ProjectAndBranch ProjectName ProjectBranchName)
startingProject <- Parser (Maybe (ProjectAndBranch ProjectName ProjectBranchName))
startingProjectOption
  ShouldWatchFiles
shouldWatchFiles <- Parser ShouldWatchFiles
noFileWatchFlag
  pure (IsHeadless
-> CodebaseServerOpts
-> Maybe (ProjectAndBranch ProjectName ProjectBranchName)
-> ShouldWatchFiles
-> Command
Launch IsHeadless
isHeadless CodebaseServerOpts
codebaseServerOpts Maybe (ProjectAndBranch ProjectName ProjectBranchName)
startingProject ShouldWatchFiles
shouldWatchFiles)

initParser :: Parser Command
initParser :: Parser Command
initParser = Command -> Parser Command
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Init

versionParser :: Parser Command
versionParser :: Parser Command
versionParser = Command -> Parser Command
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
PrintVersion

runArgumentParser :: Parser [String]
runArgumentParser :: Parser [FilePath]
runArgumentParser = Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"RUN-ARGS"))

runHQParser :: Parser (HashQualified Name)
runHQParser :: Parser (HashQualified Name)
runHQParser =
  ReadM (HashQualified Name)
-> Mod ArgumentFields (HashQualified Name)
-> Parser (HashQualified Name)
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ((FilePath -> Maybe (HashQualified Name))
-> ReadM (HashQualified Name)
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader (Text -> Maybe (HashQualified Name)
HQ.parseText (Text -> Maybe (HashQualified Name))
-> (FilePath -> Text) -> FilePath -> Maybe (HashQualified Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack)) (FilePath -> Mod ArgumentFields (HashQualified Name)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SYMBOL")

runProjectPathParser :: Parser PP.ProjectPathNames
runProjectPathParser :: Parser ProjectPathNames
runProjectPathParser =
  ReadM ProjectPathNames
-> Mod ArgumentFields ProjectPathNames -> Parser ProjectPathNames
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ((FilePath -> Maybe ProjectPathNames) -> ReadM ProjectPathNames
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader (Either Text ProjectPathNames -> Maybe ProjectPathNames
forall a b. Either a b -> Maybe b
eitherToMaybe (Either Text ProjectPathNames -> Maybe ProjectPathNames)
-> (FilePath -> Either Text ProjectPathNames)
-> FilePath
-> Maybe ProjectPathNames
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text ProjectPathNames
PP.parseProjectPath (Text -> Either Text ProjectPathNames)
-> (FilePath -> Text) -> FilePath -> Either Text ProjectPathNames
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack)) (FilePath -> Mod ArgumentFields ProjectPathNames
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"@myproject/mybranch:.path.in.project")

runSymbolParser :: Parser Command
runSymbolParser :: Parser Command
runSymbolParser =
  RunSource -> [FilePath] -> Command
Run (RunSource -> [FilePath] -> Command)
-> (ProjectPathNames -> RunSource)
-> ProjectPathNames
-> [FilePath]
-> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectPathNames -> RunSource
RunFromSymbol (ProjectPathNames -> [FilePath] -> Command)
-> Parser ProjectPathNames -> Parser ([FilePath] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ProjectPathNames
runProjectPathParser Parser ([FilePath] -> Command)
-> Parser [FilePath] -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
runArgumentParser

runFileParser :: Parser Command
runFileParser :: Parser Command
runFileParser =
  RunSource -> [FilePath] -> Command
Run
    (RunSource -> [FilePath] -> Command)
-> Parser RunSource -> Parser ([FilePath] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( FilePath -> HashQualified Name -> RunSource
RunFromFile
            (FilePath -> HashQualified Name -> RunSource)
-> Parser FilePath -> Parser (HashQualified Name -> RunSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Parser FilePath
fileArgument FilePath
"path/to/file"
            Parser (HashQualified Name -> RunSource)
-> Parser (HashQualified Name) -> Parser RunSource
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (HashQualified Name)
runHQParser
        )
    Parser ([FilePath] -> Command)
-> Parser [FilePath] -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
runArgumentParser

runPipeParser :: Parser Command
runPipeParser :: Parser Command
runPipeParser =
  RunSource -> [FilePath] -> Command
Run (RunSource -> [FilePath] -> Command)
-> (HashQualified Name -> RunSource)
-> HashQualified Name
-> [FilePath]
-> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> RunSource
RunFromPipe (HashQualified Name -> [FilePath] -> Command)
-> Parser (HashQualified Name) -> Parser ([FilePath] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (HashQualified Name)
runHQParser Parser ([FilePath] -> Command)
-> Parser [FilePath] -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
runArgumentParser

runCompiledParser :: Parser Command
runCompiledParser :: Parser Command
runCompiledParser =
  RunSource -> [FilePath] -> Command
Run (RunSource -> [FilePath] -> Command)
-> (FilePath -> RunSource) -> FilePath -> [FilePath] -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RunSource
RunCompiled (FilePath -> [FilePath] -> Command)
-> Parser FilePath -> Parser ([FilePath] -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Parser FilePath
fileArgument FilePath
"path/to/file" Parser ([FilePath] -> Command)
-> Parser [FilePath] -> Parser Command
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [FilePath]
runArgumentParser

rtsStatsOption :: Parser (Maybe RtsStatsPath)
rtsStatsOption :: Parser (Maybe RtsStatsPath)
rtsStatsOption =
  let meta :: Mod OptionFields a
meta =
        FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE.json"
          Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"rts-stats"
          Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields a
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Write json summary of rts stats to FILE"
          Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields a
forall (f :: * -> *) a. Mod f a
noGlobal
   in Parser RtsStatsPath -> Parser (Maybe RtsStatsPath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM RtsStatsPath
-> Mod OptionFields RtsStatsPath -> Parser RtsStatsPath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM RtsStatsPath
forall s. IsString s => ReadM s
OptParse.str Mod OptionFields RtsStatsPath
forall {a}. Mod OptionFields a
meta)

saveCodebaseFlag :: Parser ShouldSaveCodebase
saveCodebaseFlag :: Parser ShouldSaveCodebase
saveCodebaseFlag = ShouldSaveCodebase
-> ShouldSaveCodebase
-> Mod FlagFields ShouldSaveCodebase
-> Parser ShouldSaveCodebase
forall a. a -> a -> Mod FlagFields a -> Parser a
flag ShouldSaveCodebase
DontSaveCodebase (Maybe FilePath -> ShouldSaveCodebase
SaveCodebase Maybe FilePath
forall a. Maybe a
Nothing) (FilePath -> Mod FlagFields ShouldSaveCodebase
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"save-codebase" Mod FlagFields ShouldSaveCodebase
-> Mod FlagFields ShouldSaveCodebase
-> Mod FlagFields ShouldSaveCodebase
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields ShouldSaveCodebase
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
saveHelp)
  where
    saveHelp :: FilePath
saveHelp = FilePath
"if set the resulting codebase will be saved to a new directory, otherwise it will be deleted"

saveCodebaseToFlag :: Parser ShouldSaveCodebase
saveCodebaseToFlag :: Parser ShouldSaveCodebase
saveCodebaseToFlag = do
  Maybe FilePath
path <-
    Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
      FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"save-codebase-to"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'S'
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Where the codebase should be created. Implies --save-codebase"
  pure
    ( case Maybe FilePath
path of
        Just FilePath
_ -> Maybe FilePath -> ShouldSaveCodebase
SaveCodebase Maybe FilePath
path
        Maybe FilePath
_ -> ShouldSaveCodebase
DontSaveCodebase
    )

startingProjectOption :: Parser (Maybe (ProjectAndBranch ProjectName ProjectBranchName))
startingProjectOption :: Parser (Maybe (ProjectAndBranch ProjectName ProjectBranchName))
startingProjectOption =
  let meta :: Mod OptionFields a
meta =
        FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"project/branch"
          Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"project"
          Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
          Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields a
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Launch the UCM session at the provided project and branch."
          Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields a
forall (f :: * -> *) a. Mod f a
noGlobal
   in Parser (ProjectAndBranch ProjectName ProjectBranchName)
-> Parser (Maybe (ProjectAndBranch ProjectName ProjectBranchName))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM (ProjectAndBranch ProjectName ProjectBranchName)
-> Mod
     OptionFields (ProjectAndBranch ProjectName ProjectBranchName)
-> Parser (ProjectAndBranch ProjectName ProjectBranchName)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (ProjectAndBranch ProjectName ProjectBranchName)
readProjectAndBranchNames Mod OptionFields (ProjectAndBranch ProjectName ProjectBranchName)
forall {a}. Mod OptionFields a
meta)

noFileWatchFlag :: Parser ShouldWatchFiles
noFileWatchFlag :: Parser ShouldWatchFiles
noFileWatchFlag =
  ShouldWatchFiles
-> ShouldWatchFiles
-> Mod FlagFields ShouldWatchFiles
-> Parser ShouldWatchFiles
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
    ShouldWatchFiles
ShouldWatchFiles
    ShouldWatchFiles
ShouldNotWatchFiles
    ( FilePath -> Mod FlagFields ShouldWatchFiles
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-file-watch"
        Mod FlagFields ShouldWatchFiles
-> Mod FlagFields ShouldWatchFiles
-> Mod FlagFields ShouldWatchFiles
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields ShouldWatchFiles
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
noFileWatchHelp
        Mod FlagFields ShouldWatchFiles
-> Mod FlagFields ShouldWatchFiles
-> Mod FlagFields ShouldWatchFiles
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields ShouldWatchFiles
forall (f :: * -> *) a. Mod f a
noGlobal
    )
  where
    noFileWatchHelp :: FilePath
noFileWatchHelp = FilePath
"If set, ucm will not respond to changes in unison files. Instead, you can use the 'load' command."

readAbsolutePath :: ReadM Path.Absolute
readAbsolutePath :: ReadM Absolute
readAbsolutePath = do
  ReadM Path'
readPath' ReadM Path' -> (Path' -> ReadM Absolute) -> ReadM Absolute
forall a b. ReadM a -> (a -> ReadM b) -> ReadM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Path.AbsolutePath' Absolute
abs -> Absolute -> ReadM Absolute
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Absolute
abs
    Path.RelativePath' Relative
rel ->
      FilePath -> ReadM Absolute
forall a. FilePath -> ReadM a
OptParse.readerError (FilePath -> ReadM Absolute) -> FilePath -> ReadM Absolute
forall a b. (a -> b) -> a -> b
$
        FilePath
"Expected an absolute path, but the path "
          FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Relative -> FilePath
forall a. Show a => a -> FilePath
show Relative
rel
          FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" was relative. Try adding a `.` prefix, e.g. `.path.to.project`"

nativeRuntimePathFlag :: Parser (Maybe FilePath)
nativeRuntimePathFlag :: Parser (Maybe FilePath)
nativeRuntimePathFlag =
  Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath
-> Parser (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser (Maybe FilePath))
-> Mod OptionFields FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$
    FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"runtime-path"
      Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
      Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to native runtime files"
      Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall (f :: * -> *) a. Mod f a
noGlobal

readPath' :: ReadM Path.Path'
readPath' :: ReadM Path'
readPath' = do
  FilePath
strPath <- ReadM FilePath
forall s. IsString s => ReadM s
OptParse.str
  case FilePath -> Either Text Path'
Path.parsePath' FilePath
strPath of
    Left Text
err -> FilePath -> ReadM Path'
forall a. FilePath -> ReadM a
OptParse.readerError (Text -> FilePath
Text.unpack Text
err)
    Right Path'
path' -> Path' -> ReadM Path'
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path'
path'

readProjectAndBranchNames :: ReadM (ProjectAndBranch ProjectName ProjectBranchName)
readProjectAndBranchNames :: ReadM (ProjectAndBranch ProjectName ProjectBranchName)
readProjectAndBranchNames = do
  Text
str <- ReadM Text
forall s. IsString s => ReadM s
OptParse.str
  case Parsec Void Text (ProjectAndBranch ProjectName ProjectBranchName)
-> FilePath
-> Text
-> Either
     (ParseErrorBundle Text Void)
     (ProjectAndBranch ProjectName ProjectBranchName)
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
Megaparsec.parse Parsec Void Text (ProjectAndBranch ProjectName ProjectBranchName)
Project.fullyQualifiedProjectAndBranchNamesParser FilePath
"arg" Text
str of
    Left ParseErrorBundle Text Void
errBundle -> FilePath -> ReadM (ProjectAndBranch ProjectName ProjectBranchName)
forall a. FilePath -> ReadM a
OptParse.readerError (FilePath
 -> ReadM (ProjectAndBranch ProjectName ProjectBranchName))
-> FilePath
-> ReadM (ProjectAndBranch ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
Megaparsec.errorBundlePretty ParseErrorBundle Text Void
errBundle
    Right ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch -> ProjectAndBranch ProjectName ProjectBranchName
-> ReadM (ProjectAndBranch ProjectName ProjectBranchName)
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectAndBranch ProjectName ProjectBranchName
projectAndBranch

fileArgument :: String -> Parser FilePath
fileArgument :: FilePath -> Parser FilePath
fileArgument FilePath
varName =
  Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
    ( FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
varName
        Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"file" -- Autocomplete file names
    )

transcriptParser :: Parser Command
transcriptParser :: Parser Command
transcriptParser = do
  -- ApplicativeDo
  ShouldSaveCodebase
shouldSaveCodebaseTo <- Parser ShouldSaveCodebase
saveCodebaseToFlag
  ShouldSaveCodebase
shouldSaveCodebase <- Parser ShouldSaveCodebase
saveCodebaseFlag
  Maybe RtsStatsPath
mrtsStatsFp <- Parser (Maybe RtsStatsPath)
rtsStatsOption
  NonEmpty FilePath
files <- (FilePath -> [FilePath] -> NonEmpty FilePath)
-> Parser FilePath
-> Parser [FilePath]
-> Parser (NonEmpty FilePath)
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 FilePath -> [FilePath] -> NonEmpty FilePath
forall a. a -> [a] -> NonEmpty a
(NE.:|) (FilePath -> Parser FilePath
fileArgument FilePath
"FILE") (Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (FilePath -> Parser FilePath
fileArgument FilePath
"FILES..."))
  pure
    ( let saveCodebase :: ShouldSaveCodebase
saveCodebase = case ShouldSaveCodebase
shouldSaveCodebaseTo of
            ShouldSaveCodebase
DontSaveCodebase -> ShouldSaveCodebase
shouldSaveCodebase
            ShouldSaveCodebase
_ -> ShouldSaveCodebase
shouldSaveCodebaseTo
       in ShouldForkCodebase
-> ShouldSaveCodebase
-> Maybe RtsStatsPath
-> NonEmpty FilePath
-> Command
Transcript ShouldForkCodebase
DontFork ShouldSaveCodebase
saveCodebase Maybe RtsStatsPath
mrtsStatsFp NonEmpty FilePath
files
    )

transcriptForkParser :: Parser Command
transcriptForkParser :: Parser Command
transcriptForkParser = do
  -- ApplicativeDo
  ShouldSaveCodebase
shouldSaveCodebaseTo <- Parser ShouldSaveCodebase
saveCodebaseToFlag
  ShouldSaveCodebase
shouldSaveCodebase <- Parser ShouldSaveCodebase
saveCodebaseFlag
  Maybe RtsStatsPath
mrtsStatsFp <- Parser (Maybe RtsStatsPath)
rtsStatsOption
  NonEmpty FilePath
files <- (FilePath -> [FilePath] -> NonEmpty FilePath)
-> Parser FilePath
-> Parser [FilePath]
-> Parser (NonEmpty FilePath)
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 FilePath -> [FilePath] -> NonEmpty FilePath
forall a. a -> [a] -> NonEmpty a
(NE.:|) (FilePath -> Parser FilePath
fileArgument FilePath
"FILE") (Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (FilePath -> Parser FilePath
fileArgument FilePath
"FILES..."))
  pure
    ( let saveCodebase :: ShouldSaveCodebase
saveCodebase = case ShouldSaveCodebase
shouldSaveCodebaseTo of
            ShouldSaveCodebase
DontSaveCodebase -> ShouldSaveCodebase
shouldSaveCodebase
            ShouldSaveCodebase
_ -> ShouldSaveCodebase
shouldSaveCodebaseTo
       in ShouldForkCodebase
-> ShouldSaveCodebase
-> Maybe RtsStatsPath
-> NonEmpty FilePath
-> Command
Transcript ShouldForkCodebase
UseFork ShouldSaveCodebase
saveCodebase Maybe RtsStatsPath
mrtsStatsFp NonEmpty FilePath
files
    )

unisonHelp :: String -> String -> P.Doc
unisonHelp :: FilePath -> FilePath -> Doc AnsiStyle
unisonHelp (FilePath -> Doc AnsiStyle
forall a. IsString a => FilePath -> a
fromString -> Doc AnsiStyle
executable) (FilePath -> Doc AnsiStyle
forall a. IsString a => FilePath -> a
fromString -> Doc AnsiStyle
version) =
  [Doc AnsiStyle] -> Doc AnsiStyle
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Doc AnsiStyle] -> Doc AnsiStyle)
-> ([Doc AnsiStyle] -> [Doc AnsiStyle])
-> [Doc AnsiStyle]
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. a -> [a] -> [a]
List.intersperse Doc AnsiStyle
forall ann. Doc ann
P.line ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$
    [ Doc AnsiStyle
forall a. Monoid a => a
mempty,
      Doc AnsiStyle
"🌻",
      Doc AnsiStyle
forall a. Monoid a => a
mempty,
      AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
P.annotate AnsiStyle
P.bold Doc AnsiStyle
"Usage instructions for the Unison Codebase Manager",
      Doc AnsiStyle
"You are running version:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
version,
      Doc AnsiStyle
forall a. Monoid a => a
mempty,
      Doc AnsiStyle
"To get started just run" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
P.annotate AnsiStyle
P.bold Doc AnsiStyle
executable,
      Doc AnsiStyle
forall a. Monoid a => a
mempty,
      Doc AnsiStyle
"Use" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
P.annotate AnsiStyle
P.bold (Doc AnsiStyle
executable Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"[command] --help") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"to show help for a command."
    ]