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

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
--
-- The main module of nvfetcher. If you want to create CLI program with it, it's enough to import only this module.
--
-- Example:
--
-- @
-- module Main where
--
-- import NvFetcher
--
-- main :: IO ()
-- main = runNvFetcher packageSet
--
-- packageSet :: PackageSet ()
-- packageSet = do
--   define $ package "feeluown-core" `fromPypi` "feeluown"
--   define $ package "qliveplayer" `fromGitHub` ("THMonster", "QLivePlayer")
-- @
--
-- You can find more examples of packages in @Main_example.hs@.
--
-- Running the created program:
--
-- * @main@ -- abbreviation of @main build@
-- * @main build@ -- build nix sources expr from given @packageSet@
-- * @main clean@ -- delete .shake dir and generated nix file
--
-- All shake options are inherited.
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 ((=~))

-- | Run nvfetcher with CLI options
--
-- This function calls 'runNvFetcherNoCLI', using 'def' 'Config' overridden by 'CLIOptions'.
-- Use this function to create your own Haskell executable program.
runNvFetcher :: PackageSet () -> IO ()
runNvFetcher :: PackageSet () -> IO ()
runNvFetcher = Config -> PackageSet () -> IO ()
runNvFetcher' forall a. Default a => a
def

-- | Similar to 'runNvFetcher', but uses custom @config@ instead of 'def' overridden by 'CLIOptions'
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

-- | Apply 'CLIOptions' to 'Config'
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]

-- | @Parse generated.nix@
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

-- | Entry point of nvfetcher
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
  -- Set shakeFiles
  let shakeOptions1 :: ShakeOptions
shakeOptions1 = ShakeOptions
shakeConfig {shakeFiles :: String
shakeFiles = String
shakeDir}
  -- shakeConfig in Config will be shakeOptions1 (not including shake extra)
  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
  -- Set shakeExtra
  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
    -- Don't touch already pinned packages
    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
    -- Record removed packages to version changes
    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"