content: module Context (
      -- * Context
      Context (..), vanillaContext, stageContext,
  
      -- * Expressions
      getStage, getPackage, getWay, getBuildPath, getHieBuildPath, getPackageDbLoc, getStagedTarget,
  
      -- * Paths
      contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgSetupConfigDir,
      pkgHaddockFile, pkgRegisteredLibraryFile, pkgRegisteredLibraryFileName,
      pkgLibraryFile, pkgGhciLibraryFile,
      pkgConfFile, pkgStampFile, resourcePath, objectPath, contextPath, getContextPath, libPath, distDir,
      distDynDir,
      haddockStatsFilesDir, ensureConfigured, autogenPath, rtsContext, rtsBuildPath, libffiBuildPath
      ) where
  
  import Base
  import Context.Path
  import Context.Type
  import Hadrian.Expression
  import Hadrian.Haskell.Cabal
  import Oracles.Setting
  import Hadrian.Oracles.Cabal
  import GHC.Toolchain.Target (Target(..))
  import Packages
  import Hadrian.Haskell.Cabal.Type
  
  -- | Get the 'Stage' of the current 'Context'.
  getStage :: Expr Context b Stage
  getStage = stage <$> getContext
  
  getInplace :: Expr Context b Inplace
  getInplace = iplace <$> getContext
  
  getPackageDbLoc :: Expr Context b PackageDbLoc
  getPackageDbLoc = PackageDbLoc <$> getStage <*> getInplace
  
  -- | Get the 'Package' of the current 'Context'.
  getPackage :: Expr Context b Package
  getPackage = package <$> getContext
  
  -- | Get the 'Way' of the current 'Context'.
  getWay :: Expr Context b Way
  getWay = way <$> getContext
  
  -- | Get the 'Target' configuration of the current stage
  getStagedTarget :: Expr Context b Target
  getStagedTarget = expr . targetStage =<< getStage
  
  -- | Path to the directory containing the final artifact in a given 'Context'.
  libPath :: Context -> Action FilePath
  libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib"))
  
  -- | Get the directory name for binary distribution files
  distDir :: Context -> Action FilePath
  distDir c = do
      cd <- readContextData c
      return (contextLibdir cd)
  
  distDynDir :: Context -> Action FilePath
  distDynDir c = do
      cd <- readContextData c
      return (contextDynLibdir cd)
  
  -- | Make sure a given context has already been fully configured. The
  -- implementation simply calls 'need' on the context's @autogen/cabal_macros.h@
  -- file, which triggers 'configurePackage' and 'buildAutogenFiles'. Why this
  -- indirection? Going via @autogen/cabal_macros.h@ allows us to cache the
  -- configuration steps, i.e. not to repeat them if they have already been done.
  ensureConfigured :: Context -> Action ()
  ensureConfigured context = do
      autogen <- autogenPath context
      need [autogen -/- "cabal_macros.h"]
  
  -- TODO: Combine this with 'programName'.
  -- | Path to the @autogen@ directory generated by 'buildAutogenFiles'.
  autogenPath :: Context -> Action FilePath
  autogenPath context@Context {..}
      | isLibrary package = autogen "build"
      | package == ghc    = autogen "build/ghc"
      | package == hpcBin = autogen "build/hpc"
      | package == ghciWrapper = autogen "build/ghci"
                                 -- See Note [Hadrian's ghci-wrapper package]
      | otherwise         = autogen $ "build" -/- pkgName package
    where
      autogen dir = contextPath context <&> (-/- dir -/- "autogen")
  
  -- | RTS is considered a Stage1 package. This determines RTS build directory.
  rtsContext :: Stage -> Context
  rtsContext stage = vanillaContext stage rts
  
  -- | Path to the RTS build directory.
  rtsBuildPath :: Stage -> Action FilePath
  rtsBuildPath stage = buildPath (rtsContext stage)
  
  -- | Build directory for in-tree 'libffi' library.
  libffiBuildPath :: Stage -> Action FilePath
  libffiBuildPath stage = buildPath $ Context
      stage
      libffi
      (error "libffiBuildPath: way not set.")
      (error "libffiBuildPath: inplace not set.")
  
  pkgFileName :: Context -> Package -> String -> String -> Action FilePath
  pkgFileName context package prefix suffix = do
      pid  <- pkgUnitId (stage context) package
      return $ prefix ++ pid ++ suffix
  
  pkgFile :: Context -> String -> String -> Action FilePath
  pkgFile context@Context {..} prefix suffix = do
      path <- buildPath context
      fileName <- pkgFileName context package prefix suffix
      return $ path -/- fileName
  
  -- | Path to inplace package configuration file of a given 'Context'.
  pkgInplaceConfig :: Context -> Action FilePath
  pkgInplaceConfig context = contextPath context <&> (-/- "inplace-pkg-config")
  
  pkgSetupConfigDir :: Context -> Action FilePath
  pkgSetupConfigDir context = contextPath context
  
  -- | Path to the @setup-config@ of a given 'Context'.
  pkgSetupConfigFile :: Context -> Action FilePath
  pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config")
  
  -- | Path to the haddock file of a given 'Context', e.g.:
  -- @_build/stage1/libraries/array/doc/html/array/array.haddock@.
  pkgHaddockFile :: Context -> Action FilePath
  pkgHaddockFile Context {..} = do
      root <- buildRoot
      version <- pkgUnitId stage package
      return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock"
  
  -- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:
  -- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@
  -- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@
  pkgRegisteredLibraryFile :: Context -> Action FilePath
  pkgRegisteredLibraryFile context = do
      fileName  <- pkgRegisteredLibraryFileName context
      if Dynamic `wayUnit` (way context)
          then (-/-) <$> distDynDir context <*> pure fileName
          else (-/-) <$> distDir context <*> pure fileName
  
  -- | Just the final filename portion of pkgRegisteredLibraryFile
  pkgRegisteredLibraryFileName :: Context -> Action FilePath
  pkgRegisteredLibraryFileName context@Context{..} = do
      extension <- libsuf stage way
      pkgFileName context package "libHS" extension
  
  
  -- | Path to the library file of a given 'Context', e.g.:
  -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a@.
  pkgLibraryFile :: Context -> Action FilePath
  pkgLibraryFile context@Context {..} = do
      extension <- libsuf stage way
      pkgFile context "libHS" extension
  
  -- | Path to the GHCi library file of a given 'Context', e.g.:
  -- @_build/stage1/libraries/array/build/HSarray-0.5.1.0.o@.
  pkgGhciLibraryFile :: Context -> Action FilePath
  pkgGhciLibraryFile context@Context {..} = do
      let extension = "" <.> osuf way
      pkgFile context "HS" extension
  
  -- | Path to the configuration file of a given 'Context'.
  pkgConfFile :: Context -> Action FilePath
  pkgConfFile Context {..} = do
      pid  <- pkgUnitId stage package
      dbPath <- packageDbPath (PackageDbLoc stage iplace)
      return $ dbPath -/- pid <.> "conf"
  
  -- | Path to the stamp file for a given 'Context'. The stamp file records if
  -- we have built all the objects necessary for a certain way or not.
  pkgStampFile :: Context -> Action FilePath
  pkgStampFile c@Context{..} = do
      let extension = waySuffix way
      pkgFile c "stamp-" extension
  
  
  -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
  -- to its object file. For example:
  -- * "Task.c"                              -> "_build/stage1/rts/Task.thr_o"
  -- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
  objectPath :: Context -> FilePath -> Action FilePath
  objectPath context@Context {..} src = do
      isGenerated <- isGeneratedSource src
      path        <- buildPath context
      let extension = drop 1 $ takeExtension src
          obj       = src -<.> osuf way
          result | isGenerated          = obj
                 | "*hs*" ?== extension = path -/- obj
                 | otherwise            = path -/- extension -/- obj
      return result
  
  
  resourcePath :: Context -> FilePath -> Action FilePath
  resourcePath context src = do
      path <- buildPath context
      let extension = drop 1 $ takeExtension src
      return (path -/- extension -/- src)
  