{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module NvFetcher
( runNvFetcher,
runNvFetcher',
runNvFetcherNoCLI,
applyCliOptions,
parseLastVersions,
module NvFetcher.PackageSet,
module NvFetcher.Types,
module NvFetcher.Types.ShakeExtras,
)
where
import Control.Monad.Extra (forM_, when, whenJust)
import qualified Data.Aeson as A
import qualified Data.Aeson.Encode.Pretty as A
import qualified Data.Aeson.Types as A
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Default
import Data.List ((\\))
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake
import Development.Shake.FilePath
import NeatInterpolation (trimming)
import NvFetcher.Config
import NvFetcher.Core
import NvFetcher.NixExpr (ToNixExpr (toNixExpr))
import NvFetcher.NixFetcher
import NvFetcher.Nvchecker
import NvFetcher.Options
import NvFetcher.PackageSet
import NvFetcher.Types
import NvFetcher.Types.ShakeExtras
import NvFetcher.Utils (aesonKey, getDataDir)
import qualified System.Directory.Extra as D
import Text.Regex.TDFA ((=~))
runNvFetcher :: PackageSet () -> IO ()
runNvFetcher :: PackageSet () -> IO ()
runNvFetcher = Config -> PackageSet () -> IO ()
runNvFetcher' forall a. Default a => a
def
runNvFetcher' :: Config -> PackageSet () -> IO ()
runNvFetcher' :: Config -> PackageSet () -> IO ()
runNvFetcher' Config
config PackageSet ()
packageSet =
forall a. Parser a -> IO a
getCLIOptions Parser CLIOptions
cliOptionsParser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CLIOptions
cli ->
Config -> CLIOptions -> IO Config
applyCliOptions Config
config CLIOptions
cli forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Config
o ->
Config -> Target -> PackageSet () -> IO ()
runNvFetcherNoCLI Config
o (CLIOptions -> Target
optTarget CLIOptions
cli) PackageSet ()
packageSet
applyCliOptions :: Config -> CLIOptions -> IO Config
applyCliOptions :: Config -> CLIOptions -> IO Config
applyCliOptions Config
config CLIOptions {Bool
Int
String
Maybe String
Target
optKeyfile :: CLIOptions -> Maybe String
optPkgNameFilter :: CLIOptions -> Maybe String
optVerbose :: CLIOptions -> Bool
optTiming :: CLIOptions -> Bool
optRetry :: CLIOptions -> Int
optThreads :: CLIOptions -> Int
optLogPath :: CLIOptions -> Maybe String
optCommit :: CLIOptions -> Bool
optBuildDir :: CLIOptions -> String
optTarget :: Target
optKeyfile :: Maybe String
optPkgNameFilter :: Maybe String
optVerbose :: Bool
optTiming :: Bool
optRetry :: Int
optThreads :: Int
optLogPath :: Maybe String
optCommit :: Bool
optBuildDir :: String
optTarget :: CLIOptions -> Target
..} = do
Maybe String
aKeyfile <- case Maybe String
optKeyfile of
Just String
k -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
D.makeAbsolute String
k
Maybe String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
Config
config
{ buildDir :: String
buildDir = String
optBuildDir,
actionAfterBuild :: Action ()
actionAfterBuild = do
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe String
optLogPath String -> Action ()
logChangesToFile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
optCommit Action ()
commitChanges
Config -> Action ()
actionAfterBuild Config
config,
shakeConfig :: ShakeOptions
shakeConfig =
(Config -> ShakeOptions
shakeConfig Config
config)
{ shakeTimings :: Bool
shakeTimings = Bool
optTiming,
shakeVerbosity :: Verbosity
shakeVerbosity = if Bool
optVerbose then Verbosity
Verbose else Verbosity
Info,
shakeThreads :: Int
shakeThreads = Int
optThreads
},
filterRegex :: Maybe String
filterRegex = Maybe String
optPkgNameFilter,
retry :: Int
retry = Int
optRetry,
keyfile :: Maybe String
keyfile = Maybe String
aKeyfile
}
logChangesToFile :: FilePath -> Action ()
logChangesToFile :: String -> Action ()
logChangesToFile String
fp = do
[VersionChange]
changes <- Action [VersionChange]
getVersionChanges
forall (m :: * -> *).
(MonadIO m, Located) =>
String -> String -> m ()
writeFile' String
fp forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VersionChange]
changes
commitChanges :: Action ()
commitChanges :: Action ()
commitChanges = do
[VersionChange]
changes <- Action [VersionChange]
getVersionChanges
let commitMsg :: Maybe String
commitMsg = case [VersionChange]
changes of
[VersionChange
x] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show VersionChange
x
xs :: [VersionChange]
xs@(VersionChange
_ : [VersionChange]
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"Update\n" forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VersionChange]
xs)
[] -> forall a. Maybe a
Nothing
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe String
commitMsg forall a b. (a -> b) -> a -> b
$ \String
msg -> do
String -> Action ()
putInfo String
"Commiting changes"
Action String
getBuildDir forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
dir -> Located => [CmdOption] -> String -> [String] -> Action ()
command_ [] String
"git" [String
"add", String
dir]
Located => [CmdOption] -> String -> [String] -> Action ()
command_ [] String
"git" [String
"commit", String
"-m", String
msg]
parseLastVersions :: FilePath -> IO (Maybe (Map.Map PackageKey Version))
parseLastVersions :: String -> IO (Maybe (Map PackageKey Version))
parseLastVersions String
jsonFile =
String -> IO Bool
D.doesFileExist String
jsonFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
Maybe (Map PackageName Object)
objs <- forall a. FromJSON a => String -> IO (Maybe a)
A.decodeFileStrict' String
jsonFile
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Map PackageName Object)
objs forall a b. (a -> b) -> a -> b
$
( \[(PackageName, Object)]
xs ->
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
forall a b. (a -> b) -> a -> b
$ [(PackageName -> PackageKey
PackageKey PackageName
k,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a -> Parser b) -> a -> Maybe b
A.parseMaybe (forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"version") Object
obj | (PackageName
k, Object
obj) <- [(PackageName, Object)]
xs]
)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList
Bool
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
runNvFetcherNoCLI :: Config -> Target -> PackageSet () -> IO ()
runNvFetcherNoCLI :: Config -> Target -> PackageSet () -> IO ()
runNvFetcherNoCLI config :: Config
config@Config {Bool
Int
String
Maybe String
Rules ()
Action ()
ShakeOptions
cacheNvchecker :: Config -> Bool
actionAfterClean :: Config -> Action ()
customRules :: Config -> Rules ()
keyfile :: Maybe String
cacheNvchecker :: Bool
filterRegex :: Maybe String
retry :: Int
actionAfterClean :: Action ()
actionAfterBuild :: Action ()
customRules :: Rules ()
buildDir :: String
shakeConfig :: ShakeOptions
keyfile :: Config -> Maybe String
retry :: Config -> Int
filterRegex :: Config -> Maybe String
shakeConfig :: Config -> ShakeOptions
actionAfterBuild :: Config -> Action ()
buildDir :: Config -> String
..} Target
target PackageSet ()
packageSet = do
Map PackageKey Package
pkgs <- forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Package -> Package
pinIfUnmatch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageSet () -> IO (Map PackageKey Package)
runPackageSet PackageSet ()
packageSet
Maybe (Map PackageKey Version)
lastVersions <- String -> IO (Maybe (Map PackageKey Version))
parseLastVersions forall a b. (a -> b) -> a -> b
$ String
buildDir String -> String -> String
</> String
generatedJsonFileName
String
shakeDir <- IO String
getDataDir
let shakeOptions1 :: ShakeOptions
shakeOptions1 = ShakeOptions
shakeConfig {shakeFiles :: String
shakeFiles = String
shakeDir}
ShakeExtras
shakeExtras <- Config
-> Map PackageKey Package
-> Map PackageKey Version
-> IO ShakeExtras
initShakeExtras (Config
config {shakeConfig :: ShakeOptions
shakeConfig = ShakeOptions
shakeOptions1}) Map PackageKey Package
pkgs forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe (Map PackageKey Version)
lastVersions
let shakeOptions2 :: ShakeOptions
shakeOptions2 = ShakeOptions
shakeOptions1 {shakeExtra :: HashMap TypeRep Dynamic
shakeExtra = forall a.
Typeable a =>
a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
addShakeExtra ShakeExtras
shakeExtras (ShakeOptions -> HashMap TypeRep Dynamic
shakeExtra ShakeOptions
shakeConfig)}
rules :: Rules ()
rules = Config -> Rules ()
mainRules Config
config
ShakeOptions -> Rules () -> IO ()
shake ShakeOptions
shakeOptions2 forall a b. (a -> b) -> a -> b
$ Located => [String] -> Rules ()
want [forall a. Show a => a -> String
show Target
target] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rules ()
rules
where
pinIfUnmatch :: Package -> Package
pinIfUnmatch x :: Package
x@Package {Maybe PackageCargoLockFiles
Maybe PackageExtractSrc
PackageName
UseStaleVersion
PackagePassthru
DateFormat
ForceFetch
CheckVersion
PackageFetcher
_pforcefetch :: Package -> ForceFetch
_pgitdateformat :: Package -> DateFormat
_ppinned :: Package -> UseStaleVersion
_ppassthru :: Package -> PackagePassthru
_pcargo :: Package -> Maybe PackageCargoLockFiles
_pextract :: Package -> Maybe PackageExtractSrc
_pfetcher :: Package -> PackageFetcher
_pversion :: Package -> CheckVersion
_pname :: Package -> PackageName
_pforcefetch :: ForceFetch
_pgitdateformat :: DateFormat
_ppinned :: UseStaleVersion
_ppassthru :: PackagePassthru
_pcargo :: Maybe PackageCargoLockFiles
_pextract :: Maybe PackageExtractSrc
_pfetcher :: PackageFetcher
_pversion :: CheckVersion
_pname :: PackageName
..}
| Just String
regex <- Maybe String
filterRegex =
Package
x
{ _ppinned :: UseStaleVersion
_ppinned = case UseStaleVersion
_ppinned of
UseStaleVersion
PermanentStale -> UseStaleVersion
PermanentStale
UseStaleVersion
_ ->
if PackageName
_pname forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
regex
then UseStaleVersion
NoStale
else UseStaleVersion
TemporaryStale
}
| Bool
otherwise = Package
x
mainRules :: Config -> Rules ()
mainRules :: Config -> Rules ()
mainRules Config {Bool
Int
String
Maybe String
Rules ()
Action ()
ShakeOptions
keyfile :: Maybe String
cacheNvchecker :: Bool
filterRegex :: Maybe String
retry :: Int
actionAfterClean :: Action ()
actionAfterBuild :: Action ()
customRules :: Rules ()
buildDir :: String
shakeConfig :: ShakeOptions
cacheNvchecker :: Config -> Bool
actionAfterClean :: Config -> Action ()
customRules :: Config -> Rules ()
keyfile :: Config -> Maybe String
retry :: Config -> Int
filterRegex :: Config -> Maybe String
shakeConfig :: Config -> ShakeOptions
actionAfterBuild :: Config -> Action ()
buildDir :: Config -> String
..} = do
String
"clean" Located => String -> Action () -> Rules ()
~> do
Action String
getBuildDir forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Action ()
removeFilesAfter [String
"//*"]
Action ()
actionAfterClean
String
"build" Located => String -> Action () -> Rules ()
~> do
[PackageKey]
allKeys <- Action [PackageKey]
getAllPackageKeys
[PackageResult]
results <- forall a. [Action a] -> Action [a]
parallel forall a b. (a -> b) -> a -> b
$ PackageKey -> Action PackageResult
runPackage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageKey]
allKeys
Action (Map PackageKey Version)
getAllOnDiskVersions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Map PackageKey Version
oldPkgs -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [k]
Map.keys Map PackageKey Version
oldPkgs forall a. Eq a => [a] -> [a] -> [a]
\\ [PackageKey]
allKeys) forall a b. (a -> b) -> a -> b
$
\PackageKey
pkg -> PackageName -> Maybe Version -> Version -> Action ()
recordVersionChange (coerce :: forall a b. Coercible a b => a -> b
coerce PackageKey
pkg) (Map PackageKey Version
oldPkgs forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? PackageKey
pkg) Version
"∅"
Action [VersionChange]
getVersionChanges forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[VersionChange]
changes ->
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [VersionChange]
changes
then String -> Action ()
putInfo String
"Up to date"
else do
String -> Action ()
putInfo String
"Changes:"
String -> Action ()
putInfo forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VersionChange]
changes
String
buildDir <- Action String
getBuildDir
let generatedNixPath :: String
generatedNixPath = String
buildDir String -> String -> String
</> String
generatedNixFileName
generatedJSONPath :: String
generatedJSONPath = String
buildDir String -> String -> String
</> String
generatedJsonFileName
String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ String
"Generating " forall a. Semigroup a => a -> a -> a
<> String
generatedNixPath
forall (m :: * -> *).
(MonadIO m, Located) =>
String -> String -> m ()
writeFileChanged String
generatedNixPath forall a b. (a -> b) -> a -> b
$ PackageName -> String
T.unpack forall a b. (a -> b) -> a -> b
$ PackageName -> PackageName
srouces ([PackageName] -> PackageName
T.unlines forall a b. (a -> b) -> a -> b
$ forall a. ToNixExpr a => a -> PackageName
toNixExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageResult]
results) forall a. Semigroup a => a -> a -> a
<> PackageName
"\n"
String -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ String
"Generating " forall a. Semigroup a => a -> a -> a
<> String
generatedJSONPath
forall (m :: * -> *).
(MonadIO m, Located) =>
String -> String -> m ()
writeFileChanged String
generatedJSONPath forall a b. (a -> b) -> a -> b
$ ByteString -> String
LBS.unpack forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
A.encodePretty forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object [PackageName -> Key
aesonKey (PackageResult -> PackageName
_prname PackageResult
r) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= PackageResult
r | PackageResult
r <- [PackageResult]
results]
Action ()
actionAfterBuild
Rules ()
customRules
Rules ()
coreRules
srouces :: Text -> Text
srouces :: PackageName -> PackageName
srouces PackageName
body =
[trimming|
# This file was generated by nvfetcher, please do not modify it manually.
{ fetchgit, fetchurl, fetchFromGitHub, dockerTools }:
{
$body
}
|]
generatedNixFileName :: String
generatedNixFileName :: String
generatedNixFileName = String
"generated.nix"
generatedJsonFileName :: String
generatedJsonFileName :: String
generatedJsonFileName = String
"generated.json"