From 2233391b65aa29b05783ebbc539fa1aec28fc14a Mon Sep 17 00:00:00 2001 From: Nicolas Mattia Date: Tue, 26 Mar 2019 19:07:02 +0100 Subject: [PATCH] dirty subcommand --- Main.hs | 53 ++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 42 insertions(+), 11 deletions(-) diff --git a/Main.hs b/Main.hs index 758a3e8..8627315 100644 --- a/Main.hs +++ b/Main.hs @@ -30,6 +30,9 @@ import qualified Data.Text as T import qualified GitHub as GH import qualified GitHub.Data.Name as GH import qualified Options.Applicative as Opts +import qualified Options.Applicative.Types as Opts +-- import qualified Options.Applicative.Builder as Opts +import qualified Options.Applicative.Builder.Internal as Opts import qualified Options.Applicative.Help.Pretty as Opts import qualified System.Directory as Dir @@ -368,26 +371,49 @@ cmdInit = do ------------------------------------------------------------------------------- parseCmdAdd :: Opts.ParserInfo (IO ()) -parseCmdAdd = Opts.info (subparser <**> Opts.helper) $ Opts.progDesc "Add dependency" +parseCmdAdd = Opts.info (subcommand <**> Opts.helper) $ Opts.progDesc "Add dependency" where - subparser = - parseCmdAddGeneric <|> + subcommand = Opts.subparser ( Opts.command "github" parseCmdAddGithub <> Opts.command "file" parseCmdAddFile - ) + ) <|> + (subparser (command "/" parseCmdAddGithub)) -parseCmdAddGeneric :: Opts.Parser (IO ()) -parseCmdAddGeneric = parsePackageName <&> doStuffWithPackageName +subparser :: Opts.Mod Opts.CommandFields (IO ()) -> Opts.Parser (IO ()) +subparser m = Opts.mkParser d g rdr + where + Opts.Mod _ d g = Opts.metavar "COMMAND" `mappend` m + (groupName, cmds, subs) = mkCommand m + rdr = Opts.CmdReader groupName cmds subs -doStuffWithPackageName :: PackageName -> IO () -doStuffWithPackageName _ = pure () +command :: String -> Opts.ParserInfo a -> Opts.Mod Opts.CommandFields a +command cmd pinfo = Opts.fieldMod $ \p -> + p { Opts.cmdCommands = (cmd, pinfo) : Opts.cmdCommands p } + +mkCommand :: Opts.Mod Opts.CommandFields (IO ()) -> (Maybe String, [String], String -> Maybe (Opts.ParserInfo (IO ()))) +mkCommand m = (group, map fst cmds, const $ Just parseCmdAddGithub) + where + Opts.Mod f _ _ = m + Opts.CommandFields cmds group = f (Opts.CommandFields [] Nothing) + +-- commandInferGithub :: Opts.Mod Opts.CommandFields (IO ()) +-- commandInferGithub = Opts.fieldMod $ \p -> + -- p { Opts.cmdCommands = (cmd, parseCmdAddGithub) : Opts.cmdCommands p } + +_parseInferGithub :: Opts.Parser (IO ()) +_parseInferGithub = + ((cmdAdd' <$> parseGithubPackage) <**> Opts.helper) + where + cmdAdd' :: (PackageName, PackageSpec) -> IO () + cmdAdd' b = inferOwnerAndRepo b >>= cmdAdd Nothing parseCmdAddGithub :: Opts.ParserInfo (IO ()) parseCmdAddGithub = Opts.info ((cmdAdd' <$> parseNameAttribute <*> parseGithubPackage) <**> Opts.helper) $ mconcat desc where + cmdAdd' :: Maybe PackageName -> (PackageName, PackageSpec) -> IO () cmdAdd' a b = inferOwnerAndRepo b >>= cmdAdd a desc = [ Opts.fullDesc @@ -399,17 +425,22 @@ parseCmdAddGithub = " niv add github NixOS/nixpkgs-channels -n nixpkgs -b nixos-18.09" ] +ownerAndRepo :: String -> Maybe (String, String) +ownerAndRepo str = case span (/= '/') str of + (owner@(_:_), '/':repo@(_:_)) -> Just (owner, repo) + _ -> Nothing + -- Figures out the owner and repo inferOwnerAndRepo :: (PackageName, PackageSpec) -> IO (PackageName, PackageSpec) inferOwnerAndRepo (PackageName str, spec) = - flip runStateT spec $ case span (/= '/') str of - (owner@(_:_), '/':repo@(_:_)) -> do + flip runStateT spec $ case ownerAndRepo str of + Just (owner, repo) -> do whenNotSet "owner" $ setPackageSpecAttr "owner" (Aeson.String $ T.pack owner) whenNotSet "repo" $ do setPackageSpecAttr "repo" (Aeson.String $ T.pack repo) pure (PackageName repo) - _ -> pure (PackageName str) + Nothing -> pure (PackageName str) parseCmdAddFile :: Opts.ParserInfo (IO ()) parseCmdAddFile =