nmattia/niv
1
1
Fork 0
mirror of https://github.com/nmattia/niv.git synced 2024-11-29 09:42:35 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #151 from nmattia/nm-split-updates

Browse Source 
Experimental support for git dependencies
This commit is contained in:
Nicolas Mattia 2019-12-01 12:58:03 +01:00 committed by GitHub
commit 32fe489e08
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
26 changed files with 794 additions and 321 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
README.md
View File

@ -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/<version>.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 <NAME>
@ -249,6 +249,10 @@ Available options:
inferred from the suffix of the URL.
-h,--help Show this help text
Experimental commands:
git Add a git dependency. Experimental.
github Add a GitHub dependency
```
#### Update

5
default.nix
View File

@ -31,7 +31,9 @@ with rec
"^src/Data/Aeson$"
"^src/Data/HashMap$"
"^src/Data/HashMap/Strict$"
"^src/Data/Text$"
"^src/Niv$"
"^src/Niv/Git$"
"^src/Niv/GitHub$"
"^src/Niv/Sources$"
"^src/Niv/Update$"
@ -188,7 +190,8 @@ rec
{
inherit niv niv-sdist niv-source niv-devshell niv-cabal-upload;
tests = pkgs.callPackage ./tests { inherit niv; };
tests-github = pkgs.callPackage ./tests/github { inherit niv; };
tests-git = pkgs.callPackage ./tests/git { inherit niv; };
niv-test = pkgs.runCommand "niv-test" { buildInputs = [ niv ]; }
"niv-test && touch $out";

6
nix/sources.nix
View File

@ -18,6 +18,9 @@ let
else
pkgs.fetchzip { inherit (spec) url sha256; };
fetch_git = spec:
builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };
fetch_builtin-tarball = spec:
builtins.trace
''
@ -80,10 +83,11 @@ let
abort "ERROR: niv spec ${name} does not have a 'type' attribute"
else if spec.type == "file" then fetch_file spec
else if spec.type == "tarball" then fetch_tarball spec
else if spec.type == "git" then fetch_git spec
else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec
else if spec.type == "builtin-url" then fetch_builtin-url spec
else
abort "ERROR: niv spec ${name} has unknown type ${builtins.fromJSON spec.type}";
abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}";
# Ports of functions for older nix versions

16
src/Data/Text/Extended.hs Normal file
View File

@ -0,0 +1,16 @@
{-# LANGUAGE OverloadedStrings #-}
module Data.Text.Extended where
import Niv.Logger
import System.Exit (exitFailure)
import qualified Data.Text as T
tshow :: Show a => a -> T.Text
tshow = T.pack . show
-- not quite the perfect place for this
abort :: T.Text -> IO a
abort msg = do
tsay $ T.unwords [ tbold $ tred "FATAL:", msg ]
exitFailure

211
src/Niv/Cli.hs
View File

@ -11,22 +11,20 @@ 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
import Data.Hashable (Hashable)
import Data.String.QQ (s)
import Data.Text.Extended
import Data.Version (showVersion)
import Niv.GitHub
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
@ -70,72 +68,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
@ -171,14 +105,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)
@ -206,18 +140,43 @@ cmdInit = do
parseCmdAdd :: Opts.ParserInfo (IO ())
parseCmdAdd =
Opts.info
((uncurry (cmdAdd githubUpdate') <$> parseArgs) <**> Opts.helper) $
mconcat desc
((parseCommands <|> parseShortcuts) <**> Opts.helper) $
(description githubCmd)
where
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)
-- 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 (parseCmd gitCmd <**> Opts.helper) (description gitCmd)
parseCmdAddGitHub =
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
)
-- | 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, repoAndOwner) = case nameAndSpec of
(Just pname', (_, spec)) -> (pname', PackageSpec spec)
(Nothing, (pname', spec)) -> (pname', PackageSpec spec)
(pname, baseSpec) = case specAndName of
((_, spec), Just pname') -> (pname', PackageSpec spec)
((pname', spec), Nothing) -> (pname', PackageSpec spec)
parseNameAndShortcut =
(,) <$>
Opts.argument
(Opts.maybeReader (parseCmdShortcut cmd . T.pack))
(Opts.metavar "PACKAGE") <*>
optName
optName = Opts.optional $ PackageName <$> Opts.strOption
( Opts.long "name" <>
Opts.short 'n' <>
@ -225,27 +184,29 @@ 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"
]
-- | only used in command (niv add <cmd> ...) 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 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' <>
Opts.metavar "NAME" <>
Opts.help "Set the package name to <NAME>"
)
cmdAdd :: Update () a -> PackageName -> Attrs -> IO ()
cmdAdd updateFunc packageName attrs = do
@ -297,7 +258,6 @@ showPackage (PackageName pname) (PackageSpec spec) = do
_ -> tfaint "<barabajagal>"
tsay $ " " <> attrName <> ": " <> attrValue
-------------------------------------------------------------------------------
-- UPDATE
-------------------------------------------------------------------------------
@ -335,9 +295,14 @@ cmdUpdate = \case
eFinalSpec <- case HMS.lookup packageName sources of
Just defaultSpec -> do
-- lookup the "type" to find a Cmd to run, defaulting to legacy
-- github
let cmd = case HMS.lookup "type" (unPackageSpec defaultSpec) of
Just "git" -> gitCmd
_ -> githubCmd
fmap attrsToSpec <$> tryEvalUpdate
(specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec)
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
(updateCmd cmd)
Nothing -> abortCannotUpdateNoSuchPackage packageName
@ -354,9 +319,14 @@ cmdUpdate = \case
\packageName defaultSpec -> do
tsay $ "Package: " <> unPackageName packageName
let initialSpec = specToFreeAttrs defaultSpec
-- lookup the "type" to find a Cmd to run, defaulting to legacy
-- github
let cmd = case HMS.lookup "type" (unPackageSpec defaultSpec) of
Just "git" -> gitCmd
_ -> githubCmd
finalSpec <- fmap attrsToSpec <$> tryEvalUpdate
initialSpec
(githubUpdate nixPrefetchURL githubLatestRev githubRepo)
(updateCmd cmd)
pure finalSpec
let (failed, sources') = partitionEithersHMS esources'
@ -455,20 +425,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
-------------------------------------------------------------------------------
@ -490,10 +446,6 @@ shouldUpdateNixSourcesNix content =
_ -> False
_ -> False
-- | The IO (real) github update
githubUpdate' :: Update () ()
githubUpdate' = githubUpdate nixPrefetchURL githubLatestRev githubRepo
-------------------------------------------------------------------------------
-- Abort
-------------------------------------------------------------------------------
@ -559,12 +511,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]

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

@ -0,0 +1,18 @@
{-# 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
, parseCmdShortcut :: T.Text -> Maybe (PackageName, Aeson.Object)
, parsePackageSpec :: Opts.Parser PackageSpec
, updateCmd :: Update () ()
, name :: T.Text
}

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

@ -0,0 +1,195 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE QuasiQuotes #-}
module Niv.Git.Cmd where
import Control.Applicative
import Control.Arrow
import Data.Maybe
import Data.Text.Extended as T
import Niv.Cmd
import Niv.Logger
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
gitCmd :: Cmd
gitCmd = Cmd
{ description = describeGit
, parseCmdShortcut = parseGitShortcut
, parsePackageSpec = parseGitPackageSpec
, updateCmd = gitUpdate
, name = "git"
}
parseGitShortcut :: T.Text -> Maybe (PackageName, Aeson.Object)
parseGitShortcut txt'@(T.dropWhileEnd (== '/') -> txt) =
-- basic heuristics for figuring out if something is a git repo
if isGitURL
then case T.splitOn "/" txt of
[] -> Nothing
(last -> w) -> case T.stripSuffix ".git" w of
Nothing -> Just (PackageName w, HMS.singleton "repo" (Aeson.String txt'))
Just w' -> Just (PackageName w', HMS.singleton "repo" (Aeson.String txt'))
else Nothing
where
isGitURL =
".git" `T.isSuffixOf` txt ||
"git@" `T.isPrefixOf` txt ||
"ssh://" `T.isPrefixOf` txt
parseGitPackageSpec :: Opts.Parser PackageSpec
parseGitPackageSpec =
(PackageSpec . HMS.fromList) <$>
many (parseRepo <|> parseRef <|> parseRev <|> parseAttr <|> parseSAttr)
where
parseRepo =
("repo", ) . Aeson.String <$> Opts.strOption
( Opts.long "repo" <>
Opts.metavar "URL"
)
parseRev =
("rev", ) . Aeson.String <$> Opts.strOption
( Opts.long "rev" <>
Opts.metavar "SHA"
)
parseRef =
("ref", ) . Aeson.String <$> Opts.strOption
( Opts.long "ref" <>
Opts.metavar "REF"
)
parseAttr =
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."
)
parseSAttr =
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>."
)
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
describeGit :: Opts.InfoMod a
describeGit = mconcat
[ Opts.fullDesc
, Opts.progDesc "Add a git dependency. Experimental."
, Opts.headerDoc $ Just $
"Examples:" Opts.<$$>
"" Opts.<$$>
" niv add git git@github.com:stedolan/jq" Opts.<$$>
" niv add git ssh://git@github.com/stedolan/jq --rev deadb33f" Opts.<$$>
" niv add git https://github.com/stedolan/jq.git" Opts.<$$>
" niv add git --repo /my/custom/repo --name custom --ref foobar"
]
gitUpdate :: Update () ()
gitUpdate = proc () -> do
useOrSet "type" -< ("git" :: Box T.Text)
repository <- load "repo" -< ()
refAndRev <- (discoverRev <+> discoverRefAndRev) -< repository
update "ref" -< fst <$> refAndRev
update "rev" -< snd <$> refAndRev
returnA -< ()
where
discoverRefAndRev = proc repository -> do
run defaultRefAndHEAD -< repository
discoverRev = proc repository -> do
ref <- load "ref" -< ()
rev <- run (\(r1,r2) -> latestRev r1 r2)-< (,) <$> repository <*> ref
returnA -< (,) <$> ref <*> rev
latestRev
:: T.Text -- ^ the repository
-> T.Text -- ^ the ref/branch
-> IO T.Text
latestRev repo ref = do
let gitArgs = [ "ls-remote", repo, "refs/heads/" <> ref ]
sout <- runGit gitArgs
case sout of
ls@(_:_:_) -> abortTooMuchOutput gitArgs ls
(l1:[]) -> parseRev gitArgs l1
[] -> abortNoOutput gitArgs
where
parseRev args l = maybe (abortNoRev args l) pure $ do
checkRev $ T.takeWhile (/= '\t') l
checkRev t = if isRev t then Just t else Nothing
abortNoOutput args = abortGitFailure args
"Git didn't produce any output."
abortTooMuchOutput args ls = abortGitFailure args $ T.unlines $
[ "Git produced too much output:" ] <> map (" " <>) ls
defaultRefAndHEAD
:: T.Text -- ^ the repository
-> IO (T.Text, T.Text)
defaultRefAndHEAD repo = do
sout <- runGit args
case sout of
(l1:l2:_) -> (,) <$> parseRef l1 <*> parseRev l2
_ -> abortGitFailure args $ T.unlines $
[ "Could not read reference and revision from stdout:"
] <> sout
where
args = [ "ls-remote", "--symref", repo, "HEAD" ]
parseRef l = maybe (abortNoRef args l) pure $ do
-- ref: refs/head/master\tHEAD -> master\tHEAD
refAndSym <- T.stripPrefix "ref: refs/heads/" l
let ref = T.takeWhile (/= '\t') refAndSym
if T.null ref then Nothing else Just ref
parseRev l = maybe (abortNoRev args l) pure $ do
checkRev $ T.takeWhile (/= '\t') l
checkRev t = if isRev t then Just t else Nothing
abortNoRev :: [T.Text] -> T.Text -> IO a
abortNoRev args l = abortGitFailure args $ "Could not read revision from: " <> l
abortNoRef :: [T.Text] -> T.Text -> IO a
abortNoRef args l = abortGitFailure args $ "Could not read reference from: " <> l
-- | Run the "git" executable
runGit :: [T.Text] -> IO [T.Text]
runGit args = do
(exitCode, sout, serr) <- readProcessWithExitCode "git" (T.unpack <$> args) ""
case (exitCode, lines sout) of
(ExitSuccess, ls) -> pure $ T.pack <$> ls
_ -> abortGitFailure args $ T.unlines
[ T.unwords [ "stdout:" , T.pack sout ]
, T.unwords [ "stderr:" , T.pack serr ]
]
isRev :: T.Text -> Bool
isRev t =
-- commit hashes are comprised of abcdef0123456789
T.all (\c -> (c >= 'a' && c <= 'f') || (c >= '0' && c <= '9')) t &&
-- commit _should_ be 40 chars long, but to be sure we pick 7
T.length t >= 7
abortGitFailure :: [T.Text] -> T.Text -> IO a
abortGitFailure args msg = abort $ bug $ T.unlines
[ "Could not read the output of 'git'."
, T.unwords ("command:":"git":args)
, msg ]

30
src/Niv/Git/Test.hs Normal file
View File

@ -0,0 +1,30 @@
{-# LANGUAGE OverloadedStrings #-}
module Niv.Git.Test (tests) where
import Niv.Git.Cmd
import Niv.Sources
import Test.Tasty.HUnit ((@=?))
import qualified Data.HashMap.Strict as HMS
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.HUnit as Tasty
tests :: [Tasty.TestTree]
tests = pure $ Tasty.testGroup "repository parse"
[ Tasty.testCase "goo" $
parseGitShortcut "goo" @=? Nothing
, Tasty.testCase "git@github.com:nmattia/niv" $
parseGitShortcut "git@github.com:nmattia/niv" @=? Just
(PackageName "niv", HMS.singleton "repo" "git@github.com:nmattia/niv")
, Tasty.testCase "ssh://git@github.com/stedolan/jq" $
parseGitShortcut "ssh://git@github.com/stedolan/jq" @=? Just
(PackageName "jq", HMS.singleton "repo" "ssh://git@github.com/stedolan/jq")
, Tasty.testCase "https://github.com/stedolan/jq.git" $
parseGitShortcut "https://github.com/stedolan/jq.git" @=? Just
(PackageName "jq", HMS.singleton "repo" "https://github.com/stedolan/jq.git")
, Tasty.testCase "https://github.com/stedolan/jq" $
parseGitShortcut "https://github.com/stedolan/jq" @=? Nothing
, Tasty.testCase "~/path/to/repo.git" $
parseGitShortcut "~/path/to/repo.git" @=? Just
(PackageName "repo", HMS.singleton "repo" "~/path/to/repo.git")
]

161
src/Niv/GitHub.hs
View File

@ -3,28 +3,16 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
module Niv.GitHub where
import Control.Arrow
import Data.Bool
import Data.Functor
import Data.Maybe
import Data.String.QQ (s)
import Niv.GitHub.API
import Niv.Update
import System.Environment (lookupEnv)
import System.Exit (exitFailure)
import System.IO.Unsafe (unsafePerformIO)
import Text.Read (readMaybe)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BS8
import qualified Data.HashMap.Strict as HMS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import qualified Network.HTTP.Simple as HTTP
-- | The GitHub update function
-- TODO: fetchers for:
@ -68,150 +56,3 @@ githubURLTemplate :: T.Text
githubURLTemplate =
(if githubSecure then "https://" else "http://") <>
githubHost <> githubPath <> "<owner>/<repo>/archive/<rev>.tar.gz"
-- Bunch of GitHub helpers
data GithubRepo = GithubRepo
{ repoDescription :: Maybe T.Text
, repoHomepage :: Maybe T.Text
, repoDefaultBranch :: Maybe T.Text
}
githubRepo :: T.Text -> T.Text -> IO GithubRepo
githubRepo owner repo = do
request <- defaultRequest ["repos", owner, repo]
-- we don't use httpJSONEither because it adds an "Accept:
-- application/json" header that GitHub chokes on
resp0 <- HTTP.httpBS request
let resp = fmap Aeson.eitherDecodeStrict resp0
case (HTTP.getResponseStatusCode resp, HTTP.getResponseBody resp) of
(200, Right (Aeson.Object m)) -> do
let lookupText k = case HMS.lookup k m of
Just (Aeson.String t) -> Just t
_ -> Nothing
pure GithubRepo
{ repoDescription = lookupText "description"
, repoHomepage = lookupText "homepage"
, repoDefaultBranch = lookupText "default_branch"
}
(200, Right v) -> do
error $ "expected object, got " <> show v
(200, Left e) -> do
error $ "github didn't return JSON: " <> show e
_ -> abortCouldNotFetchGitHubRepo (tshow (request,resp0)) (owner, repo)
-- | TODO: Error instead of T.Text?
abortCouldNotFetchGitHubRepo :: T.Text -> (T.Text, T.Text) -> IO a
abortCouldNotFetchGitHubRepo e (T.unpack -> owner, T.unpack -> repo) = do
putStrLn $ unlines [ line1, line2, T.unpack line3 ]
exitFailure
where
line1 = "WARNING: Could not read from GitHub repo: " <> owner <> "/" <> repo
line2 = [s|
I assumed that your package was a GitHub repository. An error occurred while
gathering information from the repository. Check whether your package was added
correctly:
niv show
If not, try re-adding it:
niv drop <package>
niv add <package-without-typo>
Make sure the repository exists.
|]
line3 = T.unwords [ "(Error was:", e, ")" ]
defaultRequest :: [T.Text] -> IO HTTP.Request
defaultRequest (map T.encodeUtf8 -> parts) = do
let path = T.encodeUtf8 githubPath <> BS8.intercalate "/" (parts)
mtoken <- lookupEnv "GITHUB_TOKEN"
pure $
(flip (maybe id) mtoken $ \token ->
HTTP.addRequestHeader "authorization" ("token " <> BS8.pack token)
) $
HTTP.setRequestPath path $
HTTP.addRequestHeader "user-agent" "niv" $
HTTP.addRequestHeader "accept" "application/vnd.github.v3+json" $
HTTP.setRequestSecure githubSecure $
HTTP.setRequestHost (T.encodeUtf8 githubApiHost) $
HTTP.setRequestPort githubApiPort $
HTTP.defaultRequest
-- | Get the latest revision for owner, repo and branch.
-- TODO: explain no error handling
githubLatestRev
:: T.Text
-- ^ owner
-> T.Text
-- ^ repo
-> T.Text
-- ^ branch
-> IO T.Text
githubLatestRev owner repo branch = do
request <- defaultRequest [ "repos", owner, repo, "commits", branch ] <&>
HTTP.addRequestHeader "accept" "application/vnd.github.v3.sha"
resp <- HTTP.httpBS request
case HTTP.getResponseStatusCode resp of
200 -> pure $ T.decodeUtf8 $ HTTP.getResponseBody resp
_ -> abortCouldNotGetRev owner repo branch resp
abortCouldNotGetRev :: T.Text -> T.Text -> T.Text -> HTTP.Response BS8.ByteString -> IO a
abortCouldNotGetRev owner repo branch resp = abort $ T.unlines [ line1, line2, line3 ]
where
line1 = T.unwords
[ "Cannot get latest revision for branch"
, "'" <> branch <> "'"
, "(" <> owner <> "/" <> repo <> ")"
]
line2 = "The request failed: " <> tshow resp
line3 = [s|
NOTE: You may want to retry with an authentication token:
GITHUB_TOKEN=... niv <cmd>
For more information on rate-limiting, see
https://developer.github.com/v3/#rate-limiting
|]
githubHost :: T.Text
githubHost = unsafePerformIO $ do
lookupEnv "GITHUB_HOST" >>= \case
Just (T.pack -> x) -> pure x
Nothing -> pure "github.com"
githubApiPort :: Int
githubApiPort = unsafePerformIO $ do
lookupEnv "GITHUB_API_PORT" >>= \case
Just (readMaybe -> Just x) -> pure x
_ -> pure $ if githubSecure then 443 else 80
githubApiHost :: T.Text
githubApiHost = unsafePerformIO $ do
lookupEnv "GITHUB_API_HOST" >>= \case
Just (T.pack -> x) -> pure x
Nothing -> pure "api.github.com"
githubSecure :: Bool
githubSecure = unsafePerformIO $ do
lookupEnv "GITHUB_INSECURE" >>= \case
Just "" -> pure True
Just _ -> pure False
Nothing -> pure True
githubPath :: T.Text
githubPath = unsafePerformIO $ do
lookupEnv "GITHUB_PATH" >>= \case
Just (T.pack -> x) -> pure $ fromMaybe x (T.stripSuffix "/" x) <> "/"
Nothing -> pure "/"
abort :: T.Text -> IO a
abort msg = do
T.putStrLn msg
exitFailure
tshow :: Show a => a -> T.Text
tshow = T.pack . show

160
src/Niv/GitHub/API.hs Normal file
View File

@ -0,0 +1,160 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
module Niv.GitHub.API where
import Data.Functor
import Data.Maybe
import Data.String.QQ (s)
import Data.Text.Extended
import System.Environment (lookupEnv)
import System.Exit (exitFailure)
import System.IO.Unsafe (unsafePerformIO)
import Text.Read (readMaybe)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BS8
import qualified Data.HashMap.Strict as HMS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Simple as HTTP
-- Bunch of GitHub helpers
data GithubRepo = GithubRepo
{ repoDescription :: Maybe T.Text
, repoHomepage :: Maybe T.Text
, repoDefaultBranch :: Maybe T.Text
}
githubRepo :: T.Text -> T.Text -> IO GithubRepo
githubRepo owner repo = do
request <- defaultRequest ["repos", owner, repo]
-- we don't use httpJSONEither because it adds an "Accept:
-- application/json" header that GitHub chokes on
resp0 <- HTTP.httpBS request
let resp = fmap Aeson.eitherDecodeStrict resp0
case (HTTP.getResponseStatusCode resp, HTTP.getResponseBody resp) of
(200, Right (Aeson.Object m)) -> do
let lookupText k = case HMS.lookup k m of
Just (Aeson.String t) -> Just t
_ -> Nothing
pure GithubRepo
{ repoDescription = lookupText "description"
, repoHomepage = lookupText "homepage"
, repoDefaultBranch = lookupText "default_branch"
}
(200, Right v) -> do
error $ "expected object, got " <> show v
(200, Left e) -> do
error $ "github didn't return JSON: " <> show e
_ -> abortCouldNotFetchGitHubRepo (tshow (request,resp0)) (owner, repo)
-- | TODO: Error instead of T.Text?
abortCouldNotFetchGitHubRepo :: T.Text -> (T.Text, T.Text) -> IO a
abortCouldNotFetchGitHubRepo e (T.unpack -> owner, T.unpack -> repo) = do
putStrLn $ unlines [ line1, line2, T.unpack line3 ]
exitFailure
where
line1 = "WARNING: Could not read from GitHub repo: " <> owner <> "/" <> repo
line2 = [s|
I assumed that your package was a GitHub repository. An error occurred while
gathering information from the repository. Check whether your package was added
correctly:
niv show
If not, try re-adding it:
niv drop <package>
niv add <package-without-typo>
Make sure the repository exists.
|]
line3 = T.unwords [ "(Error was:", e, ")" ]
defaultRequest :: [T.Text] -> IO HTTP.Request
defaultRequest (map T.encodeUtf8 -> parts) = do
let path = T.encodeUtf8 githubPath <> BS8.intercalate "/" (parts)
mtoken <- lookupEnv "GITHUB_TOKEN"
pure $
(flip (maybe id) mtoken $ \token ->
HTTP.addRequestHeader "authorization" ("token " <> BS8.pack token)
) $
HTTP.setRequestPath path $
HTTP.addRequestHeader "user-agent" "niv" $
HTTP.addRequestHeader "accept" "application/vnd.github.v3+json" $
HTTP.setRequestSecure githubSecure $
HTTP.setRequestHost (T.encodeUtf8 githubApiHost) $
HTTP.setRequestPort githubApiPort $
HTTP.defaultRequest
-- | Get the latest revision for owner, repo and branch.
-- TODO: explain no error handling
githubLatestRev
:: T.Text
-- ^ owner
-> T.Text
-- ^ repo
-> T.Text
-- ^ branch
-> IO T.Text
githubLatestRev owner repo branch = do
request <- defaultRequest [ "repos", owner, repo, "commits", branch ] <&>
HTTP.addRequestHeader "accept" "application/vnd.github.v3.sha"
resp <- HTTP.httpBS request
case HTTP.getResponseStatusCode resp of
200 -> pure $ T.decodeUtf8 $ HTTP.getResponseBody resp
_ -> abortCouldNotGetRev owner repo branch resp
abortCouldNotGetRev :: T.Text -> T.Text -> T.Text -> HTTP.Response BS8.ByteString -> IO a
abortCouldNotGetRev owner repo branch resp = abort $ T.unlines [ line1, line2, line3 ]
where
line1 = T.unwords
[ "Cannot get latest revision for branch"
, "'" <> branch <> "'"
, "(" <> owner <> "/" <> repo <> ")"
]
line2 = "The request failed: " <> tshow resp
line3 = [s|
NOTE: You may want to retry with an authentication token:
GITHUB_TOKEN=... niv <cmd>
For more information on rate-limiting, see
https://developer.github.com/v3/#rate-limiting
|]
githubHost :: T.Text
githubHost = unsafePerformIO $ do
lookupEnv "GITHUB_HOST" >>= \case
Just (T.pack -> x) -> pure x
Nothing -> pure "github.com"
githubApiPort :: Int
githubApiPort = unsafePerformIO $ do
lookupEnv "GITHUB_API_PORT" >>= \case
Just (readMaybe -> Just x) -> pure x
_ -> pure $ if githubSecure then 443 else 80
githubApiHost :: T.Text
githubApiHost = unsafePerformIO $ do
lookupEnv "GITHUB_API_HOST" >>= \case
Just (T.pack -> x) -> pure x
Nothing -> pure "api.github.com"
githubSecure :: Bool
githubSecure = unsafePerformIO $ do
lookupEnv "GITHUB_INSECURE" >>= \case
Just "" -> pure True
Just _ -> pure False
Nothing -> pure True
githubPath :: T.Text
githubPath = unsafePerformIO $ do
lookupEnv "GITHUB_PATH" >>= \case
Just (T.pack -> x) -> pure $ fromMaybe x (T.stripSuffix "/" x) <> "/"
Nothing -> pure "/"

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

@ -0,0 +1,153 @@
{-# 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
, parseCmdShortcut = 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 a GitHub 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 -> 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))) -> Just
( PackageName repo
, HMS.fromList [ "owner" .= owner, "repo" .= repo ])
-- 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 () ()
githubUpdate' = githubUpdate nixPrefetchURL githubLatestRev githubRepo
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]

1
src/Niv/GitHub/Test.hs
View File

@ -8,6 +8,7 @@ import Control.Monad
import Data.IORef
import Data.Bifunctor
import Niv.GitHub
import Niv.GitHub.API
import Niv.Update
import qualified Data.HashMap.Strict as HMS

61
src/Niv/Logger.hs
View File

@ -3,7 +3,18 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Niv.Logger where
module Niv.Logger
( job
, bug
, tsay
, say
, green, tgreen
, red, tred
, blue, tblue
, yellow, tyellow
, bold, tbold
, faint, tfaint
) where
import Control.Monad
import Data.Profunctor
@ -13,6 +24,9 @@ import qualified Data.Text as T
import UnliftIO
import qualified System.Console.ANSI as ANSI
type S = String -> String
type T = T.Text -> T.Text
-- XXX: this assumes as single thread
job :: String -> IO () -> IO ()
job str act = do
@ -45,51 +59,68 @@ say :: String -> IO ()
say msg = do
stackSize <- jobStackSize
let indent = replicate (stackSize * 2) ' '
putStrLn $ indent <> msg
putStrLn $ unlines $ (indent <>) <$> lines msg
green :: String -> String
green :: S
green str =
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green] <>
str <> ANSI.setSGRCode [ANSI.Reset]
yellow :: String -> String
tgreen :: T
tgreen = t green
yellow :: S
yellow str =
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Yellow] <>
str <> ANSI.setSGRCode [ANSI.Reset]
tyellow :: T.Text -> T.Text
tyellow = dimap T.unpack T.pack yellow
tyellow :: T
tyellow = t yellow
blue :: String -> String
blue :: S
blue str =
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Blue] <>
str <> ANSI.setSGRCode [ANSI.Reset]
tblue :: T.Text -> T.Text
tblue = dimap T.unpack T.pack blue
tblue :: T
tblue = t blue
red :: String -> String
red :: S
red str =
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red] <>
str <> ANSI.setSGRCode [ANSI.Reset]
tbold :: T.Text -> T.Text
tbold = dimap T.unpack T.pack bold
tred :: T
tred = t red
bold :: String -> String
bold :: S
bold str =
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity] <>
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White] <>
str <> ANSI.setSGRCode [ANSI.Reset]
tfaint :: T.Text -> T.Text
tfaint = dimap T.unpack T.pack faint
tbold :: T
tbold = t bold
faint :: String -> String
faint str =
ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.FaintIntensity] <>
ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White] <>
str <> ANSI.setSGRCode [ANSI.Reset]
tfaint :: T
tfaint = t faint
t :: (String -> String) -> T.Text -> T.Text
t = dimap T.unpack T.pack
bug :: T.Text -> T.Text
bug txt = T.unlines
[ txt
, "This is a bug. Please create a ticket:"
, " https://github.com/nmattia/niv/issues/new"
, "Thanks! I'll buy you a beer."
]

5
src/Niv/Sources.hs
View File

@ -13,7 +13,7 @@ import Data.Bifunctor (first)
import Data.Hashable (Hashable)
import Data.List
import Data.String.QQ (s)
import Niv.GitHub
import Data.Text.Extended
import Niv.Logger
import Niv.Update
import System.FilePath ((</>))
@ -135,6 +135,7 @@ data SourcesNixVersion
| V9
| V10
| V11
| V12
deriving stock (Bounded, Enum, Eq)
-- | A user friendly version
@ -151,6 +152,7 @@ sourcesVersionToText = \case
V9 -> "9"
V10 -> "10"
V11 -> "11"
V12 -> "12"
latestVersionMD5 :: T.Text
latestVersionMD5 = sourcesVersionToMD5 maxBound
@ -174,6 +176,7 @@ sourcesVersionToMD5 = \case
V9 -> "87149616c1b3b1e5aa73178f91c20b53"
V10 -> "d8625c0a03dd935e1c79f46407faa8d3"
V11 -> "8a95b7d93b16f7c7515d98f49b0ec741"
V12 -> "2f9629ad9a8f181ed71d2a59b454970c"
-- | The MD5 sum of ./nix/sources.nix
sourcesNixMD5 :: IO T.Text

2
src/Niv/Test.hs
View File

@ -3,6 +3,7 @@ module Niv.Test (tests, test) where
import Niv.Sources.Test
import Niv.GitHub.Test
import Niv.Update.Test
import qualified Niv.Git.Test as Git
import qualified Test.Tasty as Tasty
import qualified Test.Tasty.HUnit as Tasty
@ -31,4 +32,5 @@ tests = Tasty.testGroup "niv"
, Tasty.testGroup "sources.nix"
[ Tasty.testCase "has latest version" test_shippedSourcesNixIsLatest
]
, Tasty.testGroup "git" Git.tests
]

8
src/Niv/Update.hs
View File

@ -14,6 +14,7 @@ import Control.Applicative
import Control.Arrow
import Data.Aeson (FromJSON, ToJSON, Value)
import Data.String
import Niv.Logger
import UnliftIO
import qualified Control.Category as Cat
import qualified Data.Aeson as Aeson
@ -80,12 +81,7 @@ runUpdate (boxAttrs -> attrs) a = runUpdate' attrs a >>= feed
prettyFail :: UpdateFailed -> T.Text
prettyFail = \case
FailNoSuchKey k -> "Key could not be found: " <> k
FailZero -> T.unlines
[ "A dead end was reached during evaluation."
, "This is a bug. Please create a ticket:"
, " https://github.com/nmattia/niv/issues/new"
, "Thanks! I'll buy you a beer."
]
FailZero -> bug "A dead end was reached during evaluation."
FailCheck -> "A check failed during update"
FailTemplate tpl keys -> T.unlines
[ "Could not render template " <> tpl

73
tests/git/default.nix Normal file
View File

@ -0,0 +1,73 @@
{ pkgs, niv }:
# TODO: this doesn' test anything meaningful yet because "niv git PACKAGE"
# doesn't parse yet
pkgs.runCommand "git-test"
{ nativeBuildInputs = [ pkgs.git niv pkgs.nix pkgs.jq ]; }
(
# First we create a dummy git repo with one commit on master, and one commit
# on "branch".
''
gitdir=$(mktemp -d)
pushd $gitdir > /dev/null
git init .
echo hello > file
git config user.email "niv@foo.bar"
git config user.name "Niv Niverson"
git add file
git commit -m "Initial commit"
gitrev=$(git rev-parse HEAD)
git checkout -b branch
echo world >> file
git add file
git commit -m "second commit"
gitrev2=$(git rev-parse HEAD)
# reset to master as "default branch"
git checkout master
popd > /dev/null
'' +
# Then we `niv add` that repo and check some properties, like the revision
# and revCount, to make sure it was imported properly, and that sources.nix
# does what it's supposed to do.
''
nivdir=$(mktemp -d)
pushd $nivdir > /dev/null
mkdir -p nix
echo "{}" > nix/sources.json
niv init
niv add git -n my-git-repo --repo file://$gitdir
nivrev=$(nix eval --json '(import ./nix/sources.nix).my-git-repo.rev' | jq -r)
if [ ! "$gitrev" = "$nivrev" ]; then
echo "Mismatched revs: $gitrev != $nivrev"
exit 42
fi
# here we cheat a bit and use "outPath", which actually is the result of
# builtins.fetchGit.
nivnixrev=$(nix eval --json '(import ./nix/sources.nix).my-git-repo.outPath.rev' | jq -r)
if [ ! "$gitrev" = "$nivnixrev" ]; then
echo "Mismatched revs: $gitrev != $nivnixrev"
exit 42
fi
nivnixrevcount=$(nix eval --json '(import ./nix/sources.nix).my-git-repo.outPath.revCount')
if [ ! "1" -eq "$nivnixrevcount" ]; then
echo "Mismatched revCount: 1 != $nivnixrevcount"
exit 42
fi
niv update my-git-repo -a ref=branch
nivrev2=$(nix eval --json '(import ./nix/sources.nix).my-git-repo.rev' | jq -r)
if [ ! "$gitrev2" = "$nivrev2" ]; then
echo "Mismatched revs: $gitrev2 != $nivrev2"
exit 42
fi
popd > /dev/null
touch $out
''
)

0
tests/data/archives/571b40d3f50466d3e91c1e609d372de96d782793.tar.gz → tests/github/data/archives/571b40d3f50466d3e91c1e609d372de96d782793.tar.gz
View File

0
tests/data/archives/a489b65a5c3a29983701069d1ce395b23d9bde64.tar.gz → tests/github/data/archives/a489b65a5c3a29983701069d1ce395b23d9bde64.tar.gz
View File

0
tests/data/archives/abc51449406ba3279c466b4d356b4ae8522ceb58.tar.gz → tests/github/data/archives/abc51449406ba3279c466b4d356b4ae8522ceb58.tar.gz
View File

0
tests/data/repos/NixOS/nixpkgs-channels/commits.json → tests/github/data/repos/NixOS/nixpkgs-channels/commits.json
View File

0
tests/data/repos/NixOS/nixpkgs-channels/repository.json → tests/github/data/repos/NixOS/nixpkgs-channels/repository.json
View File

0
tests/data/repos/nmattia/niv/commits.json → tests/github/data/repos/nmattia/niv/commits.json
View File

0
tests/data/repos/nmattia/niv/repository.json → tests/github/data/repos/nmattia/niv/repository.json
View File

0
tests/default.nix → tests/github/default.nix
View File

0
tests/expected/niv-init.json → tests/github/expected/niv-init.json
View File