diff --git a/README.md b/README.md index bdd5a29..3e786ef 100644 --- a/README.md +++ b/README.md @@ -249,6 +249,10 @@ Available options: inferred from the suffix of the URL. -h,--help Show this help text +Experimental commands: + git Echo a message back + github Add dependency + ``` #### Update diff --git a/default.nix b/default.nix index 63b1edc..c19dff7 100644 --- a/default.nix +++ b/default.nix @@ -33,6 +33,7 @@ with rec "^src/Data/HashMap/Strict$" "^src/Data/Text$" "^src/Niv$" + "^src/Niv/Git$" "^src/Niv/GitHub$" "^src/Niv/Sources$" "^src/Niv/Update$" diff --git a/src/Niv/Cli.hs b/src/Niv/Cli.hs index 5488dba..9a7b5a5 100644 --- a/src/Niv/Cli.hs +++ b/src/Niv/Cli.hs @@ -11,8 +11,6 @@ module Niv.Cli where import Control.Applicative import Control.Monad import Data.Aeson ((.=)) -import Data.Bifunctor -import Data.Maybe import Data.Char (isSpace) import Data.Functor import Data.HashMap.Strict.Extended @@ -20,15 +18,14 @@ import Data.Hashable (Hashable) import Data.String.QQ (s) import Data.Text.Extended import Data.Version (showVersion) -import Niv.GitHub -import Niv.GitHub.API +import Niv.Cmd +import Niv.Git.Cmd +import Niv.GitHub.Cmd import Niv.Logger import Niv.Sources import Niv.Update import System.Environment (getArgs) -import System.Exit (ExitCode(ExitSuccess)) import System.FilePath (takeDirectory) -import System.Process (readProcessWithExitCode) import UnliftIO import qualified Data.Aeson as Aeson import qualified Data.ByteString as B @@ -72,72 +69,8 @@ parsePackageName :: Opts.Parser PackageName parsePackageName = PackageName <$> Opts.argument Opts.str (Opts.metavar "PACKAGE") -parsePackageSpec :: Opts.Parser PackageSpec -parsePackageSpec = - (PackageSpec . HMS.fromList) <$> - many parseAttribute - where - parseAttribute :: Opts.Parser (T.Text, Aeson.Value) - parseAttribute = - Opts.option (Opts.maybeReader parseKeyValJSON) - ( Opts.long "attribute" <> - Opts.short 'a' <> - Opts.metavar "KEY=VAL" <> - Opts.help "Set the package spec attribute to , where may be JSON." - ) <|> - Opts.option (Opts.maybeReader (parseKeyVal Aeson.toJSON)) - ( Opts.long "string-attribute" <> - Opts.short 's' <> - Opts.metavar "KEY=VAL" <> - Opts.help "Set the package spec attribute to ." - ) <|> - shortcutAttributes <|> - ((("url_template",) . Aeson.String) <$> Opts.strOption - ( Opts.long "template" <> - Opts.short 't' <> - Opts.metavar "URL" <> - Opts.help "Used during 'update' when building URL. Occurrences of are replaced with attribute 'foo'." - )) <|> - ((("type",) . Aeson.String) <$> Opts.strOption - ( Opts.long "type" <> - Opts.short 'T' <> - Opts.metavar "TYPE" <> - Opts.help "The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL." - )) - - parseKeyValJSON = parseKeyVal $ \x -> - fromMaybe (Aeson.toJSON x) (Aeson.decodeStrict (B8.pack x)) - - -- Parse "key=val" into ("key", val) - parseKeyVal - :: (String -> Aeson.Value) -- ^ how to convert to JSON - -> String -> Maybe (T.Text, Aeson.Value) - parseKeyVal toJSON str = case span (/= '=') str of - (key, '=':val) -> Just (T.pack key, toJSON val) - _ -> Nothing - - -- Shortcuts for common attributes - shortcutAttributes :: Opts.Parser (T.Text, Aeson.Value) - shortcutAttributes = foldr (<|>) empty $ mkShortcutAttribute <$> - [ "branch", "owner", "repo", "version" ] - - -- TODO: infer those shortcuts from 'Update' keys - mkShortcutAttribute :: T.Text -> Opts.Parser (T.Text, Aeson.Value) - mkShortcutAttribute = \case - attr@(T.uncons -> Just (c,_)) -> fmap (second Aeson.String) $ (attr,) <$> Opts.strOption - ( Opts.long (T.unpack attr) <> - Opts.short c <> - Opts.metavar (T.unpack $ T.toUpper attr) <> - Opts.help - ( T.unpack $ - "Equivalent to --attribute " <> - attr <> "=<" <> (T.toUpper attr) <> ">" - ) - ) - _ -> empty - parsePackage :: Opts.Parser (PackageName, PackageSpec) -parsePackage = (,) <$> parsePackageName <*> parsePackageSpec +parsePackage = (,) <$> parsePackageName <*> (parsePackageSpec githubCmd) ------------------------------------------------------------------------------- -- INIT @@ -173,14 +106,14 @@ cmdInit = do createFile path initNixSourcesJsonContent -- Imports @niv@ and @nixpkgs@ (19.03) say "Importing 'niv' ..." - cmdAdd githubUpdate' (PackageName "niv") + cmdAdd (updateCmd githubCmd) (PackageName "niv") (specToFreeAttrs $ PackageSpec $ HMS.fromList [ "owner" .= ("nmattia" :: T.Text) , "repo" .= ("niv" :: T.Text) ] ) say "Importing 'nixpkgs' ..." - cmdAdd githubUpdate' (PackageName "nixpkgs") + cmdAdd (updateCmd githubCmd) (PackageName "nixpkgs") (specToFreeAttrs $ PackageSpec $ HMS.fromList [ "owner" .= ("NixOS" :: T.Text) , "repo" .= ("nixpkgs-channels" :: T.Text) @@ -208,17 +141,36 @@ cmdInit = do parseCmdAdd :: Opts.ParserInfo (IO ()) parseCmdAdd = Opts.info - ((sp <|> (uncurry (cmdAdd githubUpdate') <$> parseArgs)) <**> Opts.helper) $ - mconcat desc + ((sp <|> shortcutGitHub) <**> Opts.helper) $ + (description githubCmd) where - sp = Opts.subparser (Opts.hidden <> Opts.commandGroup "Experimental commands:" <> Opts.command "git" parseCmdAddGit) + shortcutGitHub = uncurry (cmdAdd (updateCmd githubCmd)) <$> parseArgs + parseCmdAddGit = + Opts.info + (uncurry (cmdAdd (updateCmd gitCmd)) <$> parseArgs <**> Opts.helper) $ + (description gitCmd) + parseCmdAddGitHub = + Opts.info + (uncurry (cmdAdd (updateCmd githubCmd)) <$> parseArgs <**> Opts.helper) $ + (description githubCmd) + + sp = Opts.subparser + ( Opts.hidden <> + Opts.commandGroup "Experimental commands:" <> + Opts.command "git" parseCmdAddGit <> + Opts.command "github" parseCmdAddGitHub + ) + parseArgs :: Opts.Parser (PackageName, Attrs) - parseArgs = collapse <$> parseNameAndGHShortcut <*> parsePackageSpec - parseNameAndGHShortcut = (,) <$> optName <*> parseGitHubShortcut + parseArgs = collapse <$> parseNameAndShortcut <*> (parsePackageSpec githubCmd) + parseNameAndShortcut = + (,) <$> + optName <*> + (Opts.strArgument (Opts.metavar "PACKAGE") <&> (parseShortcut githubCmd)) -- collaspe a "name or shortcut" with package spec - collapse nameAndSpec pspec = (pname, specToLockedAttrs $ pspec <> repoAndOwner) + collapse nameAndSpec pspec = (pname, specToLockedAttrs $ pspec <> baseSpec) where - (pname, repoAndOwner) = case nameAndSpec of + (pname, baseSpec) = case nameAndSpec of (Just pname', (_, spec)) -> (pname', PackageSpec spec) (Nothing, (pname', spec)) -> (pname', PackageSpec spec) optName = Opts.optional $ PackageName <$> Opts.strOption @@ -228,37 +180,6 @@ parseCmdAdd = 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" - , Opts.headerDoc $ Just $ - "Examples:" Opts.<$$> - "" Opts.<$$> - " niv add stedolan/jq" Opts.<$$> - " niv add NixOS/nixpkgs-channels -n nixpkgs -b nixos-19.03" Opts.<$$> - " niv add my-package -v alpha-0.1 -t http://example.com/archive/.zip" - ] - -parseCmdAddGit :: Opts.ParserInfo (IO ()) -parseCmdAddGit = - Opts.info - (putStrLn <$> parseArgs <**> Opts.helper) $ - mconcat desc - where - parseArgs = Opts.strOption (Opts.long "message") - desc = [ Opts.progDesc "This echoes \"message\" back." ] - cmdAdd :: Update () a -> PackageName -> Attrs -> IO () cmdAdd updateFunc packageName attrs = do job ("Adding package " <> T.unpack (unPackageName packageName)) $ do @@ -309,7 +230,6 @@ showPackage (PackageName pname) (PackageSpec spec) = do _ -> tfaint "" tsay $ " " <> attrName <> ": " <> attrValue - ------------------------------------------------------------------------------- -- UPDATE ------------------------------------------------------------------------------- @@ -349,7 +269,7 @@ cmdUpdate = \case Just defaultSpec -> do fmap attrsToSpec <$> tryEvalUpdate (specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec) - githubUpdate' + (updateCmd githubCmd) Nothing -> abortCannotUpdateNoSuchPackage packageName @@ -368,7 +288,7 @@ cmdUpdate = \case let initialSpec = specToFreeAttrs defaultSpec finalSpec <- fmap attrsToSpec <$> tryEvalUpdate initialSpec - githubUpdate' + (updateCmd githubCmd) pure finalSpec let (failed, sources') = partitionEithersHMS esources' @@ -467,20 +387,6 @@ cmdDrop packageName = \case setSources $ Sources $ HMS.insert packageName packageSpec sources -------------------------------------------------------------------------------- --- Aux -------------------------------------------------------------------------------- - -nixPrefetchURL :: Bool -> T.Text -> IO T.Text -nixPrefetchURL unpack (T.unpack -> url) = do - (exitCode, sout, serr) <- runNixPrefetch - case (exitCode, lines sout) of - (ExitSuccess, l:_) -> pure $ T.pack l - _ -> abortNixPrefetchExpectedOutput (T.pack sout) (T.pack serr) - where - args = if unpack then ["--unpack", url] else [url] - runNixPrefetch = readProcessWithExitCode "nix-prefetch-url" args "" - ------------------------------------------------------------------------------- -- Files and their content ------------------------------------------------------------------------------- @@ -502,10 +408,6 @@ shouldUpdateNixSourcesNix content = _ -> False _ -> False --- | The IO (real) github update -githubUpdate' :: Update () () -githubUpdate' = githubUpdate nixPrefetchURL githubLatestRev githubRepo - ------------------------------------------------------------------------------- -- Abort ------------------------------------------------------------------------------- @@ -571,12 +473,3 @@ abortUpdateFailed errs = abort $ T.unlines $ pname <> ": " <> tshow e ) errs -abortNixPrefetchExpectedOutput :: T.Text -> T.Text -> IO a -abortNixPrefetchExpectedOutput sout serr = abort $ [s| -Could not read the output of 'nix-prefetch-url'. This is a bug. Please create a -ticket: - - https://github.com/nmattia/niv/issues/new - -Thanks! I'll buy you a beer. -|] <> T.unlines ["stdout: ", sout, "stderr: ", serr] diff --git a/src/Niv/Cmd.hs b/src/Niv/Cmd.hs new file mode 100644 index 0000000..5134d5c --- /dev/null +++ b/src/Niv/Cmd.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE RankNTypes #-} + +module Niv.Cmd where + +import Niv.Sources +import Niv.Update +import qualified Data.Aeson as Aeson +import qualified Data.Text as T +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) + , parsePackageSpec :: Opts.Parser PackageSpec + , updateCmd :: Update () () + , name :: T.Text + } diff --git a/src/Niv/Git/Cmd.hs b/src/Niv/Git/Cmd.hs new file mode 100644 index 0000000..1988377 --- /dev/null +++ b/src/Niv/Git/Cmd.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Niv.Git.Cmd (gitCmd) where + +import Niv.Cmd +import qualified Options.Applicative as Opts + +gitCmd :: Cmd +gitCmd = Cmd + { description = describeGit + , parseShortcut = error "no parse for git" + , parsePackageSpec = pure mempty + , updateCmd = undefined + , name = "git" + } + +describeGit :: Opts.InfoMod a +describeGit = mconcat + [ Opts.fullDesc + , Opts.progDesc "Echo a message back" + ] + +-- for git: +-- default branch: +-- ~/niv$ git ls-remote --symref git@github.com:NixOS/nixpkgs HEAD +-- ref: refs/heads/master HEAD +-- 3dd8e8e7faa87fc45c2492f88643bb363572180e HEAD +-- 0a46a71a6ec41764b118a24e4cbf1b4bc4be906e refs/remotes/origin/HEAD +-- +-- lastest rev: +-- ~/niv$ git ls-remote git@github.com:NixOS/nixpkgs refs/heads/master +-- 3dd8e8e7faa87fc45c2492f88643bb363572180e refs/heads/master diff --git a/src/Niv/GitHub/Cmd.hs b/src/Niv/GitHub/Cmd.hs new file mode 100644 index 0000000..ad40414 --- /dev/null +++ b/src/Niv/GitHub/Cmd.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} + +module Niv.GitHub.Cmd (githubCmd) where + +import Control.Applicative +import Data.Aeson ((.=)) +import Data.Bifunctor +import Data.Maybe +import Data.String.QQ (s) +import Data.Text.Extended +import Niv.Cmd +import Niv.GitHub +import Niv.GitHub.API +import Niv.Sources +import Niv.Update +import System.Exit (ExitCode(ExitSuccess)) +import System.Process (readProcessWithExitCode) +import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Char8 as B8 +import qualified Data.HashMap.Strict as HMS +import qualified Data.Text as T +import qualified Options.Applicative as Opts +import qualified Options.Applicative.Help.Pretty as Opts + +githubCmd :: Cmd +githubCmd = Cmd + { description = describeGitHub + , parseShortcut = parseAddShortcutGitHub + , parsePackageSpec = parseGitHubPackageSpec + , updateCmd = githubUpdate' + , name = "github" + -- TODO: here filter by type == tarball or file or builtin- + } + +parseGitHubPackageSpec :: Opts.Parser PackageSpec +parseGitHubPackageSpec = + (PackageSpec . HMS.fromList) <$> + many parseAttribute + where + parseAttribute :: Opts.Parser (T.Text, Aeson.Value) + parseAttribute = + Opts.option (Opts.maybeReader parseKeyValJSON) + ( Opts.long "attribute" <> + Opts.short 'a' <> + Opts.metavar "KEY=VAL" <> + Opts.help "Set the package spec attribute to , where may be JSON." + ) <|> + Opts.option (Opts.maybeReader (parseKeyVal Aeson.toJSON)) + ( Opts.long "string-attribute" <> + Opts.short 's' <> + Opts.metavar "KEY=VAL" <> + Opts.help "Set the package spec attribute to ." + ) <|> + shortcutAttributes <|> + ((("url_template",) . Aeson.String) <$> Opts.strOption + ( Opts.long "template" <> + Opts.short 't' <> + Opts.metavar "URL" <> + Opts.help "Used during 'update' when building URL. Occurrences of are replaced with attribute 'foo'." + )) <|> + ((("type",) . Aeson.String) <$> Opts.strOption + ( Opts.long "type" <> + Opts.short 'T' <> + Opts.metavar "TYPE" <> + Opts.help "The type of the URL target. The value can be either 'file' or 'tarball'. If not set, the value is inferred from the suffix of the URL." + )) + + parseKeyValJSON = parseKeyVal $ \x -> + fromMaybe (Aeson.toJSON x) (Aeson.decodeStrict (B8.pack x)) + + -- Parse "key=val" into ("key", val) + parseKeyVal + :: (String -> Aeson.Value) -- ^ how to convert to JSON + -> String -> Maybe (T.Text, Aeson.Value) + parseKeyVal toJSON str = case span (/= '=') str of + (key, '=':val) -> Just (T.pack key, toJSON val) + _ -> Nothing + + -- Shortcuts for common attributes + shortcutAttributes :: Opts.Parser (T.Text, Aeson.Value) + shortcutAttributes = foldr (<|>) empty $ mkShortcutAttribute <$> + [ "branch", "owner", "repo", "version" ] + + -- TODO: infer those shortcuts from 'Update' keys + mkShortcutAttribute :: T.Text -> Opts.Parser (T.Text, Aeson.Value) + mkShortcutAttribute = \case + attr@(T.uncons -> Just (c,_)) -> fmap (second Aeson.String) $ (attr,) <$> Opts.strOption + ( Opts.long (T.unpack attr) <> + Opts.short c <> + Opts.metavar (T.unpack $ T.toUpper attr) <> + Opts.help + ( T.unpack $ + "Equivalent to --attribute " <> + attr <> "=<" <> (T.toUpper attr) <> ">" + ) + ) + _ -> empty + +describeGitHub :: Opts.InfoMod a +describeGitHub = mconcat + [ Opts.fullDesc + , Opts.progDesc "Add dependency" + , Opts.headerDoc $ Just $ + "Examples:" Opts.<$$> + "" Opts.<$$> + " niv add stedolan/jq" Opts.<$$> + " niv add NixOS/nixpkgs-channels -n nixpkgs -b nixos-19.03" Opts.<$$> + " niv add my-package -v alpha-0.1 -t http://example.com/archive/.zip" + ] + +-- parse a github shortcut of the form "owner/repo" +parseAddShortcutGitHub :: T.Text -> (PackageName, Aeson.Object) +parseAddShortcutGitHub str = -- Opts.strArgument (Opts.metavar "PACKAGE") <&> + -- 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))) -> + ( PackageName repo + , HMS.fromList [ "owner" .= owner, "repo" .= repo ]) + _ -> (PackageName str, HMS.empty) + + +-- | The IO (real) github update +githubUpdate' :: Update () () +githubUpdate' = githubUpdate nixPrefetchURL githubLatestRev githubRepo + +-- TODO: dedup +nixPrefetchURL :: Bool -> T.Text -> IO T.Text +nixPrefetchURL unpack (T.unpack -> url) = do + (exitCode, sout, serr) <- runNixPrefetch + case (exitCode, lines sout) of + (ExitSuccess, l:_) -> pure $ T.pack l + _ -> abortNixPrefetchExpectedOutput (T.pack sout) (T.pack serr) + where + args = if unpack then ["--unpack", url] else [url] + runNixPrefetch = readProcessWithExitCode "nix-prefetch-url" args "" + +abortNixPrefetchExpectedOutput :: T.Text -> T.Text -> IO a +abortNixPrefetchExpectedOutput sout serr = abort $ [s| +Could not read the output of 'nix-prefetch-url'. This is a bug. Please create a +ticket: + + https://github.com/nmattia/niv/issues/new + +Thanks! I'll buy you a beer. +|] <> T.unlines ["stdout: ", sout, "stderr: ", serr]