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

-- | Copyright: (c) 2021-2025 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <[email protected]>
-- Stability: experimental
-- Portability: portable
--
-- This module provides function that extracts files contents from package sources.
-- Because we use @nix-instantiate@ to build drv, so @<nixpkgs>@ (@NIX_PATH@) is required.
module NvFetcher.ExtractSrc
  ( -- * Types
    ExtractSrcQ (..),
    Glob (..),

    -- * Rules
    extractSrcRule,

    -- * Functions
    extractSrc,
    extractSrcs,
  )
where

import Control.Monad (filterM, forM, join, void, when)
import Control.Monad.Extra (unlessM)
import Data.Binary.Instances ()
import Data.Coerce (coerce)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.List (intercalate)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import Development.Shake
import Development.Shake.FilePath (makeRelative, (</>))
import NvFetcher.NixExpr
import NvFetcher.Types
import NvFetcher.Types.ShakeExtras
import NvFetcher.Utils (compileGlob)
import Prettyprinter (pretty, (<+>))
import qualified System.Directory.Extra as IO
import System.FilePath.Glob (globDir1)

-- | Rules of extract source
extractSrcRule :: Rules ()
extractSrcRule :: Rules ()
extractSrcRule = Rules (ExtractSrcQ -> Action (HashMap FilePath FilePath))
-> Rules ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rules (ExtractSrcQ -> Action (HashMap FilePath FilePath))
 -> Rules ())
-> Rules (ExtractSrcQ -> Action (HashMap FilePath FilePath))
-> Rules ()
forall a b. (a -> b) -> a -> b
$
  (ExtractSrcQ -> Action (HashMap FilePath FilePath))
-> Rules (ExtractSrcQ -> Action (HashMap FilePath FilePath))
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, HasCallStack) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle ((ExtractSrcQ -> Action (HashMap FilePath FilePath))
 -> Rules (ExtractSrcQ -> Action (HashMap FilePath FilePath)))
-> (ExtractSrcQ -> Action (HashMap FilePath FilePath))
-> Rules (ExtractSrcQ -> Action (HashMap FilePath FilePath))
forall a b. (a -> b) -> a -> b
$ \q :: ExtractSrcQ
q@(ExtractSrcQ NixFetcher 'Fetched
fetcher NonEmpty Glob
files) -> do
    (FilePath -> Action (HashMap FilePath FilePath))
-> Action (HashMap FilePath FilePath)
forall a. (FilePath -> Action a) -> Action a
withTempFile ((FilePath -> Action (HashMap FilePath FilePath))
 -> Action (HashMap FilePath FilePath))
