Skip to content
This repository has been archived by the owner on Aug 2, 2020. It is now read-only.

move a bunch of types into dedicated modules #502

Merged
merged 3 commits into from
Feb 19, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions hadrian.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,10 @@ executable hadrian
, Builder
, CommandLine
, Context
, Context.Type
, Environment
, Expression
, Expression.Type
, Flavour
, GHC
, Hadrian.Builder
Expand All @@ -33,11 +35,13 @@ executable hadrian
, Hadrian.Expression
, Hadrian.Haskell.Cabal
, Hadrian.Haskell.Cabal.Parse
, Hadrian.Haskell.Cabal.Type
, Hadrian.Oracles.ArgsHash
, Hadrian.Oracles.DirectoryContents
, Hadrian.Oracles.Path
, Hadrian.Oracles.TextFile
, Hadrian.Package
, Hadrian.Package.Type
, Hadrian.Target
, Hadrian.Utilities
, Oracles.Flag
Expand Down Expand Up @@ -106,6 +110,7 @@ executable hadrian
, UserSettings
, Utilities
, Way
, Way.Type
default-language: Haskell2010
default-extensions: DeriveFunctor
, DeriveGeneric
Expand Down
14 changes: 1 addition & 13 deletions src/Context.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,25 +12,13 @@ module Context (
pkgConfFile, objectPath
) where

import GHC.Generics
import Context.Type
Copy link
Owner

@snowleopard snowleopard Feb 15, 2018

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

As an example of the kind of comment I'm looking for:

-- The module "Context.Type" is used to break import cycles caused by "Oracles.Setting".
import Context.Type

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I doubt those comments will be of much use. They will document what the initial cycle that was broken was, but will ultimately bitrot pretty quickly. Any further refactoring or addition of code to hadrian that uses the .Type modules will not see that there could have been a cycle without the .Type module and subsequently not update the comment.

As such I believe the comment while it might be initially correct will be ultimately incorrect.

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, I agree, these comments will likely get out-of-date quickly, and we probably don't want to keep changing the structure very often.

Instead it may be more useful to add a general comment somewhere in the overview document that explains the module structure. (We don't have such a document at the moment, so we don't need to do it now.)

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I suggest we write such a description once we have integrated all of #445 as things will be in flux until we're done with that.

import Hadrian.Expression
import Hadrian.Haskell.Cabal

import Base
import Oracles.Setting

-- | Build context for a currently built 'Target'. We generate potentially
-- different build rules for each 'Context'.
data Context = Context
{ stage :: Stage -- ^ Currently build Stage
, package :: Package -- ^ Currently build Package
, way :: Way -- ^ Currently build Way (usually 'vanilla')
} deriving (Eq, Generic, Show)

instance Binary Context
instance Hashable Context
instance NFData Context

-- | Most targets are built only one way, hence the notion of 'vanillaContext'.
vanillaContext :: Stage -> Package -> Context
vanillaContext s p = Context s p vanilla
Expand Down
20 changes: 20 additions & 0 deletions src/Context/Type.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
module Context.Type where

import Hadrian.Package.Type
import Stage
import Way.Type

import GHC.Generics
import Development.Shake.Classes

-- | Build context for a currently built 'Target'. We generate potentially
-- different build rules for each 'Context'.
data Context = Context
{ stage :: Stage -- ^ Currently build Stage
, package :: Package -- ^ Currently build Package
, way :: Way -- ^ Currently build Way (usually 'vanilla')
} deriving (Eq, Generic, Show)

instance Binary Context
instance Hashable Context
instance NFData Context
18 changes: 3 additions & 15 deletions src/Expression.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,26 +23,14 @@ module Expression (
module GHC
) where

import qualified Hadrian.Expression as H
import Hadrian.Expression hiding (Expr, Predicate, Args)

import Base
import Builder
import GHC
import Context hiding (stage, package, way)
import Expression.Type
import GHC
import Hadrian.Expression hiding (Expr, Predicate, Args)
import Oracles.PackageData

-- | @Expr a@ is a computation that produces a value of type @Action a@ and can
-- read parameters of the current build 'Target'.
type Expr a = H.Expr Context Builder a

-- | The following expressions are used throughout the build system for
-- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways'
-- and 'Packages'.
type Predicate = H.Predicate Context Builder
type Args = H.Args Context Builder
type Ways = Expr [Way]

-- | Get a value from the @package-data.mk@ file of the current context.
getPkgData :: (FilePath -> PackageData) -> Expr String
getPkgData key = expr . pkgData . key =<< getBuildPath
Expand Down
17 changes: 17 additions & 0 deletions src/Expression/Type.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
module Expression.Type where

import Builder
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Again, I think Builder.Type is sufficient.

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah, sorry, ignore the above comment, apparently there is no Builder.Type. Or does it make sense to add it as well, for consistency?

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Looking at Stage below, I think we should only add .Type modules if they help resolve a cyclic import. So, let's not add Builder.Type if it's not necessary.

