<commit_before>
module Main (main) where

import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parse
import Distribution.Simple
import Distribution.Simple.Configure
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Simple.Utils (defaultPackageDesc, writeFileAtomic)
import Distribution.Simple.Build (writeAutogenFiles)
import Distribution.Simple.Register
import Distribution.Text
import Distribution.Verbosity
import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.Simple.PackageIndex as PackageIndex

import Data.List
import Data.Maybe
import System.IO
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import Data.Char

main :: IO ()
main = do args <- getArgs
          case args of
              "haddock" : distDir : dir : args' ->
                  runHaddock distDir dir args'
              "check" : dir : [] ->
                  doCheck dir
              "install" : ghc : ghcpkg : topdir : directory : distDir
                        : myDestDir : myPrefix : myLibdir : myDocdir : args' ->
                  doInstall ghc ghcpkg topdir directory distDir
                            myDestDir myPrefix myLibdir myDocdir args'
              "configure" : args' -> case break (== "--") args' of
                   (config_args, "--" : distdir : directories) ->
                       mapM_ (generate config_args distdir) directories
                   _ -> die syntax_error
              _ -> die syntax_error

syntax_error :: [String]
syntax_error =
    ["syntax: ghc-cabal configure <configure-args> -- <distdir> <directory>...",
     "        ghc-cabal install <ghc-pkg> <directory> <distdir> <destdir> <prefix> <args>...",
     "        ghc-cabal haddock <distdir> <directory> <args>..."]

die :: [String] -> IO ()
die errs = do mapM_ (hPutStrLn stderr) errs
              exitWith (ExitFailure 1)

-- XXX Should use bracket
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory directory io
 = do curDirectory <- getCurrentDirectory
      setCurrentDirectory directory
      r <- io
      setCurrentDirectory curDirectory
      return r

-- We need to use the autoconfUserHooks, as the packages that use
-- configure can create a .buildinfo file, and we need any info that
-- ends up in it.
userHooks :: UserHooks
userHooks = autoconfUserHooks

doCheck :: FilePath -> IO ()
doCheck directory
 = withCurrentDirectory directory
 $ do let verbosity = normal
      gpdFile <- defaultPackageDesc verbosity
      gpd <- readPackageDescription verbosity gpdFile
      case partition isFailure $ checkPackage gpd Nothing of
          ([],   [])       -> return ()
          ([],   warnings) -> mapM_ print warnings
          (errs, _)        -> do mapM_ print errs
                                 exitWith (ExitFailure 1)
    where isFailure (PackageDistSuspicious {}) = False
          isFailure _ = True

runHaddock :: FilePath -> FilePath -> [String] -> IO ()
runHaddock distdir directory args
 = withCurrentDirectory directory
 $ defaultMainWithHooksArgs hooks ("haddock" : "--builddir" : distdir : args)
    where
      hooks = userHooks {
                  haddockHook = modHook (haddockHook userHooks)
              }
      modHook f pd lbi us flags
       | packageName pd == PackageName "ghc-prim"
          = let pd' = case library pd of
                      Just lib ->
                          let ghcPrim = fromJust (simpleParse "GHC.Prim")
                              ems = filter (ghcPrim /=)
                                           (exposedModules lib)
                              lib' = lib { exposedModules = ems }
                          in pd { library = Just lib' }
                      Nothing ->
                          error "Expected a library, but none found"
                pc = withPrograms lbi
                pc' = userSpecifyArgs "haddock"
                          ["dist-install/build/autogen/GHC/Prim.hs"] pc
                lbi' = lbi { withPrograms = pc' }
            in f pd' lbi' us flags
       | otherwise
          = f pd lbi us flags

doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
          -> FilePath -> FilePath -> FilePath -> FilePath -> [String]
          -> IO ()
doInstall ghc ghcpkg topdir directory distDir myDestDir myPrefix myLibdir myDocdir args
 = withCurrentDirectory directory $ do
     defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir]
                                     ++ (if null myDestDir then []
                                           else ["--destdir", myDestDir])
                                     ++ args)
     defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args)
    where
      hooks = userHooks {
                  copyHook = noGhcPrimHook (modHook (copyHook userHooks)),
                  regHook  = modHook (regHook userHooks)
              }

      noGhcPrimHook f pd lbi us flags
              = let pd'
                     | packageName pd == PackageName "ghc-prim" =
                        case library pd of
                        Just lib ->
                            let ghcPrim = fromJust (simpleParse "GHC.Prim")
                                ems = filter (ghcPrim /=) (exposedModules lib)
                                lib' = lib { exposedModules = ems }
                            in pd { library = Just lib' }
                        Nothing ->
                            error "Expected a library, but none found"
                     | otherwise = pd
                in f pd' lbi us flags
      modHook f pd lbi us flags
              = let idts = installDirTemplates lbi
                    idts' = idts { prefix    = toPathTemplate myPrefix,
                                   libdir    = toPathTemplate myLibdir,
                                   libsubdir = toPathTemplate "$pkgid",
                                   docdir    = toPathTemplate (myDocdir </> "$pkg"),
                                   htmldir   = toPathTemplate "$docdir" }
                    progs = withPrograms lbi
                    ghcProg = ConfiguredProgram {
                                  programId = programName ghcProgram,
                                  programVersion = Nothing,
                                  programArgs = ["-B" ++ topdir],
                                  programLocation = UserSpecified ghc
                              }
                    ghcpkgconf = topdir </> "package.conf"
                    ghcPkgProg = ConfiguredProgram {
                                     programId = programName ghcPkgProgram,
                                     programVersion = Nothing,
                                     programArgs = ["--global-conf",
                                                    ghcpkgconf]
                                                   ++ if not (null myDestDir)
                                                      then ["--force"]
                                                      else [],
                                     programLocation = UserSpecified ghcpkg
                                 }
                    progs' = updateProgram ghcProg
                           $ updateProgram ghcPkgProg progs
                    lbi' = lbi {
                                   installDirTemplates = idts',
                                   withPrograms = progs'
                               }
                in f pd lbi' us flags

