{-# 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 :: Bool -> (NExprLoc -> Maybe Text) -> [NExprLoc -> Maybe (M Updater)]
fetchers Bool
onlyCommented NExprLoc -> Maybe Text
getComment =
  (forall a b. (a -> b) -> a -> b
$ NExprLoc -> Maybe Text
getComment)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
.   (forall a b. (a -> b) -> a -> b
$ Bool
onlyCommented)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
fetchgitUpdater
        , Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
builtinsFetchGitUpdater
        , Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
fetchTarballGithubUpdater
        , Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
builtinsFetchTarballUpdater
        , Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
fetchurlUpdater
        , Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
fetchGitHubUpdater
        , Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
hackageDirectUpdater
        ]

fetchgitUpdater :: Fetcher
fetchgitUpdater :: Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
fetchgitUpdater Bool
onlyCommented NExprLoc -> Maybe Text
getComment = \case
  NExprLoc
[matchNixLoc|
    ^fetcher {
      url = ^url;
      rev = ^rev; # rev
      sha256 = ^sha256;
      _deepClone = ^deepClone;
      _leaveDotGit = ^leaveDotGit;
      _fetchSubmodules = ^fetchSubmodules;
    }|] | NExprLoc -> Maybe VarName
extractFuncName NExprLoc
fetcher forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [forall a. a -> Maybe a
Just VarName
"fetchgit", forall a. a -> Maybe a
Just VarName
"fetchgitPrivate"]
        , Maybe RevisionRequest
desiredRev <- Maybe Text -> Maybe RevisionRequest
commentToRequest (NExprLoc -> Maybe Text
getComment NExprLoc
rev)
        , Bool
onlyCommented Bool -> Bool -> Bool
~> forall a. Maybe a -> Bool
isJust Maybe RevisionRequest
desiredRev
    -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
      RepoLocation
url' <- forall a. Either Warning a -> M a
fromEither forall a b. (a -> b) -> a -> b
$ Text -> RepoLocation
URL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NExprLoc -> Either Warning Text
exprText NExprLoc
url
      Bool
deepClone' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Either Warning a -> M a
fromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NExprLoc -> Either Warning Bool
exprBool forall a b. (a -> b) -> a -> b
$ Maybe NExprLoc
deepClone
      Bool
leaveDotGit' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe Bool
deepClone') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Either Warning a -> M a
fromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NExprLoc -> Either Warning Bool
exprBool forall a b. (a -> b) -> a -> b
$ Maybe NExprLoc
leaveDotGit
      Bool
fetchSubmodules' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Either Warning a -> M a
fromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NExprLoc -> Either Warning Bool
exprBool forall a b. (a -> b) -> a -> b
$ Maybe NExprLoc
fetchSubmodules
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RepoLocation
-> Maybe RevisionRequest
-> Bool
-> Bool
-> Bool
-> NExprLoc
-> Maybe NExprLoc
-> Updater
gitUpdater RepoLocation
url' Maybe RevisionRequest
desiredRev Bool
deepClone' Bool
leaveDotGit' Bool
fetchSubmodules' NExprLoc
rev (forall a. a -> Maybe a
Just NExprLoc
sha256)
  NExprLoc
_ -> forall a. Maybe a
Nothing

builtinsFetchGitUpdater :: Fetcher
builtinsFetchGitUpdater :: Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
builtinsFetchGitUpdater Bool
onlyCommented NExprLoc -> Maybe Text
getComment = \case
  NExprLoc
[matchNixLoc|
    ^fetcher {
      url = ^url;
      rev = ^rev; # rev
      _submodules = ^submodules;
    }|] | Just VarName
"fetchGit" <- NExprLoc -> Maybe VarName
extractFuncName NExprLoc
fetcher
        , Maybe RevisionRequest
desiredRev <- Maybe Text -> Maybe RevisionRequest
commentToRequest (NExprLoc -> Maybe Text
getComment NExprLoc
rev)
        , Bool
