indigo-0.4: app/Main.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Main
  ( main
  ) where

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

import Util.Main (wrapMain)

import qualified FileGen
import Helper

data CmdLnArgs
  = New Text
  | Build
  | Run
  | Repl
  | Test

argParser :: Opt.Parser CmdLnArgs
argParser = subparser $
  newSubCmd <>
  buildSubCmd <>
  runSubCmd <>
  replSubCmd <>
  testSubCmd

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

    newSubCmd =
      mkCommandParser "new"
      (New <$> newArgOption)
      "Create a new project"

    buildSubCmd =
      mkCommandParser "build"
      (pure Build)
      "Build the current project"

    runSubCmd =
      mkCommandParser "run"
      (pure Run)
      "Run the current project"

    replSubCmd =
      mkCommandParser "repl"
      (pure Repl)
      "Access Indigo REPL"

    testSubCmd =
      mkCommandParser "test"
      (pure Test)
      "Run contract tests"

    newArgOption :: Opt.Parser Text
    newArgOption = Opt.strArgument (Opt.metavar "PROJECT NAME")

main :: IO ()
main = wrapMain $ do
  r <- isRunCommand
  case r of
    Just input -> do
      handleRunCommand input

    Nothing -> do
      cmdLnArgs <- execParser programInfo
      run cmdLnArgs

  where
    isRunCommand :: IO (Maybe [String])
    isRunCommand = do
      args <- SE.getArgs
      case args of
        "run":input -> pure $ Just input
        _ -> pure Nothing

    -- | Special case for handling @run@ command
    -- Since we want to pass the whole raw input to @ContractRegistry@
    -- it is easy to do it this way, because optparse seems to be not able to
    -- parse raw input.
    handleRunCommand :: [String] -> IO ()
    handleRunCommand input = do
      result <- Utf8.readFile "package.yaml"
      S.shelly . S.escaping False $ case getExecName (words result) of
        Just execName ->
          S.catch_sh @SomeException
            (runStackWithArgs (["run", execName, "--"] <> (toText <$> input)))
            (const pass)  -- Hide Exception error text from `optparse`
        Nothing ->
          die "Could not find executable name in package.yaml"

    programInfo = info (helper <*> versionOption <*> argParser) $
      mconcat
      [ fullDesc
      , progDesc (toString indigoDesc)
      , header (toString indigoTitle)
      ]

    versionOption = infoOption ("indigo-" <> showVersion version)
      (long "version" <> help "Show version.")

    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

    run :: CmdLnArgs -> IO ()
    run = \case

      New projName ->
        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

          Left err ->
            die $ toString err

      Build -> do
        S.shelly . S.escaping False $ runStackWithArgs ["build", "--fast"]

      -- | Placeholder command
      --
      -- @run@ will be handle by @handleRunCommand@
      -- This is defined only to show the description in @help@ command
      Run -> pure ()

      Repl -> 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]

      Test -> do
        S.shelly . S.escaping False $ runStackWithArgs ["test", "--fast"]

    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