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

-- | Copyright: (c) 2021-2022 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 in shake,
-- see 'nvcheckerRule' for details.
module NvFetcher.Nvchecker
  ( -- * Types
    VersionSortMethod (..),
    ListOptions (..),
    CheckVersion (..),
    NvcheckerOptions (..),
    VersionSource (..),
    NvcheckerResult (..),

    -- * Rules
    nvcheckerRule,

    -- * Functions
    checkVersion,
    checkVersion',
  )
where

import Control.Monad (void)
import Control.Monad.Extra (fromMaybeM)
import Control.Monad.Trans.Writer.CPS
import qualified Data.Aeson as A
import qualified Data.ByteString.Char8 as BS
import Data.Coerce (coerce)
import Data.Maybe (fromJust)
import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake
import Development.Shake.Rule
import NvFetcher.Types
import NvFetcher.Types.ShakeExtras
import NvFetcher.Utils
import Prettyprinter (pretty, (<+>))

-- | Rules of nvchecker
nvcheckerRule :: Rules ()
nvcheckerRule :: Rules ()
nvcheckerRule = do
  Rules ()
persistedRule
  Rules ()
oneShotRule

-- | Nvchecker rule for packages, which is aware of version changes and supports using stale version.
-- nvchecker will be called at most one time given a package key. Follow-up using of this rule will return cached result.
-- 'PackageKey' is required for caching.
-- Run this rule by calling 'checkVersion'
persistedRule :: Rules ()
persistedRule :: Rules ()
persistedRule = 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 forall key value. BuiltinLint key value
noLint forall key value. BuiltinIdentity key value
noIdentity forall a b. (a -> b) -> a -> b
$ \(WithPackageKey (key :: CheckVersion
key@(CheckVersion VersionSource
versionSource NvcheckerOptions
options), PackageKey
pkg)) Maybe ByteString
_old RunMode
_mode -> do
  String -> Action ()
putInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Doc Any
"#" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty CheckVersion
key
  Maybe Version
oldVer <- PackageKey -> Action (Maybe Version)
getRecentLastVersion PackageKey
pkg
  UseStaleVersion
useStaleVersion <- Package -> UseStaleVersion
_ppinned forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Partial => Maybe a -> a
fromJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageKey -> Action (Maybe Package)
lookupPackage PackageKey
pkg
  let useStale :: Bool
useStale = case UseStaleVersion
useStaleVersion of
        UseStaleVersion
PermanentStale -> Bool
True
        UseStaleVersion
TemporaryStale -> Bool
True
        UseStaleVersion
_ -> Bool
False
  case Bool
useStale of
    Bool
True
      | Just Version
oldVer' <- Maybe Version
oldVer -> do
          -- use the stale version if we have
          String -> Action ()
putInfo forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"Skip running nvchecker, use stale version " forall a. Semigroup a => a -> a -> a
<> coerce :: forall a b. Coercible a b => a -> b
coerce Version
oldVer' forall a. Semigroup a => a -> a -> a
<> Text
" for " forall a. Semigroup a => a -> a -> a
<> coerce :: forall a b. Coercible a b => a -> b
coerce PackageKey
pkg
          let result :: NvcheckerResult
result = NvcheckerResult {nvNow :: Version
nvNow = Version
oldVer', nvOld :: Maybe Version
nvOld = Maybe Version
oldVer, nvStale :: Bool
nvStale = Bool
True}
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
ChangedRecomputeSame (forall a. Binary a => a -> ByteString
encode' NvcheckerResult
result) NvcheckerResult
result

    -- run nvchecker
    Bool
_ -> do
      -- if we already run this rule for a package, we can recover the last result from getLastVersionUpdated
      -- (when cacheNvchecker is enabled)
      Bool
useCache <- Action Bool
nvcheckerCacheEnabled
      Version
