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

-- | Copyright: (c) 2021 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 defaultArgs packageSet
--
-- packageSet :: PackageSet ()
-- packageSet = do
--   define $ package "feeluown-core" `fromPypi` "feeluown"
--   define $ package "qliveplayer" `fromGitHub` ("IsoaSFlus", "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
-- * @main -j@ -- build with parallelism
--
-- All shake options are inherited.
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)

-- | Arguments for running nvfetcher
data Args = Args
  { -- | Shake options
    Args -> ShakeOptions
argShakeOptions :: ShakeOptions,
    -- | Build target
    Args -> String
argTarget :: String,
    -- | Output file path
    Args -> String
argOutputFilePath :: FilePath,
    -- | Custom rules
    Args -> Rules ()
argRules :: Rules (),
    -- | Action run after build rule
    Args -> Action ()
argActionAfterBuild :: Action (),
    -- | Action run after clean rule
    Args -> Action ()
argActionAfterClean :: Action (),
    -- | Retry times
    Args -> Int
argRetries :: Int
  }

-- | Default arguments of 'defaultMain'
--
-- Output file path is @sources.nix@.
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

-- | Run nvfetcher with CLI options
--
-- This function calls 'runNvFetcherNoCLI', using 'Args' from 'CLIOptions'.
-- Use this function to create your own Haskell executable program.
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

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

-- | Entry point of nvfetcher
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
    }
  |]