generate :: [String] -> FilePath -> FilePath -> IO ()
generate config_args distdir directory
 = withCurrentDirectory directory
 $ do let verbosity = normal
      gpdFile <- defaultPackageDesc verbosity
      gpd <- readPackageDescription verbosity gpdFile

      -- XXX We shouldn't just configure with the default flags
      -- XXX And this, and thus the "getPersistBuildConfig distdir" below,<commit_msg>Fix "make install" We need to change a dependency on     pkg-inplace to     pkg-$abihash when installing<commit_after>
module Main (main) where

import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Parse
import Distribution.Simple
import Distribution.Simple.Configure
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program
import Distribution.Simple.Program.HcPkg
import Distribution.Simple.Utils (defaultPackageDesc, writeFileAtomic)
import Distribution.Simple.Build (writeAutogenFiles)
import Distribution.Simple.Register
import Distribution.Text
import Distribution.Verbosity
import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.Simple.PackageIndex as PackageIndex

import Data.List
import Data.Maybe
import System.IO
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import Data.Char

main :: IO ()
main = do args <- getArgs
          case args of
              "haddock" : distDir : dir : args' ->
                  runHaddock distDir dir args'
              "check" : dir : [] ->
                  doCheck dir
              "install" : ghc : ghcpkg : topdir : directory : distDir
                        : myDestDir : myPrefix : myLibdir : myDocdir : args' ->
                  doInstall ghc ghcpkg topdir directory distDir
                            myDestDir myPrefix myLibdir myDocdir args'
              "configure" : args' -> case break (== "--") args' of
                   (config_args, "--" : distdir : directories) ->
                       mapM_ (generate config_args distdir) directories
                   _ -> die syntax_error
              _ -> die syntax_error

syntax_error :: [String]
syntax_error =
    ["syntax: ghc-cabal configure <configure-args> -- <distdir> <directory>...",
     "        ghc-cabal install <ghc-pkg> <directory> <distdir> <destdir> <prefix> <args>...",
     "        ghc-cabal haddock <distdir> <directory> <args>..."]

die :: [String] -> IO ()
die errs = do mapM_ (hPutStrLn stderr) errs
              exitWith (ExitFailure 1)

-- XXX Should use bracket
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory directory io
 = do curDirectory <- getCurrentDirectory
      setCurrentDirectory directory
      r <- io
      setCurrentDirectory curDirectory
      return r

-- We need to use the autoconfUserHooks, as the packages that use
-- configure can create a .buildinfo file, and we need any info that
-- ends up in it.
userHooks :: UserHooks
userHooks = autoconfUserHooks

doCheck :: FilePath -> IO ()
doCheck directory
 = withCurrentDirectory directory
 $ do let verbosity = normal
      gpdFile <- defaultPackageDesc verbosity
      gpd <- readPackageDescription verbosity gpdFile
      case partition isFailure $ checkPackage gpd Nothing of
          ([],   [])       -> return ()
          ([],   warnings) -> mapM_ print warnings
          (errs, _)        -> do mapM_ print errs
                                 exitWith (ExitFailure 1)
    where isFailure (PackageDistSuspicious {}) = False
          isFailure _ = True

runHaddock :: FilePath -> FilePath -> [String] -> IO ()
runHaddock distdir directory args
 = withCurrentDirectory directory
 $ defaultMainWithHooksArgs hooks ("haddock" : "--builddir" : distdir : args)
    where
      hooks = userHooks {
                  haddockHook = modHook (haddockHook userHooks)
              }
      modHook f pd lbi us flags
       | packageName pd == PackageName "ghc-prim"
          = let pd' = case library pd of
                      Just lib ->
                          let ghcPrim = fromJust (simpleParse "GHC.Prim")
                              ems = filter (ghcPrim /=)
                                           (exposedModules lib)
                              lib' = lib { exposedModules = ems }
                          in pd { library = Just lib' }
                      Nothing ->
                          error "Expected a library, but none found"
                pc = withPrograms lbi
                pc' = userSpecifyArgs "haddock"
                          ["dist-install/build/autogen/GHC/Prim.hs"] pc
                lbi' = lbi { withPrograms = pc' }
            in f pd' lbi' us flags
       | otherwise
          = f pd lbi us flags