onlyCommented Bool -> Bool -> Bool
~> forall a. Maybe a -> Bool
isJust Maybe RevisionRequest
desiredRev
    -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
      RepoLocation
url' <- forall a. Either Warning a -> M a
fromEither forall a b. (a -> b) -> a -> b
$ Text -> RepoLocation
URL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NExprLoc -> Either Warning Text
exprText NExprLoc
url
      Bool
submodules' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Either Warning a -> M a
fromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NExprLoc -> Either Warning Bool
exprBool forall a b. (a -> b) -> a -> b
$ Maybe NExprLoc
submodules
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RepoLocation
-> Maybe RevisionRequest
-> Bool
-> Bool
-> Bool
-> NExprLoc
-> Maybe NExprLoc
-> Updater
gitUpdater RepoLocation
url' Maybe RevisionRequest
desiredRev Bool
False Bool
False Bool
submodules' NExprLoc
rev forall a. Maybe a
Nothing
  NExprLoc
_ -> forall a. Maybe a
Nothing

fetchTarballGithubUpdater :: Fetcher
fetchTarballGithubUpdater :: Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
fetchTarballGithubUpdater Bool
onlyCommented NExprLoc -> Maybe Text
getComment = \case
  NExprLoc
[matchNixLoc|
    ^fetcher {
      url = ^url; # rev
      sha256 = ^sha256;
    }|]
    | Just VarName
"fetchTarball" <- NExprLoc -> Maybe VarName
extractFuncName NExprLoc
fetcher
    , Right Text
url' <- NExprLoc -> Either Warning Text
exprText NExprLoc
url
    , Text
"https:" : Text
"" : Text
"github.com" : Text
owner : Text
repo : Text
"archive" : [Text]
_ <- Text -> Text -> [Text]
splitOn
      Text
"/"
      Text
url'
    , Maybe Text
comment <- NExprLoc -> Maybe Text
getComment NExprLoc
url
    , Bool
onlyCommented Bool -> Bool -> Bool
~> forall a. Maybe a -> Bool
isJust Maybe Text
comment
    , Maybe Text
comment forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Text
"pin" -- Fall back to the regular tarball updater if we've been instructed to not change this URL
    -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
      let rev :: Revision
rev = Text -> Revision
Revision forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"HEAD" Maybe Text
comment
          repoUrl :: Text
repoUrl = Text
"https://github.com/" forall a. Semigroup a => a -> a -> a
<> Text
owner forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
repo
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. M (Maybe Day, [SpanUpdate]) -> Updater
Updater forall a b. (a -> b) -> a -> b
$ do
        Text
revision <- Text -> Revision -> M Text
getGitRevision Text
repoUrl Revision
rev
        let newUrl :: Text
newUrl = Text
repoUrl forall a. Semigroup a => a -> a -> a
<> Text
"/archive/" forall a. Semigroup a => a -> a -> a
<> Text
revision forall a. Semigroup a => a -> a -> a
<> Text
".tar.gz"
        let Updater M (Maybe Day, [SpanUpdate])
u = Text -> NExprLoc -> Updater
tarballUpdater Text
newUrl NExprLoc
sha256
        Day
date <- Text -> Text -> Revision -> M Day
getGitHubRevisionDate Text
owner Text
repo (Text -> Revision
Revision Text
revision)
        (Maybe Day
_, [SpanUpdate]
urlUpdate) <- M (Maybe Day, [SpanUpdate])
u
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just Day
date, SrcSpan -> Text -> SpanUpdate
SpanUpdate (NExprLoc -> SrcSpan
exprSpan NExprLoc
url) (Text -> Text
quoteString Text
newUrl) forall a. a -> [a] -> [a]
: [SpanUpdate]
urlUpdate)
  NExprLoc
_ -> forall a. Maybe a
Nothing

