Stop using ref in builtins.fetchGit fetcher

nix/sources.nix

@@ -24,8 +24,15 @@ let
       else
         pkgs.fetchzip { name = name'; inherit (spec) url sha256; };
 
-  fetch_git = spec:
-    builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };
+  fetch_git = name: spec:
+    let
+      ref =
+        if spec ? ref then spec.ref else
+          if spec ? branch then "refs/heads/${spec.branch}" else
+            if spec ? tag then "refs/tags/${spec.tag}" else
+              abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!";
+    in
+      builtins.fetchGit { url = spec.repo; inherit (spec) rev; inherit ref; };
 
   fetch_local = spec: spec.path;
 
@@ -77,7 +84,7 @@ let
       abort "ERROR: niv spec ${name} does not have a 'type' attribute"
     else if spec.type == "file" then fetch_file pkgs name spec
     else if spec.type == "tarball" then fetch_tarball pkgs name spec
-    else if spec.type == "git" then fetch_git spec
+    else if spec.type == "git" then fetch_git name spec
     else if spec.type == "local" then fetch_local spec
     else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
     else if spec.type == "builtin-url" then fetch_builtin-url name

src/Niv/Cli.hs

@@ -176,7 +176,7 @@ cmdInit nixpkgs = do
             -- Imports @niv@ and @nixpkgs@
             say "Importing 'niv' ..."
             cmdAdd
-              (updateCmd githubCmd)
+              githubCmd
               (PackageName "niv")
               ( specToFreeAttrs $ PackageSpec $
                   HMS.fromList
@@ -191,7 +191,7 @@ cmdInit nixpkgs = do
                 let (owner, repo) = case nixpkgs' of
                       Nixpkgs o r -> (o, r)
                 cmdAdd
-                  (updateCmd githubCmd)
+                  githubCmd
                   (PackageName "nixpkgs")
                   ( specToFreeAttrs $ PackageSpec $
                       HMS.fromList
@@ -249,8 +249,8 @@ parseCmdAdd =
     -- 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)
+    parseShortcut cmd = uncurry (cmdAdd cmd) <$> (parseShortcutArgs cmd)
+    parseCmd cmd = uncurry (cmdAdd cmd) <$> (parseCmdArgs cmd)
     parseCmdAddGit =
       Opts.info (parseCmd gitCmd <**> Opts.helper) (description gitCmd)
     parseCmdAddLocal =
@@ -321,15 +321,15 @@ parseCmdArgs cmd = collapse <$> parseNameAndShortcut <*> parsePackageSpec cmd
                 <> Opts.help "Set the package name to <NAME>"
             )
 
-cmdAdd :: Update () a -> PackageName -> Attrs -> NIO ()
-cmdAdd updateFunc packageName attrs = do
+cmdAdd :: Cmd -> PackageName -> Attrs -> NIO ()
+cmdAdd cmd packageName attrs = do
   job ("Adding package " <> T.unpack (unPackageName packageName)) $ do
     fsj <- getFindSourcesJson
     sources <- unSources <$> li (getSources fsj)
     when (HMS.member packageName sources)
       $ li
       $ abortCannotAddPackageExists packageName
-    eFinalSpec <- fmap attrsToSpec <$> li (tryEvalUpdate attrs updateFunc)
+    eFinalSpec <- fmap attrsToSpec <$> li (doUpdate attrs cmd)
     case eFinalSpec of
       Left e -> li (abortUpdateFailed [(packageName, e)])
       Right finalSpec -> do
@@ -413,12 +413,8 @@ cmdUpdate = \case
                 Just "git" -> gitCmd
                 Just "local" -> localCmd
                 _ -> githubCmd
-          fmap attrsToSpec
-            <$> li
-              ( tryEvalUpdate
-                  (specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec)
-                  (updateCmd cmd)
-              )
+              spec = specToLockedAttrs cliSpec <> specToFreeAttrs defaultSpec
+          fmap attrsToSpec <$> li (doUpdate spec cmd)
         Nothing -> li $ abortCannotUpdateNoSuchPackage packageName
       case eFinalSpec of
         Left e -> li $ abortUpdateFailed [(packageName, e)]