doInstall :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath
          -> FilePath -> FilePath -> FilePath -> FilePath -> [String]
          -> IO ()
doInstall ghc ghcpkg topdir directory distDir myDestDir myPrefix myLibdir myDocdir args
 = withCurrentDirectory directory $ do
     defaultMainWithHooksArgs hooks (["copy", "--builddir", distDir]
                                     ++ (if null myDestDir then []
                                           else ["--destdir", myDestDir])
                                     ++ args)
     defaultMainWithHooksArgs hooks ("register" : "--builddir" : distDir : args)
    where
      hooks = userHooks {
                  copyHook = noGhcPrimHook (modHook (copyHook userHooks)),
                  regHook  = modHook (regHook userHooks)
              }

      noGhcPrimHook f pd lbi us flags
              = let pd'
                     | packageName pd == PackageName "ghc-prim" =
                        case library pd of
                        Just lib ->
                            let ghcPrim = fromJust (simpleParse "GHC.Prim")
                                ems = filter (ghcPrim /=) (exposedModules lib)
                                lib' = lib { exposedModules = ems }
                            in pd { library = Just lib' }
                        Nothing ->
                            error "Expected a library, but none found"
                     | otherwise = pd
                in f pd' lbi us flags
      modHook f pd lbi us flags
       = do let verbosity = normal
                idts = installDirTemplates lbi
                idts' = idts { prefix    = toPathTemplate myPrefix,
                               libdir    = toPathTemplate myLibdir,
                               libsubdir = toPathTemplate "$pkgid",
                               docdir    = toPathTemplate (myDocdir </> "$pkg"),
                               htmldir   = toPathTemplate "$docdir" }
                progs = withPrograms lbi
                ghcProg = ConfiguredProgram {
                              programId = programName ghcProgram,
                              programVersion = Nothing,
                              programArgs = ["-B" ++ topdir],
                              programLocation = UserSpecified ghc
                          }
                ghcpkgconf = topdir </> "package.conf"
                ghcPkgProg = ConfiguredProgram {
                                 programId = programName ghcPkgProgram,
                                 programVersion = Nothing,
                                 programArgs = ["--global-conf",
                                                ghcpkgconf]
                                               ++ if not (null myDestDir)
                                                  then ["--force"]
                                                  else [],
                                 programLocation = UserSpecified ghcpkg
                             }
                progs' = updateProgram ghcProg
                       $ updateProgram ghcPkgProg progs
            instInfos <- dump verbosity ghcPkgProg GlobalPackageDB
            let installedPkgs' = PackageIndex.listToInstalledPackageIndex
                                     instInfos
            let mlc = libraryConfig lbi
                mlc' = case mlc of
                       Just lc ->
                           let cipds = componentInstalledPackageDeps lc
                               cipds' = map (fixupPackageId instInfos) cipds
                           in Just $ lc {
                                         componentInstalledPackageDeps = cipds'
                                     }
                       Nothing -> Nothing
                lbi' = lbi {
                               libraryConfig = mlc',
                               installedPkgs = installedPkgs',
                               installDirTemplates = idts',
                               withPrograms = progs'
                           }
            f pd lbi' us flags

-- The packages are built with the package ID ending in "-inplace", but
-- when they're installed they get the package hash appended. We need to
-- fix up the package deps so that they use the hash package IDs, not
-- the inplace package IDs.
fixupPackageId :: [Installed.InstalledPackageInfo]
               -> InstalledPackageId
               -> InstalledPackageId
fixupPackageId _ x@(InstalledPackageId ipi)
 | "builtin:" `isPrefixOf` ipi = x
fixupPackageId ipinfos (InstalledPackageId ipi)
 = case stripPrefix (reverse "-inplace") $ reverse ipi of
   Nothing ->
       error ("Installed package ID doesn't end in -inplace: " ++ show ipi)
   Just x ->
       let ipi' = reverse ('-' : x)
           f (ipinfo : ipinfos') = case Installed.installedPackageId ipinfo of
                                   y@(InstalledPackageId ipinfoid)
                                    | ipi' `isPrefixOf` ipinfoid ->
                                       y
                                   _ ->
                                       f ipinfos'
           f [] = error ("Installed package ID not registered: " ++ show ipi)
       in f ipinfos

generate :: [String] -> FilePath -> FilePath -> IO ()
generate config_args distdir directory
 = withCurrentDirectory directory
 $ do let verbosity = normal
      gpdFile <- defaultPackageDesc verbosity
      gpd <- readPackageDescription verbosity gpdFile

      -- XXX We shouldn't just configure with the default flags
      -- XXX And this, and thus the "getPersistBuildConfig distdir" below,
{'fraction_non_alphanumeric': 0.07269727797635414, 'fraction_numerical': 0.00021996150673632113, 'mean_word_length': 1.4582319545823195, 'pattern_counts': {'":': 0, '<': 46, '<?xml version=': 0, '>': 107, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 63, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '789783', 'n_tokens_mistral': 4411, 'n_tokens_neox': 4260, 'n_words': 1344}