{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
--
-- This module provides function that extracs files contents from package sources.
-- It uses [IFD](https://nixos.wiki/wiki/Import_From_Derivation) under the hood,
-- pulling /textual/ files from source drv.
-- Because we use @nix-instantiate@ to build drv, so @<nixpkgs>@ (@NIX_PATH@) is required.
module NvFetcher.ExtractSrc
  ( -- * Types
    ExtractSrcQ (..),

    -- * Rules
    extractSrcRule,

    -- * Functions
    extractSrc,
    extractSrcs,
  )
where

import Control.Monad (void)
import Control.Monad.Extra (unlessM)
import Data.Binary.Instances ()
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Development.Shake
import Development.Shake.FilePath ((</>))
import NvFetcher.NixExpr
import NvFetcher.Types
import NvFetcher.Types.ShakeExtras
import Prettyprinter (pretty, (<+>))

-- | Rules of extract source
extractSrcRule :: Rules ()
extractSrcRule :: Rules ()
extractSrcRule = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
  forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle forall a b. (a -> b) -> a -> b
$ \q :: ExtractSrcQ
q@(ExtractSrcQ NixFetcher 'Fetched
fetcher NonEmpty FilePath
files) -> forall a. (FilePath -> Action a) -> Action a
withTempFile forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> forall a. Action a -> Action a
withRetry forall a b. (a -> b) -> a -> b
$ do
    FilePath -> Action ()
putInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ Doc Any
"#" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty ExtractSrcQ
q
    let nixExpr :: FilePath
nixExpr = Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fetched -> Text -> Text
fetcherToDrv NixFetcher 'Fetched
fetcher Text
"nvfetcher-extract"
    FilePath -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ FilePath
"Generated nix expr:\n" forall a. Semigroup a => a -> a -> a
<> FilePath
nixExpr
    forall (m :: * -> *).
(MonadIO m, Partial) =>
FilePath -> FilePath -> m ()
writeFile' FilePath
fp FilePath
nixExpr
    (CmdTime Double
t, StdoutTrim FilePath
out, CmdLine FilePath
c, Stdouterr FilePath
err) <- forall a. Action a -> Action a
quietly forall a b. (a -> b) -> a -> b
$ forall args r. (Partial, CmdArguments args) => args
cmd forall a b. (a -> b) -> a -> b
$ FilePath
"nix-build --no-out-link " forall a. Semigroup a => a -> a -> a
<> FilePath
fp
    FilePath -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ FilePath
"Finishing running " forall a. Semigroup a => a -> a -> a
<> FilePath
c forall a. Semigroup a => a -> a -> a
<> FilePath
", took " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Double
t forall a. Semigroup a => a -> a -> a
<> FilePath
"s"
    FilePath -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ FilePath
"Output from stdout: " forall a. Semigroup a => a -> a -> a
<> FilePath
out
    FilePath -> Action ()
putVerbose forall a b. (a -> b) -> a -> b
$ FilePath
"Output from stderr: " forall a. Semigroup a => a -> a -> a
<> FilePath
err
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (FilePath -> Action Bool
doesDirectoryExist FilePath
out) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"nix-build output is not a directory: " forall a. Semigroup a => a -> a -> a
<> FilePath
out
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [(FilePath
f,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
T.readFile forall a b. (a -> b) -> a -> b
$ FilePath
out FilePath -> FilePath -> FilePath
</> FilePath
f) | FilePath
f <- forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
files]

-- | Run extract source with many sources
extractSrcs ::
  -- | prefetched source
  NixFetcher Fetched ->
  -- | relative file paths to extract
  NE.NonEmpty FilePath ->
  Action (HashMap FilePath Text)
extractSrcs :: NixFetcher 'Fetched
-> NonEmpty FilePath -> Action (HashMap FilePath Text)
extractSrcs NixFetcher 'Fetched
fetcher NonEmpty FilePath
xs = forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a) =>
q -> Action a
askOracle (NixFetcher 'Fetched -> NonEmpty FilePath -> ExtractSrcQ
ExtractSrcQ NixFetcher 'Fetched
fetcher NonEmpty FilePath
xs)

-- | Run extract source
extractSrc ::
  -- | prefetched source
  NixFetcher Fetched ->
  -- | relative file path to extract
  FilePath ->
  Action (HashMap FilePath Text)
extractSrc :: NixFetcher 'Fetched -> FilePath -> Action (HashMap FilePath Text)
extractSrc NixFetcher 'Fetched
fetcher FilePath
fp = NixFetcher 'Fetched
-> NonEmpty FilePath -> Action (HashMap FilePath Text)
extractSrcs NixFetcher 'Fetched
fetcher forall a b. (a -> b) -> a -> b
$ forall a. [a] -> NonEmpty a
NE.fromList [FilePath
fp]