{-# 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
_prversion@(NvcheckerResult Version
version Maybe Version
_mOldV Bool
_isStale) <- VersionSource
-> NvcheckerOptions -> PackageKey -> Action NvcheckerResult
checkVersion VersionSource
versionSource NvcheckerOptions
options PackageKey
pkg
          Maybe (NixFetcher 'Fetched)
_prfetched <- NixFetcher 'Fresh
-> ForceFetch -> Action (Maybe (NixFetcher 'Fetched))
prefetch (PackageFetcher
_pfetcher Version
version) ForceFetch
_pforcefetch
          -- If we fail to prefetch, we should fail on this package
          case Maybe (NixFetcher 'Fetched)
_prfetched of
            Just NixFetcher 'Fetched
_prfetched -> do
              -- extract src
              Maybe (HashMap String String)
_prextract <-
                case Maybe PackageExtractSrc
_pextract of
                  Just (PackageExtractSrc NonEmpty Glob
extract) -> do
                    HashMap String String
result <- NixFetcher 'Fetched
-> NonEmpty Glob -> Action (HashMap String String)
extractSrcs NixFetcher 'Fetched
_prfetched NonEmpty Glob
extract
                    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)
 -> Action (Maybe (HashMap String String)))
-> Maybe (HashMap String String)
-> Action (Maybe (HashMap String String))
forall a b. (a -> b) -> a -> b
$ HashMap String String -> Maybe (HashMap String String)
forall a. a -> Maybe a
Just HashMap String String
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
              Maybe (HashMap String (String, HashMap Text Checksum))
_prcargolock <-
                case Maybe PackageCargoLockFiles
_pcargo of
                  Just (PackageCargoLockFiles NonEmpty Glob
lockPath) -> do
                    [(String, String)]
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
                    [(String, (String, HashMap Text Checksum))]
result <- [Action (String, (String, HashMap Text Checksum))]
-> Action [(String, (String, HashMap Text Checksum))]
forall a. [Action a] -> Action [a]
parallel ([Action (String, (String, HashMap Text Checksum))]
 -> Action [(String, (String, HashMap Text Checksum))])
-> [Action (String, (String, HashMap Text Checksum))]
-> Action [(String, (String, HashMap Text Checksum))]
forall a b. (a -> b) -> a -> b
$
                      (((String, String)
  -> Action (String, (String, HashMap Text Checksum)))
 -> [(String, String)]
 -> [Action (String, (String, HashMap Text Checksum))])
-> [(String, String)]
-> ((String, String)
    -> Action (String, (String, HashMap Text Checksum)))
-> [Action (String, (String, HashMap Text Checksum))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String, String)
 -> Action (String, (String, HashMap Text Checksum)))
-> [(String, String)]
-> [Action (String, (String, HashMap Text Checksum))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, String)]
lockFiles (((String, String)
  -> Action (String, (String, HashMap Text Checksum)))
 -> [Action (String, (String, HashMap Text Checksum))])
-> ((String, String)
    -> Action (String, (String, HashMap Text Checksum)))
-> [Action (String, (String, HashMap Text Checksum))]
forall a b. (a -> b) -> a -> b
$ \(String
srcLockPath, String
dstLockPath) -> do
                        HashMap Text Checksum
result <- NixFetcher 'Fetched -> String -> Action (HashMap Text Checksum)
fetchRustGitDeps NixFetcher 'Fetched
_prfetched String
srcLockPath
                        (String, (String, HashMap Text Checksum))
-> Action (String, (String, HashMap Text Checksum))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
srcLockPath, (String
dstLockPath, HashMap Text Checksum
result))
                    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))
 -> Action (Maybe (HashMap String (String, HashMap Text Checksum))))
-> (HashMap String (String, HashMap Text Checksum)
    -> Maybe (HashMap String (String, HashMap Text Checksum)))
-> HashMap String (String, HashMap Text Checksum)
-> Action (Maybe (HashMap String (String, HashMap Text Checksum)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap String (String, HashMap Text Checksum)
-> Maybe (HashMap String (String, HashMap Text Checksum))
forall a. a -> Maybe a
Just (HashMap String (String, HashMap Text Checksum)
 -> Action (Maybe (HashMap String (String, HashMap Text Checksum))))
-> HashMap String (String, HashMap Text Checksum)
-> Action (Maybe (HashMap String (String, HashMap Text Checksum)))
forall a b. (a -> b) -> a -> b
$ [(String, (String, HashMap Text Checksum))]
-> HashMap String (String, HashMap Text Checksum)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList [(String, (String, HashMap Text Checksum))]
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
              Maybe Text
_prgitdate <- case VersionSource
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
              Maybe Version
mOldV <- PackageKey -> Action (Maybe Version)
getLastVersionOnDisk PackageKey
pkg
              case Maybe Version
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 :: Maybe (HashMap Text Text)
_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
_prname = Text
_pname
                  _prpinned :: UseStaleVersion
_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
              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 -> RunResult (Maybe PackageResult))
-> Maybe PackageResult -> RunResult (Maybe PackageResult)
forall a b. (a -> b) -> a -> b
$ PackageResult -> Maybe PackageResult
forall a. a -> Maybe a
Just PackageResult {Maybe Text
Maybe (HashMap String String)
Maybe (HashMap String (String, HashMap Text Checksum))
Maybe (HashMap Text Text)
Text
UseStaleVersion
NixFetcher 'Fetched
NvcheckerResult
_prversion :: NvcheckerResult
_prfetched :: NixFetcher 'Fetched
_prextract :: Maybe (HashMap String String)
_prcargolock :: Maybe (HashMap String (String, HashMap Text Checksum))
_prgitdate :: Maybe Text
_prpassthru :: Maybe (HashMap Text Text)
_prname :: Text
_prpinned :: UseStaleVersion
_prgitdate :: Maybe Text
_prpinned :: UseStaleVersion
_prcargolock :: Maybe (HashMap String (String, HashMap Text Checksum))
_prextract :: Maybe (HashMap String String)
_prpassthru :: Maybe (HashMap Text Text)
_prfetched :: NixFetcher 'Fetched
_prversion :: NvcheckerResult
_prname :: Text
..}
            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)