now <- forall (m :: * -> *) a. Monad m => m a -> m (Maybe a) -> m a
fromMaybeM (coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageKey -> NvcheckerOptions -> VersionSource -> Action Version
runNvchecker PackageKey
pkg NvcheckerOptions
options VersionSource
versionSource) (if Bool
useCache then PackageKey -> Action (Maybe Version)
getLastVersionUpdated PackageKey
pkg else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
      let runChanged :: RunChanged
runChanged = case Maybe Version
oldVer of
            Just Version
oldVer'
              | Version
oldVer' forall a. Eq a => a -> a -> Bool
== Version
now -> RunChanged
ChangedRecomputeSame
            Maybe Version
_ -> RunChanged
ChangedRecomputeDiff
          result :: NvcheckerResult
result = NvcheckerResult {nvNow :: Version
nvNow = Version
now, nvOld :: Maybe Version
nvOld = Maybe Version
oldVer, nvStale :: Bool
nvStale = Bool
False}
      -- always update
      PackageKey -> Version -> Action ()
updateLastVersion PackageKey
pkg Version
now
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall value. RunChanged -> ByteString -> value -> RunResult value
RunResult RunChanged
runChanged forall a. Monoid a => a
mempty NvcheckerResult
result

-- | Nvchecker rule without cache
-- Rule this rule by calling 'checkVersion''
oneShotRule :: Rules ()
oneShotRule :: Rules ()
oneShotRule = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
  forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle forall a b. (a -> b) -> a -> b
$ \key :: CheckVersion
key@(CheckVersion VersionSource
versionSource NvcheckerOptions
options) -> do
    String -> Action ()
putInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty CheckVersion
key
    Version
now <- PackageKey -> NvcheckerOptions -> VersionSource -> Action Version
runNvchecker (Text -> PackageKey
PackageKey Text
"pkg") NvcheckerOptions
options VersionSource
versionSource
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version -> Bool -> NvcheckerResult
NvcheckerResult Version
now forall a. Maybe a
Nothing Bool
False

runNvchecker :: PackageKey -> NvcheckerOptions -> VersionSource -> Action Version
runNvchecker :: PackageKey -> NvcheckerOptions -> VersionSource -> Action Version
runNvchecker PackageKey
pkg NvcheckerOptions
options VersionSource
versionSource = forall a. (String -> Action a) -> Action a
withTempFile forall a b. (a -> b) -> a -> b
$ \String
config -> forall a. Action a -> Action a
withRetry forall a b. (a -> b) -> a -> b
$ do
  Maybe String
mKeyfile <- Action (Maybe String)
getKeyfilePath
  let nvcheckerConfig :: String
nvcheckerConfig = Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall w a. Monoid w => Writer w a -> w
execWriter forall a b. (a -> b) -> a -> b
$ PackageKey
-> NvcheckerOptions -> Maybe String -> VersionSource -> BuildTOML
genNvConfig PackageKey
pkg NvcheckerOptions
options Maybe String
mKeyfile VersionSource
versionSource
  String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ String
"Generated nvchecker config for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show PackageKey
pkg forall a. Semigroup a => a -> a -> a
<> String
":" forall a. Semigroup a => a -> a -> a
<> String
nvcheckerConfig
  forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFile' String
config String
nvcheckerConfig
  (CmdTime Double
t, Stdout String
out, CmdLine String
c) <- forall a. Action a -> Action a
quietly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall args r. (Partial, CmdArguments args) => args
cmd forall a b. (a -> b) -> a -> b
$ String
"nvchecker --logger json -c " forall a. Semigroup a => a -> a -> a
<> String
config
  String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ String
"Finishing running " forall a. Semigroup a => a -> a -> a
<> String
c forall a. Semigroup a => a -> a -> a
<> String
", took " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Double
t forall a. Semigroup a => a -> a -> a
<> String
"s"
  case forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall a b. (a -> b) -> a -> b
$ String
out of
    (String
o : [String]
_) | Just NvcheckerRaw
raw <- forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict' forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
o -> case NvcheckerRaw
raw of
      NvcheckerSuccess Version
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
x
      NvcheckerError Text
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to run nvchecker: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
err
    [String]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse output from nvchecker: " forall a. Semigroup a => a -> a -> a
<> String
out

type BuildTOML = Writer [Text] ()

genNvConfig :: PackageKey -> NvcheckerOptions -> Maybe FilePath -> VersionSource -> BuildTOML
genNvConfig :: PackageKey
-> NvcheckerOptions -> Maybe String -> VersionSource -> BuildTOML
genNvConfig PackageKey
pkg NvcheckerOptions
options Maybe String
mKeyfile VersionSource
versionSource =
  case Maybe String
mKeyfile of
    Just String
keyfile -> do
      forall {m :: * -> *} {a} {a}.
(Monad m, Semigroup a, IsString a) =>
a -> WriterT [a] m a -> WriterT [a] m ()
table Text
"__config__" forall a b. (a -> b) -> a -> b
$
        Text
"keyfile" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: String -> Text
T.pack String
keyfile
    Maybe String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {m :: * -> *} {a} {a}.
(Monad m, Semigroup a, IsString a) =>
a -> WriterT [a] m a -> WriterT [a] m ()
table
      (coerce :: forall a b. Coercible a b => a -> b
coerce PackageKey
pkg)
      ( do
          VersionSource -> BuildTOML
genVersionSource VersionSource
versionSource
          forall {m :: * -> *}.
Monad m =>
NvcheckerOptions -> WriterT [Text] m ()
genOptions NvcheckerOptions
options
      )
  where
    Text
key =: :: Text -> Text -> WriterT [Text] m ()
=: Text
x = forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell [Text
key forall a. Semigroup a => a -> a -> a
<> Text
" = " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x)]
    Text
key =:? :: Text -> Maybe Text -> WriterT [Text] m ()
=:? (Just Text
x) = Text
key forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
x
    Text
_ =:? Maybe Text
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    table :: a -> WriterT [a] m a -> WriterT [a] m ()
table a
t WriterT [a] m a
m = forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell [a
"[" forall a. Semigroup a => a -> a -> a
<> a
t forall a. Semigroup a => a -> a -> a
<> a
"]"] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriterT [a] m a
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell [a
""]
    genVersionSource :: VersionSource -> BuildTOML
genVersionSource = \case
      GitHubRelease {Text
_repo :: VersionSource -> Text
_owner :: VersionSource -> Text
_repo :: Text
_owner :: Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"github"
        Text
"github" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: (Text
_owner forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
_repo)
        Text
"use_latest_release" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"true"
      GitHubTag {Text
ListOptions
_listOptions :: VersionSource -> ListOptions
_listOptions :: ListOptions
_repo :: Text
_owner :: Text
_repo :: VersionSource -> Text
_owner :: VersionSource -> Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"github"
        Text
"github" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: (Text
_owner forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
_repo)
        Text
"use_max_tag" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"true"
        forall {m :: * -> *}. Monad m => ListOptions -> WriterT [Text] m ()
genListOptions ListOptions
_listOptions
      Git {Text
Branch
_vbranch :: VersionSource -> Branch
_vurl :: VersionSource -> Text
_vbranch :: Branch
_vurl :: Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"git"
        Text
"git" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_vurl
        Text
"branch" forall {m :: * -> *}.
Monad m =>
Text -> Maybe Text -> WriterT [Text] m ()
=:? coerce :: forall a b. Coercible a b => a -> b
coerce Branch
_vbranch
        Text
"use_commit" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"true"
      Aur {Text
_aur :: VersionSource -> Text
_aur :: Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"aur"
        Text
"aur" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_aur
        Text
"strip_release" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"true"
      ArchLinux {Text
_archpkg :: VersionSource -> Text
_archpkg :: Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"archpkg"
        Text
"archpkg" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_archpkg
        Text
"strip_release" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"true"
      Pypi {Text
_pypi :: VersionSource -> Text
_pypi :: Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"pypi"
        Text
"pypi" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_pypi
      Manual {Text
_manual :: VersionSource -> Text
_manual :: Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"manual"
        Text
"manual" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_manual
      Repology {Text
_repology :: VersionSource -> Text
_repo :: Text
_repology :: Text
_repo :: VersionSource -> Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"repology"
        Text
"repology" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_repology
        Text
"repo" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_repo
      Webpage {Text
ListOptions
_regex :: VersionSource -> Text
_listOptions :: ListOptions
_regex :: Text
_vurl :: Text
_vurl :: VersionSource -> Text
_listOptions :: VersionSource -> ListOptions
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"regex"
        Text
"url" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_vurl
        Text
"regex" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_regex
        forall {m :: * -> *}. Monad m => ListOptions -> WriterT [Text] m ()
genListOptions ListOptions
_listOptions
      HttpHeader {Text
ListOptions
_listOptions :: ListOptions
_regex :: Text
_vurl :: Text
_regex :: VersionSource -> Text
_vurl :: VersionSource -> Text
_listOptions :: VersionSource -> ListOptions
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"httpheader"
        Text
"url" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_vurl
        Text
"regex" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_regex
        forall {m :: * -> *}. Monad m => ListOptions -> WriterT [Text] m ()
genListOptions ListOptions
_listOptions
      OpenVsx {Text
_ovExtName :: VersionSource -> Text
_ovPublisher :: VersionSource -> Text
_ovExtName :: Text
_ovPublisher :: Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"openvsx"
        Text
"openvsx" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: (Text
_ovPublisher forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
_ovExtName)
      VscodeMarketplace {Text
_vsmExtName :: VersionSource -> Text
_vsmPublisher :: VersionSource -> Text
_vsmExtName :: Text
_vsmPublisher :: Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"vsmarketplace"
        Text
"vsmarketplace" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: (Text
_vsmPublisher forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
_vsmExtName)
      Cmd {Text
_vcmd :: VersionSource -> Text
_vcmd :: Text
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"cmd"
        Text
"cmd" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_vcmd
      Container {Text
ListOptions
_vcontainer :: VersionSource -> Text
_listOptions :: ListOptions
_vcontainer :: Text
_listOptions :: VersionSource -> ListOptions
..} -> do
        Text
"source" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
"container"
        Text
"container" forall {m :: * -> *}.
Monad m =>
Text -> Text -> WriterT [Text] m ()
=: Text
_vcontainer
        forall {m :: * -> *}. Monad m => ListOptions -> WriterT [Text] m ()
genListOptions ListOptions
_listOptions
    genListOptions :: ListOptions -> WriterT [Text] m ()
genListOptions ListOptions {Maybe Text
Maybe VersionSortMethod
_ignored :: ListOptions -> Maybe Text
_sortVersionKey :: ListOptions -> Maybe VersionSortMethod
_excludeRegex :: ListOptions -> Maybe Text
_includeRegex :: ListOptions -> Maybe Text
_ignored :: Maybe Text
_sortVersionKey :: Maybe VersionSortMethod
_excludeRegex :: Maybe Text
_includeRegex :: Maybe Text
..} = do
      Text
"include_regex" forall {m :: * -> *}.
Monad m =>
Text -> Maybe Text -> WriterT [Text] m ()
=:? Maybe Text
_includeRegex
      Text
"exclude_regex" forall {m :: * -> *}.
Monad m =>
Text -> Maybe Text -> WriterT [Text] m ()
=:? Maybe Text
_excludeRegex
      Text
"sort_version_key" forall {m :: * -> *}.
Monad m =>
Text -> Maybe Text -> WriterT [Text] m ()
=:? forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe VersionSortMethod
_sortVersionKey
      Text
"ignored" forall {m :: * -> *}.
Monad m =>
Text -> Maybe Text -> WriterT [Text] m ()
=:? Maybe Text
_ignored
    genOptions :: NvcheckerOptions -> WriterT [Text] m ()
genOptions NvcheckerOptions {Maybe Text
_toPattern :: NvcheckerOptions -> Maybe Text
_fromPattern :: NvcheckerOptions -> Maybe Text
_stripPrefix :: NvcheckerOptions -> Maybe Text
_toPattern :: Maybe Text
_fromPattern :: Maybe Text
_stripPrefix :: Maybe Text
..} = do
      Text
"prefix" forall {m :: * -> *}.
Monad m =>
Text -> Maybe Text -> WriterT [Text] m ()
=:? Maybe Text
_stripPrefix
      Text
"from_pattern" forall {m :: * -> *}.
Monad m =>
Text -> Maybe Text -> WriterT [Text] m ()
=:? Maybe Text
_fromPattern
      Text
"to_pattern" forall {m :: * -> *}.
Monad m =>
Text -> Maybe Text -> WriterT [Text] m ()
=:? Maybe Text
_toPattern

-- | Run nvchecker given 'PackageKey'
-- Recording version changes and using stale version are available.
checkVersion :: VersionSource -> NvcheckerOptions -> PackageKey -> Action NvcheckerResult
checkVersion :: VersionSource
-> NvcheckerOptions -> PackageKey -> Action NvcheckerResult
checkVersion VersionSource
v NvcheckerOptions
o PackageKey
k = forall key value.
(Partial, RuleResult key ~ value, ShakeValue key,
 Typeable value) =>
key -> Action value
apply1 forall a b. (a -> b) -> a -> b
$ forall k. (k, PackageKey) -> WithPackageKey k
WithPackageKey (VersionSource -> NvcheckerOptions -> CheckVersion
CheckVersion VersionSource
v NvcheckerOptions
o, PackageKey
k)

-- | Run nvchecker without cache
checkVersion' :: VersionSource -> NvcheckerOptions -> Action NvcheckerResult
checkVersion' :: VersionSource -> NvcheckerOptions -> Action NvcheckerResult
checkVersion' VersionSource
v NvcheckerOptions
o = forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle forall a b. (a -> b) -> a -> b
$ VersionSource -> NvcheckerOptions -> CheckVersion
CheckVersion VersionSource
v NvcheckerOptions
o