{-# 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 (ZonkAny 0) -> FilePath) -> Doc (ZonkAny 0) -> Action ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc (ZonkAny 0) -> FilePath
forall a. Show a => a -> FilePath
show (Doc (ZonkAny 0) -> Action ()) -> Doc (ZonkAny 0) -> Action ()
forall a b. (a -> b) -> a -> b
$ Doc (ZonkAny 0)
"#" Doc (ZonkAny 0) -> Doc (ZonkAny 0) -> Doc (ZonkAny 0)
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExtractSrcQ -> Doc (ZonkAny 0)
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 t, StdoutTrim out, CmdLine c, Stdouterr 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
      putVerbose $ "Finishing running " <> c <> ", took " <> show t <> "s"
      putVerbose $ "Output from stdout: " <> out
      putVerbose $ "Output from stderr: " <> err
      unlessM (liftIO $ IO.doesDirectoryExist out) $
        fail $
          "nix-build output is not a directory: " <> out
      buildDir <- getBuildDir
      HM.fromList
        <$> fmap
          join
          ( sequence
              [ do
                  let compiled = Glob -> Pattern
compileGlob Glob
glob
                  -- Find all matching files
                  paths <- liftIO $ fmap (makeRelative out) <$> (liftIO (globDir1 compiled out) >>= filterM IO.doesFileExist)
                  putVerbose $ "From glob: " <> coerce glob <> ", found file(s): " <> intercalate ", " paths
                  when (null paths) $ fail $ "No files matched glob: " <> coerce glob
                  forM paths $ \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 <- NE.toList 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]