Remove unused code from Base and Oracles.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Tue, 14 Jul 2015 14:21:55 +0000 (15:21 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Tue, 14 Jul 2015 14:21:55 +0000 (15:21 +0100)
18 files changed:
src/Base.hs
src/Expression.hs
src/Oracles.hs
src/Oracles/ArgsHash.hs
src/Oracles/Builder.hs
src/Oracles/Flag.hs
src/Oracles/Option.hs
src/Rules.hs
src/Rules/Data.hs
src/Rules/Oracles.hs
src/Settings.hs
src/Settings/GhcCabal.hs
src/Settings/GhcPkg.hs
src/Settings/Util.hs
src/Settings/Ways.hs
src/Switches.hs
src/Target.hs
src/Ways.hs

index 0aae7cd..026f211 100644 (file)
@@ -1,5 +1,4 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric, FlexibleInstances #-}
 
 module Base (
     module Development.Shake,
@@ -11,12 +10,11 @@ module Base (
     Stage (..),
     Arg, ArgList,
     ShowArg (..), ShowArgs (..),
-    Condition (..),
     filterOut,
     productArgs, concatArgs
     ) where
 
-import Development.Shake hiding ((*>), alternatives)
+import Development.Shake hiding ((*>))
 import Development.Shake.FilePath
 import Control.Applicative
 import Data.Function
@@ -39,8 +37,6 @@ instance Hashable Stage
 type Arg     = Action String
 type ArgList = Action [String]
 
-type Condition = Action Bool
-
 instance Monoid a => Monoid (Action a) where
     mempty = return mempty
     mappend p q = mappend <$> p <*> q
index 47f5984..d0eb64c 100644 (file)
@@ -1,4 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
 module Expression (
     module Target,
     module Data.Monoid,
@@ -11,13 +11,14 @@ module Expression (
     configKeyValue, configKeyValues
     ) where
 
-import Base hiding (Args)
+import Base
 import Ways
 import Target
-import Oracles
+import Oracles.Base
+import Oracles.Builder
 import Package
 import Data.Monoid
-import Control.Monad.Reader
+import Control.Monad.Reader hiding (liftIO)
 
 -- Expr a is a computation that produces a value of type Action a and can read
 -- parameters of the current build Target.
index 99f71be..e6e31f9 100644 (file)
@@ -1,10 +1,5 @@
 module Oracles (
     module Oracles.Base,
-    module Oracles.Flag,
-    module Oracles.Option,
-    module Oracles.Builder,
-    module Oracles.PackageData,
-    module Oracles.DependencyList,
     configOracle, packageDataOracle, dependencyOracle
     ) where
 
@@ -17,10 +12,8 @@ import Base
 import Util
 import Config
 import Oracles.Base
-import Oracles.Flag
-import Oracles.Option
-import Oracles.Builder
 import Oracles.PackageData
+import Control.Monad.Extra
 import Oracles.DependencyList
 
 defaultConfig, userConfig :: FilePath
@@ -31,7 +24,7 @@ userConfig    = cfgPath </> "user.config"
 configOracle :: Rules ()
 configOracle = do
     cfg <- newCache $ \() -> do
-        unless (doesFileExist $ defaultConfig <.> "in") $
+        unlessM (doesFileExist $ defaultConfig <.> "in") $
             redError_ $ "\nDefault configuration file '"
                       ++ (defaultConfig <.> "in")
                       ++ "' is missing; unwilling to proceed."
index 6a0276f..1586b97 100644 (file)
@@ -5,7 +5,7 @@ module Oracles.ArgsHash (
     ) where
 
 import Development.Shake.Classes
-import Base hiding (args)
+import Base
 import Settings
 import Expression
 
index f56ffad..aedc225 100644 (file)
@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 
 module Oracles.Builder (
     Builder (..), builderKey, withBuilderKey,
@@ -9,8 +8,8 @@ module Oracles.Builder (
 import Data.Char
 import Base
 import Util
-import Oracles.Base
 import Oracles.Flag
+import Oracles.Base
 import Oracles.Option
 import GHC.Generics
 import Development.Shake.Classes
@@ -34,6 +33,7 @@ data Builder = Ar
              | GhcPkg Stage
              deriving (Show, Eq, Generic)
 
+-- Instances for storing Target in the Shake database
 instance Binary Builder
 instance Hashable Builder
 
@@ -148,6 +148,7 @@ interestingInfo builder ss = case builder of
              ++ " arguments ..."]
              ++ drop (length ss - m) ss
 
+-- TODO: remove?
 -- Check if the builder is specified in config files
-specified :: Builder -> Condition
+specified :: Builder -> Action Bool
 specified = fmap (not . null) . showArg
index 8149619..c8eb69b 100644 (file)
@@ -1,15 +1,8 @@
-{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-}
-
 module Oracles.Flag (
-    module Control.Monad,
-    module Prelude,
     Flag (..),
-    test, when, unless, not, (&&), (||)
+    test
     ) where
 
-import qualified Prelude
-import Prelude hiding (not, (&&), (||))
-import Control.Monad hiding (when, unless)
 import Base
 import Util
 import Oracles.Base
@@ -49,66 +42,3 @@ test flag = do
                 ++ "'.\n"
            return defaultString
     return $ value == "YES"
-
-class ToCondition a where
-    toCondition :: a -> Condition
-
-instance ToCondition Condition where
-    toCondition = id
-
-instance ToCondition Bool where
-    toCondition = return
-
-instance ToCondition Flag where
-    toCondition = test
-
-when :: (ToCondition a, Monoid m) => a -> Action m -> Action m
-when x act = do
-    bool <- toCondition x
-    if bool then act else mempty
-
-unless :: (ToCondition a, Monoid m) => a -> Action m -> Action m
-unless x act = do
-    bool <- toCondition x
-    if bool then mempty else act
-
-class Not a where
-    type NotResult a
-    not :: a -> NotResult a
-
-instance Not Bool where
-    type NotResult Bool = Bool
-    not = Prelude.not
-
-instance Not Condition where
-    type NotResult Condition = Condition
-    not = fmap not
-
-instance Not Flag where
-    type NotResult Flag = Condition
-    not = not . toCondition
-
-class AndOr a b where
-    type AndOrResult a b
-    (&&) :: a -> b -> AndOrResult a b
-    (||) :: a -> b -> AndOrResult a b
-
-infixr 3 &&
-infixr 2 ||
-
-instance AndOr Bool Bool where
-    type AndOrResult Bool Bool = Bool
-    (&&) = (Prelude.&&)
-    (||) = (Prelude.||)
-
-instance ToCondition a => AndOr Condition a where
-    type AndOrResult Condition a = Condition
-    x && y = (&&) <$> x <*> toCondition y
-    x || y = (||) <$> x <*> toCondition y
-
-instance ToCondition a => AndOr Flag a where
-    type AndOrResult Flag a = Condition
-    x && y = toCondition x && y
-    x || y = toCondition x || y
-
--- TODO: need more instances to handle Bool as first argument of (&&), (||)
index c272349..f1a35e2 100644 (file)
@@ -1,11 +1,8 @@
-{-# LANGUAGE NoImplicitPrelude #-}
 module Oracles.Option (
-    Option (..), MultiOption (..),
-    ghcWithInterpreter, platformSupportsSharedLibs, windowsHost, splitObjects
+    Option (..), MultiOption (..), windowsHost
     ) where
 
 import Base
-import Oracles.Flag
 import Oracles.Base
 
 -- For each Option the files {default.config, user.config} contain
@@ -58,40 +55,7 @@ instance ShowArgs MultiOption where
       where
         showStage = ("-stage" ++) . show
 
-ghcWithInterpreter :: Condition
-ghcWithInterpreter = do
-    os   <- showArg TargetOs
-    arch <- showArg TargetArch
-    return $
-        os `elem` ["mingw32", "cygwin32", "linux", "solaris2",
-                   "freebsd", "dragonfly", "netbsd", "openbsd",
-                   "darwin", "kfreebsdgnu"]
-        &&
-        arch `elem` ["i386", "x86_64", "powerpc", "sparc", "sparc64", "arm"]
-
-platformSupportsSharedLibs :: Condition
-platformSupportsSharedLibs = do
-    platform <- showArg TargetPlatformFull
-    solarisBrokenShld <- test SolarisBrokenShld
-    return $ notElem platform $
-        ["powerpc-unknown-linux",
-         "x86_64-unknown-mingw32",
-         "i386-unknown-mingw32"] ++
-        ["i386-unknown-solaris2" | solarisBrokenShld]
-
-windowsHost :: Condition
+windowsHost :: Action Bool
 windowsHost = do
     hostOsCpp <- showArg HostOsCpp
     return $ hostOsCpp `elem` ["mingw32", "cygwin32"]
-
--- TODO: refactor helper Condition functions into a separate file
-splitObjects :: Stage -> Condition
-splitObjects stage = do
-    arch <- showArg TargetArch
-    os   <- showArg TargetOs
-    not SplitObjectsBroken && not GhcUnregisterised
-        && stage == Stage1
-        && arch `elem` ["i386", "x86_64", "powerpc", "sparc"]
-        && os   `elem` ["mingw32", "cygwin32", "linux", "darwin",
-                       "solaris2", "freebsd", "dragonfly", "netbsd",
-                       "openbsd"]
index 7fa126e..c58e263 100644 (file)
@@ -1,4 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
 module Rules (
     generateTargets, packageRules, oracleRules,
     module Rules.Package,
index aaeb5fe..684cde6 100644 (file)
@@ -6,8 +6,8 @@ module Rules.Data (
 
 import Base
 import Package
-import Expression hiding (when, liftIO)
-import Oracles.Flag (when)
+import Expression
+import Control.Monad.Extra
 import Oracles.Builder
 import Settings.GhcPkg
 import Settings.GhcCabal
@@ -39,7 +39,7 @@ buildPackageData target =
         -- GhcCabal will run the configure script, so we depend on it
         need [pkgPath pkg </> pkgCabal pkg]
         -- We still don't know who built the configure script from configure.ac
-        when (doesFileExist $ configure <.> "ac") $ need [configure]
+        whenM (doesFileExist $ configure <.> "ac") $ need [configure]
         build $ newTarget { getBuilder = GhcCabal }
         -- TODO: when (registerPackage settings) $
         build $ newTarget { getBuilder = GhcPkg stage }
index 5ea9b44..7b52ffe 100644 (file)
@@ -2,7 +2,7 @@ module Rules.Oracles (
     oracleRules
     ) where
 
-import Base hiding (arg, args, Args)
+import Base
 import Oracles
 import Oracles.ArgsHash
 
index e4519f1..196f4d7 100644 (file)
@@ -2,11 +2,11 @@ module Settings (
     args
     ) where
 
-import Base hiding (arg, args, Args)
+import Base
 import Settings.GhcPkg
 import Settings.GhcCabal
 import Settings.User
-import Expression hiding (when, liftIO)
+import Expression
 
 args :: Args
 args = defaultArgs <> userArgs
index f45f3ea..abccc03 100644 (file)
@@ -9,7 +9,7 @@ import Ways
 import Util
 import Package
 import Switches
-import Expression hiding (liftIO)
+import Expression
 import Settings.User
 import Settings.Ways
 import Settings.Util
index 5da4e5d..5777b02 100644 (file)
@@ -4,7 +4,7 @@ module Settings.GhcPkg (
 
 import Base
 import Switches
-import Expression hiding (when, liftIO)
+import Expression
 import Settings.Util
 import Oracles.Builder
 import Settings.GhcCabal
index ddb40e0..1b2ed69 100644 (file)
@@ -1,5 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-
 module Settings.Util (
     -- Primitive settings elements
     arg, argM, argWith,
@@ -13,8 +11,9 @@ module Settings.Util (
     -- argPackageConstraints,
     ) where
 
-import Base hiding (Args, arg, args)
-import Oracles hiding (not)
+import Base
+import Oracles.Base
+import Oracles.Builder
 import Expression
 
 -- A single argument
index fd9422f..4c79161 100644 (file)
@@ -3,7 +3,7 @@ module Settings.Ways (
     ) where
 
 import Base
-import Ways hiding (defaultWays)
+import Ways
 import Switches
 import Expression
 import Settings.User
index 48c44ef..ce03ade 100644 (file)
@@ -90,3 +90,14 @@ windowsHost = configKeyValues "host-os-cpp" ["mingw32", "cygwin32"]
 
 notWindowsHost :: Predicate
 notWindowsHost = liftM not windowsHost
+
+-- splitObjects :: Stage -> Condition
+-- splitObjects stage = do
+--     arch <- showArg TargetArch
+--     os   <- showArg TargetOs
+--     not SplitObjectsBroken && not GhcUnregisterised
+--         && stage == Stage1
+--         && arch `elem` ["i386", "x86_64", "powerpc", "sparc"]
+--         && os   `elem` ["mingw32", "cygwin32", "linux", "darwin",
+--                        "solaris2", "freebsd", "dragonfly", "netbsd",
+--                        "openbsd"]
index ba47421..6161db7 100644 (file)
@@ -5,8 +5,8 @@ module Target (
 
 import Base
 import Ways
-import Oracles
 import Package
+import Oracles.Builder
 import GHC.Generics
 import Development.Shake.Classes
 
index 10927cb..3247f3e 100644 (file)
@@ -1,5 +1,4 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE NoImplicitPrelude #-}
 module Ways ( -- TODO: rename to "Way"?
     WayUnit (..),
     Way, tag,
@@ -19,7 +18,7 @@ module Ways ( -- TODO: rename to "Way"?
     ) where
 
 import Base
-import Oracles
+import Oracles.Option
 import GHC.Generics
 import Development.Shake.Classes