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

-- | Copyright: (c) 2021 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <[email protected]>
-- 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` ("THMonster", "QLivePlayer")
-- @
--
-- You can find more examples of packages in @[email protected]
--
-- Running the created program:
--
-- * @[email protected] -- abbreviation of @main [email protected]
-- * @main [email protected] -- build nix sources expr from given @[email protected]
-- * @main [email protected] -- delete .shake dir and generated nix file
-- * @main [email protected] -- 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 Control.Monad.Extra (when, whenJust)
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)

-- | Arguments for running nvfetcher
data Args = Args
  { -- | Shake options
    Args -> ShakeOptions
argShakeOptions :: ShakeOptions,
    -- | Build target
    Args -> String
argTarget :: String,
    -- | Shake dir
    Args -> String
argBuildDir :: 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'
--
-- Build dir is @[email protected]
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"
    (() -> 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
commit :: CLIOptions -> Bool
buildDir :: CLIOptions -> String
target :: String
verbose :: Bool
timing :: Bool
retries :: Int
threads :: Int
logPath :: Maybe String
commit :: Bool
buildDir :: String
..} =
  Args
defaultArgs
    { argActionAfterBuild :: Action ()
argActionAfterBuild = do
        Maybe String -> (String -> Action ()) -> Action ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe String
logPath String -> Action ()
logChangesToFile
        Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
commit Action ()
commitChanges,
      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,
            shakeFiles :: String
shakeFiles = String
buildDir
          }
    }

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

commitChanges :: Action ()
commitChanges :: Action ()
commitChanges = do
  [VersionChange]
changes <- Action [VersionChange]
getVersionChanges
  let commitMsg :: Maybe String
commitMsg = case [VersionChange]
changes of
        [VersionChange
x] -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ VersionChange -> String
forall a. Show a => a -> String
show VersionChange
x
        xs :: [VersionChange]
xs@(VersionChange
_ : [VersionChange]
_) -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Update\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines (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]
xs)
        [] -> Maybe String
forall a. Maybe a
Nothing
  Maybe String -> (String -> Action ()) -> Action ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe String
commitMsg ((String -> Action ()) -> Action ())
-> (String -> Action ()) -> Action ()
forall a b. (a -> b) -> a -> b
$ \String
msg -> do
    String -> Action ()
putInfo String
"Commiting changes"
    Action String
getShakeDir Action String -> (String -> Action ()) -> Action ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
dir -> Partial => [CmdOption] -> String -> [String] -> Action ()
[CmdOption] -> String -> [String] -> Action ()
command_ [] String
"git" [String
"add", String
dir]
    Partial => [CmdOption] -> String -> [String] -> Action ()
[CmdOption] -> String -> [String] -> Action ()
command_ [] String
"git" [String
"commit", String
"-m", String
msg]

-- | 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 ()
argBuildDir :: String
argTarget :: String
argShakeOptions :: ShakeOptions
argRetries :: Args -> Int
argActionAfterClean :: Args -> Action ()
argActionAfterBuild :: Args -> Action ()
argRules :: Args -> Rules ()
argBuildDir :: 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)
          }
      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 ()
argBuildDir :: String
argTarget :: String
argShakeOptions :: ShakeOptions
argRetries :: Args -> Int
argActionAfterClean :: Args -> Action ()
argActionAfterBuild :: Args -> Action ()
argRules :: Args -> Rules ()
argBuildDir :: Args -> String
argTarget :: Args -> String
argShakeOptions :: Args -> ShakeOptions
..} = do
  String
"clean" Partial => String -> Action () -> Rules ()
String -> Action () -> Rules ()
~> do
    Action String
getShakeDir Action String -> (String -> Action ()) -> Action ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> [String] -> Action ())
-> [String] -> String -> Action ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Action ()
removeFilesAfter [String
"//*"]
    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]
    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, fetchFromGitHub }:
    {
      $body
    }
  |]