@@ -438,20 +434,20 @@ cmdUpdate = \case
               Just "git" -> gitCmd
               Just "local" -> localCmd
               _ -> githubCmd
-        finalSpec <-
-          fmap attrsToSpec
-            <$> li
-              ( tryEvalUpdate
-                  initialSpec
-                  (updateCmd cmd)
-              )
+        finalSpec <- fmap attrsToSpec <$> li (doUpdate initialSpec cmd)
         pure finalSpec
     let (failed, sources') = partitionEithersHMS esources'
     unless (HMS.null failed)
       $ li
       $ abortUpdateFailed (HMS.toList failed)
     li $ setSources fsj $ Sources sources'
 
+-- | pretty much tryEvalUpdate but we might issue some warnings first
+doUpdate :: Attrs -> Cmd -> IO (Either SomeException Attrs)
+doUpdate attrs cmd = do
+  forM_ (extraLogs cmd attrs) $ tsay
+  tryEvalUpdate attrs (updateCmd cmd)
+
 partitionEithersHMS ::
   (Eq k, Hashable k) =>
   HMS.HashMap k (Either a b) ->

src/Niv/Cmd.hs

@@ -15,5 +15,7 @@ data Cmd
         parseCmdShortcut :: T.Text -> Maybe (PackageName, Aeson.Object),
         parsePackageSpec :: Opts.Parser PackageSpec,
         updateCmd :: Update () (),
-        name :: T.Text
+        name :: T.Text,
+        -- | Some notes to print
+        extraLogs :: Attrs -> [T.Text]
       }

src/Niv/Git/Cmd.hs

@@ -31,9 +31,28 @@ gitCmd =
       parseCmdShortcut = parseGitShortcut,
       parsePackageSpec = parseGitPackageSpec,
       updateCmd = gitUpdate',
-      name = "git"
+      name = "git",
+      extraLogs = gitExtraLogs
     }
 
+gitExtraLogs :: Attrs -> [T.Text]
+gitExtraLogs attrs = noteRef <> warnRefBranch <> warnRefTag
+  where
+    noteRef =
+      textIf (HMS.member "ref" attrs) $
+        mkNote
+          "Your source contains a `ref` attribute. Make sure your sources.nix is up-to-date and consider using a `branch` or `tag` attribute."
+    warnRefBranch =
+      textIf (member "ref" && member "branch") $
+        mkWarn
+          "Your source contains both a `ref` and a `branch`. Niv will update the `branch` but the `ref` will be used by Nix to fetch the repo."
+    warnRefTag =
+      textIf (member "ref" && member "tag") $
+        mkWarn
+          "Your source contains both a `ref` and a `tag`. The `ref` will be used by Nix to fetch the repo."
+    member x = HMS.member x attrs
+    textIf cond txt = if cond then [txt] else []
+
 parseGitShortcut :: T.Text -> Maybe (PackageName, Aeson.Object)
 parseGitShortcut txt'@(T.dropWhileEnd (== '/') -> txt) =
   -- basic heuristics for figuring out if something is a git repo
@@ -53,7 +72,7 @@ parseGitShortcut txt'@(T.dropWhileEnd (== '/') -> txt) =
 parseGitPackageSpec :: Opts.Parser PackageSpec
 parseGitPackageSpec =
   (PackageSpec . HMS.fromList)
-    <$> many (parseRepo <|> parseRef <|> parseRev <|> parseAttr <|> parseSAttr)
+    <$> many (parseRepo <|> parseBranch <|> parseRev <|> parseAttr <|> parseSAttr)
   where
     parseRepo =
       ("repo",) . Aeson.String
@@ -67,11 +86,12 @@ parseGitPackageSpec =
           ( Opts.long "rev"
               <> Opts.metavar "SHA"
           )
-    parseRef =
-      ("ref",) . Aeson.String
+    parseBranch =
+      ("branch",) . Aeson.String
         <$> Opts.strOption
-          ( Opts.long "ref"
-              <> Opts.metavar "REF"
+          ( Opts.long "branch"
+              <> Opts.short 'b'
+              <> Opts.metavar "BRANCH"
           )
     parseAttr =
       Opts.option
@@ -112,7 +132,7 @@ describeGit =
           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"
+          Opts.<$$> "  niv add git --repo /my/custom/repo --name custom --branch development"
     ]
 
 gitUpdate ::
@@ -121,34 +141,34 @@ gitUpdate ::
   -- | latest rev and default ref
   (T.Text -> IO (T.Text, T.Text)) ->
   Update () ()
-gitUpdate latestRev' defaultRefAndHEAD' = proc () -> do
+gitUpdate latestRev' defaultBranchAndRev' = proc () -> do
   useOrSet "type" -< ("git" :: Box T.Text)
   repository <- load "repo" -< ()
   discoverRev <+> discoverRefAndRev -< repository
   where
     discoverRefAndRev = proc repository -> do
-      refAndRev <- run defaultRefAndHEAD' -< repository
-      update "ref" -< fst <$> refAndRev
-      update "rev" -< snd <$> refAndRev
+      branchAndRev <- run defaultBranchAndRev' -< repository
+      update "branch" -< fst <$> branchAndRev
+      update "rev" -< snd <$> branchAndRev
       returnA -< ()
     discoverRev = proc repository -> do
-      ref <- load "ref" -< ()
-      rev <- run' (uncurry latestRev') -< (,) <$> repository <*> ref
+      branch <- load "branch" -< ()
+      rev <- run' (uncurry latestRev') -< (,) <$> repository <*> branch
       update "rev" -< rev
       returnA -< ()
 
 -- | The "real" (IO) update
 gitUpdate' :: Update () ()
-gitUpdate' = gitUpdate latestRev defaultRefAndHEAD
+gitUpdate' = gitUpdate latestRev defaultBranchAndRev
 
 latestRev ::
   -- | the repository
   T.Text ->
-  -- | the ref/branch
+  -- | the branch
   T.Text ->
   IO T.Text
-latestRev repo ref = do
-  let gitArgs = ["ls-remote", repo, "refs/heads/" <> ref]
+latestRev repo branch = do
+  let gitArgs = ["ls-remote", repo, "refs/heads/" <> branch]
   sout <- runGit gitArgs
   case sout of
     ls@(_ : _ : _) -> abortTooMuchOutput gitArgs ls
@@ -166,26 +186,26 @@ latestRev repo ref = do
       abortGitFailure args $ T.unlines $
         ["Git produced too much output:"] <> map ("  " <>) ls
 
-defaultRefAndHEAD ::
+defaultBranchAndRev ::
   -- | the repository
   T.Text ->
   IO (T.Text, T.Text)
-defaultRefAndHEAD repo = do
+defaultBranchAndRev repo = do
   sout <- runGit args
   case sout of
-    (l1 : l2 : _) -> (,) <$> parseRef l1 <*> parseRev l2
+    (l1 : l2 : _) -> (,) <$> parseBranch 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
+    parseBranch 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
+      let branch = T.takeWhile (/= '\t') refAndSym
+      if T.null branch then Nothing else Just branch
     parseRev l = maybe (abortNoRev args l) pure $ do
       checkRev $ T.takeWhile (/= '\t') l
     checkRev t = if isRev t then Just t else Nothing

src/Niv/Git/Test.hs

@@ -57,7 +57,7 @@ test_gitUpdates =
 test_gitUpdateRev :: IO ()
 test_gitUpdateRev = do
   interState <- evalUpdate initialState $ proc () ->
-    gitUpdate (error "should be def") defaultRefAndHEAD' -< ()
+    gitUpdate (error "should be def") defaultBranchAndHEAD' -< ()
   let interState' = HMS.map (first (\_ -> Free)) interState
   actualState <- evalUpdate interState' $ proc () ->
     gitUpdate latestRev' (error "should update") -< ()