Copy link
Collaborator Author

@alpmestan alpmestan Feb 15, 2018

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Indeed I didn't add .Type modules that were not in @angerman's PR under src/Types/, and the ones that were there presumably were there to resolve cyclic imports, so I think the PR effectively implements what you converged on in your last comment, doesn't it?

EDIT: looking at the comments below, looks like it doesn't just yet =)

import Context.Type
import qualified Hadrian.Expression as H
import Way.Type

-- | @Expr a@ is a computation that produces a value of type @Action a@ and can
-- read parameters of the current build 'Target'.
type Expr a = H.Expr Context Builder a

-- | The following expressions are used throughout the build system for
-- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways'
-- and 'Packages'.
type Predicate = H.Predicate Context Builder
type Args = H.Args Context Builder
type Ways = Expr [Way]
1 change: 1 addition & 0 deletions src/Hadrian/Builder/Tar.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ instance Binary TarMode
instance Hashable TarMode
instance NFData TarMode


-- | Default command line arguments for invoking the archiving utility @tar@.
args :: (ShakeValue c, ShakeValue b) => TarMode -> Args c b
args Create = mconcat
Expand Down
22 changes: 1 addition & 21 deletions src/Hadrian/Haskell/Cabal/Parse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,34 +12,14 @@ module Hadrian.Haskell.Cabal.Parse (Cabal (..), parseCabal) where

import Data.List.Extra
import Development.Shake
import Development.Shake.Classes
import qualified Distribution.Package as C
import qualified Distribution.PackageDescription as C
import qualified Distribution.PackageDescription.Parsec as C
import qualified Distribution.Text as C
import qualified Distribution.Types.CondTree as C
import qualified Distribution.Verbosity as C

import Hadrian.Package

-- TODO: Use fine-grain tracking instead of tracking the whole Cabal file.
-- | Haskell package metadata extracted from a Cabal file.
data Cabal = Cabal
{ dependencies :: [PackageName]
, name :: PackageName
, synopsis :: String
, version :: String
} deriving (Eq, Read, Show, Typeable)

instance Binary Cabal where
put = put . show
get = fmap read get

instance Hashable Cabal where
hashWithSalt salt = hashWithSalt salt . show

instance NFData Cabal where
rnf (Cabal a b c d) = a `seq` b `seq` c `seq` d `seq` ()
import Hadrian.Haskell.Cabal.Type

-- | Parse a Cabal file.
parseCabal :: FilePath -> IO Cabal
Expand Down
23 changes: 23 additions & 0 deletions src/Hadrian/Haskell/Cabal/Type.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,23 @@
module Hadrian.Haskell.Cabal.Type where

import Development.Shake.Classes
import Hadrian.Package.Type

-- TODO: Use fine-grain tracking instead of tracking the whole Cabal file.
-- | Haskell package metadata extracted from a Cabal file.
data Cabal = Cabal
{ dependencies :: [PackageName]
, name :: PackageName
, synopsis :: String
, version :: String
} deriving (Eq, Read, Show, Typeable)

instance Binary Cabal where
put = put . show
get = fmap read get

instance Hashable Cabal where
hashWithSalt salt = hashWithSalt salt . show

instance NFData Cabal where
rnf (Cabal a b c d) = a `seq` b `seq` c `seq` d `seq` ()
44 changes: 1 addition & 43 deletions src/Hadrian/Package.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,53 +24,11 @@ module Hadrian.Package (
) where

import Data.Maybe
import Development.Shake.Classes
import Development.Shake.FilePath
import GHC.Generics
import GHC.Stack
import Hadrian.Package.Type
import Hadrian.Utilities

data PackageLanguage = C | Haskell deriving (Generic, Show)

-- TODO: Make PackageType more precise.
-- See https://github.com/snowleopard/hadrian/issues/12.
data PackageType = Library | Program deriving (Generic, Show)

type PackageName = String

-- TODO: Consider turning Package into a GADT indexed with language and type.
data Package = Package {
-- | The package language. 'C' and 'Haskell' packages are supported.
pkgLanguage :: PackageLanguage,
-- | The package type. 'Library' and 'Program' packages are supported.
pkgType :: PackageType,
-- | The package name. We assume that all packages have different names,
-- hence two packages with the same name are considered equal.
pkgName :: PackageName,
-- | The path to the package source code relative to the root of the build
-- system. For example, @libraries/Cabal/Cabal@ and @ghc@ are paths to the
-- @Cabal@ and @ghc-bin@ packages in GHC.
pkgPath :: FilePath
} deriving (Generic, Show)

instance Eq Package where
p == q = pkgName p == pkgName q

instance Ord Package where
compare p q = compare (pkgName p) (pkgName q)

instance Binary PackageLanguage
instance Hashable PackageLanguage
instance NFData PackageLanguage

instance Binary PackageType
instance Hashable PackageType
instance NFData PackageType

instance Binary Package
instance Hashable Package
instance NFData Package

