{-# LANGUAGE QuasiQuotes #-}
-- | This module exports a list of 'Fetcher's, programs which match on nix
-- fetching expressions and return programs to update them
module Update.Nix.Updater
( fetchers
) where
import Data.Maybe
import Data.Text ( Text
, splitOn
)
import Nix ( NExprLoc )
import Nix.Comments
import Nix.Match.Typed
import qualified Update.Nix.FetchGit.Prefetch as P
import Update.Nix.FetchGit.Prefetch ( Revision(..)
, getGitFullName
, getGitHubRevisionDate
, getGitRevision
, nixPrefetchGit
, nixPrefetchUrl
)
import Update.Nix.FetchGit.Types
import Update.Nix.FetchGit.Utils
import Update.Span
type Fetcher
= Bool -> (NExprLoc -> Maybe Comment) -> NExprLoc -> Maybe (M Updater)
fetchers
:: Bool -> (NExprLoc -> Maybe Comment) -> [NExprLoc -> Maybe (M Updater)]
fetchers onlyCommented getComment =
($ getComment)
. ($ onlyCommented)
<$> [ fetchgitUpdater
, builtinsFetchGitUpdater
, fetchTarballGithubUpdater
, builtinsFetchTarballUpdater
, fetchurlUpdater
, fetchGitHubUpdater
, hackageDirectUpdater
]
fetchgitUpdater :: Fetcher
fetchgitUpdater onlyCommented getComment = \case
[matchNixLoc|
^fetcher {
url = ^url;
rev = ^rev; # rev
sha256 = ^sha256;
_deepClone = ^deepClone;
_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
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 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
submodules' <- fmap (fromMaybe False) . fromEither . traverse exprBool $ submodules
pure $ gitUpdater url' desiredRev False False submodules' rev Nothing
_ -> Nothing
fetchTarballGithubUpdater :: Fetcher
fetchTarballGithubUpdater onlyCommented getComment = \case
[matchNixLoc|
^fetcher {
url = ^url; # rev
sha256 = ^sha256;
}|]
| Just "fetchTarball" <- extractFuncName fetcher
, Right url' <- exprText url
, "https:" : "" : "github.com" : owner : repo : "archive" : _ <- splitOn
"/"
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
repoUrl = "https://github.com/" <> owner <> "/" <> repo
pure . Updater $ do
revision <- getGitRevision repoUrl rev
let newUrl = repoUrl <> "/archive/" <> revision <> ".tar.gz"
let Updater u = tarballUpdater newUrl sha256
date <- getGitHubRevisionDate owner repo (Revision revision)
(_, urlUpdate) <- u
pure (Just date, SpanUpdate (exprSpan url) (quoteString newUrl) : urlUpdate)
_ -> Nothing
builtinsFetchTarballUpdater :: Fetcher
builtinsFetchTarballUpdater onlyCommented getComment = \case
[matchNixLoc|
^fetcher {
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
fetchurlUpdater :: Fetcher
fetchurlUpdater onlyCommented getComment = \case
[matchNixLoc|
^fetcher {
url = ^url; # [pin]
sha256 = ^sha256;
}|] | Just "fetchurl" <- extractFuncName fetcher
, comment <- getComment url
, onlyCommented ~> isJust comment
-> Just $ do
url' <- fromEither $ exprText url
pure $ urlUpdater url' sha256
_ -> Nothing
fetchGitHubUpdater :: Fetcher
fetchGitHubUpdater onlyCommented getComment = \case
[matchNixLoc|
^fetcher {
owner = ^owner;
repo = ^repo;
rev = ^rev;
sha256 = ^sha256;
_fetchSubmodules = ^fetchSubmodules;
}|] | Just fun <- extractFuncName fetcher >>= \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
fetchSubmodules' <- fmap (fromMaybe False) . fromEither . traverse exprBool $ fetchSubmodules
pure $ gitUpdater (fun owner' repo') desiredRev False False fetchSubmodules' rev (Just sha256)
_ -> Nothing
-- |
-- @
-- callHackageDirect = {pkg, ver, sha256}:
-- let pkgver = "${pkg}-${ver}";
-- in self.callCabal2nix pkg (pkgs.fetchzip {
-- url = "mirror://hackage/${pkgver}/${pkgver}.tar.gz";
-- inherit sha256;
-- });
-- @
hackageDirectUpdater :: Fetcher
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
let pkgver = pkg' <> "-" <> ver'
url = "mirror://hackage/" <> pkgver <> "/" <> pkgver <> ".tar.gz"
pure $ tarballUpdater url sha256
_ -> Nothing
----------------------------------------------------------------
-- Helpers
----------------------------------------------------------------
data RevisionRequest
= Pin
| DoNotPin Revision
commentToRequest :: Maybe Text -> Maybe RevisionRequest
commentToRequest = \case
Nothing -> Nothing
Just "pin" -> Just Pin
Just r -> Just (DoNotPin (Revision r))
gitUpdater
:: RepoLocation
-- ^ Repo URL
-> Maybe RevisionRequest
-- ^ Desired revision
-> Bool
-- ^ Deep Clone
-> Bool
-- ^ Leave .git
-> Bool
-- ^ Fetch submodules
-> NExprLoc
-- ^ rev
-> Maybe NExprLoc
-- ^ sha256, not present for some fetchers
-> Updater
gitUpdater repoLocation revisionRequest deepClone leaveDotGit fetchSubmodules revExpr sha256Expr
= Updater $ do
let repoUrl = extractUrlString repoLocation
logVerbose $ "Updating " <> prettyRepoLocation repoLocation
revArgs <- case revisionRequest of
Nothing -> pure []
Just req -> do
rev <- case req of
Pin -> fromEither (exprText revExpr)
DoNotPin r -> getGitFullName repoUrl r
pure ["--rev", rev]
let args =
revArgs
<> [ "--deepClone" | deepClone ]
<> [ "--leave-dotGit" | leaveDotGit ]
<> [ "--fetch-submodules" | fetchSubmodules ]
o <- nixPrefetchGit args repoUrl
d <- fromEither $ parseISO8601DateToDay (P.date o)
pure
( Just d
, [ SpanUpdate (exprSpan e) (quoteString (P.sha256 o))
| Just e <- pure sha256Expr
]
<> [SpanUpdate (exprSpan revExpr) (quoteString $ P.rev o)]
)
tarballUpdater
:: Text
-- ^ URL
-> NExprLoc
-- ^ sha256
-> Updater
tarballUpdater url sha256Expr = Updater $ do
logVerbose $ "Updating " <> url
sha256 <- nixPrefetchUrl ["--unpack"] url
pure (Nothing, [SpanUpdate (exprSpan sha256Expr) (quoteString sha256)])
urlUpdater
:: Text
-- ^ URL
-> NExprLoc
-- ^ sha256
-> Updater
urlUpdater 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