Move a bunch of types into dedicated modules (#502)

* move a bunch of types into dedicated modules

* address review feedback

* do away with Hadrian.Builder.Mode for now

hadrian.cabal

@@ -22,8 +22,10 @@ executable hadrian
                        , Builder
                        , CommandLine
                        , Context
+                       , Context.Type
                        , Environment
                        , Expression
+                       , Expression.Type
                        , Flavour
                        , GHC
                        , Hadrian.Builder
@@ -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
@@ -106,6 +110,7 @@ executable hadrian
                        , UserSettings
                        , Utilities
                        , Way
+                       , Way.Type
     default-language:    Haskell2010
     default-extensions:  DeriveFunctor
                        , DeriveGeneric

src/Context.hs

@@ -12,25 +12,13 @@ module Context (
     pkgConfFile, objectPath
     ) where
 
-import GHC.Generics
+import Context.Type
 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

src/Context/Type.hs

+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

src/Expression.hs

@@ -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

src/Expression/Type.hs

+module Expression.Type where
+
+import Builder
+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]

src/Hadrian/Builder/Tar.hs

@@ -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

src/Hadrian/Haskell/Cabal/Parse.hs

@@ -12,7 +12,6 @@ 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
@@ -20,26 +19,7 @@ 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

src/Hadrian/Haskell/Cabal/Type.hs

+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` ()

src/Hadrian/Package.hs

@@ -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

src/Hadrian/Package/Type.hs

+module Hadrian.Package.Type where
+
+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

src/Way.hs

@@ -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

src/Way/Type.hs

+module Way.Type 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 [(wayFromUnits [], "")] 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