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 (
putCmdLineFlags, flags, cmdProgressInfo, ProgressInfo (..)
putCmdLineFlags, flags, cmdProgressInfo, ProgressInfo (..), cmdSplitObjects
) where
import Base
......@@ -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
-- build rules to be rurun.
data Untracked = Untracked
{ progressInfo :: ProgressInfo }
{ progressInfo :: ProgressInfo
, splitObjects :: Bool }
deriving (Eq, Show)
-- | Default values for 'CmdLineFlag.Untracked'.
defaultUntracked :: Untracked
defaultUntracked = Untracked
{ progressInfo = Normal }
{ progressInfo = Normal
, splitObjects = False }
readProgressInfo :: Maybe String -> Either String (Untracked -> Untracked)
readProgressInfo ms =
......@@ -35,11 +37,16 @@ readProgressInfo ms =
go "unicorn" = Just Unicorn
go _ = Nothing -- Left "no parse"
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 = [ 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.
{-# NOINLINE cmdLineFlags #-}
......@@ -47,10 +54,13 @@ cmdLineFlags :: IORef Untracked
cmdLineFlags = unsafePerformIO $ newIORef defaultUntracked
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 = liftIO $ readIORef cmdLineFlags
cmdProgressInfo :: Action ProgressInfo
cmdProgressInfo = progressInfo <$> getCmdLineFlags
cmdSplitObjects :: Action Bool
cmdSplitObjects = splitObjects <$> getCmdLineFlags
......@@ -6,9 +6,12 @@ module Settings.User (
verboseCommands, turnWarningsIntoErrors, splitObjects
) where
import Base
import CmdLineFlag
import GHC
import Expression
import Predicates
import Settings.Default
-- | All build artefacts are stored in 'buildRootPath' directory.
buildRootPath :: FilePath
......@@ -55,9 +58,10 @@ trackBuildSystem = True
validating :: Bool
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 = return False
splitObjects = (lift $ cmdSplitObjects) &&^ defaultSplitObjects
dynamicGhcPrograms :: Bool
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