module Context (
    -- * Context
    Context (..), vanillaContext, stageContext,

    -- * Expressions
    getStage, getPackage, getWay, getBuildPath, 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)
