{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Copyright: (c) 2021-2025 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <[email protected]>
-- Stability: experimental
-- Portability: portable
module NvFetcher.Core
  ( Core (..),
    coreRules,
    runPackage,
  )
where

import Data.Coerce (coerce)
import qualified Data.HashMap.Strict as HMap
import Development.Shake
import Development.Shake.Rule
import NvFetcher.ExtractSrc
import NvFetcher.FetchRustGitDeps
import NvFetcher.GetGitCommitDate
import NvFetcher.NixFetcher
import NvFetcher.Nvchecker
import NvFetcher.Types
import NvFetcher.Types.ShakeExtras

-- | The core rule of nvchecker.
-- all rules are wired here.
coreRules :: Rules ()
coreRules :: Rules ()
coreRules = do
  Rules ()
nvcheckerRule
  Rules ()
prefetchRule
  Rules ()
extractSrcRule
  Rules ()
fetchRustGitDepsRule
  Rules ()
getGitCommitDateRule
  BuiltinLint (WithPackageKey Core) (Maybe PackageResult)
-> BuiltinIdentity (WithPackageKey Core) (Maybe PackageResult)
-> BuiltinRun (WithPackageKey Core) (Maybe PackageResult)
-> Rules ()
forall key value.
(RuleResult key ~ value, ShakeValue key, Typeable value,
 NFData value, Show value, Partial) =>
BuiltinLint key value
-> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()
addBuiltinRule BuiltinLint (WithPackageKey Core) (Maybe PackageResult)
forall key value. BuiltinLint key value
noLint BuiltinIdentity (WithPackageKey Core) (Maybe PackageResult)
forall key value. BuiltinIdentity key value
noIdentity (BuiltinRun (WithPackageKey Core) (Maybe PackageResult)
 -> Rules ())
-> BuiltinRun (WithPackageKey Core) (Maybe PackageResult)
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \(WithPackageKey (Core
Core, PackageKey
pkg)) Maybe ByteString
_ RunMode
_ -> do
    -- It's important to always rerun since the package definition is not tracked at all
    -- Also we generate new files in the build directory
    Action ()
alwaysRerun
    PackageKey -> Action (Maybe Package)
lookupPackage PackageKey
pkg Action (Maybe Package)
-> (Maybe Package -> Action (RunResult (Maybe PackageResult)))
-> Action (RunResult (Maybe PackageResult))
forall a b. Action a -> (a -> Action b) -> Action b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Package
Nothing -> String -> Action (RunResult (Maybe PackageResult))
forall a. String -> Action a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action (RunResult (Maybe PackageResult)))
-> String -> Action (RunResult (Maybe PackageResult))
forall a b. (a -> b) -> a -> b
$ String
"Unknown package key: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> PackageKey -> String
forall a. Show a => a -> String
show PackageKey
pkg
      Just
        Package
          { _pversion :: Package -> CheckVersion
_pversion = CheckVersion VersionSource
versionSource NvcheckerOptions
options,
            _ppassthru :: Package -> PackagePassthru
_ppassthru = (PackagePassthru HashMap Text Text
passthru),
            Maybe PackageCargoLockFiles
Maybe PackageExtractSrc
(GitDateFormat, GitTimeZone)
Text
UseStaleVersion
ForceFetch
PackageFetcher
_pname :: Text
_pfetcher :: PackageFetcher
_pextract :: Maybe PackageExtractSrc
_pcargo :: Maybe PackageCargoLockFiles
_ppinned :: UseStaleVersion
_pgitdate :: (GitDateFormat, GitTimeZone)
_pforcefetch :: ForceFetch
_pforcefetch :: Package -> ForceFetch
_pgitdate :: Package -> (GitDateFormat, GitTimeZone)
_ppinned :: Package -> UseStaleVersion
_pcargo :: Package -> Maybe PackageCargoLockFiles
_pextract :: Package -> Maybe PackageExtractSrc
_pfetcher :: Package -> PackageFetcher
_pname :: Package -> Text
..
          } -> do
          _prversion@(NvcheckerResult version _mOldV _isStale) <- VersionSource
-> NvcheckerOptions -> PackageKey -> Action NvcheckerResult
checkVersion VersionSource
versionSource NvcheckerOptions
options PackageKey
pkg
          _prfetched <- prefetch (_pfetcher version) _pforcefetch
          -- If we fail to prefetch, we should fail on this package
          case _prfetched of
            Just NixFetcher 'Fetched
_prfetched -> do
              -- extract src
              _prextract <-
                case Maybe PackageExtractSrc
_pextract of
                  Just (PackageExtractSrc NonEmpty Glob
extract) -> do
                    result <- NixFetcher 'Fetched