-- | Construct a C library package.
cLibrary :: PackageName -> FilePath -> Package
cLibrary = Package C Library
Expand Down
45 changes: 45 additions & 0 deletions src/Hadrian/Package/Type.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,45 @@
module Hadrian.Package.Type where
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

From a quick look at Hadrian.Package, it doesn't seem that this split is necessary. Or is it?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think it will be necessary shortly (as in, in a PR or two), and given that we're not really in a comparable situation as with the Stage/Stage.Type case (the .Package module has several functions and the package-related types are likely going to be needed by "base" modules), I would personally suggest that we leave that one as-is, but it's your call of course :)


import GHC.Generics
import Development.Shake.Classes

data PackageLanguage = C | Haskell deriving (Generic, Show)

-- TODO: Make PackageType more precise.
-- See https://github.com/snowleopard/hadrian/issues/12.
data PackageType = Library | Program deriving (Generic, Show)

type PackageName = String

-- TODO: Consider turning Package into a GADT indexed with language and type.
data Package = Package {
-- | The package language. 'C' and 'Haskell' packages are supported.
pkgLanguage :: PackageLanguage,
-- | The package type. 'Library' and 'Program' packages are supported.
pkgType :: PackageType,
-- | The package name. We assume that all packages have different names,
-- hence two packages with the same name are considered equal.
pkgName :: PackageName,
-- | The path to the package source code relative to the root of the build
-- system. For example, @libraries/Cabal/Cabal@ and @ghc@ are paths to the
-- @Cabal@ and @ghc-bin@ packages in GHC.
pkgPath :: FilePath
} deriving (Generic, Show)

instance Eq Package where
p == q = pkgName p == pkgName q

instance Ord Package where
compare p q = compare (pkgName p) (pkgName q)

instance Binary PackageLanguage
instance Hashable PackageLanguage
instance NFData PackageLanguage

instance Binary PackageType
instance Hashable PackageType
instance NFData PackageType

instance Binary Package
instance Hashable Package
instance NFData Package
83 changes: 1 addition & 82 deletions src/Way.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,88 +9,7 @@ module Way (
wayPrefix, waySuffix, hisuf, osuf, hcsuf, obootsuf, hibootsuf, ssuf
) where

import Data.IntSet (IntSet)
import qualified Data.IntSet as Set
import Data.List
import Data.Maybe
import Development.Shake.Classes
import Hadrian.Utilities

-- Note: order of constructors is important for compatibility with the old build
-- system, e.g. we want "thr_p", not "p_thr" (see instance Show Way).
-- | A 'WayUnit' is a single way of building source code, for example with
-- profiling enabled, or dynamically linked.
data WayUnit = Threaded
| Debug
| Profiling
| Logging
| Dynamic
deriving (Bounded, Enum, Eq, Ord)

-- TODO: get rid of non-derived Show instances
instance Show WayUnit where
show unit = case unit of
Threaded -> "thr"
Debug -> "debug"
Profiling -> "p"
Logging -> "l"
Dynamic -> "dyn"

instance Read WayUnit where
readsPrec _ s = [(unit, "") | unit <- [minBound ..], show unit == s]

-- | Collection of 'WayUnit's that stands for the different ways source code
-- is to be built.
newtype Way = Way IntSet

instance Binary Way where
put = put . show
get = fmap read get

instance Hashable Way where
hashWithSalt salt = hashWithSalt salt . show

instance NFData Way where
rnf (Way s) = s `seq` ()

-- | Construct a 'Way' from multiple 'WayUnit's. Inverse of 'wayToUnits'.
wayFromUnits :: [WayUnit] -> Way
wayFromUnits = Way . Set.fromList . map fromEnum

-- | Split a 'Way' into its 'WayUnit' building blocks.
-- Inverse of 'wayFromUnits'.
wayToUnits :: Way -> [WayUnit]
wayToUnits (Way set) = map toEnum . Set.elems $ set

-- | Check whether a 'Way' contains a certain 'WayUnit'.
wayUnit :: WayUnit -> Way -> Bool
wayUnit unit (Way set) = fromEnum unit `Set.member` set

-- | Remove a 'WayUnit' from 'Way'.
removeWayUnit :: WayUnit -> Way -> Way
removeWayUnit unit (Way set) = Way . Set.delete (fromEnum unit) $ set

instance Show Way where
show way = if null tag then "v" else tag
where
tag = intercalate "_" . map show . wayToUnits $ way

instance Read Way where
readsPrec _ s = if s == "v" then [(vanilla, "")] else result
where
uniqueReads token = case reads token of
[(unit, "")] -> Just unit
_ -> Nothing
units = map uniqueReads . words . replaceEq '_' ' ' $ s
result = if Nothing `elem` units
then []
else [(wayFromUnits . map fromJust $ units, "")]

instance Eq Way where
Way a == Way b = a == b

instance Ord Way where
compare (Way a) (Way b) = compare a b
import Way.Type

-- | Build default _vanilla_ way.
vanilla :: Way
Expand Down
Loading