-- 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.")