{-# LANGUAGE TupleSections #-}-- | Command line parsing flags.moduleDevelopment.Shake.Internal.Args(shakeOptDescrs ,shake ,shakeArgs ,shakeArgsWith ,shakeArgsOptionsWith )whereimportDevelopment.Shake.Internal.Paths importDevelopment.Shake.Internal.Options importDevelopment.Shake.Internal.Core.Rules importDevelopment.Shake.Internal.Errors importDevelopment.Shake.Internal.CompactUI importDevelopment.Shake.Internal.Demo importDevelopment.Shake.Internal.Core.Action importDevelopment.Shake.FilePath importDevelopment.Shake.Internal.Rules.File importDevelopment.Shake.Internal.Progress importDevelopment.Shake.Database importGeneral.Timing importGeneral.Extra importGeneral.Thread importGeneral.GetOpt importGeneral.EscCodes importData.Tuple.ExtraimportControl.DeepSeqimportControl.Exception.ExtraimportControl.MonadimportData.EitherimportData.ListimportData.MaybeimportSystem.Directory.ExtraimportSystem.EnvironmentimportSystem.ExitimportSystem.Time.Extra-- | Main entry point for running Shake build systems. For an example see the top of the module "Development.Shake".-- Use 'ShakeOptions' to specify how the system runs, and 'Rules' to specify what to build. The function will throw-- an exception if the build fails.---- To use command line flags to modify 'ShakeOptions' see 'shakeArgs'.shake::ShakeOptions ->Rules ()->IO()shake opts rules =doaddTiming "Function shake"(_,after )<-shakeWithDatabase opts rules $\db ->doshakeOneShotDatabase db shakeRunDatabase db []shakeRunAfter opts after -- | Run a build system using command line arguments for configuration.-- The available flags are those from 'shakeOptDescrs', along with a few additional-- @make@ compatible flags that are not represented in 'ShakeOptions', such as @--print-directory@.-- If there are no file arguments then the 'Rules' are used directly, otherwise the file arguments-- are 'want'ed (after calling 'withoutActions'). As an example:---- @-- main = 'shakeArgs' 'shakeOptions'{'shakeFiles' = \"_make\", 'shakeProgress' = 'progressSimple'} $ do-- 'phony' \"clean\" $ 'Development.Shake.removeFilesAfter' \"_make\" [\"\/\/*\"]-- 'want' [\"_make\/neil.txt\",\"_make\/emily.txt\"]-- \"_make\/*.txt\" '%>' \\out ->-- ... build action here ...-- @---- This build system will default to building @neil.txt@ and @emily.txt@, while showing progress messages,-- and putting the Shake files in locations such as @_make\/.database@. Some example command line flags:---- * @main --no-progress@ will turn off progress messages.---- * @main -j6@ will build on 6 threads.---- * @main --help@ will display a list of supported flags.---- * @main clean@ will not build anything, but will remove the @_make@ directory, including the-- any 'shakeFiles'.---- * @main _make/henry.txt@ will not build @neil.txt@ or @emily.txt@, but will instead build @henry.txt@.shakeArgs::ShakeOptions ->Rules ()->IO()shakeArgs opts rules =shakeArgsWith opts []f wheref _files =return$Just$ifnullfiles thenrules elsewant files >>withoutActions rules -- | A version of 'shakeArgs' with more flexible handling of command line arguments.-- The caller of 'shakeArgsWith' can add additional flags (the second argument) and chose how to convert-- the flags/arguments into rules (the third argument). Given:---- @-- 'shakeArgsWith' opts flags (\\flagValues argValues -> result)-- @---- * @opts@ is the initial 'ShakeOptions' value, which may have some fields overriden by command line flags.-- This argument is usually 'shakeOptions', perhaps with a few fields overriden.---- * @flags@ is a list of flag descriptions, which either produce a 'String' containing an error-- message (typically for flags with invalid arguments, .e.g. @'Left' \"could not parse as int\"@), or a value-- that is passed as @flagValues@. If you have no custom flags, pass @[]@.---- * @flagValues@ is a list of custom flags that the user supplied. If @flags == []@ then this list will-- be @[]@.---- * @argValues@ is a list of non-flag arguments, which are often treated as files and passed to 'want'.-- If arguments are specified then typically the 'want' calls from the rules are discarded using 'withoutActions'.---- * @result@ should produce a 'Nothing' to indicate that no building needs to take place, or a 'Just'-- providing the rules that should be used.---- As an example of a build system that can use either @gcc@ or @distcc@ for compiling:---- @-- import System.Console.GetOpt---- data Flags = DistCC deriving Eq-- flags = [Option \"\" [\"distcc\"] (NoArg $ Right DistCC) \"Run distributed.\"]---- main = 'shakeArgsWith' 'shakeOptions' flags $ \\flags targets -> return $ Just $ do-- let compiler = if DistCC \`elem\` flags then \"distcc\" else \"gcc\"-- let rules = do-- \"*.o\" '%>' \\out -> do-- 'need' ...-- 'cmd' compiler ...-- 'want' [\"target.exe\"]-- ...-- if null targets then rules else 'want' targets >> 'withoutActions' rules-- @---- Now you can pass @--distcc@ to use the @distcc@ compiler.shakeArgsWith::ShakeOptions ->[OptDescr(EitherStringa )]->([a ]->[String]->IO(Maybe(Rules ())))->IO()shakeArgsWith opt args f =shakeArgsOptionsWith opt args $\so a b ->fmap(so ,)<$>f a b -- | Like 'shakeArgsWith', but also lets you manipulate the 'ShakeOptions'.shakeArgsOptionsWith::ShakeOptions ->[OptDescr(EitherStringa )]->(ShakeOptions ->[a ]->[String]->IO(Maybe(ShakeOptions ,Rules ())))->IO()shakeArgsOptionsWith baseOpts userOptions rules =doaddTiming "shakeArgsWith"letbaseOpts2 =removeOverlap userOptions $mapsndshakeOptsEx args <-getArgslet(flag1 ,files ,errs )=getOpt (baseOpts2 `mergeOptDescr `userOptions )args (self ,user )=partitionEithersflag1 (flagsExtra ,flagsShake )=firstconcat$unzipself progressReplays =[x |ProgressReplay x <-flagsExtra ]progressRecords =[x |ProgressRecord x <-flagsExtra ]changeDirectory =listToMaybe[x |ChangeDirectory x <-flagsExtra ]printDirectory =last$False:[x |PrintDirectory x <-flagsExtra ]shareRemoves =[x |ShareRemove x <-flagsExtra ]oshakeOpts =foldl'(flip($))baseOpts flagsShake lintInside <-mapMcanonicalizePath$shakeLintInsideoshakeOpts letshakeOpts =oshakeOpts {shakeLintInside=map(toStandard .addTrailingPathSeparator)lintInside ,shakeLintIgnore=maptoStandard $shakeLintIgnoreoshakeOpts ,shakeOutput=ifshakeColoroshakeOpts thenoutputColor (shakeOutputoshakeOpts )elseshakeOutputoshakeOpts }letputWhen v msg =when(shakeVerbosityoshakeOpts >=v )$shakeOutputoshakeOpts v msg letputWhenLn v msg =putWhen v $msg ++"\n"letshowHelp long =doprogName <-getProgName(targets ,helpSuffix )<-ifnotlong thenreturn([],[])elsehandleSynchronous (\e ->doputWhenLn Info $"Failure to collect targets: "++showe ;return([],[]))$do-- run the rules as simply as we canrs <-rules shakeOpts [][]casers ofJust(_,rs )->doxs <-getTargets shakeOpts rs helpSuffix <-getHelpSuffix shakeOpts rs evaluate$force([" - "++a ++maybe""(" - "++)b |(a ,b )<-xs ],helpSuffix )_->return([],[])changes <-return$letas=shakeOptionsFields baseOpts bs =shakeOptionsFields oshakeOpts in[" - "++lbl ++": "++v1 ++" => "++v2 |long ,((lbl ,v1 ),(_,v2 ))<-zipasbs ,v1 /=v2 ]putWhen Error $unlines$("Usage: "++progName ++" [options] [target] ..."):(ifnullbaseOpts2 then[]else"":(ifnulluserOptions then"Options:"else"Standard options:"):showOptDescr baseOpts2 )++(ifnulluserOptions then[]else"":"Extra options:":showOptDescr userOptions )++(ifnullchanges then[]else"":"Changed ShakeOptions:":changes )++(ifnulltargets then[]else"":"Targets:":targets )++(ifnullhelpSuffix then[]else"":helpSuffix )when(errs /=[])$doputWhen Error $unlines$map("shake: "++)$filter(not.null)$lines$unlineserrs showHelp FalseexitFailureifHelp `elem`flagsExtra thenshowHelp TrueelseifVersion `elem`flagsExtra thenputWhenLn Info $"Shake build system, version "++shakeVersionString elseifNumericVersion `elem`flagsExtra thenputWhenLn Info shakeVersionString elseifDemo `elem`flagsExtra thendemo $shakeStaunchshakeOpts elseifnot$nullprogressReplays thendodat <-forMprogressReplays $\file ->dosrc <-readFilefile return(file ,mapread$linessrc )forM_(ifnull$shakeReportshakeOpts then["-"]elseshakeReportshakeOpts )$\file ->doputWhenLn Info $"Writing report to "++file writeProgressReport file dat elsedowhen(Sleep `elem`flagsExtra )$sleep1start <-offsetTimeinitDataDirectory -- must be done before we start changing directoryletredir =maybeidwithCurrentDirectorychangeDirectory shakeOpts <-ifnullprogressRecords thenreturnshakeOpts elsedot <-offsetTimereturnshakeOpts {shakeProgress=\p ->void$withThreadsBoth (shakeProgressshakeOpts p )$progressDisplay 1(const$return())$dop <-p t <-t forM_progressRecords $\file ->appendFilefile $show(t ,p )++"\n"returnp }(ran ,shakeOpts ,res )<-redir $dowhenprintDirectory $docurdir <-getCurrentDirectoryputWhenLn Info $"shake: In directory `"++curdir ++"'"(shakeOpts ,ui )<-doletcompact =last$No :[x |Compact x <-flagsExtra ]use <-ifcompact ==Auto thencheckEscCodes elsereturn$compact ==Yes ifuse thensecondwithThreadSlave <$>compactUI shakeOpts elsereturn(shakeOpts ,id)rules <-rules shakeOpts user files ui $caserules ofNothing->return(False,shakeOpts ,Right())Just(shakeOpts ,rules )->dores <-try_$shake shakeOpts $ifNoBuild `elem`flagsExtra thenwithoutActions rules elseifShareList `elem`flagsExtra ||not(nullshareRemoves )||ShareSanity `elem`flagsExtra thendoaction $dounless(nullshareRemoves )$actionShareRemove shareRemoves when(ShareList `elem`flagsExtra )actionShareList when(ShareSanity `elem`flagsExtra )actionShareSanity withoutActions rules elserules return(True,shakeOpts ,res )ifnotran ||shakeVerbosityshakeOpts <Info ||NoTime `elem`flagsExtra theneitherthrowIOreturnres elseletesc =ifshakeColorshakeOpts thenescape elseflipconstincaseres ofLefterr ->ifException `elem`flagsExtra thenthrowIOerr elsedoputWhenLn Error $esc Red $showerr exitFailureRight()->dotot <-start putWhenLn Info $esc Green $"Build completed in "++showDurationtot -- | A list of command line options that can be used to modify 'ShakeOptions'. Each option returns-- either an error message (invalid argument to the flag) or a function that changes some fields-- in 'ShakeOptions'. The command line flags are @make@ compatible where possbile, but additional-- flags have been added for the extra options Shake supports.shakeOptDescrs::[OptDescr(EitherString(ShakeOptions ->ShakeOptions ))]shakeOptDescrs =[fmapFmapOptDescr sndo |(True,o )<-shakeOptsEx ]dataExtra =ChangeDirectory FilePath|Version |NumericVersion |PrintDirectory Bool|Help |Sleep |NoTime |Exception |NoBuild |ProgressRecord FilePath|ProgressReplay FilePath|Demo |ShareList |ShareSanity |ShareRemove String|Compact Auto derivingEqdataAuto =Yes |No |Auto derivingEqescape::Color ->String->Stringescape color x =escForeground color ++x ++escNormal outputColor::(Verbosity ->String->IO())->Verbosity ->String->IO()outputColor output v msg =output v $color msg wherecolor =casev ofSilent ->idError ->escape Red Warn ->escape Yellow _->escape Blue -- | True if it has a potential effect on ShakeOptionsshakeOptsEx::[(Bool,OptDescr(EitherString([Extra ],ShakeOptions ->ShakeOptions )))]shakeOptsEx =[opts $Option"a"["abbrev"](reqArgPair "abbrev""FULL=SHORT"$\a s ->s {shakeAbbreviations=shakeAbbreviationss ++[a ]})"Use abbreviation in status messages.",extr $Option""["no-build"](noArg [NoBuild ])"Don't build anything.",extr $Option"C"["directory"](reqArg "DIRECTORY"$\x ->[ChangeDirectory x ])"Change to DIRECTORY before doing anything."-- ,yes $ Option "" ["cloud"] (reqArg "URL" $ \x s -> s{shakeCloud=shakeCloud s ++ [x]}) "HTTP server providing a cloud cache.",opts $Option""["color","colour"](noArg $\s ->s {shakeColor=True})"Colorize the output.",opts $Option""["no-color","no-colour"](noArg $\s ->s {shakeColor=False})"Don't colorize the output.",extr $Option""["compact"](optArgAuto "auto""yes|no|auto"$\x ->[Compact x ])"Use a compact Bazel/Buck style output.",opts $Option"d"["debug"](optArg "FILE"$\x s ->s {shakeVerbosity=Diagnostic ,shakeOutput=outputDebug (shakeOutputs )x })"Print lots of debugging information.",extr $Option""["demo"](noArg [Demo ])"Run in demo mode.",opts $Option""["digest"](noArg $\s ->s {shakeChange=ChangeDigest })"Files change when digest changes.",opts $Option""["digest-and"](noArg $\s ->s {shakeChange=ChangeModtimeAndDigest })"Files change when modtime and digest change.",opts $Option""["digest-and-input"](noArg $\s ->s {shakeChange=ChangeModtimeAndDigestInput })"Files change on modtime (and digest for inputs).",opts $Option""["digest-or"](noArg $\s ->s {shakeChange=ChangeModtimeOrDigest })"Files change when modtime or digest change.",opts $Option""["digest-not"](noArg $\s ->s {shakeChange=ChangeModtime })"Files change when modtime changes.",extr $Option""["exception"](noArg [Exception ])"Throw exceptions directly.",opts $Option""["flush"](reqIntArg 1"flush""N"(\i s ->s {shakeFlush=Justi }))"Flush metadata every N seconds.",opts $Option""["never-flush"](noArg $\s ->s {shakeFlush=Nothing})"Never explicitly flush metadata.",extr $Option"h"["help"](noArg [Help ])"Print this message and exit.",opts $Option"j"["jobs"](optArgInt 0"jobs""N"$\i s ->s {shakeThreads=fromMaybe0i })"Allow N jobs/threads at once [default CPUs].",opts $Option"k"["keep-going"](noArg $\s ->s {shakeStaunch=True})"Keep going when some targets can't be made.",opts $Option"l"["lint"](noArg $\s ->s {shakeLint=JustLintBasic })"Perform limited validation after the run.",opts $Option""["lint-watch"](reqArg "PATTERN"$\x s ->s {shakeLintWatch=shakeLintWatchs ++[x ]})"Error if any of the patterns are created (expensive).",opts $Option""["lint-fsatrace"](optArg "DIR"$\x s ->s {shakeLint=JustLintFSATrace ,shakeLintInside=shakeLintInsides ++[fromMaybe"."x ]})"Use fsatrace to do validation [in current dir].",opts $Option""["lint-ignore"](reqArg "PATTERN"$\x s ->s {shakeLintIgnore=shakeLintIgnores ++[x ]})"Ignore any lint errors in these patterns.",opts $Option""["no-lint"](noArg $\s ->s {shakeLint=Nothing})"Turn off --lint.",opts $Option""["live"](optArg "FILE"$\x s ->s {shakeLiveFiles=shakeLiveFiless ++[fromMaybe"live.txt"x ]})"List the files that are live [to live.txt].",opts $Option"m"["metadata"](reqArg "PREFIX"$\x s ->s {shakeFiles=x })"Prefix for storing metadata files.",extr $Option""["numeric-version"](noArg [NumericVersion ])"Print just the version number and exit.",opts $Option""["skip-commands"](noArg $\s ->s {shakeRunCommands=False})"Try and avoid running external programs.",opts $Option"B"["rebuild"](optArg "PATTERN"$\x s ->s {shakeRebuild=shakeRebuilds ++[(RebuildNow ,fromMaybe"**"x )]})"Rebuild matching files.",opts $Option""["no-rebuild"](optArg "PATTERN"$\x s ->s {shakeRebuild=shakeRebuilds ++[(RebuildNormal ,fromMaybe"**"x )]})"Rebuild matching files if necessary (default).",opts $Option""["skip"](optArg "PATTERN"$\x s ->s {shakeRebuild=shakeRebuilds ++[(RebuildLater ,fromMaybe"**"x )]})"Don't rebuild matching files this run."-- ,yes $ Option "" ["skip-forever"] (OptArg (\x -> Right ([], \s -> s{shakeRebuild=shakeRebuild s ++ [(RebuildNever, fromMaybe "**" x)]})) "PATTERN") "Don't rebuild matching files until they change.",opts $Option"r"["report","profile"](optArg "FILE"$\x s ->s {shakeReport=shakeReports ++[fromMaybe"report.html"x ]})"Write out profiling information [to report.html].",opts $Option""["no-reports"](noArg $\s ->s {shakeReport=[]})"Turn off --report.",opts $Option""["rule-version"](reqArg "VERSION"$\x s ->s {shakeVersion=x })"Version of the build rules.",opts $Option""["no-rule-version"](noArg $\s ->s {shakeVersionIgnore=True})"Ignore the build rules version.",opts $Option""["share"](optArg "DIRECTORY"$\x s ->s {shakeShare=Just$fromMaybe""x ,shakeChange=ensureHash $shakeChanges })"Shared cache location.",hide $Option""["share-list"](noArg ([ShareList ],ensureShare ))"List the shared cache files.",hide $Option""["share-sanity"](noArg ([ShareSanity ],ensureShare ))"Sanity check the shared cache files.",hide $Option""["share-remove"](OptArg(\x ->Right([ShareRemove $fromMaybe"**"x ],ensureShare ))"SUBSTRING")"Remove the shared cache keys.",opts $Option""["share-copy"](noArg $\s ->s {shakeSymlink=False})"Copy files into the cache.",opts $Option""["share-symlink"](noArg $\s ->s {shakeSymlink=True})"Symlink files into the cache.",opts $Option"s"["silent"](noArg $\s ->s {shakeVerbosity=Silent })"Don't print anything.",extr $Option""["sleep"](noArg [Sleep ])"Sleep for a second before building.",opts $Option"S"["no-keep-going","stop"](noArg $\s ->s {shakeStaunch=False})"Turns off -k.",opts $Option""["storage"](noArg $\s ->s {shakeStorageLog=True})"Write a storage log.",both $Option"p"["progress"](progress $optArgInt 1"progress""N"$\i s ->s {shakeProgress=prog $fromMaybe5i })"Show progress messages [every N secs, default 5].",opts $Option""["no-progress"](noArg $\s ->s {shakeProgress=const$return()})"Don't show progress messages.",opts $Option"q"["quiet"](noArg $\s ->s {shakeVerbosity=move (shakeVerbositys )pred})"Print less (pass repeatedly for even less).",extr $Option""["no-time"](noArg [NoTime ])"Don't print build time.",opts $Option""["timings"](noArg $\s ->s {shakeTimings=True})"Print phase timings.",opts $Option"V"["verbose","trace"](noArg $\s ->s {shakeVerbosity=move (shakeVerbositys )succ})"Print more (pass repeatedly for even more).",extr $Option"v"["version"](noArg [Version ])"Print the version number and exit.",extr $Option"w"["print-directory"](noArg [PrintDirectory True])"Print the current directory.",extr $Option""["no-print-directory"](noArg [PrintDirectory False])"Turn off -w, even if it was turned on implicitly."]whereopts o =(True,fmapFmapOptDescr ([],)o )extr o =(False,fmapFmapOptDescr (,id)o )both o =(True,o )hide o =(False,o )-- I do modify the options, but not in a meaningful waymove::Verbosity ->(Int->Int)->Verbosity move x by =toEnum$min(fromEnummx )$max(fromEnummn )$by $fromEnumx where(mn ,mx )=(asTypeOfminBoundx ,asTypeOfmaxBoundx )noArg =NoArg.RightreqArg a f =ReqArg(Right.f )a optArg a f =OptArg(Right.f )a reqIntArg mn flag a f =flipReqArga $\x ->casereadsx of[(i ,"")]|i >=mn ->Right(f i )_->Left$"the `--"++flag ++"' option requires a number, "++showmn ++" or above"optArgInt mn flag a f =flipOptArga $maybe(Right(f Nothing))$\x ->casereadsx of[(i ,"")]|i >=mn ->Right(f $Justi )_->Left$"the `--"++flag ++"' option requires a number, "++showmn ++" or above"optArgAuto flag a f =flipOptArga $maybe(Right(f Yes ))$\x ->casex of"yes"->Right$f Yes "no"->Right$f No "auto"->Right$f Auto _->Left$"the `--"++flag ++"' option requires yes|no|auto, but got "++showx reqArgPair flag a f =flipReqArga $\x ->casebreak(=='=')x of(a ,'=':b )->Right$f (a ,b )_->Left$"the `--"++flag ++"' option requires an = in the argument"progress (OptArgfunc msg )=flipOptArgmsg $\x ->casebreak(=='=')`fmap`x ofJust("record",file )->Right([ProgressRecord $ifnullfile then"progress.txt"elsetailfile ],id)Just("replay",file )->Right([ProgressReplay $ifnullfile then"progress.txt"elsetailfile ],id)_->([],)<$>func x progress_=throwImpure $errorInternal "incomplete pattern, progress"outputDebug output Nothing=output outputDebugoutput (Justfile )=\v msg ->dowhen(v /=Diagnostic )$output v msg appendFilefile $removeEscCodes msg ++"\n"prog i p =doprogram <-progressProgram progressDisplay i (\s ->progressTitlebar s >>program s )p -- ensure the file system always computes a hash, required for --shareensureHash ChangeModtime =ChangeModtimeAndDigest ensureHashChangeModtimeAndDigestInput =ChangeModtimeAndDigest ensureHashx =x ensureShare s =s {shakeShare=Just$fromMaybe"."$shakeShares }