@@ -66,14 +66,14 @@ test_gitUpdateRev = do
     $ "State mismatch: " <> show actualState
   where
     latestRev' _ _ = pure "some-other-rev"
-    defaultRefAndHEAD' _ = pure ("some-ref", "some-rev")
+    defaultBranchAndHEAD' _ = pure ("some-branch", "some-rev")
     initialState =
       HMS.fromList
         [("repo", (Free, "git@github.com:nmattia/niv"))]
     expectedState =
       HMS.fromList
         [ ("repo", "git@github.com:nmattia/niv"),
-          ("ref", "some-ref"),
+          ("branch", "some-branch"),
           ("rev", "some-other-rev"),
           ("type", "git")
         ]
@@ -104,10 +104,10 @@ once2 f = do
 -- the update
 test_gitCalledOnce :: IO ()
 test_gitCalledOnce = do
-  defaultRefAndHEAD'' <- once1 defaultRefAndHEAD'
+  defaultBranchAndHEAD'' <- once1 defaultBranchAndHEAD'
   latestRev'' <- once2 latestRev'
   interState <- evalUpdate initialState $ proc () ->
-    gitUpdate (error "should be def") defaultRefAndHEAD'' -< ()
+    gitUpdate (error "should be def") defaultBranchAndHEAD'' -< ()
   let interState' = HMS.map (first (\_ -> Free)) interState
   actualState <- evalUpdate interState' $ proc () ->
     gitUpdate latestRev'' (error "should update") -< ()
@@ -116,14 +116,14 @@ test_gitCalledOnce = do
     $ "State mismatch: " <> show actualState
   where
     latestRev' _ _ = pure "some-other-rev"
-    defaultRefAndHEAD' _ = pure ("some-ref", "some-rev")
+    defaultBranchAndHEAD' _ = pure ("some-branch", "some-rev")
     initialState =
       HMS.fromList
         [("repo", (Free, "git@github.com:nmattia/niv"))]
     expectedState =
       HMS.fromList
         [ ("repo", "git@github.com:nmattia/niv"),
-          ("ref", "some-ref"),
+          ("branch", "some-branch"),
           ("rev", "some-other-rev"),
           ("type", "git")
         ]

src/Niv/GitHub/Cmd.hs

@@ -38,7 +38,8 @@ githubCmd =
       parseCmdShortcut = parseAddShortcutGitHub,
       parsePackageSpec = parseGitHubPackageSpec,
       updateCmd = githubUpdate',
-      name = "github"
+      name = "github",
+      extraLogs = const []
       -- TODO: here filter by type == tarball or file or builtin-
     }
 

src/Niv/Local/Cmd.hs

@@ -27,7 +27,8 @@ localCmd =
       updateCmd = proc () -> do
         useOrSet "type" -< ("local" :: Box T.Text)
         returnA -< (),
-      name = "local"
+      name = "local",
+      extraLogs = const []
     }
 
 parseLocalShortcut :: T.Text -> Maybe (PackageName, Aeson.Object)

src/Niv/Logger.hs

@@ -8,6 +8,9 @@ module Niv.Logger
     bug,
     tsay,
     say,
+    twarn,
+    mkWarn,
+    mkNote,
     green,
     tgreen,
     red,
@@ -73,6 +76,15 @@ say msg = do
   -- the end
   liftIO $ putStrLn $ intercalate "\n" $ (indent <>) <$> lines msg
 
+mkWarn :: T.Text -> T.Text
+mkWarn w = tbold (tyellow "WARNING") <> ": " <> w
+
+twarn :: MonadIO io => T.Text -> io ()
+twarn = tsay . mkWarn
+
+mkNote :: T.Text -> T.Text
+mkNote w = tbold (tblue "NOTE") <> ": " <> w
+
 green :: S
 green str =
   ANSI.setSGRCode [ANSI.SetConsoleIntensity ANSI.BoldIntensity]