Merge Base.hs and Util.hs.

src/Base.hs

 module Base (
+    module Control.Applicative,
+    module Control.Monad.Extra,
+    module Data.Char,
+    module Data.Function,
+    module Data.List,
+    module Data.Maybe,
+    module Data.Monoid,
     module Development.Shake,
     module Development.Shake.Classes,
     module Development.Shake.Config,
     module Development.Shake.FilePath,
     module Development.Shake.Util,
-    shakeFilesPath, configPath, bootPackageConstraints, packageDependencies
+    module System.Console.ANSI,
+    shakeFilesPath, configPath, bootPackageConstraints, packageDependencies,
+    replaceEq, replaceSeparators, decodeModule,
+    unifyPath, (-/-), chunksOfSize,
+    putColoured, putOracle, putBuild, putSuccess, putError,
+    bimap, minusOrd, intersectOrd,
+    removeFileIfExists
     ) where
 
-import Development.Shake hiding (unit)
+import Control.Applicative
+import Control.Monad.Extra
+import Data.Char
+import Data.Function
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Development.Shake hiding (unit, (*>))
 import Development.Shake.Classes
 import Development.Shake.Config
 import Development.Shake.FilePath
 import Development.Shake.Util
+import System.Console.ANSI
+import qualified System.Directory as IO
+import System.IO
 
+-- Build system files and paths
 shakeFilesPath :: FilePath
 shakeFilesPath = "_build/"
 
@@ -24,3 +48,94 @@ bootPackageConstraints = shakeFilesPath ++ "boot-package-constraints"
 
 packageDependencies :: FilePath
 packageDependencies = shakeFilesPath ++ "package-dependencies"
+
+-- Utility functions
+replaceIf :: (a -> Bool) -> a -> [a] -> [a]
+replaceIf p to = map (\from -> if p from then to else from)
+
+replaceEq :: Eq a => a -> a -> [a] -> [a]
+replaceEq from = replaceIf (== from)
+
+replaceSeparators :: Char -> String -> String
+replaceSeparators = replaceIf isPathSeparator
+
+-- Given a module name extract the directory and file names, e.g.:
+-- decodeModule "Data.Functor.Identity" = ("Data/Functor/", "Identity")
+decodeModule :: String -> (FilePath, String)
+decodeModule = splitFileName . replaceEq '.' '/'
+
+-- Normalise a path and convert all path separators to /, even on Windows.
+unifyPath :: FilePath -> FilePath
+unifyPath = toStandard . normaliseEx
+
+-- Combine paths using </> and apply unifyPath to the result
+(-/-) :: FilePath -> FilePath -> FilePath
+a -/- b = unifyPath $ a </> b
+
+infixr 6 -/-
+
+-- (chunksOfSize size strings) splits a given list of strings into chunks not
+-- exceeding the given 'size'.
+chunksOfSize :: Int -> [String] -> [[String]]
+chunksOfSize _    [] = []
+chunksOfSize size strings = reverse chunk : chunksOfSize size rest
+  where
+    (chunk, rest) = go [] 0 strings
+    go res _         []     = (res, [])
+    go res chunkSize (s:ss) =
+        if newSize > size then (res, s:ss) else go (s:res) newSize ss
+      where
+        newSize = chunkSize + length s
+
+-- A more colourful version of Shake's putNormal
+putColoured :: Color -> String -> Action ()
+putColoured colour msg = do
+    liftIO $ setSGR [SetColor Foreground Vivid colour]
+    putNormal msg
+    liftIO $ setSGR []
+    liftIO $ hFlush stdout
+
+-- Make oracle output more distinguishable
+putOracle :: String -> Action ()
+putOracle = putColoured Blue
+
+-- Make build output more distinguishable
+putBuild :: String -> Action ()
+putBuild = putColoured White
+
+-- A more colourful version of success message
+putSuccess :: String -> Action ()
+putSuccess = putColoured Green
+
+-- A more colourful version of error message
+putError :: String -> Action a
+putError msg = do
+    putColoured Red msg
+    error $ "GHC build system error: " ++ msg
+
+-- Depending on Data.Bifunctor only for this function seems an overkill
+bimap :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
+bimap f g (x, y) = (f x, g y)
+
+-- Depending on Data.List.Ordered only for these two functions seems an overkill
+minusOrd :: Ord a => [a] -> [a] -> [a]
+minusOrd [] _  = []
+minusOrd xs [] = xs
+minusOrd (x:xs) (y:ys) = case compare x y of
+    LT -> x : minusOrd xs (y:ys)
+    EQ ->     minusOrd xs ys
+    GT ->     minusOrd (x:xs) ys
+
+intersectOrd :: (a -> b -> Ordering) -> [a] -> [b] -> [a]
+intersectOrd cmp = loop
+  where
+    loop [] _ = []
+    loop _ [] = []
+    loop (x:xs) (y:ys) = case cmp x y of
+         LT ->     loop xs (y:ys)
+         EQ -> x : loop xs ys
+         GT ->     loop (x:xs) ys
+
+-- Convenient helper function for removing a file that doesn't necessarily exist
+removeFileIfExists :: FilePath -> Action ()
+removeFileIfExists f = liftIO . whenM (IO.doesFileExist f) $ IO.removeFile f

