From de3f9ef328556243570ebe4597d0f7bf03959ac0 Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Fri, 3 Nov 2023 18:49:29 +0000 Subject: [PATCH] Add non-interactive version of juvix init --- app/Commands/Init.hs | 44 ++++++++++++++++++++-------- app/Commands/Init/Options.hs | 19 ++++++++++++ app/TopCommand.hs | 2 +- app/TopCommand/Options.hs | 5 ++-- tests/smoke/Commands/init.smoke.yaml | 15 ++++++++++ 5 files changed, 69 insertions(+), 16 deletions(-) create mode 100644 app/Commands/Init/Options.hs diff --git a/app/Commands/Init.hs b/app/Commands/Init.hs index fc006aaaba..7a496846b3 100644 --- a/app/Commands/Init.hs +++ b/app/Commands/Init.hs @@ -1,5 +1,6 @@ module Commands.Init where +import Commands.Init.Options import Data.Text qualified as Text import Data.Text.IO.Utf8 qualified as Utf8 import Data.Versions @@ -21,16 +22,32 @@ parse p t = mapLeft ppErr (P.runParser p "" t) ppErr :: P.ParseErrorBundle Text Void -> Text ppErr = pack . errorBundlePretty -init :: forall r. (Members '[Embed IO] r) => Sem r () -init = do +init :: forall r. (Members '[Embed IO] r) => InitOptions -> Sem r () +init opts = do checkNotInProject - say "✨ Your next Juvix adventure is about to begin! ✨" - say "I will help you set it up" - pkg <- getPackage - say ("creating " <> pack (toFilePath packageFilePath)) - embed (Utf8.writeFile @IO (toFilePath packageFilePath) (renderPackageVersion PackageVersion1 pkg)) + pkg <- + if + | isInteractive -> do + say "✨ Your next Juvix adventure is about to begin! ✨" + say "I will help you set it up" + getPackage + | otherwise -> do + cwd <- getCurrentDir + projectName <- getDefaultProjectName + let emptyPkg = emptyPackage DefaultBuildDir (cwd packageFilePath) + return $ case projectName of + Nothing -> emptyPkg + Just n -> emptyPkg {_packageName = n} + when isInteractive (say ("creating " <> pack (toFilePath packageFilePath))) + writePackage pkg checkPackage - say "you are all set" + when isInteractive (say "you are all set") + where + writePackage :: Package -> Sem r () + writePackage pkg = embed (Utf8.writeFile @IO (toFilePath packageFilePath) (renderPackageVersion PackageVersion1 pkg)) + + isInteractive :: Bool + isInteractive = not (opts ^. initOptionsNonInteractive) checkNotInProject :: forall r. (Members '[Embed IO] r) => Sem r () checkNotInProject = @@ -68,9 +85,14 @@ getPackage = do _packageLockfile = Nothing } +getDefaultProjectName :: (Member (Embed IO) r) => Sem r (Maybe Text) +getDefaultProjectName = runFail $ do + dir <- map toLower . dropTrailingPathSeparator . toFilePath . dirname <$> getCurrentDir + Fail.fromRight (parse projectNameParser (pack dir)) + getProjName :: forall r. (Members '[Embed IO] r) => Sem r Text getProjName = do - d <- getDefault + d <- getDefaultProjectName let defMsg :: Text defMsg = case d of Nothing -> mempty @@ -82,10 +104,6 @@ getProjName = do ) readName d where - getDefault :: Sem r (Maybe Text) - getDefault = runFail $ do - dir <- map toLower . dropTrailingPathSeparator . toFilePath . dirname <$> getCurrentDir - Fail.fromRight (parse projectNameParser (pack dir)) readName :: Maybe Text -> Sem r Text readName def = go where diff --git a/app/Commands/Init/Options.hs b/app/Commands/Init/Options.hs new file mode 100644 index 0000000000..62667c2dad --- /dev/null +++ b/app/Commands/Init/Options.hs @@ -0,0 +1,19 @@ +module Commands.Init.Options where + +import CommonOptions + +newtype InitOptions = InitOptions + {_initOptionsNonInteractive :: Bool} + deriving stock (Data) + +makeLenses ''InitOptions + +parseInitOptions :: Parser InitOptions +parseInitOptions = do + _initOptionsNonInteractive <- + switch + ( long "non-interactive" + <> short 'n' + <> help "Run non-interactively. Generates a default Package.juvix" + ) + pure InitOptions {..} diff --git a/app/TopCommand.hs b/app/TopCommand.hs index 92816a59ad..21d479d7e1 100644 --- a/app/TopCommand.hs +++ b/app/TopCommand.hs @@ -30,7 +30,7 @@ runTopCommand = \case DisplayNumericVersion -> embed runDisplayNumericVersion DisplayHelp -> embed showHelpText Doctor opts -> runLogIO (Doctor.runCommand opts) - Init -> runLogIO Init.init + Init opts -> runLogIO (Init.init opts) Dev opts -> Dev.runCommand opts Typecheck opts -> Typecheck.runCommand opts Compile opts -> Compile.runCommand opts diff --git a/app/TopCommand/Options.hs b/app/TopCommand/Options.hs index 43e2ff0ea3..cf131bd572 100644 --- a/app/TopCommand/Options.hs +++ b/app/TopCommand/Options.hs @@ -8,6 +8,7 @@ import Commands.Doctor.Options import Commands.Eval.Options import Commands.Format.Options import Commands.Html.Options +import Commands.Init.Options import Commands.Repl.Options import Commands.Typecheck.Options import CommonOptions hiding (Doc) @@ -26,7 +27,7 @@ data TopCommand | Html HtmlOptions | Dev Dev.DevCommand | Doctor DoctorOptions - | Init + | Init InitOptions | JuvixRepl ReplOptions | JuvixFormat FormatOptions | Dependencies Dependencies.DependenciesCommand @@ -108,7 +109,7 @@ parseUtility = command "init" ( info - (pure Init) + (Init <$> parseInitOptions) (progDesc "Interactively initialize a Juvix project in the current directory") ) commandDoctor :: Mod CommandFields TopCommand diff --git a/tests/smoke/Commands/init.smoke.yaml b/tests/smoke/Commands/init.smoke.yaml index 2c81e87bea..1ac0444215 100644 --- a/tests/smoke/Commands/init.smoke.yaml +++ b/tests/smoke/Commands/init.smoke.yaml @@ -14,6 +14,21 @@ tests: stdout: contains: type checks exit-status: 0 + - name: init-non-interactive-name + command: + shell: + - bash + script: | + temp=$(mktemp -d) + trap 'rm -rf -- "$temp"' EXIT + mkdir "$temp/packagename" + cd "$temp/packagename" + juvix init -n + juvix repl Package.juvix + stdout: + contains: '"packagename"' + stdin: Package.name package + exit-status: 0 - name: init-name command: shell: