Merge pull request #49 from expipiplus1/dry-run

more options

CHANGELOG.md

@@ -2,6 +2,15 @@
 
 ## WIP
 
+## [0.2.4] - 2020-11-11
+
+- Add --dry-run option
+- Sort tags with git ls-remote with `-v:refname` (according to version)
+  - this allows one to have a comment like `# tags/v*` to get the latest
+    version
+- Add --only-commented option to allow being a bit more explicit about what's
+  updated
+
 ## [0.2.3] - 2020-11-06
 
 - Implement filtering updates based on binding name

README.md

@@ -26,7 +26,10 @@ Additionally if the `rev` (for git fetches) or `url` attribute has a comment:
 - `pin`: the revision or URL will not be updated, only the hash will be
   changed
 - Anything else: the `rev` or `url` parameter will be updated to point to the
-  revision pointed to by the branch or tag named in the comment.
+  revision pointed to by the branch or tag named in the comment. This is in the
+  format expected by `git ls-remote` so if the expression has `rev = _; #
+  tags/v*` it will be updated to the latest tag beginning with `v`, sorted by
+  version.
 
 ## Usage
 
@@ -44,6 +47,11 @@ syntactic match so complicated invocations of the fetchers may not be picked
 up; see [./src/Update/Nix/Updater.hs](./src/Update/Nix/Updater) to look at the
 shapes of Nix expressions which are matched.
 
+If you pass `--only-commented` only expressions which have a comment on the
+`rev` or `url` attribute will be updated. This can be useful for updating files
+en-mass with some control over which expressions are modified with a command
+like: `fd .nix --exec update-nix-fetchgit --only-commented`
+
 Please open an issue if `update-nix-fetchgit` doesn't recognize a fetcher and
 you think it could.
 

app/Main.hs

@@ -4,6 +4,7 @@ module Main
   ( main
   ) where
 
+import           Data.Bool
 import           Data.Foldable
 import qualified Data.Text.IO                  as T
 import           Data.Version                   ( showVersion )
@@ -47,19 +48,23 @@ env Options {..} =
           Normal  -> sayErr
           Quiet   -> sayErr
       updateLocations = [ (l, c) | Position l c <- location ]
-      attrPatterns = attribute
-  in Env { .. }
+      attrPatterns    = attribute
+      dryness         = bool Wet Dry dryRun
+  in  Env { .. }
 
 ----------------------------------------------------------------
 -- Options
 ----------------------------------------------------------------
 
 data Options w = Options
-  { verbose  :: w ::: Bool <!> "False"
-  , quiet    :: w ::: Bool <!> "False"
-  , location :: w ::: [Position] <?> "Source location to limit updates to, Combined using inclusive or"
+  { verbose :: w ::: Bool <!> "False"
+  , quiet   :: w ::: Bool <!> "False"
+  , location
+      :: w ::: [Position] <?> "Source location to limit updates to, Combined using inclusive or"
   , attribute
       :: w ::: [Regex] <?> "Pattern (POSIX regex) to limit updates to expressions under matching names in attrsets and let bindings. Combined using inclusing or, if this isn't specified then no expressions will be filtered by attribute name"
+  , dryRun :: w ::: Bool <!> "False" <?> "Don't modify the file"
+  , onlyCommented :: w ::: Bool <!> "False" <?> "Only update from Git sources which have a comment on the 'rev' (or 'url' for fetchTarball from GitHub) attribute"
   }
   deriving stock Generic
 
@@ -80,6 +85,10 @@ optParser =
               { shortNameModifier = \case
                                       "attribute" -> Just 'A'
                                       n           -> firstLetter n
+              , fieldNameModifier = \case
+                                      "dryRun"        -> "dry-run"
+                                      "onlyCommented" -> "only-commented"
+                                      n               -> n
               }
             )
         <*> many

default.nix

