nvfetcher-0.1.0.0: src/NvFetcher.hs

{-# 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 = defaultMain 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,
    runNvFetcherWith,
    module NvFetcher.PackageSet,
    module NvFetcher.Types,
    module NvFetcher.ShakeExtras,
  )
where

import Control.Monad.Trans.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import Development.Shake
import NeatInterpolation (trimming)
import NvFetcher.Core
import NvFetcher.NixFetcher
import NvFetcher.Nvchecker
import NvFetcher.PackageSet
import NvFetcher.ShakeExtras
import NvFetcher.Types
import System.Console.GetOpt (OptDescr)

-- | Arguments for running nvfetcher
data Args = Args
  { -- | tweak shake options
    argShakeOptions :: ShakeOptions -> ShakeOptions,
    -- | Output file path
    argOutputFilePath :: FilePath,
    -- | Custom rules
    argRules :: Rules (),
    -- | Action run after build rule
    argActionAfterBuild :: Action (),
    -- | Action run after clean rule
    argActionAfterClean :: Action ()
  }

-- | Default arguments of 'defaultMain'
--
-- Output file path is @sources.nix@.
defaultArgs :: Args
defaultArgs =
  Args
    ( \x ->
        x
          { shakeTimings = True,
            shakeProgress = progressSimple
          }
    )
    "sources.nix"
    (pure ())
    (pure ())
    (pure ())

-- | Entry point of nvfetcher
runNvFetcher :: Args -> PackageSet () -> IO ()
runNvFetcher args packageSet = runNvFetcherWith [] $ const $ pure $ Just (args, packageSet)

-- | Like 'runNvFetcher' but allows to define custom cli flags
runNvFetcherWith ::
  -- | Custom flags
  [OptDescr (Either String a)] ->
  -- | Continuation, the build system won't run if it returns Nothing
  ([a] -> IO (Maybe (Args, PackageSet ()))) ->
  IO ()
runNvFetcherWith flags f = do
  shakeArgsOptionsWith
    shakeOptions
    flags
    $ \opts flagValues argValues -> runMaybeT $ do
      (args@Args {..}, packageSet) <- MaybeT $ f flagValues
      pkgs <- liftIO $ runPackageSet packageSet
      shakeExtras <- liftIO $ initShakeExtras pkgs
      let opts' =
            let old = argShakeOptions opts
             in old
                  { shakeExtra = addShakeExtra shakeExtras (shakeExtra old)
                  }
          rules = mainRules args
      pure $ case argValues of
        [] -> (opts', want ["build"] >> rules)
        files -> (opts', want files >> rules)

mainRules :: Args -> Rules ()
mainRules Args {..} = do
  addHelpSuffix "It's important to keep .shake dir if you want to get correct version changes and proper cache"
  addHelpSuffix "Changing input packages will lead to a fully cleanup, requiring to rebuild everything next run"

  "clean" ~> do
    removeFilesAfter ".shake" ["//*"]
    removeFilesAfter "." [argOutputFilePath]
    argActionAfterClean

  "build" ~> do
    allKeys <- getAllPackageKeys
    body <- parallel $ generateNixSourceExpr <$> allKeys
    getVersionChanges >>= \changes ->
      if null changes
        then putInfo "Up to date"
        else do
          putInfo "Changes:"
          putInfo $ unlines $ show <$> changes
    writeFileChanged argOutputFilePath $ T.unpack $ srouces $ T.unlines body
    putInfo $ "Generate " <> argOutputFilePath
    argActionAfterBuild

  argRules
  coreRules

srouces :: Text -> Text
srouces body =
  [trimming|
    # This file was generated by nvfetcher, please do not modify it manually.
    { fetchgit, fetchurl }:
    {
      $body
    }
  |]