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

-- | Copyright: (c) 2021-2022 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 qualified Data.Text as T
import Development.Shake
import Development.Shake.FilePath
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
    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
Text
UseStaleVersion
DateFormat
ForceFetch
PackageFetcher
_pname :: Text
_pfetcher :: PackageFetcher
_pextract :: Maybe PackageExtractSrc
_pcargo :: Maybe PackageCargoLockFiles
_ppinned :: UseStaleVersion
_pgitdateformat :: DateFormat
_pforcefetch :: ForceFetch
_pname :: Package -> Text
_pfetcher :: Package -> PackageFetcher
_pextract :: Package -> Maybe PackageExtractSrc
_pcargo :: Package -> Maybe PackageCargoLockFiles
_ppinned :: Package -> UseStaleVersion
_pgitdateformat :: Package -> DateFormat
_pforcefetch :: Package -> ForceFetch
..
          } -> 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
              String
buildDir <- Action String
getBuildDir
              -- extract src
              Maybe (HashMap String Text)
_prextract <-
                case Maybe PackageExtractSrc
_pextract of
                  Just (PackageExtractSrc NonEmpty String
extract) -> do
                    [(String, Text)]
result <- HashMap String Text -> [(String, Text)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (HashMap String Text -> [(String, Text)])
-> Action (HashMap String Text) -> Action [(String, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixFetcher 'Fetched
-> NonEmpty String -> Action (HashMap String Text)
extractSrcs NixFetcher 'Fetched
_prfetched NonEmpty String
extract
                    HashMap String Text -> Maybe (HashMap String Text)
forall a. a -> Maybe a
Just (HashMap String Text -> Maybe (HashMap String Text))
-> ([(String, Text)] -> HashMap String Text)
-> [(String, Text)]
-> Maybe (HashMap String Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Text)] -> HashMap String Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList
                      ([(String, Text)] -> Maybe (HashMap String Text))
-> Action [(String, Text)] -> Action (Maybe (HashMap String Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Action (String, Text)] -> Action [(String, Text)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
                        [ do
                            -- write extracted files to build dir
                            -- and read them in nix using 'builtins.readFile'
                            String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFile' (String
buildDir String -> String -> String
</> String
path) (Text -> String
T.unpack Text
v)
                            (String, Text) -> Action (String, Text)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
k, String -> Text
T.pack String
path)
                          | (String
k, Text
v) <- [(String, Text)]
result,
                            let path :: String
path =
                                  String
"./"
                                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
_pname
                                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-"
                                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Version -> Text
forall a b. Coercible a b => a -> b
coerce Version
version)
                                    String -> String -> String
</> String
k
                        ]
                  Maybe PackageExtractSrc
_ -> Maybe (HashMap String Text) -> Action (Maybe (HashMap String Text))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HashMap String Text)
forall a. Maybe a
Nothing
              -- cargo locks
              Maybe (HashMap String (Text, HashMap Text Checksum))
_prcargolock <-
                case Maybe PackageCargoLockFiles
_pcargo of
                  Just (PackageCargoLockFiles NonEmpty String
lockPath) -> do
                    [(String, Text)]
lockFiles <- HashMap String Text -> [(String, Text)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList (HashMap String Text -> [(String, Text)])
-> Action (HashMap String Text) -> Action [(String, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NixFetcher 'Fetched
-> NonEmpty String -> Action (HashMap String Text)
extractSrcs NixFetcher 'Fetched
_prfetched NonEmpty String
lockPath
                    [(String, (Text, HashMap Text Checksum))]
result <- [Action (String, (Text, HashMap Text Checksum))]
-> Action [(String, (Text, HashMap Text Checksum))]
forall a. [Action a] -> Action [a]
parallel ([Action (String, (Text, HashMap Text Checksum))]
 -> Action [(String, (Text, HashMap Text Checksum))])
-> [Action (String, (Text, HashMap Text Checksum))]
-> Action [(String, (Text, HashMap Text Checksum))]
forall a b. (a -> b) -> a -> b
$
                      (((String, Text) -> Action (String, (Text, HashMap Text Checksum)))
 -> [(String, Text)]
 -> [Action (String, (Text, HashMap Text Checksum))])
-> [(String, Text)]
-> ((String, Text)
    -> Action (String, (Text, HashMap Text Checksum)))
-> [Action (String, (Text, HashMap Text Checksum))]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String, Text) -> Action (String, (Text, HashMap Text Checksum)))
-> [(String, Text)]
-> [Action (String, (Text, HashMap Text Checksum))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, Text)]
lockFiles (((String, Text) -> Action (String, (Text, HashMap Text Checksum)))
 -> [Action (String, (Text, HashMap Text Checksum))])
-> ((String, Text)
    -> Action (String, (Text, HashMap Text Checksum)))
-> [Action (String, (Text, HashMap Text Checksum))]
forall a b. (a -> b) -> a -> b
$ \(String
lockPath, Text
lockData) -> do
                        HashMap Text Checksum
result <- NixFetcher 'Fetched -> String -> Action (HashMap Text Checksum)
fetchRustGitDeps NixFetcher 'Fetched
_prfetched String
lockPath
                        let lockPath' :: String
lockPath' =
                              Text -> String
T.unpack Text
_pname
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-"
                                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Version -> Text
forall a b. Coercible a b => a -> b
coerce Version
version)
                                String -> String -> String
</> String
lockPath
                            lockPathNix :: Text
lockPathNix = Text
"./" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
lockPath'
                        -- similar to extract src, write lock file to build dir
                        String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFile' (String
buildDir String -> String -> String
</> String
lockPath') (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
lockData
                        (String, (Text, HashMap Text Checksum))
-> Action (String, (Text, HashMap Text Checksum))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
lockPath, (Text
lockPathNix, HashMap Text Checksum
result))
                    Maybe (HashMap String (Text, HashMap Text Checksum))
-> Action (Maybe (HashMap String (Text, HashMap Text Checksum)))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashMap String (Text, HashMap Text Checksum))
 -> Action (Maybe (HashMap String (Text, HashMap Text Checksum))))
-> (HashMap String (Text, HashMap Text Checksum)
    -> Maybe (HashMap String (Text, HashMap Text Checksum)))
-> HashMap String (Text, HashMap Text Checksum)
-> Action (Maybe (HashMap String (Text, HashMap Text Checksum)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap String (Text, HashMap Text Checksum)
-> Maybe (HashMap String (Text, HashMap Text Checksum))
forall a. a -> Maybe a
Just (HashMap String (Text, HashMap Text Checksum)
 -> Action (Maybe (HashMap String (Text, HashMap Text Checksum))))
-> HashMap String (Text, HashMap Text Checksum)
-> Action (Maybe (HashMap String (Text, HashMap Text Checksum)))
forall a b. (a -> b) -> a -> b
$ [(String, (Text, HashMap Text Checksum))]
-> HashMap String (Text, HashMap Text Checksum)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMap.fromList [(String, (Text, HashMap Text Checksum))]
result
                  Maybe PackageCargoLockFiles
_ -> Maybe (HashMap String (Text, HashMap Text Checksum))
-> Action (Maybe (HashMap String (Text, HashMap Text Checksum)))
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HashMap String (Text, 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
_vurl :: VersionSource -> Text
_vbranch :: VersionSource -> Branch
..} -> 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 -> DateFormat -> Action Text
getGitCommitDate Text
_vurl (Version -> Text
forall a b. Coercible a b => a -> b
coerce Version
version) DateFormat
_pgitdateformat
                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 (HashMap String (Text, HashMap Text Checksum))
Maybe (HashMap String Text)
Maybe (HashMap Text Text)
Maybe Text
Text
UseStaleVersion
NixFetcher 'Fetched
NvcheckerResult
_prversion :: NvcheckerResult
_prfetched :: NixFetcher 'Fetched
_prextract :: Maybe (HashMap String Text)
_prcargolock :: Maybe (HashMap String (Text, HashMap Text Checksum))
_prgitdate :: Maybe Text
_prpassthru :: Maybe (HashMap Text Text)
_prname :: Text
_prpinned :: UseStaleVersion
_prname :: Text
_prversion :: NvcheckerResult
_prfetched :: NixFetcher 'Fetched
_prpassthru :: Maybe (HashMap Text Text)
_prextract :: Maybe (HashMap String Text)
_prcargolock :: Maybe (HashMap String (Text, HashMap Text Checksum))
_prpinned :: UseStaleVersion
_prgitdate :: Maybe 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)