juvix/app/TopCommand/Options.hs

module TopCommand.Options where

import Commands.Compile.Options
import Commands.Dev.Options qualified as Dev
import Commands.Doctor.Options
import Commands.Eval.Options
import Commands.Format.Options
import Commands.Html.Options
import Commands.Repl.Options
import Commands.Typecheck.Options
import CommonOptions hiding (Doc)
import Data.Generics.Uniplate.Data
import GlobalOptions
import Options.Applicative.Help.Pretty

data TopCommand
  = DisplayVersion
  | DisplayNumericVersion
  | DisplayHelp
  | Typecheck TypecheckOptions
  | Compile CompileOptions
  | Clean
  | Eval EvalOptions
  | Html HtmlOptions
  | Dev Dev.DevCommand
  | Doctor DoctorOptions
  | Init
  | JuvixRepl ReplOptions
  | JuvixFormat FormatOptions
  deriving stock (Data)

topCommandInputPath :: TopCommand -> IO (Maybe (SomePath Abs))
topCommandInputPath (JuvixFormat fopts) = case fopts ^. formatInput of
  Just f -> getInputPathFromPrepathFileOrDir f
  Nothing -> return Nothing
topCommandInputPath t = do
  d <- firstJustM getInputFileOrDir (universeBi t)
  f <- firstJustM getInputFile (universeBi t)
  return (f <|> d)
  where
    getInputFile :: AppPath File -> IO (Maybe (SomePath Abs))
    getInputFile p
      | p ^. pathIsInput = do
          cwd <- getCurrentDir
          Just . File <$> prepathToAbsFile cwd (p ^. pathPath)
      | otherwise = return Nothing

    getInputFileOrDir :: AppPath FileOrDir -> IO (Maybe (SomePath Abs))
    getInputFileOrDir p
      | p ^. pathIsInput = getInputPathFromPrepathFileOrDir (p ^. pathPath)
      | otherwise = return Nothing

getInputPathFromPrepathFileOrDir :: Prepath FileOrDir -> IO (Maybe (SomePath Abs))
getInputPathFromPrepathFileOrDir p = do
  cwd <- getCurrentDir
  lr <- fromPreFileOrDir cwd p
  return . Just $ case lr of
    Left file -> File file
    Right dir -> Dir dir

parseDisplayVersion :: Parser TopCommand
parseDisplayVersion =
  flag'
    DisplayVersion
    ( long "version"
        <> short 'v'
        <> help "Show version information"
    )

parseDisplayNumericVersion :: Parser TopCommand
parseDisplayNumericVersion =
  flag'
    DisplayNumericVersion
    ( long "numeric-version"
        <> help "Show only the version number"
    )

parseDisplayHelp :: Parser TopCommand
parseDisplayHelp =
  flag'
    DisplayHelp
    ( long "help"
        <> short 'h'
        <> help "Show the help text"
    )

parseUtility :: Parser TopCommand
parseUtility =
  hsubparser
    ( mconcat
        [ commandGroup "Utility commands:",
          metavar "UTILITY_CMD",
          commandDoctor,
          commandInit,
          commandDev,
          commandRepl,
          commandFormat,
          commandClean
        ]
    )
  where
    commandInit :: Mod CommandFields TopCommand
    commandInit =
      command
        "init"
        ( info
            (pure Init)
            (progDesc "Interactively initialize a Juvix project in the current directory")
        )
    commandDoctor :: Mod CommandFields TopCommand
    commandDoctor =
      command
        "doctor"
        ( info
            (Doctor <$> parseDoctorOptions)
            (progDesc "Perform checks on your Juvix development environment")
        )
    commandRepl :: Mod CommandFields TopCommand
    commandRepl =
      command
        "repl"
        ( info
            (JuvixRepl <$> parseRepl)
            (progDesc "Run the Juvix REPL")
        )

    commandFormat :: Mod CommandFields TopCommand
    commandFormat =
      command "format" $
        info
          (JuvixFormat <$> parseFormat)
          ( headerDoc
              ( Just
                  ( vsep
                      [ "juvix format is used to format Juvix source files.",
                        "",
                        "Given a file, it prints the reformatted source to standard output.",
                        "Given a project directory it prints a list of unformatted files in the project.",
                        "Given no argument it prints a list of unformatted files in the project which contains the current directory."
                      ]
                  )
              )
              <> progDesc "Format a Juvix file or Juvix project"
          )

    commandClean :: Mod CommandFields TopCommand
    commandClean =
      command
        "clean"
        (info (pure Clean) (progDesc "Delete build artifacts"))

commandCheck :: Mod CommandFields TopCommand
commandCheck =
  command "typecheck" $
    info
      (Typecheck <$> parseTypecheck)
      (progDesc "Typecheck a Juvix file")

commandCompile :: Mod CommandFields TopCommand
commandCompile =
  command "compile" $
    info
      (Compile <$> parseMainCompileOptions)
      (progDesc "Compile a Juvix file")

commandEval :: Mod CommandFields TopCommand
commandEval =
  command "eval" $
    info
      (Eval <$> parseEvalOptions)
      (progDesc "Evaluate a Juvix file")

commandHtml :: Mod CommandFields TopCommand
commandHtml =
  command "html" $
    info
      (Html <$> parseHtml)
      (progDesc "Generate HTML for a Juvix file")

commandDev :: Mod CommandFields TopCommand
commandDev =
  command "dev" $
    info
      (Dev <$> Dev.parseDevCommand)
      (progDesc "Commands for the developers")

parseCompilerCommand :: Parser TopCommand
parseCompilerCommand =
  hsubparser
    ( mconcat
        [ commandGroup "Compiler commands:",
          metavar "COMPILER_CMD",
          commandCheck,
          commandCompile,
          commandEval,
          commandHtml
        ]
    )

parseTopCommand :: Parser TopCommand
parseTopCommand =
  parseDisplayVersion
    <|> parseDisplayNumericVersion
    <|> parseDisplayHelp
    <|> parseCompilerCommand
    <|> parseUtility

descr :: ParserInfo (GlobalOptions, TopCommand)
descr =
  info
    ( do
        cli <- parseTopCommand
        opts <- parseGlobalFlags
        return (opts, cli)
    )
    ( fullDesc
        <> progDesc "The Juvix compiler."
        <> footerDoc (Just foot)
    )
  where
    foot :: Doc
    foot = bold "maintainers: " <> "The Juvix Team"