{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

-- | Copyright: (c) 2021 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
--
-- [nvchecker](https://github.com/lilydjwg/nvchecker) is a program checking new versions of packages.
-- We encode the checking process into shake build system, generating configuration of nvchecker and calling it externally.
-- Now we call nvchecker for each 'VersionSource', which seems not to be efficient, but it's tolerable when running in parallel.
--
-- Meanwhile, we lose the capabilities of tracking version updates, i.e. normally nvchecker will help us maintain a list of old versions,
-- so that we are able to know which package's version is updated in this run. Fortunately, we can reimplement this using shake database,
-- see 'nvcheckerRule' for details.
module NvFetcher.Nvchecker
  ( -- * Types
    VersionSource (..),
    NvcheckerResult (..),

    -- * Rules
    nvcheckerRule,
    checkVersion,
  )
where

import qualified Data.Aeson as A
import Data.Coerce (coerce)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.Shake
import Development.Shake.Rule
import NeatInterpolation (trimming)
import NvFetcher.ShakeExtras
import NvFetcher.Types
import NvFetcher.Utils

-- | Rules of nvchecker
nvcheckerRule :: Rules ()
nvcheckerRule :: Rules ()
nvcheckerRule = BuiltinLint (WithPackageKey VersionSource) NvcheckerResult
-> BuiltinIdentity (WithPackageKey VersionSource) NvcheckerResult
-> BuiltinRun (WithPackageKey VersionSource) NvcheckerResult
-> 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 VersionSource) NvcheckerResult
forall key value. BuiltinLint key value
noLint BuiltinIdentity (WithPackageKey VersionSource) NvcheckerResult
forall key value. BuiltinIdentity key value
noIdentity (BuiltinRun (WithPackageKey VersionSource) NvcheckerResult
 -> Rules ())
-> BuiltinRun (WithPackageKey VersionSource) NvcheckerResult
-> Rules ()
forall a b. (a -> b) -> a -> b
$ \(WithPackageKey (VersionSource
q, PackageKey
pkg)) Maybe ByteString
old RunMode
_mode ->
  -- If the package was removed after the last run,
  -- shake still runs the nvchecker rule for this package.
  -- So we record a version change here, indicating that the package has been removed.
  -- Ideally, this should be done in the core rule
  PackageKey -> Action Bool
isPackageKeyTarget PackageKey
pkg Action Bool
-> (Bool -> Action (RunResult NvcheckerResult))
-> Action (RunResult NvcheckerResult)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> do
      let oldVer :: Maybe Version
oldVer = ByteString -> Version
forall a. Binary a => ByteString -> a
decode' (ByteString -> Version) -> Maybe ByteString -> Maybe Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
old
      PackageName -> Maybe Version -> Version -> Action ()
recordVersionChange (PackageKey -> PackageName
coerce PackageKey
pkg) Maybe Version
oldVer Version
"∅"
      RunResult NvcheckerResult -> Action (RunResult NvcheckerResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult NvcheckerResult -> Action (RunResult NvcheckerResult))
-> RunResult NvcheckerResult -> Action (RunResult NvcheckerResult)
forall a b. (a -> b) -> a -> b
$ RunChanged
-> ByteString -> NvcheckerResult -> RunResult NvcheckerResult
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeDiff ByteString
forall a. Monoid a => a
mempty NvcheckerResult
forall a. Partial => a
undefined -- skip running, returning a never consumed result
    Bool
_ ->
      (FilePath -> Action (RunResult NvcheckerResult))
-> Action (RunResult NvcheckerResult)
forall a. (FilePath -> Action a) -> Action a
withTempFile ((FilePath -> Action (RunResult NvcheckerResult))
 -> Action (RunResult NvcheckerResult))
-> (FilePath -> Action (RunResult NvcheckerResult))
-> Action (RunResult NvcheckerResult)
forall a b. (a -> b) -> a -> b
$ \FilePath
config -> do
        FilePath -> FilePath -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
FilePath -> FilePath -> m ()
writeFile' FilePath
config (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ PackageName -> FilePath
T.unpack (PackageName -> FilePath) -> PackageName -> FilePath
forall a b. (a -> b) -> a -> b
$ PackageName -> VersionSource -> PackageName
genNvConfig PackageName
"pkg" VersionSource
q
        Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath
config]
        (CmdTime Double
t, Stdout ByteString
out, CmdLine FilePath
c) <- (FilePath -> Action (CmdTime, Stdout ByteString, CmdLine))
:-> Action Any
forall args r. (Partial, CmdArguments args) => args
cmd ((FilePath -> Action (CmdTime, Stdout ByteString, CmdLine))
 :-> Action Any)
-> (FilePath -> Action (CmdTime, Stdout ByteString, CmdLine))
   :-> Action Any
forall a b. (a -> b) -> a -> b
$ FilePath
"nvchecker --logger json -c " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
config
        FilePath -> Action ()
putInfo (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Finishing running " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
c FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
", took " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Double -> FilePath
forall a. Show a => a -> FilePath
show Double
t FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"s"
        let out' :: PackageName
out' = ByteString -> PackageName
T.decodeUtf8 ByteString
out
            result :: [NvcheckerResult]
result = (PackageName -> Maybe NvcheckerResult)
-> [PackageName] -> [NvcheckerResult]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ByteString -> Maybe NvcheckerResult
forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict (ByteString -> Maybe NvcheckerResult)
-> (PackageName -> ByteString)
-> PackageName
-> Maybe NvcheckerResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> ByteString
T.encodeUtf8) (PackageName -> [PackageName]
T.lines PackageName
out')
        NvcheckerResult
now <- case [NvcheckerResult]
result of
          [NvcheckerResult
x] -> NvcheckerResult -> Action NvcheckerResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure NvcheckerResult
x
          [NvcheckerResult]
_ -> FilePath -> Action NvcheckerResult
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action NvcheckerResult)
-> FilePath -> Action NvcheckerResult
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse output from nvchecker: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> PackageName -> FilePath
T.unpack PackageName
out'
        RunResult NvcheckerResult -> Action (RunResult NvcheckerResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult NvcheckerResult -> Action (RunResult NvcheckerResult))
-> RunResult NvcheckerResult -> Action (RunResult NvcheckerResult)
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
old of
          Just ByteString
lastRun
            | Version
cachedResult <- ByteString -> Version
forall a. Binary a => ByteString -> a
decode' ByteString
lastRun ->
              if Version
cachedResult Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== NvcheckerResult -> Version
nvNow NvcheckerResult
now
                then -- try to get the version in last run from store, filling it into 'now'
                  RunChanged
-> ByteString -> NvcheckerResult -> RunResult NvcheckerResult
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeSame ByteString
lastRun NvcheckerResult
now {nvOld :: Maybe Version
nvOld = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
cachedResult}
                else RunChanged
-> ByteString -> NvcheckerResult -> RunResult NvcheckerResult
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeDiff (Version -> ByteString
forall a. Binary a => a -> ByteString
encode' (Version -> ByteString) -> Version -> ByteString
forall a b. (a -> b) -> a -> b
$ NvcheckerResult -> Version
nvNow NvcheckerResult
now) NvcheckerResult
now {nvOld :: Maybe Version
nvOld = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
cachedResult}
          Maybe ByteString
Nothing -> RunChanged
-> ByteString -> NvcheckerResult -> RunResult NvcheckerResult
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeDiff (Version -> ByteString
forall a. Binary a => a -> ByteString
encode' (Version -> ByteString) -> Version -> ByteString
forall a b. (a -> b) -> a -> b
$ NvcheckerResult -> Version
nvNow NvcheckerResult
now) NvcheckerResult
now

genNvConfig :: Text -> VersionSource -> Text
genNvConfig :: PackageName -> VersionSource -> PackageName
genNvConfig PackageName
srcName = \case
  GitHubRelease {PackageName
repo :: VersionSource -> PackageName
owner :: VersionSource -> PackageName
repo :: PackageName
owner :: PackageName
..} ->
    [trimming|
          [$srcName]
          source = "github"
          github = "$owner/$repo"
          use_latest_release = true
    |]
  Git {PackageName
vurl :: VersionSource -> PackageName
vurl :: PackageName
..} ->
    [trimming|
          [$srcName]
          source = "git"
          git = "$vurl"
          use_commit = true
    |]
  Aur {PackageName
aur :: VersionSource -> PackageName
aur :: PackageName
..} ->
    [trimming|
          [$srcName]
          source = "aur"
          aur = "$aur"
          strip_release = true
    |]
  ArchLinux {PackageName
archpkg :: VersionSource -> PackageName
archpkg :: PackageName
..} ->
    [trimming|
          [$srcName]
          source = "archpkg"
          archpkg = "$archpkg"
          strip_release = true
    |]
  Pypi {PackageName
pypi :: VersionSource -> PackageName
pypi :: PackageName
..} ->
    [trimming|
          [$srcName]
          source = "pypi"
          pypi = "$pypi"
    |]
  Manual {PackageName
manual :: VersionSource -> PackageName
manual :: PackageName
..} ->
    [trimming|
          [$srcName]
          source = "manual"
          manual = "$manual"
    |]
  Repology {PackageName
repology :: VersionSource -> PackageName
repo :: PackageName
repology :: PackageName
repo :: VersionSource -> PackageName
..} ->
    [trimming|
          [$srcName]
          source = "repology"
          repology = "$repology"
          repo = "$repo"
    |]

-- | Run nvchecker
checkVersion :: VersionSource -> PackageKey -> Action NvcheckerResult
checkVersion :: VersionSource -> PackageKey -> Action NvcheckerResult
checkVersion VersionSource
v PackageKey
k = WithPackageKey VersionSource -> Action NvcheckerResult
forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 (WithPackageKey VersionSource -> Action NvcheckerResult)
-> WithPackageKey VersionSource -> Action NvcheckerResult
forall a b. (a -> b) -> a -> b
$ (VersionSource, PackageKey) -> WithPackageKey VersionSource
forall k. (k, PackageKey) -> WithPackageKey k
WithPackageKey (VersionSource
v, PackageKey
k)