Commit 87c6fae6 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add support for --split-object command line flag.

See #132.
parent e7377d11
module CmdLineFlag ( module CmdLineFlag (
putCmdLineFlags, flags, cmdProgressInfo, ProgressInfo (..) putCmdLineFlags, flags, cmdProgressInfo, ProgressInfo (..), cmdSplitObjects
) where ) where
import Base import Base
...@@ -16,13 +16,15 @@ data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show) ...@@ -16,13 +16,15 @@ data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show)
-- command line. These flags are not tracked, that is they do not force any -- command line. These flags are not tracked, that is they do not force any
-- build rules to be rurun. -- build rules to be rurun.
data Untracked = Untracked data Untracked = Untracked
{ progressInfo :: ProgressInfo } { progressInfo :: ProgressInfo
, splitObjects :: Bool }
deriving (Eq, Show) deriving (Eq, Show)
-- | Default values for 'CmdLineFlag.Untracked'. -- | Default values for 'CmdLineFlag.Untracked'.
defaultUntracked :: Untracked defaultUntracked :: Untracked
defaultUntracked = Untracked defaultUntracked = Untracked
{ progressInfo = Normal } { progressInfo = Normal
, splitObjects = False }
readProgressInfo :: Maybe String -> Either String (Untracked -> Untracked) readProgressInfo :: Maybe String -> Either String (Untracked -> Untracked)
readProgressInfo ms = readProgressInfo ms =
...@@ -35,11 +37,16 @@ readProgressInfo ms = ...@@ -35,11 +37,16 @@ readProgressInfo ms =
go "unicorn" = Just Unicorn go "unicorn" = Just Unicorn
go _ = Nothing -- Left "no parse" go _ = Nothing -- Left "no parse"
mkClosure :: ProgressInfo -> Untracked -> Untracked mkClosure :: ProgressInfo -> Untracked -> Untracked
mkClosure flag opts = opts { progressInfo = flag } mkClosure flag flags = flags { progressInfo = flag }
readSplitObjects :: Either String (Untracked -> Untracked)
readSplitObjects = Right $ \flags -> flags { splitObjects = True }
flags :: [OptDescr (Either String (Untracked -> Untracked))] flags :: [OptDescr (Either String (Untracked -> Untracked))]
flags = [ Option [] ["progress-info"] (OptArg readProgressInfo "") flags = [ Option [] ["progress-info"] (OptArg readProgressInfo "")
"Progress Info Style (None, Brief, Normal, or Unicorn)" ] "Progress Info Style (None, Brief, Normal, or Unicorn)"
, Option [] ["split-objects"] (NoArg readSplitObjects)
"Generate split objects (requires a full clean rebuild)." ]
-- TODO: Get rid of unsafePerformIO by using shakeExtra. -- TODO: Get rid of unsafePerformIO by using shakeExtra.
{-# NOINLINE cmdLineFlags #-} {-# NOINLINE cmdLineFlags #-}
...@@ -47,10 +54,13 @@ cmdLineFlags :: IORef Untracked ...@@ -47,10 +54,13 @@ cmdLineFlags :: IORef Untracked
cmdLineFlags = unsafePerformIO $ newIORef defaultUntracked cmdLineFlags = unsafePerformIO $ newIORef defaultUntracked
putCmdLineFlags :: [Untracked -> Untracked] -> IO () putCmdLineFlags :: [Untracked -> Untracked] -> IO ()
putCmdLineFlags opts = modifyIORef cmdLineFlags (\o -> foldl (flip id) o opts) putCmdLineFlags flags = modifyIORef cmdLineFlags (\f -> foldl (flip id) f flags)
getCmdLineFlags :: Action Untracked getCmdLineFlags :: Action Untracked
getCmdLineFlags = liftIO $ readIORef cmdLineFlags getCmdLineFlags = liftIO $ readIORef cmdLineFlags
cmdProgressInfo :: Action ProgressInfo cmdProgressInfo :: Action ProgressInfo
cmdProgressInfo = progressInfo <$> getCmdLineFlags cmdProgressInfo = progressInfo <$> getCmdLineFlags
cmdSplitObjects :: Action Bool
cmdSplitObjects = splitObjects <$> getCmdLineFlags
...@@ -6,9 +6,12 @@ module Settings.User ( ...@@ -6,9 +6,12 @@ module Settings.User (
verboseCommands, turnWarningsIntoErrors, splitObjects verboseCommands, turnWarningsIntoErrors, splitObjects
) where ) where
import Base
import CmdLineFlag
import GHC import GHC
import Expression import Expression
import Predicates import Predicates
import Settings.Default
-- | All build artefacts are stored in 'buildRootPath' directory. -- | All build artefacts are stored in 'buildRootPath' directory.
buildRootPath :: FilePath buildRootPath :: FilePath
...@@ -55,9 +58,10 @@ trackBuildSystem = True ...@@ -55,9 +58,10 @@ trackBuildSystem = True
validating :: Bool validating :: Bool
validating = False validating = False
-- To switch on split objects use 'splitObjects = defaultSplitObjects', see #153 -- | Control when split objects are generated. Note, due to the GHC bug #11315
-- it is necessary to do a full clean rebuild when changing this option.
splitObjects :: Predicate splitObjects :: Predicate
splitObjects = return False splitObjects = (lift $ cmdSplitObjects) &&^ defaultSplitObjects
dynamicGhcPrograms :: Bool dynamicGhcPrograms :: Bool
dynamicGhcPrograms = False dynamicGhcPrograms = False
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment