Merge Base.hs and Util.hs.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sat, 22 Aug 2015 20:03:38 +0000 (21:03 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sat, 22 Aug 2015 20:03:38 +0000 (21:03 +0100)
35 files changed:
src/Base.hs
src/Builder.hs
src/Expression.hs
src/Oracles/ArgsHash.hs
src/Oracles/Config.hs
src/Oracles/Config/Flag.hs
src/Oracles/Dependencies.hs
src/Oracles/PackageData.hs
src/Oracles/PackageDeps.hs
src/Oracles/WindowsRoot.hs
src/Package.hs
src/Predicates.hs
src/Rules.hs
src/Rules/Actions.hs
src/Rules/Cabal.hs
src/Rules/Compile.hs
src/Rules/Config.hs
src/Rules/Data.hs
src/Rules/Dependencies.hs
src/Rules/Documentation.hs
src/Rules/Library.hs
src/Rules/Package.hs
src/Rules/Resources.hs
src/Settings/Args.hs
src/Settings/Builders/Gcc.hs
src/Settings/Builders/Ghc.hs
src/Settings/Builders/GhcCabal.hs
src/Settings/Builders/GhcPkg.hs
src/Settings/Builders/Haddock.hs
src/Settings/TargetDirectory.hs
src/Settings/Util.hs
src/Settings/Ways.hs
src/Target.hs
src/Util.hs [deleted file]
src/Way.hs

index c2d864d..862c46b 100644 (file)
@@ -1,18 +1,42 @@
 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
index d5c04cc..5d60035 100644 (file)
@@ -2,7 +2,6 @@
 module Builder (Builder (..), builderPath, specified, needBuilder) where
 
 import Base
-import Util
 import GHC.Generics (Generic)
 import Oracles
 import Stage
index 26c6a9b..e62acf0 100644 (file)
@@ -1,10 +1,10 @@
 {-# 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
index 4b02ea5..937f7ae 100644 (file)
@@ -1,10 +1,8 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-
 module Oracles.ArgsHash (
     checkArgsHash, argsHashOracle
     ) where
 
-import Base
 import Target
 import Expression
 import Settings
index 8c6612c..5a163a6 100644 (file)
@@ -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
index 3608d61..737af97 100644 (file)
@@ -5,7 +5,6 @@ module Oracles.Config.Flag (
     ) where
 
 import Base
-import Util
 import Oracles.Config
 import Oracles.Config.Setting
 
index b48e344..8a7e3fe 100644 (file)
@@ -6,7 +6,6 @@ module Oracles.Dependencies (
     ) where
 
 import Base
-import Util
 import qualified Data.HashMap.Strict as Map
 
 newtype DependenciesKey = DependenciesKey (FilePath, FilePath)
index 15cc025..94eab45 100644 (file)
@@ -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
index 3ef93ff..10e7027 100644 (file)
@@ -6,7 +6,6 @@ module Oracles.PackageDeps (
     ) where
 
 import Base
-import Util
 import Package
 import qualified Data.HashMap.Strict as Map
 
index 6312629..5f4f4cd 100644 (file)
@@ -5,7 +5,6 @@ module Oracles.WindowsRoot (
     ) where
 
 import Base
-import Util
 
 newtype WindowsRoot = WindowsRoot ()
     deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
index b96435f..f1da50c 100644 (file)
@@ -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
index 3f40614..8743881 100644 (file)
@@ -4,7 +4,6 @@ module Predicates (
     registerPackage, splitObjects
     ) where
 
-import Base
 import Expression
 import GHC
 import Oracles
index 6586ed7..8166404 100644 (file)
@@ -1,14 +1,10 @@
 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
index e58815b..e25c1e6 100644 (file)
@@ -1,7 +1,5 @@
 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
index e267fc3..ce19475 100644 (file)
@@ -1,6 +1,5 @@
 module Rules.Cabal (cabalRules) where
 
-import Base
 import Stage
 import Package hiding (library)
 import Expression
index a24da66..a740dd5 100644 (file)
@@ -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
index 956b3dd..4987fcc 100644 (file)
@@ -1,7 +1,6 @@
 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.
index cc8a795..937a8e9 100644 (file)
@@ -1,7 +1,5 @@
 module Rules.Data (buildPackageData) where
 
-import Base
-import Util
 import Target (PartialTarget (..), fullTarget)
 import Package
 import Builder
index d0dc4b6..469035e 100644 (file)
@@ -1,7 +1,5 @@
 module Rules.Dependencies (buildPackageDependencies) where
 
-import Base
-import Util
 import Builder
 import Package
 import Expression
index f7fac4f..8592f59 100644 (file)
@@ -1,7 +1,6 @@
 module Rules.Documentation (buildPackageDocumentation) where
 
 import Way
-import Base
 import Stage
 import Builder
 import Package
index 9058271..c940a38 100644 (file)
@@ -1,13 +1,12 @@
 module Rules.Library (buildPackageLibrary) where
 
-import Base hiding (splitPath, getDirectoryContents)
-import Expression
+import Expression hiding (splitPath)
 import Oracles.PackageData
 import Predicates (splitObjects)
 import Rules.Actions
 import Rules.Resources
 import Settings
-import System.Directory (getDirectoryContents)
+import qualified System.Directory as IO
 import Target (PartialTarget (..), fullTarget)
 
 buildPackageLibrary :: Resources -> PartialTarget -> Rules ()
@@ -33,7 +32,7 @@ buildPackageLibrary _ target @ (PartialTarget stage pkg) = do
         splitObjs <- if not split then return [] else
             fmap concat $ forM hSrcs $ \src -> do
                 let splitPath = buildPath -/- src ++ "_" ++ osuf way ++ "_split"
-                contents <- liftIO $ getDirectoryContents splitPath
+                contents <- liftIO $ IO.getDirectoryContents splitPath
                 return . map (splitPath -/-)
                        . filter (not . all (== '.')) $ contents
 
index 3095679..dfc15e8 100644 (file)
@@ -1,7 +1,6 @@
 module Rules.Package (buildPackage) where
 
 import Base
-import Expression
 import Rules.Compile
 import Rules.Data
 import Rules.Dependencies
index ec00207..3631a1e 100644 (file)
@@ -1,7 +1,6 @@
 module Rules.Resources (resourceRules, Resources (..)) where
 
 import Base
-import Util
 
 data Resources = Resources
     {
index 81aae65..a2b7c13 100644 (file)
@@ -1,4 +1,4 @@
-module Settings.Args (args, getArgs) where
+module Settings.Args (args, getArgs, arPersistentArgsCount) where
 
 import Expression
 import Settings
index a3d088e..1900ff1 100644 (file)
@@ -1,7 +1,5 @@
 module Settings.Builders.Gcc (gccArgs, gccMArgs) where
 
-import Base
-import Util
 import Expression
 import Predicates (stagedBuilder)
 import Oracles.PackageData
index 472a484..d1404a0 100644 (file)
@@ -1,6 +1,5 @@
 module Settings.Builders.Ghc (ghcArgs, ghcMArgs, commonGhcArgs) where
 
-import Util
 import Expression
 import Predicates (stagedBuilder, splitObjects, stage0)
 import Oracles
index 1a95368..11529bf 100644 (file)
@@ -4,8 +4,6 @@ module Settings.Builders.GhcCabal (
     ) where
 
 import Way
-import Base
-import Util
 import Stage
 import Builder
 import Package
index 64981c6..fcf22c5 100644 (file)
@@ -1,6 +1,5 @@
 module Settings.Builders.GhcPkg (ghcPkgArgs) where
 
-import Util
 import Builder
 import Expression
 import Predicates
index aa9282c..fe55e0d 100644 (file)
@@ -1,7 +1,5 @@
 module Settings.Builders.Haddock (haddockArgs) where
 
-import Base
-import Util
 import Builder
 import Package
 import Expression
index 568ec05..265ae94 100644 (file)
@@ -3,7 +3,6 @@ module Settings.TargetDirectory (
     ) where
 
 import Base
-import Util
 import Stage
 import Package
 import Settings.User
index 3469d39..c25b882 100644 (file)
@@ -9,7 +9,6 @@ module Settings.Util (
     appendCcArgs
     ) where
 
-import Base
 import Stage
 import Builder
 import Package
index 27f7d4c..da59f5f 100644 (file)
@@ -1,6 +1,5 @@
 module Settings.Ways (getWays, getRtsWays) where
 
-import Way
 import Stage
 import Expression
 import Predicates
index 2b90426..90f8141 100644 (file)
@@ -11,7 +11,6 @@ import GHC.Generics (Generic)
 import Package
 import Stage
 import Way
-import Util
 
 -- Target captures all parameters relevant to the current build target:
 -- * Stage and Package being built,
diff --git a/src/Util.hs b/src/Util.hs
deleted file mode 100644 (file)
index 561ac13..0000000
+++ /dev/null
@@ -1,117 +0,0 @@
-module Util (
-    module Control.Applicative,
-    module Control.Monad.Extra,
-    module Data.Char,
-    module Data.Function,
-    module Data.List,
-    module Data.Maybe,
-    module Data.Monoid,
-    module System.Console.ANSI,
-    replaceEq, replaceSeparators, decodeModule,
-    unifyPath, (-/-), chunksOfSize,
-    putColoured, putOracle, putBuild, putSuccess, putError,
-    bimap, minusOrd, intersectOrd,
-    removeFileIfExists
-    ) where
-
-import Base hiding (doesFileExist)
-import Control.Applicative
-import Control.Monad.Extra
-import Data.Char
-import Data.Function
-import Data.List
-import Data.Maybe
-import Data.Monoid
-import System.Console.ANSI
-import System.Directory (doesFileExist, removeFile)
-import System.IO
-
-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 file = liftIO . whenM (doesFileExist file) $ removeFile file
index 562ffad..ff295e8 100644 (file)
@@ -12,11 +12,10 @@ module Way (
     safeDetectWay, detectWay, matchBuildResult
     ) where
 
-import Base
+import Base hiding (unit)
 import Data.IntSet (IntSet)
 import qualified Data.IntSet as Set
 import Oracles
-import Util hiding (unit)
 
 data WayUnit = Threaded
              | Debug