Re-use work from #1426, thanks @shmish111

Co-authored-by: shmish111 <shmish111+github@gmail.com>

CONTRIBUTORS.markdown

@@ -55,3 +55,5 @@ The format for this list: name, GitHub handle, and then optional blurb about wha
 * Tavish Pegram (@tapegram)
 * Javier Neira (@jneira)
 * Simon Højberg (@hojberg)
+* David Smith (@shmish111)
+* Chris Penner (@ChrisPenner)

parser-typechecker/package.yaml

@@ -32,6 +32,7 @@ library:
   dependencies:
     - aeson
     - ansi-terminal
+    - ansi-wl-pprint
     - async
     - base
     - base16 >= 0.2.1.0

parser-typechecker/src/Unison/CommandLine/ArgParse.hs

@@ -0,0 +1,117 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- The Options module defines the command line options available when invoking unison
+--
+-- It is built using https://hackage.haskell.org/package/optparse-applicative
+-- which has a pretty good guide that should explain everything in this module
+module Unison.CommandLine.ArgParse where
+
+import Control.Applicative ((<**>), (<|>), some)
+import Options.Applicative
+import Text.PrettyPrint.ANSI.Leijen ((<$$>), (<+>), (</>), Doc, bold, hardline)
+import Data.Foldable
+
+-- Unfortunately we can't use a global --codebase option so we have
+-- to add it to all Commands that needs it
+-- see https://github.com/pcapriotti/optparse-applicative/issues/294
+type Codebase = Maybe FilePath
+
+data Command
+  = Launch Codebase
+  | Version
+  | Init Codebase
+  | Run Codebase (Maybe FilePath) Stdin String
+  | Transcript Codebase Fork SaveCodebase [FilePath]
+  deriving (Show)
+
+newtype Stdin = Stdin Bool
+  deriving (Show)
+
+newtype Fork = Fork Bool
+  deriving (Show)
+
+newtype SaveCodebase = SaveCodebase Bool
+  deriving (Show)
+
+options :: ParserInfo Command
+options = info (options' <**> helper) (progDescDoc unisonHelp)
+
+unisonHelp :: Maybe Doc
+unisonHelp =
+  Just $
+    "Usage instructions for the Unison Codebase Manager"
+      <> hardline
+      <> hardline
+      <> "To get started just run " <+> bold "unison" <+> "to enter interactive mode"
+      <$$> mempty
+      </> "Unison has various sub-commands (see Available commands) but by default will run in interactive mode"
+      </> "Use" <+> bold "unison command --help" <+> "to show help for a command"
+      <> hardline
+      <> hardline
+      <> "Most commands take the option" <+> bold "--codebase" <+> "which expects a path to a unison codebase"
+      </> "If none is provided then the home directory is used"
+
+codebaseHelp :: Maybe Doc
+codebaseHelp = Just "The path to the codebase, defaults to the home directory"
+
+options' :: Parser Command
+options' =
+  hsubparser commands <|> launchCommand
+  where
+    commands = 
+      fold [ versionCommand
+           , initCommand
+           , runCommand
+           , transcriptCommand
+           ]
+
+versionCommand :: Mod CommandFields Command
+versionCommand = command "version" (info (pure Version) (progDesc "print the version of unison"))
+
+initCommand :: Mod CommandFields Command
+initCommand = command "init" (info (Init <$> optional (strOption (long "codebase" <> helpDoc codebaseHelp))) (progDesc initHelp))
+  where
+    initHelp = "Initialise a unison codebase"
+
+runCommand :: Mod CommandFields Command
+runCommand = command "run" (info run (progDescDoc runHelp))
+  where
+    runHelp = Just "Execute a definition from a file, stdin or the codebase"
+
+transcriptCommand :: Mod CommandFields Command
+transcriptCommand = command "transcript" (info transcript (progDesc transcriptHelp <> footerDoc transcriptFooter))
+  where
+    transcriptHelp = "Execute transcript markdown files"
+    transcriptFooter =
+      Just $
+        "For each transcript file provided this executes the transcript and creates"
+          <+> bold "mytranscript.output.md"
+          <+> "if successful."
+          </> "Exits after completion, and deletes the temporary directory created."
+          </> "Multiple transcript files may be provided; they are processed in sequence"
+          <+> "starting from the same codebase."
+
+launchCommand :: Parser Command
+launchCommand = (Launch <$> optional (strOption (long "codebase" <> helpDoc codebaseHelp)))
+
+run :: Parser Command
+run =
+  Run <$> optional (strOption (long "codebase" <> helpDoc codebaseHelp))
+    <*> optional (strOption (long "file" <> helpDoc fileHelp))
+    <*> (Stdin <$> switch (long "stdin" <> helpDoc pipeHelp))
+    <*> strArgument (help mainHelp <> metavar ".mylib.mymain")
+  where
+    fileHelp = Just $ "the file containing" <+> bold ".mylib.mymain" <+> "- if not provided then the codebase will be used"
+    pipeHelp = Just $ "read the definition from stdin, usefull for piping to unison"
+    mainHelp = "the main method"
+
+transcript :: Parser Command
+transcript =
+  Transcript <$> optional (strOption (long "codebase" <> helpDoc codebaseHelp))
+    <*> (Fork <$> switch (long "fork" <> helpDoc forkHelp))
+    <*> (SaveCodebase <$> switch (long "save-codebase" <> helpDoc saveHelp))
+    <*> some (strArgument (metavar "transcriptfiles..."))
+  where
+    forkHelp = Just "if set the transcript is executed in a copy of the current codebase"
+    saveHelp = Just "if set the resulting codebase will be saved to a new directory, otherwise it will be deleted"

parser-typechecker/unison-parser-typechecker.cabal

@@ -80,6 +80,7 @@ library
       Unison.Codebase.TypeEdit
       Unison.Codebase.Watch
       Unison.CommandLine
+      Unison.CommandLine.ArgParse
       Unison.CommandLine.DisplayValues
       Unison.CommandLine.InputPattern
       Unison.CommandLine.InputPatterns
@@ -180,6 +181,7 @@ library
       ListLike
     , aeson
     , ansi-terminal
+    , ansi-wl-pprint
     , async
     , base
     , base16 >=0.2.1.0

parser-typechecker/unison/Main.hs

@@ -54,74 +54,10 @@ import qualified Unison.Util.Pretty as P
 import qualified Version
 import qualified Unison.Codebase.Conversion.Upgrade12 as Upgrade12
 
-usage :: String -> P.Pretty P.ColorText
-usage executableStr = P.callout "🌻" $ P.lines [
-  P.bold "Usage instructions for the Unison Codebase Manager",
-  "You are running version: " <> P.string Version.gitDescribe,
-  "",
-  P.bold executable,
-  P.wrap "Starts Unison interactively, using the codebase in the home directory.",
-  "",
-  P.bold $ executable <> " -codebase path/to/codebase",
-  P.wrap "Starts Unison interactively, using the specified codebase. This flag can also be set before any of the below commands.",
-  "",
-  P.bold $ executable <> " --old-codebase",
-  P.wrap $ "Starts Unison using a v1 codebase. This flag can also be set before any of the below commands.",
-  "",
-  P.bold $ executable <> " run .mylib.mymain",
-  P.wrap "Executes the definition `.mylib.mymain` from the codebase, then exits.",
-  "",
-  P.bold $ executable <> " run.file foo.u mymain",
-  P.wrap "Executes the definition called `mymain` in `foo.u`, then exits.",
-  "",
-  P.bold $ executable <> " run.pipe mymain",
-  P.wrap "Executes the definition called `mymain` from a `.u` file read from the standard input, then exits.",
-  "",
-  P.bold $ executable <> " transcript mytranscript.md",
-  P.wrap $ "Executes the `mytranscript.md` transcript and creates"
-        <> "`mytranscript.output.md` if successful. Exits after completion, and deletes"
-        <> "the temporary directory created."
-        <> "Multiple transcript files may be provided; they are processed in sequence"
-        <> "starting from the same codebase.",
-  "",
-  P.bold $ executable <> " transcript -save-codebase mytranscript.md",
-  P.wrap $ "Executes the `mytranscript.md` transcript and creates"
-        <> "`mytranscript.output.md` if successful. Exits after completion, and saves"
-        <> "the resulting codebase to a new directory on disk."
-        <> "Multiple transcript files may be provided; they are processed in sequence"
-        <> "starting from the same codebase.",
-  "",
-  P.bold $ executable <> " transcript.fork mytranscript.md",
-  P.wrap $ "Executes the `mytranscript.md` transcript in a copy of the current codebase"
-        <> "and creates `mytranscript.output.md` if successful. Exits after completion."
-        <> "Multiple transcript files may be provided; they are processed in sequence"
-        <> "starting from the same codebase.",
-  "",
-  P.bold $ executable <> " transcript.fork -save-codebase mytranscript.md",
-  P.wrap $ "Executes the `mytranscript.md` transcript in a copy of the current codebase"
-        <> "and creates `mytranscript.output.md` if successful. Exits after completion,"
-        <> "and saves the resulting codebase to a new directory on disk."
-        <> "Multiple transcript files may be provided; they are processed in sequence"
-        <> "starting from the same codebase.",
-  "",
-  P.bold $ executable <> " upgrade-codebase",
-  "Upgrades a v1 codebase to a v2 codebase.",
-  "",
-  P.bold $ executable <> " headless",
-  "Runs the codebase server without the command-line interface.",
-  "",
-  P.bold $ executable <> " version",
-  "Prints version of Unison then quits.",
-  "",
-  P.bold $ executable <> " help",
-  "Prints this help."]
-      where executable = (P.text . Text.pack) executableStr
-
 installSignalHandlers :: IO ()
 installSignalHandlers = do
   main_thread <- myThreadId
   wtid <- mkWeakThreadId main_thread
-
   let interrupt = do
         r <- deRefWeak wtid
         case r of
@@ -137,7 +73,6 @@ installSignalHandlers = do
   _ <- Sig.installHandler Sig.sigQUIT  (Sig.Catch interrupt) Nothing
   _ <- Sig.installHandler Sig.sigINT   (Sig.Catch interrupt) Nothing
 #endif
-
   return ()
 
 
@@ -152,7 +87,8 @@ main = do
   progName <- getProgName
   -- hSetBuffering stdout NoBuffering -- cool
 
-  _ <- installSignalHandlers
+  void installSignalHandlers
+  option <- customExecParser (prefs showHelpOnError) Options.options
   -- We need to know whether the program was invoked with -codebase for
   -- certain messages. Therefore we keep a Maybe FilePath - mcodepath
   -- rather than just deciding on whether to use the supplied path or