indigo-0.6.0: app/Main.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Main
  ( main
  ) where

import Data.Text (dropWhileEnd)
import Data.Text.IO.Utf8 qualified as Utf8
import Data.Version (showVersion)
import Options.Applicative
  (command, execParser, fullDesc, header, help, helper, info, infoOption, long, progDesc, subparser)
import Options.Applicative qualified as Opt
import Paths_indigo (version)
import Shelly qualified as S
import System.Environment qualified as SE
import System.Process

import Morley.Util.Main (wrapMain)

import FileGen qualified
import Helper
import Upgrade qualified

argParser :: Opt.Parser (IO ())
argParser =
  subparser $
    newSubCmd <>
    buildSubCmd <>
    runSubCmd <>
    replSubCmd <>
    upgradeSubCmd <>
    testSubCmd

  where
    mkCommandParser commandName desc parser =
      command commandName $
      info (helper <*> parser) $
      progDesc desc

    projectName = Opt.strArgument (Opt.metavar "PROJECT_NAME")

    revisionArg = optional $ Opt.strOption $
         long "revision"
      <> Opt.metavar "REVISION"
      <> help "Git commit to pull from"
      <> Opt.internal

    newArgs = (,) <$> projectName <*> revisionArg

    newSubCmd =
      mkCommandParser "new"
      "Create a new project" $
      newArgs <&> \(projName, gitRev) -> do
        case parsePackageName projName of
          Right _ -> do
            isNonUnique <- doesExistProjectName projName
            if isNonUnique then
              die "A project with this name already exists. Please choose another one."
            else
              FileGen.run projName gitRev

          Left err ->
            die $ toString err

    buildSubCmd =
      mkCommandParser "build"
      "Build the current project" $ pure $
        S.shelly . S.escaping False $ runStackWithArgs ["build", "--fast"]

    runSubCmd =
      command "run" $
      flip info (progDesc "Run the current project" <> Opt.noIntersperse <> Opt.forwardOptions) $
      many (Opt.strArgument $ Opt.metavar "ARGUMENTS") <&> \input -> do
        result <- Utf8.readFile "package.yaml"
        S.shelly . S.escaping False $ case getExecName (words result) of
          Just execName ->
            -- If we don't catch the exception here, 2 errors message will be print
            -- one by 'runStackWithArgs' and another by shelly itself.
            -- We still treat it as a fail command when the exception occurs by
            -- exit with error code 1.
            S.catch_sh @(S.ReThrownException SomeException)
              (runStackWithArgs (["run", execName, "--"] <> input))
              (\_ -> S.quietExit 1)
          Nothing ->
            die "Could not find executable name in package.yaml"

    replSubCmd =
      mkCommandParser "repl"
      "Access Indigo REPL" $ pure $ do
        mbIndigoInDocker <- SE.lookupEnv "INDIGO_IN_DOCKER"
        let dockerFlag = (maybe [] (const ["--allow-different-user"]) mbIndigoInDocker)
        result <- Utf8.readFile "package.yaml"
        target <- case getLibName (words result) of
          Just libName ->
            pure (libName <> ":lib")
          Nothing ->
            -- | Fallback to executable name in case of not finding the library name
            -- Needed especially in running the REPL for the tutorial, since we need the
            -- target to be @:indigo-repl@.
            case getExecName (words result) of
              Just execName -> pure (":" <> execName)
              Nothing ->
                die "Could not find library name in package.yaml"

        S.shelly $ S.liftIO $ callProcess "stack" $ dockerFlag <> ["repl", toString target]

    testSubCmd =
      mkCommandParser "test"
      "Run contract tests" $ pure $
        S.shelly . S.escaping False $ runStackWithArgs ["test", "--fast"]

    upgradeSubCmd =
      mkCommandParser "upgrade"
      "Upgrade indigo binary to the latest version" $
        Upgrade.run <$> revisionArg <*> Opt.switch (long "force" <> Opt.internal)

    runStackWithArgs :: [Text] -> S.Sh ()
    runStackWithArgs args = do
      mbIndigoInDocker <- liftIO $ SE.lookupEnv "INDIGO_IN_DOCKER"
      let dockerFlag = (maybe [] (const ["--allow-different-user"]) mbIndigoInDocker)
      S.shelly $ S.escaping False $ S.run_ "stack" $ dockerFlag <> args

    getExecName :: [Text] -> Maybe Text
    getExecName = \case
      "executables:":a:_ -> Just $ dropWhileEnd (==':') a
      _:xs -> getExecName xs
      _ -> Nothing

    getLibName :: [Text] -> Maybe Text
    getLibName = \case
      "name:":a:_ -> Just a
      _ -> Nothing

main :: IO ()
main = wrapMain $ do
  join $ execParser $ info (helper <*> versionOption <*> argParser) $
    mconcat
    [ fullDesc
    , progDesc (toString indigoDesc)
    , header (toString indigoTitle)
    ]
  where
    versionOption = infoOption ("indigo-" <> showVersion version)
      (long "version" <> help "Show version.")