module Rules.CabalReinstall where

import Context
import Expression
import Oracles.Flag
import Packages
import Settings
import Target
import Utilities
import qualified System.Directory.Extra as IO
import Data.Either
import Rules.BinaryDist
import Hadrian.Haskell.Cabal (pkgIdentifier)

{-
Note [Testing reinstallable GHC]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
To test the reinstallable GHC configuration, we install a GHC to <build root>/stage-cabal/bin
along with appropriate wrapper scripts.

The libdir of the reinstalled GHC points to the libdir of the stage 2 compiler (in <build root>/stage1)
-}


-- | We don't support reinstalling these
cabalExcludedPackages :: [Package]
cabalExcludedPackages = [array, base, deepseq, filepath, ghcBignum, ghcBootTh, ghcPrim, integerGmp, integerSimple, pretty, templateHaskell]

findCabalPackageDb :: String -> FilePath
findCabalPackageDb env = go $ map (\l -> (words l, l)) (lines env)
  where
    go [] = error $ "Couldn't find installed package db in " ++ show env
    go (("package-db":_, l):_) = drop 11 l
    go (_:xs) = go xs


cabalBuildRules :: Rules ()
cabalBuildRules = do
    root <- buildRootRules
    root -/- "stage-cabal" -/- "cabal-packages" %> \_ -> do
      -- Always rerun to pass onto cabal's own recompilation logic
      alwaysRerun
      all_pkgs <- stagePackages Stage1
      forM_ (filter (not . (`elem` cabalExcludedPackages)) all_pkgs) $ \pkg -> do
        withVerbosity Diagnostic $
          buildWithCmdOptions [] $
            target (vanillaContext Stage2 pkg) (Cabal Install Stage2) [] []

    phony "build-cabal" $ need [root -/- "stage-cabal" -/- "bin" -/- ".stamp"]

    root -/- "stage-cabal" -/- "bin" -/- "*" %> \_ -> need [root -/- "stage-cabal" -/- "bin" -/- ".stamp"]

    priority 2.0 $ root -/- "stage-cabal" -/- "bin" -/- ".stamp" %> \stamp -> do
        -- We 'need' all binaries and libraries
        all_pkgs <- stagePackages Stage1
        (lib_targets, bin_targets) <- partitionEithers <$> mapM pkgTarget all_pkgs
        cross <- flag CrossCompiling
        iserv_targets <- if cross then pure [] else iservBins
        need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets)))

        distDir        <- Context.distDir Stage1
        rtsDir         <- pkgIdentifier rts

        let ghcBuildDir      = root -/- stageString Stage1
            rtsIncludeDir    = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir
                               -/- "include"

        libdir  <- liftIO . IO.makeAbsolute =<< stageLibPath Stage1
        work_dir <- liftIO $ IO.makeAbsolute $ root -/- "stage-cabal"
        let outputDir = work_dir -/- "bin"
        includeDir <- liftIO $ IO.makeAbsolute rtsIncludeDir

        createDirectory outputDir

        need [root -/- "stage-cabal" -/- "cabal-packages"]
        env <- liftIO $ readFile $ root -/- "stage-cabal" -/- "cabal-packages"
        let cabal_package_db = findCabalPackageDb env

        forM_ (filter ((/= iserv) . fst) bin_targets) $ \(bin_pkg,_bin_path) -> do
            let pgmName pkg
                  | pkg == ghc    = "ghc"
                  | pkg == hpcBin = "hpc"
                  | otherwise     = pkgName pkg
            let cabal_bin_out = work_dir -/- "cabal-bin" -/- (pgmName bin_pkg)
            needed_wrappers <- pkgToWrappers bin_pkg
            forM_ needed_wrappers $ \wrapper_name -> do
              let wrapper_prefix = unlines
                    ["#!/usr/bin/env sh"
                    ,"executablename="++show cabal_bin_out
                    ,"libdir="++show libdir
                    ,"bindir="++show outputDir
                    ,"exedir="++show outputDir
                    ,"includedir="++show includeDir
                    ,"export GHC_PACKAGE_PATH="++show cabal_package_db++":"
                    ]
                  output_file = outputDir -/- wrapper_name
              wrapper_content <- wrapper wrapper_name
              writeFile' output_file (wrapper_prefix ++ wrapper_content)
              makeExecutable output_file
              pure ()

        -- Just symlink these for now
        -- TODO: build these with cabal as well
        forM_ iserv_targets $ \(_bin_pkg,bin_path') -> do
            bin_path <- liftIO $ IO.makeAbsolute bin_path'
            let orig_filename = takeFileName bin_path
                output_file = outputDir -/- orig_filename
            liftIO $ do
              IO.removeFile output_file <|> pure ()
              IO.createFileLink bin_path output_file
            pure ()
        writeFile' stamp "OK"