-> (FilePath -> Action (HashMap FilePath FilePath))
-> Action (HashMap FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> Action (HashMap FilePath FilePath)
-> Action (HashMap FilePath FilePath)
forall a. Action a -> Action a
withRetry (Action (HashMap FilePath FilePath)
 -> Action (HashMap FilePath FilePath))
-> Action (HashMap FilePath FilePath)
-> Action (HashMap FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> Action ()
putInfo (FilePath -> Action ())
-> (Doc Any -> FilePath) -> Doc Any -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> FilePath
forall a. Show a => a -> FilePath
show (Doc Any -> Action ()) -> Doc Any -> Action ()
forall a b. (a -> b) -> a -> b
$ Doc Any
"#" Doc Any -> Doc Any -> Doc Any
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExtractSrcQ -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. ExtractSrcQ -> Doc ann
pretty ExtractSrcQ
q
      let nixExpr :: FilePath
nixExpr = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fetched -> Text -> Text
fetcherToDrv NixFetcher 'Fetched
fetcher Text
"nvfetcher-extract"
      FilePath -> Action ()
putVerbose (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Generated nix expr:\n" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
nixExpr
      FilePath -> FilePath -> Action ()
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
FilePath -> FilePath -> m ()
writeFile' FilePath
fp FilePath
nixExpr
      (CmdTime Double
t, StdoutTrim FilePath
out, CmdLine FilePath
c, Stdouterr FilePath
err) <- Action (CmdTime, StdoutTrim FilePath, CmdLine, Stdouterr FilePath)
-> Action
     (CmdTime, StdoutTrim FilePath, CmdLine, Stdouterr FilePath)
forall a. Action a -> Action a
quietly (Action (CmdTime, StdoutTrim FilePath, CmdLine, Stdouterr FilePath)
 -> Action
      (CmdTime, StdoutTrim FilePath, CmdLine, Stdouterr FilePath))
-> Action
     (CmdTime, StdoutTrim FilePath, CmdLine, Stdouterr FilePath)
-> Action
     (CmdTime, StdoutTrim FilePath, CmdLine, Stdouterr FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
-> Action
     (CmdTime, StdoutTrim FilePath, CmdLine, Stdouterr FilePath)
forall args r. (HasCallStack, CmdArguments args) => args
cmd (FilePath
 -> Action
      (CmdTime, StdoutTrim FilePath, CmdLine, Stdouterr FilePath))
-> FilePath
-> Action
     (CmdTime, StdoutTrim FilePath, CmdLine, Stdouterr FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
"nix-build --no-out-link " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp
      FilePath -> Action ()
putVerbose (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Finishing running " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
c FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
", took " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Double -> FilePath
forall a. Show a => a -> FilePath
show Double
t FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"s"
      FilePath -> Action ()
putVerbose (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Output from stdout: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
out
      FilePath -> Action ()
putVerbose (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Output from stderr: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
err
      Action Bool -> Action () -> Action ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (IO Bool -> Action Bool
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Action Bool) -> IO Bool -> Action Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
IO.doesDirectoryExist FilePath
out) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> Action ()
forall a. FilePath -> Action a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$
          FilePath
"nix-build output is not a directory: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
out
      FilePath
buildDir <- Action FilePath
getBuildDir
      [(FilePath, FilePath)] -> HashMap FilePath FilePath
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
        ([(FilePath, FilePath)] -> HashMap FilePath FilePath)
-> Action [(FilePath, FilePath)]
-> Action (HashMap FilePath FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[(FilePath, FilePath)]] -> [(FilePath, FilePath)])
-> Action [[(FilePath, FilePath)]] -> Action [(FilePath, FilePath)]
forall a b. (a -> b) -> Action a -> Action b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          [[(FilePath, FilePath)]] -> [(FilePath, FilePath)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
          ( [Action [(FilePath, FilePath)]] -> Action [[(FilePath, FilePath)]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
              [ do
                  let compiled :: Pattern
compiled = Glob -> Pattern
compileGlob Glob
glob
                  -- Find all matching files
                  [FilePath]
paths <- IO [FilePath] -> Action [FilePath]
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Action [FilePath])
-> IO [FilePath] -> Action [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
makeRelative FilePath
out) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO [FilePath] -> IO [FilePath]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Pattern -> FilePath -> IO [FilePath]
globDir1 Pattern
compiled FilePath
out) IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
IO.doesFileExist)
                  FilePath -> Action ()
putVerbose (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath
"From glob: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Glob -> FilePath
forall a b. Coercible a b => a -> b
coerce Glob
glob FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
", found file(s): " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " [FilePath]
paths
                  Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
paths) (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Action ()
forall a. FilePath -> Action a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ FilePath
"No files matched glob: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Glob -> FilePath
forall a b. Coercible a b => a -> b
coerce Glob
glob
                  [FilePath]
-> (FilePath -> Action (FilePath, FilePath))
-> Action [(FilePath, FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
paths ((FilePath -> Action (FilePath, FilePath))
 -> Action [(FilePath, FilePath)])
-> (FilePath -> Action (FilePath, FilePath))
-> Action [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$ \FilePath
file -> do
                    -- Copy the file to the build directory under the hash of the fetcher
                    -- Also replace slashes in the hash with underscores
                    let dst :: FilePath
dst = (Text -> FilePath
T.unpack (Text -> FilePath) -> (Checksum -> Text) -> Checksum -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"/" Text
"_" (Text -> Text) -> (Checksum -> Text) -> Checksum -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Checksum -> Text
forall a b. Coercible a b => a -> b
coerce (Checksum -> FilePath) -> Checksum -> FilePath
forall a b. (a -> b) -> a -> b
$ NixFetcher 'Fetched -> FetchResult Checksum 'Fetched
forall (k :: FetchStatus). NixFetcher k -> FetchResult Checksum k
_sha256 NixFetcher 'Fetched
fetcher) FilePath -> FilePath -> FilePath
</> FilePath
file
                    HasCallStack => FilePath -> FilePath -> Action ()
FilePath -> FilePath -> Action ()
copyFile' (FilePath
out FilePath -> FilePath -> FilePath
</> FilePath
file) (FilePath
buildDir FilePath -> FilePath -> FilePath
</> FilePath
dst)
                    (FilePath, FilePath) -> Action (FilePath, FilePath)
forall a. a -> Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
file, FilePath
dst)
                | Glob
glob <- NonEmpty Glob -> [Glob]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Glob
files
              ]
          )

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

-- | Run extract source
extractSrc ::
  -- | prefetched source
  NixFetcher Fetched ->
  -- | glob pattern
  Glob ->
  Action (HashMap FilePath FilePath)
extractSrc :: NixFetcher 'Fetched -> Glob -> Action (HashMap FilePath FilePath)
extractSrc NixFetcher 'Fetched
fetcher Glob
glob = NixFetcher 'Fetched
-> NonEmpty Glob -> Action (HashMap FilePath FilePath)
extractSrcs NixFetcher 'Fetched
fetcher (NonEmpty Glob -> Action (HashMap FilePath FilePath))
-> NonEmpty Glob -> Action (HashMap FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ [Glob] -> NonEmpty Glob
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Glob
glob]