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

-- | 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,
    extractSrc,
    extractSrcs,
  )
where

import Control.Monad (void)
import qualified Data.Aeson as A
import Data.Binary.Instances ()
import Data.HashMap.Strict (HashMap)
import qualified Data.List.NonEmpty as NE
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.Shake
import NeatInterpolation (trimming)
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, Partial) =>
(q -> Action a) -> Rules (q -> Action a)
addOracleCache ((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
$ \(ExtractSrcQ
q :: ExtractSrcQ) -> (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
pretty ExtractSrcQ
q
    let nixExpr :: FilePath
nixExpr = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Text
wrap (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ExtractSrcQ -> Text
forall a. ToNixExpr a => a -> Text
toNixExpr ExtractSrcQ
q
    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, Partial) =>
FilePath -> FilePath -> m ()
writeFile' FilePath
fp FilePath
nixExpr
    -- TODO: Avoid using NIX_PATH
    (CmdTime Double
t, StdoutTrim ByteString
out, CmdLine FilePath
c) <- Action (CmdTime, StdoutTrim ByteString, CmdLine)
-> Action (CmdTime, StdoutTrim ByteString, CmdLine)
forall a. Action a -> Action a
quietly (Action (CmdTime, StdoutTrim ByteString, CmdLine)
 -> Action (CmdTime, StdoutTrim ByteString, CmdLine))
-> Action (CmdTime, StdoutTrim ByteString, CmdLine)
-> Action (CmdTime, StdoutTrim ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$ (CmdOption
 -> FilePath -> Action (CmdTime, StdoutTrim ByteString, CmdLine))
:-> Action Any
forall args r. (Partial, CmdArguments args) => args
cmd CmdOption
Shell (FilePath -> Action (CmdTime, StdoutTrim ByteString, CmdLine))
-> FilePath -> Action (CmdTime, StdoutTrim ByteString, CmdLine)
forall a b. (a -> b) -> a -> b
$ FilePath
"nix-instantiate --eval --strict --json --read-write-mode -E 'let pkgs = import <nixpkgs> { }; in ((import " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
") pkgs)'"
    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"
    case ByteString -> Maybe (HashMap FilePath Text)
forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict ByteString
out of
      Just HashMap FilePath Text
x -> HashMap FilePath Text -> Action (HashMap FilePath Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap FilePath Text
x
      Maybe (HashMap FilePath Text)
_ -> FilePath -> Action (HashMap FilePath Text)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Action (HashMap FilePath Text))
-> FilePath -> Action (HashMap FilePath Text)
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to parse output of nix-instantiate: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (ByteString -> Text
T.decodeUtf8 ByteString
out)

-- | 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. [a] -> NonEmpty a
NE.fromList [FilePath
fp]

--------------------------------------------------------------------------------

wrap :: NixExpr -> NixExpr
wrap :: Text -> Text
wrap Text
expr =
  [trimming|
    { pkgs, ... }:
    $expr
  |]