-> NonEmpty Glob -> Action (HashMap String String)
extractSrcs NixFetcher 'Fetched
_prfetched NonEmpty Glob
extract
                    pure $ Just result
                  Maybe PackageExtractSrc
_ -> Maybe (HashMap String String)
-> Action (Maybe (HashMap String String))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HashMap String String)
forall a. Maybe a
Nothing
              -- cargo locks
              _prcargolock <-
                case _pcargo of
                  Just (PackageCargoLockFiles NonEmpty Glob
lockPath) -> do
                    lockFiles <- HashMap String String -> [(String, String)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (HashMap String String -> [(String, String)])
-> Action (HashMap String String) -> Action [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixFetcher 'Fetched
-> NonEmpty Glob -> Action (HashMap String String)
extractSrcs NixFetcher 'Fetched
_prfetched NonEmpty Glob
lockPath
                    result <- parallel $
                      flip fmap lockFiles $ \(String
srcLockPath, String
dstLockPath) -> do
                        result <- NixFetcher 'Fetched -> String -> Action (HashMap Text Checksum)
fetchRustGitDeps NixFetcher 'Fetched
_prfetched String
srcLockPath
                        pure (srcLockPath, (dstLockPath, result))
                    pure . Just $ HMap.fromList result
                  Maybe PackageCargoLockFiles
_ -> Maybe (HashMap String (String, HashMap Text Checksum))
-> Action (Maybe (HashMap String (String, HashMap Text Checksum)))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HashMap String (String, HashMap Text Checksum))
forall a. Maybe a
Nothing

              -- Only git version source supports git commit date
              _prgitdate <- case versionSource of
                Git {Text
Branch
_vurl :: Text
_vbranch :: Branch
_vbranch :: VersionSource -> Branch
_vurl :: VersionSource -> Text
..} -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Action Text -> Action (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> (GitDateFormat, GitTimeZone) -> Action Text
getGitCommitDate Text
_vurl (Version -> Text
forall a b. Coercible a b => a -> b
coerce Version
version) (GitDateFormat, GitTimeZone)
_pgitdate
                VersionSource
_ -> Maybe Text -> Action (Maybe Text)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

              -- update changelog
              -- always use on disk version
              mOldV <- getLastVersionOnDisk pkg
              case mOldV of
                Maybe Version
Nothing ->
                  Text -> Maybe Version -> Version -> Action ()
recordVersionChange Text
_pname Maybe Version
forall a. Maybe a
Nothing Version
version
                Just Version
old
                  | Version
old Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
version ->
                      Text -> Maybe Version -> Version -> Action ()
recordVersionChange Text
_pname (Version -> Maybe Version
forall a. a -> Maybe a
Just Version
old) Version
version
                Maybe Version
_ -> () -> Action ()
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

              let _prpassthru = if HashMap Text Text -> Bool
forall k v. HashMap k v -> Bool
HMap.null HashMap Text Text
passthru then Maybe (HashMap Text Text)
forall a. Maybe a
Nothing else HashMap Text Text -> Maybe (HashMap Text Text)
forall a. a -> Maybe a
Just HashMap Text Text
passthru
                  _prname = Text
_pname
                  _prpinned = UseStaleVersion
_ppinned
              -- Since we don't save the previous result, we are not able to know if the result changes
              -- Depending on this rule leads to RunDependenciesChanged
              pure $ RunResult ChangedRecomputeDiff mempty $ Just PackageResult {..}
            Maybe (NixFetcher 'Fetched)
_ -> RunResult (Maybe PackageResult)
-> Action (RunResult (Maybe PackageResult))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult (Maybe PackageResult)
 -> Action (RunResult (Maybe PackageResult)))
-> RunResult (Maybe PackageResult)
-> Action (RunResult (Maybe PackageResult))
forall a b. (a -> b) -> a -> b
$ RunChanged
-> ByteString
-> Maybe PackageResult
-> RunResult (Maybe PackageResult)
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeDiff ByteString
forall a. Monoid a => a
mempty Maybe PackageResult
forall a. Maybe a
Nothing

-- | 'Core' rule take a 'PackageKey', find the corresponding 'Package', and run all needed rules to get 'PackageResult'
runPackage :: PackageKey -> Action (Maybe PackageResult)
runPackage :: PackageKey -> Action (Maybe PackageResult)
runPackage PackageKey
k = WithPackageKey Core -> Action (Maybe PackageResult)
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (WithPackageKey Core -> Action (Maybe PackageResult))
-> WithPackageKey Core -> Action (Maybe PackageResult)
forall a b. (a -> b) -> a -> b
$ (Core, PackageKey) -> WithPackageKey Core
forall k. (k, PackageKey) -> WithPackageKey k
WithPackageKey (Core
Core, PackageKey
k)