{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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
    VersionSortMethod (..),
    ListOptions (..),
    NvcheckerQ (..),
    NvcheckerOptions (..),
    VersionSource (..),
    NvcheckerA (..),

    -- * Rules
    nvcheckerRule,
    checkVersion,
  )
where

import qualified Data.Aeson as A
import Data.Coerce (coerce)
import Data.Maybe (mapMaybe)
import Data.String (fromString)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.Shake
import Development.Shake.Rule
import NvFetcher.Types
import NvFetcher.Types.ShakeExtras
import NvFetcher.Utils
import Toml (Value (Bool, Text), pretty)
import Toml.Type.Edsl

-- | Rules of nvchecker
nvcheckerRule :: Rules ()
nvcheckerRule :: Rules ()
nvcheckerRule = BuiltinLint (WithPackageKey NvcheckerQ) NvcheckerA
-> BuiltinIdentity (WithPackageKey NvcheckerQ) NvcheckerA
-> BuiltinRun (WithPackageKey NvcheckerQ) NvcheckerA
-> 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 NvcheckerQ) NvcheckerA
forall key value. BuiltinLint key value
noLint BuiltinIdentity (WithPackageKey NvcheckerQ) NvcheckerA
forall key value. BuiltinIdentity key value
noIdentity (BuiltinRun (WithPackageKey NvcheckerQ) NvcheckerA -> Rules ())
-> BuiltinRun (WithPackageKey NvcheckerQ) NvcheckerA -> Rules ()
forall a b. (a -> b) -> a -> b
$ \(WithPackageKey (NvcheckerQ VersionSource
versionSource NvcheckerOptions
options, 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 NvcheckerA))
-> Action (RunResult NvcheckerA)
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 NvcheckerA -> Action (RunResult NvcheckerA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult NvcheckerA -> Action (RunResult NvcheckerA))
-> RunResult NvcheckerA -> Action (RunResult NvcheckerA)
forall a b. (a -> b) -> a -> b
$ RunChanged -> ByteString -> NvcheckerA -> RunResult NvcheckerA
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeDiff ByteString
forall a. Monoid a => a
mempty NvcheckerA
forall a. Partial => a
undefined -- skip running, returning a never consumed result
    Bool
_ ->
      (FilePath -> Action (RunResult NvcheckerA))
-> Action (RunResult NvcheckerA)
forall a. (FilePath -> Action a) -> Action a
withTempFile ((FilePath -> Action (RunResult NvcheckerA))
 -> Action (RunResult NvcheckerA))
-> (FilePath -> Action (RunResult NvcheckerA))
-> Action (RunResult NvcheckerA)
forall a b. (a -> b) -> a -> b
$ \FilePath
config -> Action (RunResult NvcheckerA) -> Action (RunResult NvcheckerA)
forall a. Action a -> Action a
withRetries (Action (RunResult NvcheckerA) -> Action (RunResult NvcheckerA))
-> Action (RunResult NvcheckerA) -> Action (RunResult NvcheckerA)
forall a b. (a -> b) -> a -> b
$ 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
$ TOML -> PackageName
pretty (TOML -> PackageName) -> TOML -> PackageName
forall a b. (a -> b) -> a -> b
$ TDSL -> TOML
mkToml (TDSL -> TOML) -> TDSL -> TOML
forall a b. (a -> b) -> a -> b
$ PackageKey -> NvcheckerOptions -> VersionSource -> TDSL
genNvConfig PackageKey
pkg NvcheckerOptions
options VersionSource
versionSource
        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 ()
putVerbose (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 :: [NvcheckerA]
result = (PackageName -> Maybe NvcheckerA) -> [PackageName] -> [NvcheckerA]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ByteString -> Maybe NvcheckerA
forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict (ByteString -> Maybe NvcheckerA)
-> (PackageName -> ByteString) -> PackageName -> Maybe NvcheckerA
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> ByteString
T.encodeUtf8) (PackageName -> [PackageName]
T.lines PackageName
out')
        NvcheckerA
now <- case [NvcheckerA]
result of
          [NvcheckerA
x] -> NvcheckerA -> Action NvcheckerA
forall (f :: * -> *) a. Applicative f => a -> f a
pure NvcheckerA
x
          [NvcheckerA]
_ -> FilePath -> Action NvcheckerA
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action NvcheckerA) -> FilePath -> Action NvcheckerA
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 NvcheckerA -> Action (RunResult NvcheckerA)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult NvcheckerA -> Action (RunResult NvcheckerA))
-> RunResult NvcheckerA -> Action (RunResult NvcheckerA)
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
== NvcheckerA -> Version
nvNow NvcheckerA
now
                then -- try to get the version in last run from store, filling it into 'now'
                  RunChanged -> ByteString -> NvcheckerA -> RunResult NvcheckerA
forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeSame ByteString
lastRun NvcheckerA
now {nvOld :: Maybe Version
nvOld = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
cachedResult}
                else RunChanged -> ByteString -> NvcheckerA -> RunResult NvcheckerA
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
$ NvcheckerA -> Version
nvNow NvcheckerA
now) NvcheckerA
now {nvOld :: Maybe Version
nvOld = Version -> Maybe Version
forall a. a -> Maybe a
Just Version
cachedResult}
          Maybe ByteString
Nothing -> RunChanged -> ByteString -> NvcheckerA -> RunResult NvcheckerA
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
$ NvcheckerA -> Version
nvNow NvcheckerA
now) NvcheckerA
now

genNvConfig :: PackageKey -> NvcheckerOptions -> VersionSource -> TDSL
genNvConfig :: PackageKey -> NvcheckerOptions -> VersionSource -> TDSL
genNvConfig PackageKey
pkg NvcheckerOptions
options VersionSource
versionSource = Key -> TDSL -> TDSL
table (FilePath -> Key
forall a. IsString a => FilePath -> a
fromString (FilePath -> Key) -> FilePath -> Key
forall a b. (a -> b) -> a -> b
$ PackageName -> FilePath
T.unpack (PackageName -> FilePath) -> PackageName -> FilePath
forall a b. (a -> b) -> a -> b
$ PackageKey -> PackageName
coerce PackageKey
pkg) (TDSL -> TDSL) -> TDSL -> TDSL
forall a b. (a -> b) -> a -> b
$ do
  VersionSource -> TDSL
genVersionSource VersionSource
versionSource
  NvcheckerOptions -> TDSL
genOptions NvcheckerOptions
options
  where
    Key
key =:? :: Key -> Maybe PackageName -> TDSL
=:? (Just PackageName
x) = Key
key Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
x
    Key
_ =:? Maybe PackageName
_ = () -> TDSL
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    genVersionSource :: VersionSource -> TDSL
genVersionSource = \case
      GitHubRelease {PackageName
_repo :: VersionSource -> PackageName
_owner :: VersionSource -> PackageName
_repo :: PackageName
_owner :: PackageName
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"github"
        Key
"github" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text (PackageName
_owner PackageName -> PackageName -> PackageName
forall a. Semigroup a => a -> a -> a
<> PackageName
"/" PackageName -> PackageName -> PackageName
forall a. Semigroup a => a -> a -> a
<> PackageName
_repo)
        Key
"use_latest_release" Key -> Value 'TBool -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Bool -> Value 'TBool
Bool Bool
True
      GitHubTag {PackageName
ListOptions
_listOptions :: VersionSource -> ListOptions
_listOptions :: ListOptions
_repo :: PackageName
_owner :: PackageName
_repo :: VersionSource -> PackageName
_owner :: VersionSource -> PackageName
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"github"
        Key
"github" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text (PackageName
_owner PackageName -> PackageName -> PackageName
forall a. Semigroup a => a -> a -> a
<> PackageName
"/" PackageName -> PackageName -> PackageName
forall a. Semigroup a => a -> a -> a
<> PackageName
_repo)
        Key
"use_max_tag" Key -> Value 'TBool -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Bool -> Value 'TBool
Bool Bool
True
        ListOptions -> TDSL
genListOptions ListOptions
_listOptions
      Git {PackageName
Branch
_vbranch :: VersionSource -> Branch
_vurl :: VersionSource -> PackageName
_vbranch :: Branch
_vurl :: PackageName
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"git"
        Key
"git" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_vurl
        Key
"branch" Key -> Maybe PackageName -> TDSL
=:? Branch -> Maybe PackageName
coerce Branch
_vbranch
        Key
"use_commit" Key -> Value 'TBool -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Bool -> Value 'TBool
Bool Bool
True
      Aur {PackageName
_aur :: VersionSource -> PackageName
_aur :: PackageName
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"aur"
        Key
"aur" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_aur
        Key
"strip_release" Key -> Value 'TBool -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Bool -> Value 'TBool
Bool Bool
True
      ArchLinux {PackageName
_archpkg :: VersionSource -> PackageName
_archpkg :: PackageName
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"archpkg"
        Key
"aur" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_archpkg
        Key
"strip_release" Key -> Value 'TBool -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Bool -> Value 'TBool
Bool Bool
True
      Pypi {PackageName
_pypi :: VersionSource -> PackageName
_pypi :: PackageName
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"pypi"
        Key
"pypi" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_pypi
      Manual {PackageName
_manual :: VersionSource -> PackageName
_manual :: PackageName
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"manual"
        Key
"manual" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_manual
      Repology {PackageName
_repology :: VersionSource -> PackageName
_repo :: PackageName
_repology :: PackageName
_repo :: VersionSource -> PackageName
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"repology"
        Key
"repology" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_repology
        Key
"repo" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_repo
      Webpage {PackageName
ListOptions
_regex :: VersionSource -> PackageName
_listOptions :: ListOptions
_regex :: PackageName
_vurl :: PackageName
_vurl :: VersionSource -> PackageName
_listOptions :: VersionSource -> ListOptions
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"regex"
        Key
"url" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_vurl
        Key
"regex" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_regex
        ListOptions -> TDSL
genListOptions ListOptions
_listOptions
      HttpHeader {PackageName
ListOptions
_listOptions :: ListOptions
_regex :: PackageName
_vurl :: PackageName
_regex :: VersionSource -> PackageName
_vurl :: VersionSource -> PackageName
_listOptions :: VersionSource -> ListOptions
..} -> do
        Key
"source" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: Value 'TText
"httpheader"
        Key
"url" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_vurl
        Key
"regex" Key -> Value 'TText -> TDSL
forall (a :: TValue). Key -> Value a -> TDSL
=: PackageName -> Value 'TText
Text PackageName
_regex
        ListOptions -> TDSL
genListOptions ListOptions
_listOptions
    genListOptions :: ListOptions -> TDSL
genListOptions ListOptions {Maybe PackageName
Maybe VersionSortMethod
_ignored :: ListOptions -> Maybe PackageName
_sortVersionKey :: ListOptions -> Maybe VersionSortMethod
_excludeRegex :: ListOptions -> Maybe PackageName
_includeRegex :: ListOptions -> Maybe PackageName
_ignored :: Maybe PackageName
_sortVersionKey :: Maybe VersionSortMethod
_excludeRegex :: Maybe PackageName
_includeRegex :: Maybe PackageName
..} = do
      Key
"include_regex" Key -> Maybe PackageName -> TDSL
=:? Maybe PackageName
_includeRegex
      Key
"exclude_regex" Key -> Maybe PackageName -> TDSL
=:? Maybe PackageName
_excludeRegex
      Key
"sort_version_key" Key -> Maybe PackageName -> TDSL
=:? (VersionSortMethod -> PackageName)
-> Maybe VersionSortMethod -> Maybe PackageName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> PackageName
T.pack (FilePath -> PackageName)
-> (VersionSortMethod -> FilePath)
-> VersionSortMethod
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionSortMethod -> FilePath
forall a. Show a => a -> FilePath
show) Maybe VersionSortMethod
_sortVersionKey
      Key
"ignored" Key -> Maybe PackageName -> TDSL
=:? Maybe PackageName
_ignored
    genOptions :: NvcheckerOptions -> TDSL
genOptions NvcheckerOptions {Maybe PackageName
_toPattern :: NvcheckerOptions -> Maybe PackageName
_fromPattern :: NvcheckerOptions -> Maybe PackageName
_stripPrefix :: NvcheckerOptions -> Maybe PackageName
_toPattern :: Maybe PackageName
_fromPattern :: Maybe PackageName
_stripPrefix :: Maybe PackageName
..} = do
      Key
"prefix" Key -> Maybe PackageName -> TDSL
=:? Maybe PackageName
_stripPrefix
      Key
"from_pattern" Key -> Maybe PackageName -> TDSL
=:? Maybe PackageName
_fromPattern
      Key
"to_pattern" Key -> Maybe PackageName -> TDSL
=:? Maybe PackageName
_toPattern

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