{-# LANGUAGE FlexibleContexts #-}

module Expression (
    -- * Expressions
    Expr, Predicate, Args, Ways,

    -- ** Construction and modification
    expr, exprIO, arg, remove, cabalFlag,

    -- ** Predicates
    (?), stage, stage0, stage1, stage2, notStage0, threadedBootstrapper,
     package, notPackage, packageOneOf, libraryPackage, builder, way, input,
     inputs, output, outputs,

    -- ** Evaluation
    interpret, interpretInContext,

    -- * Convenient accessors
    getBuildRoot, getContext, getOutputs, getInputs,
    getInput, getOutput, getContextData,

    -- * Re-exports
    module Base,
    module Builder,
    module Context,
    ) where

import Base
import Builder
import Context hiding (stage, package, way)
import Expression.Type
import Oracles.Flag
import Hadrian.Expression hiding (Expr, Predicate, Args)
import Hadrian.Haskell.Cabal.Type
import Hadrian.Oracles.Cabal

-- | Get values from a configured cabal stage.
getContextData :: (ContextData -> a) -> Expr a
getContextData key = do
    contextData <- expr . readContextData =<< getContext
    return $ key contextData

-- | Is the build currently in the provided stage?
stage :: Stage -> Predicate
stage s = (s ==) <$> getStage

-- | Is a particular package being built?
package :: Package -> Predicate
package p = (p ==) <$> getPackage

packageOneOf :: [Package] -> Predicate
packageOneOf ps = (`elem` ps) <$> getPackage

-- | This type class allows the user to construct both precise builder
-- predicates, such as @builder (Ghc CompileHs Stage1)@, as well as predicates
-- covering a set of similar builders. For example, @builder (Ghc CompileHs)@
-- matches any stage, and @builder Ghc@ matches any stage and any GHC mode.
class BuilderPredicate a where
    -- | Is a particular builder being used?
    builder :: a -> Predicate

instance BuilderPredicate Builder where
    builder b = (b ==) <$> getBuilder

instance BuilderPredicate a => BuilderPredicate (Stage -> a) where
    builder f = builder . f =<< getStage

instance BuilderPredicate a => BuilderPredicate (CcMode -> a) where
    builder f = do
        b <- getBuilder
        case b of
            Cc  c _ -> builder (f c)
            _       -> return False

instance BuilderPredicate a => BuilderPredicate (GhcMode -> a) where
    builder f = do
        b <- getBuilder
        case b of
            Ghc c _ -> builder (f c)
            _       -> return False

instance BuilderPredicate a => BuilderPredicate (FilePath -> a) where
    builder f = do
        b <- getBuilder
        case b of
            Configure path -> builder (f path)
            _              -> return False

-- | Is the current build 'Way' equal to a certain value?
way :: Way -> Predicate
way w = (w ==) <$> getWay

{-
Note [Stage Names]
~~~~~~~~~~~~~~~~~~

Code referring to specific stages can be a bit tricky. In Hadrian, the stages
have the same names they carried in the autoconf build system, but they are
often referred to by the stage used to construct them. For example, the stage 1
artifacts will be placed in _build/stage0, because they are constructed by the
stage 0 compiler. The stage predicates in this module behave the same way,
'stage0' will return 'True' while stage 0 is being used to build the stage 1
compiler.
-}

-- | Is the build currently in stage 0?
stage0 :: Predicate
stage0 = stage Stage0

-- | Is the build currently in stage 1?
stage1 :: Predicate
stage1 = stage Stage1

-- | Is the build currently in stage 2?
stage2 :: Predicate
stage2 = stage Stage2

-- | Is the build /not/ in stage 0 right now?
notStage0 :: Predicate
notStage0 = notM stage0

-- | Whether or not the bootstrapping compiler provides a threaded RTS. We need
--   to know this when building stage 1, since stage 1 links against the
--   compiler's RTS ways. See Note [Linking ghc-bin against threaded stage0 RTS]
--   in Settings.Packages for details.
threadedBootstrapper :: Predicate
threadedBootstrapper = expr (flag BootstrapThreadedRts)

-- | Is a certain package /not/ built right now?
notPackage :: Package -> Predicate
notPackage = notM . package

-- | Is a library package currently being built?
libraryPackage :: Predicate
libraryPackage = isLibrary <$> getPackage

-- | Either @-flagName@ or @flagName@, depending upon a predicate.
-- For use in @Cabal Flags@ argument lists.
cabalFlag :: ToPredicate p Context Builder => p -> String -> Args
cabalFlag pred flagName = do
    ifM (toPredicate pred) (arg flagName) (arg $ "-"<>flagName)

infixr 3 `cabalFlag`