builtinsFetchTarballUpdater :: Fetcher
builtinsFetchTarballUpdater :: Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
builtinsFetchTarballUpdater Bool
onlyCommented NExprLoc -> Maybe Text
getComment = \case
  NExprLoc
[matchNixLoc|
    ^fetcher {
      url = ^url; # [pin]
      sha256 = ^sha256;
    }|] | Just VarName
"fetchTarball" <- NExprLoc -> Maybe VarName
extractFuncName NExprLoc
fetcher
        , Maybe Text
comment <- NExprLoc -> Maybe Text
getComment NExprLoc
url
        , Bool
onlyCommented Bool -> Bool -> Bool
~> forall a. Maybe a -> Bool
isJust Maybe Text
comment
    -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
      Text
url' <- forall a. Either Warning a -> M a
fromEither forall a b. (a -> b) -> a -> b
$ NExprLoc -> Either Warning Text
exprText NExprLoc
url
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> NExprLoc -> Updater
tarballUpdater Text
url' NExprLoc
sha256
  NExprLoc
_ -> forall a. Maybe a
Nothing

fetchurlUpdater :: Fetcher
fetchurlUpdater :: Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
fetchurlUpdater Bool
onlyCommented NExprLoc -> Maybe Text
getComment = \case
  NExprLoc
[matchNixLoc|
    ^fetcher {
      url = ^url; # [pin]
      sha256 = ^sha256;
    }|] | Just VarName
"fetchurl" <- NExprLoc -> Maybe VarName
extractFuncName NExprLoc
fetcher
        , Maybe Text
comment <- NExprLoc -> Maybe Text
getComment NExprLoc
url
        , Bool
onlyCommented Bool -> Bool -> Bool
~> forall a. Maybe a -> Bool
isJust Maybe Text
comment
    -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
      Text
url' <- forall a. Either Warning a -> M a
fromEither forall a b. (a -> b) -> a -> b
$ NExprLoc -> Either Warning Text
exprText NExprLoc
url
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> NExprLoc -> Updater
urlUpdater Text
url' NExprLoc
sha256
  NExprLoc
_ -> forall a. Maybe a
Nothing

fetchGitHubUpdater :: Fetcher
fetchGitHubUpdater :: Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
fetchGitHubUpdater Bool
onlyCommented NExprLoc -> Maybe Text
getComment = \case
  NExprLoc
[matchNixLoc|
    ^fetcher {
      owner = ^owner;
      repo = ^repo;
      rev = ^rev;
      sha256 = ^sha256;
      _fetchSubmodules = ^fetchSubmodules;
    }|] | Just Text -> Text -> RepoLocation
fun <- NExprLoc -> Maybe VarName
extractFuncName NExprLoc
fetcher forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        VarName
"fetchFromGitHub" -> forall a. a -> Maybe a
Just Text -> Text -> RepoLocation
GitHub
                        VarName
"fetchFromGitLab" -> forall a. a -> Maybe a
Just Text -> Text -> RepoLocation
GitLab
                        VarName
_ -> forall a. Maybe a
Nothing
        , Maybe RevisionRequest
desiredRev <- Maybe Text -> Maybe RevisionRequest
commentToRequest (NExprLoc -> Maybe Text
getComment NExprLoc
rev)
        , Bool
onlyCommented Bool -> Bool -> Bool
~> forall a. Maybe a -> Bool
isJust Maybe RevisionRequest
desiredRev
    -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
      Text
owner' <- forall a. Either Warning a -> M a
fromEither forall a b. (a -> b) -> a -> b
$ NExprLoc -> Either Warning Text
exprText NExprLoc
owner
      Text
repo' <- forall a. Either Warning a -> M a
fromEither forall a b. (a -> b) -> a -> b
$ NExprLoc -> Either Warning Text
exprText NExprLoc
repo
      Bool
