content: {-# 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
  