nmattia/niv
1
1
Fork 0
mirror of https://github.com/nmattia/niv.git synced 2024-09-05 20:15:26 +03:00
Code Issues Projects Releases Wiki Activity

Add Cmd and split commands

Browse Source
This commit is contained in:
Nicolas Mattia 2019-11-24 11:57:05 +01:00
parent c3ec48dbb0
commit c8b5412835
6 changed files with 242 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
README.md
View File

@ -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

1
default.nix
View File

@ -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$"

175
src/Niv/Cli.hs
View File

@ -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 <KEY> to <VAL>, where <VAL> 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 <KEY> to <VAL>."
) <|>
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 <foo> 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 <NAME>"
)
-- 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/<version>.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 "<barabajagal>"
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]

19
src/Niv/Cmd.hs Normal file
View File

@ -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
}

32
src/Niv/Git/Cmd.hs Normal file
View File

@ -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

152
src/Niv/GitHub/Cmd.hs Normal file
View File

@ -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 <KEY> to <VAL>, where <VAL> 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 <KEY> to <VAL>."
) <|>
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 <foo> 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/<version>.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]