fetchSubmodules' <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Either Warning a -> M a
fromEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NExprLoc -> Either Warning Bool
exprBool forall a b. (a -> b) -> a -> b
$ Maybe NExprLoc
fetchSubmodules
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RepoLocation
-> Maybe RevisionRequest
-> Bool
-> Bool
-> Bool
-> NExprLoc
-> Maybe NExprLoc
-> Updater
gitUpdater (Text -> Text -> RepoLocation
fun Text
owner' Text
repo') Maybe RevisionRequest
desiredRev Bool
False Bool
False Bool
fetchSubmodules' NExprLoc
rev (forall a. a -> Maybe a
Just NExprLoc
sha256)
  NExprLoc
_ -> forall a. Maybe a
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 :: Bool -> (NExprLoc -> Maybe Text) -> NExprLoc -> Maybe (M Updater)
hackageDirectUpdater Bool
onlyCommented NExprLoc -> Maybe Text
_ = \case
  NExprLoc
[matchNixLoc|
    ^fetcher {
      pkg = ^pkg;
      ver = ^ver;
      sha256 = ^sha256;
    }
  |] | Just VarName
"callHackageDirect" <- NExprLoc -> Maybe VarName
extractFuncName NExprLoc
fetcher
     , Bool -> Bool
not Bool
onlyCommented -- no comments on this one
     -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
      Text
pkg' <- forall a. Either Warning a -> M a
fromEither forall a b. (a -> b) -> a -> b
$ NExprLoc -> Either Warning Text
exprText NExprLoc
pkg
      Text
ver' <- forall a. Either Warning a -> M a
fromEither forall a b. (a -> b) -> a -> b
$ NExprLoc -> Either Warning Text
exprText NExprLoc
ver
      let pkgver :: Text
pkgver = Text
pkg' forall a. Semigroup a => a -> a -> a
<> Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
ver'
          url :: Text
url = Text
"mirror://hackage/" forall a. Semigroup a => a -> a -> a
<> Text
pkgver forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
pkgver forall a. Semigroup a => a -> a -> a
<> Text
".tar.gz"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> NExprLoc -> Updater
tarballUpdater Text
url NExprLoc
sha256
  NExprLoc
_ -> forall a. Maybe a
Nothing

----------------------------------------------------------------
-- Helpers
----------------------------------------------------------------

data RevisionRequest
  = Pin
  | DoNotPin Revision

commentToRequest :: Maybe Text -> Maybe RevisionRequest
commentToRequest :: Maybe Text -> Maybe RevisionRequest
commentToRequest = \case
  Maybe Text
Nothing    -> forall a. Maybe a
Nothing
  Just Text
"pin" -> forall a. a -> Maybe a
Just RevisionRequest
Pin
  Just Text
r     -> forall a. a -> Maybe a
Just (Revision -> RevisionRequest
DoNotPin (Text -> Revision
Revision Text
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
-> Maybe RevisionRequest
-> Bool
-> Bool
-> Bool
-> NExprLoc
-> Maybe NExprLoc
-> Updater
gitUpdater RepoLocation
repoLocation Maybe RevisionRequest
revisionRequest Bool
deepClone Bool
leaveDotGit Bool
fetchSubmodules NExprLoc
revExpr Maybe NExprLoc
sha256Expr
  = M (Maybe Day, [SpanUpdate]) -> Updater
Updater forall a b. (a -> b) -> a -> b
$ do
    let repoUrl :: Text
repoUrl = RepoLocation -> Text
extractUrlString RepoLocation
repoLocation
    Text -> M ()
logVerbose forall a b. (a -> b) -> a -> b
$ Text
"Updating " forall a. Semigroup a => a -> a -> a
<> RepoLocation -> Text
prettyRepoLocation RepoLocation
repoLocation
    [Text]
revArgs <- case Maybe RevisionRequest
revisionRequest of
      Maybe RevisionRequest
Nothing  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just RevisionRequest
req -> do
        Text
rev <- case RevisionRequest
req of
          RevisionRequest
Pin        -> forall a. Either Warning a -> M a
fromEither (NExprLoc -> Either Warning Text
exprText NExprLoc
revExpr)
          DoNotPin Revision
r -> Text -> Revision -> M Text
getGitFullName Text
repoUrl Revision
r
        forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text
"--rev", Text
rev]
    let args :: [Text]
args =
          [Text]
revArgs
            forall a. Semigroup a => a -> a -> a
<> [ Text
"--deepClone" | Bool
deepClone ]
            forall a. Semigroup a => a -> a -> a
<> [ Text
"--leave-dotGit" | Bool
leaveDotGit ]
            forall a. Semigroup a => a -> a -> a
<> [ Text
"--fetch-submodules" | Bool
fetchSubmodules ]
    NixPrefetchGitOutput
o <- [Text] -> Text -> M NixPrefetchGitOutput
nixPrefetchGit [Text]
args Text
repoUrl
    Day
d <- forall a. Either Warning a -> M a
fromEither forall a b. (a -> b) -> a -> b
$ Text -> Either Warning Day
parseISO8601DateToDay (NixPrefetchGitOutput -> Text
P.date NixPrefetchGitOutput
o)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( forall a. a -> Maybe a
Just Day
d
      , [ SrcSpan -> Text -> SpanUpdate
SpanUpdate (NExprLoc -> SrcSpan
exprSpan NExprLoc
e) (Text -> Text
quoteString (NixPrefetchGitOutput -> Text
P.sha256 NixPrefetchGitOutput
o))
        | Just NExprLoc
e <- forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NExprLoc
sha256Expr
        ]
        forall a. Semigroup a => a -> a -> a
<> [SrcSpan -> Text -> SpanUpdate
SpanUpdate (NExprLoc -> SrcSpan
exprSpan NExprLoc
revExpr) (Text -> Text
quoteString forall a b. (a -> b) -> a -> b
$ NixPrefetchGitOutput -> Text
P.rev NixPrefetchGitOutput
o)]
      )

tarballUpdater
  :: Text
  -- ^ URL
  -> NExprLoc
  -- ^ sha256
  -> Updater
tarballUpdater :: Text -> NExprLoc -> Updater
tarballUpdater Text
url NExprLoc
sha256Expr = M (Maybe Day, [SpanUpdate]) -> Updater
Updater forall a b. (a -> b) -> a -> b
$ do
  Text -> M ()
logVerbose forall a b. (a -> b) -> a -> b
$ Text
"Updating " forall a. Semigroup a => a -> a -> a
<> Text
url
  Text
sha256 <- [Text] -> Text -> M Text
nixPrefetchUrl [Text
"--unpack"] Text
url
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, [SrcSpan -> Text -> SpanUpdate
SpanUpdate (NExprLoc -> SrcSpan
exprSpan NExprLoc
sha256Expr) (Text -> Text
quoteString Text
sha256)])

urlUpdater
  :: Text
  -- ^ URL
  -> NExprLoc
  -- ^ sha256
  -> Updater
urlUpdater :: Text -> NExprLoc -> Updater
urlUpdater Text
url NExprLoc
sha256Expr = M (Maybe Day, [SpanUpdate]) -> Updater
Updater forall a b. (a -> b) -> a -> b
$ do
  Text -> M ()
logVerbose forall a b. (a -> b) -> a -> b
$ Text
"Updating " forall a. Semigroup a => a -> a -> a
<> Text
url
  Text
sha256 <- [Text] -> Text -> M Text
nixPrefetchUrl [] Text
url
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, [SrcSpan -> Text -> SpanUpdate
SpanUpdate (NExprLoc -> SrcSpan
exprSpan NExprLoc
sha256Expr) (Text -> Text
quoteString Text
sha256)])

(~>) :: Bool -> Bool -> Bool
Bool
x ~> :: Bool -> Bool -> Bool
~> Bool
y = Bool -> Bool
not Bool
x Bool -> Bool -> Bool
|| Bool
y