From e7bfac7a59c73b625efc029adfcf3e051d6d8edc Mon Sep 17 00:00:00 2001 From: Nicolas Mattia Date: Wed, 20 Nov 2019 12:44:24 +0100 Subject: [PATCH] Refactor argument parsing The argument parsing for `niv add` was a bit ad-hoc. This makes it a bit more principled by passing clearer types. Moreover the logic of argument parsing is taking out of `cmdAdd`. --- src/Niv/Cli.hs | 89 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 53 insertions(+), 36 deletions(-) diff --git a/src/Niv/Cli.hs b/src/Niv/Cli.hs index cff7695..fe8b7f2 100644 --- a/src/Niv/Cli.hs +++ b/src/Niv/Cli.hs @@ -15,18 +15,18 @@ import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey, (.=)) import Data.Bifunctor (first) import Data.Char (isSpace) import Data.FileEmbed (embedFile) +import Data.Functor import Data.Hashable (Hashable) -import Data.Maybe (fromMaybe) import Data.String.QQ (s) -import Niv.Logger +import Data.Version (showVersion) import Niv.GitHub +import Niv.Logger import Niv.Update +import System.Environment (getArgs) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((), takeDirectory) import System.Process (readProcessWithExitCode) -import System.Environment (getArgs) import UnliftIO -import Data.Version (showVersion) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encode.Pretty as AesonPretty import qualified Data.ByteString as B @@ -217,12 +217,20 @@ cmdInit = do createFile path initNixSourcesJsonContent -- Imports @niv@ and @nixpkgs@ (19.03) say "Importing 'niv' ..." - cmdAdd Nothing (PackageName "nmattia/niv", PackageSpec HMS.empty) + cmdAdd githubUpdate' (PackageName "niv") + (specToFreeAttrs $ PackageSpec $ HMS.fromList + [ "owner" .= ("nmattia" :: T.Text) + , "repo" .= ("niv" :: T.Text) + ] + ) say "Importing 'nixpkgs' ..." - cmdAdd - (Just (PackageName "nixpkgs")) - ( PackageName "NixOS/nixpkgs-channels" - , PackageSpec (HMS.singleton "branch" "nixos-19.03")) + cmdAdd githubUpdate' (PackageName "nixpkgs") + (specToFreeAttrs $ PackageSpec $ HMS.fromList + [ "owner" .= ("NixOS" :: T.Text) + , "repo" .= ("nixpkgs-channels" :: T.Text) + , "branch" .= ("nixos-19.03" :: T.Text) + ] + ) , \path _content -> dontCreateFile path) ] $ \(path, onCreate, onUpdate) -> do exists <- Dir.doesFileExist path @@ -243,16 +251,37 @@ cmdInit = do parseCmdAdd :: Opts.ParserInfo (IO ()) parseCmdAdd = - Opts.info ((cmdAdd <$> optName <*> parsePackage) <**> Opts.helper) $ + Opts.info + ((uncurry (cmdAdd githubUpdate') <$> parseArgs) <**> Opts.helper) $ mconcat desc where - optName :: Opts.Parser (Maybe PackageName) - optName = Opts.optional $ PackageName <$> Opts.strOption + parseArgs :: Opts.Parser (PackageName, Attrs) + parseArgs = collapse <$> parseNameAndGHShortcut <*> parsePackageSpec + parseNameAndGHShortcut = (,) <$> optName <*> parseGitHubShortcut + -- collaspe a "name or shortcut" with package spec + collapse nameAndSpec pspec = (pname, specToLockedAttrs $ pspec <> repoAndOwner) + where + (pname, repoAndOwner) = case nameAndSpec of + (Just pname', (_, spec)) -> (pname', PackageSpec spec) + (Nothing, (pname', spec)) -> (pname', PackageSpec spec) + optName = Opts.optional $ PackageName <$> Opts.strOption ( Opts.long "name" <> Opts.short 'n' <> Opts.metavar "NAME" <> Opts.help "Set the package name to " ) + + -- parse a github shortcut of the form "owner/repo" + parseGitHubShortcut = Opts.strArgument (Opts.metavar "PACKAGE") <&> + -- parses a string "owner/repo" into package name (repo) and spec (owner + + -- repo) + \(T.pack -> str) -> + case T.span (/= '/') str of + (owner@(T.null -> False) + , T.uncons -> Just ('/', repo@(T.null -> False))) -> + ( PackageName repo + , HMS.fromList [ "owner" .= owner, "repo" .= repo ]) + _ -> (PackageName str, HMS.empty) desc = [ Opts.fullDesc , Opts.progDesc "Add dependency" @@ -264,38 +293,22 @@ parseCmdAdd = " niv add my-package -v alpha-0.1 -t http://example.com/archive/.zip" ] -cmdAdd :: Maybe PackageName -> (PackageName, PackageSpec) -> IO () -cmdAdd mPackageName (PackageName str, cliSpec) = - job ("Adding package " <> T.unpack str) $ do - - -- Figures out the owner and repo - let (packageName, defaultSpec) = case T.span (/= '/') str of - ( owner@(T.null -> False) - , T.uncons -> Just ('/', repo@(T.null -> False))) -> do - (PackageName repo, HMS.fromList [ "owner" .= owner, "repo" .= repo ]) - _ -> (PackageName str, HMS.empty) - +cmdAdd :: Update () a -> PackageName -> Attrs -> IO () +cmdAdd updateFunc packageName attrs = do + job ("Adding package " <> T.unpack (unPackageName packageName)) $ do sources <- unSources <$> getSources - let packageName' = fromMaybe packageName mPackageName + when (HMS.member packageName sources) $ + abortCannotAddPackageExists packageName - when (HMS.member packageName' sources) $ - abortCannotAddPackageExists packageName' - - let defaultSpec' = PackageSpec $ defaultSpec - - let initialSpec = specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec' - - eFinalSpec <- fmap attrsToSpec <$> tryEvalUpdate - initialSpec - (githubUpdate nixPrefetchURL githubLatestRev githubRepo) + eFinalSpec <- fmap attrsToSpec <$> tryEvalUpdate attrs updateFunc case eFinalSpec of - Left e -> abortUpdateFailed [(packageName', e)] + Left e -> abortUpdateFailed [(packageName, e)] Right finalSpec -> do say $ "Writing new sources file" setSources $ Sources $ - HMS.insert packageName' finalSpec sources + HMS.insert packageName finalSpec sources ------------------------------------------------------------------------------- -- SHOW @@ -612,6 +625,10 @@ pathNixSourcesJson = "nix" "sources.json" initNixSourcesJsonContent :: B.ByteString initNixSourcesJsonContent = "{}" +-- | The IO (real) github update +githubUpdate' :: Update () () +githubUpdate' = githubUpdate nixPrefetchURL githubLatestRev githubRepo + ------------------------------------------------------------------------------- -- Abort -------------------------------------------------------------------------------