{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module NvFetcher
( Args (..),
defaultArgs,
runNvFetcher,
runNvFetcherNoCLI,
cliOptionsToArgs,
module NvFetcher.PackageSet,
module NvFetcher.Types,
module NvFetcher.Types.ShakeExtras,
)
where
import qualified Control.Exception as CE
import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake
import Development.Shake.FilePath
import NeatInterpolation (trimming)
import NvFetcher.Core
import NvFetcher.NixFetcher
import NvFetcher.Nvchecker
import NvFetcher.Options
import NvFetcher.PackageSet
import NvFetcher.Types
import NvFetcher.Types.ShakeExtras
import NvFetcher.Utils (getShakeDir)
import System.Directory.Extra (createDirectoryIfMissing, createFileLink, removeFile)
data Args = Args
{
Args -> ShakeOptions
argShakeOptions :: ShakeOptions,
Args -> String
argTarget :: String,
Args -> String
argOutputFilePath :: FilePath,
Args -> Rules ()
argRules :: Rules (),
Args -> Action ()
argActionAfterBuild :: Action (),
Args -> Action ()
argActionAfterClean :: Action (),
Args -> Int
argRetries :: Int
}
defaultArgs :: Args
defaultArgs :: Args
defaultArgs =
ShakeOptions
-> String
-> String
-> Rules ()
-> Action ()
-> Action ()
-> Int
-> Args
Args
( ShakeOptions
shakeOptions
{ shakeProgress :: IO Progress -> IO ()
shakeProgress = IO Progress -> IO ()
progressSimple,
shakeThreads :: Int
shakeThreads = Int
0
}
)
String
"build"
String
"sources.nix"
(() -> Rules ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
(() -> Action ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
(() -> Action ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
Int
3
runNvFetcher :: PackageSet () -> IO ()
runNvFetcher :: PackageSet () -> IO ()
runNvFetcher PackageSet ()
packageSet =
Parser CLIOptions -> IO CLIOptions
forall a. Parser a -> IO a
getCLIOptions Parser CLIOptions
cliOptionsParser IO CLIOptions -> (CLIOptions -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Args -> PackageSet () -> IO ()) -> PackageSet () -> Args -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Args -> PackageSet () -> IO ()
runNvFetcherNoCLI PackageSet ()
packageSet (Args -> IO ()) -> (CLIOptions -> Args) -> CLIOptions -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLIOptions -> Args
cliOptionsToArgs
cliOptionsToArgs :: CLIOptions -> Args
cliOptionsToArgs :: CLIOptions -> Args
cliOptionsToArgs CLIOptions {Bool
Int
String
Maybe String
target :: CLIOptions -> String
verbose :: CLIOptions -> Bool
timing :: CLIOptions -> Bool
retries :: CLIOptions -> Int
threads :: CLIOptions -> Int
logPath :: CLIOptions -> Maybe String
outputPath :: CLIOptions -> String
target :: String
verbose :: Bool
timing :: Bool
retries :: Int
threads :: Int
logPath :: Maybe String
outputPath :: String
..} =
Args
defaultArgs
{ argOutputFilePath :: String
argOutputFilePath = String
outputPath,
argActionAfterBuild :: Action ()
argActionAfterBuild = Action () -> (String -> Action ()) -> Maybe String -> Action ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Action ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) String -> Action ()
logChangesToFile Maybe String
logPath,
argTarget :: String
argTarget = String
target,
argShakeOptions :: ShakeOptions
argShakeOptions =
(Args -> ShakeOptions
argShakeOptions Args
defaultArgs)
{ shakeTimings :: Bool
shakeTimings = Bool
timing,
shakeVerbosity :: Verbosity
shakeVerbosity = if Bool
verbose then Verbosity
Verbose else Verbosity
Info,
shakeThreads :: Int
shakeThreads = Int
threads
}
}
logChangesToFile :: FilePath -> Action ()
logChangesToFile :: String -> Action ()
logChangesToFile String
fp = do
[VersionChange]
changes <- Action [VersionChange]
getVersionChanges
String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFile' String
fp (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ VersionChange -> String
forall a. Show a => a -> String
show (VersionChange -> String) -> [VersionChange] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VersionChange]
changes
runNvFetcherNoCLI :: Args -> PackageSet () -> IO ()
runNvFetcherNoCLI :: Args -> PackageSet () -> IO ()
runNvFetcherNoCLI args :: Args
args@Args {Int
String
Rules ()
Action ()
ShakeOptions
argRetries :: Int
argActionAfterClean :: Action ()
argActionAfterBuild :: Action ()
argRules :: Rules ()
argOutputFilePath :: String
argTarget :: String
argShakeOptions :: ShakeOptions
argRetries :: Args -> Int
argActionAfterClean :: Args -> Action ()
argActionAfterBuild :: Args -> Action ()
argRules :: Args -> Rules ()
argOutputFilePath :: Args -> String
argTarget :: Args -> String
argShakeOptions :: Args -> ShakeOptions
..} PackageSet ()
packageSet = do
Map PackageKey Package
pkgs <- PackageSet () -> IO (Map PackageKey Package)
runPackageSet PackageSet ()
packageSet
ShakeExtras
shakeExtras <- Map PackageKey Package -> Int -> IO ShakeExtras
initShakeExtras Map PackageKey Package
pkgs Int
argRetries
let opts :: ShakeOptions
opts =
ShakeOptions
argShakeOptions
{ shakeExtra :: HashMap TypeRep Dynamic
shakeExtra = ShakeExtras -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
forall a.
Typeable a =>
a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
addShakeExtra ShakeExtras
shakeExtras (ShakeOptions -> HashMap TypeRep Dynamic
shakeExtra ShakeOptions
argShakeOptions),
shakeFiles :: String
shakeFiles = String
"_build"
}
rules :: Rules ()
rules = Args -> Rules ()
mainRules Args
args
ShakeOptions -> Rules () -> IO ()
shake ShakeOptions
opts (Rules () -> IO ()) -> Rules () -> IO ()
forall a b. (a -> b) -> a -> b
$ Partial => [String] -> Rules ()
[String] -> Rules ()
want [String
argTarget] Rules () -> Rules () -> Rules ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rules ()
rules
mainRules :: Args -> Rules ()
mainRules :: Args -> Rules ()
mainRules Args {Int
String
Rules ()
Action ()
ShakeOptions
argRetries :: Int
argActionAfterClean :: Action ()
argActionAfterBuild :: Action ()
argRules :: Rules ()
argOutputFilePath :: String
argTarget :: String
argShakeOptions :: ShakeOptions
argRetries :: Args -> Int
argActionAfterClean :: Args -> Action ()
argActionAfterBuild :: Args -> Action ()
argRules :: Args -> Rules ()
argOutputFilePath :: Args -> String
argTarget :: Args -> String
argShakeOptions :: Args -> ShakeOptions
..} = do
String
"clean" Partial => String -> Action () -> Rules ()
String -> Action () -> Rules ()
~> do
String -> [String] -> Action ()
removeFilesAfter String
"_build" [String
"//*"]
String -> [String] -> Action ()
removeFilesAfter String
"." [String
argOutputFilePath]
Action ()
argActionAfterClean
String
"build" Partial => String -> Action () -> Rules ()
String -> Action () -> Rules ()
~> do
[PackageKey]
allKeys <- Action [PackageKey]
getAllPackageKeys
[NixExpr]
body <- [Action NixExpr] -> Action [NixExpr]
forall a. [Action a] -> Action [a]
parallel ([Action NixExpr] -> Action [NixExpr])
-> [Action NixExpr] -> Action [NixExpr]
forall a b. (a -> b) -> a -> b
$ PackageKey -> Action NixExpr
generateNixSourceExpr (PackageKey -> Action NixExpr) -> [PackageKey] -> [Action NixExpr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PackageKey]
allKeys
Action [VersionChange]
getVersionChanges Action [VersionChange]
-> ([VersionChange] -> Action ()) -> Action ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[VersionChange]
changes ->
if [VersionChange] -> Bool
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 (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ VersionChange -> String
forall a. Show a => a -> String
show (VersionChange -> String) -> [VersionChange] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VersionChange]
changes
String
shakeDir <- Action String
getShakeDir
let genPath :: String
genPath = String
shakeDir String -> String -> String
</> String
"generated.nix"
String -> Action ()
putVerbose (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"Generating " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
genPath
String -> String -> Action ()
forall (m :: * -> *).
(MonadIO m, Partial) =>
String -> String -> m ()
writeFileChanged String
genPath (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ NixExpr -> String
T.unpack (NixExpr -> String) -> NixExpr -> String
forall a b. (a -> b) -> a -> b
$ NixExpr -> NixExpr
srouces ([NixExpr] -> NixExpr
T.unlines [NixExpr]
body) NixExpr -> NixExpr -> NixExpr
forall a. Semigroup a => a -> a -> a
<> NixExpr
"\n"
Partial => [String] -> Action ()
[String] -> Action ()
need [String
genPath]
let outDir :: String
outDir = String -> String
takeDirectory String
argOutputFilePath
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
outDir
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
CE.catch @IOError (String -> IO ()
removeFile String
argOutputFilePath) (IO () -> IOError -> IO ()
forall a b. a -> b -> a
const (IO () -> IOError -> IO ()) -> IO () -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
String -> Action ()
putVerbose (String -> Action ()) -> String -> Action ()
forall a b. (a -> b) -> a -> b
$ String
"Symlinking " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
argOutputFilePath
IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
createFileLink String
genPath String
argOutputFilePath
Action ()
argActionAfterBuild
Rules ()
argRules
Rules ()
coreRules
srouces :: Text -> Text
srouces :: NixExpr -> NixExpr
srouces NixExpr
body =
[trimming|
# This file was generated by nvfetcher, please do not modify it manually.
{ fetchgit, fetchurl }:
{
$body
}
|]