@@ -7,7 +7,7 @@ let
     if compiler == null then haskellPackages else haskell.packages.${compiler};
 
 in hp.developPackage {
-  name = "";
+  name = "update-nix-fetchgit";
   root = nix-gitignore.gitignoreSource [ ] ./.;
   overrides = self: _super: {
     optparse-generic = self.optparse-generic_1_4_4;

package.yaml

@@ -1,5 +1,5 @@
 name: update-nix-fetchgit
-version: "0.2.3"
+version: "0.2.4"
 synopsis: A program to update fetchgit values in Nix expressions
 description: |
   This command-line utility is meant to be used by people maintaining Nix

src/Update/Nix/FetchGit.hs

@@ -46,7 +46,9 @@ processText :: Env -> Text -> IO Text
 processText env t = do
   (es, t') <- runM env (updatesFromText t <&> (`updateSpans` t))
   traverse_ (sayLog env Normal . formatWarning) es
-  maybe exitFailure pure t'
+  maybe exitFailure pure $ case dryness env of
+    Wet -> t'
+    Dry -> Just t
 
 -- | Given the path to a Nix file, returns the SpanUpdates
 -- all the parts of the file we want to update.
@@ -79,7 +81,7 @@ findUpdates getComment e = do
     then pure $ Node Nothing []
     else
       let
-        updaters     = ($ e) <$> fetchers getComment
+        updaters     = ($ e) <$> fetchers onlyCommented getComment
         bindingTrees = \case
           NamedVar p e' _ | Just t <- pathText p ->
             (: []) . (Just t, ) <$> findUpdates getComment e'
@@ -127,6 +129,7 @@ evalUpdates = fmap snd . go
   go = \case
     UpdaterNode (Updater u) -> u
     Node versionExpr cs     -> do
+      -- Run over all children
       (ds, ss) <- unzip . catMaybes <$> traverse (tolerate . go . snd) cs
       -- Update version string with the maximum of versions in the children
       let latestDate = maximumMay (catMaybes ds)

src/Update/Nix/FetchGit/Prefetch.hs

@@ -1,4 +1,3 @@
-
 module Update.Nix.FetchGit.Prefetch
   ( NixPrefetchGitOutput(..)
   , nixPrefetchGit
@@ -31,11 +30,12 @@ import           Update.Nix.FetchGit.Warning
 
 
 -- | The type of nix-prefetch-git's output
-data NixPrefetchGitOutput = NixPrefetchGitOutput{ url    :: Text
-                                                , rev    :: Text
-                                                , sha256 :: Text
-                                                , date   :: Text
-                                                }
+data NixPrefetchGitOutput = NixPrefetchGitOutput
+  { url    :: Text
+  , rev    :: Text
+  , sha256 :: Text
+  , date   :: Text
+  }
   deriving (Show, Generic, FromJSON)
 
 -- | Run nix-prefetch-git
@@ -86,10 +86,9 @@ getGitFullName
   -> M Text
   -- ^ Full name, i.e. with refs/heads/ or refs/tags/
 getGitFullName repo revision = do
-  (stdoutText, rs) <- gitLsRemotes repo revision
-  case rs of
-    [_hash, name] : _ -> pure name
-    _                 -> refute1 $ InvalidGitLsRemoteOutput stdoutText
+  gitLsRemotes repo revision >>= \case
+    Just (_hash, name) -> pure name
+    Nothing            -> refute1 $ NoSuchRef (unRevision revision)
 
 -- | Return a tag or a hash
 getGitRevision
@@ -98,27 +97,31 @@ getGitRevision
   -> Revision
   -- ^ branch or tag name
   -> M Text
-  -- ^ Full name, i.e. with refs/heads/ or refs/tags/
 getGitRevision repo revision = do
-  (stdoutText, rs) <- gitLsRemotes repo revision
-  case rs of
-    [hash, name] : _ | Just tag <- stripPrefix "refs/tags/" name -> pure tag
-                     | otherwise -> pure hash
-    _ -> refute1 $ InvalidGitLsRemoteOutput stdoutText
+  gitLsRemotes repo revision >>= \case
+    Just (hash, name) | Just tag <- stripPrefix "refs/tags/" name -> pure tag
+                      | otherwise -> pure hash
+    Nothing -> refute1 $ NoSuchRef (unRevision revision)
 
-gitLsRemotes :: Text -> Revision -> M (Text, [[Text]])
+-- | Run git ls-remote --sort=-v:refname and return the first match if any
+gitLsRemotes :: Text -> Revision -> M (Maybe (Text, Text))
 gitLsRemotes repo revision = do
   (exitCode, nsStdout, nsStderr) <- liftIO $ readProcessWithExitCode
     "git"
-    ["ls-remote", T.unpack repo, T.unpack (unRevision revision)]
+    [ "ls-remote"
+    , "--sort=-v:refname"
+    , T.unpack repo
+    , T.unpack (unRevision revision)
+    ]
     ""
   case exitCode of
     ExitFailure e -> refute1 (NixPrefetchGitFailed e (pack nsStderr))
     ExitSuccess   -> pure ()
   let stdoutText = T.pack nsStdout
   case fmap T.words . T.lines $ stdoutText of
-    [] -> refute1 (NoSuchRef (unRevision revision))
-    rs -> pure (stdoutText, rs)
+    []               -> pure Nothing
+    [hash, name] : _ -> pure $ Just (hash, name)
+    _                -> refute1 (InvalidGitLsRemoteOutput stdoutText)
 
 getGitHubRevisionDate :: Text -> Text -> Revision -> M Day
 getGitHubRevisionDate owner repo revision = do
@@ -156,6 +159,5 @@ parseSHA256 t = do
   base32Length   = (sha256HashSize * 8 - 1) `quot` 5 + 1
 
 stripPrefix :: Text -> Text -> Maybe Text
-stripPrefix p t = if p `T.isPrefixOf` t
-                    then Just $ T.drop (T.length p) t
-                    else Nothing
+stripPrefix p t =
+  if p `T.isPrefixOf` t then Just $ T.drop (T.length p) t else Nothing

src/Update/Nix/FetchGit/Types.hs

@@ -32,8 +32,13 @@ data Env = Env
   { sayLog          :: Verbosity -> Text -> IO ()
   , updateLocations :: [(Int, Int)]
   , attrPatterns    :: [Regex]
+  , dryness         :: Dryness
+  , onlyCommented   :: Bool
   }
 
+-- | Is this a dry run or not
+data Dryness = Dry | Wet
+
 data Verbosity
   = Verbose
   | Normal

src/Update/Nix/Updater.hs

@@ -24,11 +24,14 @@ import           Update.Nix.FetchGit.Types
 import           Update.Nix.FetchGit.Utils
 import           Update.Span
 
-type Fetcher = (NExprLoc -> Maybe Comment) -> NExprLoc -> Maybe (M Updater)
+type Fetcher
+  = Bool -> (NExprLoc -> Maybe Comment) -> NExprLoc -> Maybe (M Updater)
 
-fetchers :: (NExprLoc -> Maybe Comment) -> [NExprLoc -> Maybe (M Updater)]
-fetchers getComment =
+fetchers
+  :: Bool -> (NExprLoc -> Maybe Comment) -> [NExprLoc -> Maybe (M Updater)]
+fetchers onlyCommented getComment =
   ($ getComment)
+    .   ($ onlyCommented)
     <$> [ fetchgitUpdater
         , builtinsFetchGitUpdater
         , fetchTarballGithubUpdater
@@ -38,7 +41,7 @@ fetchers getComment =
         ]
 
 fetchgitUpdater :: Fetcher
-fetchgitUpdater getComment = \case
+fetchgitUpdater onlyCommented getComment = \case
   [matchNixLoc|
     ^fetcher {
       url = ^url;
@@ -48,32 +51,34 @@ fetchgitUpdater getComment = \case
       _leaveDotGit = ^leaveDotGit;
       _fetchSubmodules = ^fetchSubmodules;
     }|] | extractFuncName fetcher `elem` [Just "fetchgit", Just "fetchgitPrivate"]
+        , desiredRev <- commentToRequest (getComment rev)
+        , onlyCommented ~> isJust desiredRev
     -> Just $ do
       url' <- fromEither $ URL <$> exprText url
-      let desiredRev = commentToRequest (getComment rev)
       deepClone' <- fmap (fromMaybe False) . fromEither . traverse exprBool $ deepClone
       leaveDotGit' <- fmap (fromMaybe deepClone') . fromEither . traverse exprBool $ leaveDotGit
       fetchSubmodules' <- fmap (fromMaybe True) . fromEither . traverse exprBool $ fetchSubmodules
       pure $ gitUpdater url' desiredRev deepClone' leaveDotGit' fetchSubmodules' rev (Just sha256)
   _ -> Nothing
 
 builtinsFetchGitUpdater :: Fetcher
-builtinsFetchGitUpdater getComment = \case
+builtinsFetchGitUpdater onlyCommented getComment = \case
   [matchNixLoc|
     ^fetcher {
       url = ^url;
       rev = ^rev; # rev
       _submodules = ^submodules;
     }|] | Just "fetchGit" <- extractFuncName fetcher
+        , desiredRev <- commentToRequest (getComment rev)
+        , onlyCommented ~> isJust desiredRev
     -> Just $ do
       url' <- fromEither $ URL <$> exprText url
-      let desiredRev = commentToRequest (getComment rev)
       submodules' <- fmap (fromMaybe False) . fromEither . traverse exprBool $ submodules
       pure $ gitUpdater url' desiredRev False False submodules' rev Nothing
   _ -> Nothing
 
 fetchTarballGithubUpdater :: Fetcher
-fetchTarballGithubUpdater getComment = \case
+fetchTarballGithubUpdater onlyCommented getComment = \case
   [matchNixLoc|
     ^fetcher {
       url = ^url; # rev
@@ -85,6 +90,7 @@ fetchTarballGithubUpdater getComment = \case
       "/"
       url'
     , comment <- getComment url
+    , onlyCommented ~> isJust comment
     , comment /= Just "pin" -- Fall back to the regular tarball updater if we've been instructed to not change this URL
     -> Just $ do
       let rev = Revision $ fromMaybe "HEAD" comment
@@ -99,19 +105,21 @@ fetchTarballGithubUpdater getComment = \case
   _ -> Nothing
 
 builtinsFetchTarballUpdater :: Fetcher
-builtinsFetchTarballUpdater _ = \case
+builtinsFetchTarballUpdater onlyCommented getComment = \case
   [matchNixLoc|
     ^fetcher {
-      url = ^url;
+      url = ^url; # [pin]
       sha256 = ^sha256;
     }|] | Just "fetchTarball" <- extractFuncName fetcher
+        , comment <- getComment url
+        , onlyCommented ~> isJust comment
     -> Just $ do
       url' <- fromEither $ exprText url
       pure $ tarballUpdater url' sha256
   _ -> Nothing
 
 fetchGitHubUpdater :: Fetcher
-fetchGitHubUpdater getComment = \case
+fetchGitHubUpdater onlyCommented getComment = \case
   [matchNixLoc|
     ^fetcher {
       owner = ^owner;
@@ -123,10 +131,11 @@ fetchGitHubUpdater getComment = \case
                         "fetchFromGitHub" -> Just GitHub
                         "fetchFromGitLab" -> Just GitLab
                         _ -> Nothing
+        , desiredRev <- commentToRequest (getComment rev)
+        , onlyCommented ~> isJust desiredRev
     -> Just $ do
       owner' <- fromEither $ exprText owner
       repo' <- fromEither $ exprText repo
-      let desiredRev = commentToRequest (getComment rev)
       fetchSubmodules' <- fmap (fromMaybe False) . fromEither . traverse exprBool $ fetchSubmodules
       pure $ gitUpdater (fun owner' repo') desiredRev False False fetchSubmodules' rev (Just sha256)
   _ -> Nothing
@@ -141,14 +150,15 @@ fetchGitHubUpdater getComment = \case
 --      });
 -- @
 hackageDirectUpdater :: Fetcher
-hackageDirectUpdater _ = \case
+hackageDirectUpdater onlyCommented _ = \case
   [matchNixLoc|
     ^fetcher {
       pkg = ^pkg;
       ver = ^ver;
       sha256 = ^sha256;
     }
   |] | Just "callHackageDirect" <- extractFuncName fetcher
+     , not onlyCommented -- no comments on this one
      -> Just $ do
       pkg' <- fromEither $ exprText pkg
       ver' <- fromEither $ exprText ver
@@ -223,3 +233,6 @@ tarballUpdater url sha256Expr = Updater $ do
   logVerbose $ "Updating " <> url
   sha256 <- nixPrefetchUrl [] url
   pure (Nothing, [SpanUpdate (exprSpan sha256Expr) (quoteString sha256)])
+
+(~>) :: Bool -> Bool -> Bool
+x ~> y = not x || y

tests/Samples.hs

@@ -17,9 +17,11 @@ import qualified System.IO
 import qualified System.IO.Temp
 import qualified System.Process
 
+import           Data.Text.IO                   ( hPutStrLn )
 import qualified Update.Nix.FetchGit
-import           Update.Nix.FetchGit.Types (Env(Env))
-import Data.Text.IO (hPutStrLn)
+import           Update.Nix.FetchGit.Types      ( Dryness(..)
+                                                , Env(Env)
+                                                )
 
 -- | Provided output file @f@ pointing to e.g. @tests/test_rec_sets.out.nix@
 -- * turn this into @tests/test_rec_sets.in.nix@
@@ -60,7 +62,7 @@ runTest f =
         (System.Process.shell ("nix-store --init"))
         mempty
 
-  let env = Env (const (Data.Text.IO.hPutStrLn System.IO.stderr)) [] []
+  let env = Env (const (Data.Text.IO.hPutStrLn System.IO.stderr)) [] [] Wet False
   Update.Nix.FetchGit.processFile env (dir </> inBase)
 
   replaceFile (dir </> inBase) (Data.Text.pack dir) "/tmp/nix-update-fetchgit-test"

tests/networked/test_latest_tag.expected.nix

@@ -0,0 +1,6 @@
+fetchFromGitHub {
+  owner = "expipiplus1";
+  repo = "update-nix-fetchgit";
+  rev = "e38aedf11616eb74d06cf99a5244290eef5d404e"; # tags/0.1*
+  sha256 = "1k8mxdp789lp3pwcm8i8dz65yjcsx5ijz1fmiwghwr4kzsa6z20c";
+}