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

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <[email protected]>
-- 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 = Rules (ExtractSrcQ -> Action (HashMap FilePath Text)) -> Rules ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Rules (ExtractSrcQ -> Action (HashMap FilePath Text)) -> Rules ())
-> Rules (ExtractSrcQ -> Action (HashMap FilePath Text))
-> Rules ()
forall a b. (a -> b) -> a -> b
$
  (ExtractSrcQ -> Action (HashMap FilePath Text))
-> Rules (ExtractSrcQ -> Action (HashMap FilePath Text))
forall q a.
(RuleResult q ~ a, ShakeValue q, ShakeValue a, HasCallStack) =>
(q -> Action a) -> Rules (q -> Action a)
addOracle ((ExtractSrcQ -> Action (HashMap FilePath Text))
 -> Rules (ExtractSrcQ -> Action (HashMap FilePath Text)))
-> (ExtractSrcQ -> Action (HashMap FilePath Text))
-> Rules (ExtractSrcQ -> Action (HashMap FilePath Text))
forall a b. (a -> b) -> a -> b
$ \q :: ExtractSrcQ
q@(ExtractSrcQ NixFetcher 'Fetched
fetcher NonEmpty FilePath
files) -> (FilePath -> Action (HashMap FilePath Text))
-> Action (HashMap FilePath Text)
forall a. (FilePath -> Action a) -> Action a
withTempFile ((FilePath -> Action (HashMap FilePath Text))
 -> Action (HashMap FilePath Text))
-> (FilePath -> Action (HashMap FilePath Text))
-> Action (HashMap FilePath Text)
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> Action (HashMap FilePath Text) -> Action (HashMap FilePath Text)
forall a. Action a -> Action a
withRetry (Action (HashMap FilePath Text) -> Action (HashMap FilePath Text))
-> Action (HashMap FilePath Text) -> Action (HashMap FilePath Text)
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 (FilePath -> Action Bool
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, Text)] -> HashMap FilePath Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(FilePath, Text)] -> HashMap FilePath Text)
-> Action [(FilePath, Text)] -> Action (HashMap FilePath Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Action (FilePath, Text)] -> Action [(FilePath, Text)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [(FilePath
f,) (Text -> (FilePath, Text))
-> Action Text -> Action (FilePath, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text -> Action Text
forall a. IO a -> Action a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
T.readFile (FilePath -> IO Text) -> FilePath -> IO Text
forall a b. (a -> b) -> a -> b
$ FilePath
out FilePath -> FilePath -> FilePath
</> FilePath
f) | FilePath
f <- NonEmpty FilePath -> [FilePath]
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 = ExtractSrcQ -> Action (HashMap FilePath Text)
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 (NonEmpty FilePath -> Action (HashMap FilePath Text))
-> NonEmpty FilePath -> Action (HashMap FilePath Text)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> NonEmpty FilePath
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [FilePath
fp]