From 1e7abae0298a536168086231344b73510cd70d03 Mon Sep 17 00:00:00 2001 From: Nicolas Mattia Date: Sun, 24 Nov 2019 14:46:33 +0100 Subject: [PATCH] Fix parsing of subcommands --- README.md | 10 +++---- src/Niv/Cli.hs | 68 ++++++++++++++++++++++++++++++------------- src/Niv/Cmd.hs | 3 +- src/Niv/Git/Cmd.hs | 13 +++++++-- src/Niv/GitHub/Cmd.hs | 16 +++++----- 5 files changed, 73 insertions(+), 37 deletions(-) diff --git a/README.md b/README.md index 3e786ef..0a94611 100644 --- a/README.md +++ b/README.md @@ -209,7 +209,7 @@ Available options: Available commands: init Initialize a Nix project. Existing files won't be modified. - add Add dependency + add Add a GitHub dependency show update Update dependencies modify Modify dependency @@ -226,11 +226,11 @@ Examples: niv add NixOS/nixpkgs-channels -n nixpkgs -b nixos-19.03 niv add my-package -v alpha-0.1 -t http://example.com/archive/.zip -Usage: niv add [-n|--name NAME] PACKAGE ([-a|--attribute KEY=VAL] | +Usage: niv add PACKAGE [-n|--name NAME] ([-a|--attribute KEY=VAL] | [-s|--string-attribute KEY=VAL] | [-b|--branch BRANCH] | [-o|--owner OWNER] | [-r|--repo REPO] | [-v|--version VERSION] | [-t|--template URL] | [-T|--type TYPE]) - Add dependency + Add a GitHub dependency Available options: -n,--name NAME Set the package name to @@ -250,8 +250,8 @@ Available options: -h,--help Show this help text Experimental commands: - git Echo a message back - github Add dependency + git Add a git dependency. Experimental. + github Add a GitHub dependency ``` diff --git a/src/Niv/Cli.hs b/src/Niv/Cli.hs index 9a7b5a5..dfcd16c 100644 --- a/src/Niv/Cli.hs +++ b/src/Niv/Cli.hs @@ -12,7 +12,6 @@ import Control.Applicative import Control.Monad import Data.Aeson ((.=)) import Data.Char (isSpace) -import Data.Functor import Data.HashMap.Strict.Extended import Data.Hashable (Hashable) import Data.String.QQ (s) @@ -141,38 +140,67 @@ cmdInit = do parseCmdAdd :: Opts.ParserInfo (IO ()) parseCmdAdd = Opts.info - ((sp <|> shortcutGitHub) <**> Opts.helper) $ + ((parseCommands <|> parseShortcuts) <**> Opts.helper) $ (description githubCmd) where - shortcutGitHub = uncurry (cmdAdd (updateCmd githubCmd)) <$> parseArgs + -- XXX: this should parse many shortcuts (github, git). Right now we only + -- parse GitHub because the git interface is still experimental. note to + -- implementer: it'll be tricky to have the correct arguments show up + -- without repeating "PACKAGE PACKAGE PACKAGE" for every package type. + parseShortcuts = parseShortcut githubCmd + parseShortcut cmd = uncurry (cmdAdd (updateCmd cmd)) <$> (parseShortcutArgs cmd) + parseCmd cmd = uncurry (cmdAdd (updateCmd cmd)) <$> (parseCmdArgs cmd) parseCmdAddGit = - Opts.info - (uncurry (cmdAdd (updateCmd gitCmd)) <$> parseArgs <**> Opts.helper) $ - (description gitCmd) + Opts.info (parseCmd gitCmd <**> Opts.helper) (description gitCmd) parseCmdAddGitHub = - Opts.info - (uncurry (cmdAdd (updateCmd githubCmd)) <$> parseArgs <**> Opts.helper) $ - (description githubCmd) - - sp = Opts.subparser + Opts.info (parseCmd githubCmd <**> Opts.helper) (description githubCmd) + parseCommands = Opts.subparser ( Opts.hidden <> Opts.commandGroup "Experimental commands:" <> Opts.command "git" parseCmdAddGit <> Opts.command "github" parseCmdAddGitHub ) - parseArgs :: Opts.Parser (PackageName, Attrs) - parseArgs = collapse <$> parseNameAndShortcut <*> (parsePackageSpec githubCmd) +-- | only used in shortcuts (niv add foo/bar ...) because PACKAGE is NOT +-- optional +parseShortcutArgs :: Cmd -> Opts.Parser (PackageName, Attrs) +parseShortcutArgs cmd = collapse <$> parseNameAndShortcut <*> parsePackageSpec cmd + where + collapse specAndName pspec = (pname, specToLockedAttrs $ pspec <> baseSpec) + where + (pname, baseSpec) = case specAndName of + ((_, spec), Just pname') -> (pname', PackageSpec spec) + ((pname', spec), Nothing) -> (pname', PackageSpec spec) parseNameAndShortcut = (,) <$> - optName <*> - (Opts.strArgument (Opts.metavar "PACKAGE") <&> (parseShortcut githubCmd)) - -- collaspe a "name or shortcut" with package spec - collapse nameAndSpec pspec = (pname, specToLockedAttrs $ pspec <> baseSpec) + Opts.argument + (Opts.maybeReader (parseCmdShortcut cmd . T.pack)) + (Opts.metavar "PACKAGE") <*> + optName + optName = Opts.optional $ PackageName <$> Opts.strOption + ( Opts.long "name" <> + Opts.short 'n' <> + Opts.metavar "NAME" <> + Opts.help "Set the package name to " + ) + +-- | only used in command (niv add ...) because PACKAGE is optional +parseCmdArgs :: Cmd -> Opts.Parser (PackageName, Attrs) +parseCmdArgs cmd = collapse <$> parseNameAndShortcut <*> parsePackageSpec cmd + where + collapse specAndName pspec = (pname, specToLockedAttrs $ pspec <> baseSpec) where - (pname, baseSpec) = case nameAndSpec of - (Just pname', (_, spec)) -> (pname', PackageSpec spec) - (Nothing, (pname', spec)) -> (pname', PackageSpec spec) + (pname, baseSpec) = case specAndName of + (Just (_, spec), Just pname') -> (pname', PackageSpec spec) + (Just (pname', spec), Nothing) -> (pname', PackageSpec spec) + (Nothing, Just pname') -> (pname', PackageSpec HMS.empty) + (Nothing, Nothing) -> (PackageName "unnamed", PackageSpec HMS.empty) + parseNameAndShortcut = + (,) <$> + Opts.optional (Opts.argument + (Opts.maybeReader (parseCmdShortcut cmd . T.pack)) + (Opts.metavar "PACKAGE")) <*> + optName optName = Opts.optional $ PackageName <$> Opts.strOption ( Opts.long "name" <> Opts.short 'n' <> diff --git a/src/Niv/Cmd.hs b/src/Niv/Cmd.hs index 5134d5c..5769ba4 100644 --- a/src/Niv/Cmd.hs +++ b/src/Niv/Cmd.hs @@ -11,8 +11,7 @@ import qualified Options.Applicative as Opts -- TODO: add filter data Cmd = Cmd { description :: forall a. Opts.InfoMod a - -- TODO: should be "Maybe" - , parseShortcut :: T.Text -> (PackageName, Aeson.Object) + , parseCmdShortcut :: T.Text -> Maybe (PackageName, Aeson.Object) , parsePackageSpec :: Opts.Parser PackageSpec , updateCmd :: Update () () , name :: T.Text diff --git a/src/Niv/Git/Cmd.hs b/src/Niv/Git/Cmd.hs index 1988377..a58be11 100644 --- a/src/Niv/Git/Cmd.hs +++ b/src/Niv/Git/Cmd.hs @@ -4,20 +4,27 @@ module Niv.Git.Cmd (gitCmd) where import Niv.Cmd import qualified Options.Applicative as Opts +import qualified Options.Applicative.Help.Pretty as Opts gitCmd :: Cmd gitCmd = Cmd { description = describeGit - , parseShortcut = error "no parse for git" + , parseCmdShortcut = pure Nothing , parsePackageSpec = pure mempty - , updateCmd = undefined + , updateCmd = error "git update is not implemented yet" , name = "git" } describeGit :: Opts.InfoMod a describeGit = mconcat [ Opts.fullDesc - , Opts.progDesc "Echo a message back" + , Opts.progDesc "Add a git dependency. Experimental." + , Opts.headerDoc $ Just $ + "Examples:" Opts.<$$> + "" Opts.<$$> + " niv add git@github.com:stedolan/jq" Opts.<$$> + " niv add ssh://git@github.com/stedolan/jq" Opts.<$$> + " niv add https://github.com/stedolan/jq.git" ] -- for git: diff --git a/src/Niv/GitHub/Cmd.hs b/src/Niv/GitHub/Cmd.hs index ad40414..dba412b 100644 --- a/src/Niv/GitHub/Cmd.hs +++ b/src/Niv/GitHub/Cmd.hs @@ -30,7 +30,7 @@ import qualified Options.Applicative.Help.Pretty as Opts githubCmd :: Cmd githubCmd = Cmd { description = describeGitHub - , parseShortcut = parseAddShortcutGitHub + , parseCmdShortcut = parseAddShortcutGitHub , parsePackageSpec = parseGitHubPackageSpec , updateCmd = githubUpdate' , name = "github" @@ -104,7 +104,7 @@ parseGitHubPackageSpec = describeGitHub :: Opts.InfoMod a describeGitHub = mconcat [ Opts.fullDesc - , Opts.progDesc "Add dependency" + , Opts.progDesc "Add a GitHub dependency" , Opts.headerDoc $ Just $ "Examples:" Opts.<$$> "" Opts.<$$> @@ -114,17 +114,19 @@ describeGitHub = mconcat ] -- parse a github shortcut of the form "owner/repo" -parseAddShortcutGitHub :: T.Text -> (PackageName, Aeson.Object) -parseAddShortcutGitHub str = -- Opts.strArgument (Opts.metavar "PACKAGE") <&> +parseAddShortcutGitHub :: T.Text -> Maybe (PackageName, Aeson.Object) +parseAddShortcutGitHub str = -- parses a string "owner/repo" into package name (repo) and spec (owner + -- repo) case T.span (/= '/') str of (owner@(T.null -> False) - , T.uncons -> Just ('/', repo@(T.null -> False))) -> + , T.uncons -> Just ('/', repo@(T.null -> False))) -> Just ( PackageName repo , HMS.fromList [ "owner" .= owner, "repo" .= repo ]) - _ -> (PackageName str, HMS.empty) - + -- XXX: this should be "Nothing" but for the time being we keep + -- backwards compatibility with "niv add foo" adding "foo" as a + -- package name. + _ -> Just (PackageName str, HMS.empty) -- | The IO (real) github update githubUpdate' :: Update () ()