src/Builder.hs

@@ -2,7 +2,6 @@
 module Builder (Builder (..), builderPath, specified, needBuilder) where
 
 import Base
-import Util
 import GHC.Generics (Generic)
 import Oracles
 import Stage

src/Expression.hs

 {-# LANGUAGE FlexibleInstances #-}
 module Expression (
+    module Base,
     module Control.Monad.Reader,
     module Builder,
     module Package,
     module Stage,
-    module Util,
     module Way,
     Expr, DiffExpr, fromDiffExpr,
     Predicate, (?), (??), notP, applyPredicate,
@@ -22,7 +22,6 @@ import Control.Monad.Reader
 import Package
 import Stage
 import Target (Target (..), PartialTarget (..), fromPartial)
-import Util
 import Way
 
 -- Expr a is a computation that produces a value of type Action a and can read

src/Oracles/ArgsHash.hs

 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-
 module Oracles.ArgsHash (
     checkArgsHash, argsHashOracle
     ) where
 
-import Base
 import Target
 import Expression
 import Settings

src/Oracles/Config.hs

@@ -2,7 +2,6 @@
 module Oracles.Config (askConfig, askConfigWithDefault, configOracle) where
 
 import Base
-import Util
 import qualified Data.HashMap.Strict as Map
 
 newtype ConfigKey = ConfigKey String

src/Oracles/Config/Flag.hs

@@ -5,7 +5,6 @@ module Oracles.Config.Flag (
     ) where
 
 import Base
-import Util
 import Oracles.Config
 import Oracles.Config.Setting
 

src/Oracles/Dependencies.hs

@@ -6,7 +6,6 @@ module Oracles.Dependencies (
     ) where
 
 import Base
-import Util
 import qualified Data.HashMap.Strict as Map
 
 newtype DependenciesKey = DependenciesKey (FilePath, FilePath)

src/Oracles/PackageData.hs

@@ -6,7 +6,6 @@ module Oracles.PackageData (
     ) where
 
 import Base
-import Util
 import qualified Data.HashMap.Strict as Map
 
 -- For each (PackageData path) the file 'path/package-data.mk' contains

src/Oracles/PackageDeps.hs

@@ -6,7 +6,6 @@ module Oracles.PackageDeps (
     ) where
 
 import Base
-import Util
 import Package
 import qualified Data.HashMap.Strict as Map
 

src/Oracles/WindowsRoot.hs

@@ -5,7 +5,6 @@ module Oracles.WindowsRoot (
     ) where
 
 import Base
-import Util
 
 newtype WindowsRoot = WindowsRoot ()
     deriving (Show, Typeable, Eq, Hashable, Binary, NFData)

src/Package.hs

@@ -6,7 +6,6 @@ module Package (
 
 import Base
 import GHC.Generics (Generic)
-import Util
 
 -- It is helpful to distinguish package names from strings.
 type PackageName = String

src/Predicates.hs

@@ -4,7 +4,6 @@ module Predicates (
     registerPackage, splitObjects
     ) where
 
-import Base
 import Expression
 import GHC
 import Oracles

src/Rules.hs

 module Rules (generateTargets, packageRules) where
 
-import Base
 import Expression
 import Oracles.PackageData
 import Rules.Package
 import Rules.Resources
-import Settings.Packages
-import Settings.User
-import Settings.Util
-import Settings.Ways
+import Settings
 import Target (PartialTarget (..))
 
 -- generateTargets needs top-level build targets

src/Rules/Actions.hs

 module Rules.Actions (build, buildWithResources) where
 
-import Base
-import Util
 import Target hiding (builder)
 import qualified Target
 import Builder
@@ -10,7 +8,6 @@ import Oracles
 import Oracles.ArgsHash
 import Settings
 import Settings.Args
-import Settings.Builders.Ar
 
 -- Build a given target using an appropriate builder and acquiring necessary
 -- resources. Force a rebuilt if the argument list has changed since the last

src/Rules/Cabal.hs

 module Rules.Cabal (cabalRules) where
 
-import Base
 import Stage
 import Package hiding (library)
 import Expression

src/Rules/Compile.hs

@@ -2,7 +2,6 @@ module Rules.Compile (compilePackage) where
 
 import Way
 import Base
-import Util
 import Builder
 import Target (PartialTarget (..), fullTarget, fullTargetWithWay)
 import Oracles.Dependencies

src/Rules/Config.hs

 module Rules.Config (configRules) where
 
 import Base
-import Util
 
 -- We add the following line to 'configure.ac' in order to produce configuration
 -- file "system.config" from "system.config.in" by running 'configure' script.

src/Rules/Data.hs

 module Rules.Data (buildPackageData) where
 
-import Base
-import Util
 import Target (PartialTarget (..), fullTarget)
 import Package
 import Builder

src/Rules/Dependencies.hs

 module Rules.Dependencies (buildPackageDependencies) where
 
-import Base
-import Util
 import Builder
 import Package
 import Expression

src/Rules/Documentation.hs

 module Rules.Documentation (buildPackageDocumentation) where
 
 import Way
-import Base
 import Stage
 import Builder
 import Package