Commit 92ef7772 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Refactoring: Target is now defined in Target.hs, old Targets.hs is dropped.

parent 5db0017b
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-} {-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-}
module Expression ( module Expression (
module Control.Monad.Reader, module Target,
module Data.Monoid, module Data.Monoid,
module Control.Monad.Reader,
Expr, DiffExpr, fromDiffExpr, Expr, DiffExpr, fromDiffExpr,
Predicate, Predicate, Settings, Ways, Packages,
Settings, Ways, Packages,
Target (..), stageTarget, stagePackageTarget,
append, appendM, remove, appendSub, appendSubD, filterSub, removeSub, append, appendM, remove, appendSub, appendSubD, filterSub, removeSub,
interpret, interpretExpr, interpret, interpretExpr,
applyPredicate, (?), (??), stage, package, builder, file, way, applyPredicate, (?), (??), stage, package, builder, file, way,
...@@ -15,58 +13,12 @@ module Expression ( ...@@ -15,58 +13,12 @@ module Expression (
import Base hiding (arg, args, Args, TargetDir) import Base hiding (arg, args, Args, TargetDir)
import Ways import Ways
import Target
import Oracles import Oracles
import Package import Package
import Data.Monoid import Data.Monoid
import Development.Shake.Classes
import GHC.Generics
import Control.Monad.Reader import Control.Monad.Reader
-- Target captures parameters relevant to the current build target: Stage and
-- Package being built, Builder that is to be invoked, file(s) that are to
-- be built and the Way they are to be built.
data Target = Target
{
getStage :: Stage,
getPackage :: Package,
getBuilder :: Builder,
getFile :: FilePath, -- TODO: handle multple files?
getWay :: Way
}
deriving (Eq, Generic)
-- Shows a target as "package:file@stage (builder, way)"
instance Show Target where
show target = show (getPackage target)
++ ":" ++ show (getFile target)
++ "@" ++ show (getStage target)
++ " (" ++ show (getBuilder target)
++ ", " ++ show (getWay target) ++ ")"
instance Binary Target
instance NFData Target
instance Hashable Target
stageTarget :: Stage -> Target
stageTarget stage = Target
{
getStage = stage,
getPackage = error "stageTarget: Package not set",
getBuilder = error "stageTarget: Builder not set",
getFile = error "stageTarget: File not set",
getWay = error "stageTarget: Way not set"
}
stagePackageTarget :: Stage -> Package -> Target
stagePackageTarget stage package = Target
{
getStage = stage,
getPackage = package,
getBuilder = error "stagePackageTarget: Builder not set",
getFile = error "stagePackageTarget: File not set",
getWay = error "stagePackageTarget: Way not set"
}
-- Expr a is a computation that produces a value of type Action a and can read -- Expr a is a computation that produces a value of type Action a and can read
-- parameters of the current build Target. -- parameters of the current build Target.
type Expr a = ReaderT Target Action a type Expr a = ReaderT Target Action a
......
...@@ -5,7 +5,7 @@ module Settings ( ...@@ -5,7 +5,7 @@ module Settings (
import Base hiding (arg, args) import Base hiding (arg, args)
import Settings.GhcPkg import Settings.GhcPkg
import Settings.GhcCabal import Settings.GhcCabal
import UserSettings import Settings.User
import Expression hiding (when, liftIO) import Expression hiding (when, liftIO)
settings :: Settings settings :: Settings
......
module Targets ( module Settings.Default (
defaultTargetDirectory, defaultTargetDirectory, defaultKnownPackages,
array, base, binPackageDb, binary, bytestring, cabal, compiler, containers, array, base, binPackageDb, binary, bytestring, cabal, compiler, containers,
deepseq, directory, filepath, ghcPrim, haskeline, hoopl, hpc, deepseq, directory, filepath, ghcPrim, haskeline, hoopl, hpc, integerGmp,
integerGmp, integerGmp2, integerSimple, integerGmp2, integerSimple, parallel, pretty, primitive, process, stm,
parallel, pretty, primitive, process, stm, templateHaskell, templateHaskell, terminfo, time, transformers, unix, win32, xhtml
terminfo, time, transformers, unix, win32, xhtml
) where ) where
import Base hiding (arg, args) import Base
import Package import Package
-- Build results will be placed into a target directory with the following -- Build results will be placed into a target directory with the following
...@@ -21,6 +21,19 @@ defaultTargetDirectory stage package ...@@ -21,6 +21,19 @@ defaultTargetDirectory stage package
| stage == Stage0 = "dist-boot" | stage == Stage0 = "dist-boot"
| otherwise = "dist-install" | otherwise = "dist-install"
-- These are all packages we know about. Build rules will be generated for
-- all of them. However, not all of these packages will be built. For example,
-- package 'win32' is built only on Windows.
-- Settings/Packages.hs defines default conditions for building each package,
-- which can be overridden in UserSettings.hs.
defaultKnownPackages :: [Package]
defaultKnownPackages =
[ array, base, binPackageDb, binary, bytestring, cabal, compiler
, containers, deepseq, directory, filepath, ghcPrim, haskeline
, hoopl, hpc, integerGmp, integerGmp2, integerSimple, parallel
, pretty, primitive, process, stm, templateHaskell, terminfo, time
, transformers, unix, win32, xhtml ]
-- Package definitions -- Package definitions
array = library "array" array = library "array"
base = library "base" base = library "base"
......
...@@ -8,14 +8,13 @@ import Oracles.Builder ...@@ -8,14 +8,13 @@ import Oracles.Builder
import Ways import Ways
import Util import Util
import Package import Package
import Targets
import Switches import Switches
import Expression hiding (liftIO) import Expression hiding (liftIO)
import Settings.User
import Settings.Ways import Settings.Ways
import Settings.Util import Settings.Util
import Settings.Packages import Settings.Packages
import Settings.TargetDirectory import Settings.TargetDirectory
import UserSettings
cabalSettings :: Settings cabalSettings :: Settings
cabalSettings = builder GhcCabal ? do cabalSettings = builder GhcCabal ? do
......
...@@ -4,10 +4,9 @@ module Settings.Packages ( ...@@ -4,10 +4,9 @@ module Settings.Packages (
import Base import Base
import Package import Package
import Targets
import Switches import Switches
import Expression import Expression
import UserSettings import Settings.User
-- Combining default list of packages with user modifications -- Combining default list of packages with user modifications
packages :: Packages packages :: Packages
...@@ -33,17 +32,5 @@ packagesStage1 = mconcat ...@@ -33,17 +32,5 @@ packagesStage1 = mconcat
, notWindowsHost ? append [unix] , notWindowsHost ? append [unix]
, buildHaddock ? append [xhtml] ] , buildHaddock ? append [xhtml] ]
-- These are all packages we know about. Build rules will be generated for
-- all of them. However, not all of these packages will be built. For example,
-- package 'win32' is built only on Windows.
-- Settings/Packages.hs defines default conditions for building each package,
-- which can be overridden in UserSettings.hs.
knownPackages :: [Package] knownPackages :: [Package]
knownPackages = defaultKnownPackages ++ userKnownPackages knownPackages = defaultKnownPackages ++ userKnownPackages
defaultKnownPackages :: [Package]
defaultKnownPackages =
[ array, base, binPackageDb, binary, bytestring, cabal, compiler
, containers, deepseq, directory, filepath, ghcPrim, haskeline
, hoopl, hpc, integerLibrary, parallel, pretty, primitive, process
, stm, templateHaskell, terminfo, time, transformers, unix, win32, xhtml ]
...@@ -4,7 +4,7 @@ module Settings.TargetDirectory ( ...@@ -4,7 +4,7 @@ module Settings.TargetDirectory (
import Base import Base
import Package import Package
import UserSettings import Settings.User
-- User can override the default target directory settings given below -- User can override the default target directory settings given below
targetDirectory :: Stage -> Package -> FilePath targetDirectory :: Stage -> Package -> FilePath
......
module UserSettings ( module Settings.User (
module Settings.Default,
userSettings, userPackages, userWays, userTargetDirectory, userSettings, userPackages, userWays, userTargetDirectory,
userKnownPackages, integerLibrary, userKnownPackages, integerLibrary,
buildHaddock, validating buildHaddock, validating
...@@ -6,7 +7,7 @@ module UserSettings ( ...@@ -6,7 +7,7 @@ module UserSettings (
import Base hiding (arg, args, Args) import Base hiding (arg, args, Args)
import Package import Package
import Targets import Settings.Default
import Expression import Expression
-- No user-specific settings by default -- No user-specific settings by default
...@@ -26,7 +27,7 @@ userKnownPackages = [] ...@@ -26,7 +27,7 @@ userKnownPackages = []
userWays :: Ways userWays :: Ways
userWays = mempty userWays = mempty
-- Control where build results go -- Control where build results go (see Settings.Default for an example)
userTargetDirectory :: Stage -> Package -> FilePath userTargetDirectory :: Stage -> Package -> FilePath
userTargetDirectory = defaultTargetDirectory userTargetDirectory = defaultTargetDirectory
......
...@@ -6,7 +6,7 @@ import Base ...@@ -6,7 +6,7 @@ import Base
import Ways hiding (defaultWays) import Ways hiding (defaultWays)
import Switches import Switches
import Expression import Expression
import UserSettings import Settings.User
-- Combining default ways with user modifications -- Combining default ways with user modifications
ways :: Ways ways :: Ways
......
{-# LANGUAGE DeriveGeneric #-}
module Target (
Target (..), stageTarget, stagePackageTarget
) where
import Base
import Ways
import Oracles
import Package
import GHC.Generics
import Development.Shake.Classes
-- Target captures parameters relevant to the current build target: Stage and
-- Package being built, Builder that is to be invoked, file(s) that are to
-- be built and the Way they are to be built.
data Target = Target
{
getStage :: Stage,
getPackage :: Package,
getBuilder :: Builder,
getFile :: FilePath, -- TODO: handle multple files?
getWay :: Way
}
deriving (Eq, Generic)
-- Shows a target as "package:file@stage (builder, way)"
instance Show Target where
show target = show (getPackage target)
++ ":" ++ show (getFile target)
++ "@" ++ show (getStage target)
++ " (" ++ show (getBuilder target)
++ ", " ++ show (getWay target) ++ ")"
stageTarget :: Stage -> Target
stageTarget stage = Target
{
getStage = stage,
getPackage = error "stageTarget: Package not set",
getBuilder = error "stageTarget: Builder not set",
getFile = error "stageTarget: File not set",
getWay = error "stageTarget: Way not set"
}
stagePackageTarget :: Stage -> Package -> Target
stagePackageTarget stage package = Target
{
getStage = stage,
getPackage = package,
getBuilder = error "stagePackageTarget: Builder not set",
getFile = error "stagePackageTarget: File not set",
getWay = error "stagePackageTarget: Way not set"
}
-- Instances for storing Target in the Shake database
instance Binary Target
instance NFData Target
instance Hashable Target
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment