{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Nix
  ( assertNewerVersion,
    assertOldVersionOn,
    binPath,
    build,
    getAttr,
    getChangelog,
    getDerivationFile,
    getDescription,
    getDrvAttr,
    getHash,
    getHashFromBuild,
    getHomepage,
    getHomepageET,
    getIsBroken,
    getMaintainers,
    getOldHash,
    getOutpaths,
    getPatches,
    getSrcUrl,
    getSrcUrls,
    hasPatchNamed,
    hasUpdateScript,
    lookupAttrPath,
    nixEvalET,
    numberOfFetchers,
    numberOfHashes,
    parseStringList,
    resultLink,
    runUpdateScript,
    sha256Zero,
    version,
    Raw (..),
  )
where

import Data.Maybe (fromJust)
import qualified Data.Text as T
import qualified Data.Vector as V
import Language.Haskell.TH.Env (envQ)
import OurPrelude
import qualified Polysemy.Error as Error
import qualified System.Process.Typed as TP
import qualified Process
import qualified Process as P
import System.Exit
import Text.Parsec (parse)
import Text.Parser.Combinators
import Text.Parser.Token
import Utils (UpdateEnv (..), nixBuildOptions, nixCommonOptions, srcOrMain)
import Prelude hiding (log)

binPath :: String
binPath = fromJust ($$(envQ "NIX") :: Maybe String) <> "/bin"

data Env = Env [(String, String)]

data Raw
  = Raw
  | NoRaw

data EvalOptions = EvalOptions Raw Env

rawOpt :: Raw -> [String]
rawOpt Raw = ["--raw"]
rawOpt NoRaw = []

nixEvalSem ::
  Members '[P.Process, Error Text] r =>
  EvalOptions ->
  Text ->
  Sem r (Text, Text)
nixEvalSem (EvalOptions raw (Env env)) expr =
  (\(stdout, stderr) -> (T.strip stdout, T.strip stderr))
    <$> ourReadProcess_Sem
      (setEnv env (proc (binPath <> "/nix") (["eval", "-f", "."] <> rawOpt raw <> [T.unpack expr])))

nixEvalET :: MonadIO m => EvalOptions -> Text -> ExceptT Text m Text
nixEvalET (EvalOptions raw (Env env)) expr =
  ourReadProcess_
    (setEnv env (proc (binPath <> "/nix") (["eval", "-f", "."] <> rawOpt raw <> [T.unpack expr])))
    & fmapRT (fst >>> T.strip)

-- Error if the "new version" is actually newer according to nix
assertNewerVersion :: MonadIO m => UpdateEnv -> ExceptT Text m ()
assertNewerVersion updateEnv = do
  versionComparison <-
    nixEvalET
      (EvalOptions NoRaw (Env []))
      ( "(builtins.compareVersions \""
          <> newVersion updateEnv
          <> "\" \""
          <> oldVersion updateEnv
          <> "\")"
      )
  case versionComparison of
    "1" -> return ()
    a ->
      throwE
        ( newVersion updateEnv
            <> " is not newer than "
            <> oldVersion updateEnv
            <> " according to Nix; versionComparison: "
            <> a
            <> " "
        )

-- This is extremely slow but gives us the best results we know of
lookupAttrPath :: MonadIO m => UpdateEnv -> ExceptT Text m Text
lookupAttrPath updateEnv =
  proc
    (binPath <> "/nix-env")
    ( [ "-qa",
        (packageName updateEnv <> "-" <> oldVersion updateEnv) & T.unpack,
        "-f",
        ".",
        "--attr-path"
      ]
        <> nixCommonOptions
    )
    & ourReadProcess_
    & fmapRT (fst >>> T.lines >>> head >>> T.words >>> head)

getDerivationFile :: MonadIO m => Text -> ExceptT Text m FilePath
getDerivationFile attrPath =
  proc "env" ["EDITOR=echo", (binPath <> "/nix"), "edit", attrPath & T.unpack, "-f", "."]
    & ourReadProcess_
    & fmapRT (fst >>> T.strip >>> T.unpack)

getDrvAttr :: MonadIO m => Text -> Text -> ExceptT Text m Text
getDrvAttr drvAttr =
  srcOrMain
    (\attrPath -> nixEvalET (EvalOptions Raw (Env [])) ("pkgs." <> attrPath <> ".drvAttrs." <> drvAttr))

-- Get an attribute that can be evaluated off a derivation, as in:
-- getAttr "cargoSha256" "ripgrep" -> 0lwz661rbm7kwkd6mallxym1pz8ynda5f03ynjfd16vrazy2dj21
getAttr :: MonadIO m => Raw -> Text -> Text -> ExceptT Text m Text
getAttr raw attr =
  srcOrMain
    (\attrPath -> nixEvalET (EvalOptions raw (Env [])) (attrPath <> "." <> attr))

getHash :: MonadIO m => Text -> ExceptT Text m Text
getHash =
  srcOrMain
    (\attrPath -> nixEvalET (EvalOptions Raw (Env [])) ("pkgs." <> attrPath <> ".drvAttrs.outputHash"))

getOldHash :: MonadIO m => Text -> ExceptT Text m Text
getOldHash attrPath =
  getHash attrPath

getMaintainers :: MonadIO m => Text -> ExceptT Text m Text
getMaintainers attrPath =
  nixEvalET
    (EvalOptions Raw (Env []))
    ( "(let pkgs = import ./. {}; gh = m : m.github or \"\"; nonempty = s: s != \"\"; addAt = s: \"@\"+s; in builtins.concatStringsSep \" \" (map addAt (builtins.filter nonempty (map gh pkgs."
        <> attrPath
        <> ".meta.maintainers or []))))"
    )

parseStringList :: MonadIO m => Text -> ExceptT Text m (Vector Text)
parseStringList list =
  parse nixStringList ("nix list " ++ T.unpack list) list & fmapL tshow
    & hoistEither

nixStringList :: TokenParsing m => m (Vector Text)
nixStringList = V.fromList <$> brackets (many stringLiteral)

getOutpaths :: MonadIO m => Text -> ExceptT Text m (Vector Text)
getOutpaths attrPath = do
  list <- nixEvalET (EvalOptions NoRaw (Env [("GC_INITIAL_HEAP_SIZE", "10g")])) (attrPath <> ".outputs")
  outputs <- parseStringList list
  V.sequence $ fmap (\o -> nixEvalET (EvalOptions Raw (Env [])) (attrPath <> "." <> o)) outputs

readNixBool :: MonadIO m => ExceptT Text m Text -> ExceptT Text m Bool
readNixBool t = do
  text <- t
  case text of
    "true" -> return True
    "false" -> return False
    a -> throwE ("Failed to read expected nix boolean " <> a <> " ")

getIsBroken :: MonadIO m => Text -> ExceptT Text m Bool
getIsBroken attrPath =
  nixEvalET
    (EvalOptions NoRaw (Env []))
    ( "(let pkgs = import ./. {}; in pkgs."
        <> attrPath
        <> ".meta.broken or false)"
    )
    & readNixBool

getChangelog :: MonadIO m => Text -> ExceptT Text m Text
getChangelog attrPath =
  nixEvalET
    (EvalOptions NoRaw (Env []))
    ( "(let pkgs = import ./. {}; in pkgs."
        <> attrPath
        <> ".meta.changelog or \"\")"
    )

getDescription :: MonadIO m => Text -> ExceptT Text m Text
getDescription attrPath =
  nixEvalET
    (EvalOptions NoRaw (Env []))
    ( "(let pkgs = import ./. {}; in pkgs."
        <> attrPath
        <> ".meta.description or \"\")"
    )

getHomepage ::
  Members '[P.Process, Error Text] r =>
  Text ->
  Sem r Text
getHomepage attrPath =
  fst <$> nixEvalSem
    (EvalOptions NoRaw (Env []))
    ( "(let pkgs = import ./. {}; in pkgs."
        <> attrPath
        <> ".meta.homepage or \"\")"
    )

getHomepageET :: MonadIO m => Text -> ExceptT Text m Text
getHomepageET attrPath =
  ExceptT
    . liftIO
    . runFinal
    . embedToFinal
    . Error.runError
    . Process.runIO
    $ getHomepage attrPath

getSrcUrl :: MonadIO m => Text -> ExceptT Text m Text
getSrcUrl =
  srcOrMain
    ( \attrPath ->
        nixEvalET
          (EvalOptions Raw (Env []))
          ( "(let pkgs = import ./. {}; in builtins.elemAt pkgs."
              <> attrPath
              <> ".drvAttrs.urls 0)"
          )
    )

getSrcAttr :: MonadIO m => Text -> Text -> ExceptT Text m Text
getSrcAttr attr =
  srcOrMain (\attrPath -> nixEvalET (EvalOptions NoRaw (Env [])) ("pkgs." <> attrPath <> "." <> attr))

getSrcUrls :: MonadIO m => Text -> ExceptT Text m Text
getSrcUrls = getSrcAttr "urls"

buildCmd :: Text -> ProcessConfig () () ()
buildCmd attrPath =
  silently $ proc (binPath <> "/nix-build") (nixBuildOptions ++ ["-A", attrPath & T.unpack])

log :: Text -> ProcessConfig () () ()
log attrPath = proc (binPath <> "/nix") ["log", "-f", ".", attrPath & T.unpack]

build :: MonadIO m => Text -> ExceptT Text m ()
build attrPath =
  (buildCmd attrPath & runProcess_ & tryIOTextET)
    <|> ( do
            _ <- buildFailedLog
            throwE "nix log failed trying to get build logs "
        )
  where
    buildFailedLog = do
      buildLog <-
        ourReadProcessInterleaved_ (log attrPath)
          & fmap (T.lines >>> reverse >>> take 30 >>> reverse >>> T.unlines)
      throwE ("nix build failed.\n" <> buildLog <> " ")

numberOfFetchers :: Text -> Int
numberOfFetchers derivationContents =
  countUp "fetchurl {" + countUp "fetchgit {" + countUp "fetchFromGitHub {"
  where
    countUp x = T.count x derivationContents

-- Sum the number of things that look like fixed-output derivation hashes
numberOfHashes :: Text -> Int
numberOfHashes derivationContents =
  sum $ map countUp ["sha256 =", "sha256=", "cargoSha256 =", "vendorSha256 ="]
  where
    countUp x = T.count x derivationContents

assertOldVersionOn ::
  MonadIO m => UpdateEnv -> Text -> Text -> ExceptT Text m ()
assertOldVersionOn updateEnv branchName contents =
  tryAssert
    ("Old version " <> oldVersionPattern <> " not present in " <> branchName <> " derivation file with contents: " <> contents)
    (oldVersionPattern `T.isInfixOf` contents)
  where
    oldVersionPattern = oldVersion updateEnv <> "\""

resultLink :: MonadIO m => ExceptT Text m Text
resultLink =
  T.strip
    <$> ( ourReadProcessInterleaved_ "readlink ./result"
            <|> ourReadProcessInterleaved_ "readlink ./result-bin"
        )
    <|> throwE "Could not find result link. "

sha256Zero :: Text
sha256Zero = "0000000000000000000000000000000000000000000000000000"

-- fixed-output derivation produced path '/nix/store/fg2hz90z5bc773gpsx4gfxn3l6fl66nw-source' with sha256 hash '0q1lsgc1621czrg49nmabq6am9sgxa9syxrwzlksqqr4dyzw4nmf' instead of the expected hash '0bp22mzkjy48gncj5vm9b7whzrggcbs5pd4cnb6k8jpl9j02dhdv'
getHashFromBuild :: MonadIO m => Text -> ExceptT Text m Text
getHashFromBuild =
  srcOrMain
    ( \attrPath -> do
        (exitCode, _, stderr) <- buildCmd attrPath & readProcess
        when (exitCode == ExitSuccess) $ throwE "build succeeded unexpectedly"
        let stdErrText = bytestringToText stderr
        let firstSplit = T.splitOn "got:    " stdErrText
        firstSplitSecondPart <-
          tryAt
            ("stderr did not split as expected full stderr was: \n" <> stdErrText)
            firstSplit
            1
        let secondSplit = T.splitOn "\n" firstSplitSecondPart
        tryHead
          ( "stderr did not split second part as expected full stderr was: \n"
              <> stdErrText
              <> "\nfirstSplitSecondPart:\n"
              <> firstSplitSecondPart
          )
          secondSplit
    )

version :: MonadIO m => ExceptT Text m Text
version = ourReadProcessInterleaved_ (proc (binPath <> "/nix") ["--version"])

getPatches :: MonadIO m => Text -> ExceptT Text m Text
getPatches attrPath =
  nixEvalET
    (EvalOptions NoRaw (Env []))
    ( "(let pkgs = import ./. {}; in (map (p: p.name) pkgs."
        <> attrPath
        <> ".patches))"
    )

hasPatchNamed :: MonadIO m => Text -> Text -> ExceptT Text m Bool
hasPatchNamed attrPath name = do
  ps <- getPatches attrPath
  return $ name `T.isInfixOf` ps

hasUpdateScript :: MonadIO m => Text -> ExceptT Text m Bool
hasUpdateScript attrPath = do
  result <-
    nixEvalET
      (EvalOptions NoRaw (Env []))
      ( "(let pkgs = import ./. {}; in builtins.hasAttr \"updateScript\" pkgs."
          <> attrPath
          <> ")"
      )
  case result of
    "true" -> return True
    _ -> return False

runUpdateScript :: MonadIO m => Text -> ExceptT Text m (ExitCode, Text)
runUpdateScript attrPath = do
  ourReadProcessInterleaved $
    TP.setStdin (TP.byteStringInput "\n") $
    proc "nix-shell" ["maintainers/scripts/update.nix", "--argstr", "package", T.unpack attrPath]